425 lines
14 KiB
Plaintext
425 lines
14 KiB
Plaintext
( a blank file )
|
|
|
|
( macros )
|
|
%RTN { JMP2r } ( return from a subroutine )
|
|
%LOB { SWP POP } ( get low byte of short as byte )
|
|
%HIB { POP } ( get high byte of short as byte )
|
|
|
|
%MOD { DUP2 DIV MUL SUB }
|
|
|
|
( data structure access macros )
|
|
%NOTE { NOP } ( get the note of a pattern line addr )
|
|
%INST { #0001 ADD2 } ( get the instrument of a pattern line addr )
|
|
%VOL { #0002 ADD2 } ( get the volume of a pattern line addr )
|
|
|
|
( debugging macros )
|
|
%LOG { DUP .Console/byte DEO } ( prints a byte to the console non-destructively )
|
|
|
|
( constants )
|
|
%PTN_WIDTH { #0003 } ( pattern width. a short )
|
|
%PTN_LEN { #0010 } ( pattern length. a short )
|
|
|
|
( devices )
|
|
|
|
|00 @System [ &vector $2 &wst $1 &rst $1 &pad $4 &r $2 &g $2 &b $2 ]
|
|
|10 @Console [ &pad $8 &char $1 &byte $1 &short $2 &string $2 ]
|
|
|20 @Screen [ &vector $2 &width $2 &height $2 &pad $2 &x $2 &y $2 &addr $2 &color $1 ]
|
|
|30 @Audio0 [ &vector $2 &position $2 &output $1 &pad $3 &adsr $2 &length $2 &addr $2 &volume $1 &pitch $1 ]
|
|
|40 @Audio1 [ &vector $2 &position $2 &output $1 &pad $3 &adsr $2 &length $2 &addr $2 &volume $1 &pitch $1 ]
|
|
|50 @Audio2 [ &vector $2 &position $2 &output $1 &pad $3 &adsr $2 &length $2 &addr $2 &volume $1 &pitch $1 ]
|
|
|60 @Audio3 [ &vector $2 &position $2 &output $1 &pad $3 &adsr $2 &length $2 &addr $2 &volume $1 &pitch $1 ]
|
|
|70 @Midi [ &vector $2 &channel $1 ¬e $1 &velocity $1 ]
|
|
|80 @Controller [ &vector $2 &button $1 &key $1 ]
|
|
|90 @Mouse [ &vector $2 &x $2 &y $2 &state $1 &chord $1 ]
|
|
|a0 @File [ &vector $2 &success $2 &offset $2 &pad $2 &name $2 &length $2 &load $2 &save $2 ]
|
|
|b0 @DateTime [ &year $2 &month $1 &day $1 &hour $1 &minute $1 &second $1 &dotw $1 &doty $2 &isdst $1 ]
|
|
|
|
( variables )
|
|
|
|
|0000
|
|
|
|
@Playback [ &position $2 &pattern-addr $2 &tick $1 &speed $1 &playing $1 &pattern-index $1 ] ( pattern-index = 0-127 which pattern is selected from the pattern table )
|
|
@Draw [ &row $1 &col $1
|
|
&pattern-x $2 &pattern-y $2
|
|
&pattern-vspacing $2 &pattern-hspacing $2
|
|
&playhead-x $2 &playhead-y $2 ]
|
|
@Edit [ &selection-x $1 &selection-y $1 ]
|
|
|
|
@Pointer [ &x $2 &y $2 ]
|
|
|
|
( program )
|
|
|
|
|0100 ( -> )
|
|
|
|
( set a pallete )
|
|
#0f00 .System/r DEO2
|
|
#0f00 .System/g DEO2
|
|
#0fff .System/b DEO2
|
|
|
|
( speed - how many ticks we play a note every )
|
|
#10 .Playback/speed STZ
|
|
|
|
#00 .Playback/pattern-index STZ
|
|
;load-pattern JSR2
|
|
|
|
( display/audio init )
|
|
;on-frame .Screen/vector DEO2
|
|
;on-button .Controller/vector DEO2
|
|
;on-mouse .Mouse/vector DEO2
|
|
#0180 .Audio0/adsr DEO2
|
|
;wave .Audio0/addr DEO2
|
|
#0002 .Audio0/length DEO2
|
|
|
|
( drawing properties )
|
|
#0010 .Draw/pattern-x STZ2
|
|
#0010 .Draw/pattern-y STZ2
|
|
#0004 .Draw/pattern-vspacing STZ2
|
|
#0007 .Draw/playhead-x STZ2
|
|
#0004 .Draw/pattern-hspacing STZ2
|
|
|
|
#01 .Playback/playing STZ
|
|
|
|
BRK
|
|
|
|
( TODO either alloc or get-selected-addr is breaking things. Fix tomorrow. )
|
|
|
|
@alloc-pattern ( number -- ) ( allocates pattern n in the pattern table in a new area of memory. WILL OVERWRITE! )
|
|
#02 MUL #00 SWP ;pattern-table ADD2 ;pattern-pointer LDA2 SWP2 STA2 ( store current position of pattern pointer in pattern table for this pattern )
|
|
PTN_LEN PTN_WIDTH MUL2 ;pattern-pointer LDA2 ADD2 ;pattern-pointer STA2
|
|
|
|
RTN
|
|
|
|
@get-selected-addr ( -- addr* ) ( get the address of the current selection in the pattern )
|
|
.Playback/pattern-addr LDZ2 #00 .Edit/selection-x LDZ ADD2 #00 .Edit/selection-y LDZ PTN_WIDTH MUL2 ADD2
|
|
RTN
|
|
|
|
( loads the pattern pointed to by Playback/pattern-index. Allocs it if it doesn't exist. )
|
|
@load-pattern ( number -- )
|
|
.Playback/pattern-index LDZ #02 MUL #00 SWP ;pattern-table ADD2 LDA2 ( get current pattern address )
|
|
DUP2 #0000 NEQ ,&exists JCN ( if the pattern exists, don't alloc a new one )
|
|
.Playback/pattern-index LDZ ;alloc-pattern JSR2
|
|
&exists
|
|
POP2
|
|
.Playback/pattern-index LDZ #02 MUL #00 SWP ;pattern-table ADD2 LDA2 .Playback/pattern-addr STZ2
|
|
RTN
|
|
|
|
@handle-cursor ( controller -- ) ( handles moving the cursor around )
|
|
DUP #10 AND #00 NEQ ,&up JCN ( check the if the four directions are pressed )
|
|
DUP #20 AND ,&down JCN
|
|
DUP #40 AND ,&left JCN
|
|
#80 AND ,&right JCN
|
|
RTN ( if none are pressed, break )
|
|
&up
|
|
#00 .Edit/selection-y LDZ EQU ,&end JCN
|
|
.Edit/selection-y LDZ #01 SUB .Edit/selection-y STZ
|
|
RTN
|
|
&down
|
|
PTN_LEN #01 SUB .Edit/selection-y LDZ EQU ,&end JCN
|
|
.Edit/selection-y LDZ #01 ADD .Edit/selection-y STZ
|
|
RTN
|
|
&left
|
|
#00 .Edit/selection-x LDZ EQU ,&end JCN
|
|
.Edit/selection-x LDZ #01 SUB .Edit/selection-x STZ
|
|
RTN
|
|
&right
|
|
PTN_WIDTH #01 SUB .Edit/selection-x LDZ EQU ,&end JCN
|
|
.Edit/selection-x LDZ #01 ADD .Edit/selection-x STZ
|
|
&end
|
|
RTN
|
|
|
|
@handle-editing ( key -- )
|
|
DUP #2b EQU ,&plus JCN
|
|
#2d EQU ,&minus JCN
|
|
RTN
|
|
&plus
|
|
POP ( pop the key )
|
|
#00 .Edit/selection-x LDZ EQU ;get-selected-addr JSR2 LDA #6c EQU AND ,&end JCN ( if we're on a note and out of bounds, skip moving )
|
|
;get-selected-addr JSR2 DUP2 STH2 ( stash selection address and keep another copy on the stack )
|
|
LDA #01 ADD STH2r STA
|
|
RTN
|
|
&minus
|
|
#00 .Edit/selection-x LDZ EQU ;get-selected-addr JSR2 LDA #0c EQU AND ,&end JCN ( if we're on a note and out of bounds, skip moving )
|
|
;get-selected-addr JSR2 DUP2 STH2 ( stash selection address and keep another copy on the stack )
|
|
LDA #01 SUB STH2r STA
|
|
RTN
|
|
&end
|
|
RTN
|
|
|
|
@on-button ( -> )
|
|
.Controller/button DEI ( get button )
|
|
;handle-cursor JSR2
|
|
.Controller/key DEI DUP
|
|
;handle-editing JSR2
|
|
( play/pause )
|
|
DUP #70 EQU ,&pause JCN
|
|
DUP #3e EQU ,&next-pattern JCN
|
|
#3c EQU ,&prev-pattern JCN
|
|
.Playback/pattern-addr LDZ2 .Console/short DEO2
|
|
BRK
|
|
&pause
|
|
POP
|
|
.Playback/playing LDZ #00 EQU .Playback/playing STZ
|
|
BRK
|
|
&next-pattern ( TODO bounds checking to 127 )
|
|
POP
|
|
.Playback/pattern-index LDZ #01 ADD .Playback/pattern-index STZ
|
|
;load-pattern JSR2
|
|
BRK
|
|
&prev-pattern ( TODO bounds checking to 127 )
|
|
POP
|
|
.Playback/pattern-index LDZ #01 SUB .Playback/pattern-index STZ
|
|
;load-pattern JSR2
|
|
BRK
|
|
BRK
|
|
|
|
@on-frame ( -> )
|
|
;draw JSR2
|
|
.Playback/playing LDZ #00 NEQ ,&play JCN ( if we're paused, skip playback )
|
|
;pause JSR2
|
|
BRK
|
|
&play
|
|
.Playback/tick LDZ .Playback/speed LDZ NEQ ,&inc JCN ( if the tick != speed, skip to inc )
|
|
;on-step JSR2 ( otherwise, run the on-step routine )
|
|
#00 .Playback/tick STZ ( reset the tick )
|
|
,&end JMP ( jump to end )
|
|
&inc
|
|
#01 .Playback/tick LDZ ADD .Playback/tick STZ ( tick up 1 )
|
|
&end
|
|
BRK
|
|
|
|
@pause ( pause playback )
|
|
#00 .Playback/tick STZ
|
|
#ff .Audio1/pitch DEO
|
|
RTN
|
|
|
|
@draw-nibble ( nibble )
|
|
#00 SWP ;hex-chars ADD2 LDA #00 SWP #0008 MUL2 ;font ADD2 .Screen/addr DEO2 ( locate nibble in the hex font )
|
|
.Edit/selection-y LDZ .Draw/row LDZ NEQ
|
|
.Edit/selection-x LDZ .Draw/col LDZ NEQ ADD ( if the row and column are the selected ones, use a different color )
|
|
,&else JCN
|
|
#22 .Screen/color DEO
|
|
,&then JMP
|
|
&else
|
|
#21 .Screen/color DEO ( display it )
|
|
&then
|
|
.Screen/x DEI2 #0008 ADD2 .Screen/x DEO2 ( move right a sprite )
|
|
RTN
|
|
|
|
@draw-char ( char )
|
|
#00 SWP #0008 MUL2 ;font ADD2 .Screen/addr DEO2
|
|
.Edit/selection-y LDZ .Draw/row LDZ NEQ
|
|
.Edit/selection-x LDZ .Draw/col LDZ NEQ ADD ( if the row and column are the selected ones, use a different color )
|
|
,&else JCN
|
|
#22 .Screen/color DEO
|
|
,&then JMP
|
|
&else
|
|
#21 .Screen/color DEO ( display it )
|
|
&then
|
|
.Screen/x DEI2 #0008 ADD2 .Screen/x DEO2 ( move right a sprite )
|
|
RTN
|
|
|
|
( notes is a table of the note characters, starting at C. The highest bit is used to mark if it's sharp or not. )
|
|
@notes [ 23 a3 24 a4 25 26 a6 27 a7 21 a1 22 ]
|
|
|
|
( draw-note draws a byte as a note name and number on the screen )
|
|
@draw-note ( byte )
|
|
DUP #0c DIV #01 SUB STH ( stash octave )
|
|
DUP #6c LTH ,¬e JCN ( if note is in range, draw note, otherwise continue to draw a rest )
|
|
#3b ;draw-char JSR2
|
|
#00 ;draw-char JSR2
|
|
#3d ;draw-char JSR2 ( draws "[ ]" )
|
|
POPr ( remove octave from returnstack ) POP
|
|
RTN
|
|
¬e
|
|
#0c MOD #00 SWP ;notes ADD2 LDA DUP #7f AND ;draw-char JSR2
|
|
#80 AND ,&else JCN ( if the high bit is unset )
|
|
#00 ;draw-char JSR2 ( draw a space )
|
|
,&then JMP
|
|
&else
|
|
#03 ;draw-char JSR2 ( otherwise draw a # )
|
|
&then
|
|
STHr ;draw-nibble JSR2 ( unstash and draw octave number )
|
|
RTN
|
|
|
|
|
|
( draw-byte draws a byte as hex on the screen )
|
|
@draw-byte ( byte )
|
|
DUP #04 SFT ( high digit ) ;draw-nibble JSR2
|
|
#0f AND ( low digit ) ;draw-nibble JSR2
|
|
RTN
|
|
|
|
( draw-pattern-line draws a single line in a pattern )
|
|
@draw-pattern-line ( addr )
|
|
#00 .Draw/col STZ
|
|
&loop
|
|
#00 .Draw/col LDZ NEQ ,&else JCN ( if it's not the note value, draw a byte )
|
|
DUP2 LDA ;draw-note JSR2
|
|
,&then JMP
|
|
&else
|
|
DUP2 LDA ;draw-byte JSR2
|
|
&then
|
|
.Screen/x DEI2 #0004 ADD2 .Screen/x DEO2 ( add spacing between digits )
|
|
#0001 ADD2 ( get the next byte in the pattern )
|
|
#01 .Draw/col LDZ ADD .Draw/col STZ
|
|
.Draw/col LDZ PTN_WIDTH LOB NEQ ,&loop JCN
|
|
POP2 ( remove final address from stack )
|
|
RTN
|
|
|
|
( draw-pattern draws a pattern )
|
|
@draw-pattern ( addr )
|
|
#00 .Draw/row STZ
|
|
&loop
|
|
.Draw/pattern-y LDZ2 .Screen/x DEO2
|
|
DUP2 ;draw-pattern-line JSR2
|
|
.Screen/y DEI2 #0008 .Draw/pattern-vspacing LDZ2 ADD2 ADD2 .Screen/y DEO2 ( add spacing between rows )
|
|
PTN_WIDTH ADD2 ( get the next byte in the pattern )
|
|
#01 .Draw/row LDZ ADD .Draw/row STZ
|
|
.Draw/row LDZ PTN_LEN LOB NEQ ,&loop JCN
|
|
POP2 ( remove final address from stack )
|
|
RTN
|
|
|
|
@draw-playhead
|
|
( clear previous playhead )
|
|
.Draw/playhead-y LDZ2 .Screen/y DEO2
|
|
.Draw/playhead-x LDZ2 .Screen/x DEO2
|
|
#20 .Screen/color DEO
|
|
( draw new playhead )
|
|
.Draw/pattern-y LDZ2 .Playback/position LDZ2 #0001 SUB2 #0004 MUL2 ADD2 #0008 SUB2 DUP2 .Draw/playhead-y STZ2
|
|
.Screen/y DEO2
|
|
;playhead_icon .Screen/addr DEO2
|
|
#21 .Screen/color DEO
|
|
RTN
|
|
|
|
@draw
|
|
;draw-playhead JSR2
|
|
.Draw/pattern-x LDZ2 .Screen/x DEO2
|
|
.Draw/pattern-y LDZ2 .Screen/y DEO2
|
|
.Playback/pattern-addr LDZ2 ;draw-pattern JSR2
|
|
RTN
|
|
|
|
@on-step ( whenever a pattern step should be played )
|
|
|
|
PTN_WIDTH PTN_LEN MUL2 .Playback/position LDZ2 NEQ2 ,&continue JCN ( if we're at the end of the pattern, reset the counter )
|
|
#0000 .Playback/position STZ2
|
|
&continue
|
|
.Playback/position LDZ2 .Playback/pattern-addr LDZ2 ADD2 ( put pattern line address on the stack )
|
|
DUP2 VOL LDA .Audio0/volume DEO ( ln -- ) ( put the address of the pattern line on the stack )
|
|
NOTE LDA ( get the current note )
|
|
DUP #00 EQU ,&rest JCN ( if the note is 00, aka empty, skip playing it )
|
|
.Audio0/pitch DEO ( play the note )
|
|
,&end JMP ( jump to the end )
|
|
|
|
&rest POP ( if the note is a 00, jump here. POP to clean up the stack )
|
|
&end
|
|
PTN_WIDTH .Playback/position LDZ2 ADD2 .Playback/position STZ2
|
|
;draw-playhead JSR2 ( update the playhead position )
|
|
RTN
|
|
|
|
@draw-cursor ( -- )
|
|
|
|
;pointer_icon .Screen/addr DEO2
|
|
( clear last cursor )
|
|
.Pointer/x LDZ2 .Screen/x DEO2
|
|
.Pointer/y LDZ2 .Screen/y DEO2
|
|
#30 .Screen/color DEO
|
|
|
|
( record Pointer positions )
|
|
.Mouse/x DEI2 .Pointer/x STZ2
|
|
.Mouse/y DEI2 .Pointer/y STZ2
|
|
|
|
( draw new cursor )
|
|
.Pointer/x LDZ2 .Screen/x DEO2
|
|
.Pointer/y LDZ2 .Screen/y DEO2
|
|
#31 .Screen/color DEO
|
|
|
|
RTN
|
|
|
|
@on-mouse ( -> )
|
|
;draw-cursor JSR2
|
|
BRK
|
|
|
|
@wave [ ff 00 ]
|
|
|
|
@hex-chars [ 10 11 12 13 14 15 16 17 18 19 21 22 23 24 25 26 ] ( adding a hex digit to this address and loading will be that hex digit's code for the font )
|
|
]
|
|
@font ( specter8-frag font )
|
|
[
|
|
0000 0000 0000 0000 0008 0808 0800 0800
|
|
0014 1400 0000 0000 0024 7e24 247e 2400
|
|
0008 1e28 1c0a 3c08 0000 2204 0810 2200
|
|
0030 4832 4c44 3a00 0008 1000 0000 0000
|
|
0004 0808 0808 0400 0020 1010 1010 2000
|
|
0000 2214 0814 2200 0000 0808 3e08 0800
|
|
0000 0000 0000 0810 0000 0000 3e00 0000
|
|
0000 0000 0000 0800 0000 0204 0810 2000
|
|
003c 464a 5262 3c00 0018 0808 0808 1c00
|
|
003c 4202 3c40 7e00 003c 421c 0242 3c00
|
|
000c 1424 447e 0400 007e 407c 0242 3c00
|
|
003c 407c 4242 3c00 007e 0204 0810 1000
|
|
003c 423c 4242 3c00 003c 4242 3e02 3c00
|
|
0000 0010 0000 1000 0000 1000 0010 1020
|
|
0000 0810 2010 0800 0000 003e 003e 0000
|
|
0000 1008 0408 1000 003c 420c 1000 1000
|
|
003c 4232 4a42 3c00 003c 4242 7e42 4200
|
|
007c 427c 4242 7c00 003c 4240 4042 3c00
|
|
007c 4242 4242 7c00 007e 4078 4040 7e00
|
|
007e 4078 4040 4000 003c 4240 4642 3c00
|
|
0042 427e 4242 4200 001c 0808 0808 1c00
|
|
007e 0202 0242 3c00 0042 4478 4442 4200
|
|
0040 4040 4040 7e00 0042 665a 4242 4200
|
|
0042 6252 4a46 4200 003c 4242 4242 3c00
|
|
007c 4242 7c40 4000 003c 4242 4244 3a00
|
|
007c 4242 7c44 4200 003e 403c 0242 3c00
|
|
007e 0808 0808 1000 0042 4242 4244 3a00
|
|
0042 4242 4224 1800 0042 4242 5a66 4200
|
|
0042 423c 4242 4200 0042 423e 0242 3c00
|
|
007e 020c 3040 7e00 000c 0808 0808 0c00
|
|
0040 2010 0804 0200 0030 1010 1010 3000
|
|
0008 1400 0000 0000 0000 0000 0000 7e00
|
|
0008 0400 0000 0000 0000 3c02 3e42 3a00
|
|
0040 407c 4242 7c00 0000 3c42 4042 3c00
|
|
0002 023e 4242 3e00 0000 3c42 7e40 3e00
|
|
0000 3e40 7840 4000 0000 3c42 3e02 3c00
|
|
0040 405c 6242 4200 0008 0018 0808 0400
|
|
0008 0018 0808 4830 0040 4244 7844 4200
|
|
0010 1010 1010 0c00 0000 6c52 5252 5200
|
|
0000 5c62 4242 4200 0000 3c42 4242 3c00
|
|
0000 7c42 427c 4040 0000 3e42 423e 0202
|
|
0000 5c62 4040 4000 0000 3e40 3c02 7c00
|
|
0008 7e08 0808 1000 0000 4242 4244 3a00
|
|
0000 4242 4224 1800 0000 5252 5252 2e00
|
|
0000 4224 1824 4200 0000 4242 3e02 7c00
|
|
0000 7e02 3c40 7e00 000c 0810 1008 0c00
|
|
0008 0808 0808 0800 0030 1008 0810 3000
|
|
0000 0032 4c00 0000 3c42 99a1 a199 423c
|
|
]
|
|
|
|
@playhead_icon [ 00 60 78 7e 7e 78 60 00 ]
|
|
@pointer_icon [ 80c0 e0f0 f8e0 1000 ]
|
|
|
|
@pattern-table :pattern $fe ( the pattern table is a list of pattern addresses in memory )
|
|
|
|
@pattern-pointer :pattern/end ( the pattern pointer is a pointer to where in memory the next pattern will be put. )
|
|
|
|
( pattern format - each note has 3 bytes. Pitch, instrument, volume. patterns are 0x10 long.
|
|
an ff in the note column of the pattern will kill the existing note without starting a new one (this is the tracker "box" note) )
|
|
|
|
@pattern [
|
|
48 12 66
|
|
49 34 66
|
|
4a 56 22
|
|
4b 78 66
|
|
4c 9a 88
|
|
4d bc 66
|
|
4e de 66
|
|
4f ff 66
|
|
50 00 22
|
|
51 00 66
|
|
52 00 20
|
|
53 00 66
|
|
54 00 66
|
|
ff 00 66
|
|
56 00 ff
|
|
57 00 66 &end
|
|
]
|