; -------------------------------------------------------------------------------------------------
;  SID Chord.cal
; -------------------------------------------------------------------------------------------------
;
; Author:       Eric von Bayer
; Email:        CAL @ ericvonbayer.us   (remove the spaces)
; WWW:          http://www.ericvonbayer.us
; Dates:        January 2005 - February 2005
; Version:      1.2
; Changes:
;
;	02/02/2005 EvB - If the "center note" can be maintained it will be used for the next chord.
;                        This makes it easier to build chord progressions where you might remove the
;                        individual notes later in favor of one long held note.  Also added ArpTypes.
;
; Description:
;
; Script to generate the arpreggio effect as the SID chip did.  It will find all 3 note chords and
; render them to a center note with a rapid pitch bend envelope on top.  All other notes will be deleted.

; -------------------------------------------------------------------------------------------------
;                                    Make Sure we're new enough
; -------------------------------------------------------------------------------------------------

(do
	(if (< VERSION 40) (do
		(pause "This CAL program requires CAL version 4.0 or higher")
		(exit)
	) )

; -------------------------------------------------------------------------------------------------
;                                        Config Section
; -------------------------------------------------------------------------------------------------

	(word wNoteDur   16) ; Duration of note to tolerate as being the same (16th Note)
	(word wArpDur    72) ; Duration of the arpregio effect
	(word wBendDepth 12) ; Bend Depth (+/- semitones)
	(word wArpType    1) ; ARP Type (1=Up,2=Down,3=Up/Down,4=Down/Up,5=Random)

; -------------------------------------------------------------------------------------------------
;                                    Main processing loop
; -------------------------------------------------------------------------------------------------

	(dword dInitTime -999999)
	(dword dLastTime dInitTime)
	(int   iLastChan 0)
	(int   iLastKey1 0)
	(int   iLastKey2 0)
	(int   iLastKey3 0)
	(int   iCtr      0)
	(int   iLastVel  0)
	(dword dLastEnd  0)
	(dword dTmpEnd   0)
	(int   iKeyTmp   0)
	(dword dArpLoc   0)
	(int   iCtrKey -100)
	(int   iOff1     0)
	(int   iOff2     0)
	(int   iOff3     0)
	(int   iArpCtr   0)

	; Calculate the tolerance
	(dword dTicksTol (/ (* TIMEBASE 4) wNoteDur ) )
	
	; Calculate the Arp ticks
	(dword dArpTicks (/ (* TIMEBASE 4) wArpDur ) )
	
	; Calculate the pitch bend semitones
	(dword dBendSemi (/ 8192 wBendDepth ) )
	
	(forEachEvent (do

		; Only process notes
		(if (== Event.Kind NOTE) (do		

			; Calculate the note end
			(= dTmpEnd (+ Event.Time Note.Dur ) )

			; See if we don't match the last time
			(if (|| (<= (+ dLastTime dTicksTol ) Event.Time ) (== dLastTime dInitTime) ) (do

				; Update the info for a new note
				(= dLastTime Event.Time)
				(= iLastChan Event.Chan)
				(= iLastKey1 Note.Key)
				(= iLastVel  Note.Vel)
				(= dLastEnd  dTmpEnd)
				(= iCtr      0)

			) (do ; We match the last time

				(switch iCtr
					0 (= iLastKey2 Note.Key)
					1 (do
						; Get the last key
						(= iLastKey3 Note.Key)
						
						; Sort Key1 and Key2
						(if (> iLastKey1 iLastKey2 ) (do 
							(= iKeyTmp   iLastKey1 )
							(= iLastKey1 iLastKey2 )
							(= iLastKey2 iKeyTmp )
						) )
						
						; Sort Key2 and Key3
						(if (> iLastKey2 iLastKey3 ) (do 
							(= iKeyTmp   iLastKey2 )
							(= iLastKey2 iLastKey3 )
							(= iLastKey3 iKeyTmp )
						) )
						
						; Sort Key1 and Key2
						(if (> iLastKey1 iLastKey2 ) (do 
							(= iKeyTmp   iLastKey1 )
							(= iLastKey1 iLastKey2 )
							(= iLastKey2 iKeyTmp )
						) )
						
						; Find out if our old center key is still good
						(if (|| (< (+ iCtrKey wBendDepth) iLastKey3 )
								(> (- iCtrKey wBendDepth) iLastKey1 ) ) (do
								
							; Find the new center key
							(= iCtrKey (/ (+ iLastKey1 iLastKey3 ) 2 ) )
						
							; Throw an error if the range is too great
							(if (> (- iLastKey3 iLastKey1 ) (+ wBendDepth wBendDepth ) ) (do
								(pause "Chord exceeds pitch bend range!  Aborting." )
								(exit)
							) )
						) )
						
						; Calculate the offsets
						(= iOff1 (* (- iLastKey1 iCtrKey ) dBendSemi ) )
						(= iOff2 (* (- iLastKey2 iCtrKey ) dBendSemi ) )
						(= iOff3 (* (- iLastKey3 iCtrKey ) dBendSemi ) )
						
						; Insert the note
						(insert dLastTime iLastChan NOTE iCtrKey iLastVel (- dLastEnd dLastTime) )

						(switch wArpType
						
							; Arpeggio Up
							1 (do
								; Insert the pitch bends
								(= dArpLoc dLastTime)
								(= iArpCtr 0)
								(while (< dArpLoc dLastEnd ) (do
									(switch iArpCtr
										0 (insert dArpLoc iLastChan WHEEL iOff1 )
										1 (insert dArpLoc iLastChan WHEEL iOff2 )
										2 (insert dArpLoc iLastChan WHEEL iOff3 )
									)

									(++ iArpCtr)

									(if (== iArpCtr 3) (= iArpCtr 0) )

									(+= dArpLoc dArpTicks)
								) )
							)
						
							; Arpeggio Down
							2 (do
								; Insert the pitch bends
								(= dArpLoc dLastTime)
								(= iArpCtr 0)
								(while (< dArpLoc dLastEnd ) (do
									(switch iArpCtr
										0 (insert dArpLoc iLastChan WHEEL iOff3 )
										1 (insert dArpLoc iLastChan WHEEL iOff2 )
										2 (insert dArpLoc iLastChan WHEEL iOff1 )
									)

									(++ iArpCtr)

									(if (== iArpCtr 3) (= iArpCtr 0) )

									(+= dArpLoc dArpTicks)
								) )
							)
						
							; Arpeggio Up/Down
							3 (do
								; Insert the pitch bends
								(= dArpLoc dLastTime)
								(= iArpCtr 0)
								(while (< dArpLoc dLastEnd ) (do
									(switch iArpCtr
										0 (insert dArpLoc iLastChan WHEEL iOff1 )
										1 (insert dArpLoc iLastChan WHEEL iOff2 )
										2 (insert dArpLoc iLastChan WHEEL iOff3 )
										3 (insert dArpLoc iLastChan WHEEL iOff2 )
									)

									(++ iArpCtr)

									(if (== iArpCtr 4) (= iArpCtr 0) )

									(+= dArpLoc dArpTicks)
								) )
							)
						
							; Arpeggio Down/Up
							4 (do
								; Insert the pitch bends
								(= dArpLoc dLastTime)
								(= iArpCtr 0)
								(while (< dArpLoc dLastEnd ) (do
									(switch iArpCtr
										0 (insert dArpLoc iLastChan WHEEL iOff3 )
										1 (insert dArpLoc iLastChan WHEEL iOff2 )
										2 (insert dArpLoc iLastChan WHEEL iOff1 )
										3 (insert dArpLoc iLastChan WHEEL iOff2 )
									)

									(++ iArpCtr)

									(if (== iArpCtr 4) (= iArpCtr 0) )

									(+= dArpLoc dArpTicks)
								) )
							)
						
							; Arpeggio Random
							5 (do
								; Insert the pitch bends
								(= dArpLoc dLastTime)
								(while (< dArpLoc dLastEnd ) (do
									(switch (random 0 2)
										0 (insert dArpLoc iLastChan WHEEL iOff1 )
										1 (insert dArpLoc iLastChan WHEEL iOff2 )
										2 (insert dArpLoc iLastChan WHEEL iOff3 )
									)

									(+= dArpLoc dArpTicks)
								) )
							)
						)
					)
				)	

				; Increment the counter
				(++ iCtr)
				
				; If the end point is later, adjust the stored one
				(if (> dTmpEnd dLastEnd ) (do
					(= dLastEnd dTmpEnd)
				) )
			) )
			
			; Delete the note regardless
			(delete)

		) )
	) )

)