application/octet-stream
•
7.19 KB
•
210 lines
(import (TermApp) :term/TermApp)
(import (TextBuffer) :app/termed/buffer)
(def term (:new TermApp))
(def buffers [])
(def cur-buffer #nil)
(def screen-width #nil)
(def screen-height #nil)
(def last-char 0)
(def clipboard "")
(def keycodes #nil)
(def scroll-interval 8)
(defn add-keycode (c t)
(set! keycodes (cons (fmt "{t}{c:02X}") keycodes))
(when (> (:length keycodes) 8)
(set! keycodes (except-last-pair keycodes)))
(return c))
(defn poll-key (t)
(add-keycode (:poll-input term) t))
(defn set-cur-buffer! (buf)
(set! scroll-interval (max 4 (int (/ screen-height 3))))
(set! buf :scroll-interval scroll-interval)
(set! cur-buffer buf))
(defn new-buffer (filename)
(def buf (:new TextBuffer filename))
(array/push buffers buf)
buf)
(defn yank () (:insert-text cur-buffer clipboard))
(defn kill-line () (set! clipboard (:kill-line cur-buffer)))
(defn get-modeline (buf)
(def x buf.pos-x)
(def y (inc buf.pos-y))
(def bufname (:get-buf-name buf))
(def saved (if buf.changed "*" ""))
(def ll (:line-length buf buf.pos-y))
(def id (:line-indent-depth buf buf.pos-y))
(def keys (join keycodes " "))
(fmt " L{y}:{x} - {ll}:{id} - {bufname} - ({keys})"))
(defn draw-modeline (buf)
(def colored-modeline (cat " " (pad-end (get-modeline buf) (dec screen-width))))
(:draw-text term colored-modeline 1 (dec screen-height) screen-width 1 #x34))
(defn draw-buffer-line (buf term-x term-y term-w line-y)
(def line (:get-line buf line-y))
(when-not line
(:draw-text term (pad-end "" term-w) term-x term-y term-w 1 #xFF)
(return))
(def gutter-color (if (= line-y buf.pos-y) #x34 #xFF))
(def ln (fmt " {:4} " (inc line-y)))
(:draw-text term ln term-x term-y 6 1 gutter-color)
(def buf-off 0)
(def buf-max (:length line))
(def max-w (min (- buf-max buf-off) (- term-w 5)))
(def mark-start 0)
(def mark-end 0)
(when (:use-region? cur-buffer)
(def rs-y (:region-start-y cur-buffer))
(def re-y (:region-end-y cur-buffer))
(def rs-x (:region-start-x cur-buffer))
(def re-x (:region-end-x cur-buffer))
(when (and (>= line-y rs-y)
(<= line-y re-y))
(set! mark-end max-w)
(when (= line-y rs-y)
(set! mark-start rs-x))
(when (= line-y re-y)
(set! mark-end re-x))))
(def c 0)
(def color 0)
(:draw-char term #x20 (+ 6 term-x) term-y #xFF)
(dotimes (i term-w)
(if (< i max-w)
(do (set! c (ref line (+ i buf-off)))
(set! color (if (and (>= i mark-start)
(< i mark-end)
(not (zero? c)))
#x34 #xFF))
(:draw-char term (if (zero? c) #x20 c) (+ 6 term-x i) term-y color))
(:draw-char term #x20 (+ 6 term-x i) term-y color))))
(defn draw-buffer (buf x y w h)
(dotimes (cy h)
(draw-buffer-line buf x (+ cy y) w (+ cy buf.scroll-y)))
(draw-modeline buf))
(defn draw-screen ()
(def cur-buffer cur-buffer)
(draw-buffer cur-buffer 1 1 screen-width (- screen-height 2))
(:set-cursor term
(+ 1 6 cur-buffer.pos-x)
(- (inc cur-buffer.pos-y)
cur-buffer.scroll-y))
(:flip term))
(defn quit ()
(:stop term)
(exit 0))
(defn clear-frame () #t)
(defn scroll-into-view ()
(def buf cur-buffer)
(def frame-height (- screen-height 3))
(when (< (- buf.pos-y buf.scroll-y) 0)
(clear-frame)
(set! buf.scroll-y (* scroll-interval (int (floor (/ buf.pos-y scroll-interval))))))
(when (> (- buf.pos-y buf.scroll-y) frame-height)
(clear-frame)
(set! buf.scroll-y (* scroll-interval (int (ceil (/ (- buf.pos-y frame-height) scroll-interval))))))
(when (< buf.scroll-y 0)
(set! buf.scroll-y 0)))
(defn read-nav-key (method)
(def c (poll-key "U-"))
(when (= c #x7E)
(if (lambda? method)
(method)
(method cur-buffer))))
(defn read-bracketed-input ()
(def c (poll-key "[-"))
(case c
(#\A (:previous-line cur-buffer))
(#\B (:next-line cur-buffer))
(#\C (:forward-char cur-buffer))
(#\D (:backward-char cur-buffer))
(#x32 (read-nav-key yank))
(#x33 (read-nav-key :delete-forward-char))
(#x35 (read-nav-key :scroll-down-command))
(#x36 (read-nav-key :scroll-up-command))
(#x46 (:end-of-line cur-buffer))
(#x48 (:start-of-line cur-buffer))))
(defn read-escaped-input ()
(def c (poll-key "E-"))
(case c
(#\[ (read-bracketed-input))
(#x3C (:beginning-of-buffer cur-buffer))
(#x3E (:end-of-buffer cur-buffer))
(#x77 (set! clipboard (:get-region cur-buffer)) (:keyboard-quit cur-buffer))
(otherwise (:insert-char cur-buffer #\[))))
(defn read-cx-input ()
(def c (poll-key "C-"))
(case c
(#x68 (:mark-whole-buffer cur-buffer))
(#x03 (quit))))
(defn read-input ()
(def c (poll-key #nil))
(set! last-char c)
(case c
(#x1B (read-escaped-input))
(#x17 (set! clipboard (:get-region cur-buffer)) (:delete-region cur-buffer)) ; C-w
(#x18 (read-cx-input)) ; C-x
(#x19 (yank)) ; C-y
(#x00 (:set-mark-command cur-buffer))
(#x01 (:start-of-line cur-buffer))
(#x02 (:backward-char cur-buffer))
(#x05 (:end-of-line cur-buffer)) ; C-e
(#x06 (:forward-char cur-buffer)) ; C-f
(#x07 (:keyboard-quit cur-buffer)) ; C-g
(#x0B (kill-line)) ; C-k
(#x10 (:previous-line cur-buffer)) ; C-p
(#x0E (:next-line cur-buffer)) ; C-n
(#x7E (:delete-forward-char cur-buffer))
(#x7F (:backward-delete-char cur-buffer))
(#x0D (:insert-newline cur-buffer))
(otherwise (when (and (>= c #x20)
(< c #x80))
(return (:insert-char cur-buffer c))))))
(defn load-buffer (filename)
(def buf (new-buffer filename))
(def text (slurp filename))
(def raw-lines (if text (split text "\n") #nil))
(def lines (:alloc Array (max 1 (:length raw-lines))))
(set! buf :lines lines)
(def i 0)
(doseq (line raw-lines buf)
(def cur-line (buffer/allocate (bit-shift-left (inc (bit-shift-right (:length line) 4)) 4)))
(buffer/copy cur-line line 0 (:length line))
(set! lines i cur-line)
(inc! i)))
(defn main (args)
:export
(:start term)
(:clear-screen term)
(def s (:get-size term))
(set! screen-width s.width)
(set! screen-height 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)))
