application/octet-stream
•
10.39 KB
•
309 lines
;;; Nujel - Copyright (C) 2020-2021 - Benjamin Vincent Schulenburg
;;; This project uses the MIT license, a copy should be included under /LICENSE
;;;
(defclass TermAppHorizontalSplit
:export
(defn new (self parent top-child bottom-child)
(def s (:get-size parent))
(def ret { :parent parent
:width s.width
:height s.height
:top-child top-child
:bottom-child bottom-child
:bottom-child-focus? #f
:bottom-child-active? #f
:split-pos (div/int s.height 2)
:prototype* self })
(:set-parent! top-child ret)
(:set-parent! bottom-child ret)
(:clear-screen ret)
ret)
(defn child-offset (self)
(if self.bottom-child-active?
self.split-pos
0))
(defn windmove-left (self)
(:windmove-left self.parent))
(defn windmove-right (self)
(:windmove-right self.parent))
(defn windmove-up (self)
(if self.bottom-child-focus?
(do (set! self.bottom-child-focus? #f)
(:handle-event self.bottom-child {:T :blur})
(:handle-event self.top-child {:T :focus}))
(:windmove-up self.parent)))
(defn windmove-down (self)
(if self.bottom-child-focus?
(:windmove-down self.parent)
(do (set! self.bottom-child-focus? #t)
(:handle-event self.top-child {:T :blur})
(:handle-event self.bottom-child {:T :focus}))))
(defn child-height (self)
(if self.bottom-child-active?
(- self.height self.split-pos)
(inc self.split-pos)))
(defn split-window-right (self new-child)
(def new (:new TermAppVerticalSplit
self
(:active-child self)
new-child))
(if self.bottom-child-active?
(set! self.bottom-child new)
(set! self.top-child new))
(:handle-event new {:T :resize :width self.width :height (:child-height self)}))
(defn split-window-below (self new-child)
(def new (:new TermAppHorizontalSplit
self
(:active-child self)
new-child))
(if self.bottom-child-active?
(set! self.bottom-child new)
(set! self.top-child new))
(:handle-event new {:T :resize :width self.width :height (:child-height self)}))
(defn run (self child)
(if self.bottom-child-active?
(set! self.bottom-child child)
(set! self.top-child child))
(:handle-event child {:T :resize :width self.width :height (:child-height self)})
(:handle-event child {:T :focus})
(:handle-event child {:T :draw}))
(defn active-child (self)
(if self.bottom-child-active?
self.bottom-child
self.top-child))
(defn inactive-child (self)
(if self.bottom-child-active?
self.top-child
self.bottom-child))
(defn stop (self)
(def child (:inactive-child self))
(:handle-event child {:T :reparent :parent self.parent})
(:run self.parent child))
(defn quit (self)
(:quit self.parent))
(defn flip (self) (:flip self.parent))
(defn draw-char (self char x y color)
(when (or (>= x self.width)
(>= y (:child-height self))
(< x 0)
(< y 0))
(return))
(:draw-char self.parent char x (+ (:child-offset self) y) color))
(defn set-cursor (self x y)
(when (= self.bottom-child-active? self.bottom-child-focus?)
(def child-offset (if self.bottom-child-active?
self.split-pos
0))
(:set-cursor self.parent x (+ y child-offset))))
(defn draw-text (self text x y w h color)
(set! x (max 0 x))
(set! y (max 0 y))
(set! w (min (- self.width x) w))
(set! h (min (- (:child-height self) y) (- h 1)))
(:draw-text self.parent text x (+ y (:child-offset self)) w h color))
(defn set-parent! (self parent)
(set! self.parent parent))
(defn clear-screen (self)
(:clear-screen self.parent))
(defn handle-event (self event)
(when (= :resize event.T)
(set! self.width event.width)
(set! self.height event.height)
(set! self.bottom-child-active? #f)
(:handle-event self.top-child {:T :resize :width self.width :height (:child-height self)})
(set! self.bottom-child-active? #t)
(:handle-event self.bottom-child {:T :resize :width self.width :height (:child-height self)})
(return))
(when (= :reparent event.T)
(set! self.parent event.parent)
(return))
(when (= :draw event.T)
(set! self.bottom-child-active? #f)
(:handle-event self.top-child event)
(set! self.bottom-child-active? #t)
(:handle-event self.bottom-child event)
(return))
(set! self.bottom-child-active? self.bottom-child-focus?)
(:handle-event (:active-child self) event))
(defn get-size (self)
{ :width self.width
:height (:child-height self) }))
(defclass TermAppVerticalSplit
:export
(defn new (self parent left-child right-child)
(def s (:get-size parent))
(def ret { :parent parent
:width s.width
:height s.height
:left-child left-child
:right-child right-child
:right-child-focus? #f
:right-child-active? #f
:split-pos (div/int s.width 2)
:prototype* self })
(:set-parent! left-child ret)
(:set-parent! right-child ret)
(:clear-screen ret)
ret)
(defn child-offset (self)
(if self.right-child-active?
self.split-pos
0))
(defn windmove-up (self)
(:windmove-up self.parent))
(defn windmove-down (self)
(:windmove-down self.parent))
(defn windmove-left (self)
(if self.right-child-focus?
(do (set! self.right-child-focus? #f)
(:handle-event self.right-child {:T :blur})
(:handle-event self.left-child {:T :focus}))
(:windmove-left self.parent)))
(defn windmove-right (self)
(if self.right-child-focus?
(:windmove-right self.parent)
(do (set! self.right-child-focus? #t)
(:handle-event self.left-child {:T :blur})
(:handle-event self.right-child {:T :focus}))))
(defn child-width (self)
(if self.right-child-active?
(- self.width self.split-pos)
(inc self.split-pos)))
(defn split-window-right (self new-child)
(def new (:new TermAppVerticalSplit
self
(:active-child self)
new-child))
(if self.right-child-active?
(set! self.right-child new)
(set! self.left-child new))
(:handle-event new {:T :resize :width (:child-width self) :height self.height}))
(defn split-window-below (self new-child)
(def new (:new TermAppHorizontalSplit
self
(:active-child self)
new-child))
(if self.right-child-active?
(set! self.right-child new)
(set! self.left-child new))
(:handle-event new {:T :resize :width (:child-width self) :height self.height}))
(defn run (self child)
(if self.right-child-active?
(set! self.right-child child)
(set! self.left-child child))
(:handle-event child {:T :resize :width (:child-width self) :height self.height})
(:handle-event child {:T :focus})
(:handle-event child {:T :draw}))
(defn active-child (self)
(if self.right-child-active?
self.right-child
self.left-child))
(defn inactive-child (self)
(if self.right-child-active?
self.left-child
self.right-child))
(defn stop (self)
(def child (:inactive-child self))
(:handle-event child {:T :reparent :parent self.parent})
(:run self.parent child))
(defn quit (self)
(:quit self.parent))
(defn flip (self) (:flip self.parent))
(defn draw-char (self char x y color)
(when (or (>= x (:child-width self))
(>= y self.height)
(< x 0)
(< y 0))
(return))
(:draw-char self.parent char (+ (:child-offset self) x) y color))
(defn set-cursor (self x y)
(when (= self.right-child-active? self.right-child-focus?)
(def child-offset (if self.right-child-active?
self.split-pos
0))
(:set-cursor self.parent (+ x child-offset) y)))
(defn draw-text (self text x y w h color)
(set! x (max 0 x))
(set! y (max 0 y))
(set! w (min (- (:child-width self) x) w))
(set! h (min (- self.height y) (- h 1)))
(:draw-text self.parent text (+ x (:child-offset self)) y w h color))
(defn set-parent! (self parent)
(set! self.parent parent))
(defn clear-screen (self)
(:clear-screen self.parent))
(defn handle-event (self event)
(when (= :resize event.T)
(set! self.width event.width)
(set! self.height event.height)
(set! self.right-child-active? #f)
(:handle-event self.left-child {:T :resize :width (:child-width self) :height self.height})
(set! self.right-child-active? #t)
(:handle-event self.right-child {:T :resize :width (:child-width self) :height self.height})
(return))
(when (= :reparent event.T)
(set! self.parent event.parent)
(return))
(when (= :draw event.T)
(set! self.right-child-active? #f)
(:handle-event self.left-child event)
(set! self.right-child-active? #t)
(:handle-event self.right-child event)
(return))
(set! self.right-child-active? self.right-child-focus?)
(:handle-event (:active-child self) event))
(defn get-size (self)
(def child-width )
{ :width (:child-width self)
:height self.height }))
