; pattern cascade kit 1.0.0
; o.+o.--o.+o.o.+o.--o.+o..
; (c) 2006   dave griffiths 
; GPL licence (see COPYING)
; ~~~~~~~~~~~~~~~~~~~~~~~~~

; the main pattern cascade script, defines some scheme building blocks
; and wraps all the osc messaging into easy to use and livecode elements

(define pattern-build 0)
(define pattern-animate 0)

; definitions of the osc paths, these need to match those in the start.sh
(define pattern-osc-noisepattern "4000")
(define pattern-osc-noiseweapon "4001")
(define pattern-osc-noiselab "4002")
(define pattern-osc-kitchensync "4003")
(define pattern-osc-prefix "osc.udp://localhost:")

(define pattern-osc-current "")
(define pattern-do-init 1)
(define pattern-sampledir "/home/dave/noiz/pattern-cascade/") ; replace with your sample directory
(define pattern-sample-id 0)

; helper to minimise switching between osc destinations
(define pattern-osc-destination
	(lambda (address)
		(if (not (string=? pattern-osc-current address)) ; minimise switches
			(osc-destination (string-append pattern-osc-prefix address)))))

; sets the reset flag 
(define pattern-reset
	(lambda ()
		(set! pattern-do-init 1)))

; inits the whole system (if the reset flag is set), and resets the sample mapping
(define pattern-top
	(lambda ()
		(set! pattern-sample-id 0)
		(pattern-sample-unmap)
		(cond ((eq? pattern-do-init 1)
			(pattern-osc-destination pattern-osc-noisepattern)
			(osc-source "4004")
			(osc-send "/clear" "" '()) 
			(osc-send "/add_dest_address" "s" (list pattern-osc-noiseweapon)) ; noiseweapon
			(osc-send "/add_dest_address" "s" (list pattern-osc-noiselab)) ; noiselab
			(osc-send "/add_dest_address" "s" (list pattern-osc-kitchensync)) ; kitchensync
			(osc-send "/add_dest_url" "s" '("/play")) 
			;(osc-send "/loadtuning" "s" '("./tuning.scl")) ; you can replace the default equal temperament
			(osc-send "/settimebuffer" "f" '(0.5))          ; this might need some tuning on your system
			(osc-send "/settimelatency" "f" '(0.5))         ; and this (see noisepattern docs)
			;(osc-send "/notedebug" "i" '(1))

			(pattern-osc-destination pattern-osc-noiseweapon)
			(osc-send "/clear" "" '())
			(osc-send "/setclock" "" '())

			(pattern-osc-destination pattern-osc-noiselab)
			(osc-send "/clear" "" '())
			(osc-send "/setclock" "" '())
			(osc-send "/addsearchpath" "s" (list pattern-sampledir))
			
			(set! pattern-do-init 0)
		))))

;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; noisepattern part

; make a new pattern
(define pattern-add
	(lambda (id)
		(pattern-osc-destination pattern-osc-noisepattern)
		(osc-send "/new" "i" (list id))
		(osc-send "/modify" "isf" (list id "Midi" id))))

; set a pattern
(define pattern-set
	(lambda (id s)
		(pattern-osc-destination pattern-osc-noisepattern)
		(osc-send "/modifystr" "iss" (list id "Score" s))))

; change global bpm
(define pattern-bpm
	(lambda (s)
		(pattern-osc-destination pattern-osc-noisepattern)
		(osc-send "/bpm" "f" (list s))))

; mute a pattern
(define pattern-mute
	(lambda (id s)
		(pattern-osc-destination pattern-osc-noisepattern)
		(osc-send "/modify" "isf" '(id "Playing" s))))

; sets the speed of a pattern - a multiplier of the bpm
(define pattern-speed
	(lambda (id s)
		(pattern-osc-destination pattern-osc-noisepattern)
		(osc-send "/modify" "isf" (list id "BeatMult" s))))

; helper to set up a pattern in one command
(define pattern
	(lambda (id speed str)
		(pattern-osc-destination pattern-osc-noisepattern)
		(pattern-add id)
		(pattern-speed id speed)
		(pattern-set id str)
		; call the visuals builder function if it's defined
		(cond 
			((not (number? pattern-build))
				(pattern-build id str)))))

; define pattern order - changes the way that resets are passed
; from pattern to pattern meaning you can change the music radically
; use this also to mute patterns, by leaving them out of the list
; the system will maintain their rhythm for you
(define pattern-cascade
	(lambda (patterns)
	(define loop
		(lambda (patterns)
			(osc-send "/cascadetop" "i" (list (car patterns)))
			(if (eq? (cdr patterns) '())
				0
				(loop (cdr patterns)))))
				
		(pattern-osc-destination pattern-osc-noisepattern)
		(osc-send "/muteall" "" (list))
		(if (not (eq? patterns '()))
			(loop (reverse patterns)))))

;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; pattern-gfx build and animate
;
; (pattern-build id string)
; (pattern-animate ((id . notenum) (id . notenum) ...))

; set a function to call for building patterns
(define pattern-build-func
	(lambda (func)
		(set! pattern-build func)))
		
; set a function to call every frame with note information
(define pattern-animate-func
	(lambda (func)
		(set! pattern-animate func)
		(every-frame (_pattern-animate))))

; internal every-frame function (don't call every-frame yourself)
(define _pattern-animate
	(lambda ()
		(define collector
			(lambda (l)
				(cond 
					((osc-msg "/play") 
						; fill the list with pairs of (id . notenum)
                    	(set! l (cons (cons (inexact->exact (osc 2)) 
							(inexact->exact (osc 8))) l))
						(collector l)) ; call until we run out of /plays
					(else l)))) 
		
		(if (not (number? pattern-animate))
			(pattern-animate (collector '())))))
	
		
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; kitchensync part

; a global delay in seconds - negative delay doesn't seem to work
(define pattern-delay
	(lambda (s)
		(pattern-osc-destination pattern-osc-kitchensync)
		(osc-send "/delay" "f" (list s))))

; set the master clock - will be overridden by external messages
(define pattern-clock
	(lambda (bpb bpm)
		(pattern-osc-destination pattern-osc-kitchensync)
		(osc-send "/clock" "fi" (list bpb bpm))))

;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; noiseweapon part

; define a synth voice
(define pattern-voice 
	(lambda (id type keyvalue)
		(define build-argsstr
			(lambda (keyvalue str)
				(set! str (string-append str "sf"))
				(if (eq? (cdr (cdr keyvalue)) '())
					str
					(build-argsstr (cdr (cdr keyvalue)) str))))
					
		(pattern-osc-destination pattern-osc-noiseweapon)
		(osc-send "/addinstrument" "is" (list id type))
		(set! keyvalue (cons id keyvalue))
		(set! keyvalue (cons "map" keyvalue))
		(osc-send "/modify" 
			(build-argsstr keyvalue "i") 
			(append (list id) keyvalue))))

; set voice volume individually
(define pattern-voice-volume
	(lambda (vol)
		(pattern-osc-destination pattern-osc-noiseweapon)
		(osc-send "/globalvolume" "f" (list vol))))
	
	
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; noiselab part

; load a sample into a voice
(define pattern-sample
	(lambda (id file)
		(pattern-osc-destination pattern-osc-noiselab)
		(set! pattern-sample-id (+ pattern-sample-id 1))
		(osc-send "/addtoqueue" "is" (list pattern-sample-id file))
		(osc-send "/loadqueue" "" '())
		(osc-send "/map" "ii" (list pattern-sample-id id))))

; set global properties for a sample
(define pattern-sample-globals 
	(lambda (id vol freq pan)
		(pattern-osc-destination pattern-osc-noiselab)
		(set! pattern-sample-id (+ pattern-sample-id 1))
		(osc-send "/setglobals" "ifff" (list vol freq pan))))

; sets the global sampler volume
(define pattern-sample-volume
	(lambda (vol)
		(pattern-osc-destination pattern-osc-noiselab)
		(osc-send "/globalvolume" "f" (list vol))))

; sets the global pitch of the sampler
(define pattern-sample-pitch
	(lambda (pitch)
		(pattern-osc-destination pattern-osc-noiselab)
		(osc-send "/globalpitch" "f" (list pitch))))


; load a load of samples in one go from a directory specified and
; assign them to one voice for pitch based percussion style use
(define pattern-samples
	(lambda (id dir)	
		(define get-samples
			(lambda (d l)
				(let ((ret (readdir d)))
					(cond ((not (string? ret))
						(closedir d)
						l)
						((if (and (> (string-length ret) 4)
								(or (string=? (substring ret (- (string-length ret) 4)) ".wav")
						    		(string=? (substring ret (- (string-length ret) 4)) ".WAV")))
								(set! l (append l (list ret))))
						(get-samples d l))))))
						
		(define load-list
			(lambda (id dir l)
				(set! pattern-sample-id (+ pattern-sample-id 1))
				(osc-send "/addtoqueue" "is" (list pattern-sample-id (string-append dir "/" (car l))))
				(osc-send "/map" "ii" (list pattern-sample-id id))
				(if (eq? (cdr l) '())
					0
					(load-list id dir (cdr l)))))
					
		(pattern-osc-destination pattern-osc-noiselab)
		(load-list id dir (get-samples (opendir (string-append pattern-sampledir dir)) '()))
		(osc-send "/loadqueue" "" '())))

(define pattern-sample-unmap
	(lambda ()
		(pattern-osc-destination pattern-osc-noiselab)
		(osc-send "/unmapall" "" '())))
		
(define pattern-sample-stop
	(lambda ()
		(pattern-osc-destination pattern-osc-noiselab)
		(osc-send "/stop" "" '())))