;; rate -> string
(define rate-to-color
  (lambda (rate)
    (list-ref '("yellow" "blue" "black" "red") (rate-value rate))))

;; char -> char -> char -> bool
(define boundary?
  (lambda (p c n)
    (or (and p
	     (char-lower-case? p)
	     (char-upper-case? c))
	(and p
	     n
	     (char-upper-case? p)
	     (char-upper-case? c)
	     (char-lower-case? n)))))

;; string -> string
(define scheme-name
  (lambda (s)
    (let ((l (string->list s))
	  (f
	   (lambda (p c n)
	     (if (boundary? p c n)
		 (list #\- (char-downcase c))
		 (list (char-downcase c))))))
      (list->string
       (concat
	(zip-with3
	 f
	 (cons #f l)
	 l
	 (append2 (tail l) (list #f))))))))

;; n = name, i = inputs, o = outputs, s = special
(define ugen-to-label
  (lambda (g u)
    (let ((n (ugen-name u))
	  (i (ugen-inputs u))
	  (o (ugen-outputs u))
	  (s (ugen-special u)))
      (list (cons (or2 (operator-name u)
		       (scheme-name n))
		  (zip-with
		   (lambda (i index)
		     (if (= (input-ugen i) -1)
			 (graphdef-constant g (input-port i))
			 (port (list "i_" index))))
		   i
		   (iota (length i))))
	    (map1 (lambda (index)
		    (port (list "o_" index)))
		  (iota (length o)))))))

;; ugen -> bool
(define ugen-implicit?
  (lambda (u)
    (member (ugen-name u) (list "Control" "TrigControl" "LagControl"))))

;; rsc3 generates only k-rate implicit controls
(define control-port
  (lambda (g u o)
    o))

;; li = left index, lp = left port
(define graph-edge
  (lambda (g li lp ri rp)
    (let* ((u (graphdef-ugen g li))
	   (c (rate-to-color (output-rate (ugen-output u lp)))))
      (if (ugen-implicit? u)
	  `((c_ ,(control-port g u lp))
	    ((u_ ,ri) : (i_ ,rp))
	    ((color ,c)))
	  `(((u_ ,li) : (o_ ,lp))
	    ((u_ ,ri) : (i_ ,rp))
	    ((color ,c)))))))

;; ii = inputs, ri = right index
(define ugen-to-edges
  (lambda (g u ri)
    (let ((ii (ugen-inputs u)))
      (filter
       id
       (zip-with
	(lambda (i rp)
	  (let ((li (input-ugen i))
		(lp (input-port i)))
	    (if (= li -1)
		#f
		(graph-edge g li lp ri rp))))
	ii
	(iota (length ii)))))))

;; i = index
(define ugen-to-node
  (lambda (g u i)
    `((u_ ,i)
      ((shape record)
       (color ,(rate-to-color (ugen-rate u)))
       (label ,(record (ugen-to-label g u)))))))

;; v = value (initial), i = index
(define control-to-node
  (lambda (g c v i)
    `((c_ ,i)
      ((shape trapezium)
       (color green)
       (label (,(control-name c) #\: ,(s:round v 0.001)))))))

;; show a => graphdef -> Tree a
(define graphdef-to-dot
  (lambda (g)
    (let ((n (graphdef-name g))
	  (d (graphdef-defaults g))
	  (k (graphdef-controls g))
	  (u (graphdef-ugens g)))
      (list n
	    (append (zip-with3
		     (lambda (c v n)
		       (control-to-node g c v n))
		     k d (iota (length k)))
		    (zip-with
		     (lambda (u n)
		       (ugen-to-node g u n))
		     u (iota (length u))))
	    (concat (zip-with
		     (lambda (u n)
		       (ugen-to-edges g u n))
		     u
		     (iota (length u))))))))

;; ugen -> string -> ()
(define draw-graph
  (lambda (u fn)
    (with-output-to-file
	fn
      (lambda ()
	(for-each
	 display
	 (flatten
	  (digraph
	   (graphdef-to-dot
	    (synthdef "dot" u)))))))))