;; Issues
;;
;; - Rename *-drawer => *-draw & *-plotter => *-plot

(module (s9fes char-canvas shape cross)

(;export
  cross-+-drawer cross-x-drawer
  cross-+-plotter cross-x-plotter)

(import scheme utf8)
(import (chicken base))
(import (chicken fixnum))
(import (chicken type))
(import (s9fes char-canvas))

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

(define-type shape-point-drawer (canvas #!optional fixnum fixnum -> void))

(: cross-+-drawer (fixnum #!optional fixnum (or char plotter-configuration) -> shape-point-drawer))
(: cross-x-drawer (fixnum #!optional fixnum (or char plotter-configuration) -> shape-point-drawer))

(define-type shape-point-plotter (canvas #!optional integer integer -> void))

(: cross-+-plotter (integer #!optional integer (or char plotter-configuration) -> shape-point-plotter))
(: cross-x-plotter (integer #!optional integer (or char plotter-configuration) -> shape-point-plotter))

;;

(define (cross-drawer-args loc wd ht cfg)
  (let* ((cfg (validate-plotter-configuration loc cfg 2))
         (mx (fx- wd 1)) (my (fx- ht 1))
         (c1 (car cfg)) (c2 (cadr cfg))
         (wd/2 (fx/ (fx+ wd 1) 2)) (ht/2 (fx/ (fx+ ht 1) 2))
         (xm0 (fx+ wd/2 -1)) (ym0 (fx+ ht/2 -1)) )
    (values c1 c2 mx my xm0 ym0) ) )

(define (cross-+-drawer wd #!optional (ht wd) (cfg (current-plotter-char)))
  (receive (c1 c2 mx my xm0 ym0) (cross-drawer-args 'cross-+-drawer wd ht cfg)
    (lambda (cv #!optional (xm xm0) (ym ym0))
      (let ((x0 (fx- xm xm0)) (y0 (fx- ym ym0)))
        (when c1 (canvas-draw-line cv x0 ym (fx+ x0 mx) ym c1))
        (when c2 (canvas-draw-line cv xm (fx+ y0 my) xm y0 c2)) ) ) ) )

(define (cross-x-drawer wd #!optional (ht wd) (cfg (current-plotter-char)))
  (receive (c1 c2 mx my xm0 ym0) (cross-drawer-args 'cross-+-drawer wd ht cfg)
    (lambda (cv #!optional (xm xm0) (ym ym0))
      (let* ((x0 (fx- xm xm0)) (y0 (fx- ym ym0))
             (x1 (fx+ x0 mx)) (y1 (fx+ y0 my)) )
        (when c1 (canvas-draw-line cv x0 y1 x1 y0 c1))
        (when c2 (canvas-draw-line cv x0 y0 x1 y1 c2)) ) ) ) )

;;

(define (cross-plotter-args loc wd ht cfg)
  (let ((xm0 (+ (round (/ wd 2)) -1)) (ym0 (+ (round (/ ht 2)) -1)))
    (values xm0 ym0)) )

(define (cross-+-plotter wd #!optional (ht wd) (cfg (current-plotter-char)))
  (receive (xm0 ym0) (cross-plotter-args 'cross-+-plotter wd ht cfg)
    ;wait until have a canvas
    (let ((pwd (the (or false fixnum) #f)) (pht (the (or false fixnum) #f))
          (drawer (the (or false procedure) #f)) )
      (lambda (cv #!optional (xm xm0) (ym ym0))
        (unless drawer
          (set!-values (pwd pht) (canvas-physical cv wd ht))
          (set! drawer (cross-+-drawer pwd pht cfg)) )
        (receive (pxm0 pym0) (canvas-physical cv xm0 ym0)
          (drawer cv pxm0 pym0)) ) ) ) )

(define (cross-x-plotter wd #!optional (ht wd) (cfg (current-plotter-char)))
  (receive (xm0 ym0) (cross-plotter-args 'cross-x-plotter wd ht cfg)
    ;wait until have a canvas
    (let ((pwd (the (or false fixnum) #f)) (pht (the (or false fixnum) #f))
          (drawer (the (or false procedure) #f)) )
      (lambda (cv #!optional (xm xm0) (ym ym0))
        (unless drawer
          (set!-values (pwd pht) (canvas-physical cv wd ht))
          (set! drawer (cross-x-drawer pwd pht cfg)) )
        (receive (pxm0 pym0) (canvas-physical cv xm0 ym0)
          (drawer cv pxm0 pym0)) ) ) ) )

) ;module (s9fes char-canvas shape cross)