(module (s9fes char-canvas shape jpad)

(;export
  ;
  real-shape-jpad
  ;
  shape-jpad)

(import scheme utf8)
(import (chicken base))
(import (chicken fixnum))
(import (chicken type))
(import record-variants)
(import (only (srfi 1) make-list))
(import (s9fes char-canvas)
        (s9fes char-canvas rect)
        (s9fes char-canvas shape shape)
        (s9fes char-canvas shape fpad))

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

(include-relative "s9fes.char-canvas.shape.pad.incl")

(: jpad-center (shape-plotter #!optional integer integer -> integer integer))

(: real-shape-jpad (real-shape-plotter real-pad-dims #!optional pad-chars -> real-shape-plotter))
(: shape-jpad (shape-plotter pad-dims #!optional pad-chars -> shape-plotter))

;; Private

(define (info-shape info) (the shape-plotter (@info 0 info)))
(define (info-pad-dims info) (the (or false pad-dims) (@info 1 info)))
(define (info-pad-chars info) (the pad-chars (@info 2 info)))
(define (info-justified-dims info) (the (or false pad-dims) (@info 3 info)))

(define (jpad-info->fpad info)
  (let* ((shape (info-shape info))
         (justified-dims (info-justified-dims info))
         (pad-dims (or justified-dims (info-pad-dims info)))
         (pad-chars (info-pad-chars info)) )
    (case (@info-coords info)
      ((real) (real-shape-fpad shape pad-dims pad-chars))
      (else   (shape-fpad shape pad-dims pad-chars))) ) )

#|
(define (*jpad-shape-size w h pad-dims)
  ;FIXME
  (let-values (((top bottom left right) (apply values pad-dims)))
    (values (+ left w right) (+ top h bottom)) ) )

(define (*jpad-center w h pad-dims x0 y0)
  ;FIXME
  (if (and x0 y0) (values x0 y0)
      (receive (wd ht) (*jpad-shape-size w h pad-dims)
        (values (round (/ wd 2)) (round (/ ht 2))))) )
|#

(define (*canvas-draw-jpad cv x0 y0 shape pad-dims pad-chars justified-dims)
  ((jpad-info->fpad (^real-info jpad shape pad-dims pad-chars justified-dims)) cv x0 y0) )

(define (*canvas-plot-jpad cv x0 y0 shape pad-dims pad-chars justified-dims)
  ((jpad-info->fpad (^virtual-info jpad shape pad-dims pad-chars justified-dims)) cv x0 y0) )

;; Public

(define (real-shape-jpad shape pad-dims #!optional (pad-chars (%bkgd-pad-chars)))
  (let ((justified-dims #f))
    (lambda (#!optional cv x0 y0)
      (if cv
          (begin
            (*canvas-draw-jpad cv x0 y0 shape pad-dims pad-chars justified-dims)
            cv )
          (^real-info jpad shape pad-dims pad-chars justified-dims) ) ) ) )

;;

(define (shape-jpad shape pad-dims #!optional (pad-chars (%bkgd-pad-chars)))
  (let ((justified-dims #f))
    (lambda (#!optional cv x0 y0)
      (if cv
          (begin
            (*canvas-plot-jpad cv x0 y0 shape pad-dims pad-chars justified-dims)
            cv )
          (^virtual-info jpad shape pad-dims pad-chars justified-dims) ) ) ) )

;;

(define (class-shape-size shp info)
  (shape-size (jpad-info->fpad info)) )

(define (class-shape-layout shp info bb)
  ;FIXME calc & set justified-dims
  (jpad-info->fpad info) )

(register-shape-method 'jpad 'size class-shape-size)
(register-shape-method 'jpad 'cardinality (lambda (shp info) 1))
(register-shape-method 'jpad 'elements (lambda (shp info) `(,(info-shape info))))
(register-shape-method 'jpad 'layout class-shape-layout)
(register-shape-method 'jpad 'justified? (lambda (shp info) (and (info-justified-dims info) #t)))

) ;module (s9fes char-canvas shape jpad)