(module (s9fes char-canvas shape oval)

(;export
  ;
  circle-octant-point
  ;
  circle-octant-plotter
  ;
  generate-circle-octant
  circle-octant-visitor
  draw-circle
  ;
  generate-virtual-circle-octant
  virtual-circle-octant-visitor
  plot-circle
  ;
  circle-polygon-lines)

(import scheme utf8)
(import (chicken base))
(import (chicken fixnum))
(import (chicken type))
(import (only (srfi 1) cons* append! reverse!))
(import (s9fes char-canvas))

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

(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 (or char plotter-configuration) -> circle-octant-plotter))

(: circle-octant-visitor (fixnum fixnum circle-octant-plotter -> circle-octant-visitor))
(: generate-circle-octant (canvas fixnum circle-octant-visitor -> void))
(: draw-circle (canvas fixnum fixnum fixnum #!optional (or char plotter-configuration) -> 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))
(: plot-circle (canvas integer integer integer #!optional (or char plotter-configuration) -> void))

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

;;

(define PI (acos -1))
(define DEGREE (/ PI 180))

;FIXME generate-circle-octant produces octant 1!
(define (octant-order-patch loc ot)
  (case ot
    ((0) 1)
    ((1) 0)
    ((2) 3)
    ((3) 2)
    ((4) 5)
    ((5) 4)
    ((6) 7)
    ((7) 6)
    (else
      (error loc "unknown octant" ot))) )

(define (circle-octant-point ot x0 y0 x y)
  (case (octant-order-patch 'circle-octant-point ot)
    ((0) (values (fx+ x0 x) (fx+ y0 y)))
    ((1) (values (fx+ x0 y) (fx+ y0 x)))
    ((2) (values (fx- x0 y) (fx+ y0 x)))
    ((3) (values (fx- x0 x) (fx+ y0 y)))
    ((4) (values (fx- x0 x) (fx- y0 y)))
    ((5) (values (fx- x0 y) (fx- y0 x)))
    ((6) (values (fx+ x0 y) (fx- y0 x)))
    ((7) (values (fx+ x0 x) (fx- y0 y)))
    (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 (draw-circle cv x0 y0 r #!optional (cfg (current-plotter-char)))
  (generate-circle-octant cv r (circle-octant-visitor x0 y0 (circle-octant-plotter cfg))) )

;;

(define (generate-virtual-circle-octant cv r visit #!optional (avg? #f))
  (let-values (((rx ry) (canvas-physical cv r r)))
    (let ((rp (if avg? (fx/ (fx+ rx ry) 2) ry)))
      (assert (fx< 0 ry) 'generate-virtual-circle-octant "radius is too small" r)
      (generate-circle-octant cv ry 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, so 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-values (((x0 y0) (canvas-physical cv x0 y0)))
                      (circle-octant-visitor x0 y0 plotter))) )
      (visit cv x y) ) ) )

(define (plot-circle cv x0 y0 r #!optional (cfg (current-plotter-char)))
  (generate-virtual-circle-octant cv r (virtual-circle-octant-visitor x0 y0 (circle-octant-plotter cfg))) )

;;

;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)
                (cons* (+ (inexact->exact (round (* (cos a) ir))) y)
                       (+ (inexact->exact (round (* (sin a) ir))) x)
                       ps)) ) ) ) )

) ;module (s9fes char-canvas shape oval)