Skip to content

Instantly share code, notes, and snippets.

@tomaes
Last active June 21, 2020 14:54
Show Gist options
  • Save tomaes/5458ad48d02512d30ce5471bb9635287 to your computer and use it in GitHub Desktop.
Save tomaes/5458ad48d02512d30ce5471bb9635287 to your computer and use it in GitHub Desktop.
SID sounds test tool (verbose), written in COMAL-80
auto 100,4
// SID test mini
// in COMAL-80
// ----------
// procedures
// ----------
proc wait(count)
for i:=0 to count do null
endproc wait
proc init
dim wforms(4) // waveforms
dim sregs(8) // sid registers+1 (8: duration)
init'sregs
col:=646 // text color
sid:=54272 // sid start
scr:=53280 // frame (+1: backgr.)
u$:=chr$(18) // invers chars:on
v$:=chr$(146) // invers chars:off
w$:=chr$(221) // vertical bar
t$:="" // title header
t$:=u$+chr$(220) // invers:on + left-start
t$:+" SID test mini " +chr$(234) // title + vertical break
t$:+" v0.4 "+v$ // version + invers:off
z$:=""
poke scr+0,11 // gray frame
poke scr+1,11 // gray background
for i:=0 to 35 do
z$:+chr$(192)
endfor i
wforms(1):= %00010001 // 17: triangle
wforms(2):= %00100001 // 33: sawtooth
wforms(3):= %01000001 // 65: pulse ("rectangle")
wforms(4):= %10000001 // 129: white noise
randomize
endproc init
proc init'sregs
sregs(1):=3
sregs(2):=40
sregs(5):=17
sregs(6):=175
sregs(7):=50
sregs(8):=99
endproc init'sregs
proc play'sound
poke sid+24,15 // volume: max
poke sid+0,sregs(1) // freq.low
poke sid+1,sregs(2) // freq.high
poke sid+5,sregs(6) // env.: ad
poke sid+6,sregs(7) // env.: sr
poke sid+4,sregs(5) // waveform
wait(sregs(8)) // delay
poke sid+4,0 // release voice #1
endproc play'sound
proc random'sound
sregs(1):= rnd(0,255)
sregs(2):= rnd(0,255)
sregs(5):= wforms(rnd(1,4))
sregs(6):= rnd(0,15) + 16*rnd(0,15)
sregs(7):= rnd(0,15) + 16*rnd(0,15)
sregs(8):= rnd(10,990)
endproc random'sound
proc mutate'sound
for j:=0 to 3 do
for i:=1 to 8 do
sregs(i):+rnd(-1,1)
if sregs(i)<0 then sregs(i)=0
endfor i
endfor j
sregs(5):= wforms(rnd(1,4))
endproc mutate'sound
proc menu'screen
page
cursor 5,1
print chr$(14) // 2nd charset (a-z,A-Z)
poke col,1
print " ", chr$(240), // 1st long line
print z$ , chr$(238) // with corners
poke col,15
print " ", w$,
poke col,3
print t$,
poke col,15
print w$;
poke col,12
print " ", chr$(235), // 2nd long line
print z$ , chr$(243) // with corners
poke col,3
print " " , w$, " s+", u$, "0", v$, " (fq-l):",str$(sregs(1)),tab(20);
print "s+", u$, "1" , v$, " (fq-h):"; sregs(2), tab(39), w$
print " " , w$, " s+", u$, "4", v$, " (wavf):",str$(sregs(5)),tab(20);
print "s+", u$, "5" , v$, "/", u$, "6", v$, " (a):";
print str$(sregs(6)),"/", str$(sregs(7)), tab(39), w$
print " " , w$, " ", u$, "l", v$, "ength :", str$(sregs(8)),tab(20);
print u$ , "d" , v$, "efault" , tab(39), w$
print " " , w$, " ", u$, "r", v$, "andomize" , tab(20);
print u$ , "m" , v$, "utate" , tab(39), w$
print " ! ",u$, "p", v$, "lay (or ret.)", tab(20);
print "e" ,u$, "x", v$, "it" , tab(38); w$
poke col,15
print " ", chr$(237), // closing line
print z$ , chr$(253); // with corners
poke col,1
endproc menu'screen
// ---------
// main loop
// ---------
proc main
escape:=false
repeat
menu'screen
aa:=0
a$:=""
print
input " item >": a$;
case a$ of
when "p", "P", ""
play'sound
when "r", "R"
random'sound
when "l", "L"
a$:="7"
when "m", "M"
mutate'sound
when "d", "D"
init'sregs
when "x", "X", "exit"
escape:=true
otherwise
trap
aa:=val(a$)
handler
print " no command or register"
wait(2000)
goto no'op
endtrap
if aa<0 or aa>7 then
print " invalid register"
wait(2000)
goto no'op
endif
trap
input " val. >": sv;
handler
print " number required"
wait(2000)
goto no'op
endtrap
sregs(aa+1):=sv
no'op:
endcase
until escape
endproc main
proc done
poke scr, 14 // back to
poke scr+1,6 // system colors
poke col, 14
page // cls
print chr$(142) // 1st charset again
endproc done
// -----------
// entry point
// -----------
init
main
done
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment