(module (s9fes char-canvas shape vgroup)

(;export
  ;
  real-shape-vgroup
  ;
  shape-vgroup)

(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")

(: real-shape-vgroup (#!rest real-shape-plotter -> real-shape-plotter))
(: shape-vgroup (#!rest shape-plotter -> shape-plotter))

;; Private

(define (*info-elements info) (the (list-of shape-plotter) (@info 0 info)))

(define (*canvas-draw-vgroup cv x0 y0 shps)
  ;FIXME
  (define (next shp x y) (receive (w h) (shape-size shp) (values x (fx+ y h))))
  (let loop ((shps (reverse shps)) (x x0) (y y0))
    (unless (null? shps)
      (let ((shp (car shps)))
        (shp cv x y)
        (receive (x y) (next shp x y)
          (loop (cdr shps) x y)) ) ) )
  cv )

(define (*canvas-plot-vgroup cv x0 y0 shps)
  ;FIXME
  (define (next shp x y) (receive (w h) (shape-size shp) (values x (+ y h))))
  (let loop ((shps (reverse shps)) (x x0) (y y0))
    (unless (null? shps)
      (let ((shp (car shps)))
        (shp cv x y)
        (receive (x y) (next shp x y)
          (loop (cdr shps) x y)) ) ) )
  cv )

;; Public

(define ((real-shape-vgroup #!rest shps) #!optional cv x0 y0)
  (if cv
      (begin
        (*canvas-draw-vgroup cv x0 y0 shps)
        cv )
      (^real-info vgroup shps) ) )

;;

(define ((shape-vgroup #!rest shps) #!optional cv x0 y0)
  (if cv
      (begin
        (*canvas-plot-vgroup cv 0 y0 shps)
        cv )
      (^virtual-info vgroup shps) ) )

;;

(define (class-shape-size shp info)
  (let* ((shps (*info-elements info))
         (sizs (map (lambda (shp) (receive (shape-size shp))) shps)) )
    (values (apply max (map car sizs)) (apply + (map cadr sizs))) ) )

(define (class-shape-layout shp info bb)
  #; ;FIXME ;shape-size might use previous layout info - must not use justified-dims
  (let loop ((shps (*info-elements info)) (w 0) (h 0))
    (if (null? shps) (values w h)
      (let ((shp (car shps)))
        (shape-layout shp info bb)
    ) ) )
  shp )

(define (class-shape-justified? shp info)
  (let loop ((shps (*info-elements info)))
    (or (null? shps)
        (let ((shp (car shps)))
          (and (shape-justified? shp)
               (loop (cdr shps))) ) ) )
  #f )

(register-shape-method 'vgroup 'size class-shape-size)
(register-shape-method 'vgroup 'cardinality (lambda (shp info) (vector-length (@info 0 info))))
(register-shape-method 'vgroup 'elements (lambda (shp info) (@info 0 info)))
(register-shape-method 'vgroup 'layout class-shape-layout)
(register-shape-method 'vgroup 'justified? class-shape-justified?)

) ;module (s9fes char-canvas shape vgroup)