This repository has been archived on 2022-04-18. You can view files and clone it, but cannot push or open issues or pull requests.
kalama-sin/tracker.tal

296 lines
8.9 KiB
Tal

( a blank file )
( TODO fix ugly stack effects )
%+ { ADD } %- { SUB } %* { MUL } %/ { DIV }
%< { LTH } %> { GTH } %= { EQU } %! { NEQ }
%++ { ADD2 } %-- { SUB2 } %** { MUL2 } %// { DIV2 }
%<< { LTH2 } %>> { GTH2 } %== { EQU2 } %!! { NEQ2 }
%2* { #10 SFT } %2/ { #01 SFT } %2** { #10 SFT2 } %2// { #01 SFT2 }
%4* { #20 SFT } %4/ { #02 SFT } %4** { #20 SFT2 } %4// { #02 SFT2 }
%8* { #30 SFT } %8/ { #03 SFT } %8** { #30 SFT2 } %8// { #03 SFT2 }
%10* { #40 SFT } %10/ { #04 SFT } %10** { #40 SFT2 } %10// { #04 SFT2 }
%20* { #50 SFT } %20/ { #05 SFT } %20** { #50 SFT2 } %20// { #05 SFT2 }
%2MOD { #01 AND } %2MOD2 { #0001 AND2 }
%4MOD { #03 AND } %4MOD2 { #0003 AND2 }
%8MOD { #07 AND } %8MOD2 { #0007 AND2 }
%10MOD { #0f AND } %10MOD2 { #000f AND2 }
%DEBUG { ;print-hex/byte JSR2 #0a18 DEO }
%DEBUG2 { ;print-hex JSR2 #0a18 DEO }
%RTN { JMP2r }
%MOD { DIVk MUL SUB }
%MOD2 { DIV2k MUL2 SUB2 }
( devices )
|00 @System &vector $2 &wst $1 &rst $1 &eaddr $2 &ecode $1 &pad $1 &r $2 &g $2 &b $2 &debug $1 &halt $1
|10 @Console &vector $2 &read $1 &pad $5 &write $1 &error $1
|20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $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
|80 @Controller &vector $2 &button $1 &key $1 &func $1
|90 @Mouse &vector $2 &x $2 &y $2 &state $1 &pad $3 &scrollx $2 &scrolly $2
|a0 @File &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2
|b0 @DateTime &year $2 &month $1 &day $1 &hour $1 &minute $1 &second $1 &dotw $1 &doty $2 &isdst $1
( variables )
|0000
@kalama
&module $2 ( pointer to start of module file )
&loopflags $1 ( if different channels are set to loop )
&instruments $2 ( address that instruments start at )
&tick $1
&line $1
&speed $1
&songloop $1 ( if song loops or not )
&songpos $2 ( position in song table )
@tracker
&selected-pattern $1
( program )
|0100 ( -> )
( theme )
#0fe5 .System/r DEO2
#0fc5 .System/g DEO2
#0f25 .System/b DEO2
;module ;k-init-module/run JSR2
;on-input .Controller/vector DEO2
;redraw JSR2
BRK
@redraw ( -> )
#0000 .Screen/x DEO2
#0008 .Screen/y DEO2
;draw-song JSR2
#0008 .Screen/y DEO2
#0080 .Screen/x DEO2
;get-selected-song-line-address JSR2 ;draw-patterns JSR2
BRK
@on-input ( -> )
.Controller/button DEI
DUP #10 AND ,&up JCN
#20 AND ,&down JCN
BRK
&up
.tracker/selected-pattern LDZ #01 SUB .tracker/selected-pattern STZ
,&end JMP
&down
.tracker/selected-pattern LDZ #01 ADD .tracker/selected-pattern STZ
,&end JMP
&end
;redraw JSR2
BRK
@draw-patterns ( addr* )
DUP2
LDA ;draw-pattern JSR2
#0008 .Screen/y DEO2
.Screen/x DEI2 #0040 ADD2 .Screen/x DEO2
DUP2 #0001 ADD2 LDA ;draw-pattern JSR2
#0008 .Screen/y DEO2
.Screen/x DEI2 #0040 ADD2 .Screen/x DEO2
DUP2 #0002 ADD2 LDA ;draw-pattern JSR2
#0008 .Screen/y DEO2
.Screen/x DEI2 #0040 ADD2 .Screen/x DEO2
#0003 ADD2 LDA ;draw-pattern JSR2
RTN
@get-selected-song-line-address ( -- addr* )
.tracker/selected-pattern LDZ #00 SWP #0004 MUL2
.kalama/module LDZ2 #0005 ADD2 ADD2
RTN
@draw-song
.Screen/x DEI2 ,&pos STR2
#0005 .kalama/module LDZ2 ADD2 DUP2 ( first song line )
#0003 .kalama/module LDZ2 ADD2 LDA2 ( song length ) ADD2 STH2 ( stash end address )
&loop ( start-addr* )
DUP2
DUP2 ;get-selected-song-line-address JSR2 EQU2 ( if selected address is this one, use color 08. If not, use 01 ) ,&if JCN
,&else JMP
&if
#08 ,&end JMP
&else
#01
&end
;draw-song-line JSR2
,&pos LDR2 .Screen/x DEO2
.Screen/y DEI2 #0008 ADD2 .Screen/y DEO2
#0004 ADD2 DUP2
STHrk2 NEQ2 ,&loop JCN
POP2r POP2
RTN
&pos $2
&start-addr $2
@draw-song-line ( addr* color )
,&color STR
DUP2 #0004 ADD2 STH2 ( stash end address )
&loop ( start-addr* )
DUP2 LDA ,&color LDR ;draw-hex JSR2
#00 .Screen/sprite DEO
INC2 DUP2
STHrk2 NEQ2 ,&loop JCN
POP2r POP2
RTN
&color $1
@draw-pattern ( p )
.Screen/x DEI2 ,&x STR2
;k-get-pattern JSR2
DUP2 #0030 ADD2 STH2 ( stash address of end of pattern )
&loop ( addr )
DUP2 ;draw-pattern-line JSR2 ( addr )
#00 .Screen/auto DEO ( clear auto byte )
.Screen/y DEI2 #0008 ADD2 .Screen/y DEO2
,&x LDR2 .Screen/x DEO2
#0003 ADD2 ( addr+3 ) DUP2 STH2rk ( addr+3 addr+3 end ) NEQ2 ,&loop JCN
POP2 POP2r
RTN
&x $2
@draw-pattern-line ( addr )
#01 .Screen/auto DEO
DUP2 LDA #01 ;draw-note JSR2 ( draw note name )
#00 .Screen/sprite DEO ( space )
DUP2 #0001 ADD2 ( effect letter )
LDA #00 SWP ;&effect-letters ADD2 LDA #20 SUB #00 SWP #0008 MUL2 ;font ADD2 .Screen/addr DEO2 ( draw effect letter )
#01 .Screen/sprite DEO
#0002 ADD2 LDA #01 ;draw-hex JSR2 ( draw effect argument )
RTN
&effect-letters '- 'V 'I 'A 'D 'S 'R 'T
@draw-note ( n color -- )
#01 .Screen/auto DEO
STH ( stash color )
DUP #ff EQU ;&note-off JCN2
DUP #00 EQU ;&blank JCN2
DUP #0c MOD ( note minus octave )
#00 SWP #0002 MUL2
;&notes ADD2 LDA2 SWP
#20 SUB #00 SWP #0008 MUL2 ;font ADD2 .Screen/addr DEO2 ( first note character )
STHrk .Screen/sprite DEO
#20 SUB #00 SWP #0008 MUL2 ;font ADD2 .Screen/addr DEO2 ( second note character )
STHrk .Screen/sprite DEO
#0c DIV #10 ADD #00 SWP #0008 MUL2 ;font ADD2 .Screen/addr DEO2 ( octave number )
STHr .Screen/sprite DEO
RTN
&notes "C- "C# "D- "D# "E- "F- "F# "G- "G# "A- "A# "B-
&note-off
#5b #20 SUB #00 SWP #0008 MUL2 ;font ADD2 .Screen/addr DEO2 ( [ )
STHrk .Screen/sprite DEO
#00 .Screen/sprite DEO
#5d #20 SUB #00 SWP #0008 MUL2 ;font ADD2 .Screen/addr DEO2 ( ] )
STHr .Screen/sprite DEO
POP
RTN
&blank
#2d #20 SUB #00 SWP #0008 MUL2 ;font ADD2 .Screen/addr DEO2 ( - )
STHr
DUP .Screen/sprite DEO ( three times )
DUP .Screen/sprite DEO
.Screen/sprite DEO
POP
RTN
@draw-hex ( n color -- )
#01 .Screen/auto DEO
STH ( stash color )
DUP
#f0 AND #04 SFT ,&get-char JSR #0008 MUL2 ;font ADD2 .Screen/addr DEO2
STHrk .Screen/sprite DEO
#0f AND ,&get-char JSR #0008 MUL2 ;font ADD2 .Screen/addr DEO2
STHr .Screen/sprite DEO
RTN
&get-char ( d -- c* )
DUP #09 GTH ,&hex JCN
#10 ADD #00 SWP
RTN
&hex
#37 ADD #00 SWP
RTN
@print-hex ( value* -- )
SWP ,&byte JSR
&byte ( byte -- )
STHk #04 SFT ,&parse JSR #18 DEO
STHr #0f AND ,&parse JSR #18 DEO
RTN
&parse ( byte -- char ) DUP #09 GTH ,&above JCN #30 + RTN
&above #57 + RTN
RTN
~engine.tal
@font ( bbcmicro )
0000 0000 0000 0000 1818 1818 1800 1800
6c6c 6c00 0000 0000 3636 7f36 7f36 3600
0c3f 683e 0b7e 1800 6066 0c18 3066 0600
386c 6c38 6d66 3b00 0c18 3000 0000 0000
0c18 3030 3018 0c00 3018 0c0c 0c18 3000
0018 7e3c 7e18 0000 0018 187e 1818 0000
0000 0000 0018 1830 0000 007e 0000 0000
0000 0000 0018 1800 0006 0c18 3060 0000
3c66 6e7e 7666 3c00 1838 1818 1818 7e00
3c66 060c 1830 7e00 3c66 061c 0666 3c00
0c1c 3c6c 7e0c 0c00 7e60 7c06 0666 3c00
1c30 607c 6666 3c00 7e06 0c18 3030 3000
3c66 663c 6666 3c00 3c66 663e 060c 3800
0000 1818 0018 1800 0000 1818 0018 1830
0c18 3060 3018 0c00 0000 7e00 7e00 0000
3018 0c06 0c18 3000 3c66 0c18 1800 1800
3c66 6e6a 6e60 3c00 3c66 667e 6666 6600
7c66 667c 6666 7c00 3c66 6060 6066 3c00
786c 6666 666c 7800 7e60 607c 6060 7e00
7e60 607c 6060 6000 3c66 606e 6666 3c00
6666 667e 6666 6600 7e18 1818 1818 7e00
3e0c 0c0c 0c6c 3800 666c 7870 786c 6600
6060 6060 6060 7e00 6377 7f6b 6b63 6300
6666 767e 6e66 6600 3c66 6666 6666 3c00
7c66 667c 6060 6000 3c66 6666 6a6c 3600
7c66 667c 6c66 6600 3c66 603c 0666 3c00
7e18 1818 1818 1800 6666 6666 6666 3c00
6666 6666 663c 1800 6363 6b6b 7f77 6300
6666 3c18 3c66 6600 6666 663c 1818 1800
7e06 0c18 3060 7e00 7c60 6060 6060 7c00
0060 3018 0c06 0000 3e06 0606 0606 3e00
183c 6642 0000 0000 0000 0000 0000 00ff
1c36 307c 3030 7e00 0000 3c06 3e66 3e00
6060 7c66 6666 7c00 0000 3c66 6066 3c00
0606 3e66 6666 3e00 0000 3c66 7e60 3c00
1c30 307c 3030 3000 0000 3e66 663e 063c
6060 7c66 6666 6600 1800 3818 1818 3c00
1800 3818 1818 1870 6060 666c 786c 6600
3818 1818 1818 3c00 0000 367f 6b6b 6300
0000 7c66 6666 6600 0000 3c66 6666 3c00
0000 7c66 667c 6060 0000 3e66 663e 0607
0000 6c76 6060 6000 0000 3e60 3c06 7c00
3030 7c30 3030 1c00 0000 6666 6666 3e00
0000 6666 663c 1800 0000 636b 6b7f 3600
0000 663c 183c 6600 0000 6666 663e 063c
0000 7e0c 1830 7e00 0c18 1870 1818 0c00
1818 1800 1818 1800 3018 180e 1818 3000
316b 4600 0000 0000 ffff ffff ffff ffff
@module
~testmodule.tal