(module (s9fes char-canvas shape box)

(;export
  ;
  SINGLE-FRAME-DIMS
  make-frame-dims
  ;
  real-shape-box
  ;
  shape-box)

(import scheme utf8)
(import (chicken base))
(import (chicken fixnum))
(import (chicken type))
(import record-variants)
(import (s9fes char-canvas)
        (s9fes char-canvas rect)
        (s9fes char-canvas shape shape))

(include-relative "s9fes.char-canvas.types")
(include-relative "s9fes.char-canvas.inlines")

(include-relative "s9fes.char-canvas.shape.types")
(include-relative "s9fes.char-canvas.shape.inlines")

(: real-shape-box (fixnum fixnum #!optional box-frame-chars -> real-shape-plotter))
(: shape-box (integer integer #!optional box-frame-chars -> shape-plotter))

#| ;show box inset by 1 top bottom left right

;NOTE cannot use box shape! current center makes this dubious for even & odd
;sized camvases - off-by-one issues

(: canvas-frame-chars (canvas #!optional box-frame-chars pad-dims -> void))
(: canvas-frame (canvas #!optional box-frame-chars pad-dims -> void))
|#

;;

(define (1d-dims? dims)
  (and (= 1 (%dims-top dims)) (= 1 (%dims-bottom dims))
       (= 1 (%dims-left dims)) (= 1 (%dims-right dims))) )

(define (*canvas-draw-1d-box cv rgn frm)

  ;corners
  (canvas-draw cv (%rect-x rgn) (%rect-y rgn) (%frame-bl frm))          ;bottom-left
  (canvas-draw cv (%rect-x-max rgn) (%rect-y rgn) (%frame-br frm))      ;bottom-right
  (canvas-draw cv (%rect-x rgn) (%rect-y-max rgn) (%frame-tl frm))      ;top-left
  (canvas-draw cv (%rect-x-max rgn) (%rect-y-max rgn) (%frame-tr frm))  ;top-right

  ;straights
  (canvas-draw-line cv (fx+ (%rect-x rgn) 1) (%rect-y rgn)          ;bottom
                       (fx- (%rect-x-max rgn) 1) (%rect-y rgn)
                       (%frame-bh frm))
  (canvas-draw-line cv (fx+ (%rect-x rgn) 1) (%rect-y-max rgn)      ;top
                       (fx- (%rect-x-max rgn) 1) (%rect-y-max rgn)
                       (%frame-th frm))
  (canvas-draw-line cv (%rect-x rgn) (fx+ (%rect-y rgn) 1)          ;left
                       (%rect-x rgn) (fx- (%rect-y-max rgn) 1)
                       (%frame-lv frm))
  (canvas-draw-line cv (%rect-x-max rgn) (fx+ (%rect-y rgn) 1)      ;right
                       (%rect-x-max rgn) (fx- (%rect-y-max rgn) 1)
                       (%frame-rv frm))

  ;std shape return
  cv )

(define (*canvas-draw-frame cv rgn frm dims)
  ;FIXME
  (*canvas-draw-1d-box cv rgn frm)

  ;flood corners
  ;bottom-left rect
  ;bottom-right rect
  ;top-left rect
  ;top-right rect

  ;flood straights
  ;bottom rect
  ;top rect
  ;left rect
  ;right rect

  ;std shape return
  cv )

;;

(define SINGLE-FRAME-DIMS (%make-dims 1 1 1 1))

(define (make-frame-dims t b l r) (%make-dims t b l r))

;FIXME box walls need a tblr thickness

(define (real-shape-box w h #!optional (frm ASCII-FRAME-CHARS) (frm-dims SINGLE-FRAME-DIMS))
  (assert (and (fixnum? w) (fixnum? h)) 'real-shape-box "bad argument type - not fixnums"  w h)
  (assert (%pad-dims? frm-dims) 'real-shape-box "bad argument type - not pad-dims" frm-dims)
  (assert (frame-chars? frm) 'real-shape-box "bad argument type - not frame-chars" frm)
  (if (1d-dims? frm-dims)
      (lambda (#!optional cv (x0 (fx/ w 2)) (y0 (fx/ h 2)))
        (if cv
            (*canvas-draw-1d-box cv (%rect x0 y0 w h) frm)
            (^real-info box w h frm frm-dims) ) )
      (lambda (#!optional cv (x0 (fx/ w 2)) (y0 (fx/ h 2)))
        (if cv
            (*canvas-draw-frame cv (%rect x0 y0 w h) frm frm-dims)
            (^real-info box w h frm frm-dims) ) ) ) )

(define (shape-box w h #!optional (frm ASCII-FRAME-CHARS) (frm-dims SINGLE-FRAME-DIMS))
  (assert (and (exact-integer? w) (fixnum? h)) 'shape-box "bad argument type - not exact-integers"  w h)
  (assert (%pad-dims? frm-dims) 'shape-box "bad argument type - not pad-dims" frm-dims)
  (assert (frame-chars? frm) 'shape-box "bad argument type - not frame-chars" frm)
  (if (1d-dims? frm-dims)
      (lambda (#!optional cv (x0 (round (/ w 2))) (y0 (round (/ h 2))))
        (if cv
            (*canvas-draw-1d-box cv (%rect-real cv (%rect x0 y0 w h)) frm)
            (^virtual-info box w h frm frm-dims) ) )
      (lambda (#!optional cv (x0 (round (/ w 2))) (y0 (round (/ h 2))))
        (if cv
            (*canvas-draw-frame cv (%rect-real cv (%rect x0 y0 w h)) frm frm-dims)
            (^virtual-info box w h frm frm-dims) ) ) ) )

;;

(register-shape-method 'box 'size wh-class-shape-size)

) ;module (s9fes char-canvas shape box)