(use-modules (ice-9 receive)
	     (srfi srfi-1))

;; represent 2D vectors as pairs


(define x car)
(define y cdr)
(define mkvec cons)

(define (vbin+ v1 v2)
  (mkvec (+ (x v1) (x v2)) (+ (y v1) (y v2))))


(define (v+ . vectors)
  (fold vbin+ '(0 . 0) vectors))

(define (v* r v)
  (mkvec (* r (x v)) (* r (y v))))

(define (v- v . rest)
  (if (null? rest)
      (mkvec (- (x v)) (- (y v)))
      (v+ v (v* -1 (apply v+ rest)))))

(define (vmag v)
  (sqrt (+ (sqr (x v)) (sqr (y v)))))

(define (vsqrmag v)
  (+ (sqr (x v)) (sqr (y v))))
  
(define (normalize v)
  (v* (/ (vmag v)) v))

(define (findparams p1 p2 p3 r)
  (let ((p1-p2 (v- p1 p2))
	(p3-p2 (v- p3 p2)))
    (let ((v1 (normalize p1-p2))
	  (v3 (normalize p3-p2)))
      (let* ((F (/ (vsqrmag (v- v1 v3)) 4))
	     (scale (* r (sqrt (- (/ 1 F) 1))))

	     (e1 (v* scale v1))
	     (e3 (v* scale v3))
             
	     (ccw? (> (- (* (x v3) (y v1)) (* (x v1) (y v3))) 0)))
	(values (v+ p2 e1) (v+ p2 e3) ccw?)))))

(define (do-vertex index points n radius)
  (receive (endpoint1 endpoint2 ccw?)
	   (findparams (vector-ref points (modulo (- index 1) n))
                       (vector-ref points index)
                       (vector-ref points (modulo (+ index 1) n))
                       radius)
           (format #f "L~a,~a A~a,~a 0 0 ~a ~a,~a~%"
                   (x endpoint1)
                   (y endpoint1)
                   radius
                   radius
		   (if ccw? 1 0)
		   (x endpoint2)
		   (y endpoint2))))

(define (polygon points radius)
  (define n (vector-length points))
  (define startpoint (v* 0.5 (v+ (vector-ref points (- n 1)) (vector-ref points 0))))
  
  (entity 'path ""
	  `(d . ,(format
		   #f "M~a,~a~%~aZ"
		   (x startpoint) (y startpoint)
		   (let loop ((index 0) (str ""))
		     (if (= index n)
		       str
		       (loop (+ index 1)
			     (string-append str
					    (do-vertex index points n radius)))))))
	  '(style . "fill:currentColor; stroke:none")))