(module (s9fes char-canvas shape shape)

(;export
  ;
  shape-size
  ;
  register-shape-method
  registered-shapes)

(import scheme utf8)
(import (chicken base))
(import (chicken type))

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

(define-type shape-entry (pair symbol (list-of symbol)))

(: shape-size (shape-plotter -> integer integer))

(: register-shape-method (symbol symbol (list -> . *) -> void))

(: registered-shapes (-> (list-of shape-entry)))

;;

(define (lookup-method id nm ms)
  (let ((fn (alist-ref 'size ms eq?)))
    (or fn
        (error "unknown shape method" id nm)) ) )

(define (lookup-shape id shps)
  (let ((ms (alist-ref id shps eq?)))
    (or ms
        (error "unknown shape" id)) ) )

(define (lookup-shape-method id shps)
  (lookup-method id 'size (lookup-shape id shps)) )

;;

(define shape-size)
(define register-shape-method)
(define registered-shapes)
(let ((+shapes+ '()))

  (set! register-shape-method
    (lambda (id nm fn)
      (let ((ms (alist-ref id +shapes+ eq? '())))
        ;don't bother to remove stale items from method list
        (set! +shapes+
              (alist-update! id (cons `(,nm . ,fn) ms)
                             +shapes+ eq?)) ) ) )

  (set! registered-shapes
    (lambda ()
      (map (lambda (elm) (cons (car elm) (map car (cdr elm)))) +shapes+) ) )

  (set! shape-size
    (lambda (shp)
      (let* ((info (shp))
             (fn (lookup-shape-method (car info) +shapes+)) )
        (fn info) ) ) ) )

) ;(module (s9fes char-canvas shape shape)