;; Canvas

;; Config

(define-inline (%plt-cfg ls) (apply vector ls))
(define-inline (%make-plt-cfg n v) (make-vector n v))
(define-inline (%plt-cfg-cnt v) (vector-length v))
(define-inline (%plt-cfg-c n pc) (vector-ref pc n))
(define-inline (%plt-cfg-char? x) (or (not x) (char? x)))

(define-inline (%make-frame-chars thc bhc lvc rvc tlc trc blc brc) (vector thc bhc lvc rvc tlc trc blc brc))
(define-inline (%frame-th f) (vector-ref f 0))
(define-inline (%frame-bh f) (vector-ref f 1))
(define-inline (%frame-lv f) (vector-ref f 2))
(define-inline (%frame-rv f) (vector-ref f 3))
(define-inline (%frame-tl f) (vector-ref f 4))
(define-inline (%frame-tr f) (vector-ref f 5))
(define-inline (%frame-bl f) (vector-ref f 6))
(define-inline (%frame-br f) (vector-ref f 7))

(define-inline (%frame-chars? obj)
  (and (vector? obj) (= 8 (vector-length obj))
       (char? (%frame-th obj))
       (char? (%frame-bh obj))
       (char? (%frame-lv obj))
       (char? (%frame-rv obj))
       (char? (%frame-tl obj))
       (char? (%frame-tr obj))
       (char? (%frame-bl obj))
       (char? (%frame-br obj))) )

;; Region

;; rect < vector

(define-inline (%rect x y w h) (vector x y w h))

(define-inline (%rect! rt x y w h)
  (vector-set! rt 0 x)
  (vector-set! rt 0 y)
  (vector-set! rt 0 w)
  (vector-set! rt 0 h)
  ;unusual for side-effecting
  rt )

(define-inline (%rect-null) (vector 0 0 0 0))

(define-inline (%rect-c? obj)
  (and (integer? (vector-ref obj 0))
       (integer? (vector-ref obj 1))
       (integer? (vector-ref obj 2))
       (integer? (vector-ref obj 3))) )
(define-inline (%rect-s? obj)
  (and (vector? obj)
       (fx<= 4 (vector-length obj))) )
(define-inline (%rect? obj) (and (%rect-s? obj) (%rect-c? obj)))

(define-inline (%rect-x rt) (vector-ref rt 0))
(define-inline (%rect-y rt) (vector-ref rt 1))
(define-inline (%rect-wd rt) (vector-ref rt 2))
(define-inline (%rect-ht rt) (vector-ref rt 3))

(define-inline (%rect-null? rt) (or (zero? (%rect-wd rt)) (zero? (%rect-ht rt))))

(define-inline (%rect-x-end rt) (+ (%rect-x rt) (%rect-wd rt)))
(define-inline (%rect-y-end rt) (+ (%rect-y rt) (%rect-ht rt)))

(define-inline (%rect-x-min rt) (%rect-x rt))
(define-inline (%rect-y-min rt) (%rect-y rt))
(define-inline (%rect-x-max rt) (- (%rect-x-end rt) 1))
(define-inline (%rect-y-max rt) (- (%rect-y-end rt) 1))

(define-inline (%rect-area rt) (* (%rect-wd rt) (%rect-ht rt)))

(define-inline (%rect-overlaps? rt1 rt2)
  (and (<= (%rect-x rt1) (%rect-x-end rt2))
       (<= (%rect-x rt2) (%rect-x-end rt1))
       (<= (%rect-y rt1) (%rect-y-end rt2))
       (<= (%rect-y rt2) (%rect-y-end rt1))) )

;@ in ctor arg order; *rect
(define-inline (%rect->list rt)
  (list (%rect-x rt) (%rect-y rt) (%rect-wd rt) (%rect-ht rt)) )
(define-inline (%list->rect ls)
  (%rect (car ls) (cadr ls) (caddr ls) (cadddr ls)) )

(define-inline (%rect->vector rt)
  (vector (%rect-x rt) (%rect-y rt) (%rect-wd rt) (%rect-ht rt)) )
(define-inline (%vector->rect vc)
  (%rect (vector-ref vc 0) (vector-ref vc 1) (vector-ref vc 2) (vector-ref vc 3)) )

(define-inline (%rect-spot rt) (values (%rect-x rt) (%rect-y rt)))
(define-inline (%rect-size rt) (values (%rect-wd rt) (%rect-ht rt)))

;; char-rect < rect

(define-inline (%char-rect-c? obj)
  (and (fixnum? (vector-ref obj 0))
       (fixnum? (vector-ref obj 1))
       (fixnum? (vector-ref obj 2))
       (fixnum? (vector-ref obj 3))) )
(define-inline (%char-rect-s? obj)
  (and (vector? obj)
       (fx<= 4 (vector-length obj))) )
(define-inline (%char-rect? obj) (and (%char-rect-s? obj) (%char-rect-c? obj)))

#| ;NO - (struct 'wndw canvas rect) & (struct 'char-wndw canvas char-rect)
;; wndw < rect

(define-inline (%wndw cv x y w h) (vector x y w h cv))

(define-inline (%wndw/rect cv rect)
  (%wndw cv (%rect-x rect) (%rect-y rect)
            (%rect-wd rect) (%rect-ht rect)) )

(define-inline (%wndw-c? obj)
  (and (%rect-c? obj)
       (canvas? (vector-ref obj 4))) )
(define-inline (%wndw-s? obj)
  (and (%rect-s? obj)
       (fx<= 5 (vector-length obj))) )
(define-inline (%wndw? obj) (and (%wndw-s? obj) (%wndw-c? obj)))

(define-inline (%wndw-canvas cwin) (vector-ref cwin 4))

