;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; 

;; THE PERISCORE

;;

;; click on red green or blue

;; then click inside the periscore

;;

;; grey clears existing nodes, which will be slowly

;; wiped over time but stop sounding immediately

;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(gfx:set-alias *gfx:aa-on*)

(au:clear-graph)

(define synth (au:make-node "aumu" "dls " "appl"))

(au:connect-node synth 0 *au:output-node* 0)

(au:update-graph)

(au:midi-out (now) synth *io:midi-pc* 0 13 0)

(au:midi-out (now) synth *io:midi-pc* 1 14 0)

(au:midi-out (now) synth *io:midi-pc* 2 15 0)

(define canvas (gfx:make-canvas 600 620))

(io:register-mouse-events canvas)

(gfx:lock-canvas-size canvas 600 620)

(define moving-line (gfx:make-path))

(define nodes '())

(define colour '(1 0 0 1))

(define channel 0)

(define synth-a (gfx:make-circle 210 50 25))

(define synth-b (gfx:make-circle 270 50 25))

(define synth-c (gfx:make-circle 330 50 25))

(define synth-d (gfx:make-circle 390 50 25))

(define y-cross (gfx:make-rectangle 300 100 2 400))

(define x-cross (gfx:make-rectangle 100 300 400 2))

(define ring-a (gfx:make-circle 300 300 50))

(define ring-b (gfx:make-circle 300 300 100))

(define ring-c (gfx:make-circle 300 300 150))

(define ring-d (gfx:make-circle 300 300 200))

(define outer-bounds (gfx:make-circle 300 300 190))

(define text-style (gfx:make-text-style "Times-Roman" 72.0 (list 0.5 0.5 0.7 1)))

(gfx:clear-canvas (now) canvas '(0.0 0.0 0.2 1))

(define draw-target

   (lambda ()

      (let ((tc '(0.1 0.1 0.7 1))

            (nc '()))

         (gfx:draw-path (now) canvas ring-d 

                    '(0.1 0.0 0.3 0.35) '(0.2 0.0 0.3 0.35) 1 *gfx:whole-path*)                    

         (gfx:draw-path (now) canvas y-cross nc tc 1 *gfx:fill-path*)

         (gfx:draw-path (now) canvas x-cross nc tc 1 *gfx:fill-path*)

         (gfx:draw-path (now) canvas ring-a tc nc 1 *gfx:stroke-path*)

         (gfx:draw-path (now) canvas ring-b tc nc 1 *gfx:stroke-path*)

         (gfx:draw-path (now) canvas ring-c tc nc 1 *gfx:stroke-path*)

         (gfx:draw-path (now) canvas ring-d tc nc 1 *gfx:stroke-path*))))

(define test

   (lambda (time path cnt)

      (if (= cnt 360)

          (begin (set! cnt 0)

                 (draw-target)))

      (gfx:rotate-path time path 1 300 300 *degrees*)

      (map (lambda (node)

              (if (gfx:point-in-path? path 

                                  (car (node 'centre))

                                  (cdr (node 'centre)))

                  (begin (node 'play time)

                         (callback (+ time 2000) (lambda () (node 'draw))))))

           nodes)

      (gfx:draw-path (+ time 5) canvas path 

                 '(0 0 0 0) '(0.7 0.7 0.9 0.1) 1 *gfx:fill-path*)

      (callback (+ time 1000) 'test (+ time 2000) path (+ cnt 1))))

(define set-moving-line

   (lambda ()

      (gfx:set-start-point moving-line 300 300)

      (gfx:add-line moving-line 300 500)

      (gfx:add-line moving-line 305 500)

      (gfx:add-line moving-line 305 300)

      (gfx:close-path moving-line)))

(define clear

   (lambda ()

      (set! nodes '())))

(define io:mouse-down

   (lambda (x y)

      (cond ((gfx:point-in-path? synth-a x y)

             (gfx:draw-path (now) canvas synth-a

                        '(1 1 1 1) '(1 0 0 1) 1 *gfx:whole-path*))

            ((gfx:point-in-path? synth-b x y)

             (gfx:draw-path (now) canvas synth-b

                        '(1 1 1 1) '(0 1 0 1) 1 *gfx:whole-path*))

            ((gfx:point-in-path? synth-c x y)

             (gfx:draw-path (now) canvas synth-c

                        '(1 1 1 1) '(0 0 1 1) 1 *gfx:whole-path*))

            ((gfx:point-in-path? synth-d x y)

             (gfx:draw-path (now) canvas synth-d

                        '(1 1 1 1) '(0 0 0 1) 1 *gfx:whole-path*)))))

(define io:mouse-up

   (lambda (x y)

      (cond ((gfx:point-in-path? synth-a x y)

             (gfx:draw-path (now) canvas synth-a

                        '(1 1 1 1) '(1 0.5 0.5 1) 1 *gfx:whole-path*)

             (set! channel 0)

             (set! colour '(1 0.5 0.5 0.5)))

            ((gfx:point-in-path? synth-b x y)

             (gfx:draw-path (now) canvas synth-b

                        '(1 1 1 1) '(0.5 1 0.5 1) 1 *gfx:whole-path*)

             (set! channel 1)

             (set! colour '(0.5 1 0.5 0.5)))

            ((gfx:point-in-path? synth-c x y)

             (gfx:draw-path (now) canvas synth-c

                        '(1 1 1 1) '(0.5 0.5 1 1) 1 *gfx:whole-path*)

             (set! channel 2)

             (set! colour '(0.5 0.5 1 0.5)))

            ((gfx:point-in-path? synth-d x y)

             (gfx:draw-path (now) canvas synth-d

                        '(1 1 1 1) '(0.5 0.5 0.5 1) 1 *gfx:whole-path*)

             (clear))

            ((gfx:point-in-path? outer-bounds x y)

             (let ((n (make-node channel colour x y)))

                (n 'draw)

                (set! nodes (cons n nodes)))))))

(define make-node

   (lambda (channel fill-colour x y)

      (let* ((path (gfx:make-circle x y 10))

             (rel-x (abs (- x 300)))

             (rel-y (abs (- y 300)))

             (pitch (sqrt (+ (* rel-x rel-x) (* rel-y rel-y))))

             (end-time 0))

         (lambda (sym . args)

            (cond ((eq? sym 'play)

                   (if (< end-time (car args))

                       (begin (set! end-time (+ (car args) 44100))

                              (play-note (now) synth (* pitch 0.6) 80 4000 channel)

                              (gfx:draw-path (now) canvas path

                                         '(0 0 0 0) '(0 0 0 0) 1 *gfx:fill-path*))))

                  ((eq? sym 'point)

                   (gfx:get-path-point path))

                  ((eq? sym 'centre)

                   (gfx:get-path-centre path))

                  ((eq? sym 'draw)

                   (gfx:draw-path (now) canvas path

                              '(0 0 0 0) fill-colour 1 *gfx:fill-path*))

                  ((eq? sym 'move)

                   (gfx:move-path (now) path (car args) (cadr args))))))))

(define start

   (lambda ()

      (set-moving-line)

      (gfx:draw-text (now) canvas "Periscore" text-style '(170 510))      

      (gfx:draw-path (now) canvas synth-a '(1 1 1 1) '(1 0.5 0.5 1) 1 *gfx:whole-path*)

      (gfx:draw-path (now) canvas synth-b '(1 1 1 1) '(0.5 1 0.5 1) 1 *gfx:whole-path*)

      (gfx:draw-path (now) canvas synth-c '(1 1 1 1) '(0.5 0.5 1 1) 1 *gfx:whole-path*)

      (gfx:draw-path (now) canvas synth-d '(1 1 1 1) '(0.5 0.5 0.5 1) 1 *gfx:whole-path*)

      (draw-target)      

      (test (now) moving-line 0)))

(callback (+ (now) 20000) 'start)