REBOL [Title: "Kurtsynth Rebol Synthesizer Demo"
	   Author: "Kurt Sassenrath"
	   Date: 31-Jan-06
	   Version: 1.0.0
]
; Order of Operations: ;
; 1. Generate Integer Wave
; 2. Filter Integer Wave (If needed)
; 3. Scale wave based on pitch
; 4. Convert Integer wave into 8-bit char wave
; 5. Multiply char wave by amplitude (Attack, sustain, decay, release yadda yadda yadda)

;----------=[Wav Functions]=----------;

; Functions for the "raw" integer form of wave ;

make-sine: does [
	repeat x 512 [
		poke wav x (127 * sine x - 1 / 512 * 360) + 128
	]  
]

make-sine2: does [
	repeat x 512 [
		poke wav x (127 * (sine x - 1 / 512 * 360) * (sine x - 1 / 128 * 360)) + 128
	]  
]

make-random: does [
	repeat x 512 [
		poke wav x random 255
	]
]

make-tri: does [
	repeat x 512 [
		poke wav x (to-integer x / 2) + 127 and 255
	]
]

fill-gap: func [wav x1 x2 /local dx] [ ;fills up gaps caused when freehand drawing with mouse
	dx: x2 - x1 - 1
	if any [zero? dx dx = -1] [exit]
	y: pick wav x1
	if not y [exit]
	y2: pick wav x2
	slope: to-integer (y2 - y) / dx
	if dx < 0 [x1: x2]
	repeat x abs dx [
		poke wav x1 + x y
		y: y + slope
	]
]

scale-wav: func [wav size /local dx x new-wav] [
	size: to-integer size * length? wav
	size: max 1 size
	new-wav: array size
	dx: (length? wav) / size
	x: 1.0
	repeat n size [
		poke new-wav n pick wav to-integer x
		x: x + dx
	]
	new-wav
]

smooth-wav: func [wav block wave-disp color] [
	wav: next wav
	forall wav [
		if tail? skip wav 2 [break]
		change wav to-integer wav/-1 + wav/1 + wav/2 / 3
	]
]

;----------=[Wave Functions]=----------;

shape-wav: func [wave adsr /local dx val mul] [
	dx: (length? wave) / length? adsr
	repeat n length? wave [
		mul: any [pick adsr 1 + to-integer n / dx 0]
		mul: 255 - mul
		val: to-integer pick wave n
		poke wave n to char! val * mul / 256
	]
]


generate-wave: func [time] [
	clear sample/data
	clear wave
	time: to-integer time * 44200
	foreach n nwav [
		if error? try [append wave to char! n][    ;converts the integer wave to 8-bit char format
			?? n halt
		]
	]
	while [(length? sample/data) < time] [append sample/data wave]
]

asdr: func [wave blk /local as an n ad] [
	as: 0
	an: 0
	n: 1
	foreach [l a] blk [
		ad: a - as / (l * length? wave)
		as: a
		loop to-integer l * length? wave [
			an: an + ad
			poke wave n to-integer 1 - an * 255
			n: n + 1
		]
	]
]

;----------=[Plot Functions]=----------;

plot: func [wav block color /bias /local y] [
	clear block
	append block reduce ['pen color 'line]
	n: pick [128 256] found? bias
	repeat x 512 [
		y: pick wav x
		append block reduce [as-pair x n as-pair x y]
	]
	append draw-block [pen white line 0x128 512x128]
]

;----------=[Sound Playing Functions]=----------;

play-sound: does [
	nwav: scale-wav wav pitch-slide/data
	generate-wave time
	shape-wav sample/data amp
	insert sound-port sample
    wait sound-port
]

;----------=[Commonly Used Functions]=----------;

refresh-wave: does [
	plot/bias wav draw-block orange
	if wave-disp [show wave-disp]
]

refresh-amp: does [
	plot amp amp-block leaf
	if amp-disp [show amp-disp]
]

;----------=[Inits And Globals]=----------;

wav: array/initial 512 128
amp: array/initial 512 255
sound-port: open sound://
sample: make sound [
    rate: 44200
    channels: 1
    bits: 8
    volume: 1.0
	data: #{}
]
prior-x: 1
time: 1
nwav: wav
wave: []
draw-block: []
amp-block: []
wave-disp: none
amp-disp: none
make-sine 
refresh-wave
asdr amp [.2 1 .1 .5 .5 .4 .2 0]
refresh-amp 


