From 9c7f987cdfb2473e08e9868e88d36450079814d7 Mon Sep 17 00:00:00 2001 From: dschmenk Date: Tue, 25 Apr 2017 22:30:03 -0700 Subject: [PATCH] Macro capability --- SANDBOX.PO | Bin 143360 -> 143360 bytes src/samplesrc/a2pwm/._demo.po | Bin 0 -> 4096 bytes src/samplesrc/a2pwm/._lfo.po | Bin 0 -> 4096 bytes src/samplesrc/a2pwm/hilopwm.pla | 498 +++++++++++++++++++++++++------- src/samplesrc/a2pwm/lfo.po | Bin 143360 -> 143360 bytes src/samplesrc/a2pwm/makefile | 2 +- src/samplesrc/a2pwm/util.pla | 411 ++++++++++++++++---------- 7 files changed, 654 insertions(+), 257 deletions(-) create mode 100755 src/samplesrc/a2pwm/._demo.po create mode 100755 src/samplesrc/a2pwm/._lfo.po diff --git a/SANDBOX.PO b/SANDBOX.PO index e81dcd9799d7096ad9f8b6e014a7519c460457cd..25b2a17fc461d0d8c0073b4a4591f6e2b79c494f 100755 GIT binary patch delta 568 zcmY+BKTpC?6vgj-5Gj8J0*yha1Og6{MpQt@LNOsx+CWKI{Q}0t#0_+HB-l?N6N8Zu zH+SRW0-FhmgNsoYSMj|^A=shm``vTTIq7Rpg!V+Z6YYK@QE&l&lJK_ajSSNEYg=ml zuu@gaHMyo~1{*$o0fG~Nsm~tY*+W=EMes%f3UpdsDjXiwH#G>rK_Oef-8 Y$8NK8xzQTLg$p!Ko-yrpNB{r; delta 133 zcmZp8z|ru4V}lrrzyw({K?X2TW_Ya5E3sLPrJGrm!Ohdp#WhIJ#WBPYBzcmbk&$5o zBLhfv!M^7V3^sBa+>@`d>uqML`@^`2OO}a^k%58vu-s-vfxC=Ne9QP4FR$Vqox1Ojhs@R)|o50+1L3ClDJkFz{^v(m+1nBL)UWIgo;|%-Cq47!KeV z5)#CmaDEX)2g3}YGG;WTj6gnATqHR^SFbFysH8M8Co@y8EI%hNA84(q37VEs?q~>% zhQMeDjE2By2#kinXb6mkz-S1JhQMeDjE2By2;dI^P-hc_!9Xq~BePhcD784hv?w`M zAuYcsTOl*ABsH%jGe0jeC#O;&CpE1^At@&@FB{m?h3Xp86srH>UXfvt`~M#R-1aD8 literal 0 HcmV?d00001 diff --git a/src/samplesrc/a2pwm/._lfo.po b/src/samplesrc/a2pwm/._lfo.po new file mode 100755 index 0000000000000000000000000000000000000000..d5a959f9b4ffeab05290e7a33c76704157a98fbf GIT binary patch literal 4096 zcmZQz6=P>$Vqox1Ojhs@R)|o50+1L3ClDJkFz{^v(m+1nBL)UWIgo;|%-Cq47!KeV z5)#CmaDF932g3}YGG;WTj6gnATqHR^SFbFysH8M8Co@y8EI%hNA84(q37VEs?q~>% zhQMeDjE2By2#kinXb6mkz-S1JhQMeDjE2By2;dI^P-hc_!9Xq~BePhcD784hv?w`M zAuYcsTOl*ABsH%jGe0jeC#O;&CpE1^At@&@FB{m?h3Xp86srH>UXfvt`~M#RN{A?E literal 0 HcmV?d00001 diff --git a/src/samplesrc/a2pwm/hilopwm.pla b/src/samplesrc/a2pwm/hilopwm.pla index 7d91150..c4e937c 100755 --- a/src/samplesrc/a2pwm/hilopwm.pla +++ b/src/samplesrc/a2pwm/hilopwm.pla @@ -1,8 +1,30 @@ const inbuff = $200 const freemem = $0002 +const iobuffer = 0x1800 +const NMACROS = 7 const FALSE = 0 const TRUE = !FALSE // +// Macro sequence structure +// +struc t_macro + byte absStart + byte durAtk + byte durDcy + byte durSus + byte durRel + word rateAtk + word rateDcy + word rateRel + byte idxOctave + byte perLFO + byte idxLFO + byte[256] sequence +end +word macros // Pointer to macros +byte record[t_macro] // Recording buffer +word recording = FALSE // Recording key/flag +// // System variables. // word heap @@ -15,6 +37,14 @@ byte scale[] = 166, 156, 148, 139, 132, 124, 117, 111, 104, 99, 93, 88, 83, 78 // byte keytone[] = 'A','S','E','D','R','F','G','Y','H','U','J','I','K','L' // +// Macro sequence keys +// +byte keymacro[] = 'Z', 'X', 'C', 'V', 'B', 'N', 'M' +// +// Macro record keys +// +byte keyrecord[] = $1A, $18, $03, $16, $02, $0E, $0D +// // Which octave are we in // byte octave = 1 @@ -37,10 +67,53 @@ word atkRate = $07FF word dcyRate = $0000 word relRate = $00FF // +// Patch filename +// +byte patch = "PATCH" +byte modPatch = FALSE +// // Import utility routines // include "util.pla" // +// Load/Save PATCH +// +def loadPatch + byte refnum + + refnum = open(@patch, iobuffer) + if refnum + read(refnum, macros, t_macro * NMACROS) // Macros + read(refnum, @octave, @patch - @octave) // Initial values + close(refnum) + fin +end +def savePatch + byte refnum + + destroy(@patch) + create(@patch, $C3, $06, $00) // full access, BIN file + refnum = open(@patch, iobuffer) + if refnum + write(refnum, macros, t_macro * NMACROS) // Macros + write(refnum, @octave, @patch - @octave) // Initial values + close(refnum) + modPatch = FALSE + fin +end +// +// Query routines +// +def query(str) + byte c + + inverse + clearview + putsxy(20 - ^str / 2, 2, str) + c = toupper(getc) + return c == 'Y' +end +// // Display LFO bar // def showLFO @@ -48,18 +121,21 @@ def showLFO LFObar = (LFO+7)/8 grcolor(WHITE) - rect(34, 39, 6, 39, FALSE) + rect(33, 39, 6, 39, FALSE) if LFObar < 32 grcolor(ORANGE) - rect(35, 38, 7, 38-LFObar, TRUE) + rect(34, 38, 7, 38-LFObar, TRUE) fin if LFObar grcolor(DRKBLU) - rect(35, 38, 39-LFObar, 38, TRUE) + rect(34, 38, 39-LFObar, 38, TRUE) fin - putsxy(36, 0, " ") - gotoxy(36, 0) - puti(LFO) + // + //Show actual value + // + putsxy(35, 0, " ") + gotoxy(35, 0) + return puti(LFO) end // // Display LFO waveform @@ -87,7 +163,7 @@ def showWaveform // // Restore envelope // - envelope(atkLen, dcyLen, susLen, relLen, atkRate, dcyRate, relRate) + return envelope(atkLen, dcyLen, susLen, relLen, atkRate, dcyRate, relRate) end // // Display duration @@ -111,6 +187,12 @@ def showDuration fin grcolor(AQUA) rect(left, right, 0, 5, TRUE) + // + // Show actual value + // + putsxy(5, 3, " ") + gotoxy(5, 3) + return puti(duration) end // // Display octave @@ -120,7 +202,35 @@ def showOctave putsxy(0, 1, "----------------------------------------") normal putsxy(octave*10, 1, "----------") + return inverse +end +def showMainPanel inverse + clearview + showDuration + showWaveform + showLFO + putsxy(5, 0, "OSCILLATION OVERTHRUSTER 1.0") + normal + putsxy(1, 0, "1-8") + gotoxy(34, 0); putc('<') + gotoxy(38, 0); putc('>') + gotoxy(3, 3); putc('-') + gotoxy(8, 3); putc('+') + inverse + showOctave + normal + putsxy(0, 2, "<-") + putsxy(38, 2, "->") + inverse + putsxy(11, 3, "A S D F G H J K L") + normal + gotoxy(14, 2); putc('E') + gotoxy(16, 2); putc('R') + gotoxy(20, 2); putc('Y') + gotoxy(22, 2); putc('U') + gotoxy(24, 2); putc('I') + return inverse end // // Recalc envelope parameters @@ -133,123 +243,315 @@ def recalcEnv relRate = $0FFF/relLen end // +// Rest +// +def restnote + byte d + + for d = duration downto 1 + call($FCA8, $6A, 0, 0, 0) + next +end +// +// playback a sequence +// +def playback(seq) + word macro + byte seq, key, i, showUpdate + + macro = macros + t_macro * seq + // + // Start off with initial conditions + // + showUpdate = 0 + if macro->absStart + if macro->idxOctave <> octave + octave = macro->idxOctave + showUpdate = showUpdate | 1 + fin + if macro->idxLFO <> LFOmap + LFOmap = macro->idxLFO + showUpdate = showUpdate | 2 + fin + if macro->perLFO <> LFO + LFO = macro->perLFO + showUpdate = showUpdate | 4 + fin + if macro->durAtk + macro->durDcy + macro->durSus + macro->durRel <> duration + envelope(macro->durAtk, macro->durDcy, macro->durSus, macro->durRel, macro=>rateAtk, macro=>rateDcy, macro=>rateRel) + duration = macro->durAtk + macro->durDcy + macro->durSus + macro->durRel + showUpdate = showUpdate | 8 + fin + fin + // + // Run throught the sequence + // + for seq = 1 to macro->sequence + key = macro->sequence[seq] + // + // Check for tone keys + // + for i = 0 to 13 + if keytone[i] == key + if LFO == 0 + hilopwm(scale[i]>>octave, LFO, 0) + else + hilopwm(scale[i]>>octave, LFO, LFOmap) + fin + break + fin + next + // + // Check for macro keys + // + if i > 13 + for i = 0 to 6 + if keymacro[i] == key + playback(i) + break + fin + next + if i > 6 + when key + is ' ' + restnote + break + is $15 // -> + octave++ + showUpdate = showUpdate | 1 + break + is $08 // <- + showUpdate = showUpdate | 1 + octave-- + break + is '1' + is '2' + is '3' + is '4' + is '5' + is '6' + is '7' + is '8' + LFOmap = key - '1' + showUpdate = showUpdate | 2 + break + is '<' + is ',' + LFO-- + showUpdate = showUpdate | 4 + break + is '>' + is '.' + LFO++ + showUpdate = showUpdate | 4 + break + is '+' + is $0B // UP + duration++ + recalcEnv + envelope(atkLen, dcyLen, susLen, relLen, atkRate, dcyRate, relRate) + showUpdate = showUpdate | 8 + break + is '-' + is $0A // DOWN + duration-- + recalcEnv + envelope(atkLen, dcyLen, susLen, relLen, atkRate, dcyRate, relRate) + showUpdate = showUpdate | 8 + break + wend + fin + fin + next + // + // Udate display + // + if showUpdate & 1; showOctave; fin + if showUpdate & 2; showWaveform; fin + if showUpdate & 4; showLFO; fin + if showUpdate & 8; showDuration; fin +end +// // Main loop // def main byte quit, key, i - envelope(atkLen, dcyLen, susLen, relLen, atkRate, dcyRate, relRate) quit = FALSE repeat if keypressed key = toupper(getc) - when key - is $1B // ESC - quit = TRUE - break - is $15 // -> - if octave < 3 - octave++ - showOctave + // + // Check for tone keys + // + for i = 0 to 13 + if keytone[i] == key + if LFO == 0 + hilopwm(scale[i]>>octave, LFO, 0) + else + hilopwm(scale[i]>>octave, LFO, LFOmap) fin break - is $08 // <- - if octave > 0 - octave-- - showOctave + fin + next + // + // Check for macro keys + // + if i > 13 + for i = 0 to 6 + if keymacro[i] == key + playback(i) + break fin - break - is '1' - is '2' - is '3' - is '4' - is '5' - is '6' - is '7' - is '8' - LFOmap = key - '1' - showWaveform - break - is '<' - is ',' - LFO-- - showLFO - break - is '>' - is '.' - LFO++ - showLFO - break - is '+' - is $0B // UP - if duration < 40 - duration++ - recalcEnv - envelope(atkLen, dcyLen, susLen, relLen, atkRate, dcyRate, relRate) - showDuration - fin - break - is '-' - is $0A // DOWN - if duration > 2 - duration-- - recalcEnv - envelope(atkLen, dcyLen, susLen, relLen, atkRate, dcyRate, relRate) - showDuration - fin - break - otherwise - for i = 0 to 13 - if keytone[i] == key - if LFO == 0 - hilopwm(scale[i]>>octave, LFO, 0) - else - hilopwm(scale[i]>>octave, LFO, LFOmap) + next + if i > 6 + if not recording + for i = 0 to 6 + if keyrecord[i] == key + recording = (key << 8) | i + // + // Save current state + // + record.absStart = TRUE + record.durAtk = atkLen + record.durDcy = dcyLen + record.durSus = susLen + record.durRel = relLen + record.rateAtk = atkRate + record.rateDcy = dcyRate + record.rateRel = relRate + record.idxOctave = octave + record.perLFO = LFO + record.idxLFO = LFOmap + record.sequence = 0 + flash + putsxy(29, 3, "RECORDING") + inverse + key = 0 + break fin - break - fin - next - wend + next + fin + if i > 6 + when key + is $1B // ESC + if recording // Cancel recording + recording = FALSE + putsxy(29, 3, " ") + else + quit = query("QUIT (Y/N)?") + if not quit + showMainPanel + fin + fin + break + is '?' + record.absStart = FALSE + is '/' + if recording // Copy recorded macro to key macro + memcpy(macros + t_macro * (recording & $FF), @record, t_macro) + recording = FALSE + modPatch = TRUE + putsxy(29, 3, " ") + fin + break + is $15 // -> + if octave < 3 + octave++ + showOctave + else + key = 0 + fin + break + is $08 // <- + if octave > 0 + octave-- + showOctave + else + key = 0 + fin + break + is '1' + is '2' + is '3' + is '4' + is '5' + is '6' + is '7' + is '8' + LFOmap = key - '1' + showWaveform + break + is '<' + is ',' + LFO-- + showLFO + break + is '>' + is '.' + LFO++ + showLFO + break + is '+' + is $0B // UP + if duration < 40 + duration++ + recalcEnv + envelope(atkLen, dcyLen, susLen, relLen, atkRate, dcyRate, relRate) + showDuration + else + key = 0 + fin + break + is '-' + is $0A // DOWN + if duration > 1 + duration-- + recalcEnv + envelope(atkLen, dcyLen, susLen, relLen, atkRate, dcyRate, relRate) + showDuration + else + key = 0 + fin + break + is 'P' + if modPatch + savePatch + fin + break + wend + fin + fin + fin + if recording and key + if record.sequence < 255 + record.sequence++ + record.sequence[record.sequence] = key + fin + fin fin - //LFO = pdl(0) until quit end // // Get heap start. // -heap = *freemem +macros = *freemem +heap = macros + t_macro * NMACROS +loadPatch +memset(macros, 0, t_macro * NMACROS) call($FDED, $8D, 0, 0, 0) call($FDED, $91, 0, 0, 0)// CTRL-Q = turn off 80 column call($FDED, $8D, 0, 0, 0) ^$C000 = 0 // Turn off 80STORE grmode -clearview -showDuration -showWaveform -showLFO -putsxy(8, 0, "OSCILLATION OVERTHRUSTER") -normal -putsxy(2, 0, "1..8") -gotoxy(34, 0); putc('<') -gotoxy(39, 0); putc('>') -gotoxy(6, 3); putc('-') -gotoxy(32, 3); putc('+') -inverse -showOctave -normal -putsxy(0, 2, "<-") -putsxy(38, 2, "->") -inverse -putsxy(11, 3, "A S D F G H J K L") -normal -gotoxy(14, 2); putc('E') -gotoxy(16, 2); putc('R') -gotoxy(20, 2); putc('Y') -gotoxy(22, 2); putc('U') -gotoxy(24, 2); putc('I') -inverse +showMainPanel main +if modPatch + if query("SAVE PATCH (Y/N)?") + savePatch + fin +fin normal textmode done diff --git a/src/samplesrc/a2pwm/lfo.po b/src/samplesrc/a2pwm/lfo.po index 8578bcef5d8528894497e6f51c9d9539729f53cd..7246055c4575b7edcdc973746249c1971dc0d645 100755 GIT binary patch delta 3570 zcma(UTWl29_1wF&vunII1|0LKu@^V2H<#JFvuhGuVwN@7#IB|=H5X)(2(7HqWN|4n zXyuNmnn9J)j|!)1H~FCL2SREfQIt@?s`63ADGjaKsG({KJNNI{{e^XFB3-n-jR15}&^l@{fEq;YVXtL3Z=B{YFT8X$ zT>|{gFI>7hcZHw)8NW8aF!wG`!rMqa4N{_X@te<$5PFPPua>)87qibM$C4~27PHlx z<+T)FErwc zSEe`kNU(3zOuGxkUEKw79VH}0B?QXcGRh(q&4t;hOJ`$HX<=-OY6I(MI_n2Pq&1e@Wvv6&qF8+_#bPYwfM(Qc!dC*4OB>vNX0Ja0t+&x<7CjSnuFI zNVwDipO#ppyFx%&mwpiq9VV&*8BtV8lMdIZ5k=h?P@BZJSGWH^u9lO_AGdvMBKGJ$rYKTh_1`-?KZpXaDGg7@OF)SBy?1bKI=!W&|^u z%M7ZF_Nk1rAsm*r$x;DUK+I&3z+IM6SUkiwNle+lj<(TNtQ<~Dk2xkhRr`2a> z*7~w!QHr%=fnn{iQKhXT#3mHh8Da+%))iv=6t*VB#wCV!<>$+M#p52PS|!dKkN{?0 z!=!6oo*T90h{ca@=7x{p0D^;D4gE7oCK}! zf=*|t8eJvpS2#jhD=lGSc3@Eih-Yvo#z>c(ZmbQNyv{_#Lmbn)gEQ_B9KCPnoTYnV7umMpY@ zIEkD*VUHA60a{Gli@4oQSRAQg0+88`Oj{=`S3p%UVEOP}9Xi7NPC$)0El7$?i2WmA zL!pErwP#R4BO~@HV1-=D<6(I2;RdA2mR0aMeOfBjgv93_5xKRb6Vypt%Tm>jGVttQJ zFJ+R}ix8Z60qbTXcfu1mtg!&rIkfBeQU*t}cgw(U^ZsVw`1k&9;0EyiVPNZf|1@w9 z_};$^Tv6U_1Gkj-k%4}D9~+o+@2-JvdY>5JEg9kl4yg4wv0ElackY=O8Q=X>ILa_Q zL{_M$J_CINisnC47zT9F>IOh3f|Ix^gP%NU_W*DG;=Xa=C({SAyC2&ww9RtMBxUM` zpD^vW2-}Wj4(Pos*=(Vx6mAJ`AE=zwI(3@5CGR4FWKC&Eer=II%-po>lwR2>EV9e$ zsJD!`zUgt{g$aP~cGb0o%uq)Gg|rkXrAyKzuN~07dH1z2&L4i?B!8UkzH@%(ch7lW zvN*^t4zjx-Wi^1X9lVy2EdX#3IIt41oEjJ~qhob6L&LP)tf<~b9e);W9}y6X({0B` zYzCh$&RPvxj`dV*?tR^He8lde;v>Xvh@!Brtj&m)UB9X_)c^soBS4x}1^_isRGBBR z^@nP!!Cdv{* z756x9ca$NR{lI|=A3)OL+p$A3c-G|vMpq>vO_Wyo{hc|wJ6}@gfNA(ZzI1b+Rz@Oe zkPk?X3N$CX{E81r85KyY;h8AoN3zR)#T7LRKUPK)KHx*1jk!)A>FG6Hd=( zx%w#rcvj~+C5N-sQjC?(mawKEhy;3Kd0QYKIsy@vb= zr&HHxO$#K?N>9@q?snDbwrj_Iv`@pYoxmEx8VKb7c{U0E~56f##GT2_&kIl)$Ek6VfzhB_qb+1zvb9)W?c8 zp@GhabNw1;p64~fL|Ni#3Fh$fwGZYK53;^7xH!vJYshsJ)i$hXjgVRoWVKb!R!y44 zE{xMPo2Dho`h#Tz_~U-(dw^$8j%y3_Y|imKmop!Fp_Ed{1Febqz+DTa_`)QBu@U23 z2CRtHqU^~S?sPu_CAKgTyR`Q8knw8h?!b|SWBuCg{+j1>^H3UHNC7tkr0ha7zIS7_ zHXME})Cr`*{!mU|NW2@%4B&>+lCfT!S_#a=QXJ@|C9ni*A?$5yY zXFy~7G8q4_48;JFAFFaW#oD7zE>>-FjG z{uy^`1ng1q9JoBa`cg<}`ofOv?DpTJT5UJ9_lFbfD}Se7^MeCmj%Sq9>FLtOLF*0E ziusdRkdqj=cTS>T9~5nfBm{EEyquf@eG@bEO_WCCR|4L1Z7roj-Jm5xw`ARN^jpKQ zh35_5FP=$l;d9VvSx=UQb-D2BNJ@f46O?+*)CCB#WQUZxxqx*@T%wt6^w3N8BYYFfHj^VHjt8&@!)mq{(e=v>j=kVPS1~ z31coyiu=*tkTRudTH-Wn6f?1BAGL*A&op&YemX|6?8DvV^qurmY=`m@y@%$wdzCCE zi+PjV7u&>aXFU9`(P3;6n&I zB3#D-zT3!!cJc#-H_T%?P6~^~daKY@VwhljAU^-%O{SgZuEYn=eQg18odd1GlK4&J zKITw&CwYc+uqFQPd}SM#`Ve}n56NwVQg(2huW5CtFVtnQU=)3TYr;_Orhz#pHOB z=cXwylgr3e+_$j?@_TX^KO~k;rBf&P+0h!xPi+)lkNiTlQO}55yQa`p^h<^n;U8(0 z{?2$~XaQ5lj5BZP7{S)Ean`+UY1~GxG;VV17+&RXPPp#EM?!;`mSQ{mzQJpH-Z9~q zndZ5~6gIv49byyV|AO72oF*EGo4CPByoTr-Ze^^PoJ>B*w?@~JYe~BxN6(XOWTW7T z6j3hfJF&cL8}%9Wv!NiIMvtLWO~KCh=(9Aw`>D(}W}$Uro5ZeXzm03Sn9Kdh{Viep zc|ZTSus3B+)6L@7hFjB@{#<8di5gZ>MiY5{;u5<^sU+?rs<>EeEwPg5;qHqaCB7xr z@_V8JDUdE95^<9yWQu5yY$SJ(oFTF6GHIk7#?FwJdYY;1%yh)u)?Q72O8;PO zz2szGVRGYVT(q-0*b#~H`9dy*zj?r!#&7s^@m%^(r$XWew1GXQ97g^F$ijJ)PILjS z;=YR|5jG-&&x?&G#uA74XQGP;?JFFJ>?J-XCX2zYD+EOr8BT{MlI3K%aaU*yd4Sw* za&=m$k<>`bruG1Jlp17v^->tpB8OJt>`Ubbz}hHAn@9i5cd+Z z4ex~45L<{^cZSl4Ji=gZ?5HH3Cbn6IwSP`rApUBLyYwg0 zOIqv;THYr~svs%p+&$DuYSzFF!9tp5?##UVyud!?S02)SKitnjWf81~&D^}$ zO86qI;TxiF!)-8KNRJ+b2jLl^G|~vq!hPbyT?ArLoxvL(hK8em8M8xE(G27?f70DPITCIzBQegMBHk>wPh*s6)`92bTduPAm1H0HCRX9POZ-*Pj04~K#cXz zRl=YH%;vgcz2FLna?@iXp4xH`dKRro+S9xXh0&>jLxP#a zGNK{#@QFjjBj7hb`;bxt9s>)wmY5$r34Y_I#+HI-L4e;EeG$}xn*=ht2CM+HKe`?oo=VDj_zC@R6`1&X|iv*xcAP$dU z`;<7L3(FIRQDH2B352k?*Ze{UmcaV=HeJT;Y{hc19kgJ%H)&NfmLL@bbvfwu69ByA zSAWwOSf;K}F#}JjOH|CjLiKSKGcZ@3r(y;kQXf(=1NW=X7`Tn#SEnOnp4#nJ6AEORu#_x MQkOir^+{OwA9YOdT>t<8 diff --git a/src/samplesrc/a2pwm/makefile b/src/samplesrc/a2pwm/makefile index df9b77b..d5080af 100755 --- a/src/samplesrc/a2pwm/makefile +++ b/src/samplesrc/a2pwm/makefile @@ -24,5 +24,5 @@ clean: -rm *.o *~ *.a *.bin $(HILOPWM): a2pwm.s util.pla hilopwm.pla pwmvm.s $(PLASM) - ./$(PLASM) -A < hilopwm.pla > hilopwm.a + $(PLASM) -A < hilopwm.pla > hilopwm.a acme -o $(HILOPWM) pwmvm.s diff --git a/src/samplesrc/a2pwm/util.pla b/src/samplesrc/a2pwm/util.pla index 4ad9d8a..e4db7f2 100644 --- a/src/samplesrc/a2pwm/util.pla +++ b/src/samplesrc/a2pwm/util.pla @@ -22,6 +22,10 @@ word txt1scrn[] = $0400,$0480,$0500,$0580,$0600,$0680,$0700,$0780 word = $0428,$04A8,$0528,$05A8,$0628,$06A8,$0728,$07A8 word = $0450,$04D0,$0550,$05D0,$0650,$06D0,$0750,$07D0 // +// ProDOS error +// +byte perr +// // CALL 6502 ROUTINE // CALL(ADDR, AREG, XREG, YREG, STATUS) // @@ -63,225 +67,248 @@ CALL6502 JSR $FFFF REGVALS !FILL 4 end // +// CALL PRODOS +// SYSCALL(CMD, PARAMS) +// +asm syscall + LDA ESTKL,X + LDY ESTKH,X + STA PARAMS + STY PARAMS+1 + INX + LDA ESTKL,X + STA CMD + JSR $BF00 +CMD: !BYTE 00 +PARAMS: !WORD 0000 + LDY #$00 + STA ESTKL,X + STY ESTKH,X + RTS +end +// // SET MEMORY TO VALUE // MEMSET(ADDR, VALUE, SIZE) // With optimizations from Peter Ferrie // asm memset - LDA ESTKL+2,X - STA DSTL - LDA ESTKH+2,X - STA DSTH - LDY ESTKL,X - BEQ + - INC ESTKH,X - LDY #$00 -+ LDA ESTKH,X - BEQ SETMEX + LDA ESTKL+2,X + STA DSTL + LDA ESTKH+2,X + STA DSTH + LDY ESTKL,X + BEQ + + INC ESTKH,X + LDY #$00 ++ LDA ESTKH,X + BEQ SETMEX SETMLPL CLC - LDA ESTKL+1,X + LDA ESTKL+1,X SETMLPH STA (DST),Y - DEC ESTKL,X - BEQ ++ -- INY - BEQ + --- BCS SETMLPL - SEC - LDA ESTKH+1,X - BCS SETMLPH -+ INC DSTH - BNE -- -++ DEC ESTKH,X - BNE - + DEC ESTKL,X + BEQ ++ +- INY + BEQ + +-- BCS SETMLPL + SEC + LDA ESTKH+1,X + BCS SETMLPH ++ INC DSTH + BNE -- +++ DEC ESTKH,X + BNE - SETMEX INX - INX - RTS + INX + RTS end // // COPY MEMORY // MEMCPY(DSTADDR, SRCADDR, SIZE) // asm memcpy - INX - INX - LDA ESTKL-2,X - ORA ESTKH-2,X - BEQ CPYMEX - LDA ESTKL-1,X - CMP ESTKL,X - LDA ESTKH-1,X - SBC ESTKH,X - BCC REVCPY + INX + INX + LDA ESTKL-2,X + ORA ESTKH-2,X + BEQ CPYMEX + LDA ESTKL-1,X + CMP ESTKL,X + LDA ESTKH-1,X + SBC ESTKH,X + BCC REVCPY ; ; FORWARD COPY ; - LDA ESTKL,X - STA DSTL - LDA ESTKH,X - STA DSTH - LDA ESTKL-1,X - STA SRCL - LDA ESTKH-1,X - STA SRCH - LDY ESTKL-2,X - BEQ FORCPYLP - INC ESTKH-2,X - LDY #$00 + LDA ESTKL,X + STA DSTL + LDA ESTKH,X + STA DSTH + LDA ESTKL-1,X + STA SRCL + LDA ESTKH-1,X + STA SRCH + LDY ESTKL-2,X + BEQ FORCPYLP + INC ESTKH-2,X + LDY #$00 FORCPYLP LDA (SRC),Y - STA (DST),Y - INY - BNE + - INC DSTH - INC SRCH -+ DEC ESTKL-2,X - BNE FORCPYLP - DEC ESTKH-2,X - BNE FORCPYLP - RTS + STA (DST),Y + INY + BNE + + INC DSTH + INC SRCH ++ DEC ESTKL-2,X + BNE FORCPYLP + DEC ESTKH-2,X + BNE FORCPYLP + RTS ; ; REVERSE COPY ; REVCPY ;CLC - LDA ESTKL-2,X - ADC ESTKL,X - STA DSTL - LDA ESTKH-2,X - ADC ESTKH,X - STA DSTH - CLC - LDA ESTKL-2,X - ADC ESTKL-1,X - STA SRCL - LDA ESTKH-2,X - ADC ESTKH-1,X - STA SRCH - DEC DSTH - DEC SRCH - LDY #$FF - LDA ESTKL-2,X - BEQ REVCPYLP - INC ESTKH-2,X + LDA ESTKL-2,X + ADC ESTKL,X + STA DSTL + LDA ESTKH-2,X + ADC ESTKH,X + STA DSTH + CLC + LDA ESTKL-2,X + ADC ESTKL-1,X + STA SRCL + LDA ESTKH-2,X + ADC ESTKH-1,X + STA SRCH + DEC DSTH + DEC SRCH + LDY #$FF + LDA ESTKL-2,X + BEQ REVCPYLP + INC ESTKH-2,X REVCPYLP LDA (SRC),Y - STA (DST),Y - DEY - CPY #$FF - BNE + - DEC DSTH - DEC SRCH -+ DEC ESTKL-2,X - BNE REVCPYLP - DEC ESTKH-2,X - BNE REVCPYLP + STA (DST),Y + DEY + CPY #$FF + BNE + + DEC DSTH + DEC SRCH ++ DEC ESTKL-2,X + BNE REVCPYLP + DEC ESTKH-2,X + BNE REVCPYLP CPYMEX RTS end // // Unsigned word comparisons. // asm uword_isge - LDA ESTKL+1,X - CMP ESTKL,X - LDA ESTKH+1,X - SBC ESTKH,X - LDA #$FF - ADC #$00 - EOR #$FF - STA ESTKL+1,X - STA ESTKH+1,X - INX - RTS + LDA ESTKL+1,X + CMP ESTKL,X + LDA ESTKH+1,X + SBC ESTKH,X + LDA #$FF + ADC #$00 + EOR #$FF + STA ESTKL+1,X + STA ESTKH+1,X + INX + RTS end asm uword_isle - LDA ESTKL,X - CMP ESTKL+1,X - LDA ESTKH,X - SBC ESTKH+1,X - LDA #$FF - ADC #$00 - EOR #$FF - STA ESTKL+1,X - STA ESTKH+1,X - INX - RTS + LDA ESTKL,X + CMP ESTKL+1,X + LDA ESTKH,X + SBC ESTKH+1,X + LDA #$FF + ADC #$00 + EOR #$FF + STA ESTKL+1,X + STA ESTKH+1,X + INX + RTS end asm uword_isgt - LDA ESTKL,X - CMP ESTKL+1,X - LDA ESTKH,X - SBC ESTKH+1,X - LDA #$FF - ADC #$00 - STA ESTKL+1,X - STA ESTKH+1,X - INX - RTS + LDA ESTKL,X + CMP ESTKL+1,X + LDA ESTKH,X + SBC ESTKH+1,X + LDA #$FF + ADC #$00 + STA ESTKL+1,X + STA ESTKH+1,X + INX + RTS end asm uword_islt - LDA ESTKL+1,X - CMP ESTKL,X - LDA ESTKH+1,X - SBC ESTKH,X - LDA #$FF - ADC #$00 - STA ESTKL+1,X - STA ESTKH+1,X - INX - RTS + LDA ESTKL+1,X + CMP ESTKL,X + LDA ESTKH+1,X + SBC ESTKH,X + LDA #$FF + ADC #$00 + STA ESTKL+1,X + STA ESTKH+1,X + INX + RTS end // // Addresses of internal routines. // asm _hilopwm - TXA - PHA - JSR HILOPWM - PLA - TAX - DEX - RTS + TXA + PHA + JSR HILOPWM + PLA + TAX + DEX + RTS end asm toupper - LDA ESTKL,X + LDA ESTKL,X TOUPR AND #$7F - CMP #'a' - BCC + - CMP #'z'+1 - BCS + - SBC #$1F -+ STA ESTKL,X - RTS + CMP #'a' + BCC + + CMP #'z'+1 + BCS + + SBC #$1F ++ STA ESTKL,X + RTS end // // CONSOLE I/O // asm putc - LDA ESTKL,X -; JSR TOUPR - ORA #$80 - JMP $FDF0 + LDA ESTKL,X +; JSR TOUPR + ORA #$80 + JMP $FDF0 end asm getc - DEX -- LDA $C000 - BPL - - BIT $C010 - AND #$7F - STA ESTKL,X - LDA #$00 - STA ESTKH,X - RTS + DEX +- LDA $C000 + BPL - + BIT $C010 + AND #$7F + STA ESTKL,X + LDA #$00 + STA ESTKH,X + RTS end def keypressed return ^$C000 >= 128 end def pdl(num) return call($FB1E, 0, num, 0, 0)->2 -end +end def bttn(num) return (^$C061+num) >= 128 end def putln return putc($0D) end +def beep + return putc($07) +end def puts(str) byte i @@ -320,6 +347,9 @@ end def inverse ^$32 = $3F end +def flash + ^$32 = $1F +end def gotoxy(x, y) ^$24 = x + ^$20 return call($FB5B, y + ^$22, 0, 0, 0) @@ -341,7 +371,7 @@ end def clearview byte i word c - inverse + c = ' ' | $80 & ^$32 c = c | (c << 8) for i = ^$22 to ^$23 @@ -385,6 +415,71 @@ def rect(left, right, top, bottom, fill) fin end // +// ProDOS routines +// +def open(path, buff) + byte params[6] + + params.0 = 3 + params:1 = path + params:3 = buff + params.5 = 0 + perr = syscall($C8, @params) + return params.5 +end +def close(refnum) + byte params[2] + + params.0 = 1 + params.1 = refnum + perr = syscall($CC, @params) + return perr +end +def read(refnum, buff, len) + byte params[8] + + params.0 = 4 + params.1 = refnum + params:2 = buff + params:4 = len + params:6 = 0 + perr = syscall($CA, @params) + return params:6 +end +def write(refnum, buff, len) + byte params[8] + + params.0 = 4 + params.1 = refnum + params:2 = buff + params:4 = len + params:6 = 0 + perr = syscall($CB, @params) + return params:6 +end +def create(path, access, type, aux) + byte params[12] + + params.0 = 7 + params:1 = path + params.3 = access + params.4 = type + params:5 = aux + params.7 = $1 + params:8 = 0 + params:10 = 0 + perr = syscall($C0, @params) + return perr +end +def destroy(path) + byte params[3] + + params.0 = 1 + params:1 = path + perr = syscall($C1, @params) + return perr +end +// // HFO/LFO PWM sound routines // def envelope(attack, decay, sustain, release, ainc, dinc, rinc)