(module (s9fes char-canvas shape circle)

(;export
  ;
  circle-octant-point
  ;
  circle-octant-plotter
  ;
  generate-circle-octant
  circle-octant-visitor
  real-shape-circle
  ;
  generate-virtual-circle-octant
  virtual-circle-octant-visitor
  shape-circle
  ;
  circle-polygon-lines)

(import scheme utf8)
(import (chicken base))
(import (chicken fixnum))
(import (chicken type))
(import (only (srfi 1) cons* append! reverse!))
(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")

(define-type circle-octant-plotter (canvas fixnum fixnum fixnum fixnum -> boolean))
(define-type circle-octant-visitor (canvas fixnum fixnum -> boolean))

(: circle-octant-point (fixnum fixnum fixnum fixnum fixnum -> fixnum fixnum))

(: circle-octant-plotter (#!optional plotter-config-arg -> circle-octant-plotter))

(: circle-octant-visitor (fixnum fixnum circle-octant-plotter -> circle-octant-visitor))
(: generate-circle-octant (canvas fixnum circle-octant-visitor -> void))

(: virtual-circle-octant-visitor (integer integer circle-octant-plotter -> circle-octant-visitor))
(: generate-virtual-circle-octant (canvas integer circle-octant-visitor #!optional boolean -> void))

(: real-shape-circle (fixnum #!optional plotter-config-arg -> real-shape-plotter))
(: shape-circle (integer #!optional plotter-config-arg -> shape-plotter))

(: circle-polygon-lines (integer integer integer #!optional fixnum fixnum -> (list-of integer)))

;;

;constant but not immediate
(define PI (acos -1))
(define DEGREE (/ PI 180))

(define (circle-octant-point ot x0 y0 x y)
  ;octant-order-patch
  (case ot                                ;real octant
    ((0) (values (fx+ x0 y) (fx+ y0 x)))  ;1
    ((1) (values (fx+ x0 x) (fx+ y0 y)))  ;0
    ((2) (values (fx- x0 x) (fx+ y0 y)))  ;3
    ((3) (values (fx- x0 y) (fx+ y0 x)))  ;2
    ((4) (values (fx- x0 y) (fx- y0 x)))  ;5
    ((5) (values (fx- x0 x) (fx- y0 y)))  ;4
    ((6) (values (fx+ x0 x) (fx- y0 y)))  ;7
    ((7) (values (fx+ x0 y) (fx- y0 x)))  ;6
    (else
      (error 'circle-octant-point "unknown octant" ot))) )

;https://iq.opengenus.org/bresenhams-circle-drawing-algorithm/
(define (generate-circle-octant cv r visit)
  ;produces octant 1
  (let loop ((x 0) (y r) (d (fx- 3 (fx* r 2))))
    (unless (fx< y x)
      (when (visit cv x y)
        (let ((x (fx+ x 1)))
          (if (fx> d 0)
              (loop x (fx- y 1) (fx+ d (fx+ (fx* 4 (fx- x y)) 10)))
              (loop x y         (fx+ d (fx+ (fx* 4 x) 6))) ) ) ) ) ) )

;FIXME should cv & center be closed-over here or by visit?

(define ((circle-octant-visitor x0 y0 plotter) cv x y)
  (plotter cv x0 y0 x y) )

(define (circle-octant-plotter #!optional (cfg (current-plotter-char)))
  (let ((cfg (validate-plotter-configuration 'circle-octant-plotter cfg 8 #f)))
    (lambda (cv x0 y0 x y)
      (let loop ((rem cfg) (ot 0))
        (or (null? rem)
            (let ((c (car rem)))
              (when c
                (let-values (((xr yr) (circle-octant-point ot x0 y0 x y)))
                  (canvas-draw cv xr yr c) ) )
              (loop (cdr rem) (fx+ ot 1)) ) ) ) ) ) )

(define (real-shape-circle r #!optional (cfg (current-plotter-char)))
  (let ((pltr (circle-octant-plotter cfg)))
    (lambda (#!optional cv (x0 r) (y0 r))
      (if cv
          (begin
            (generate-circle-octant cv r (circle-octant-visitor x0 y0 pltr))
            cv)
          (list 'circle 'real r cfg) ) ) ) )

;;

;FIXME square aspect compensation

(define (generate-virtual-circle-octant cv r visit #!optional (avg? #f))
  (let ((rx (%real-x cv r)) (ry (%real-y cv r)))
    (let ((rp (if avg? (fx/ (fx+ rx ry) 2) ry)))
      ;(assert (fx< 0 rp) 'generate-virtual-circle-octant "radius is too small" r)
      (generate-circle-octant cv rp visit) ) ) )

(define (virtual-circle-octant-visitor x0 y0 plotter)
  ;need a canvas to do the conversion, so pend until available
  ;need a function, & since visitor dependent on canvas, then caching
  (let ((visit (the (or false circle-octant-visitor) #f))
        (visit-cv (the (or false canvas) #f)) )
    (lambda (cv x y)
      (unless (and visit (eq? visit-cv cv))
        (set! visit-cv cv)
        (set! visit (let ((x0 (%real-x cv x0)) (y0 (%real-y cv y0)))
                      (circle-octant-visitor x0 y0 plotter))) )
      (visit cv x y) ) ) )

(define (shape-circle r #!optional (cfg (current-plotter-char)))
  (let ((pltr (circle-octant-plotter cfg)))
    (lambda (#!optional cv (x0 r) (y0 r))
      (if cv
          (begin
            (generate-virtual-circle-octant cv r (virtual-circle-octant-visitor x0 y0 pltr))
            cv)
          (list 'circle 'virtual r cfg) ) ) ) )

;;

(define-inline (virt->phys v) (inexact->exact (floor v)))

(define-inline (phys-polar-x a r) (virt->phys (* (cos a) r)))
(define-inline (phys-polar-y a r) (virt->phys (* (sin a) r)))

;circle-polygon-lines returns a list of coordinates suitable for use w/
;{{canvas-plot-lines}}. The coordinates describe a closed, convex, polygon.
;
;-> (list-of fixnum fixnum ...) - (x0 y0 x1 y1 ...)
;
;@x, @y center
;@radius point distance from center
;@n point count; default 360
;@angle starting degrees; default; {{0}} - has little influence
;
(define (circle-polygon-lines x y radius #!optional (n 360) (angle 0))
  (let ((ai (* (/ 360 n) DEGREE))
        (ir (exact->inexact radius)) )
    (let loop ((i 0) (a (* angle DEGREE)) (ps '()))
      (if (fx= i n)
          ;then ensure closed-polygon
          (let ((ps (reverse! ps)))
            (append! ps `(,(car ps) ,(cadr ps))) )
          ;else more points
          (loop (fx+ i 1)
                (+ a ai)
                ;WTF insensitive to (+ next-y y) vs (+ next-y x) - square test canvas?
                (cons* (+ (phys-polar-y a ir) y) (+ (phys-polar-x a ir) x) ps)) ) ) ) )

;;

(define (circle-shape-size info)
  (let ((r (the integer (caddr info))))
    (values r r) ) )

(register-shape-method 'circle 'size circle-shape-size)

) ;module (s9fes char-canvas shape circle)