application/octet-stream
•
6.00 KB
•
196 lines
[import [start stop clear-screen get-size poll-input draw-box move-cursor put-char put-string set-bg-color set-fg-color] :core/term]
[def screen-width #nil]
[def screen-height #nil]
[def buffers #[]]
[defn new-buffer [filename]
[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]]
[array/push buffers buf]
[return buf]]
[def cur-buffer [new-buffer "*new*"]]
[def last-char 0]
[defn get-buf-name [buf]
[def filename [tree/ref buf :filename]]
[def saved [if [tree/ref buf :changed] "*" ""]]
[fmt "{filename}{saved}"]]
[defn draw-menu-line []
[def x 1]
[draw-box :white 1 1 screen-width 1]
[dotimes [i [array/length buffers]]
[def active? [= cur-buffer [array/ref buffers i]]]
[if active?
[do [set-bg-color :default]
[set-fg-color :default]]
[do [set-bg-color :white]
[set-fg-color :black]]]
[move-cursor [+ x 1] 1]
[def buf [array/ref buffers i]]
[def bufname [fmt " {}: {} " [inc i] [get-buf-name buf]]]
[put-string bufname]
[inc! x [+ 2 [buffer/length bufname]]]]
[set-bg-color :default]
[set-fg-color :default]]
[defn draw-gutter []
[draw-box :red 1 2 4 [- screen-height 2]]]
[defn get-modeline [buf]
[def x [tree/ref buf :pos-x]]
[def y [tree/ref buf :pos-y]]
[def bufname [get-buf-name buf]]
[def saved [if [tree/ref buf :changed] "*" ""]]
[fmt " X:{x} Y:{y} - {bufname} - KeyCode: {last-char:X}"]]
[defn draw-modeline [buf]
[draw-box :blue 1 screen-height screen-width 1]
[move-cursor 1 screen-height]
[set-bg-color :blue]
[set-fg-color :yellow]
[put-string [get-modeline buf]]
[set-bg-color :default]
[set-fg-color :default]]
[defn get-line [buf line-y]
[def lines [tree/ref buf :lines]]
[if [or [< line-y 0]
[>= line-y [array/length lines]]]
#nil
[array/ref lines line-y]]]
[defn draw-buffer-line [buf term-x term-y term-w line-y]
[def line [get-line buf line-y]]
[when-not line [return]]
[when [= line-y [tree/ref buf :pos-y]]
[set-bg-color :blue]
[set-fg-color :yellow]]
[move-cursor term-x term-y]
[def ln [fmt " {line-y:4} "]]
[put-string ln]
[set-bg-color :default]
[set-fg-color :default]
[move-cursor [+ 1 [buffer/length ln] term-x] term-y]
[put-string line]]
[defn draw-buffer [buf x y w h]
[dotimes [cy h]
[def line-y [+ cy [tree/ref buf :scroll-y]]]
[draw-buffer-line buf x [+ cy y] w line-y]]
[draw-modeline buf]]
[defn draw-screen []
[clear-screen]
[draw-menu-line]
[draw-buffer cur-buffer 1 2 screen-width [- screen-height 2]]
[move-cursor [+ 1 1 6 [tree/ref cur-buffer :pos-x]] [+ 2 [tree/ref cur-buffer :pos-y]]]]
[defn quit []
[stop]
[exit 0]]
[defn line-length [pos-y]
[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 []
[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-delete-char []
[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]
[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 []
[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 beginning-of-line []
[def buf cur-buffer]
[tree/set! buf :pos-x 0]]
[defn end-of-line []
[def buf cur-buffer]
[tree/set! buf :pos-x [inc [line-length [tree/ref buf :pos-y]]]]]
[defn read-input []
[def c [poll-input]]
[set! last-char c]
[when [= c #x01] ; C-a
[beginning-of-line]
[return]]
[when [= c #x05] ; C-e
[end-of-line]
[return]]
[when [= c #x7F]
[backward-delete-char]
[return]]
[when [= c #x0D]
[insert-newline]
[return]]
[when [and [>= c #x20]
[< c #x80]]
[insert-char c]
[return]]
[when [= c #x11]
[quit]]]
[defn main [args]
:export
[start]
[def s [get-size]]
[set! screen-width [tree/ref s :width]]
[set! screen-height [tree/ref s :height]]
[while #t
[draw-screen]
[read-input]]]
