Ben / Nujel

(import (start stop show-cursor hide-cursor clear-line clear-screen get-size poll-input draw-box move-cursor put-char put-string set-color) :core/term)
(import (new-buffer :as new-buffer* get-line line-length forward-char backward-char backward-delete-line backward-delete-char insert-char insert-newline get-buf-name set-cur-buffer! get-cur-buffer previous-line next-line line-clean! line-clean? delete-forward-char) :app/termed/buffer)

(def buffers [])
(def screen-width #nil)
(def screen-height #nil)
(def last-char 0)

(def scroll-interval 10)

(defn new-buffer (filename)
      (def buf (new-buffer* filename))
      (array/push buffers buf)
      buf)

(defn draw-gutter ()
      (draw-box :red 1 2 4 (- screen-height 2)))

(defn get-modeline (buf)
      (def x (ref buf :pos-x))
      (def y (inc (ref buf :pos-y)))
      (def bufname (get-buf-name buf))
      (def saved (if (ref buf :changed) "*" ""))
      (fmt " L{y} - {bufname} - KeyCode: {last-char:X}"))

(defn draw-modeline (buf)
      (move-cursor 1 (dec screen-height))
      (set-color :yellow :blue)
      (def colored-modeline (cat " " (pad-end (get-modeline buf) (dec screen-width))))
      (put-string colored-modeline)
      (set-color :default :default))

(defn draw-buffer-line (buf term-x term-y term-w line-y)
      (def line (get-line buf line-y))
      (when-not line (return))
      (move-cursor term-x term-y)
      (clear-line)
      (when (= line-y (ref buf :pos-y))
        (set-color :yellow :blue))
      (def ln (fmt " {:4} " (inc line-y)))
      (put-string ln)
      (set-color :default)
      (move-cursor (+ 1 (:length ln) term-x) term-y)
      (def max-w (- term-w 7))
      (when (>= (:length line) max-w)
        (set! line (string->buffer (string/cut (buffer->string line) 0 max-w))))
      (put-string line)
      (line-clean! buf line-y #t))

(defn draw-buffer (buf x y w h)
      (dotimes (cy h)
               (def line-y (+ cy (ref buf :scroll-y)))
               (when-not (line-clean? buf line-y)
                         (draw-buffer-line buf x (+ cy y) w line-y)))
      (draw-modeline buf))

(defn draw-screen ()
      (def cur-buffer (get-cur-buffer))
      (hide-cursor)
      (draw-buffer cur-buffer 1 1 screen-width (- screen-height 2))
      (show-cursor)
      (move-cursor (+ 1 1 6 (ref cur-buffer :pos-x)) (- (inc (ref cur-buffer :pos-y))
                                                             (ref cur-buffer :scroll-y))))

(defn quit ()
      (stop)
      (exit 0))

(defn beginning-of-line ()
      (set! (get-cur-buffer) :pos-x 0))

(defn end-of-line ()
      (def buf (get-cur-buffer))
      (set! buf :pos-x (line-length (ref buf :pos-y))))

(defn clear-frame ()
      (dotimes (y (- screen-height 1))
               (move-cursor 0 y)
               (clear-line)))

(defn scroll-into-view ()
      (def buf (get-cur-buffer))
      (def frame-height (- screen-height 3))
      (when (< (- (ref buf :pos-y)
                  (ref buf :scroll-y)) 0)
        (array/fill! (ref buf :lines-clean) #f)
        (clear-frame)
        (set! buf :scroll-y (* scroll-interval (int (floor (/ (ref buf :pos-y) scroll-interval))))))

      (when (> (- (ref buf :pos-y)
                  (ref buf :scroll-y)) frame-height)
        (array/fill! (ref buf :lines-clean) #f)
        (clear-frame)
        (set! buf :scroll-y (* scroll-interval (int (ceil (/ (- (ref buf :pos-y) frame-height) scroll-interval))))))

      (when (< (ref buf :scroll-y) 0)
        (array/fill! (ref buf :lines-clean) #f)
        (set! buf :scroll-y)))

(defn read-bracketed-input ()
      (def c (poll-input))
      (when (= c #\A)
        (dirty-buf!)
        (return (previous-line)))
      (when (= c #\B)
        (dirty-buf!)
        (return (next-line)))
      (when (= c #\C)
        (return (forward-char)))
      (when (= c #\D)
        (return (backward-char)))
      (return))

(defn read-escaped-input ()
      (def c (poll-input))
      (when (= c #\[)
        (return (read-bracketed-input)))
      (return (insert-char #\[)))

(defn read-cx-input ()
      (def c (poll-input))
      (when (= c 3)
        (return (quit))))

(defn dirty-buf! ()
      (def buf (get-cur-buffer))
      (line-clean! buf (ref buf :pos-y) #f))

(defn read-input ()
      (def c (poll-input))
      (set! last-char c)
      (when (= c #x1B)
        (return (read-escaped-input)))
      (when (= c #x01) ; C-a
        (return (beginning-of-line)))
      (when (= c #x02) ; C-b
        (return (backward-char)))
      (when (= c #x05) ; C-e
        (return (end-of-line)))
      (when (= c #x06) ; C-f
        (return (forward-char)))
      (when (= c #x10) ; C-p
        (dirty-buf!)
        (return (previous-line)))
      (when (= c #x0E) ; C-n
        (dirty-buf!)
        (return (next-line)))
      (when (= c #x18) ; C-x
        (return (read-cx-input)))
      (when (= c #x7E)
        (dirty-buf!)
        (return (delete-forward-char)))
      (when (= c #x7F)
        (dirty-buf!)
        (return (backward-delete-char)))
      (when (= c #x0D)
        (dirty-buf!)
        (return (insert-newline)))
      (when (and (>= c #x20)
                 (<  c #x80))
        (dirty-buf!)
        (return (insert-char c))))

(defn load-buffer (filename)
      (def buf (new-buffer filename))
      (def text (slurp filename))
      (when text
        (set! buf :lines (apply array/new (map (split text "\n") string->buffer)))))

(defn main (args)
      :export
      (start)
      (clear-screen)
      (def s (get-size))
      (set! screen-width (ref s :width))
      (set! screen-height (ref s :height))
      (for-each args load-buffer)
      (when (zero? (:length buffers))
        (new-buffer "*scratch*"))
      (set-cur-buffer! (ref buffers (dec (:length buffers))))
      (while #t
        (scroll-into-view)
        (draw-screen)
        (read-input)))