application/octet-stream
•
4.32 KB
•
146 lines
[def cur-buffer #nil]
[defn set-cur-buffer! [buf]
:export
[set! cur-buffer buf]]
[defn get-cur-buffer []
:export
cur-buffer]
[defn new-buffer [filename]
:export
[def lines #[[buffer/allocate 16]]]
[def buf @[ :lines lines
:filename filename
:changed #f
:pos-x 0
:pos-y 0
:scroll-x 0
:scroll-y 0]]
[return buf]]
[defn get-line [buf line-y]
:export
[def lines [tree/ref buf :lines]]
[if [or [< line-y 0]
[>= line-y [array/length lines]]]
#nil
[array/ref lines line-y]]]
[defn line-length [pos-y]
:export
[def buf cur-buffer]
[def line [get-line buf pos-y]]
[when-not line [return 0]]
[dotimes [i [buffer/length line] [buffer/length line]]
[when [zero? [buffer/ref line i]]
[return [- i 1]]]]]
[defn backward-delete-line []
:export
[def buf cur-buffer]
[def lines [tree/ref buf :lines]]
[def ll [- [array/length lines] 1]]
[def pos-y [tree/ref buf :pos-y]]
[when [zero? pos-y] [return]]
[while [< pos-y ll]
[array/set! lines pos-y [inc pos-y]]
[inc! pos-y]]
[array/length! lines [max 0 ll]]
[tree/set! buf :pos-y [- [tree/ref buf :pos-y] 1]]
[tree/set! buf :pos-x [inc [line-length [tree/ref buf :pos-y]]]]]
[defn backward-char []
:export
[def buf cur-buffer]
[def pos-x [tree/ref buf :pos-x]]
[when [< pos-x 1]
[def pos-y [tree/ref buf :pos-y]]
[when [< pos-y 1]
[return]]
[tree/set! buf :pos-y [dec pos-y]]
[tree/set! buf :pos-x [inc [line-length [dec pos-y]]]]
[return]]
[tree/set! buf :pos-x [dec pos-x]]]
[defn previous-line []
:export
[def buf cur-buffer]
[def pos-x [tree/ref buf :pos-x]]
[def pos-y [tree/ref buf :pos-y]]
[when [< pos-y 1]
[return]]
[tree/set! buf :pos-y [dec pos-y]]
[tree/set! buf :pos-x [min pos-x [inc [line-length [dec pos-y]]]]]]
[defn next-line []
:export
[def buf cur-buffer]
[def pos-x [tree/ref buf :pos-x]]
[def pos-y [tree/ref buf :pos-y]]
[def lines [tree/ref buf :lines]]
[def ll [- [array/length lines] 1]]
[when [>= pos-y ll]
[return]]
[tree/set! buf :pos-y [inc pos-y]]
[tree/set! buf :pos-x [min pos-x [inc [line-length [inc pos-y]]]]]]
[defn forward-char []
:export
[def buf cur-buffer]
[def pos-x [tree/ref buf :pos-x]]
[def pos-y [tree/ref buf :pos-y]]
[def ll [line-length pos-y]]
[when [> pos-x ll]
[when [>= [inc pos-y] [array/length [tree/ref buf :lines]]]
[return]]
[tree/set! buf :pos-x 0]
[tree/set! buf :pos-y [inc pos-y]]
[return]]
[tree/set! buf :pos-x [inc pos-x]]]
[defn backward-delete-char []
:export
[def buf cur-buffer]
[def line [get-line buf [tree/ref buf :pos-y]]]
[when-not line [return]]
[def pos-x [tree/ref buf :pos-x]]
[when [< pos-x 1]
[backward-delete-line]
[return]]
[def bl [- [buffer/length line] 1]]
[buffer/set! line [- pos-x 1] 0]
[while [< pos-x [- bl 1]]
[buffer/set! line pos-x [buffer/ref line [inc pos-x]]]
[inc! pos-x]]
[buffer/set! line bl 0]
[tree/set! buf :pos-x [- [tree/ref buf :pos-x] 1]]]
[defn insert-char [c]
:export
[def buf cur-buffer]
[def line [get-line buf [tree/ref buf :pos-y]]]
[when-not line
; ToDo: add line?
[return]]
[def pos-x [tree/ref buf :pos-x]]
[when [>= pos-x [buffer/length line]]
[buffer/length! line [+ [buffer/length line] 16]]]
[buffer/set! line pos-x c]
[tree/set! buf :pos-x [inc pos-x]]]
[defn insert-newline []
:export
[def buf cur-buffer]
[def lines [tree/ref buf :lines]]
[array/length! lines [inc [array/length lines]]]
[array/set! lines [- [array/length lines] 1] [buffer/allocate 16]]
[tree/set! buf :pos-x 0]
[tree/set! buf :pos-y [inc [tree/ref buf :pos-y]]]]
[defn get-buf-name [buf]
:export
[def filename [tree/ref buf :filename]]
[def saved [if [tree/ref buf :changed] "*" ""]]
[fmt "{filename}{saved}"]]