Ben / Nujel

;;; Nujel - Copyright (C) 2020-2021 - Benjamin Vincent Schulenburg
;;; This project uses the MIT license, a copy should be included under /LICENSE
;;;

(def fg-colors { :default "\e[0m"

                 :black "\e[30m"
                 :red "\e[31m"
                 :green "\e[32m"
                 :yellow "\e[33m"
                 :blue "\e[34m"

                 :pink "\e[35m"
                 :magenta "\e[35m"
                 :purple "\e[35m"

                 :cyan "\e[36m"
                 :teal "\e[36m"

                 :white "\e[37m"})

(def bg-colors { :default "\e[49m"

                 :black "\e[40m"
                 :red "\e[41m"
                 :green "\e[42m"
                 :yellow "\e[43m"
                 :blue "\e[44m"

                 :pink "\e[45m"
                 :magenta "\e[45m"
                 :purple "\e[45m"

                 :cyan "\e[46m"
                 :teal "\e[46m"

                 :white "\e[47m"})

(def fg-codes [ 30 31 32 33 34 35 36 37
                0  0  0  0  0  0  0  0 ])

(def bg-codes [ 40 41 42 43 44 45 46 47
                49 49 49 49 49 49 49 49 ])

(defclass VT100
  "A buffered terminal connection"
  :export

  (defn new (self out in)
        (when-not in (set! in (:new InputPort stdin*)))
        (when-not out (set! out (:new OutputPort stdout*)))
        (:raw! in)
        { :in-port in
          :out-port out
          :buf-port (:new StringOutputPort)
          :prototype* self })

  (defn flip (self)
        (def s (:return-string self.buf-port))
        (:position! self.buf-port 0)
        (:block-write self.out-port s)
        (:flush-output self.out-port))

  (defn put-char (self char)
        (:char-write self.buf-port char))

  (defn put-string (self text)
        (:block-write self.buf-port text))

  (defn clear-screen (self)
        (:block-write self.buf-port "\e[2J"))

  (defn clear-line (self)
        (:block-write self.buf-port "\e[2K"))

  (defn hide-cursor (self)
        (:block-write self.buf-port "\e[?25l"))

  (defn show-cursor (self)
        (:block-write self.buf-port "\e[?25h"))

  (defn start (self)
        (:block-write self.buf-port "\e[?1049h")
        (:flip self))

  (defn stop (self)
        (:block-write self.buf-port "\e[?1049l")
        (:flip self))

  (defn move-cursor (self column line)
        (:block-write self.buf-port (fmt "\e[{line};{column}H")))

  (defn set-color-code (self color-code)
        (def fg (ref fg-codes (bit-shift-right color-code 4)))
        (def bg (ref bg-codes (bit-and color-code #xF)))
        (:block-write self.buf-port (fmt "\e[{fg}m\e[{bg}m")))

  (defn set-fg-color (self color-name)
        (def v (ref fg-colors color-name))
        (when-not v (exception "Unknown color" color-name))
        (:block-write self.buf-port v))

  (defn set-bg-color (self color-name)
        (def v (ref bg-colors color-name))
        (when-not v (exception "Unknown color" color-name))
        (:block-write self.buf-port v))

  (defn set-color (self fg-color-name bg-color-name)
        (when fg-color-name (:set-fg-color self fg-color-name))
        (when bg-color-name (:set-bg-color self bg-color-name)))

  (defn get-size (self)
        :export
        (:block-write self.out-port "\e 7")
        (:block-write self.out-port "\e[9999;9999H")
        (:block-write self.out-port "\e[6n")
        (:flush-output self.out-port)
        (def buf (buffer/allocate 128))
        (def i 0)
        (while #t
          (def c (:char-read self.in-port))
          (when (= c #\R)
            (:block-write self.out-port "\e 8")
            (def s (split (cut (buffer->string buf i) 2) ";"))
            (return { :width (read/int (cadr s))
                      :height (read/int (car s))}))
          (set! buf i c)
          (inc! i)))

  (defn get-width (self)
        (ref (:get-size self) :width))

  (defn get-height (self)
        (ref (:get-size self) :height))

  (defn input-would-block? (self)
        (zero? (:length self.in-port)))

  (defn input-left (self)
        (:length self.in-port))

  (defn poll-input (self)
        (def c (:char-read self.in-port))
        (if (= c :end-of-file) 0 c)))