From 6921c5c7332dc2c2ddf1dd2415901d138ec48600 Mon Sep 17 00:00:00 2001 From: Jeffrey Armstrong Date: Thu, 9 Sep 2021 11:51:23 -0400 Subject: Initial Fortran code porting kilo to appgraphics in Fortran --- ap_kilo.prj | 74 +++++++++ apfilo.f90 | 140 +++++++++++++++++ driver.f90 | 82 ++++++++++ filo.f90 | 516 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 812 insertions(+) create mode 100644 ap_kilo.prj create mode 100644 apfilo.f90 create mode 100644 driver.f90 create mode 100644 filo.f90 diff --git a/ap_kilo.prj b/ap_kilo.prj new file mode 100644 index 0000000..1d989da --- /dev/null +++ b/ap_kilo.prj @@ -0,0 +1,74 @@ +{ + "Root":{ + "Folders":[], + "Name":"+ap_kilo (apkilo.exe)", + "Files":[{ + "filename":".\\apfilo.f90", + "enabled":"1" + },{ + "filename":".\\driver.f90", + "enabled":"1" + },{ + "filename":".\\filo.f90", + "enabled":"1" + },{ + "filename":".\\kilo.c", + "enabled":"0" + }] + }, + "Name":"ap_kilo (apkilo.exe)", + "Options":{ + "Compiler Options":{ + "Fortran Flags":"", + "Link Flags":"-lappgraphics -lgdi32 -lcomdlg32 -lcomctl32 -luuid -loleaut32 -lole32", + "C Flags":"" + }, + "Architecture":0, + "Type":0, + "Revision":2, + "Windows GUI":0, + "File Options":{ + "Library Directories":["Default Add-On Directory"], + "Build Directory":"build", + "Module Directory":"modules", + "Include Directories":["Default Add-On Include Directory"] + }, + "Target":"apkilo.exe", + "Fortran Options":{ + "Use C Preprocessor":"false", + "Runtime Diagnostics":"false", + "Floating Point Exception Trap":0, + "Cray Pointers":"false", + "Enable Coarrays":"false", + "Enable OpenMP":"false", + "Initialize Variables to Zero":"false", + "Default Double for Real":"false" + }, + "Code Generation Options":{ + "CPU Specific":"false", + "Processor":"generic", + "Aggressive Loops":"false", + "Debugging":"true", + "Optimization Mode":0, + "Profiling":"false" + }, + "Build Dependencies":1, + "Launch Options":{ + "Working Directory":"", + "Launch Using MPI":"false", + "Keep Console":"true", + "External Console":"false", + "Command Line Arguments":"", + "Build Before Launch":"true" + }, + "Build Options":{ + "Makefile":"Makefile.sf", + "Auto Makefile":"true" + }, + "Linker Options":{ + "Static Linking Mode":7, + "Link MPI Library":"false", + "Link LAPACK":0 + } + } +} \ No newline at end of file diff --git a/apfilo.f90 b/apfilo.f90 new file mode 100644 index 0000000..c933b91 --- /dev/null +++ b/apfilo.f90 @@ -0,0 +1,140 @@ +module appgraphics_filo +use filo +implicit none + + type, extends(editorConfig) :: apEditorConfig + + integer::window + integer::x, y, w, h + + end type apEditorConfig + +contains + + function initApEditor(win, x, y, w, h) result(E) + use appgraphics, only: getmaxx, getmaxy + implicit none + + integer, intent(in)::win + integer, intent(in), optional::x, y, w, h + + type(apEditorConfig)::E + + call initEditor(E) + + E%window = win + if(present(x)) then + E%x = x + else + E%x = 0 + end if + if(present(y)) then + E%y = y + else + E%y = 0 + end if + if(present(w)) then + E%w = w + else + E%w = getmaxx() + end if + if(present(h)) then + E%h = h + else + E%h = getmaxy() + end if + + call updateApEditorSize(E) + + end function initApEditor + + subroutine updateApEditorSize(E) + use appgraphics + implicit none + + class(apEditorConfig), intent(inout)::E + + E%screencols = 0 + do while(textwidth(repeat('X', E%screencols+1)) < E%w) + E%screencols = E%screencols + 1 + end do + E%screenrows = E%h / textheight('XXX') + + E%cx = max(E%cx, E%screencols) + E%cy = max(E%cy, E%screenrows) + + end subroutine updateApEditorSize + + subroutine drawApEditor(E) + use appgraphics + implicit none + + class(apEditorConfig), intent(inout)::E + + integer::irow, icol, icollast + integer::x, y, rh + + character(len=:), pointer::row_text + + call setcurrentwindow(E%window) + call resetviewport() + call setviewport(E%x, E%y, E%x+E%w, E%y+E%h, .TRUE.) + call clearviewport() + + y = 0 + do irow = 1+E%rowoff, E%rowoff + E%screenrows + x = 0 + rh = 0 + + row_text => E%row(irow)%string_pointer() + + if(.not. associated(row_text)) then + rh = textheight('XXX') + else + if(E%coloff+1 > len(row_text)) then + rh = textheight('XXX') + else + icol = 1 + E%coloff + icollast = min(E%coloff+E%screencols, len(row_text)) + call outtextxy(x, y, row_text(icol:icollast)) + rh = textheight(row_text(icol:icollast)) + end if + +! if(irow == E%cy .and. icol == E%cx) then +! call bar(x, y, x+3, y+rh) +! end if + end if + + ! Cursor + if(irow - E%rowoff - 1 == E%cy) then + if(.not. associated(row_text) .or. E%cx == 1) then + x = 0 + else + + ! Width calculations are all messed up by trimming + ! being performed in textwidth + x = index(row_text(icol:icol+E%cx-2), ' ') + do while(x > 0) + x = x + icol - 1 + row_text(x:x) = '_' + x = index(row_text(icol:icol+E%cx-2), ' ') + end do + x = textwidth(row_text(icol:icol+E%cx-2)) + end if + + call bar(x, y-rh-1, x+3, y+1) + end if + + if(associated(row_text)) then + deallocate(row_text) + row_text => null() + end if + + y = y + rh + end do + + call resetviewport() + + end subroutine drawApEditor + +end module appgraphics_filo \ No newline at end of file diff --git a/driver.f90 b/driver.f90 new file mode 100644 index 0000000..8008e81 --- /dev/null +++ b/driver.f90 @@ -0,0 +1,82 @@ +program driver +use appgraphics +use appgraphics_filo +use filo +implicit none + + type(apEditorConfig)::E + integer::mywindow + integer::key, delta, rowoff + logical::cursor_moved + + mywindow = initwindow(640, 480, dbflag=.true., closeflag=.true.) + + call settextstyle(MONOSPACE_FONT, HORIZ_DIR, 20) + call setfillstyle(SOLID_FILL, WHITE) + + E = initApEditor(mywindow) + + if(.not. editorOpen(E, "kilo.c")) then + Print *, "Error opening file..." + stop + end if + + call drawApEditor(E) + call swapbuffers() + + do while(.true.) + call startidle(50) + do while(kbhit()) + cursor_moved = .false. + rowoff = E%rowoff + + key = getch() + ! Special character + if(key == 0) then + key = getch() + delta = 0 + select case(key) + case(KEY_UP) + E%cy = max(E%cy - 1, 1) + cursor_moved = .true. + case(KEY_DOWN) + E%cy = min(E%cy + 1, E%screenrows) + cursor_moved = .true. + case(KEY_LEFT) + E%cx = max(E%cx - 1, 0) + cursor_moved = .true. + case(KEY_RIGHT) + E%cx = min(E%cx + 1, E%screencols) + cursor_moved = .true. + case(KEY_PGUP) + delta = -1*E%screenrows + case(KEY_PGDN) + delta = E%screenrows + end select + + rowoff = rowoff + delta + rowoff = max(rowoff, 0) + rowoff = min(rowoff, E%numrows - E%screenrows) + else + + select case(key) + case(8) ! Backspace + call editorDelChar(E) + case default + call editorInsertChar(E, char(key)) + end select + + cursor_moved = .TRUE. + + end if + + if(rowoff /= E%rowoff .or. cursor_moved) then + e%rowoff = rowoff + call drawApEditor(E) + call swapbuffers() + end if + + end do + end do + +end program driver \ No newline at end of file diff --git a/filo.f90 b/filo.f90 new file mode 100644 index 0000000..3918d8e --- /dev/null +++ b/filo.f90 @@ -0,0 +1,516 @@ +module filo +implicit none + + type :: erow + integer::idx + character(len=1), dimension(:), allocatable::chars + + contains + + procedure :: size => row_size + procedure :: string_pointer => row_string_pointer + + end type + + type :: editorConfig + integer::cx, cy ! Cursor position in characters + integer::rowoff ! Offset of row displayed + integer::coloff ! Offset of column displayed + integer::screenrows + integer::screencols + integer::numrows + + type(erow), dimension(:), allocatable::row + + integer::dirty + + character(len=:), pointer::filename + end type + + interface editorInsertRow + module procedure editorInsertRowString + module procedure editorInsertRowArray + module procedure editorInsertRowEmpty + end interface + +contains + + pure function row_size(er) + implicit none + + integer::row_size + class(erow), intent(in)::er + + if(allocated(er%chars)) then + row_size = size(er%chars) + else + row_size = 0 + end if + + end function row_size + + function row_string_pointer(er) result(str) + implicit none + + class(erow), intent(in)::er + character(len=:), pointer::str + integer::i + + if(row_size(er) == 0) then + str => null() + else + allocate(character(len=row_size(er)) :: str) + do i = 1, row_size(er) + str(i:i) = er%chars(i) + end do + end if + + end function row_string_pointer + + subroutine editorInsertRowEmpty(E, at) + implicit none + + class(editorConfig), intent(inout)::E + integer, intent(in)::at + + type(erow), dimension(:), allocatable::ertmp + + if(at > E%numrows + 1) then + return + end if + + allocate(ertmp(E%numrows+1)) + if(allocated(E%row) .and. E%numrows > 0) then + ertmp(1:E%numrows) = E%row + end if + call move_alloc(ertmp, E%row) + + if(at /= E%numrows+1) then + E%row(at+1:E%numrows+1) = E%row(at:E%numrows) + E%row(at+1:E%numrows+1)%idx = E%row(at+1:E%numrows+1)%idx+1 + end if + + E%row(at)%idx = at + + E%numrows = E%numrows + 1 + E%dirty = E%dirty + 1 + + end subroutine editorInsertRowEmpty + + subroutine editorInsertRowArray(E, at, arr) + implicit none + + class(editorConfig), intent(inout)::E + integer, intent(in)::at + character, dimension(:)::arr + + if(at > E%numrows + 1) then + return + end if + + call editorInsertRowEmpty(E, at) + + allocate(E%row(at)%chars(size(arr))) + E%row(at)%chars = arr + + end subroutine editorInsertRowArray + + subroutine editorInsertRowString(E, at, s) + implicit none + + class(editorConfig), intent(inout)::E + integer, intent(in)::at + character(*)::s + + character, dimension(:), allocatable::ctmp + integer::i + + if(at > E%numrows+1) then + return + end if + + if(len(s) == 0) then + + call editorInsertRowEmpty(E, at) + + else + + allocate(ctmp(len(s))) + do i=1, len(s) + ctmp(i) = s(i:i) + end do + + call editorInsertRowArray(E, at, ctmp) + + deallocate(ctmp) + end if + + end subroutine editorInsertRowString + + subroutine editorFreeRow(er) + implicit none + + type(erow), intent(inout)::er + + deallocate(er%chars) + + end subroutine editorFreeRow + + subroutine editorDelRow(E, at) + implicit none + + class(editorConfig), intent(inout)::E + integer, intent(in)::at + + if(at > E%numrows) then + return + end if + + call editorFreeRow(E%row(at)) + + if(at < E%numrows) then + E%row(at:E%numrows-1) = E%row(at+1:E%numrows) + E%row(at:E%numrows-1)%idx = E%row(at:E%numrows-1)%idx-1 + end if + + E%numrows = E%numrows - 1 + E%dirty = E%dirty + 1 + + end subroutine editorDelRow + + function editorRowsToString(E) result(res) + implicit none + + class(editorConfig), intent(in)::E + character(len=:), pointer::res + + integer::totlen + integer::j, k, i + + totlen = 0 + do j=1,E%numrows + totlen = totlen + E%row(j)%size() + end do + totlen = totlen + E%numrows*len_trim(new_line(' ')) + + allocate(character(len=totlen) :: res) + i = 1 + do j=1, E%numrows + do k=1,E%row(j)%size() + res(i:i) = E%row(j)%chars(k) + i = i + 1 + end do + res(i:i+len_trim(new_line(' '))) = new_line(' ') + i = i + len_trim(new_line(' ')) + end do + + end function editorRowsToString + + subroutine editorRowInsertChar(E, er, at, c) + implicit none + + class(editorConfig), intent(inout)::E + type(erow), intent(inout)::er + integer, intent(in)::at + character, intent(in)::c + + integer::padlen + + character, dimension(:), allocatable::ctmp + + if(at > er%size()) then + + padlen = at - er%size() + allocate(ctmp(er%size() + padlen + 1)) + ctmp(1:er%size()) = er%chars + if(padlen > 0) then + ctmp(er%size()+1:er%size()+padlen) = ' ' + end if + + else + + allocate(ctmp(er%size() + 1)) + ctmp(1:at-1) = er%chars(1:at-1) + ctmp(at+1:er%size() + 1) = er%chars(at:er%size()) + + end if + + ctmp(at) = c + call move_alloc(ctmp, er%chars) + + E%dirty = E%dirty + 1 + + end subroutine editorRowInsertChar + + subroutine editorRowAppendArray(E, er, arr) + implicit none + + class(editorConfig), intent(inout)::E + type(erow), intent(inout)::er + character, dimension(:), intent(in)::arr + + character, dimension(:), allocatable::ctmp + integer::i + + allocate(ctmp(er%size()+size(arr))) + ctmp(1:er%size()) = er%chars + ctmp(er%size()+1:er%size()+size(arr)) = arr + + call move_alloc(ctmp, er%chars) + + E%dirty = E%dirty + 1 + + end subroutine editorRowAppendArray + + subroutine editorRowAppendString(E, er, s) + implicit none + + class(editorConfig), intent(inout)::E + type(erow), intent(inout)::er + character(*), intent(in)::s + + character, dimension(:), allocatable::ctmp + integer::i + + allocate(ctmp(len(s))) + do i=1,len(s) + ctmp(i) = s(i:i) + end do + call editorRowAppendArray(E, er, ctmp) + deallocate(ctmp) + + end subroutine editorRowAppendString + + subroutine editorRowDelChar(er, at) + implicit none + + type(erow), intent(inout)::er + integer, intent(in)::at + + character, dimension(:), allocatable::ctmp + + if(er%size() < at) then + return + end if + + if(er%size() == 1) then + deallocate(er%chars) + else + allocate(ctmp(er%size() - 1)) + ctmp(1:at-1) = er%chars(1:at-1) + ctmp(at:er%size()-1) = er%chars(at+1:er%size()) + call move_alloc(ctmp, er%chars) + end if + + end subroutine editorRowDelChar + + subroutine editorInsertChar(E, c) + implicit none + + class(editorConfig), intent(inout)::E + character, intent(in)::c + + integer::filerow, filecol + + filerow = E%rowoff+E%cy + filecol = E%coloff+E%cx + + !Print *, E%cy, filerow, E%rowoff, ':', E%cx, filecol + + if(filerow >= E%numrows) then + do while(E%numrows < filerow) + call editorInsertRow(E, E%numrows, "") + end do + end if + + call editorRowInsertChar(E, E%row(filerow), filecol, c) + if(E%cx == E%screencols - 1) then + E%coloff = E%coloff + 1 + else + E%cx = E%cx + 1 + end if + + E%dirty = E%dirty + 1 + + end subroutine editorInsertChar + + subroutine editorInsertNewline_fixcursor(E) + implicit none + + class(editorConfig), intent(inout)::E + + if(E%cy == E%screenrows) then + E%rowoff = E%rowoff + 1 + else + E%cy = E%cy + 1 + end if + + E%cx = 0 + E%coloff = 0 + + end subroutine editorInsertNewline_fixcursor + + subroutine editorInsertNewline(E) + implicit none + + class(editorConfig), intent(inout)::E + type(erow)::er + integer::filerow, filecol + + character, dimension(:), allocatable::ctmp + + filerow = E%rowoff+E%cy + filecol = E%coloff+E%cx + + if(filerow > E%numrows) then + call editorInsertRow(E, filerow, "") + call editorInsertNewline_fixcursor(E) + return + else + er = E%row(filerow) + end if + + filecol = min(er%size(), filecol) + if(filecol == 0) then + call editorInsertRow(E, filerow, "") + else + call editorInsertRow(E, filerow+1, er%chars(filecol:er%size())) + allocate(ctmp(filerow)) + ctmp = er%chars(1:filerow) + call move_alloc(ctmp, er%chars) + end if + + call editorInsertNewline_fixcursor(E) + + end subroutine editorInsertNewline + + subroutine editorDelChar(E) + implicit none + + class(editorConfig), intent(inout)::E + integer::filerow, filecol + integer::deltax + + filerow = E%rowoff+E%cy + filecol = E%coloff+E%cx + + if(filerow > E%numrows) then + return + end if + + if(filecol == 1) then + filecol = E%row(filerow - 1)%size() + if(E%row(filerow)%size() > 0) then + call editorRowAppendArray(e, E%row(filerow - 1), E%row(filerow)%chars) + end if + call editorDelRow(E, filerow) + if(E%cy == 1) then + E%rowoff = E%rowoff - 1 + else + E%cy = E%cy - 1 + end if + + E%cx = filecol+1 + if(E%cx > E%screencols) then + deltax = E%screencols - E%cx + 1 + E%cx = E%cx - deltax + E%coloff = E%coloff + deltax + end if + else + call editorRowDelChar(E%row(filerow), filecol - 1) + if(E%cx == 0 .and. E%coloff > 0) then + E%coloff = E%coloff - 1 + else + E%cx = E%cx - 1 + end if + end if + + E%dirty = E%dirty + 1 + + end subroutine editorDelChar + + function editorOpen(E, filename) result(success) + implicit none + + class(editorConfig), intent(inout)::E + character(*), intent(in)::filename + + integer::unum, ios + logical::success + + character(1024)::line + + E%dirty = 0 + if(associated(E%filename)) then + deallocate(E%filename) + end if + allocate(character(len=len(filename))::E%filename) + + E%filename = filename + + open(newunit=unum, file=filename, action="read", iostat=ios, status="old") + if(ios /= 0) then + success = .false. + return + end if + + read(unum, '(A)', iostat=ios) line + do while(ios == 0) + call editorInsertRow(E, E%numrows+1, trim(line)) + line = ' ' + read(unum, '(A)', iostat=ios) line + end do + + close(unum) + E%dirty = 0 + E%cx = 1 + E%cy = 1 + + success = .true. + + end function editorOpen + + function editorSave(E) result(success) + implicit none + + class(editorConfig), intent(inout)::E + logical::success + + character(len=:), pointer::buf + integer::unum, ios + + buf => editorRowsToString(E) + if(.not. associated(buf)) then + success = .false. + return + end if + + open(newunit=unum, file=E%filename, status='unknown', action='write', iostat=ios) + if(ios /= 0) then + success = .false. + return + end if + + write(unum, *, iostat=ios) buf + + close(unum) + success = .true. + E%dirty = 0 + + end function editorSave + + subroutine initEditor(E) + implicit none + + class(editorConfig), intent(out)::E + + E%cx = 1 + E%cy = 1 + E%rowoff = 0 + E%coloff = 0 + E%numrows = 0 + E%dirty = 0 + + end subroutine initEditor + +end module filo -- cgit v1.2.3