diff --git a/SANDBOX.PO b/SANDBOX.PO
index e81dcd9..25b2a17 100755
Binary files a/SANDBOX.PO and b/SANDBOX.PO differ
diff --git a/src/samplesrc/a2pwm/._demo.po b/src/samplesrc/a2pwm/._demo.po
new file mode 100755
index 0000000..c29b0e3
Binary files /dev/null and b/src/samplesrc/a2pwm/._demo.po differ
diff --git a/src/samplesrc/a2pwm/._lfo.po b/src/samplesrc/a2pwm/._lfo.po
new file mode 100755
index 0000000..d5a959f
Binary files /dev/null and b/src/samplesrc/a2pwm/._lfo.po differ
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 8578bce..7246055 100755
Binary files a/src/samplesrc/a2pwm/lfo.po and b/src/samplesrc/a2pwm/lfo.po differ
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)