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 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 Print *, "new offset: ", E%coloff, "->", E%screencols, E%cx 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