;----------=[GUI]=----------;
GUI: layout [
	style lab lab 50x15 white
	style text text white
	style box box edge [size: 2x2 color: white effect: [bevel]]
	backdrop black
	across
    size 800x730
    origin 0x0
    Title white "Kurtsynth Sound Demo"
	return
	box 780x2 white
	return
	text font-size 13 bold "Wave Properties"
	return
    wave-disp: box black 512x256 feel [
        engage: func [face action event /local x] [
				if find [down away] action [prior-x: event/offset/x]
				if find [down over] action [
					x: event/offset/x + 1
					poke wav x event/offset/y
					fill-gap wav prior-x x
					prior-x: x
					plot/bias wav draw-block orange
        	        show face
				]
            ]
        ] effect [draw draw-block]
	indent 22 btn 110x30 "Triangle" [make-tri refresh-wave]
	btn 110x30 "Random" [make-random refresh-wave]
	at 542x45 btn "Sine" 110x30 [make-sine refresh-wave]
	btn 110x30 "Sine * 2"  [make-sine2 refresh-wave]
	at 542x113 btn "Smooth" 110x30 [smooth-wav wav draw-block wave-disp orange refresh-wave] 
	btn "Clear" 110x30 [
		clear draw-block
		wav: array/initial 512 128
		refresh-wave
	]
	at 512x154 lab "Pitch:"
	pitch-slide: slider 200x15 [
		if zero? value [exit]
		nwav: scale-wav wav value
		set-face pitch-view round value * 100
	] with [data: .5]
	at 765x150 pitch-view: field 30x20 "50" [
		value: attempt [to-integer face/text]
		if value [
			value: max 1 min 100 value
			set-face pitch-slide value / 100
			face/text: form value
			show face
		]
	]
	at 512x184 lab "Length:"
	time-slide: slider 200x15 [
		if zero? value [exit]
		time: value * 2
		set-face time-view round/to value * 2 .1
		] with [data: .5]
		
	at 765x180 time-view: field 30x20 "1.0" [
		value: attempt [to-integer face/text]
		if value [
			value: max .00001 min 2 value
			set-face time-slide value * 2
			face/text: form value
			show face
		]
	]

	at 542x210 btn 227x50 "Save Wave Pattern" [
		file: request-file/save/only 
		if not file [exit]
		save file wav
		alert "Waveform saved!"
	]
	at 542x270 btn 227x50 "Load Wave Pattern" [
		file: request-file/only 
		if not file [exit]
		w: attempt [load file]
		if w [wav: w]
		refresh-wave
	]
	return
	box 780x2 white
	return
	text font-size 13 bold "Amplitude (Attack Sustain Release Decay) Properties"
	return
		amp-disp: box black 512x256 feel [
            engage: func [face action event /local x] [
				if find [down away] action [prior-x: event/offset/x]
				if find [down over] action [
					x: event/offset/x + 1
					poke amp x event/offset/y
					fill-gap amp prior-x x
					prior-x: x
					plot amp amp-block leaf
        	        show face
				]
            ]
        ] effect [draw amp-block]
	return
	at 542x380 btn 110x30 "Flat" [
		amp: array/initial 512 128
		refresh-amp
	]
	btn 110x30 "Guitar" [asdr amp [.1 1 .05 .8 .55 .4 .3 0] refresh-amp]
	at 542x414 btn 110x30 "Woodwind" [asdr amp [.15 1 .45 .8 .2 .3 .2 0] refresh-amp]
	btn 110x30 "Percussion" [asdr amp [.1 1 .05 .1 .85 0] refresh-amp] 
	at 542x448 btn 110x30 "Triangular" [asdr amp [.5 1 .5 0] refresh-amp]
    btn 110x30 "Vibrating" [asdr amp [.2 1 .05 .7 .05 1 .05 .7 .05 1 .05 .7 .05 .9 .1 .6 .1 .8 .15 .4 .15 .6] refresh-amp] 
    at 542x482 btn "Clear" 110x30 [amp: array/initial 512 255 refresh-amp] 
    btn 110x30 "Smooth" [smooth-wav amp amp-block amp-disp leaf refresh-amp]
    at 542x517 btn 227x50 "Save Amplitude" [
		file: request-file/save/only 
		if not file [exit]
		save file amp
		alert "Amplitude saved!"
	]
	at 542x577 btn 227x50 "Load Amplitude" [
		file: request-file/only 
		if not file [exit]
		a: attempt [load file]
		if a [amp: a]
		refresh-amp
	]
	return
	box 780x2 white
	return
	text font-size 13 bold "Other Options"
	return
    btn-enter 110x30 "Play Sound (F5)" keycode 'f5 [
		play-sound
	]
	lab 80"Master Vol:"
	slider 160x30 coal water [
		sample/volume: value
	] with [data: 1]
	btn 110x30 "Help" [view/new help?]
	btn 110x30 "About:" [alert "KurtSynth sound synthesizer demonstration. Author: Kurt Sassenrath"]
	return
	box 780x2 white
]

help?: layout [
	backdrop black
	vh1 white "Help for Kurtsynth"
	text white 300 "To edit a wave or asdr customly, simply click in the box and drag the mouse.  To make smoother paths, drag slower.  For jagged paths, drag quickly. Beware that when you go out of the box on the right side that you might get an error.  You can save and load your waves.  I hope you enjoy this program.  You can email me at Kurtsassenrath@gmail.com"  ]


view GUI