Initial Fortran code porting kilo to appgraphics in Fortran

4 files changed, 812 insertions, 0 deletions

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