Ben / Nujel

(import (Term) :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 term (:new Term))
(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 term :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 term 1 (dec screen-height))
      (:set-color term :yellow :blue)
      (def colored-modeline (cat " " (pad-end (get-modeline buf) (dec screen-width))))
      (:put-string term colored-modeline)
      (:set-color term :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 term-x term-y)
      (:clear-line term)
      (when (= line-y (ref buf :pos-y))
        (:set-color term :yellow :blue))
      (def ln (fmt " {:4} " (inc line-y)))
      (:put-string term ln)
      (:set-color term :default)
      (:move-cursor term (+ 1 (:length ln) term-x) term-y)
      (def max-w (- term-w 7))
      (when (>= (:length line) max-w)
        (set! line (:clone (:cut (buffer->string line) 0 max-w))))
      (:put-string term 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 term)
      (draw-buffer cur-buffer 1 1 screen-width (- screen-height 2))
      (:show-cursor term)
      (:move-cursor term (+ 1 1 6 (ref cur-buffer :pos-x)) (- (inc (ref cur-buffer :pos-y))
                                                              (ref cur-buffer :scroll-y)))
      (:flip term))

(defn quit ()
      (:stop term)
      (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 term 0 y)
               (:clear-line term)))

(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 term))
      (case c
            (#\A (dirty-buf!) (previous-line))
            (#\B (dirty-buf!) (next-line))
            (#\C (forward-char))
            (#\D (backward-char))))

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

(defn read-cx-input ()
      (def c (:poll-input term))
      (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 term))
      (set! last-char c)
      (case c
            (#x1B (read-escaped-input))
            (#x01 (beginning-of-line))
            (#x02 (backward-char))
            (#x05 (end-of-line)) C-e
            (#x06 (forward-char)) ; C-f
            (#x10 (dirty-buf!) (previous-line)) ; C-p
            (#x0E (dirty-buf!) (next-line)) ; C-n
            (#x18 (read-cx-input)) ; C-x
            (#x7E (dirty-buf!) (delete-forward-char))
            (#x7F (dirty-buf!) (backward-delete-char))
            (#x0D (dirty-buf!) (insert-newline))
            (otherwise (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") :clone)))))

(defn main (args)
      :export
      (:start term)
      (:clear-screen term)
      (def s (:get-size term))
      (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)))