( a blank file ) %+ { ADD } %- { SUB } %* { MUL } %/ { DIV } %< { LTH } %> { GTH } %= { EQU } %! { NEQ } %++ { ADD2 } %-- { SUB2 } %** { MUL2 } %// { DIV2 } %<< { LTH2 } %>> { GTH2 } %== { EQU2 } %!! { NEQ2 } %DEBUG { ;print-hex JSR2 #0a .Console/write DEO } %DEBUG2 { SWP ;print-hex JSR2 ;print-hex JSR2 #0a .Console/write DEO } %RTN { JMP2r } %inc-ptr-reg-nib { .ptr-register-nibbles LDZ #01 ADD #7f AND .ptr-register-nibbles STZ } %inc-ptr-reg-byt { .ptr-register-nibbles LDZ #02 ADD #7f AND .ptr-register-nibbles STZ } %dec-ptr-reg-nib { .ptr-register-nibbles LDZ #01 SUB #7f AND .ptr-register-nibbles STZ } %dec-ptr-reg-byt { .ptr-register-nibbles LDZ #02 SUB #7f AND .ptr-register-nibbles STZ } ( devices ) |00 @System [ &vector $2 &wst $1 &rst $1 &pad $4 &r $2 &g $2 &b $2 ] |10 @Console [ &vector $2 &read $1 &pad $5 &write $1 ] |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 &wheel $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 ] ( constants ) %die-color-normal { #53 } ( #53 ) %die-color-invert { #5b } %column-size { #08 } ( top left corner of registers column ) %pos-x-registers { #0010 } %pos-y-registers { #0010 } ( variables ) |0000 ( @registers $10 ) @ptr-register-nibbles $1 @framecount0 $1 @framecount1 $1 @beat0 $1 @beat1 $1 ( temp variables ) @die-color $1 @high-nibble $1 @low-nibble $1 ( program ) |0100 ( -> ) ( theme ) #1ec9 .System/r DEO2 #1d83 .System/g DEO2 #1d38 .System/b DEO2 #0f ;registers/count0 STA #208f ;registers/adsr0 STA2 #1a ;registers/pitch0 STA #77 ;registers/volume0 STA #ff ;registers/seq0 STA #0008 .Audio0/length DEO2 #0f ;registers/count1 STA #1ff0 ;registers/adsr1 STA2 #4c ;registers/pitch1 STA #11 ;registers/volume1 STA #aa ;registers/seq1 STA #0008 .Audio1/length DEO2 #00 .ptr-register-nibbles STZ ;on-frame .Screen/vector DEO2 ;on-controller .Controller/vector DEO2 BRK @on-frame ( -> ) .framecount0 LDZ #01 ADD DUP .framecount0 STZ ;registers/count0 LDA LTH ,&check-count1 JCN &play-sound0 #00 .framecount0 STZ ;registers/seq0 LDA .beat0 LDZ #01 ADD #07 AND DUP .beat0 STZ ( check sequencer ) SFT #01 AND #00 EQU ,&check-count1 JCN ( play if sequencer indicates ) ;registers/extra0 LDA #00 EQU ,&play0 JCN ( update note ) #00 .beat0 LDZ ;registers/melody0 ADD2 LDA ;registers/pitch0 STA &play0 ;registers/adsr0 LDA2 .Audio0/adsr DEO2 ;registers/volume0 LDA .Audio0/volume DEO ;registers/pitch0 LDA .Audio0/pitch DEO &check-count1 .framecount1 LDZ #01 ADD DUP .framecount1 STZ ;registers/count1 LDA LTH ,&draw-registers JCN &play-sound1 #00 .framecount1 STZ ;registers/seq1 LDA .beat1 LDZ #01 ADD #07 AND DUP .beat1 STZ SFT #01 AND #00 EQU ,&draw-registers JCN ( play if sequencer indicates ) ;registers/extra1 LDA #00 EQU ,&play1 JCN ( update note ) #00 .beat1 LDZ ;registers/melody1 ADD2 LDA ;registers/pitch1 STA &play1 ;registers/adsr1 LDA2 .Audio1/adsr DEO2 ;registers/volume1 LDA .Audio1/volume DEO ;registers/pitch1 LDA .Audio1/pitch DEO &draw-registers ( pos-x-registers pos-y-registers ;draw-registers JSR2 ) #0008 #0010 #00 ;draw-bytes JSR2 #0030 #0010 #08 ;draw-bytes JSR2 #0058 #0010 #10 ;draw-bytes JSR2 #0080 #0010 #18 ;draw-bytes JSR2 #00a8 #0010 #20 ;draw-bytes JSR2 #00d0 #0010 #28 ;draw-bytes JSR2 BRK @on-controller ( -> ) .Controller/button DEI DUP #10 AND ,&up JCN DUP #20 AND ,&down JCN DUP #40 AND ,&left JCN DUP #80 AND ,&right JCN DUP #01 AND ,&inc-nibble JCN DUP #02 AND ,&dec-nibble JCN POP &keys .Controller/key DEI DUP LIT 'j EQU ,&down JCN DUP LIT 'k EQU ,&up JCN DUP LIT '+ EQU ,&inc-nibble JCN DUP LIT '- EQU ,&dec-nibble JCN POP BRK ( registers ) &down inc-ptr-reg-byt POP BRK &up dec-ptr-reg-byt POP BRK &left inc-ptr-reg-nib POP BRK &right dec-ptr-reg-nib POP BRK &inc-nibble ( increment nibble ) #01 ;add-to-nibble JSR2 ( ;increment-nibble JSR2 ) POP BRK &dec-nibble ( dec nibble ) #ff ;add-to-nibble JSR2 POP BRK BRK @add-to-nibble ( a -- ) ( add a to nibble pointed by ptr-register-nibbles ) ,&num STR ,&start JMP &num $1 &start .ptr-register-nibbles LDZ ( get register address ) #01 SFT #00 SWP ;registers ADD2 ( calculate register address+offset ) STH2k ( store and keep address+offset ) LDA ( get register contents ) DUP ( duplicate byte ) #04 SFT #0f AND .high-nibble STZ ( store high nibble ) #0f AND .low-nibble STZ ( store low nibble ) .ptr-register-nibbles LDZ #01 AND ( are we in high 1 or low 0 nibble? ) ,&inc-high-nibble JCN &inc-low-nibble .low-nibble LDZ ,&num LDR ADD #0f AND ( increment and mask low nibble ) .low-nibble STZ ,&finish JMP &inc-high-nibble .high-nibble LDZ ,&num LDR ADD #0f AND ( increment and mask low nibble ) .high-nibble STZ &finish .high-nibble LDZ #40 SFT .low-nibble LDZ ORA ( reassemble byte ) STH2r ( recover byte address ) STA RTN @draw-bytes ( x2 y2 ptr-offset -- ) ;registers ,&addr STR2 ( starting address of bytes ) ,&offset STR ( starting offset of these bytes ) .ptr-register-nibbles ,&ptr-addr STR ( address of pointer to bytes ) ,&start JMP &addr $2 &offset $1 &ptr-addr $1 &start ,&offset LDR ( #00 ) &loop STH OVR2 OVR2 ( duplicate x2 y2 ) STHkr ( copy counter ) #00 SWP ,&addr LDR2 ADD2 LDA ( add counter as offset to address ) ,&ptr-addr LDR LDZ ( load pointer ) #01 SFT ( shift right to get byte number ) STHkr ( retrieve counter, copying ) NEQ ,&normal-mode JCN ( byte is selected ) ,&ptr-addr LDR LDZ ( load pointer ) #01 AND #01 ADD ( get rightmost bit and add one to get mode ) ,&draw JMP &normal-mode #00 ( mode ) &draw ;draw-byte JSR2 #0010 ADD2 ( increment y ) STHr ( recover counter ) #01 ADD DUP column-size ,&offset LDR ADD NEQ ,&loop JCN POP POP2 POP2 ( pop counter, x and y ) RTN @draw-registers ( x2 y2 -- ) #00 &loop STH OVR2 OVR2 ( duplicate x2 y2 ) STHkr ( copy counter ) #00 SWP ;registers ADD2 LDA ( add counter as offset to get value ) .ptr-register-nibbles LDZ ( load pointer ) #01 SFT ( shift right to get byte number ) STHr DUP STH ( retrieve, duplicate, store counter ) NEQ ,&normal-mode JCN ( byte is selected ) .ptr-register-nibbles LDZ ( load pointer ) #01 AND #01 ADD ( get rightmost bit and add one to get mode ) ,&draw JMP &normal-mode #00 ( mode ) &draw ;draw-byte JSR2 #0010 ADD2 ( increment y ) STHr ( recover counter ) #01 ADD DUP column-size NEQ ,&loop JCN POP POP2 POP2 ( pop counter, x and y ) RTN @draw-byte ( x2 y2 byte mode -- ) DUP #01 AND ,&low-nibble-mode STR ( mode 1 ) #01 SFT #01 AND ,&high-nibble-mode STR ( mode 2 ) ,&start JMP &high-nibble-mode $1 &low-nibble-mode $1 &start STH ( stash byte ) OVR2 OVR2 ( duplicate coordinates ) STHr DUP STH ( restore, duplicate, stash byte ) #04 SFT #0f AND ( get high nibble ) ,&high-nibble-mode LDR ;draw-nibble JSR2 ( draw high nibble ) SWP2 #0010 ADD2 SWP2 ( increment x ) STHr ( restore byte ) #0f AND ( get low nibble ) ,&low-nibble-mode LDR ;draw-nibble JSR2 ( draw low nibble ) RTN @draw-nibble ( x2 y2 num mode -- ) ,&set-invert JCN ( check mode: 0 is normal, nonzero is inverted ) &set-normal die-color-normal .die-color STZ ,&start JMP &set-invert die-color-invert .die-color STZ &start ( bit 3 ) STH .Screen/y DEO2 .Screen/x DEO2 STHr DUP STH #03 SFT #01 AND ,&bit-3-on JCN &bit-3-off ;nibble-dice-empty/tl .Screen/addr DEO2 ,&bit-3-draw JMP &bit-3-on ;nibble-dice-dot/tl .Screen/addr DEO2 &bit-3-draw .die-color LDZ .Screen/color DEO ( bit 2 ) STHr DUP STH .Screen/x DEI2 #0008 ADD2 .Screen/x DEO2 ( increment x ) #02 SFT #01 AND ,&bit-2-on JCN &bit-2-off ;nibble-dice-empty/tr .Screen/addr DEO2 ,&bit-2-draw JMP &bit-2-on ;nibble-dice-dot/tr .Screen/addr DEO2 &bit-2-draw .die-color LDZ .Screen/color DEO ( bit 0 ) STHr DUP STH .Screen/y DEI2 #0008 ADD2 .Screen/y DEO2 ( increment y ) #01 AND ,&bit-0-on JCN &bit-0-off ;nibble-dice-empty/br .Screen/addr DEO2 ,&bit-0-draw JMP &bit-0-on ;nibble-dice-dot/br .Screen/addr DEO2 &bit-0-draw .die-color LDZ .Screen/color DEO ( bit 1 ) STHr .Screen/x DEI2 #0008 SUB2 .Screen/x DEO2 ( decrement x ) #01 SFT #01 AND ,&bit-1-on JCN &bit-1-off ;nibble-dice-empty/bl .Screen/addr DEO2 ,&bit-1-draw JMP &bit-1-on ;nibble-dice-dot/bl .Screen/addr DEO2 &bit-1-draw .die-color LDZ .Screen/color DEO RTN @nibble-dice-empty ( top left, top right, bottom left, bottom right ) &tl 00 1f 3f 7f 7f 7f 7f 7f 00 1f 3f 7f 7f 7f 7f 7f &tr 00 f8 fc fe fe fe fe fe 00 f8 fc fe fe fe fe fe &bl 7f 7f 7f 7f 7f 3f 1f 00 7f 7f 7f 7f 7f 3f 1f 00 &br fe fe fe fe fe fc f8 00 fe fe fe fe fe fc f8 00 @nibble-dice-dot ( top left, top right, bottom left, bottom right ) &tl 00 1f 3f 7f 7f 7f 7f 7f 00 1f 3f 73 61 61 73 7f &tr 00 f8 fc fe fe fe fe fe 00 f8 fc ce 86 86 ce fe &bl 7f 7f 7f 7f 7f 3f 1f 00 7f 73 61 61 73 3f 1f 00 &br fe fe fe fe fe fc f8 00 fe ce 86 86 ce fc f8 00 |ff00 @registers &count0 $1 &pitch0 $1 &adsr0 $2 &volume0 $1 &seq0 $1 &extra0 $2 ( col 0 ) &melody0 1a1a 1d1d 2121 1d1d &sample0 ff00 0ff0 000f f000 &count1 $1 &pitch1 $1 &adsr1 $2 &volume1 $1 &seq1 $1 &extra1 $2 ( col 2 ) &melody1 3e41 453e 4145 3e41 &sample1 ffff ffff 0000 0000 &col2 $8 &col3 $8 &col4 $8