;@ in ctor arg order; *wndw
(define-inline (%wndw->list cwin)
  (list (%wndw-canvas cwin)
        (%rect-x cwin) (%rect-y cwin)
        (%rect-wd cwin) (%rect-ht cwin)) )

;; char-wndw < wndw( char-canvas char-rect )

(define-inline (%char-wndw-c? obj)
  (and (%char-rect-c? obj)
       (%char-canvas? (vector-ref obj 4))) )
(define-inline (%char-wndw-s? obj)
  (and (%char-rect-s? obj)
       (fx<= 5 (vector-length obj))) )
(define-inline (%char-wndw? obj) (and (%char-wndw-s? obj) (%char-wndw-c? obj)))
|#

;;;

;A `cmap' is in reverse visual order. The visually top row is stored last in
;buffer. As such the sequence does not to be reversed.
(define-inline (%make-cmap wd ht c) (make-vector (fx* wd ht) c))

;NOTE cannot export from `s9fes.char-canvas' since char-canvas uses .rect
(define-constant char-canvas 's9fes.char-canvas#char-canvas)
(define-record-type-variant char-canvas (unchecked inline unsafe)
  (%make-char-canvas width height cmap)
  %char-canvas?
  (width %char-canvas-columns) ;fixnum
  (height %char-canvas-rows)   ;fixnum
  (cmap %char-canvas-cmap %set-char-canvas-cmap!))

(define (%make-char-canvas* wd ht c)
  (let ((cmap (if (not (char? c)) c (%make-cmap wd ht c))))
    (%make-char-canvas wd ht cmap) ) )

;cmap index for x y
(define-inline (%char-canvas-index ccv x y) (fx+ x (fx* y (%char-canvas-columns ccv))))

(define-inline (%char-canvas-xmax ccv) (fx- (%char-canvas-columns ccv) 1))
(define-inline (%char-canvas-ymax ccv) (fx- (%char-canvas-rows ccv) 1))

(define-inline (%char-canvas-aspect ccv)
  (if (fx= 0 (%char-canvas-rows ccv)) 0
      (/ (%char-canvas-columns ccv) (%char-canvas-rows ccv)) ) )

(define-inline (%char-canvas-square? ccv) (fx= 1 (%char-canvas-aspect ccv)))

;NOTE cannot export from `s9fes.char-canvas' since char-canvas uses .rect
(define-constant canvas 's9fes.char-canvas#canvas)
(define-record-type-variant canvas (unchecked inline unsafe)
  (%make-canvas ccv x-scale y-scale)
  %canvas?
  (ccv %canvas-chars)
  (x-scale %canvas-x-scale)
  (y-scale %canvas-y-scale))

(define-inline (%canvas-columns cv) (%char-canvas-columns (%canvas-chars cv)))
(define-inline (%canvas-rows cv) (%char-canvas-rows (%canvas-chars cv)))

(define-inline (%canvas-cmap cv) (%char-canvas-cmap (%canvas-chars cv)))
(define-inline (%set-canvas-cmap! cv cmap) (%set-char-canvas-cmap! (%canvas-chars cv) cmap))

(define (%new-canvas ccv v-wd v-ht)
  (%make-canvas ccv
                (if (zero? v-wd) 0 (/ (%char-canvas-columns ccv) v-wd))
                (if (zero? v-ht) 0 (/ (%char-canvas-rows ccv) v-ht))) )

;NOTE `floor', not `round': could (right) clip

;should check area for 0 before use
(define-inline (%real-x cv x) (floor (* x (%canvas-x-scale cv))))
(define-inline (%real-y cv y) (floor (* y (%canvas-y-scale cv))))

;must check area for 0 before use
(define-inline (%virtual-x cv x) (floor (/ x (%canvas-x-scale cv))))
(define-inline (%virtual-y cv y) (floor (/ y (%canvas-y-scale cv))))

;must be "recovered"
(define-inline (%canvas-width cv) (%virtual-x cv (%canvas-columns cv)))
(define-inline (%canvas-height cv) (%virtual-y cv (%canvas-rows cv)))

;y-scale / x-scale = width / height
(define-inline (%canvas-aspect cv)
  (if (zero? (%canvas-x-scale cv)) 0
      (/ (%canvas-y-scale cv) (%canvas-x-scale cv)) ) )

(define-inline (%canvas-square? cv) (= 1 (%canvas-aspect cv)))

(define-inline (%rect-real cv rgn)
  (%rect (%real-x cv (%rect-x rgn))
         (%real-y cv (%rect-y rgn))
         (%real-x cv (%rect-wd rgn))
         (%real-y cv (%rect-ht rgn))) )

(define-inline (%rect-real/optional cv rgn)
  (and rgn
       (%rect-real cv rgn)) )

(define-inline (%rect-virtual cv rgn)
  (%rect (%virtual-x cv (%rect-x rgn))
         (%virtual-y cv (%rect-y rgn))
         (%virtual-x cv (%rect-wd rgn))
         (%virtual-y cv (%rect-ht rgn))) )

(define-inline (%canvas-real cv x y) (values (%real-x cv x) (%real-y cv y)))
(define-inline (%canvas-virtual cv x y) (values (%virtual-x cv x) (%virtual-y cv y)))

;canvas interaction

(define-inline (%char-canvas-rect ccv)
  (%rect 0 0 (%char-canvas-columns ccv) (%char-canvas-rows ccv)) )

(define-inline (%canvas-rect cv)
  (%rect 0 0 (%canvas-width cv) (%canvas-height cv)) )

#| ;NO - (struct 'wndw canvas rect) & (struct 'char-wndw canvas char-rect)
(define-inline (%canvas->wndw cv) (%wndw/rect cv (%canvas-rect cv)))
(define-inline (%char-canvas->wndw cv) (%wndw/rect cv (%char-canvas-rect cv)))
|#