Ben / Nujel

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

(defclass TermIO
  "An high-level abstract I/O interface towards a terminal"
  :export

  (defn new (self in out)
        (def term (:new Term in out))
        (:start term)
        (def ret { :term term
                   :width 0
                   :height 0
                   :frontbuffer #nil
                   :backbuffer #nil
                   :cursor-x -1
                   :cursor-y -1
                   :prototype* self })
        (:resize ret))

  (defn start (self)
        #t)

  (defn stop (self)
        (:stop (ref self :term)))

  (defn resize (self)
        (def term (ref self :term))
        (def size (:get-size term))
        (def buf-size (* 2 (ref size :width) (ref size :height)))
        (set! self :width (ref size :width))
        (set! self :height (ref size :height))
        (set! self :frontbuffer (buffer/allocate buf-size))
        (set! self :backbuffer (buffer/allocate buf-size)))

  (defn flip (self)
        (def backbuffer (ref self :backbuffer))
        (def frontbuffer (ref self :frontbuffer))
        (def term (ref self :term))
        (:hide-cursor term)
        (def last-color -1)
        (def pos-x -1)
        (def pos-y -1)
        (dotimes (y (ref self :height))
                 (dotimes (x (ref self :width))
                          (def off (* 2 (+ x (* y (ref self :width)))))
                          (def bc  (+ (ref backbuffer off)
                                      (bit-shift-left (ref backbuffer (inc off)) 8)))
                          (def fc  (+ (ref frontbuffer off)
                                      (bit-shift-left (ref frontbuffer (inc off)) 8)))
                          (when (not= fc bc)
                            (when (or (not= x pos-x)
                                      (not= y pos-y))
                              (:move-cursor term x y))
                            (set! pos-y y)
                            (set! pos-x (inc x))
                            (when (not= (bit-shift-right bc 8) last-color)
                              (:set-color-code term (bit-shift-right bc 8))
                              (set! last-color (bit-shift-right bc 8)))
                            (:put-char term (bit-and #xFF bc))
                            (set! frontbuffer off (bit-and bc #xFF))
                            (set! frontbuffer (inc off) (bit-shift-right bc 8)))))
        (when (and (> (ref self :cursor-x) 0)
                   (> (ref self :cursor-y) 0)
                   (< (ref self :cursor-x) (ref self :width))
                   (< (ref self :cursor-y) (ref self :height)))
          (:move-cursor term (ref self :cursor-x) (ref self :cursor-y))
          (:show-cursor term))
        (:flip (ref self :term)))

  (defn draw-char (self char x y color)
        (when (>= x (ref self :width)) (return))
        (when (>= y (ref self :height)) (return))
        (when (< x 0) (return))
        (when (< y 0) (return))
        (def off (* 2 (+ x (* y (ref self :width)))))
        (def color color)
        (set! (ref self :backbuffer) off char)
        (set! (ref self :backbuffer) (inc off) color))

  (defn set-cursor (self x y)
       (set! self :cursor-x x)
       (set! self :cursor-y y))

  (defn clear-screen (self)
        (def bb (ref self :backbuffer))
        (dotimes (i (:length bb))
                 (set! bb i 0)))

  (defn draw-text (self text x y w h color)
        (set! x (max 0 x))
        (set! y (max 0 y))
        (set! w (min (- (ref self :width) x) w (:length text)))
        (set! h (min (- (ref self :height) y) h))
        (def off (* 2 (+ x (* y (ref self :width)))))
        (def bb (ref self :backbuffer))
        (dotimes (i w)
                 (set! bb off (ref text i))
                 (set! bb (inc off) color)
                 (set! off (+ off 2))))

  (defn get-size (self)
        { :width (ref self :width)
          :height (ref self :height) })

  (defn poll-input (self)
        (:poll-input (ref self :term))))