application/octet-stream
•
6.91 KB
•
198 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 clipboard "")
(def scroll-interval 8)
(def cx-active #f)
(def cx-key-down-handler {})
(def key-down-handler {})
(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))
(fmt " L{y}:{x} - {ll}:{id} - {bufname}"))
(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 handle-key-down (key)
(def handler (ref (if cx-active cx-key-down-handler key-down-handler) key))
(set! cx-active #f)
(when handler (handler cur-buffer)))
(defn kill-region ()
(set! clipboard (:get-region cur-buffer))
(:delete-region cur-buffer))
(defn kill-ring-save ()
(set! clipboard (:get-region cur-buffer))
(:keyboard-quit cur-buffer))
(defn read-input ()
(:poll-input term)
(def e (:get-events term))
(when e
(case e.T
(:key-down (handle-key-down e.key))
(:input (if cx-active
(handle-key-down (:keyword e.char))
(:insert-char cur-buffer e.code))))))
(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 add-default-keys ()
(set! key-down-handler :C-x (fn () (set! cx-active #t)))
(set! key-down-handler :C-spc :set-mark-command)
(set! key-down-handler :C-a :start-of-line)
(set! key-down-handler :C-b :backward-char)
(set! key-down-handler :C-e :end-of-line)
(set! key-down-handler :C-f :forward-char)
(set! key-down-handler :C-g :keyboard-quit)
(set! key-down-handler :C-k kill-line)
(set! key-down-handler :C-p :previous-line)
(set! key-down-handler :C-n :next-line)
(set! key-down-handler :C-y yank)
(set! key-down-handler :C-w kill-region)
(set! key-down-handler :M-w kill-ring-save)
(set! key-down-handler :M-< :beginning-of-buffer)
(set! key-down-handler :M-> :end-of-buffer)
(set! key-down-handler :left :backward-char)
(set! key-down-handler :right :forward-char)
(set! key-down-handler :up :previous-line)
(set! key-down-handler :down :next-line)
(set! key-down-handler :home :start-of-line)
(set! key-down-handler :end :end-of-line)
(set! key-down-handler :page-up :scroll-down-command)
(set! key-down-handler :page-down :scroll-up-command)
(set! key-down-handler :backspace :backward-delete-char)
(set! key-down-handler :delete :delete-forward-char)
(set! key-down-handler :insert yank)
(set! key-down-handler :ret :insert-newline)
(set! cx-key-down-handler :h :mark-whole-buffer)
(set! cx-key-down-handler :C-c quit))
(defn main (args)
:export
(add-default-keys)
(: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)))
