6502/PLASMA
1
0
Fork 0
mirror of https://github.com/dschmenk/PLASMA.git synced 2025-01-08 07:31:32 +00:00
Code Issues Projects Releases Wiki Activity

Macro capability

Browse Source
This commit is contained in:
dschmenk 2017-04-25 22:30:03 -07:00
parent 3f7ce73003
commit 9c7f987cdf
7 changed files with 654 additions and 257 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
SANDBOX.PO
View File

Binary file not shown.

BIN
src/samplesrc/a2pwm/._demo.po Executable file
View File

Binary file not shown.

BIN
src/samplesrc/a2pwm/._lfo.po Executable file
View File

Binary file not shown.

498
src/samplesrc/a2pwm/hilopwm.pla
View File

@ -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

BIN
src/samplesrc/a2pwm/lfo.po
View File

Binary file not shown.

2
src/samplesrc/a2pwm/makefile
View File

@ -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

411
src/samplesrc/a2pwm/util.pla
View File

@ -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)