Ported projects to new assembler syntax
All these programs tested working, except for left, which compiles but doesn't run properly.
This commit is contained in:
parent
e065b8015a
commit
3c758b734b
|
@ -2,119 +2,123 @@
|
|||
|
||||
%RTN { JMP2r }
|
||||
%ABS2 { DUP2 #000f SFT2 EQU #04 JNZ #ffff MUL2 }
|
||||
%SCALEX { #0002 DIV2 ~Screen.width #0002 DIV2 ADD2 #0040 SUB2 }
|
||||
%SCALEY { #0002 DIV2 ~Screen.height #0002 DIV2 ADD2 #0040 SUB2 }
|
||||
%SCALEX { #0002 DIV2 .Screen/width DEI2 #0002 DIV2 ADD2 #0040 SUB2 }
|
||||
%SCALEY { #0002 DIV2 .Screen/height DEI2 #0002 DIV2 ADD2 #0040 SUB2 }
|
||||
%12HOURS { DUP #0c GTH #0c MUL SUB }
|
||||
%MOD { DUP2 DIV MUL SUB }
|
||||
|
||||
;current { second 1 }
|
||||
;needles { hx 2 hy 2 mx 2 my 2 sx 2 sy 2 }
|
||||
;line { x0 2 y0 2 x 2 y 2 sx 2 sy 2 dx 2 dy 2 e1 2 e2 2 }
|
||||
;color { byte 1 }
|
||||
|
||||
( devices )
|
||||
|
||||
|0100 ;System { vector 2 pad 6 r 2 g 2 b 2 }
|
||||
|0120 ;Screen { vector 2 width 2 height 2 pad 2 x 2 y 2 addr 2 color 1 }
|
||||
|01a0 ;DateTime { year 2 month 1 day 1 hour 1 minute 1 second 1 dotw 1 doty 2 isdst 1 refresh 1 }
|
||||
|00 @System [ &vector $2 &pad $6 &r $2 &g $2 &b $2 ]
|
||||
|20 @Screen [ &vector $2 &width $2 &height $2 &pad $2 &x $2 &y $2 &addr $2 &color $1 ]
|
||||
|a0 @DateTime [ &year $2 &month $1 &day $1 &hour $1 &minute $1 &second $1 &dotw $1 &doty $2 &isdst $1 &refresh $1 ]
|
||||
|
||||
( variables )
|
||||
|
||||
|0000
|
||||
|
||||
@current [ &second $1 ]
|
||||
@needles [ &hx $2 &hy $2 &mx $2 &my $2 &sx $2 &sy $2 ]
|
||||
@line [ &x0 $2 &y0 $2 &x $2 &y $2 &sx $2 &sy $2 &dx $2 &dy $2 &e1 $2 &e2 $2 ]
|
||||
@color [ &byte $1 ]
|
||||
|
||||
( program )
|
||||
|
||||
|0200
|
||||
|0100
|
||||
|
||||
( theme ) #0ff8 =System.r #0f08 =System.g #0f08 =System.b
|
||||
( vectors ) ,on-frame =Screen.vector
|
||||
( theme ) #0ff8 .System/r DEO2 #0f08 .System/g DEO2 #0f08 .System/b DEO2
|
||||
( vectors ) ;on-frame .Screen/vector DEO2
|
||||
|
||||
BRK
|
||||
|
||||
@on-frame
|
||||
|
||||
#00 =DateTime.refresh
|
||||
#00 .DateTime/refresh DEO
|
||||
|
||||
( only draw once per second )
|
||||
~DateTime.second ~current.second NEQ #01 JNZ BRK
|
||||
~DateTime.second =current.second
|
||||
.DateTime/second DEI .current/second PEK NEQ #01 JNZ BRK
|
||||
.DateTime/second DEI .current/second POK
|
||||
|
||||
( clear )
|
||||
#0080 SCALEX #0080 SCALEY ~needles.sx ~needles.sy #00 ,draw-line JSR2
|
||||
#0080 SCALEX #0080 SCALEY ~needles.mx ~needles.my #00 ,draw-line JSR2
|
||||
#0080 SCALEX #0080 SCALEY ~needles.hx ~needles.hy #00 ,draw-line JSR2
|
||||
#0080 SCALEX #0080 SCALEY .needles/sx PEK2 .needles/sy PEK2 #00 ;draw-line JSR2
|
||||
#0080 SCALEX #0080 SCALEY .needles/mx PEK2 .needles/my PEK2 #00 ;draw-line JSR2
|
||||
#0080 SCALEX #0080 SCALEY .needles/hx PEK2 .needles/hy PEK2 #00 ;draw-line JSR2
|
||||
|
||||
( place )
|
||||
#00 ~DateTime.second #0002 MUL2 ,table ADD2 LDR2
|
||||
#00 SWP SCALEY =needles.sy
|
||||
#00 SWP SCALEX =needles.sx
|
||||
#00 ~DateTime.minute #0002 MUL2 ,table ADD2 LDR2
|
||||
#00 SWP #0004 DIV2 #0003 MUL2 #0020 ADD2 SCALEY =needles.my
|
||||
#00 SWP #0004 DIV2 #0003 MUL2 #0020 ADD2 SCALEX =needles.mx
|
||||
#00 ~DateTime.hour 12HOURS #05 MUL #0002 MUL2 ,table ADD2 LDR2
|
||||
#00 SWP #0002 DIV2 #0040 ADD2 SCALEY =needles.hy
|
||||
#00 SWP #0002 DIV2 #0040 ADD2 SCALEX =needles.hx
|
||||
#00 .DateTime/second DEI #0002 MUL2 ;table ADD2 GET2
|
||||
#00 SWP SCALEY .needles/sy POK2
|
||||
#00 SWP SCALEX .needles/sx POK2
|
||||
#00 .DateTime/minute DEI #0002 MUL2 ;table ADD2 GET2
|
||||
#00 SWP #0004 DIV2 #0003 MUL2 #0020 ADD2 SCALEY .needles/my POK2
|
||||
#00 SWP #0004 DIV2 #0003 MUL2 #0020 ADD2 SCALEX .needles/mx POK2
|
||||
#00 .DateTime/hour DEI 12HOURS #05 MUL #0002 MUL2 ;table ADD2 GET2
|
||||
#00 SWP #0002 DIV2 #0040 ADD2 SCALEY .needles/hy POK2
|
||||
#00 SWP #0002 DIV2 #0040 ADD2 SCALEX .needles/hx POK2
|
||||
|
||||
( needles )
|
||||
#0080 SCALEX #0080 SCALEY ~needles.sx ~needles.sy #02 ,draw-line JSR2
|
||||
#0080 SCALEX #0080 SCALEY ~needles.mx ~needles.my #01 ,draw-line JSR2
|
||||
#0080 SCALEX #0080 SCALEY ~needles.hx ~needles.hy #03 ,draw-line JSR2
|
||||
#0080 SCALEX #0080 SCALEY .needles/sx PEK2 .needles/sy PEK2 #02 ;draw-line JSR2
|
||||
#0080 SCALEX #0080 SCALEY .needles/mx PEK2 .needles/my PEK2 #01 ;draw-line JSR2
|
||||
#0080 SCALEX #0080 SCALEY .needles/hx PEK2 .needles/hy PEK2 #03 ;draw-line JSR2
|
||||
|
||||
( circle )
|
||||
#00 #3c
|
||||
$loop
|
||||
( load ) OVR #00 SWP #0002 MUL2 ,table ADD2 LDR2
|
||||
#00 SWP SCALEY =Screen.y
|
||||
#00 SWP SCALEX =Screen.x
|
||||
OVR #0f MOD #00 EQU #01 ADD =Screen.color
|
||||
&loop
|
||||
( load ) OVR #00 SWP #0002 MUL2 ;table ADD2 GET2
|
||||
#00 SWP SCALEY .Screen/y DEO2
|
||||
#00 SWP SCALEX .Screen/x DEO2
|
||||
OVR #0f MOD #00 EQU #01 ADD .Screen/color DEO
|
||||
( incr ) SWP #01 ADD SWP
|
||||
DUP2 LTH ^$loop JNZ
|
||||
DUP2 LTH ,&loop JNZ
|
||||
POP2
|
||||
|
||||
( display )
|
||||
~Screen.height #0002 DIV2 #0048 ADD2 =Screen.y
|
||||
~Screen.width #0002 DIV2
|
||||
DUP2 #0020 SUB2 =Screen.x
|
||||
,font_hex #00 ~DateTime.hour #0a DIV #08 MUL ADD2 =Screen.addr
|
||||
#22 =Screen.color
|
||||
DUP2 #0018 SUB2 =Screen.x
|
||||
,font_hex #00 ~DateTime.hour #0a MOD #08 MUL ADD2 =Screen.addr
|
||||
#22 =Screen.color
|
||||
DUP2 #0008 SUB2 =Screen.x
|
||||
,font_hex #00 ~DateTime.minute #0a DIV #08 MUL ADD2 =Screen.addr
|
||||
#22 =Screen.color
|
||||
DUP2 =Screen.x
|
||||
,font_hex #00 ~DateTime.minute #0a MOD #08 MUL ADD2 =Screen.addr
|
||||
#22 =Screen.color
|
||||
DUP2 #0010 ADD2 =Screen.x
|
||||
,font_hex #00 ~DateTime.second #0a DIV #08 MUL ADD2 =Screen.addr
|
||||
#22 =Screen.color
|
||||
DUP2 #0018 ADD2 =Screen.x
|
||||
,font_hex #00 ~DateTime.second #0a MOD #08 MUL ADD2 =Screen.addr
|
||||
#22 =Screen.color
|
||||
.Screen/height DEI2 #0002 DIV2 #0048 ADD2 .Screen/y DEO2
|
||||
.Screen/width DEI2 #0002 DIV2
|
||||
DUP2 #0020 SUB2 .Screen/x DEO2
|
||||
;font_hex #00 .DateTime/hour DEI #0a DIV #08 MUL ADD2 .Screen/addr DEO2
|
||||
#22 .Screen/color DEO
|
||||
DUP2 #0018 SUB2 .Screen/x DEO2
|
||||
;font_hex #00 .DateTime/hour DEI #0a MOD #08 MUL ADD2 .Screen/addr DEO2
|
||||
#22 .Screen/color DEO
|
||||
DUP2 #0008 SUB2 .Screen/x DEO2
|
||||
;font_hex #00 .DateTime/minute DEI #0a DIV #08 MUL ADD2 .Screen/addr DEO2
|
||||
#22 .Screen/color DEO
|
||||
DUP2 .Screen/x DEO2
|
||||
;font_hex #00 .DateTime/minute DEI #0a MOD #08 MUL ADD2 .Screen/addr DEO2
|
||||
#22 .Screen/color DEO
|
||||
DUP2 #0010 ADD2 .Screen/x DEO2
|
||||
;font_hex #00 .DateTime/second DEI #0a DIV #08 MUL ADD2 .Screen/addr DEO2
|
||||
#22 .Screen/color DEO
|
||||
DUP2 #0018 ADD2 .Screen/x DEO2
|
||||
;font_hex #00 .DateTime/second DEI #0a MOD #08 MUL ADD2 .Screen/addr DEO2
|
||||
#22 .Screen/color DEO
|
||||
POP2
|
||||
|
||||
BRK
|
||||
|
||||
@draw-line ( x1 y1 x2 y2 color -- )
|
||||
|
||||
( load ) =color =line.y0 =line.x0 =line.y =line.x
|
||||
~line.x0 ~line.x SUB2 ABS2 =line.dx
|
||||
~line.y0 ~line.y SUB2 ABS2 #0000 SWP2 SUB2 =line.dy
|
||||
#ffff #00 ~line.x ~line.x0 LTS2 #0002 MUL2 ADD2 =line.sx
|
||||
#ffff #00 ~line.y ~line.y0 LTS2 #0002 MUL2 ADD2 =line.sy
|
||||
~line.dx ~line.dy ADD2 =line.e1
|
||||
$loop
|
||||
~line.x =Screen.x ~line.y =Screen.y ~color =Screen.color
|
||||
~line.x ~line.x0 EQU2 ~line.y ~line.y0 EQU2 #0101 EQU2 ^$end JNZ
|
||||
~line.e1 #0002 MUL2 =line.e2
|
||||
~line.e2 ~line.dy LTS2 ^$skipy JNZ
|
||||
~line.e1 ~line.dy ADD2 =line.e1
|
||||
~line.x ~line.sx ADD2 =line.x
|
||||
$skipy
|
||||
~line.e2 ~line.dx GTS2 ^$skipx JNZ
|
||||
~line.e1 ~line.dx ADD2 =line.e1
|
||||
~line.y ~line.sy ADD2 =line.y
|
||||
$skipx
|
||||
,$loop JMP2
|
||||
( load ) .color POK .line/y0 POK2 .line/x0 POK2 .line/y POK2 .line/x POK2
|
||||
.line/x0 PEK2 .line/x PEK2 SUB2 ABS2 .line/dx POK2
|
||||
.line/y0 PEK2 .line/y PEK2 SUB2 ABS2 #0000 SWP2 SUB2 .line/dy POK2
|
||||
#ffff #00 .line/x PEK2 .line/x0 PEK2 LTS2 #0002 MUL2 ADD2 .line/sx POK2
|
||||
#ffff #00 .line/y PEK2 .line/y0 PEK2 LTS2 #0002 MUL2 ADD2 .line/sy POK2
|
||||
.line/dx PEK2 .line/dy PEK2 ADD2 .line/e1 POK2
|
||||
&loop
|
||||
.line/x PEK2 .Screen/x DEO2 .line/y PEK2 .Screen/y DEO2 .color PEK .Screen/color DEO
|
||||
.line/x PEK2 .line/x0 PEK2 EQU2 .line/y PEK2 .line/y0 PEK2 EQU2 #0101 EQU2 ,&end JNZ
|
||||
.line/e1 PEK2 #0002 MUL2 .line/e2 POK2
|
||||
.line/e2 PEK2 .line/dy PEK2 LTS2 ,&skipy JNZ
|
||||
.line/e1 PEK2 .line/dy PEK2 ADD2 .line/e1 POK2
|
||||
.line/x PEK2 .line/sx PEK2 ADD2 .line/x POK2
|
||||
&skipy
|
||||
.line/e2 PEK2 .line/dx PEK2 GTS2 ,&skipx JNZ
|
||||
.line/e1 PEK2 .line/dx PEK2 ADD2 .line/e1 POK2
|
||||
.line/y PEK2 .line/sy PEK2 ADD2 .line/y POK2
|
||||
&skipx
|
||||
;&loop JMP2
|
||||
|
||||
$end
|
||||
&end
|
||||
|
||||
RTN
|
||||
|
||||
|
|
|
@ -1,249 +1,249 @@
|
|||
( a blank file )
|
||||
( mini music tracker )
|
||||
|
||||
%RTN { JMP2r }
|
||||
%8+ { #0008 ADD2 } %8- { #0008 SUB2 }
|
||||
%8* { #0008 MUL2 } %8/ { #0008 DIV2 }
|
||||
%++ { #0001 ADD2 }
|
||||
%++ { #0001 ADD2 }
|
||||
%MOD { DUP2 DIV MUL SUB }
|
||||
%TRACK { ,track.ch1 #00 ~track.active #0020 MUL2 ADD2 }
|
||||
%SOUND { STH #00 =Audio.value STHr #00 =Audio.delay }
|
||||
%SOUND_FINISH { #00 =Audio.finish }
|
||||
%TRACK { ;track/ch1 #00 .track/active PEK #0020 MUL2 ADD2 }
|
||||
%SOUND { STH #00 .Audio/value DEO2 STHr #00 .Audio/delay DEO2 }
|
||||
%SOUND_FINISH { #00 .Audio/finish DEO }
|
||||
|
||||
( variables )
|
||||
|
||||
;pointer { x 2 y 2 }
|
||||
;color { byte 1 }
|
||||
;rect { x1 2 y1 2 x2 2 y2 2 }
|
||||
;trkframe { x1 2 y1 2 x2 2 y2 2 }
|
||||
;chnframe { x1 2 y1 2 x2 2 y2 2 }
|
||||
;ctlframe { x1 2 y1 2 x2 2 y2 2 }
|
||||
;label { x 2 y 2 color 1 addr 2 }
|
||||
;knob { x 2 y 2 value 1 }
|
||||
;head { pos 1 }
|
||||
;track { active 1 ch1 20 ch2 20 ch3 20 ch4 20 }
|
||||
;adsr { ch1a 1 ch1d 1 ch1s 1 ch1r 1 ch2a 1 ch2d 1 ch2s 1 ch2r 1 ch3a 1 ch3d 1 ch3s 1 ch3r 1 ch4a 1 ch4d 1 ch4s 1 ch4r 1 }
|
||||
;volume { ch1 1 ch2 1 ch3 1 ch4 1 }
|
||||
@pointer [ &x $2 &y $2 ]
|
||||
@color [ &byte $1 ]
|
||||
@rect [ &x1 $2 &y1 $2 &x2 $2 &y2 $2 ]
|
||||
@trkframe [ &x1 $2 &y1 $2 &x2 $2 &y2 $2 ]
|
||||
@chnframe [ &x1 $2 &y1 $2 &x2 $2 &y2 $2 ]
|
||||
@ctlframe [ &x1 $2 &y1 $2 &x2 $2 &y2 $2 ]
|
||||
@label [ &x $2 &y $2 &color $1 &addr $2 ]
|
||||
@knob [ &x $2 &y $2 &value $1 ]
|
||||
@head [ &pos $1 ]
|
||||
@track [ &active $1 &ch1 $20 &ch2 $20 &ch3 $20 &ch4 $20 ]
|
||||
@adsr [ &ch1a $1 &ch1d $1 &ch1s $1 &ch1r $1 &ch2a $1 &ch2d $1 &ch2s $1 &ch2r $1 &ch3a $1 &ch3d $1 &ch3s $1 &ch3r $1 &ch4a $1 &ch4d $1 &ch4s $1 &ch4r $1 ]
|
||||
@volume [ &ch1 $1 &ch2 $1 &ch3 $1 &ch4 $1 ]
|
||||
|
||||
( devices )
|
||||
|
||||
|0100 ;System { vector 2 pad 6 r 2 g 2 b 2 }
|
||||
|0110 ;Console { vector 2 pad 6 char 1 byte 1 short 2 string 2 }
|
||||
|0120 ;Screen { vector 2 width 2 height 2 pad 2 x 2 y 2 addr 2 color 1 }
|
||||
|0130 ;Audio { wave 2 envelope 2 pad 4 volume 1 pitch 1 play 1 value 2 delay 2 finish 1 }
|
||||
|0140 ;Controller { vector 2 button 1 key 1 }
|
||||
|0160 ;Mouse { vector 2 x 2 y 2 state 1 chord 1 }
|
||||
|0170 ;File { vector 2 success 2 offset 2 pad 2 name 2 length 2 load 2 save 2 }
|
||||
|00 @System [ &vector $2 &pad $6 &r $2 &g $2 &b $2 ]
|
||||
|10 @Console [ &vector $2 &pad $6 &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 @Audio [ &wave $2 &envelope $2 &pad $4 &volume $1 &pitch $1 &play $1 &value $2 &delay $2 &finish $1 ]
|
||||
|40 @Controller [ &vector $2 &button $1 &key $1 ]
|
||||
|60 @Mouse [ &vector $2 &x $2 &y $2 &state $1 &chord $1 ]
|
||||
|70 @File [ &vector $2 &success $2 &offset $2 &pad $2 &name $2 &length $2 &load $2 &save $2 ]
|
||||
|
||||
( vectors )
|
||||
|
||||
|0200
|
||||
|0100
|
||||
|
||||
( theme ) #e0fa =System.r #30fa =System.g #30fa =System.b
|
||||
( vectors ) ,on-screen =Screen.vector
|
||||
( vectors ) ,on-mouse =Mouse.vector
|
||||
( vectors ) ,on-button =Controller.vector
|
||||
( theme ) #e0fa .System/r DEO2 #30fa .System/g DEO2 #30fa .System/b DEO2
|
||||
( vectors ) ;on-screen .Screen/vector DEO2
|
||||
( vectors ) ;on-mouse .Mouse/vector DEO2
|
||||
( vectors ) ;on-button .Controller/vector DEO2
|
||||
|
||||
~Screen.width #0002 DIV2 DUP2 #0080 SUB2 =trkframe.x1
|
||||
#0080 ADD2 =trkframe.x2
|
||||
~Screen.height #0002 DIV2 DUP2 #0038 SUB2 #0010 SUB2 =trkframe.y1
|
||||
#0038 ADD2 #0010 SUB2 =trkframe.y2
|
||||
.Screen/width DEI2 #0002 DIV2 DUP2 #0080 SUB2 .trkframe/x1 POK2
|
||||
#0080 ADD2 .trkframe/x2 POK2
|
||||
.Screen/height DEI2 #0002 DIV2 DUP2 #0038 SUB2 #0010 SUB2 .trkframe/y1 POK2
|
||||
#0038 ADD2 #0010 SUB2 .trkframe/y2 POK2
|
||||
|
||||
~trkframe.x1 =chnframe.x1 ~trkframe.y2 =chnframe.y1
|
||||
~chnframe.x1 #0030 ADD2 =chnframe.x2 ~chnframe.y1 #0030 ADD2 =chnframe.y2
|
||||
.trkframe/x1 PEK2 .chnframe/x1 POK2 .trkframe/y2 PEK2 .chnframe/y1 POK2
|
||||
.chnframe/x1 PEK2 #0030 ADD2 .chnframe/x2 POK2 .chnframe/y1 PEK2 #0030 ADD2 .chnframe/y2 POK2
|
||||
|
||||
~chnframe.x2 =ctlframe.x1 ~chnframe.y1 =ctlframe.y1
|
||||
~trkframe.x2 =ctlframe.x2 ~chnframe.y2 =ctlframe.y2
|
||||
.chnframe/x2 PEK2 .ctlframe/x1 POK2 .chnframe/y1 PEK2 .ctlframe/y1 POK2
|
||||
.trkframe/x2 PEK2 .ctlframe/x2 POK2 .chnframe/y2 PEK2 .ctlframe/y2 POK2
|
||||
|
||||
( default settings )
|
||||
,adsr-envelope =Audio.envelope
|
||||
#00 =adsr.ch1a #40 =adsr.ch1d #80 =adsr.ch1s #c0 =adsr.ch1r #88 =volume.ch1
|
||||
#10 =adsr.ch2a #50 =adsr.ch2d #90 =adsr.ch2s #d0 =adsr.ch2r #88 =volume.ch2
|
||||
#20 =adsr.ch3a #60 =adsr.ch3d #a0 =adsr.ch3s #e0 =adsr.ch3r #88 =volume.ch3
|
||||
;adsr-envelope .Audio/envelope DEO2
|
||||
#00 .adsr/ch1a POK #40 .adsr/ch1d POK #80 .adsr/ch1s POK #c0 .adsr/ch1r POK #88 .volume/ch1 POK
|
||||
#10 .adsr/ch2a POK #50 .adsr/ch2d POK #90 .adsr/ch2s POK #d0 .adsr/ch2r POK #88 .volume/ch2 POK
|
||||
#20 .adsr/ch3a POK #60 .adsr/ch3d POK #a0 .adsr/ch3s POK #e0 .adsr/ch3r POK #88 .volume/ch3 POK
|
||||
|
||||
~volume.ch3 =Audio.volume
|
||||
.volume/ch3 PEK .Audio/volume DEO
|
||||
|
||||
,draw-timeline JSR2
|
||||
,draw-controls JSR2
|
||||
,draw-channels JSR2
|
||||
;draw-timeline JSR2
|
||||
;draw-controls JSR2
|
||||
;draw-channels JSR2
|
||||
|
||||
BRK
|
||||
|
||||
@on-screen ( -> )
|
||||
|
||||
,move-head JSR2
|
||||
~head.pos #08 MOD #00 NEQ ^$skip JNZ
|
||||
,bang JSR2
|
||||
$skip
|
||||
;move-head JSR2
|
||||
.head/pos PEK #08 MOD #00 NEQ ,&skip JNZ
|
||||
;bang JSR2
|
||||
&skip
|
||||
|
||||
BRK
|
||||
|
||||
@on-mouse ( -> )
|
||||
|
||||
~Mouse.state #00 EQU ,$click-end JNZ2
|
||||
~Mouse.x ~trkframe.x1 GTH2 ~Mouse.x ~trkframe.x2 LTH2 #0101 EQU2
|
||||
~Mouse.y ~trkframe.y1 GTH2 ~Mouse.y ~trkframe.y2 LTH2 #0101 EQU2
|
||||
#0101 EQU2 ,touch-trk JNZ2
|
||||
~Mouse.x ~chnframe.x1 GTH2 ~Mouse.x ~chnframe.x2 LTH2 #0101 EQU2
|
||||
~Mouse.y ~chnframe.y1 8+ GTH2 ~Mouse.y ~chnframe.y2 8- LTH2 #0101 EQU2
|
||||
#0101 EQU2 ,touch-chn JNZ2
|
||||
~Mouse.x ~ctlframe.x1 GTH2 ~Mouse.x ~ctlframe.x2 LTH2 #0101 EQU2
|
||||
~Mouse.y ~ctlframe.y1 8+ GTH2 ~Mouse.y ~ctlframe.y2 8- LTH2 #0101 EQU2
|
||||
#0101 EQU2 ,touch-ctl JNZ2
|
||||
$click-end
|
||||
.Mouse/state DEI #00 EQU ;&click-end JNZ2
|
||||
.Mouse/x DEI2 .trkframe/x1 PEK2 GTH2 .Mouse/x DEI2 .trkframe/x2 PEK2 LTH2 #0101 EQU2
|
||||
.Mouse/y DEI2 .trkframe/y1 PEK2 GTH2 .Mouse/y DEI2 .trkframe/y2 PEK2 LTH2 #0101 EQU2
|
||||
#0101 EQU2 ;touch-trk JNZ2
|
||||
.Mouse/x DEI2 .chnframe/x1 PEK2 GTH2 .Mouse/x DEI2 .chnframe/x2 PEK2 LTH2 #0101 EQU2
|
||||
.Mouse/y DEI2 .chnframe/y1 PEK2 8+ GTH2 .Mouse/y DEI2 .chnframe/y2 PEK2 8- LTH2 #0101 EQU2
|
||||
#0101 EQU2 ;touch-chn JNZ2
|
||||
.Mouse/x DEI2 .ctlframe/x1 PEK2 GTH2 .Mouse/x DEI2 .ctlframe/x2 PEK2 LTH2 #0101 EQU2
|
||||
.Mouse/y DEI2 .ctlframe/y1 PEK2 8+ GTH2 .Mouse/y DEI2 .ctlframe/y2 PEK2 8- LTH2 #0101 EQU2
|
||||
#0101 EQU2 ;touch-ctl JNZ2
|
||||
&click-end
|
||||
|
||||
,draw-cursor JSR2
|
||||
;draw-cursor JSR2
|
||||
|
||||
BRK
|
||||
|
||||
@on-button ( -> )
|
||||
|
||||
~Controller.key
|
||||
DUP #61 NEQ ^$no-c JNZ
|
||||
,notes PEK2 ,play JSR2 $no-c
|
||||
DUP #73 NEQ ^$no-d JNZ
|
||||
,notes #0001 ADD2 PEK2 ,play JSR2 $no-d
|
||||
DUP #64 NEQ ^$no-e JNZ
|
||||
,notes #0002 ADD2 PEK2 ,play JSR2 $no-e
|
||||
DUP #66 NEQ ^$no-f JNZ
|
||||
,notes #0003 ADD2 PEK2 ,play JSR2 $no-f
|
||||
DUP #67 NEQ ^$no-g JNZ
|
||||
,notes #0004 ADD2 PEK2 ,play JSR2 $no-g
|
||||
DUP #68 NEQ ^$no-a JNZ
|
||||
,notes #0005 ADD2 PEK2 ,play JSR2 $no-a
|
||||
DUP #6a NEQ ^$no-b JNZ
|
||||
,notes #0006 ADD2 PEK2 ,play JSR2 $no-b
|
||||
DUP #6b NEQ ^$no-c2 JNZ
|
||||
,notes #0007 ADD2 PEK2 ,play JSR2 $no-c2
|
||||
.Controller/key DEI
|
||||
DUP #61 NEQ ,&no-c JNZ
|
||||
;notes GET ;play JSR2 &no-c
|
||||
DUP #73 NEQ ,&no-d JNZ
|
||||
;notes #0001 ADD2 GET ;play JSR2 &no-d
|
||||
DUP #64 NEQ ,&no-e JNZ
|
||||
;notes #0002 ADD2 GET ;play JSR2 &no-e
|
||||
DUP #66 NEQ ,&no-f JNZ
|
||||
;notes #0003 ADD2 GET ;play JSR2 &no-f
|
||||
DUP #67 NEQ ,&no-g JNZ
|
||||
;notes #0004 ADD2 GET ;play JSR2 &no-g
|
||||
DUP #68 NEQ ,&no-a JNZ
|
||||
;notes #0005 ADD2 GET ;play JSR2 &no-a
|
||||
DUP #6a NEQ ,&no-b JNZ
|
||||
;notes #0006 ADD2 GET ;play JSR2 &no-b
|
||||
DUP #6b NEQ ,&no-c2 JNZ
|
||||
;notes #0007 ADD2 GET ;play JSR2 &no-c2
|
||||
POP
|
||||
|
||||
BRK
|
||||
|
||||
@play ( pitch -- )
|
||||
|
||||
#80 ORA =Audio.pitch
|
||||
,triangle-wave =Audio.wave
|
||||
~track.active =Audio.play
|
||||
#80 ORA .Audio/pitch DEO
|
||||
;triangle-wave .Audio/wave DEO2
|
||||
.track/active PEK .Audio/play DEO
|
||||
|
||||
RTN
|
||||
|
||||
@touch-trk ( -- )
|
||||
|
||||
,clear-notes JSR2
|
||||
;clear-notes JSR2
|
||||
( get note )
|
||||
#0e ~Mouse.y ~trkframe.y1 SUB2 SWP POP #08 DIV SUB
|
||||
~Mouse.state #10 NEQ ^$no-erase JNZ POP #00 $no-erase
|
||||
#0e .Mouse/y DEI2 .trkframe/y1 PEK2 SUB2 SWP POP #08 DIV SUB
|
||||
.Mouse/state DEI #10 NEQ ,&no-erase JNZ POP #00 &no-erase
|
||||
( edit note )
|
||||
TRACK #00 ~Mouse.x ~trkframe.x1 SUB2 SWP POP #08 DIV ADD2 POK2
|
||||
( release ) #00 =Mouse.state
|
||||
,draw-notes JSR2
|
||||
TRACK #00 .Mouse/x DEI2 .trkframe/x1 PEK2 SUB2 SWP POP #08 DIV ADD2 PUT
|
||||
( release ) #00 .Mouse/state DEO
|
||||
;draw-notes JSR2
|
||||
|
||||
BRK
|
||||
|
||||
@touch-chn ( -- )
|
||||
|
||||
,clear-notes JSR2
|
||||
( save ) ~Mouse.y ~chnframe.y1 SUB2 SWP POP #08 DIV #01 SUB =track.active
|
||||
( release ) #00 =Mouse.state
|
||||
,draw-channels JSR2
|
||||
,draw-notes JSR2
|
||||
,draw-controls JSR2
|
||||
;clear-notes JSR2
|
||||
( save ) .Mouse/y DEI2 .chnframe/y1 PEK2 SUB2 SWP POP #08 DIV #01 SUB .track/active POK
|
||||
( release ) #00 .Mouse/state DEO
|
||||
;draw-channels JSR2
|
||||
;draw-notes JSR2
|
||||
;draw-controls JSR2
|
||||
|
||||
BRK
|
||||
|
||||
@touch-ctl ( -- )
|
||||
|
||||
~Mouse.x ~ctlframe.x1 SUB2 8- 8/ SWP POP #02 DIV
|
||||
DUP #00 NEQ ^$no-a JNZ
|
||||
,adsr #00 ~track.active #04 MUL ADD2 PEK2
|
||||
#10 ~Mouse.state #10 EQU #e0 MUL ADD ADD
|
||||
,adsr #00 ~track.active #04 MUL ADD2 POK2 $no-a
|
||||
DUP #01 NEQ ^$no-d JNZ
|
||||
,adsr #00 ~track.active #04 MUL ADD2 #0001 ADD2 PEK2
|
||||
#10 ~Mouse.state #10 EQU #e0 MUL ADD ADD
|
||||
,adsr #00 ~track.active #04 MUL ADD2 #0001 ADD2 POK2 $no-d
|
||||
DUP #02 NEQ ^$no-s JNZ
|
||||
,adsr #00 ~track.active #04 MUL ADD2 #0002 ADD2 PEK2
|
||||
#10 ~Mouse.state #10 EQU #e0 MUL ADD ADD
|
||||
,adsr #00 ~track.active #04 MUL ADD2 #0002 ADD2 POK2 $no-s
|
||||
DUP #03 NEQ ^$no-r JNZ
|
||||
,adsr #00 ~track.active #04 MUL ADD2 #0003 ADD2 PEK2
|
||||
#10 ~Mouse.state #10 EQU #e0 MUL ADD ADD
|
||||
,adsr #00 ~track.active #04 MUL ADD2 #0003 ADD2 POK2 $no-r
|
||||
DUP #05 NEQ ^$no-left JNZ
|
||||
,volume #00 ~track.active ADD2 PEK2
|
||||
#10 ~Mouse.state #10 EQU #e0 MUL ADD ADD
|
||||
,volume #00 ~track.active ADD2 POK2 $no-left
|
||||
DUP #06 NEQ ^$no-right JNZ
|
||||
,volume #00 ~track.active ADD2 PEK2
|
||||
DUP #f0 AND STH #01 ~Mouse.state #10 EQU #0e MUL ADD ADD #0f AND STHr ADD
|
||||
,volume #00 ~track.active ADD2 POK2 $no-right
|
||||
.Mouse/x DEI2 .ctlframe/x1 PEK2 SUB2 8- 8/ SWP POP #02 DIV
|
||||
DUP #00 NEQ ,&no-a JNZ
|
||||
;adsr #00 .track/active PEK #04 MUL ADD2 GET
|
||||
#10 .Mouse/state DEI #10 EQU #e0 MUL ADD ADD
|
||||
;adsr #00 .track/active PEK #04 MUL ADD2 PUT &no-a
|
||||
DUP #01 NEQ ,&no-d JNZ
|
||||
;adsr #00 .track/active PEK #04 MUL ADD2 #0001 ADD2 GET
|
||||
#10 .Mouse/state DEI #10 EQU #e0 MUL ADD ADD
|
||||
;adsr #00 .track/active PEK #04 MUL ADD2 #0001 ADD2 PUT &no-d
|
||||
DUP #02 NEQ ,&no-s JNZ
|
||||
;adsr #00 .track/active PEK #04 MUL ADD2 #0002 ADD2 GET
|
||||
#10 .Mouse/state DEI #10 EQU #e0 MUL ADD ADD
|
||||
;adsr #00 .track/active PEK #04 MUL ADD2 #0002 ADD2 PUT &no-s
|
||||
DUP #03 NEQ ,&no-r JNZ
|
||||
;adsr #00 .track/active PEK #04 MUL ADD2 #0003 ADD2 GET
|
||||
#10 .Mouse/state DEI #10 EQU #e0 MUL ADD ADD
|
||||
;adsr #00 .track/active PEK #04 MUL ADD2 #0003 ADD2 PUT &no-r
|
||||
DUP #05 NEQ ,&no-left JNZ
|
||||
;volume #00 .track/active PEK ADD2 GET
|
||||
#10 .Mouse/state DEI #10 EQU #e0 MUL ADD ADD
|
||||
;volume #00 .track/active PEK ADD2 PUT &no-left
|
||||
DUP #06 NEQ ,&no-right JNZ
|
||||
;volume #00 .track/active PEK ADD2 GET
|
||||
DUP #f0 AND STH #01 .Mouse/state DEI #10 EQU #0e MUL ADD ADD #0f AND STHr ADD
|
||||
;volume #00 .track/active PEK ADD2 PUT &no-right
|
||||
POP
|
||||
( release ) #00 =Mouse.state
|
||||
,draw-controls JSR2
|
||||
( release ) #00 .Mouse/state DEO
|
||||
;draw-controls JSR2
|
||||
|
||||
BRK
|
||||
|
||||
@bang ( -- )
|
||||
|
||||
,track.ch1 #00 ~head.pos #08 DIV ADD2 PEK2
|
||||
;track/ch1 #00 .head/pos PEK #08 DIV ADD2 GET
|
||||
#01 SUB
|
||||
DUP #ff NEQ ^$skip1 JNZ
|
||||
POP ^$listen2 JMP
|
||||
$skip1
|
||||
#00 SWP ,notes ADD2 PEK2 #80 ORA =Audio.pitch
|
||||
~volume.ch1 =Audio.volume
|
||||
,square-wave =Audio.wave
|
||||
#00 =Audio.play
|
||||
$listen2
|
||||
,track.ch2 #00 ~head.pos #08 DIV ADD2 PEK2
|
||||
DUP #ff NEQ ,&skip1 JNZ
|
||||
POP ,&listen2 JMP
|
||||
&skip1
|
||||
#00 SWP ;notes ADD2 GET #80 ORA .Audio/pitch DEO
|
||||
.volume/ch1 PEK .Audio/volume DEO
|
||||
;square-wave .Audio/wave DEO2
|
||||
#00 .Audio/play DEO
|
||||
&listen2
|
||||
;track/ch2 #00 .head/pos PEK #08 DIV ADD2 GET
|
||||
#01 SUB
|
||||
DUP #ff NEQ ^$skip2 JNZ
|
||||
POP ^$listen3 JMP
|
||||
$skip2
|
||||
#00 SWP ,notes ADD2 PEK2 #80 ORA =Audio.pitch
|
||||
~volume.ch2 =Audio.volume
|
||||
,square-wave =Audio.wave
|
||||
#01 =Audio.play
|
||||
$listen3
|
||||
,track.ch3 #00 ~head.pos #08 DIV ADD2 PEK2
|
||||
DUP #ff NEQ ,&skip2 JNZ
|
||||
POP ,&listen3 JMP
|
||||
&skip2
|
||||
#00 SWP ;notes ADD2 GET #80 ORA .Audio/pitch DEO
|
||||
.volume/ch2 PEK .Audio/volume DEO
|
||||
;square-wave .Audio/wave DEO2
|
||||
#01 .Audio/play DEO
|
||||
&listen3
|
||||
;track/ch3 #00 .head/pos PEK #08 DIV ADD2 GET
|
||||
#01 SUB
|
||||
DUP #ff NEQ ^$skip3 JNZ
|
||||
POP ^$end JMP
|
||||
$skip3
|
||||
#00 SWP ,notes ADD2 PEK2 #80 ORA =Audio.pitch
|
||||
~volume.ch3 =Audio.volume
|
||||
,triangle-wave =Audio.wave
|
||||
#02 =Audio.play
|
||||
$end
|
||||
DUP #ff NEQ ,&skip3 JNZ
|
||||
POP ,&end JMP
|
||||
&skip3
|
||||
#00 SWP ;notes ADD2 GET #80 ORA .Audio/pitch DEO
|
||||
.volume/ch3 PEK .Audio/volume DEO
|
||||
;triangle-wave .Audio/wave DEO2
|
||||
#02 .Audio/play DEO
|
||||
&end
|
||||
|
||||
RTN
|
||||
|
||||
@move-head ( -- )
|
||||
|
||||
( clear )
|
||||
~trkframe.y1 8- =Screen.y
|
||||
~trkframe.x1 #00 ~head.pos ADD2 =Screen.x
|
||||
,head_icn =Screen.addr
|
||||
#20 =Screen.color
|
||||
( incr ) ~head.pos #01 ADD =head.pos
|
||||
~trkframe.x1 #00 ~head.pos ADD2 =Screen.x
|
||||
,head_icn =Screen.addr
|
||||
#21 ( if note ) TRACK #00 ~head.pos #08 DIV ADD2 PEK2 #00 NEQ ADD =Screen.color
|
||||
.trkframe/y1 PEK2 8- .Screen/y DEO2
|
||||
.trkframe/x1 PEK2 #00 .head/pos PEK ADD2 .Screen/x DEO2
|
||||
;head_icn .Screen/addr DEO2
|
||||
#20 .Screen/color DEO
|
||||
( incr ) .head/pos PEK #01 ADD .head/pos POK
|
||||
.trkframe/x1 PEK2 #00 .head/pos PEK ADD2 .Screen/x DEO2
|
||||
;head_icn .Screen/addr DEO2
|
||||
#21 ( if note ) TRACK #00 .head/pos PEK #08 DIV ADD2 GET #00 NEQ ADD .Screen/color DEO
|
||||
|
||||
RTN
|
||||
|
||||
@clear-notes ( -- )
|
||||
|
||||
#00 #20
|
||||
$loop
|
||||
( load ) OVR #00 SWP TRACK ADD2 PEK2
|
||||
DUP STH #00 SWP #0e SWP SUB 8* ~trkframe.y1 ADD2 =Screen.y
|
||||
OVR #00 SWP 8* ~trkframe.x1 ADD2 =Screen.x
|
||||
STHr #00 EQU ^$skip JNZ
|
||||
#20 =Screen.color
|
||||
$skip
|
||||
&loop
|
||||
( load ) OVR #00 SWP TRACK ADD2 GET
|
||||
DUP STH #00 SWP #0e SWP SUB 8* .trkframe/y1 PEK2 ADD2 .Screen/y DEO2
|
||||
OVR #00 SWP 8* .trkframe/x1 PEK2 ADD2 .Screen/x DEO2
|
||||
STHr #00 EQU ,&skip JNZ
|
||||
#20 .Screen/color DEO
|
||||
&skip
|
||||
( incr ) SWP #01 ADD SWP
|
||||
DUP2 LTH ^$loop JNZ
|
||||
DUP2 LTH ,&loop JNZ
|
||||
POP2
|
||||
|
||||
RTN
|
||||
|
@ -251,63 +251,63 @@ RTN
|
|||
@draw-notes ( -- )
|
||||
|
||||
#00 #20
|
||||
$notes-loop
|
||||
( load ) OVR #00 SWP TRACK ADD2 PEK2
|
||||
DUP STH #00 SWP #0e SWP SUB 8* ~trkframe.y1 ADD2 =Screen.y
|
||||
OVR #00 SWP 8* ~trkframe.x1 ADD2 =Screen.x
|
||||
,note_icn =Screen.addr
|
||||
STHr #00 EQU ^$skip JNZ
|
||||
#25 =Screen.color
|
||||
$skip
|
||||
¬es-loop
|
||||
( load ) OVR #00 SWP TRACK ADD2 GET
|
||||
DUP STH #00 SWP #0e SWP SUB 8* .trkframe/y1 PEK2 ADD2 .Screen/y DEO2
|
||||
OVR #00 SWP 8* .trkframe/x1 PEK2 ADD2 .Screen/x DEO2
|
||||
;note_icn .Screen/addr DEO2
|
||||
STHr #00 EQU ,&skip JNZ
|
||||
#25 .Screen/color DEO
|
||||
&skip
|
||||
( incr ) SWP #01 ADD SWP
|
||||
DUP2 LTH ^$notes-loop JNZ
|
||||
DUP2 LTH ,¬es-loop JNZ
|
||||
POP2
|
||||
,draw-bars JSR2
|
||||
;draw-bars JSR2
|
||||
|
||||
RTN
|
||||
|
||||
@draw-bars ( -- )
|
||||
|
||||
~trkframe.x1 ~trkframe.y1 ~trkframe.x2 ~trkframe.y2 #01 ,line-rect JSR2
|
||||
.trkframe/x1 PEK2 .trkframe/y1 PEK2 .trkframe/x2 PEK2 .trkframe/y2 PEK2 #01 ;line-rect JSR2
|
||||
|
||||
( grid )
|
||||
~trkframe.y1 #0010 SUB2 =Screen.y
|
||||
,font_hex =Screen.addr
|
||||
.trkframe/y1 PEK2 #0010 SUB2 .Screen/y DEO2
|
||||
;font_hex .Screen/addr DEO2
|
||||
#0000 #0100
|
||||
$loop
|
||||
OVR2 SWP POP #02 DIV #0f AND #00 NEQ ^$skip JNZ
|
||||
OVR2 ~trkframe.x1 ADD2 =Screen.x
|
||||
~trkframe.y1 #0010 SUB2 =Screen.y
|
||||
#22 =Screen.color
|
||||
~Screen.addr 8+ =Screen.addr
|
||||
OVR2 ~trkframe.x1 ADD2 ~trkframe.y1 ++ ~trkframe.y2 #01 ,line-vertical-dotted JSR2
|
||||
$skip
|
||||
OVR2 ~trkframe.x1 ADD2 ~trkframe.y1 ~trkframe.y2 #01 ,line-vertical-dotted JSR2
|
||||
&loop
|
||||
OVR2 SWP POP #02 DIV #0f AND #00 NEQ ,&skip JNZ
|
||||
OVR2 .trkframe/x1 PEK2 ADD2 .Screen/x DEO2
|
||||
.trkframe/y1 PEK2 #0010 SUB2 .Screen/y DEO2
|
||||
#22 .Screen/color DEO
|
||||
.Screen/addr DEI2 8+ .Screen/addr DEO2
|
||||
OVR2 .trkframe/x1 PEK2 ADD2 .trkframe/y1 PEK2 ++ .trkframe/y2 PEK2 #01 ;line-vertical-dotted JSR2
|
||||
&skip
|
||||
OVR2 .trkframe/x1 PEK2 ADD2 .trkframe/y1 PEK2 .trkframe/y2 PEK2 #01 ;line-vertical-dotted JSR2
|
||||
SWP2 8+ SWP2
|
||||
OVR2 OVR2 LTH2 ^$loop JNZ
|
||||
OVR2 OVR2 LTH2 ,&loop JNZ
|
||||
POP2
|
||||
POP2
|
||||
|
||||
~trkframe.x1 ~trkframe.x2 ~trkframe.y1 8- #0040 ADD2 #01 ,line-horizontal-dotted JSR2
|
||||
.trkframe/x1 PEK2 .trkframe/x2 PEK2 .trkframe/y1 PEK2 8- #0040 ADD2 #01 ;line-horizontal-dotted JSR2
|
||||
|
||||
RTN
|
||||
|
||||
@draw-octave ( x y -- )
|
||||
|
||||
=Screen.y
|
||||
=Screen.x
|
||||
,octave_icn =Screen.addr
|
||||
~Screen.y ~Screen.y #0038 ADD2
|
||||
$loop
|
||||
OVR2 =Screen.y
|
||||
#21 =Screen.color
|
||||
~Screen.addr 8+ =Screen.addr
|
||||
~Screen.x 8+ =Screen.x
|
||||
#21 =Screen.color
|
||||
~Screen.addr 8+ =Screen.addr
|
||||
~Screen.x 8- =Screen.x
|
||||
.Screen/y DEO2
|
||||
.Screen/x DEO2
|
||||
;octave_icn .Screen/addr DEO2
|
||||
.Screen/y DEI2 .Screen/y DEI2 #0038 ADD2
|
||||
&loop
|
||||
OVR2 .Screen/y DEO2
|
||||
#21 .Screen/color DEO
|
||||
.Screen/addr DEI2 8+ .Screen/addr DEO2
|
||||
.Screen/x DEI2 8+ .Screen/x DEO2
|
||||
#21 .Screen/color DEO
|
||||
.Screen/addr DEI2 8+ .Screen/addr DEO2
|
||||
.Screen/x DEI2 8- .Screen/x DEO2
|
||||
SWP2 8+ SWP2
|
||||
OVR2 OVR2 LTH2 ^$loop JNZ
|
||||
OVR2 OVR2 LTH2 ,&loop JNZ
|
||||
POP2
|
||||
POP2
|
||||
|
||||
|
@ -315,103 +315,103 @@ RTN
|
|||
|
||||
@draw-octaves ( -- )
|
||||
|
||||
~trkframe.x1 #0018 SUB2 DUP2 ~trkframe.y1 ,draw-octave JSR2
|
||||
~trkframe.y1 #0038 ADD2 ,draw-octave JSR2
|
||||
~trkframe.x1 #0028 SUB2 =Screen.x
|
||||
~trkframe.y1 #0030 ADD2 =Screen.y
|
||||
,font_hex #0028 ADD2 =Screen.addr
|
||||
#23 =Screen.color
|
||||
~trkframe.x1 #0030 SUB2 =Screen.x
|
||||
,font_hex #0060 ADD2 =Screen.addr
|
||||
#23 =Screen.color
|
||||
~trkframe.x1 #0028 SUB2 =Screen.x
|
||||
~trkframe.y1 #0068 ADD2 =Screen.y
|
||||
,font_hex #0020 ADD2 =Screen.addr
|
||||
#23 =Screen.color
|
||||
~trkframe.x1 #0030 SUB2 =Screen.x
|
||||
,font_hex #0060 ADD2 =Screen.addr
|
||||
#23 =Screen.color
|
||||
.trkframe/x1 PEK2 #0018 SUB2 DUP2 .trkframe/y1 PEK2 ;draw-octave JSR2
|
||||
.trkframe/y1 PEK2 #0038 ADD2 ;draw-octave JSR2
|
||||
.trkframe/x1 PEK2 #0028 SUB2 .Screen/x DEO2
|
||||
.trkframe/y1 PEK2 #0030 ADD2 .Screen/y DEO2
|
||||
;font_hex #0028 ADD2 .Screen/addr DEO2
|
||||
#23 .Screen/color DEO
|
||||
.trkframe/x1 PEK2 #0030 SUB2 .Screen/x DEO2
|
||||
;font_hex #0060 ADD2 .Screen/addr DEO2
|
||||
#23 .Screen/color DEO
|
||||
.trkframe/x1 PEK2 #0028 SUB2 .Screen/x DEO2
|
||||
.trkframe/y1 PEK2 #0068 ADD2 .Screen/y DEO2
|
||||
;font_hex #0020 ADD2 .Screen/addr DEO2
|
||||
#23 .Screen/color DEO
|
||||
.trkframe/x1 PEK2 #0030 SUB2 .Screen/x DEO2
|
||||
;font_hex #0060 ADD2 .Screen/addr DEO2
|
||||
#23 .Screen/color DEO
|
||||
|
||||
RTN
|
||||
|
||||
@draw-timeline ( -- )
|
||||
|
||||
,draw-bars JSR2
|
||||
,draw-octaves JSR2
|
||||
;draw-bars JSR2
|
||||
;draw-octaves JSR2
|
||||
|
||||
RTN
|
||||
|
||||
@draw-knob ( x* y* value -- )
|
||||
|
||||
( load ) =knob.value =knob.y =knob.x
|
||||
~knob.x =Screen.x
|
||||
~knob.y =Screen.y ,knob_icns =Screen.addr #21 =Screen.color
|
||||
~knob.x 8+ =Screen.x ,knob_icns 8+ =Screen.addr #21 =Screen.color
|
||||
~knob.y 8+ =Screen.y ,knob_icns #0018 ADD2 =Screen.addr #21 =Screen.color
|
||||
~knob.x =Screen.x ,knob_icns #0010 ADD2 =Screen.addr #21 =Screen.color
|
||||
~knob.x #00 #00 ~knob.value ,knob_offsetx ADD2 PEK2 ADD2 =Screen.x
|
||||
~knob.y #00 #00 ~knob.value ,knob_offsety ADD2 PEK2 ADD2 =Screen.y
|
||||
,knob_icns #0020 ADD2 =Screen.addr
|
||||
#25 =Screen.color
|
||||
~knob.x #0004 ADD2 =Screen.x
|
||||
~knob.y #0010 ADD2 =Screen.y
|
||||
,font_hex #00 ~knob.value #08 MUL ADD2 =Screen.addr
|
||||
#21 =Screen.color
|
||||
( load ) .knob/value POK .knob/y POK2 .knob/x POK2
|
||||
.knob/x PEK2 .Screen/x DEO2
|
||||
.knob/y PEK2 .Screen/y DEO2 ;knob_icns .Screen/addr DEO2 #21 .Screen/color DEO
|
||||
.knob/x PEK2 8+ .Screen/x DEO2 ;knob_icns 8+ .Screen/addr DEO2 #21 .Screen/color DEO
|
||||
.knob/y PEK2 8+ .Screen/y DEO2 ;knob_icns #0018 ADD2 .Screen/addr DEO2 #21 .Screen/color DEO
|
||||
.knob/x PEK2 .Screen/x DEO2 ;knob_icns #0010 ADD2 .Screen/addr DEO2 #21 .Screen/color DEO
|
||||
.knob/x PEK2 #00 #00 .knob/value PEK ;knob_offsetx ADD2 GET ADD2 .Screen/x DEO2
|
||||
.knob/y PEK2 #00 #00 .knob/value PEK ;knob_offsety ADD2 GET ADD2 .Screen/y DEO2
|
||||
;knob_icns #0020 ADD2 .Screen/addr DEO2
|
||||
#25 .Screen/color DEO
|
||||
.knob/x PEK2 #0004 ADD2 .Screen/x DEO2
|
||||
.knob/y PEK2 #0010 ADD2 .Screen/y DEO2
|
||||
;font_hex #00 .knob/value PEK #08 MUL ADD2 .Screen/addr DEO2
|
||||
#21 .Screen/color DEO
|
||||
|
||||
RTN
|
||||
|
||||
@draw-controls ( -- )
|
||||
|
||||
~ctlframe.x1 ~ctlframe.y1 ~ctlframe.x2 ~ctlframe.y2 #01 ,line-rect JSR2
|
||||
.ctlframe/x1 PEK2 .ctlframe/y1 PEK2 .ctlframe/x2 PEK2 .ctlframe/y2 PEK2 #01 ;line-rect JSR2
|
||||
( env )
|
||||
~ctlframe.x1 8+ ~ctlframe.y1 8+ #22 ,env_txt ,draw-label JSR2
|
||||
~ctlframe.x1 8+ ~ctlframe.y1 #0010 ADD2
|
||||
,adsr #00 ~track.active #04 MUL ADD2 PEK2 #04 SFT
|
||||
,draw-knob JSR2
|
||||
~ctlframe.x1 #0018 ADD2 ~ctlframe.y1 #0010 ADD2
|
||||
,adsr #00 ~track.active #04 MUL ADD2 #0001 ADD2 PEK2 #04 SFT
|
||||
,draw-knob JSR2
|
||||
~ctlframe.x1 #0028 ADD2 ~ctlframe.y1 #0010 ADD2
|
||||
,adsr #00 ~track.active #04 MUL ADD2 #0002 ADD2 PEK2 #04 SFT
|
||||
,draw-knob JSR2
|
||||
~ctlframe.x1 #0038 ADD2 ~ctlframe.y1 #0010 ADD2
|
||||
,adsr #00 ~track.active #04 MUL ADD2 #0003 ADD2 PEK2 #04 SFT
|
||||
,draw-knob JSR2
|
||||
.ctlframe/x1 PEK2 8+ .ctlframe/y1 PEK2 8+ #22 ;env_txt ;draw-label JSR2
|
||||
.ctlframe/x1 PEK2 8+ .ctlframe/y1 PEK2 #0010 ADD2
|
||||
;adsr #00 .track/active PEK #04 MUL ADD2 GET #04 SFT
|
||||
;draw-knob JSR2
|
||||
.ctlframe/x1 PEK2 #0018 ADD2 .ctlframe/y1 PEK2 #0010 ADD2
|
||||
;adsr #00 .track/active PEK #04 MUL ADD2 #0001 ADD2 GET #04 SFT
|
||||
;draw-knob JSR2
|
||||
.ctlframe/x1 PEK2 #0028 ADD2 .ctlframe/y1 PEK2 #0010 ADD2
|
||||
;adsr #00 .track/active PEK #04 MUL ADD2 #0002 ADD2 GET #04 SFT
|
||||
;draw-knob JSR2
|
||||
.ctlframe/x1 PEK2 #0038 ADD2 .ctlframe/y1 PEK2 #0010 ADD2
|
||||
;adsr #00 .track/active PEK #04 MUL ADD2 #0003 ADD2 GET #04 SFT
|
||||
;draw-knob JSR2
|
||||
( vol )
|
||||
~ctlframe.x1 #0058 ADD2 ~ctlframe.y1 8+ #22 ,vol_txt ,draw-label JSR2
|
||||
~ctlframe.x1 #0058 ADD2 ~ctlframe.y1 #0010 ADD2
|
||||
,volume #00 ~track.active ADD2 PEK2 #04 SFT
|
||||
,draw-knob JSR2
|
||||
~ctlframe.x1 #0068 ADD2 ~ctlframe.y1 #0010 ADD2
|
||||
,volume #00 ~track.active ADD2 PEK2 #0f AND
|
||||
,draw-knob JSR2
|
||||
.ctlframe/x1 PEK2 #0058 ADD2 .ctlframe/y1 PEK2 8+ #22 ;vol_txt ;draw-label JSR2
|
||||
.ctlframe/x1 PEK2 #0058 ADD2 .ctlframe/y1 PEK2 #0010 ADD2
|
||||
;volume #00 .track/active PEK ADD2 GET #04 SFT
|
||||
;draw-knob JSR2
|
||||
.ctlframe/x1 PEK2 #0068 ADD2 .ctlframe/y1 PEK2 #0010 ADD2
|
||||
;volume #00 .track/active PEK ADD2 GET #0f AND
|
||||
;draw-knob JSR2
|
||||
|
||||
RTN
|
||||
|
||||
@draw-channels
|
||||
|
||||
~chnframe.x1 ~chnframe.y1 ~chnframe.x2 ~chnframe.y2 #01 ,line-rect JSR2
|
||||
~chnframe.x1 8+ ~chnframe.y1 8+ #21 ~track.active #00 EQU #07 MUL ADD ,ch1_txt ,draw-label JSR2
|
||||
~chnframe.x1 8+ ~chnframe.y1 #0010 ADD2 #21 ~track.active #01 EQU #07 MUL ADD ,ch2_txt ,draw-label JSR2
|
||||
~chnframe.x1 8+ ~chnframe.y1 #0018 ADD2 #21 ~track.active #02 EQU #07 MUL ADD ,ch3_txt ,draw-label JSR2
|
||||
~chnframe.x1 8+ ~chnframe.y1 #0020 ADD2 #21 ~track.active #03 EQU #07 MUL ADD ,ch4_txt ,draw-label JSR2
|
||||
.chnframe/x1 PEK2 .chnframe/y1 PEK2 .chnframe/x2 PEK2 .chnframe/y2 PEK2 #01 ;line-rect JSR2
|
||||
.chnframe/x1 PEK2 8+ .chnframe/y1 PEK2 8+ #21 .track/active PEK #00 EQU #07 MUL ADD ;ch1_txt ;draw-label JSR2
|
||||
.chnframe/x1 PEK2 8+ .chnframe/y1 PEK2 #0010 ADD2 #21 .track/active PEK #01 EQU #07 MUL ADD ;ch2_txt ;draw-label JSR2
|
||||
.chnframe/x1 PEK2 8+ .chnframe/y1 PEK2 #0018 ADD2 #21 .track/active PEK #02 EQU #07 MUL ADD ;ch3_txt ;draw-label JSR2
|
||||
.chnframe/x1 PEK2 8+ .chnframe/y1 PEK2 #0020 ADD2 #21 .track/active PEK #03 EQU #07 MUL ADD ;ch4_txt ;draw-label JSR2
|
||||
|
||||
RTN
|
||||
|
||||
@draw-cursor ( -- )
|
||||
|
||||
( clear last cursor )
|
||||
,clear_icn =Screen.addr
|
||||
~pointer.x =Screen.x
|
||||
~pointer.y =Screen.y
|
||||
#30 =Screen.color
|
||||
;clear_icn .Screen/addr DEO2
|
||||
.pointer/x PEK2 .Screen/x DEO2
|
||||
.pointer/y PEK2 .Screen/y DEO2
|
||||
#30 .Screen/color DEO
|
||||
( record pointer positions )
|
||||
~Mouse.x =pointer.x ~Mouse.y =pointer.y
|
||||
.Mouse/x DEI2 .pointer/x POK2 .Mouse/y DEI2 .pointer/y POK2
|
||||
( draw new cursor )
|
||||
,cursor_icn =Screen.addr
|
||||
~pointer.x =Screen.x
|
||||
~pointer.y =Screen.y
|
||||
#32 ~Mouse.state #00 NEQ ADD =Screen.color
|
||||
;cursor_icn .Screen/addr DEO2
|
||||
.pointer/x PEK2 .Screen/x DEO2
|
||||
.pointer/y PEK2 .Screen/y DEO2
|
||||
#32 .Mouse/state DEI #00 NEQ ADD .Screen/color DEO
|
||||
|
||||
RTN
|
||||
|
||||
|
@ -419,61 +419,61 @@ RTN
|
|||
|
||||
@draw-label ( x y color addr -- )
|
||||
|
||||
( load ) =label.addr =label.color =Screen.y =Screen.x
|
||||
~label.addr
|
||||
$loop
|
||||
( draw ) DUP2 PEK2 #00 SWP 8* ,font ADD2 =Screen.addr ~label.color =Screen.color
|
||||
( load ) .label/addr POK2 .label/color POK .Screen/y DEO2 .Screen/x DEO2
|
||||
.label/addr PEK2
|
||||
&loop
|
||||
( draw ) DUP2 GET #00 SWP 8* ;font ADD2 .Screen/addr DEO2 .label/color PEK .Screen/color DEO
|
||||
( incr ) ++
|
||||
( incr ) ~Screen.x 8+ =Screen.x
|
||||
DUP2 PEK2 #00 NEQ ^$loop JNZ
|
||||
( incr ) .Screen/x DEI2 8+ .Screen/x DEO2
|
||||
DUP2 GET #00 NEQ ,&loop JNZ
|
||||
POP2
|
||||
|
||||
RTN
|
||||
|
||||
@line-vertical-dotted ( x y0 y1 color -- )
|
||||
|
||||
=color STH2 SWP2 =Screen.x STH2r OVR2 =Screen.y
|
||||
$draw-ver
|
||||
( draw ) ~color =Screen.color
|
||||
( incr ) SWP2 #0002 ADD2 DUP2 =Screen.y SWP2
|
||||
OVR2 OVR2 LTH2 ^$draw-ver JNZ
|
||||
.color POK STH2 SWP2 .Screen/x DEO2 STH2r OVR2 .Screen/y DEO2
|
||||
&draw-ver
|
||||
( draw ) .color PEK .Screen/color DEO
|
||||
( incr ) SWP2 #0002 ADD2 DUP2 .Screen/y DEO2 SWP2
|
||||
OVR2 OVR2 LTH2 ,&draw-ver JNZ
|
||||
POP2 POP2
|
||||
|
||||
RTN
|
||||
|
||||
@line-horizontal-dotted ( x0 x1 y color -- )
|
||||
|
||||
=color =Screen.y OVR2 =Screen.x
|
||||
$draw-hor
|
||||
( draw ) ~color =Screen.color
|
||||
( incr ) SWP2 #0002 ADD2 DUP2 =Screen.x SWP2
|
||||
OVR2 OVR2 LTH2 ^$draw-hor JNZ
|
||||
.color POK .Screen/y DEO2 OVR2 .Screen/x DEO2
|
||||
&draw-hor
|
||||
( draw ) .color PEK .Screen/color DEO
|
||||
( incr ) SWP2 #0002 ADD2 DUP2 .Screen/x DEO2 SWP2
|
||||
OVR2 OVR2 LTH2 ,&draw-hor JNZ
|
||||
POP2 POP2
|
||||
|
||||
RTN
|
||||
|
||||
@line-rect ( x1 y1 x2 y2 color )
|
||||
|
||||
( load ) =color =rect.y2 =rect.x2 DUP2 =Screen.y =rect.y1 DUP2 =Screen.x =rect.x1
|
||||
$hor
|
||||
( incr ) ~Screen.x ++ =Screen.x
|
||||
( draw ) ~rect.y1 =Screen.y ~color =Screen.color
|
||||
( draw ) ~rect.y2 =Screen.y ~color =Screen.color
|
||||
~Screen.x ~rect.x2 LTH2 ^$hor JNZ
|
||||
~rect.y1 =Screen.y
|
||||
$ver
|
||||
( draw ) ~rect.x1 =Screen.x ~color =Screen.color
|
||||
( draw ) ~rect.x2 =Screen.x ~color =Screen.color
|
||||
( incr ) ~Screen.y ++ =Screen.y
|
||||
~Screen.y ~rect.y2 ++ LTH2 ^$ver JNZ
|
||||
( load ) .color POK .rect/y2 POK2 .rect/x2 POK2 DUP2 .Screen/y DEO2 .rect/y1 POK2 DUP2 .Screen/x DEO2 .rect/x1 POK2
|
||||
&hor
|
||||
( incr ) .Screen/x DEI2 ++ .Screen/x DEO2
|
||||
( draw ) .rect/y1 PEK2 .Screen/y DEO2 .color PEK .Screen/color DEO
|
||||
( draw ) .rect/y2 PEK2 .Screen/y DEO2 .color PEK .Screen/color DEO
|
||||
.Screen/x DEI2 .rect/x2 PEK2 LTH2 ,&hor JNZ
|
||||
.rect/y1 PEK2 .Screen/y DEO2
|
||||
&ver
|
||||
( draw ) .rect/x1 PEK2 .Screen/x DEO2 .color PEK .Screen/color DEO
|
||||
( draw ) .rect/x2 PEK2 .Screen/x DEO2 .color PEK .Screen/color DEO
|
||||
( incr ) .Screen/y DEI2 ++ .Screen/y DEO2
|
||||
.Screen/y DEI2 .rect/y2 PEK2 ++ LTH2 ,&ver JNZ
|
||||
|
||||
RTN
|
||||
|
||||
@adsr-envelope ( -- )
|
||||
#ff ,adsr #00 ~Audio.play #04 MUL ADD2 PEK2 SOUND
|
||||
#80 ,adsr #00 ~Audio.play #04 MUL ADD2 #0001 ADD2 PEK2 SOUND
|
||||
#80 ,adsr #00 ~Audio.play #04 MUL ADD2 #0002 ADD2 PEK2 SOUND
|
||||
#00 ,adsr #00 ~Audio.play #04 MUL ADD2 #0003 ADD2 PEK2 SOUND
|
||||
#ff ;adsr #00 .Audio/play DEI #04 MUL ADD2 GET SOUND
|
||||
#80 ;adsr #00 .Audio/play DEI #04 MUL ADD2 #0001 ADD2 GET SOUND
|
||||
#80 ;adsr #00 .Audio/play DEI #04 MUL ADD2 #0002 ADD2 GET SOUND
|
||||
#00 ;adsr #00 .Audio/play DEI #04 MUL ADD2 #0003 ADD2 GET SOUND
|
||||
SOUND_FINISH
|
||||
BRK
|
||||
|
||||
|
@ -490,12 +490,12 @@ RTN
|
|||
#8040 SOUND
|
||||
BRK
|
||||
|
||||
@ch1_txt [ CHN0 00 ]
|
||||
@ch2_txt [ CHN1 00 ]
|
||||
@ch3_txt [ CHN2 00 ]
|
||||
@ch4_txt [ ---- 00 ]
|
||||
@env_txt [ Envelope 00 ]
|
||||
@vol_txt [ Volume 00 ]
|
||||
@ch1_txt [ "CHN0 00 ]
|
||||
@ch2_txt [ "CHN1 00 ]
|
||||
@ch3_txt [ "CHN2 00 ]
|
||||
@ch4_txt [ "---- 00 ]
|
||||
@env_txt [ "Envelope 00 ]
|
||||
@vol_txt [ "Volume 00 ]
|
||||
|
||||
@clear_icn [ 0000 0000 0000 0000 ]
|
||||
@cursor_icn [ 80c0 e0f0 f8e0 1000 ]
|
||||
|
|
|
@ -7,331 +7,337 @@
|
|||
%STEP8 { #0033 SFT2 }
|
||||
%S2B { SWP POP }
|
||||
|
||||
;center { x 2 y 2 }
|
||||
;color { byte 1 }
|
||||
;pointer { x 2 y 2 sprite 2 }
|
||||
;rect { x1 2 y1 2 x2 2 y2 2 }
|
||||
;window { x1 2 y1 2 x2 2 y2 2 w 2 h 2 }
|
||||
;label { x 2 y 2 addr 2 }
|
||||
;slider { x1 2 y 2 x2 2 pos 2 }
|
||||
;selection { byte 1 }
|
||||
;addr { short 2 }
|
||||
;theme {
|
||||
r1 1 r2 1 r3 1 r4 1
|
||||
g1 1 g2 1 g3 1 g4 1
|
||||
b1 1 b2 1 b3 1 b4 1
|
||||
}
|
||||
( devices )
|
||||
|
||||
|0100 ;System { vector 2 pad 6 r 2 g 2 b 2 }
|
||||
|0120 ;Screen { vector 2 width 2 height 2 pad 2 x 2 y 2 addr 2 color 1 }
|
||||
|0160 ;Mouse { vector 2 x 2 y 2 state 1 chord 1 }
|
||||
|00 @System [ &vector $2 &pad $6 &r $2 &g $2 &b $2 ]
|
||||
|20 @Screen [ &vector $2 &width $2 &height $2 &pad $2 &x $2 &y $2 &addr $2 &color $1 ]
|
||||
|60 @Mouse [ &vector $2 &x $2 &y $2 &state $1 &chord $1 ]
|
||||
|
||||
( variables )
|
||||
|
||||
|0000
|
||||
|
||||
@center [ &x $2 &y $2 ]
|
||||
@color [ &byte $1 ]
|
||||
@pointer [ &x $2 &y $2 &sprite $2 ]
|
||||
@rect [ &x1 $2 &y1 $2 &x2 $2 &y2 $2 ]
|
||||
@window [ &x1 $2 &y1 $2 &x2 $2 &y2 $2 &w $2 &h $2 ]
|
||||
@label [ &x $2 &y $2 &addr $2 ]
|
||||
@slider [ &x1 $2 &y $2 &x2 $2 &pos $2 ]
|
||||
@selection [ &byte $1 ]
|
||||
@addr [ &byte $1 ]
|
||||
@theme [
|
||||
&r1 $1 &r2 $1 &r3 $1 &r4 $1
|
||||
&g1 $1 &g2 $1 &g3 $1 &g4 $1
|
||||
&b1 $1 &b2 $1 &b3 $1 &b4 $1
|
||||
]
|
||||
|
||||
( program )
|
||||
|
||||
|0200
|
||||
|0100
|
||||
|
||||
( theme ) #127f =System.r #34e7 =System.g #56c4 =System.b
|
||||
( vectors ) ,on-mouse =Mouse.vector
|
||||
( theme ) #127f .System/r DEO2 #34e7 .System/g DEO2 #56c4 .System/b DEO2
|
||||
( vectors ) ;on-mouse .Mouse/vector DEO2
|
||||
|
||||
#00b0 =window.w
|
||||
#0050 =window.h
|
||||
#00b0 .window/w POK2
|
||||
#0050 .window/h POK2
|
||||
|
||||
( center window )
|
||||
|
||||
~Screen.width #0002 DIV2 ~window.w #0002 DIV2 SUB2 =window.x1
|
||||
~Screen.height #0002 DIV2 ~window.h #0002 DIV2 SUB2 =window.y1
|
||||
.Screen/width DEI2 #0002 DIV2 .window/w PEK2 #0002 DIV2 SUB2 .window/x1 POK2
|
||||
.Screen/height DEI2 #0002 DIV2 .window/h PEK2 #0002 DIV2 SUB2 .window/y1 POK2
|
||||
|
||||
#01 =theme.r1 #02 =theme.g1 #03 =theme.b1
|
||||
#04 =theme.r2 #06 =theme.g2 #07 =theme.b2
|
||||
#0a =theme.r3 #09 =theme.g3 #08 =theme.b3
|
||||
#0c =theme.r4 #0b =theme.g4 #0d =theme.b4
|
||||
#01 .theme/r1 POK #02 .theme/g1 POK #03 .theme/b1 POK
|
||||
#04 .theme/r2 POK #06 .theme/g2 POK #07 .theme/b2 POK
|
||||
#0a .theme/r3 POK #09 .theme/g3 POK #08 .theme/b3 POK
|
||||
#0c .theme/r4 POK #0b .theme/g4 POK #0d .theme/b4 POK
|
||||
|
||||
( find screen center )
|
||||
~Screen.width #0002 DIV2 =center.x
|
||||
~Screen.height #0002 DIV2 =center.y
|
||||
.Screen/width DEI2 #0002 DIV2 .center/x POK2
|
||||
.Screen/height DEI2 #0002 DIV2 .center/y POK2
|
||||
|
||||
,update-theme JSR2
|
||||
,draw-background JSR2
|
||||
,draw-window JSR2
|
||||
;update-theme JSR2
|
||||
;draw-background JSR2
|
||||
;draw-window JSR2
|
||||
|
||||
BRK
|
||||
|
||||
@on-mouse
|
||||
|
||||
,draw-cursor JSR2
|
||||
;draw-cursor JSR2
|
||||
|
||||
~Mouse.state #00 NEQ ,$no-skip JNZ2 BRK $no-skip
|
||||
.Mouse/state DEI #00 NEQ ;&no-skip JNZ2 BRK &no-skip
|
||||
|
||||
~Mouse.y ~window.y1 SUB2 STEP8
|
||||
.Mouse/y DEI2 .window/y1 PEK2 SUB2 STEP8
|
||||
|
||||
DUP2 #0010 NEQ2 ^$no-touch-red JNZ
|
||||
~Mouse.x ~window.x1 #0060 ADD2 LTH2 ^$no-touch-red JNZ
|
||||
~Mouse.x ~window.x1 #009c ADD2 GTH2 ^$no-touch-red JNZ
|
||||
( get new value ) ~Mouse.x ~window.x1 SUB2 #0060 SUB2 #0004 DIV2 S2B ,theme.r1 #00 ~selection ADD2 POK2
|
||||
$no-touch-red
|
||||
DUP2 #0020 NEQ2 ^$no-touch-green JNZ
|
||||
~Mouse.x ~window.x1 #0060 ADD2 LTH2 ^$no-touch-green JNZ
|
||||
~Mouse.x ~window.x1 #009c ADD2 GTH2 ^$no-touch-green JNZ
|
||||
( get new value ) ~Mouse.x ~window.x1 SUB2 #0060 SUB2 #0004 DIV2 S2B ,theme.g1 #00 ~selection ADD2 POK2
|
||||
$no-touch-green
|
||||
DUP2 #0030 NEQ2 ^$no-touch-blue JNZ
|
||||
~Mouse.x ~window.x1 #0060 ADD2 LTH2 ^$no-touch-blue JNZ
|
||||
~Mouse.x ~window.x1 #009c ADD2 GTH2 ^$no-touch-blue JNZ
|
||||
( get new value ) ~Mouse.x ~window.x1 SUB2 #0060 SUB2 #0004 DIV2 S2B ,theme.b1 #00 ~selection ADD2 POK2
|
||||
$no-touch-blue
|
||||
DUP2 #0040 NEQ2 ^$no-touch-radio JNZ
|
||||
~Mouse.x ~window.x1 #0050 ADD2 LTH2 ^$no-touch-radio JNZ
|
||||
~Mouse.x ~window.x1 #008c ADD2 GTH2 ^$no-touch-radio JNZ
|
||||
~Mouse.x ~window.x1 SUB2 #0050 SUB2 STEP8 2/ #0008 DIV2 S2B =selection
|
||||
$no-touch-radio
|
||||
DUP2 #0010 NEQ2 ,&no-touch-red JNZ
|
||||
.Mouse/x DEI2 .window/x1 PEK2 #0060 ADD2 LTH2 ,&no-touch-red JNZ
|
||||
.Mouse/x DEI2 .window/x1 PEK2 #009c ADD2 GTH2 ,&no-touch-red JNZ
|
||||
( get new value ) .Mouse/x DEI2 .window/x1 PEK2 SUB2 #0060 SUB2 #0004 DIV2 S2B ;theme/r1 #00 .selection PEK ADD2 PUT
|
||||
&no-touch-red
|
||||
DUP2 #0020 NEQ2 ,&no-touch-green JNZ
|
||||
.Mouse/x DEI2 .window/x1 PEK2 #0060 ADD2 LTH2 ,&no-touch-green JNZ
|
||||
.Mouse/x DEI2 .window/x1 PEK2 #009c ADD2 GTH2 ,&no-touch-green JNZ
|
||||
( get new value ) .Mouse/x DEI2 .window/x1 PEK2 SUB2 #0060 SUB2 #0004 DIV2 S2B ;theme/g1 #00 .selection PEK ADD2 PUT
|
||||
&no-touch-green
|
||||
DUP2 #0030 NEQ2 ,&no-touch-blue JNZ
|
||||
.Mouse/x DEI2 .window/x1 PEK2 #0060 ADD2 LTH2 ,&no-touch-blue JNZ
|
||||
.Mouse/x DEI2 .window/x1 PEK2 #009c ADD2 GTH2 ,&no-touch-blue JNZ
|
||||
( get new value ) .Mouse/x DEI2 .window/x1 PEK2 SUB2 #0060 SUB2 #0004 DIV2 S2B ;theme/b1 #00 .selection PEK ADD2 PUT
|
||||
&no-touch-blue
|
||||
DUP2 #0040 NEQ2 ,&no-touch-radio JNZ
|
||||
.Mouse/x DEI2 .window/x1 PEK2 #0050 ADD2 LTH2 ,&no-touch-radio JNZ
|
||||
.Mouse/x DEI2 .window/x1 PEK2 #008c ADD2 GTH2 ,&no-touch-radio JNZ
|
||||
.Mouse/x DEI2 .window/x1 PEK2 SUB2 #0050 SUB2 STEP8 2/ #0008 DIV2 S2B .selection POK
|
||||
&no-touch-radio
|
||||
|
||||
POP2
|
||||
|
||||
,update-theme JSR2
|
||||
,draw-window JSR2
|
||||
;update-theme JSR2
|
||||
;draw-window JSR2
|
||||
|
||||
BRK
|
||||
|
||||
@update-theme
|
||||
|
||||
#0108 PEK2 #0f AND ~theme.r1 #40 SFT ADD #0108 POK2
|
||||
#010a PEK2 #0f AND ~theme.g1 #40 SFT ADD #010a POK2
|
||||
#010c PEK2 #0f AND ~theme.b1 #40 SFT ADD #010c POK2
|
||||
#0108 PEK2 #f0 AND ~theme.r2 ADD #0108 POK2
|
||||
#010a PEK2 #f0 AND ~theme.g2 ADD #010a POK2
|
||||
#010c PEK2 #f0 AND ~theme.b2 ADD #010c POK2
|
||||
#0109 PEK2 #0f AND ~theme.r3 #40 SFT ADD #0109 POK2
|
||||
#010b PEK2 #0f AND ~theme.g3 #40 SFT ADD #010b POK2
|
||||
#010d PEK2 #0f AND ~theme.b3 #40 SFT ADD #010d POK2
|
||||
#0109 PEK2 #f0 AND ~theme.r4 ADD #0109 POK2
|
||||
#010b PEK2 #f0 AND ~theme.g4 ADD #010b POK2
|
||||
#010d PEK2 #f0 AND ~theme.b4 ADD #010d POK2
|
||||
#08 DEI #0f AND .theme/r1 PEK #40 SFT ADD #08 DEO
|
||||
#0a DEI #0f AND .theme/g1 PEK #40 SFT ADD #0a DEO
|
||||
#0c DEI #0f AND .theme/b1 PEK #40 SFT ADD #0c DEO
|
||||
#08 DEI #f0 AND .theme/r2 PEK ADD #08 DEO
|
||||
#0a DEI #f0 AND .theme/g2 PEK ADD #0a DEO
|
||||
#0c DEI #f0 AND .theme/b2 PEK ADD #0c DEO
|
||||
#09 DEI #0f AND .theme/r3 PEK #40 SFT ADD #09 DEO
|
||||
#0b DEI #0f AND .theme/g3 PEK #40 SFT ADD #0b DEO
|
||||
#0d DEI #0f AND .theme/b3 PEK #40 SFT ADD #0d DEO
|
||||
#09 DEI #f0 AND .theme/r4 PEK ADD #09 DEO
|
||||
#0b DEI #f0 AND .theme/g4 PEK ADD #0b DEO
|
||||
#0d DEI #f0 AND .theme/b4 PEK ADD #0d DEO
|
||||
|
||||
RTN
|
||||
|
||||
@draw-background
|
||||
|
||||
( draw hor line )
|
||||
#0000 =Screen.x ~center.y =Screen.y
|
||||
#0000 ~Screen.width ( from/to )
|
||||
$draw-hor
|
||||
( draw ) #01 =Screen.color
|
||||
( incr ) SWP2 #0002 ADD2 DUP2 =Screen.x SWP2
|
||||
OVR2 OVR2 LTH2 ^$draw-hor JNZ
|
||||
#0000 .Screen/x DEO2 .center/y PEK2 .Screen/y DEO2
|
||||
#0000 .Screen/width DEI2 ( from/to )
|
||||
&draw-hor
|
||||
( draw ) #01 .Screen/color DEO
|
||||
( incr ) SWP2 #0002 ADD2 DUP2 .Screen/x DEO2 SWP2
|
||||
OVR2 OVR2 LTH2 ,&draw-hor JNZ
|
||||
POP2 POP2
|
||||
|
||||
( draw ver line )
|
||||
~center.x =Screen.x #0000 =Screen.y
|
||||
#0000 ~Screen.height ( from/to )
|
||||
$draw-ver
|
||||
( draw ) #02 =Screen.color
|
||||
( incr ) SWP2 #0002 ADD2 DUP2 =Screen.y SWP2
|
||||
OVR2 OVR2 LTH2 ^$draw-ver JNZ
|
||||
.center/x PEK2 .Screen/x DEO2 #0000 .Screen/y DEO2
|
||||
#0000 .Screen/height DEI2 ( from/to )
|
||||
&draw-ver
|
||||
( draw ) #02 .Screen/color DEO
|
||||
( incr ) SWP2 #0002 ADD2 DUP2 .Screen/y DEO2 SWP2
|
||||
OVR2 OVR2 LTH2 ,&draw-ver JNZ
|
||||
POP2 POP2
|
||||
|
||||
( draw blending modes )
|
||||
,preview_icn =Screen.addr
|
||||
#0010 =Screen.y
|
||||
;preview_icn .Screen/addr DEO2
|
||||
#0010 .Screen/y DEO2
|
||||
#00 #08
|
||||
$draw-pixel1
|
||||
( move ) OVR #00 SWP #0008 MUL2 #0010 ADD2 =Screen.x
|
||||
( draw ) OVR =Screen.color
|
||||
&draw-pixel1
|
||||
( move ) OVR #00 SWP #0008 MUL2 #0010 ADD2 .Screen/x DEO2
|
||||
( draw ) OVR .Screen/color DEO
|
||||
( incr ) SWP #01 ADD SWP
|
||||
DUP2 LTH ^$draw-pixel1 JNZ
|
||||
DUP2 LTH ,&draw-pixel1 JNZ
|
||||
POP POP
|
||||
#0018 =Screen.y
|
||||
#0018 .Screen/y DEO2
|
||||
#00 #08
|
||||
$draw-pixel2
|
||||
( move ) OVR #00 SWP #0008 MUL2 #0010 ADD2 =Screen.x
|
||||
( draw ) OVR #08 ADD =Screen.color
|
||||
&draw-pixel2
|
||||
( move ) OVR #00 SWP #0008 MUL2 #0010 ADD2 .Screen/x DEO2
|
||||
( draw ) OVR #08 ADD .Screen/color DEO
|
||||
( incr ) SWP #01 ADD SWP
|
||||
DUP2 LTH ^$draw-pixel2 JNZ
|
||||
DUP2 LTH ,&draw-pixel2 JNZ
|
||||
POP POP
|
||||
#0020 =Screen.y
|
||||
#0020 .Screen/y DEO2
|
||||
#00 #08
|
||||
$draw-icn1
|
||||
( move ) OVR #00 SWP #0008 MUL2 #0010 ADD2 =Screen.x
|
||||
( draw ) OVR #20 ADD =Screen.color
|
||||
&draw-icn1
|
||||
( move ) OVR #00 SWP #0008 MUL2 #0010 ADD2 .Screen/x DEO2
|
||||
( draw ) OVR #20 ADD .Screen/color DEO
|
||||
( incr ) SWP #01 ADD SWP
|
||||
DUP2 LTH ^$draw-icn1 JNZ
|
||||
DUP2 LTH ,&draw-icn1 JNZ
|
||||
POP POP
|
||||
#0028 =Screen.y
|
||||
#0028 .Screen/y DEO2
|
||||
#00 #08
|
||||
$draw-icn2
|
||||
( move ) OVR #00 SWP #0008 MUL2 #0010 ADD2 =Screen.x
|
||||
( draw ) OVR #28 ADD =Screen.color
|
||||
&draw-icn2
|
||||
( move ) OVR #00 SWP #0008 MUL2 #0010 ADD2 .Screen/x DEO2
|
||||
( draw ) OVR #28 ADD .Screen/color DEO
|
||||
( incr ) SWP #01 ADD SWP
|
||||
DUP2 LTH ^$draw-icn2 JNZ
|
||||
DUP2 LTH ,&draw-icn2 JNZ
|
||||
POP POP
|
||||
#0030 =Screen.y
|
||||
#0030 .Screen/y DEO2
|
||||
#00 #08
|
||||
$draw-chr1
|
||||
( move ) OVR #00 SWP #0008 MUL2 #0010 ADD2 =Screen.x
|
||||
( draw ) OVR #40 ADD =Screen.color
|
||||
&draw-chr1
|
||||
( move ) OVR #00 SWP #0008 MUL2 #0010 ADD2 .Screen/x DEO2
|
||||
( draw ) OVR #40 ADD .Screen/color DEO
|
||||
( incr ) SWP #01 ADD SWP
|
||||
DUP2 LTH ^$draw-chr1 JNZ
|
||||
DUP2 LTH ,&draw-chr1 JNZ
|
||||
POP POP
|
||||
#0038 =Screen.y
|
||||
#0038 .Screen/y DEO2
|
||||
#00 #08
|
||||
$draw-chr2
|
||||
( move ) OVR #00 SWP #0008 MUL2 #0010 ADD2 =Screen.x
|
||||
( draw ) OVR #48 ADD =Screen.color
|
||||
&draw-chr2
|
||||
( move ) OVR #00 SWP #0008 MUL2 #0010 ADD2 .Screen/x DEO2
|
||||
( draw ) OVR #48 ADD .Screen/color DEO
|
||||
( incr ) SWP #01 ADD SWP
|
||||
DUP2 LTH ^$draw-chr2 JNZ
|
||||
DUP2 LTH ,&draw-chr2 JNZ
|
||||
POP POP
|
||||
|
||||
RTN
|
||||
|
||||
@draw-window
|
||||
|
||||
~window.x1 ~window.w ADD2 =window.x2
|
||||
~window.y1 ~window.h ADD2 =window.y2
|
||||
~window.x1 ~window.y1 ~window.x2 ~window.y2 #02 ,fill-rect JSR2
|
||||
~window.x1 ~window.y1 ~window.x2 ~window.y2 #01 ,line-rect JSR2
|
||||
~window.x1 #0002 SUB2 ~window.y1 #0002 SUB2 ~window.x2 #0002 ADD2 ~window.y2 #0002 ADD2 #01 ,line-rect JSR2
|
||||
.window/x1 PEK2 .window/w PEK2 ADD2 .window/x2 POK2
|
||||
.window/y1 PEK2 .window/h PEK2 ADD2 .window/y2 POK2
|
||||
.window/x1 PEK2 .window/y1 PEK2 .window/x2 PEK2 .window/y2 PEK2 #02 ;fill-rect JSR2
|
||||
.window/x1 PEK2 .window/y1 PEK2 .window/x2 PEK2 .window/y2 PEK2 #01 ;line-rect JSR2
|
||||
.window/x1 PEK2 #0002 SUB2 .window/y1 PEK2 #0002 SUB2 .window/x2 PEK2 #0002 ADD2 .window/y2 PEK2 #0002 ADD2 #01 ;line-rect JSR2
|
||||
|
||||
~window.x1 #0008 ADD2 ~window.y1 #0010 ADD2 #25 ,red_txt ,draw-label JSR2
|
||||
~window.x1 #0038 ADD2 ~window.y1 #0010 ADD2 #28 ,System.r ,draw-byte JSR2
|
||||
~window.x1 #0048 ADD2 ~window.y1 #0010 ADD2 #28 ,System.r #0001 ADD2 ,draw-byte JSR2
|
||||
.window/x1 PEK2 #0008 ADD2 .window/y1 PEK2 #0010 ADD2 #25 ;red_txt ;draw-label JSR2
|
||||
.window/x1 PEK2 #0038 ADD2 .window/y1 PEK2 #0010 ADD2 #28 .System/r ;draw-byte JSR2
|
||||
.window/x1 PEK2 #0048 ADD2 .window/y1 PEK2 #0010 ADD2 #28 .System/r #01 ADD ;draw-byte JSR2
|
||||
|
||||
~window.x1 #0008 ADD2 ~window.y1 #0020 ADD2 #25 ,green_txt ,draw-label JSR2
|
||||
~window.x1 #0038 ADD2 ~window.y1 #0020 ADD2 #28 ,System.g ,draw-byte JSR2
|
||||
~window.x1 #0048 ADD2 ~window.y1 #0020 ADD2 #28 ,System.g #0001 ADD2 ,draw-byte JSR2
|
||||
.window/x1 PEK2 #0008 ADD2 .window/y1 PEK2 #0020 ADD2 #25 ;green_txt ;draw-label JSR2
|
||||
.window/x1 PEK2 #0038 ADD2 .window/y1 PEK2 #0020 ADD2 #28 .System/g ;draw-byte JSR2
|
||||
.window/x1 PEK2 #0048 ADD2 .window/y1 PEK2 #0020 ADD2 #28 .System/g #01 ADD ;draw-byte JSR2
|
||||
|
||||
~window.x1 #0008 ADD2 ~window.y1 #0030 ADD2 #25 ,blue_txt ,draw-label JSR2
|
||||
~window.x1 #0038 ADD2 ~window.y1 #0030 ADD2 #28 ,System.b ,draw-byte JSR2
|
||||
~window.x1 #0048 ADD2 ~window.y1 #0030 ADD2 #28 ,System.b #0001 ADD2 ,draw-byte JSR2
|
||||
.window/x1 PEK2 #0008 ADD2 .window/y1 PEK2 #0030 ADD2 #25 ;blue_txt ;draw-label JSR2
|
||||
.window/x1 PEK2 #0038 ADD2 .window/y1 PEK2 #0030 ADD2 #28 .System/b ;draw-byte JSR2
|
||||
.window/x1 PEK2 #0048 ADD2 .window/y1 PEK2 #0030 ADD2 #28 .System/b #01 ADD ;draw-byte JSR2
|
||||
|
||||
~window.x1 #0060 ADD2 ~window.y1 #0010 ADD2 ~window.x1 #0090 ADD2 #00 ,theme.r1 ~selection ADD PEK2 #0004 MUL2 #01 ,draw-slider JSR2
|
||||
~window.x1 #0060 ADD2 ~window.y1 #0020 ADD2 ~window.x1 #0090 ADD2 #00 ,theme.g1 ~selection ADD PEK2 #0004 MUL2 #01 ,draw-slider JSR2
|
||||
~window.x1 #0060 ADD2 ~window.y1 #0030 ADD2 ~window.x1 #0090 ADD2 #00 ,theme.b1 ~selection ADD PEK2 #0004 MUL2 #01 ,draw-slider JSR2
|
||||
.window/x1 PEK2 #0060 ADD2 .window/y1 PEK2 #0010 ADD2 .window/x1 PEK2 #0090 ADD2 #00 ;theme/r1 .selection PEK ADD GET #0004 MUL2 #01 ;draw-slider JSR2
|
||||
.window/x1 PEK2 #0060 ADD2 .window/y1 PEK2 #0020 ADD2 .window/x1 PEK2 #0090 ADD2 #00 ;theme/g1 .selection PEK ADD GET #0004 MUL2 #01 ;draw-slider JSR2
|
||||
.window/x1 PEK2 #0060 ADD2 .window/y1 PEK2 #0030 ADD2 .window/x1 PEK2 #0090 ADD2 #00 ;theme/b1 .selection PEK ADD GET #0004 MUL2 #01 ;draw-slider JSR2
|
||||
|
||||
~window.x1 #0050 ADD2 =Screen.x
|
||||
~window.y1 #0040 ADD2 =Screen.y
|
||||
,radio_icns #00 ~selection #00 EQU #0008 MUL2 ADD2 =Screen.addr
|
||||
#25 =Screen.color
|
||||
.window/x1 PEK2 #0050 ADD2 .Screen/x DEO2
|
||||
.window/y1 PEK2 #0040 ADD2 .Screen/y DEO2
|
||||
;radio_icns #00 .selection PEK #00 EQU #0008 MUL2 ADD2 .Screen/addr DEO2
|
||||
#25 .Screen/color DEO
|
||||
|
||||
~window.x1 #0060 ADD2 =Screen.x
|
||||
~window.y1 #0040 ADD2 =Screen.y
|
||||
,radio_icns #00 ~selection #01 EQU #0008 MUL2 ADD2 =Screen.addr
|
||||
#25 =Screen.color
|
||||
.window/x1 PEK2 #0060 ADD2 .Screen/x DEO2
|
||||
.window/y1 PEK2 #0040 ADD2 .Screen/y DEO2
|
||||
;radio_icns #00 .selection PEK #01 EQU #0008 MUL2 ADD2 .Screen/addr DEO2
|
||||
#25 .Screen/color DEO
|
||||
|
||||
~window.x1 #0070 ADD2 =Screen.x
|
||||
~window.y1 #0040 ADD2 =Screen.y
|
||||
,radio_icns #00 ~selection #02 EQU #0008 MUL2 ADD2 =Screen.addr
|
||||
#25 =Screen.color
|
||||
.window/x1 PEK2 #0070 ADD2 .Screen/x DEO2
|
||||
.window/y1 PEK2 #0040 ADD2 .Screen/y DEO2
|
||||
;radio_icns #00 .selection PEK #02 EQU #0008 MUL2 ADD2 .Screen/addr DEO2
|
||||
#25 .Screen/color DEO
|
||||
|
||||
~window.x1 #0080 ADD2 =Screen.x
|
||||
~window.y1 #0040 ADD2 =Screen.y
|
||||
,radio_icns #00 ~selection #03 EQU #0008 MUL2 ADD2 =Screen.addr
|
||||
#25 =Screen.color
|
||||
.window/x1 PEK2 #0080 ADD2 .Screen/x DEO2
|
||||
.window/y1 PEK2 #0040 ADD2 .Screen/y DEO2
|
||||
;radio_icns #00 .selection PEK #03 EQU #0008 MUL2 ADD2 .Screen/addr DEO2
|
||||
#25 .Screen/color DEO
|
||||
|
||||
RTN
|
||||
|
||||
@draw-cursor ( -- )
|
||||
|
||||
( clear last cursor )
|
||||
,clear_icn =Screen.addr
|
||||
~pointer.x =Screen.x
|
||||
~pointer.y =Screen.y
|
||||
#30 =Screen.color
|
||||
;clear_icn .Screen/addr DEO2
|
||||
.pointer/x PEK2 .Screen/x DEO2
|
||||
.pointer/y PEK2 .Screen/y DEO2
|
||||
#30 .Screen/color DEO
|
||||
|
||||
( record pointer positions )
|
||||
~Mouse.x =pointer.x ~Mouse.y =pointer.y
|
||||
.Mouse/x DEI2 .pointer/x POK2 .Mouse/y DEI2 .pointer/y POK2
|
||||
|
||||
( draw new cursor )
|
||||
,pointer_icn =Screen.addr
|
||||
~pointer.x =Screen.x
|
||||
~pointer.y =Screen.y
|
||||
#33 ~Mouse.state #00 NEQ #02 MUL SUB =Screen.color
|
||||
;pointer_icn .Screen/addr DEO2
|
||||
.pointer/x PEK2 .Screen/x DEO2
|
||||
.pointer/y PEK2 .Screen/y DEO2
|
||||
#33 .Mouse/state DEI #00 NEQ #02 MUL SUB .Screen/color DEO
|
||||
|
||||
RTN
|
||||
|
||||
@draw-slider ( x1 y x2 pos color -- )
|
||||
|
||||
( load ) =color =slider.pos =slider.x2 =slider.y =slider.x1
|
||||
( load ) .color POK .slider/pos POK2 .slider/x2 POK2 .slider/y POK2 .slider/x1 POK2
|
||||
|
||||
~slider.x1 =Screen.x
|
||||
~slider.y =Screen.y
|
||||
,halftone_icn =Screen.addr
|
||||
.slider/x1 PEK2 .Screen/x DEO2
|
||||
.slider/y PEK2 .Screen/y DEO2
|
||||
;halftone_icn .Screen/addr DEO2
|
||||
|
||||
,slidera_icn =Screen.addr
|
||||
( draw ) #25 =Screen.color
|
||||
,sliderb_icn =Screen.addr
|
||||
;slidera_icn .Screen/addr DEO2
|
||||
( draw ) #25 .Screen/color DEO
|
||||
;sliderb_icn .Screen/addr DEO2
|
||||
|
||||
$loop
|
||||
( incr ) ~Screen.x 8+ =Screen.x
|
||||
( draw ) #25 =Screen.color
|
||||
~Screen.x ~slider.x2 #0008 ADD2 LTH2 ^$loop JNZ
|
||||
&loop
|
||||
( incr ) .Screen/x DEI2 8+ .Screen/x DEO2
|
||||
( draw ) #25 .Screen/color DEO
|
||||
.Screen/x DEI2 .slider/x2 PEK2 #0008 ADD2 LTH2 ,&loop JNZ
|
||||
|
||||
( incr ) ~Screen.x #0004 ADD2 =Screen.x
|
||||
,sliderc_icn =Screen.addr
|
||||
( draw ) #25 =Screen.color
|
||||
( incr ) .Screen/x DEI2 #0004 ADD2 .Screen/x DEO2
|
||||
;sliderc_icn .Screen/addr DEO2
|
||||
( draw ) #25 .Screen/color DEO
|
||||
|
||||
~slider.x1 ~slider.pos ADD2 =Screen.x
|
||||
,sliderd_icn =Screen.addr
|
||||
( draw ) #2a =Screen.color
|
||||
.slider/x1 PEK2 .slider/pos PEK2 ADD2 .Screen/x DEO2
|
||||
;sliderd_icn .Screen/addr DEO2
|
||||
( draw ) #2a .Screen/color DEO
|
||||
|
||||
RTN
|
||||
|
||||
@fill-rect ( x1 y1 x2 y2 color )
|
||||
|
||||
=color
|
||||
.color POK
|
||||
( x1 x2 y1 y2 ) ROT2 SWP2
|
||||
$ver
|
||||
( save ) OVR2 =Screen.y
|
||||
&ver
|
||||
( save ) OVR2 .Screen/y DEO2
|
||||
STH2 STH2 OVR2 OVR2
|
||||
$hor
|
||||
( save ) OVR2 =Screen.x
|
||||
( draw ) ~color =Screen.color
|
||||
&hor
|
||||
( save ) OVR2 .Screen/x DEO2
|
||||
( draw ) .color PEK .Screen/color DEO
|
||||
( incr ) SWP2 #0001 ADD2 SWP2
|
||||
OVR2 OVR2 LTH2 ^$hor JNZ
|
||||
OVR2 OVR2 LTH2 ,&hor JNZ
|
||||
POP2 POP2 STH2r STH2r
|
||||
( incr ) SWP2 #0001 ADD2 SWP2
|
||||
OVR2 OVR2 LTH2 ^$ver JNZ
|
||||
OVR2 OVR2 LTH2 ,&ver JNZ
|
||||
POP2 POP2 POP2 POP2
|
||||
|
||||
RTN
|
||||
|
||||
@line-rect ( x1 y1 x2 y2 color -- )
|
||||
|
||||
( load ) =color =rect.y2 =rect.x2 DUP2 =Screen.y =rect.y1 DUP2 =Screen.x =rect.x1
|
||||
$hor
|
||||
( incr ) ~Screen.x ++ =Screen.x
|
||||
( draw ) ~rect.y1 =Screen.y ~color =Screen.color
|
||||
( draw ) ~rect.y2 =Screen.y ~color =Screen.color
|
||||
~Screen.x ~rect.x2 LTH2 ^$hor JNZ
|
||||
~rect.y1 =Screen.y
|
||||
$ver
|
||||
( draw ) ~rect.x1 =Screen.x ~color =Screen.color
|
||||
( draw ) ~rect.x2 =Screen.x ~color =Screen.color
|
||||
( incr ) ~Screen.y ++ =Screen.y
|
||||
~Screen.y ~rect.y2 ++ LTH2 ^$ver JNZ
|
||||
( load ) .color POK .rect/y2 POK2 .rect/x2 POK2 DUP2 .Screen/y DEO2 .rect/y1 POK2 DUP2 .Screen/x DEO2 .rect/x1 POK2
|
||||
&hor
|
||||
( incr ) .Screen/x DEI2 ++ .Screen/x DEO2
|
||||
( draw ) .rect/y1 PEK2 .Screen/y DEO2 .color PEK .Screen/color DEO
|
||||
( draw ) .rect/y2 PEK2 .Screen/y DEO2 .color PEK .Screen/color DEO
|
||||
.Screen/x DEI2 .rect/x2 PEK2 LTH2 ,&hor JNZ
|
||||
.rect/y1 PEK2 .Screen/y DEO2
|
||||
&ver
|
||||
( draw ) .rect/x1 PEK2 .Screen/x DEO2 .color PEK .Screen/color DEO
|
||||
( draw ) .rect/x2 PEK2 .Screen/x DEO2 .color PEK .Screen/color DEO
|
||||
( incr ) .Screen/y DEI2 ++ .Screen/y DEO2
|
||||
.Screen/y DEI2 .rect/y2 PEK2 ++ LTH2 ,&ver JNZ
|
||||
|
||||
RTN
|
||||
|
||||
@draw-label ( x y color addr -- )
|
||||
|
||||
( load ) =label.addr =color =Screen.y =Screen.x ~label.addr
|
||||
$loop
|
||||
( draw ) DUP2 PEK2 #00 SWP #0008 MUL2 ,font ADD2 =Screen.addr ~color =Screen.color
|
||||
( load ) .label/addr POK2 .color POK .Screen/y DEO2 .Screen/x DEO2 .label/addr PEK2
|
||||
&loop
|
||||
( draw ) DUP2 GET #00 SWP #0008 MUL2 ;font ADD2 .Screen/addr DEO2 .color PEK .Screen/color DEO
|
||||
( incr ) ++
|
||||
( incr ) ~Screen.x 8+ =Screen.x
|
||||
DUP2 PEK2 #00 NEQ ^$loop JNZ
|
||||
( incr ) .Screen/x DEI2 8+ .Screen/x DEO2
|
||||
DUP2 GET #00 NEQ ,&loop JNZ
|
||||
POP2
|
||||
|
||||
RTN
|
||||
|
||||
@draw-byte ( x y color addr -- )
|
||||
|
||||
=addr STH
|
||||
=Screen.y
|
||||
=Screen.x
|
||||
,font_hex #00 ~addr PEK2 #04 SFT #0008 MUL2 ADD2 =Screen.addr
|
||||
STHr DUP STH =Screen.color
|
||||
,font_hex #00 ~addr PEK2 #0f AND #0008 MUL2 ADD2 =Screen.addr
|
||||
~Screen.x 8+ =Screen.x
|
||||
STHr =Screen.color
|
||||
.addr POK STH
|
||||
.Screen/y DEO2
|
||||
.Screen/x DEO2
|
||||
;font_hex #00 .addr PEK DEI #04 SFT #0008 MUL2 ADD2 .Screen/addr DEO2
|
||||
STHr DUP STH .Screen/color DEO
|
||||
;font_hex #00 .addr PEK DEI #0f AND #0008 MUL2 ADD2 .Screen/addr DEO2
|
||||
.Screen/x DEI2 8+ .Screen/x DEO2
|
||||
STHr .Screen/color DEO
|
||||
|
||||
RTN
|
||||
|
||||
|
@ -342,14 +348,14 @@ RTN
|
|||
@sliderb_icn [ ffff ffff ffff ffff ]
|
||||
@sliderc_icn [ fcfe ffff ffff fefc ]
|
||||
@sliderd_icn [ 003c 7e7e 7e7e 3c00 ]
|
||||
@preview_icn [ 183c 66db db66 3c18 0000 183c 3c18 0000 ]
|
||||
@preview_icn [ 183c 66db db66 3c18 0000 183c 3c18 0000 ]
|
||||
@radio_icns
|
||||
[ 3c42 8181 8181 423c ]
|
||||
[ 3c42 99bd bd99 423c ]
|
||||
|
||||
@red_txt [ Red 00 ]
|
||||
@green_txt [ Green 00 ]
|
||||
@blue_txt [ Blue 00 ]
|
||||
@red_txt [ "Red 00 ]
|
||||
@green_txt [ "Green 00 ]
|
||||
@blue_txt [ "Blue 00 ]
|
||||
|
||||
@font_hex ( 0-F TODO: should pull from @font instead.. )
|
||||
[
|
||||
|
|
|
@ -2,94 +2,100 @@
|
|||
|
||||
%RTN { JMP2r }
|
||||
|
||||
;color { byte 1 }
|
||||
;pointer { x 2 y 2 sprite 2 }
|
||||
;rect { x1 2 y1 2 x2 2 y2 2 }
|
||||
;r1 { x1 2 y1 2 x2 2 y2 2 }
|
||||
;r2 { x1 2 y1 2 x2 2 y2 2 }
|
||||
;r3 { x1 2 y1 2 x2 2 y2 2 }
|
||||
( devices )
|
||||
|
||||
|0100 ;System { vector 2 pad 6 r 2 g 2 b 2 }
|
||||
|0120 ;Screen { vector 2 width 2 height 2 pad 2 x 2 y 2 addr 2 color 1 }
|
||||
|0160 ;Mouse { vector 2 x 2 y 2 state 1 chord 1 }
|
||||
|00 @System [ &vector $2 &pad $6 &r $2 &g $2 &b $2 ]
|
||||
|20 @Screen [ &vector $2 &width $2 &height $2 &pad $2 &x $2 &y $2 &addr $2 &color $1 ]
|
||||
|60 @Mouse [ &vector $2 &x $2 &y $2 &state $1 &chord $1 ]
|
||||
|
||||
( variables )
|
||||
|
||||
|0000
|
||||
|
||||
@color [ &byte $1 ]
|
||||
@pointer [ &x $2 &y $2 &sprite $2 ]
|
||||
@rect [ &x1 $2 &y1 $2 &x2 $2 &y2 $2 ]
|
||||
@r1 [ &x1 $2 &y1 $2 &x2 $2 &y2 $2 ]
|
||||
@r2 [ &x1 $2 &y1 $2 &x2 $2 &y2 $2 ]
|
||||
@r3 [ &x1 $2 &y1 $2 &x2 $2 &y2 $2 ]
|
||||
|
||||
( program )
|
||||
|
||||
|0200
|
||||
|0100
|
||||
|
||||
( theme ) #0f0f =System.r #0fff =System.g #0ff0 =System.b
|
||||
( vectors ) ,on-mouse =Mouse.vector
|
||||
( theme ) #0f0f .System/r DEO2 #0fff .System/g DEO2 #0ff0 .System/b DEO2
|
||||
( vectors ) ;on-mouse .Mouse/vector DEO2
|
||||
|
||||
#0020 #0030 #0060 #0060 =r1.y2 =r1.x2 =r1.y1 =r1.x1
|
||||
#0058 #0050 #0090 #0080 =r2.y2 =r2.x2 =r2.y1 =r2.x1
|
||||
#0048 #0048 #0080 #0098 =r3.y2 =r3.x2 =r3.y1 =r3.x1
|
||||
#0020 #0030 #0060 #0060 .r1/y2 POK2 .r1/x2 POK2 .r1/y1 POK2 .r1/x1 POK2
|
||||
#0058 #0050 #0090 #0080 .r2/y2 POK2 .r2/x2 POK2 .r2/y1 POK2 .r2/x1 POK2
|
||||
#0048 #0048 #0080 #0098 .r3/y2 POK2 .r3/x2 POK2 .r3/y1 POK2 .r3/x1 POK2
|
||||
|
||||
BRK
|
||||
( no BRK, run through to on-mouse )
|
||||
|
||||
@on-mouse
|
||||
|
||||
,pointer_icn =pointer.sprite
|
||||
;pointer_icn .pointer/sprite POK2
|
||||
|
||||
#01 =color
|
||||
#01 .color POK
|
||||
( matrix comparison )
|
||||
~Mouse.x ~r1.x1 GTH2 ~Mouse.x ~r1.x2 LTH2 #0101 EQU2
|
||||
~Mouse.y ~r1.y1 GTH2 ~Mouse.y ~r1.y2 LTH2 #0101 EQU2
|
||||
#0101 NEQ2 ^$draw1 JNZ #02 =color ,hand_icn =pointer.sprite
|
||||
$draw1 ~r1.x1 ~r1.y1 ~r1.x2 ~r1.y2 ~color ,line-rect JSR2
|
||||
.Mouse/x DEI2 .r1/x1 PEK2 GTH2 .Mouse/x DEI2 .r1/x2 PEK2 LTH2 #0101 EQU2
|
||||
.Mouse/y DEI2 .r1/y1 PEK2 GTH2 .Mouse/y DEI2 .r1/y2 PEK2 LTH2 #0101 EQU2
|
||||
#0101 NEQ2 ,&draw1 JNZ #02 .color POK ;hand_icn .pointer/sprite POK2
|
||||
&draw1 .r1/x1 PEK2 .r1/y1 PEK2 .r1/x2 PEK2 .r1/y2 PEK2 .color PEK ;line-rect JSR2
|
||||
|
||||
#01 =color
|
||||
#01 .color POK
|
||||
( 2-step comparison )
|
||||
~Mouse.x ~r2.x1 GTH2 ~Mouse.x ~r2.x2 LTH2 #0101 NEQ2 ^$draw2 JNZ
|
||||
~Mouse.y ~r2.y1 GTH2 ~Mouse.y ~r2.y2 LTH2 #0101 NEQ2 ^$draw2 JNZ
|
||||
#03 =color ,hand_icn =pointer.sprite
|
||||
$draw2 ~r2.x1 ~r2.y1 ~r2.x2 ~r2.y2 ~color ,line-rect JSR2
|
||||
.Mouse/x DEI2 .r2/x1 PEK2 GTH2 .Mouse/x DEI2 .r2/x2 PEK2 LTH2 #0101 NEQ2 ,&draw2 JNZ
|
||||
.Mouse/y DEI2 .r2/y1 PEK2 GTH2 .Mouse/y DEI2 .r2/y2 PEK2 LTH2 #0101 NEQ2 ,&draw2 JNZ
|
||||
#03 .color POK ;hand_icn .pointer/sprite POK2
|
||||
&draw2 .r2/x1 PEK2 .r2/y1 PEK2 .r2/x2 PEK2 .r2/y2 PEK2 .color PEK ;line-rect JSR2
|
||||
|
||||
#01 =color
|
||||
#01 .color POK
|
||||
( 4-step comparison )
|
||||
~Mouse.x ~r3.x1 LTH2 ^$draw3 JNZ
|
||||
~Mouse.x ~r3.x2 GTH2 ^$draw3 JNZ
|
||||
~Mouse.y ~r3.y1 LTH2 ^$draw3 JNZ
|
||||
~Mouse.y ~r3.y2 GTH2 ^$draw3 JNZ
|
||||
#02 =color ,hand_icn =pointer.sprite
|
||||
$draw3 ~r3.x1 ~r3.y1 ~r3.x2 ~r3.y2 ~color ,line-rect JSR2
|
||||
.Mouse/x DEI2 .r3/x1 PEK2 LTH2 ,&draw3 JNZ
|
||||
.Mouse/x DEI2 .r3/x2 PEK2 GTH2 ,&draw3 JNZ
|
||||
.Mouse/y DEI2 .r3/y1 PEK2 LTH2 ,&draw3 JNZ
|
||||
.Mouse/y DEI2 .r3/y2 PEK2 GTH2 ,&draw3 JNZ
|
||||
#02 .color POK ;hand_icn .pointer/sprite POK2
|
||||
&draw3 .r3/x1 PEK2 .r3/y1 PEK2 .r3/x2 PEK2 .r3/y2 PEK2 .color PEK ;line-rect JSR2
|
||||
|
||||
,draw-cursor JSR2
|
||||
;draw-cursor JSR2
|
||||
|
||||
BRK
|
||||
|
||||
@draw-cursor
|
||||
|
||||
( clear last cursor )
|
||||
,clear_icn =Screen.addr
|
||||
~pointer.x =Screen.x
|
||||
~pointer.y =Screen.y
|
||||
#30 =Screen.color
|
||||
;clear_icn .Screen/addr DEO2
|
||||
.pointer/x PEK2 .Screen/x DEO2
|
||||
.pointer/y PEK2 .Screen/y DEO2
|
||||
#30 .Screen/color DEO
|
||||
|
||||
( record pointer positions )
|
||||
~Mouse.x =pointer.x ~Mouse.y =pointer.y
|
||||
.Mouse/x DEI2 .pointer/x POK2 .Mouse/y DEI2 .pointer/y POK2
|
||||
|
||||
( draw new cursor )
|
||||
~pointer.sprite =Screen.addr
|
||||
~pointer.x =Screen.x
|
||||
~pointer.y =Screen.y
|
||||
#31 =Screen.color
|
||||
.pointer/sprite PEK2 .Screen/addr DEO2
|
||||
.pointer/x PEK2 .Screen/x DEO2
|
||||
.pointer/y PEK2 .Screen/y DEO2
|
||||
#31 .Screen/color DEO
|
||||
|
||||
RTN
|
||||
|
||||
@line-rect ( x1 y1 x2 y2 color )
|
||||
|
||||
( load ) =color =rect.y2 =rect.x2 DUP2 =Screen.y =rect.y1 DUP2 =Screen.x =rect.x1
|
||||
$hor
|
||||
( incr ) ~Screen.x #0001 ADD2 =Screen.x
|
||||
( draw ) ~rect.y1 =Screen.y ~color =Screen.color
|
||||
( draw ) ~rect.y2 =Screen.y ~color =Screen.color
|
||||
~Screen.x ~rect.x2 LTH2 ^$hor JNZ
|
||||
~rect.y1 =Screen.y
|
||||
$ver
|
||||
( draw ) ~rect.x1 =Screen.x ~color =Screen.color
|
||||
( draw ) ~rect.x2 =Screen.x ~color =Screen.color
|
||||
( incr ) ~Screen.y #0001 ADD2 =Screen.y
|
||||
~Screen.y ~rect.y2 #0001 ADD2 LTH2 ^$ver JNZ
|
||||
( load ) .color POK .rect/y2 POK2 .rect/x2 POK2 DUP2 .Screen/y DEO2 .rect/y1 POK2 DUP2 .Screen/x DEO2 .rect/x1 POK2
|
||||
&hor
|
||||
( incr ) .Screen/x DEI2 #0001 ADD2 .Screen/x DEO2
|
||||
( draw ) .rect/y1 PEK2 .Screen/y DEO2 .color PEK .Screen/color DEO
|
||||
( draw ) .rect/y2 PEK2 .Screen/y DEO2 .color PEK .Screen/color DEO
|
||||
.Screen/x DEI2 .rect/x2 PEK2 LTH2 ,&hor JNZ
|
||||
.rect/y1 PEK2 .Screen/y DEO2
|
||||
&ver
|
||||
( draw ) .rect/x1 PEK2 .Screen/x DEO2 .color PEK .Screen/color DEO
|
||||
( draw ) .rect/x2 PEK2 .Screen/x DEO2 .color PEK .Screen/color DEO
|
||||
( incr ) .Screen/y DEI2 #0001 ADD2 .Screen/y DEO2
|
||||
.Screen/y DEI2 .rect/y2 PEK2 #0001 ADD2 LTH2 ,&ver JNZ
|
||||
|
||||
RTN
|
||||
|
||||
|
|
|
@ -2,80 +2,86 @@
|
|||
|
||||
%RTN { JMP2r }
|
||||
|
||||
;label { x 2 y 2 color 1 addr 2 }
|
||||
;center { x 2 y 2 }
|
||||
( devices )
|
||||
|
||||
|0100 ;System { vector 2 pad 6 r 2 g 2 b 2 }
|
||||
|0120 ;Screen { vector 2 width 2 height 2 pad 2 x 2 y 2 addr 2 color 1 }
|
||||
|00 @System [ &vector $2 &pad $6 &r $2 &g $2 &b $2 ]
|
||||
|20 @Screen [ &vector $2 &width $2 &height $2 &pad $2 &x $2 &y $2 &addr $2 &color $1 ]
|
||||
|
||||
( variables )
|
||||
|
||||
|0000
|
||||
|
||||
@label [ &x $2 &y $2 &color $1 &addr $2 ]
|
||||
@center [ &x $2 &y $2 ]
|
||||
|
||||
( program )
|
||||
|
||||
|0200
|
||||
|0100
|
||||
|
||||
( theme ) #0f0f =System.r #0fff =System.g #0ff0 =System.b
|
||||
( theme ) #0f0f .System/r DEO2 #0fff .System/g DEO2 #0ff0 .System/b DEO2
|
||||
|
||||
,draw JSR2
|
||||
;draw JSR2
|
||||
|
||||
BRK
|
||||
|
||||
@draw ( -- )
|
||||
|
||||
( find screen center )
|
||||
~Screen.width #0002 DIV2 =center.x
|
||||
~Screen.height #0002 DIV2 =center.y
|
||||
.Screen/width DEI2 #0002 DIV2 .center/x POK2
|
||||
.Screen/height DEI2 #0002 DIV2 .center/y POK2
|
||||
|
||||
( draw ver line )
|
||||
~center.x =Screen.x #0000 =Screen.y
|
||||
$draw-ver
|
||||
( draw ) #02 =Screen.color
|
||||
( incr ) ~Screen.y #0002 ADD2 =Screen.y
|
||||
~Screen.y ~Screen.height LTH2 ^$draw-ver JNZ
|
||||
.center/x PEK2 .Screen/x DEO2 #0000 .Screen/y DEO2
|
||||
&draw-ver
|
||||
( draw ) #02 .Screen/color DEO
|
||||
( incr ) .Screen/y DEI2 #0002 ADD2 .Screen/y DEO2
|
||||
.Screen/y DEI2 .Screen/height DEI2 LTH2 ,&draw-ver JNZ
|
||||
|
||||
~center.x ~center.y #0010 SUB2 #2c ,text1 ,draw-label-left JSR2
|
||||
~center.x ~center.y #2c ,text2 ,draw-label-middle JSR2
|
||||
~center.x ~center.y #0010 ADD2 #2c ,text3 ,draw-label-right JSR2
|
||||
~center.x ~center.y #0020 ADD2 #2c ,text4 ,draw-label-middle JSR2
|
||||
~center.x ~center.y #0030 ADD2 #2c ,text5 ,draw-label-middle JSR2
|
||||
.center/x PEK2 .center/y PEK2 #0010 SUB2 #2c ;text1 ;draw-label-left JSR2
|
||||
.center/x PEK2 .center/y PEK2 #2c ;text2 ;draw-label-middle JSR2
|
||||
.center/x PEK2 .center/y PEK2 #0010 ADD2 #2c ;text3 ;draw-label-right JSR2
|
||||
.center/x PEK2 .center/y PEK2 #0020 ADD2 #2c ;text4 ;draw-label-middle JSR2
|
||||
.center/x PEK2 .center/y PEK2 #0030 ADD2 #2c ;text5 ;draw-label-middle JSR2
|
||||
|
||||
RTN
|
||||
|
||||
@draw-label-left ( x y color addr -- )
|
||||
|
||||
( load ) =label.addr =label.color =Screen.y =Screen.x
|
||||
~label.addr
|
||||
$loop
|
||||
( draw ) DUP2 PEK2 #00 SWP #0008 MUL2 ,font ADD2 =Screen.addr ~label.color =Screen.color
|
||||
( load ) .label/addr POK2 .label/color POK .Screen/y DEO2 .Screen/x DEO2
|
||||
.label/addr PEK2
|
||||
&loop
|
||||
( draw ) DUP2 GET #00 SWP #0008 MUL2 ;font ADD2 .Screen/addr DEO2 .label/color PEK .Screen/color DEO
|
||||
( incr ) #0001 ADD2
|
||||
( incr ) ~Screen.x #0008 ADD2 =Screen.x
|
||||
DUP2 PEK2 #00 NEQ ^$loop JNZ
|
||||
( incr ) .Screen/x DEI2 #0008 ADD2 .Screen/x DEO2
|
||||
DUP2 GET #00 NEQ ,&loop JNZ
|
||||
POP2
|
||||
|
||||
RTN
|
||||
|
||||
@draw-label-middle ( x y color addr -- )
|
||||
|
||||
( load ) =label.addr =label.color =Screen.y
|
||||
( align ) ~label.addr ,get-text-length JSR2 #0008 MUL2 #0002 DIV2 SUB2 =Screen.x
|
||||
~label.addr
|
||||
$loop
|
||||
( draw ) DUP2 PEK2 #00 SWP #0008 MUL2 ,font ADD2 =Screen.addr ~label.color =Screen.color
|
||||
( load ) .label/addr POK2 .label/color POK .Screen/y DEO2
|
||||
( align ) .label/addr PEK2 ;get-text-length JSR2 #0008 MUL2 #0002 DIV2 SUB2 .Screen/x DEO2
|
||||
.label/addr PEK2
|
||||
&loop
|
||||
( draw ) DUP2 GET #00 SWP #0008 MUL2 ;font ADD2 .Screen/addr DEO2 .label/color PEK .Screen/color DEO
|
||||
( incr ) #0001 ADD2
|
||||
( incr ) ~Screen.x #0008 ADD2 =Screen.x
|
||||
DUP2 PEK2 #00 NEQ ^$loop JNZ
|
||||
( incr ) .Screen/x DEI2 #0008 ADD2 .Screen/x DEO2
|
||||
DUP2 GET #00 NEQ ,&loop JNZ
|
||||
POP2
|
||||
|
||||
RTN
|
||||
|
||||
@draw-label-right ( x y color addr -- )
|
||||
|
||||
( load ) =label.addr =label.color =Screen.y
|
||||
( align ) ~label.addr ,get-text-length JSR2 #0008 MUL2 SUB2 #0008 SUB2 =Screen.x
|
||||
~label.addr
|
||||
$loop
|
||||
( draw ) DUP2 PEK2 #00 SWP #0008 MUL2 ,font ADD2 =Screen.addr ~label.color =Screen.color
|
||||
( load ) .label/addr POK2 .label/color POK .Screen/y DEO2
|
||||
( align ) .label/addr PEK2 ;get-text-length JSR2 #0008 MUL2 SUB2 #0008 SUB2 .Screen/x DEO2
|
||||
.label/addr PEK2
|
||||
&loop
|
||||
( draw ) DUP2 GET #00 SWP #0008 MUL2 ;font ADD2 .Screen/addr DEO2 .label/color PEK .Screen/color DEO
|
||||
( incr ) #0001 ADD2
|
||||
( incr ) ~Screen.x #0008 ADD2 =Screen.x
|
||||
DUP2 PEK2 #00 NEQ ^$loop JNZ
|
||||
( incr ) .Screen/x DEI2 #0008 ADD2 .Screen/x DEO2
|
||||
DUP2 GET #00 NEQ ,&loop JNZ
|
||||
POP2
|
||||
|
||||
RTN
|
||||
|
@ -83,9 +89,9 @@ RTN
|
|||
@get-text-length ( label* -- length )
|
||||
|
||||
#0000 ( counter )
|
||||
$loop
|
||||
&loop
|
||||
( incr ) #0001 ADD2 OVR2 OVR2 ADD2
|
||||
PEK2 #00 NEQ ^$loop JNZ
|
||||
GET #00 NEQ ,&loop JNZ
|
||||
SWP2 POP2
|
||||
|
||||
RTN
|
||||
|
@ -126,8 +132,8 @@ RTN
|
|||
0008 0808 0808 0800 0030 1008 0810 3000 0000 0032 4c00 0000 3c42 99a1 a199 423c
|
||||
]
|
||||
|
||||
@text1 [ Left 20 Aligned 00 ]
|
||||
@text2 [ Middle 20 Aligned 00 ]
|
||||
@text3 [ Right 20 Aligned 00 ]
|
||||
@text4 [ even 00 ]
|
||||
@text5 [ odd 00 ]
|
||||
@text1 [ "Left 20 "Aligned 00 ]
|
||||
@text2 [ "Middle 20 "Aligned 00 ]
|
||||
@text3 [ "Right 20 "Aligned 00 ]
|
||||
@text4 [ "even 00 ]
|
||||
@text5 [ "odd 00 ]
|
|
@ -1,103 +1,109 @@
|
|||
( GUI Picture )
|
||||
|
||||
%RTN { JMP2r }
|
||||
%8+ { #0008 ADD2 }
|
||||
%8+ { #0008 ADD2 }
|
||||
|
||||
;color { byte 1 }
|
||||
;position { x 2 y 2 }
|
||||
;size { width 2 height 2 }
|
||||
( devices )
|
||||
|
||||
|0100 ;System { vector 2 pad 6 r 2 g 2 b 2 }
|
||||
|0110 ;Console { vector 2 pad 6 char 1 byte 1 short 2 string 2 }
|
||||
|0120 ;Screen { vector 2 width 2 height 2 pad 2 x 2 y 2 addr 2 color 1 }
|
||||
|0170 ;File { vector 2 success 2 offset 2 pad 2 name 2 length 2 load 2 save 2 }
|
||||
|00 @System [ &vector $2 &pad $6 &r $2 &g $2 &b $2 ]
|
||||
|10 @Console [ &vector $2 &pad $6 &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 ]
|
||||
|70 @File [ &vector $2 &success $2 &offset $2 &pad $2 &name $2 &length $2 &load $2 &save $2 ]
|
||||
|
||||
( variables )
|
||||
|
||||
|0000
|
||||
|
||||
@color [ &byte $1 ]
|
||||
@position [ &x $2 &y $2 ]
|
||||
@size [ &width $2 &height $2 ]
|
||||
|
||||
( program )
|
||||
|
||||
|0200
|
||||
|0100
|
||||
|
||||
( theme ) #037a =System.r #032a =System.g #052a =System.b
|
||||
( theme ) #037a .System/r DEO2 #032a .System/g DEO2 #052a .System/b DEO2
|
||||
|
||||
( background ) ,checker_icn #22 ,cover-pattern JSR2
|
||||
( background ) ;checker_icn #22 ;cover-pattern JSR2
|
||||
|
||||
( load ) ,icn1_path =File.name #1800 =File.length ,image =File.load
|
||||
( draw ) #0008 #0008 #0100 #00c0 #27 ,image ,draw-icn JSR2
|
||||
( load ) ;icn1_path .File/name DEO2 #1800 .File/length DEO2 ;image .File/load DEO2
|
||||
( draw ) #0008 #0008 #0100 #00c0 #27 ;image ;draw-icn JSR2
|
||||
|
||||
( load ) ,icn2_path =File.name #0800 =File.length ,image =File.load
|
||||
( draw ) #0010 #0078 #0080 #0080 #27 ,image ,draw-icn JSR2
|
||||
( load ) ;icn2_path .File/name DEO2 #0800 .File/length DEO2 ;image .File/load DEO2
|
||||
( draw ) #0010 #0078 #0080 #0080 #27 ;image ;draw-icn JSR2
|
||||
|
||||
( load ) ,chr1_path =File.name #4000 =File.length ,image =File.load
|
||||
( draw ) #00a8 #0010 #0100 #0100 #4f ,image ,draw-chr JSR2
|
||||
( load ) ;chr1_path .File/name DEO2 #4000 .File/length DEO2 ;image .File/load DEO2
|
||||
( draw ) #00a8 #0010 #0100 #0100 #4f ;image ;draw-chr JSR2
|
||||
|
||||
( load ) ,chr2_path =File.name #0900 =File.length ,image =File.load
|
||||
( draw ) #0088 #0088 #0060 #0060 #41 ,image ,draw-chr JSR2
|
||||
( load ) ;chr2_path .File/name DEO2 #0900 .File/length DEO2 ;image .File/load DEO2
|
||||
( draw ) #0088 #0088 #0060 #0060 #41 ;image ;draw-chr JSR2
|
||||
|
||||
BRK
|
||||
|
||||
@draw-icn ( x y width height color addr -- )
|
||||
|
||||
( load ) =Screen.addr =color =size.height =size.width =position.y =position.x
|
||||
#0000 ~size.height
|
||||
$ver
|
||||
( save ) OVR2 ~position.y ADD2 =Screen.y
|
||||
#0000 ~size.width
|
||||
$hor
|
||||
( save ) OVR2 ~position.x ADD2 =Screen.x
|
||||
( draw ) ~color =Screen.color
|
||||
( incr ) ~Screen.addr 8+ =Screen.addr
|
||||
( load ) .Screen/addr DEO2 .color POK .size/height POK2 .size/width POK2 .position/y POK2 .position/x POK2
|
||||
#0000 .size/height PEK2
|
||||
&ver
|
||||
( save ) OVR2 .position/y PEK2 ADD2 .Screen/y DEO2
|
||||
#0000 .size/width PEK2
|
||||
&hor
|
||||
( save ) OVR2 .position/x PEK2 ADD2 .Screen/x DEO2
|
||||
( draw ) .color PEK .Screen/color DEO
|
||||
( incr ) .Screen/addr DEI2 8+ .Screen/addr DEO2
|
||||
( incr ) SWP2 8+ SWP2
|
||||
OVR2 OVR2 LTH2 ^$hor JNZ
|
||||
OVR2 OVR2 LTH2 ,&hor JNZ
|
||||
POP2 POP2
|
||||
( incr ) SWP2 8+ SWP2
|
||||
OVR2 OVR2 LTH2 ^$ver JNZ
|
||||
OVR2 OVR2 LTH2 ,&ver JNZ
|
||||
POP2 POP2
|
||||
|
||||
RTN
|
||||
|
||||
@draw-chr ( x y width height color addr -- )
|
||||
|
||||
( load ) =Screen.addr =color =size.height =size.width =position.y =position.x
|
||||
#0000 ~size.height
|
||||
$ver
|
||||
( save ) OVR2 ~position.y ADD2 =Screen.y
|
||||
#0000 ~size.width
|
||||
$hor
|
||||
( save ) OVR2 ~position.x ADD2 =Screen.x
|
||||
( draw ) ~color =Screen.color
|
||||
( incr ) ~Screen.addr #0010 ADD2 =Screen.addr
|
||||
( load ) .Screen/addr DEO2 .color POK .size/height POK2 .size/width POK2 .position/y POK2 .position/x POK2
|
||||
#0000 .size/height PEK2
|
||||
&ver
|
||||
( save ) OVR2 .position/y PEK2 ADD2 .Screen/y DEO2
|
||||
#0000 .size/width PEK2
|
||||
&hor
|
||||
( save ) OVR2 .position/x PEK2 ADD2 .Screen/x DEO2
|
||||
( draw ) .color PEK .Screen/color DEO
|
||||
( incr ) .Screen/addr DEI2 #0010 ADD2 .Screen/addr DEO2
|
||||
( incr ) SWP2 8+ SWP2
|
||||
OVR2 OVR2 LTH2 ^$hor JNZ
|
||||
OVR2 OVR2 LTH2 ,&hor JNZ
|
||||
POP2 POP2
|
||||
( incr ) SWP2 8+ SWP2
|
||||
OVR2 OVR2 LTH2 ^$ver JNZ
|
||||
OVR2 OVR2 LTH2 ,&ver JNZ
|
||||
POP2 POP2
|
||||
|
||||
RTN
|
||||
|
||||
@cover-pattern ( addr color -- )
|
||||
|
||||
( load ) =color =Screen.addr
|
||||
#0000 ~Screen.height
|
||||
$ver
|
||||
( save ) OVR2 =Screen.y
|
||||
#0000 ~Screen.width
|
||||
$hor
|
||||
( save ) OVR2 =Screen.x
|
||||
( draw ) ~color =Screen.color
|
||||
( load ) .color POK .Screen/addr DEO2
|
||||
#0000 .Screen/height DEI2
|
||||
&ver
|
||||
( save ) OVR2 .Screen/y DEO2
|
||||
#0000 .Screen/width DEI2
|
||||
&hor
|
||||
( save ) OVR2 .Screen/x DEO2
|
||||
( draw ) .color PEK .Screen/color DEO
|
||||
( incr ) SWP2 8+ SWP2
|
||||
OVR2 OVR2 LTH2 ^$hor JNZ
|
||||
OVR2 OVR2 LTH2 ,&hor JNZ
|
||||
POP2 POP2
|
||||
( incr ) SWP2 8+ SWP2
|
||||
OVR2 OVR2 LTH2 ^$ver JNZ
|
||||
OVR2 OVR2 LTH2 ,&ver JNZ
|
||||
POP2 POP2
|
||||
|
||||
RTN
|
||||
|
||||
@checker_icn [ f0f0 f0f0 0f0f 0f0f ]
|
||||
|
||||
@icn1_path [ projects/pictures/ergo100x0c0.bit 00 ]
|
||||
@icn2_path [ projects/pictures/dafu80x80.bit 00 ]
|
||||
@chr1_path [ projects/pictures/zerotwo2020.chr 00 ]
|
||||
@chr2_path [ projects/pictures/felix0cx0c.chr 00 ]
|
||||
@icn1_path [ "projects/pictures/ergo100x0c0.bit 00 ]
|
||||
@icn2_path [ "projects/pictures/dafu80x80.bit 00 ]
|
||||
@chr1_path [ "projects/pictures/zerotwo2020.chr 00 ]
|
||||
@chr2_path [ "projects/pictures/felix0cx0c.chr 00 ]
|
||||
|
||||
@image [ ]
|
|
@ -10,144 +10,150 @@
|
|||
STH2 STH2 OVR2 STH2r ADD2 OVR2 STH2r ADD2
|
||||
} ( x y w h -- x1 y1 x2 y2 )
|
||||
|
||||
( devices )
|
||||
|
||||
|00 @System [ &vector $2 &pad $6 &r $2 &g $2 &b $2 ]
|
||||
|10 @Console [ &vector $2 &pad $6 &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 ]
|
||||
|
||||
( variables )
|
||||
|
||||
|0000
|
||||
|
||||
( draw requirements )
|
||||
;color { byte 1 }
|
||||
@color [ &byte $1 ]
|
||||
|
||||
;rect { x1 2 y1 2 x2 2 y2 2 }
|
||||
;line { x0 2 y0 2 x 2 y 2 sx 2 sy 2 dx 2 dy 2 e1 2 e2 2 }
|
||||
;circle { xc 2 yc 2 x 2 y 2 r 2 d 2 }
|
||||
|
||||
|0100 ;System { vector 2 pad 6 r 2 g 2 b 2 }
|
||||
|0110 ;Console { vector 2 pad 6 char 1 byte 1 short 2 string 2 }
|
||||
|0120 ;Screen { vector 2 width 2 height 2 pad 2 x 2 y 2 addr 2 color 1 }
|
||||
@rect [ &x1 $2 &y1 $2 &x2 $2 &y2 $2 ]
|
||||
@line [ &x0 $2 &y0 $2 &x $2 &y $2 &sx $2 &sy $2 &dx $2 &dy $2 &e1 $2 &e2 $2 ]
|
||||
@circle [ &xc $2 &yc $2 &x $2 &y $2 &r $2 &d $2 ]
|
||||
|
||||
( program )
|
||||
|
||||
|0200
|
||||
|0100
|
||||
|
||||
( theme ) #f03f =System.r #f03f =System.g #003f =System.b
|
||||
( theme ) #f03f .System/r DEO2 #f03f .System/g DEO2 #003f .System/b DEO2
|
||||
|
||||
( background ) ,checker_icn #23 ,cover-pattern JSR2
|
||||
( background ) ;checker_icn #23 ;cover-pattern JSR2
|
||||
|
||||
#0010 #0030 #0020 #0020 SIZE-TO-RECT #01 ,line-slow JSR2
|
||||
#0070 #0040 #0010 #01 ,draw-circle JSR2
|
||||
#0038 #0030 #0020 #0020 SIZE-TO-RECT #01 ,line-rect JSR2
|
||||
#0038 #0058 #0020 #0020 SIZE-TO-RECT #01 ,fill-rect JSR2
|
||||
#0010 #0030 #0020 #0020 SIZE-TO-RECT #01 ;line-slow JSR2
|
||||
#0070 #0040 #0010 #01 ;draw-circle JSR2
|
||||
#0038 #0030 #0020 #0020 SIZE-TO-RECT #01 ;line-rect JSR2
|
||||
#0038 #0058 #0020 #0020 SIZE-TO-RECT #01 ;fill-rect JSR2
|
||||
|
||||
BRK
|
||||
|
||||
@line-slow ( x1 y1 x2 y2 color -- )
|
||||
|
||||
( load ) =color -- =line.y0 -- =line.x0 =line.y =line.x
|
||||
~line.x0 ~line.x SUB2 ABS2 =line.dx
|
||||
~line.y0 ~line.y SUB2 ABS2 #0000 SWP2 SUB2 =line.dy
|
||||
#ffff #00 ~line.x ~line.x0 LTS2 #0002 MUL2 ADD2 =line.sx
|
||||
#ffff #00 ~line.y ~line.y0 LTS2 #0002 MUL2 ADD2 =line.sy
|
||||
~line.dx ~line.dy ADD2 =line.e1
|
||||
$loop
|
||||
~line.x =Screen.x ~line.y =Screen.y ~color =Screen.color
|
||||
~line.x ~line.x0 EQU2 ~line.y ~line.y0 EQU2 #0101 EQU2 ^$end JNZ
|
||||
~line.e1 #0002 MUL2 =line.e2
|
||||
~line.e2 ~line.dy LTS2 ^$skipy JNZ
|
||||
~line.e1 ~line.dy ADD2 =line.e1
|
||||
~line.x ~line.sx ADD2 =line.x
|
||||
$skipy
|
||||
~line.e2 ~line.dx GTS2 ^$skipx JNZ
|
||||
~line.e1 ~line.dx ADD2 =line.e1
|
||||
~line.y ~line.sy ADD2 =line.y
|
||||
$skipx
|
||||
,$loop JMP2
|
||||
( load ) .color POK -- .line/y0 POK2 -- .line/x0 POK2 .line/y POK2 .line/x POK2
|
||||
.line/x0 PEK2 .line/x PEK2 SUB2 ABS2 .line/dx POK2
|
||||
.line/y0 PEK2 .line/y PEK2 SUB2 ABS2 #0000 SWP2 SUB2 .line/dy POK2
|
||||
#ffff #00 .line/x PEK2 .line/x0 PEK2 LTS2 #0002 MUL2 ADD2 .line/sx POK2
|
||||
#ffff #00 .line/y PEK2 .line/y0 PEK2 LTS2 #0002 MUL2 ADD2 .line/sy POK2
|
||||
.line/dx PEK2 .line/dy PEK2 ADD2 .line/e1 POK2
|
||||
&loop
|
||||
.line/x PEK2 .Screen/x DEO2 .line/y PEK2 .Screen/y DEO2 .color PEK .Screen/color DEO
|
||||
.line/x PEK2 .line/x0 PEK2 EQU2 .line/y PEK2 .line/y0 PEK2 EQU2 #0101 EQU2 ,&end JNZ
|
||||
.line/e1 PEK2 #0002 MUL2 .line/e2 POK2
|
||||
.line/e2 PEK2 .line/dy PEK2 LTS2 ,&skipy JNZ
|
||||
.line/e1 PEK2 .line/dy PEK2 ADD2 .line/e1 POK2
|
||||
.line/x PEK2 .line/sx PEK2 ADD2 .line/x POK2
|
||||
&skipy
|
||||
.line/e2 PEK2 .line/dx PEK2 GTS2 ,&skipx JNZ
|
||||
.line/e1 PEK2 .line/dx PEK2 ADD2 .line/e1 POK2
|
||||
.line/y PEK2 .line/sy PEK2 ADD2 .line/y POK2
|
||||
&skipx
|
||||
;&loop JMP2
|
||||
|
||||
$end
|
||||
&end
|
||||
|
||||
RTN
|
||||
|
||||
@line-rect ( x1 y1 x2 y2 color -- )
|
||||
|
||||
( load ) =color DUP2 STH2 -- =rect.y2 -- =rect.x2 DUP2 STH2 =rect.y1 =rect.x1
|
||||
( load ) .color POK DUP2 STH2 -- .rect/y2 POK2 -- .rect/x2 POK2 DUP2 STH2 .rect/y1 POK2 .rect/x1 POK2
|
||||
STH2r STH2r
|
||||
$ver
|
||||
( save ) OVR2 =Screen.y
|
||||
( draw ) ~rect.x1 =Screen.x ~color DUP =Screen.color
|
||||
( draw ) ~rect.x2 =Screen.x =Screen.color
|
||||
&ver
|
||||
( save ) OVR2 .Screen/y DEO2
|
||||
( draw ) .rect/x1 PEK2 .Screen/x DEO2 .color PEK DUP .Screen/color DEO
|
||||
( draw ) .rect/x2 PEK2 .Screen/x DEO2 .Screen/color DEO
|
||||
( incr ) SWP2 ++ SWP2
|
||||
OVR2 OVR2 LTS2 ^$ver JNZ
|
||||
OVR2 OVR2 LTS2 ,&ver JNZ
|
||||
POP2 POP2
|
||||
~rect.x1 ~rect.x2
|
||||
$hor
|
||||
( save ) OVR2 =Screen.x
|
||||
( draw ) ~rect.y1 =Screen.y ~color DUP =Screen.color
|
||||
( draw ) ~rect.y2 =Screen.y =Screen.color
|
||||
.rect/x1 PEK2 .rect/x2 PEK2
|
||||
&hor
|
||||
( save ) OVR2 .Screen/x DEO2
|
||||
( draw ) .rect/y1 PEK2 .Screen/y DEO2 .color PEK DUP .Screen/color DEO
|
||||
( draw ) .rect/y2 PEK2 .Screen/y DEO2 .Screen/color DEO
|
||||
( incr ) SWP2 ++ SWP2
|
||||
OVR2 OVR2 ++ LTS2 ^$hor JNZ
|
||||
OVR2 OVR2 ++ LTS2 ,&hor JNZ
|
||||
POP2 POP2
|
||||
|
||||
RTN
|
||||
|
||||
@fill-rect ( x1 y1 x2 y2 color -- )
|
||||
|
||||
=color
|
||||
.color POK
|
||||
( x1 x2 y1 y2 ) ROT2 SWP2
|
||||
$ver
|
||||
( save ) OVR2 =Screen.y
|
||||
&ver
|
||||
( save ) OVR2 .Screen/y DEO2
|
||||
STH2 STH2 OVR2 OVR2
|
||||
$hor
|
||||
( save ) OVR2 =Screen.x
|
||||
( draw ) ~color =Screen.color
|
||||
&hor
|
||||
( save ) OVR2 .Screen/x DEO2
|
||||
( draw ) .color PEK .Screen/color DEO
|
||||
( incr ) SWP2 ++ SWP2
|
||||
OVR2 OVR2 LTS2 ^$hor JNZ
|
||||
OVR2 OVR2 LTS2 ,&hor JNZ
|
||||
POP2 POP2 STH2r STH2r
|
||||
( incr ) SWP2 ++ SWP2
|
||||
OVR2 OVR2 LTS2 ^$ver JNZ
|
||||
OVR2 OVR2 LTS2 ,&ver JNZ
|
||||
POP2 POP2 POP2 POP2
|
||||
|
||||
RTN
|
||||
|
||||
@draw-circle ( xc yc r color -- )
|
||||
|
||||
( load ) =color =circle.r =circle.yc =circle.xc
|
||||
#0000 =circle.x ~circle.r =circle.y
|
||||
~circle.r #0002 MUL2 =circle.d
|
||||
( draw ) ,$seg JSR2
|
||||
$loop
|
||||
( incr ) ~circle.x ++ =circle.x
|
||||
~circle.d #0001 LTS2 ^$else JNZ
|
||||
( decr ) ~circle.y -- =circle.y
|
||||
~circle.x ~circle.y SUB2 #0004 MUL2 ~circle.d ADD2 =circle.d
|
||||
,$end JMP2
|
||||
$else
|
||||
~circle.x #0004 MUL2 ~circle.d ADD2 =circle.d
|
||||
$end
|
||||
( draw ) ,$seg JSR2
|
||||
~circle.y ~circle.x -- GTS2 ^$loop JNZ
|
||||
( load ) .color POK .circle/r POK2 .circle/yc POK2 .circle/xc POK2
|
||||
#0000 .circle/x POK2 .circle/r PEK2 .circle/y POK2
|
||||
.circle/r PEK2 #0002 MUL2 .circle/d POK2
|
||||
( draw ) ;&seg JSR2
|
||||
&loop
|
||||
( incr ) .circle/x PEK2 ++ .circle/x POK2
|
||||
.circle/d PEK2 #0001 LTS2 ,&else JNZ
|
||||
( decr ) .circle/y PEK2 -- .circle/y POK2
|
||||
.circle/x PEK2 .circle/y PEK2 SUB2 #0004 MUL2 .circle/d PEK2 ADD2 .circle/d POK2
|
||||
;&end JMP2
|
||||
&else
|
||||
.circle/x PEK2 #0004 MUL2 .circle/d PEK2 ADD2 .circle/d POK2
|
||||
&end
|
||||
( draw ) ;&seg JSR2
|
||||
.circle/y PEK2 .circle/x PEK2 -- GTS2 ,&loop JNZ
|
||||
RTN
|
||||
$seg
|
||||
~circle.xc ~circle.x ADD2 =Screen.x ~circle.yc ~circle.y ADD2 =Screen.y ~color =Screen.color
|
||||
~circle.xc ~circle.x SUB2 =Screen.x ~circle.yc ~circle.y ADD2 =Screen.y ~color =Screen.color
|
||||
~circle.xc ~circle.x ADD2 =Screen.x ~circle.yc ~circle.y SUB2 =Screen.y ~color =Screen.color
|
||||
~circle.xc ~circle.x SUB2 =Screen.x ~circle.yc ~circle.y SUB2 =Screen.y ~color =Screen.color
|
||||
~circle.xc ~circle.y ADD2 =Screen.x ~circle.yc ~circle.x ADD2 =Screen.y ~color =Screen.color
|
||||
~circle.xc ~circle.y SUB2 =Screen.x ~circle.yc ~circle.x ADD2 =Screen.y ~color =Screen.color
|
||||
~circle.xc ~circle.y ADD2 =Screen.x ~circle.yc ~circle.x SUB2 =Screen.y ~color =Screen.color
|
||||
~circle.xc ~circle.y SUB2 =Screen.x ~circle.yc ~circle.x SUB2 =Screen.y ~color =Screen.color
|
||||
&seg
|
||||
.circle/xc PEK2 .circle/x PEK2 ADD2 .Screen/x DEO2 .circle/yc PEK2 .circle/y PEK2 ADD2 .Screen/y DEO2 .color PEK .Screen/color DEO
|
||||
.circle/xc PEK2 .circle/x PEK2 SUB2 .Screen/x DEO2 .circle/yc PEK2 .circle/y PEK2 ADD2 .Screen/y DEO2 .color PEK .Screen/color DEO
|
||||
.circle/xc PEK2 .circle/x PEK2 ADD2 .Screen/x DEO2 .circle/yc PEK2 .circle/y PEK2 SUB2 .Screen/y DEO2 .color PEK .Screen/color DEO
|
||||
.circle/xc PEK2 .circle/x PEK2 SUB2 .Screen/x DEO2 .circle/yc PEK2 .circle/y PEK2 SUB2 .Screen/y DEO2 .color PEK .Screen/color DEO
|
||||
.circle/xc PEK2 .circle/y PEK2 ADD2 .Screen/x DEO2 .circle/yc PEK2 .circle/x PEK2 ADD2 .Screen/y DEO2 .color PEK .Screen/color DEO
|
||||
.circle/xc PEK2 .circle/y PEK2 SUB2 .Screen/x DEO2 .circle/yc PEK2 .circle/x PEK2 ADD2 .Screen/y DEO2 .color PEK .Screen/color DEO
|
||||
.circle/xc PEK2 .circle/y PEK2 ADD2 .Screen/x DEO2 .circle/yc PEK2 .circle/x PEK2 SUB2 .Screen/y DEO2 .color PEK .Screen/color DEO
|
||||
.circle/xc PEK2 .circle/y PEK2 SUB2 .Screen/x DEO2 .circle/yc PEK2 .circle/x PEK2 SUB2 .Screen/y DEO2 .color PEK .Screen/color DEO
|
||||
|
||||
RTN
|
||||
|
||||
@cover-pattern ( addr color -- )
|
||||
|
||||
( load ) =color =Screen.addr
|
||||
#0000 ~Screen.height
|
||||
$ver
|
||||
( save ) OVR2 =Screen.y
|
||||
#0000 ~Screen.width
|
||||
$hor
|
||||
( save ) OVR2 =Screen.x
|
||||
( draw ) ~color =Screen.color
|
||||
( load ) .color POK .Screen/addr DEO2
|
||||
#0000 .Screen/height DEI2
|
||||
&ver
|
||||
( save ) OVR2 .Screen/y DEO2
|
||||
#0000 .Screen/width DEI2
|
||||
&hor
|
||||
( save ) OVR2 .Screen/x DEO2
|
||||
( draw ) .color PEK .Screen/color DEO
|
||||
( incr ) SWP2 8+ SWP2
|
||||
OVR2 OVR2 LTH2 ^$hor JNZ
|
||||
OVR2 OVR2 LTH2 ,&hor JNZ
|
||||
POP2 POP2
|
||||
( incr ) SWP2 8+ SWP2
|
||||
OVR2 OVR2 LTH2 ^$ver JNZ
|
||||
OVR2 OVR2 LTH2 ,&ver JNZ
|
||||
POP2 POP2
|
||||
|
||||
RTN
|
||||
|
|
|
@ -1,65 +1,69 @@
|
|||
;scroll { x 2 y 2 wait 1 }
|
||||
|
||||
( devices )
|
||||
|
||||
|0100 ;System { vector 2 pad 6 r 2 g 2 b 2 }
|
||||
|0110 ;Console { vector 2 pad 6 char 1 byte 1 short 2 string 2 }
|
||||
|0120 ;Screen { vector 2 width 2 height 2 pad 2 x 2 y 2 addr 2 color 1 }
|
||||
|0130 ;Audio { wave 2 envelope 2 pad 4 volume 1 pitch 1 play 1 value 2 delay 2 finish 1 }
|
||||
|0140 ;Controller { vector 2 button 1 key 1 }
|
||||
|0160 ;Mouse { vector 2 x 2 y 2 state 1 chord 1 }
|
||||
|0170 ;File { vector 2 success 2 offset 2 pad 2 name 2 length 2 load 2 save 2 }
|
||||
|01a0 ;DateTime { year 2 month 1 day 1 hour 1 minute 1 second 1 dotw 1 doty 2 isdst 1 refresh 1 }
|
||||
|00 @System [ &vector $2 &pad $6 &r $2 &g $2 &b $2 ]
|
||||
|10 @Console [ &vector $2 &pad $6 &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 @Audio [ &wave $2 &envelope $2 &pad $4 &volume $1 &pitch $1 &play $1 &value $2 &delay $2 &finish $1 ]
|
||||
|40 @Controller [ &vector $2 &button $1 &key $1 ]
|
||||
|60 @Mouse [ &vector $2 &x $2 &y $2 &state $1 &chord $1 ]
|
||||
|70 @File [ &vector $2 &success $2 &offset $2 &pad $2 &name $2 &length $2 &load $2 &save $2 ]
|
||||
|a0 @DateTime [ &year $2 &month $1 &day $1 &hour $1 &minute $1 &second $1 &dotw $1 &doty $2 &isdst $1 &refresh $1 ]
|
||||
|
||||
|0200
|
||||
#90ff =System.r #9000 =System.g #900f =System.b
|
||||
#08e0 ~Screen.width #0001 SFT2 SUB2 =scroll.x
|
||||
#09b0 =scroll.y
|
||||
,frame =Screen.vector
|
||||
#30 =scroll.wait
|
||||
BRK
|
||||
( variables )
|
||||
|
||||
|0000
|
||||
|
||||
@scroll [ &x $2 &y $2 &wait $1 ]
|
||||
|
||||
|0100 ( -> )
|
||||
#90ff .System/r DEO2 #9000 .System/g DEO2 #900f .System/b DEO2
|
||||
#08e0 .Screen/width DEI2 #0001 SFT2 SUB2 .scroll/x POK2
|
||||
#09b0 .scroll/y POK2
|
||||
;frame .Screen/vector DEO2
|
||||
#30 .scroll/wait POK
|
||||
BRK
|
||||
|
||||
@frame ( -> )
|
||||
#ffff
|
||||
$loop
|
||||
DUP2 ^row JSR
|
||||
#0001 ADD2
|
||||
DUP2 ~Screen.height LTH2 ^$loop JNZ
|
||||
POP2
|
||||
~scroll.wait ^$noscroll JNZ
|
||||
~scroll.y #0001 ADD2 =scroll.y
|
||||
BRK
|
||||
#ffff
|
||||
&loop
|
||||
DUP2 ,row JSR
|
||||
#0001 ADD2
|
||||
DUP2 .Screen/height DEI2 LTH2 ,&loop JNZ
|
||||
POP2
|
||||
.scroll/wait PEK ,&noscroll JNZ
|
||||
.scroll/y PEK2 #0001 ADD2 .scroll/y POK2
|
||||
BRK
|
||||
|
||||
$noscroll
|
||||
~scroll.wait #01 SUB =scroll.wait
|
||||
BRK
|
||||
&noscroll
|
||||
.scroll/wait PEK #01 SUB .scroll/wait POK
|
||||
BRK
|
||||
|
||||
@row ( y* -- )
|
||||
DUP2 =Screen.y
|
||||
~scroll.y ADD2
|
||||
DUP2 .Screen/y DEO2
|
||||
.scroll/y PEK2 ADD2
|
||||
|
||||
~Screen.width
|
||||
$loop
|
||||
#0001 SUB2
|
||||
OVR2 OVR2 ~scroll.x ADD2 EOR2 DUP2 #0013 DIV2 #0013 MUL2 SUB2
|
||||
DUP #00 EQU ^$draw JNZ
|
||||
DUP #05 EQU ^$draw JNZ
|
||||
POP2
|
||||
$rest
|
||||
DUP2 ORA ^$loop JNZ
|
||||
POP2 POP2
|
||||
JMP2r
|
||||
.Screen/width DEI2
|
||||
&loop
|
||||
#0001 SUB2
|
||||
OVR2 OVR2 .scroll/x PEK2 ADD2 EOR2 DUP2 #0013 DIV2 #0013 MUL2 SUB2
|
||||
DUP #00 EQU ,&draw JNZ
|
||||
DUP #05 EQU ,&draw JNZ
|
||||
POP2
|
||||
&rest
|
||||
DUP2 ORA ,&loop JNZ
|
||||
POP2 POP2
|
||||
JMP2r
|
||||
|
||||
#15 =Screen.color
|
||||
JMP2r
|
||||
#15 .Screen/color DEO
|
||||
JMP2r
|
||||
|
||||
$draw
|
||||
OVR2 =Screen.x
|
||||
#05 ADD =Screen.color
|
||||
~Screen.y
|
||||
DUP2 #0001 ADD2 =Screen.y
|
||||
#00 =Screen.color
|
||||
=Screen.y
|
||||
POP
|
||||
^$rest JMP
|
||||
&draw
|
||||
OVR2 .Screen/x DEO2
|
||||
#05 ADD .Screen/color DEO
|
||||
.Screen/y DEI2
|
||||
DUP2 #0001 ADD2 .Screen/y DEO2
|
||||
#00 .Screen/color DEO
|
||||
.Screen/y DEO2
|
||||
POP
|
||||
,&rest JMP
|
||||
|
||||
|
|
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
|
@ -21,145 +21,145 @@
|
|||
%DATA-LOCKS { #3000 }
|
||||
%DATA-TYPES { #4000 }
|
||||
|
||||
%GET-CHAR { #24 MOD #00 SWP ,b36clc ADD2 PEK2 } ( b36 -- char )
|
||||
%GET-VALUE { #20 SUB #00 SWP ,values ADD2 PEK2 } ( char -- b36 )
|
||||
%GET-CHAR { #24 MOD #00 SWP ;b36clc ADD2 GET } ( b36 -- char )
|
||||
%GET-VALUE { #20 SUB #00 SWP ;values ADD2 GET } ( char -- b36 )
|
||||
|
||||
%GET-INDEX { #00 SWP #00 ~grid.width MUL2 ROT #00 SWP ADD2 } ( x y -- index )
|
||||
%GET-CELL { GET-INDEX DATA-CELLS ADD2 PEK2 } ( x y -- char )
|
||||
%SET-CELL { ROT ROT GET-INDEX DATA-CELLS ADD2 POK2 } ( x y char -- )
|
||||
%GET-TYPE { GET-INDEX DATA-TYPES ADD2 PEK2 } ( x y -- type )
|
||||
%SET-TYPE { ROT ROT GET-INDEX DATA-TYPES ADD2 POK2 } ( x y type -- )
|
||||
%GET-LOCK { GET-INDEX DATA-TYPES ADD2 PEK2 } ( x y -- type )
|
||||
%SET-LOCK { ROT ROT GET-INDEX DATA-TYPES ADD2 POK2 } ( x y type -- )
|
||||
%GET-INDEX { #00 SWP #00 .grid/width PEK MUL2 ROT #00 SWP ADD2 } ( x y -- index )
|
||||
%GET-CELL { GET-INDEX DATA-CELLS ADD2 GET } ( x y -- char )
|
||||
%SET-CELL { ROT ROT GET-INDEX DATA-CELLS ADD2 PUT } ( x y char -- )
|
||||
%GET-TYPE { GET-INDEX DATA-TYPES ADD2 GET } ( x y -- type )
|
||||
%SET-TYPE { ROT ROT GET-INDEX DATA-TYPES ADD2 PUT } ( x y type -- )
|
||||
%GET-LOCK { GET-INDEX DATA-TYPES ADD2 GET } ( x y -- type )
|
||||
%SET-LOCK { ROT ROT GET-INDEX DATA-TYPES ADD2 PUT } ( x y type -- )
|
||||
%GET-PORT { } ( x y lock -- char )
|
||||
%SET-PORT { } ( x y char -- )
|
||||
|
||||
%GET-CELL-VALUE { GET-CELL GET-VALUE } ( x y -- b36 )
|
||||
|
||||
( variables )
|
||||
|
||||
;timer { byte 1 frame 1 speed 1 }
|
||||
;grid { width 1 height 1 }
|
||||
;selection { x1 1 y1 1 x2 1 y2 1 }
|
||||
;cursor { x 2 y 2 }
|
||||
|
||||
( devices )
|
||||
|
||||
|0100 ;System { vector 2 pad 6 r 2 g 2 b 2 }
|
||||
|0110 ;Console { vector 2 pad 6 char 1 byte 1 short 2 string 2 }
|
||||
|0120 ;Screen { vector 2 width 2 height 2 pad 2 x 2 y 2 addr 2 color 1 }
|
||||
|0140 ;Controller { vector 2 button 1 key 1 }
|
||||
|0160 ;Mouse { vector 2 x 2 y 2 state 1 chord 1 }
|
||||
|00 @System [ &vector $2 &pad $6 &r $2 &g $2 &b $2 ]
|
||||
|10 @Console [ &vector $2 &pad $6 &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 ]
|
||||
|40 @Controller [ &vector $2 &button $1 &key $1 ]
|
||||
|60 @Mouse [ &vector $2 &x $2 &y $2 &state $1 &chord $1 ]
|
||||
|
||||
|0200
|
||||
( variables )
|
||||
|
||||
( theme ) #08f3 =System.r #08fc =System.g #08f9 =System.b
|
||||
( vectors ) ,on-button =Controller.vector
|
||||
( vectors ) ,on-mouse =Mouse.vector
|
||||
( vectors ) ,on-frame =Screen.vector
|
||||
@timer [ &byte $1 &frame $1 &speed $1 ]
|
||||
@grid [ &width $1 &height $1 ]
|
||||
@selection [ &x1 $1 &y1 $1 &x2 $1 &y2 $1 ]
|
||||
@cursor [ &x $2 &y $2 ]
|
||||
|
||||
|0100
|
||||
|
||||
( theme ) #08f3 .System/r DEO2 #08fc .System/g DEO2 #08f9 .System/b DEO2
|
||||
( vectors ) ;on-button .Controller/vector DEO2
|
||||
( vectors ) ;on-mouse .Mouse/vector DEO2
|
||||
( vectors ) ;on-frame .Screen/vector DEO2
|
||||
|
||||
( find size )
|
||||
~Screen.width 8/ SWP POP =grid.width
|
||||
~Screen.height 8/ SWP POP #02 SUB =grid.height
|
||||
.Screen/width DEI2 8/ SWP POP .grid/width POK
|
||||
.Screen/height DEI2 8/ SWP POP #02 SUB .grid/height POK
|
||||
|
||||
( fill grid with dots )
|
||||
|
||||
,start JSR2
|
||||
,redraw JSR2
|
||||
;start JSR2
|
||||
;redraw JSR2
|
||||
|
||||
BRK
|
||||
|
||||
@on-frame
|
||||
|
||||
~timer ++ DUP =timer
|
||||
.timer PEK ++ DUP .timer POK
|
||||
|
||||
( skip ) #08 EQU ^$tick JNZ BRK $tick
|
||||
( skip ) #08 EQU ,&tick JNZ BRK &tick
|
||||
|
||||
~timer.frame ++ =timer.frame
|
||||
.timer/frame PEK ++ .timer/frame POK
|
||||
|
||||
,run JSR2
|
||||
;run JSR2
|
||||
|
||||
#00 =timer
|
||||
#00 .timer POK
|
||||
|
||||
BRK
|
||||
|
||||
@on-button
|
||||
|
||||
~Controller.key #00 EQU ^$no-key JNZ
|
||||
~selection.x1 ~selection.y1 ~Controller.key SET-CELL
|
||||
,redraw JSR2
|
||||
$no-key
|
||||
.Controller/key DEI #00 EQU ,&no-key JNZ
|
||||
.selection/x1 PEK .selection/y1 PEK .Controller/key DEI SET-CELL
|
||||
;redraw JSR2
|
||||
&no-key
|
||||
|
||||
( arrows )
|
||||
~Controller.button #f0 AND
|
||||
DUP #04 SFT #01 AND #01 NEQ ^$no-up JNZ
|
||||
~selection.y1 #00 EQU ^$no-up JNZ
|
||||
~selection.y1 -- =selection.y1
|
||||
~selection.y2 -- =selection.y2 $no-up
|
||||
DUP #05 SFT #01 AND #01 NEQ ^$no-down JNZ
|
||||
~selection.y1 ~grid.height -- EQU ^$no-down JNZ
|
||||
~selection.y1 ++ =selection.y1
|
||||
~selection.y2 ++ =selection.y2 $no-down
|
||||
DUP #06 SFT #01 AND #01 NEQ ^$no-left JNZ
|
||||
~selection.x1 #00 EQU ^$no-left JNZ
|
||||
~selection.x1 -- =selection.x1
|
||||
~selection.x2 -- =selection.x2 $no-left
|
||||
DUP #07 SFT #01 AND #01 NEQ ^$no-right JNZ
|
||||
~selection.x1 ~grid.width -- EQU ^$no-right JNZ
|
||||
~selection.x1 ++ =selection.x1
|
||||
~selection.x2 ++ =selection.x2 $no-right
|
||||
.Controller/button DEI #f0 AND
|
||||
DUP #04 SFT #01 AND #01 NEQ ,&no-up JNZ
|
||||
.selection/y1 PEK #00 EQU ,&no-up JNZ
|
||||
.selection/y1 PEK -- .selection/y1 POK
|
||||
.selection/y2 PEK -- .selection/y2 POK &no-up
|
||||
DUP #05 SFT #01 AND #01 NEQ ,&no-down JNZ
|
||||
.selection/y1 PEK .grid/height PEK -- EQU ,&no-down JNZ
|
||||
.selection/y1 PEK ++ .selection/y1 POK
|
||||
.selection/y2 PEK ++ .selection/y2 POK &no-down
|
||||
DUP #06 SFT #01 AND #01 NEQ ,&no-left JNZ
|
||||
.selection/x1 PEK #00 EQU ,&no-left JNZ
|
||||
.selection/x1 PEK -- .selection/x1 POK
|
||||
.selection/x2 PEK -- .selection/x2 POK &no-left
|
||||
DUP #07 SFT #01 AND #01 NEQ ,&no-right JNZ
|
||||
.selection/x1 PEK .grid/width PEK -- EQU ,&no-right JNZ
|
||||
.selection/x1 PEK ++ .selection/x1 POK
|
||||
.selection/x2 PEK ++ .selection/x2 POK &no-right
|
||||
POP
|
||||
|
||||
~Controller.key #08 NEQ ^$no-backspace JNZ
|
||||
~selection.x1 ~selection.y1 #2e SET-CELL ( put . char )
|
||||
$no-backspace
|
||||
.Controller/key DEI #08 NEQ ,&no-backspace JNZ
|
||||
.selection/x1 PEK .selection/y1 PEK #2e SET-CELL ( put . char )
|
||||
&no-backspace
|
||||
|
||||
,redraw JSR2
|
||||
;redraw JSR2
|
||||
|
||||
BRK
|
||||
|
||||
@on-mouse
|
||||
|
||||
~Mouse.state #00 EQU ^$no-touch JNZ
|
||||
~Mouse.x 8/ SWP POP =selection.x1
|
||||
~Mouse.y 8/ SWP POP =selection.y1
|
||||
,redraw JSR2
|
||||
$no-touch
|
||||
.Mouse/state DEI #00 EQU ,&no-touch JNZ
|
||||
.Mouse/x DEI2 8/ SWP POP .selection/x1 POK
|
||||
.Mouse/y DEI2 8/ SWP POP .selection/y1 POK
|
||||
;redraw JSR2
|
||||
&no-touch
|
||||
|
||||
( clear last cursor )
|
||||
~cursor.x =Screen.x
|
||||
~cursor.y =Screen.y
|
||||
,blank_icn =Screen.addr
|
||||
#30 =Screen.color
|
||||
.cursor/x PEK2 .Screen/x DEO2
|
||||
.cursor/y PEK2 .Screen/y DEO2
|
||||
;blank_icn .Screen/addr DEO2
|
||||
#30 .Screen/color DEO
|
||||
|
||||
( record cursor positions )
|
||||
~Mouse.x =cursor.x
|
||||
~Mouse.y =cursor.y
|
||||
.Mouse/x DEI2 .cursor/x POK2
|
||||
.Mouse/y DEI2 .cursor/y POK2
|
||||
|
||||
( draw new cursor )
|
||||
~cursor.x =Screen.x
|
||||
~cursor.y =Screen.y
|
||||
,cursor_icn =Screen.addr
|
||||
#32 ~Mouse.state #01 EQU ADD =Screen.color
|
||||
.cursor/x PEK2 .Screen/x DEO2
|
||||
.cursor/y PEK2 .Screen/y DEO2
|
||||
;cursor_icn .Screen/addr DEO2
|
||||
#32 .Mouse/state DEI #01 EQU ADD .Screen/color DEO
|
||||
|
||||
BRK
|
||||
|
||||
@start ( -- )
|
||||
|
||||
#00 ~grid.height
|
||||
$ver
|
||||
#00 ~grid.width
|
||||
$hor
|
||||
#00 .grid/height PEK
|
||||
&ver
|
||||
#00 .grid/width PEK
|
||||
&hor
|
||||
( get x,y ) SWP2 OVR STH SWP2 OVR STHr
|
||||
#2e SET-CELL
|
||||
( incr ) SWP ++ SWP
|
||||
DUP2 LTH ^$hor JNZ
|
||||
( incr ) SWP ++ SWP
|
||||
DUP2 LTH ,&hor JNZ
|
||||
POP2
|
||||
( incr ) SWP ++ SWP
|
||||
DUP2 LTH ^$ver JNZ
|
||||
DUP2 LTH ,&ver JNZ
|
||||
POP2
|
||||
|
||||
#9a =timer.speed
|
||||
#9a .timer/speed POK
|
||||
|
||||
RTN
|
||||
|
||||
|
@ -172,7 +172,7 @@ RTN
|
|||
|
||||
@is-selected ( x y -- flag )
|
||||
|
||||
~selection.x1 ~selection.y1 EQU2
|
||||
.selection/x1 PEK .selection/y1 PEK EQU2
|
||||
|
||||
RTN
|
||||
|
||||
|
@ -192,15 +192,15 @@ RTN
|
|||
|
||||
DUP2 GET-CELL
|
||||
( if character is dot )
|
||||
DUP #2e NEQ ^$no-bar JNZ
|
||||
DUP #2e NEQ ,&no-bar JNZ
|
||||
( check if x,y is grid )
|
||||
POP
|
||||
DUP2 #08 MOD #00 EQU SWP #08 MOD #00 EQU #0101 NEQ2 ^$no-marker8 JNZ POP2 ,marker8_icn RTN $no-marker8
|
||||
DUP2 #02 MOD #00 EQU SWP #02 MOD #00 EQU #0101 NEQ2 ^$no-marker4 JNZ POP2 ,marker4_icn RTN $no-marker4
|
||||
POP2 ,font RTN
|
||||
$no-bar
|
||||
DUP2 #08 MOD #00 EQU SWP #08 MOD #00 EQU #0101 NEQ2 ,&no-marker8 JNZ POP2 ;marker8_icn RTN &no-marker8
|
||||
DUP2 #02 MOD #00 EQU SWP #02 MOD #00 EQU #0101 NEQ2 ,&no-marker4 JNZ POP2 ;marker4_icn RTN &no-marker4
|
||||
POP2 ;font RTN
|
||||
&no-bar
|
||||
STH POP2 STHr
|
||||
#20 SUB #00 SWP #0008 MUL2 ,font ADD2
|
||||
#20 SUB #00 SWP #0008 MUL2 ;font ADD2
|
||||
|
||||
RTN
|
||||
|
||||
|
@ -236,7 +236,7 @@ RTN
|
|||
|
||||
POP
|
||||
++
|
||||
#30 ~timer.frame #08 MOD ADD SET-CELL
|
||||
#30 .timer/frame PEK #08 MOD ADD SET-CELL
|
||||
|
||||
RTN
|
||||
|
||||
|
@ -304,13 +304,13 @@ RTN
|
|||
|
||||
STH
|
||||
( limit )
|
||||
DUP #00 NEQ ^$not-edge JNZ
|
||||
DUP #00 NEQ ,¬-edge JNZ
|
||||
#2a SET-CELL POP STHr RTN
|
||||
$not-edge
|
||||
¬-edge
|
||||
( collide )
|
||||
DUP2 -- GET-CELL #2e EQU ^$not-collide JNZ
|
||||
DUP2 -- GET-CELL #2e EQU ,¬-collide JNZ
|
||||
#2a SET-CELL POP STHr RTN
|
||||
$not-collide
|
||||
¬-collide
|
||||
( move )
|
||||
DUP2 STHr
|
||||
SWP -- SWP SET-CELL
|
||||
|
@ -373,13 +373,13 @@ RTN
|
|||
|
||||
STH
|
||||
( limit )
|
||||
OVR #00 NEQ ^$not-edge JNZ
|
||||
OVR #00 NEQ ,¬-edge JNZ
|
||||
#2a SET-CELL POP STHr RTN
|
||||
$not-edge
|
||||
¬-edge
|
||||
( collide )
|
||||
DUP2 SWP -- SWP GET-CELL #2e EQU ^$not-collide JNZ
|
||||
DUP2 SWP -- SWP GET-CELL #2e EQU ,¬-collide JNZ
|
||||
#2a SET-CELL POP STHr RTN
|
||||
$not-collide
|
||||
¬-collide
|
||||
( move )
|
||||
DUP2
|
||||
SWP -- SWP STHr SET-CELL
|
||||
|
@ -415,149 +415,149 @@ RTN
|
|||
@run-char ( x y char -- )
|
||||
|
||||
( skip dot )
|
||||
DUP #2e NEQ ^$not-dot JNZ
|
||||
DUP #2e NEQ ,¬-dot JNZ
|
||||
POP POP2 RTN
|
||||
$not-dot
|
||||
¬-dot
|
||||
|
||||
( skip locked )
|
||||
ROT ROT DUP2 GET-LOCK #00 EQU ^$not-locked JNZ
|
||||
ROT ROT DUP2 GET-LOCK #00 EQU ,¬-locked JNZ
|
||||
POP POP2 RTN
|
||||
$not-locked
|
||||
¬-locked
|
||||
ROT
|
||||
|
||||
( A ) DUP #41 EQU ,op-a JNZ2 ( B ) DUP #42 EQU ,op-b JNZ2
|
||||
( C ) DUP #43 EQU ,op-c JNZ2 ( D ) DUP #44 EQU ,op-d JNZ2
|
||||
( E ) DUP #45 EQU ,op-e JNZ2 ( F ) DUP #46 EQU ,op-f JNZ2
|
||||
( G ) DUP #47 EQU ,op-g JNZ2 ( H ) DUP #48 EQU ,op-h JNZ2
|
||||
( I ) DUP #49 EQU ,op-i JNZ2 ( J ) DUP #4a EQU ,op-j JNZ2
|
||||
( K ) DUP #4b EQU ,op-k JNZ2 ( L ) DUP #4c EQU ,op-l JNZ2
|
||||
( M ) DUP #4d EQU ,op-m JNZ2 ( N ) DUP #4e EQU ,op-n JNZ2
|
||||
( O ) DUP #4f EQU ,op-o JNZ2 ( P ) DUP #50 EQU ,op-p JNZ2
|
||||
( Q ) DUP #51 EQU ,op-q JNZ2 ( R ) DUP #52 EQU ,op-r JNZ2
|
||||
( S ) DUP #53 EQU ,op-s JNZ2 ( T ) DUP #54 EQU ,op-t JNZ2
|
||||
( U ) DUP #55 EQU ,op-u JNZ2 ( V ) DUP #56 EQU ,op-v JNZ2
|
||||
( W ) DUP #57 EQU ,op-w JNZ2 ( X ) DUP #58 EQU ,op-x JNZ2
|
||||
( Y ) DUP #59 EQU ,op-y JNZ2 ( Z ) DUP #5a EQU ,op-z JNZ2
|
||||
( * ) DUP #2a EQU ,op-bang JNZ2
|
||||
( A ) DUP #41 EQU ;op-a JNZ2 ( B ) DUP #42 EQU ;op-b JNZ2
|
||||
( C ) DUP #43 EQU ;op-c JNZ2 ( D ) DUP #44 EQU ;op-d JNZ2
|
||||
( E ) DUP #45 EQU ;op-e JNZ2 ( F ) DUP #46 EQU ;op-f JNZ2
|
||||
( G ) DUP #47 EQU ;op-g JNZ2 ( H ) DUP #48 EQU ;op-h JNZ2
|
||||
( I ) DUP #49 EQU ;op-i JNZ2 ( J ) DUP #4a EQU ;op-j JNZ2
|
||||
( K ) DUP #4b EQU ;op-k JNZ2 ( L ) DUP #4c EQU ;op-l JNZ2
|
||||
( M ) DUP #4d EQU ;op-m JNZ2 ( N ) DUP #4e EQU ;op-n JNZ2
|
||||
( O ) DUP #4f EQU ;op-o JNZ2 ( P ) DUP #50 EQU ;op-p JNZ2
|
||||
( Q ) DUP #51 EQU ;op-q JNZ2 ( R ) DUP #52 EQU ;op-r JNZ2
|
||||
( S ) DUP #53 EQU ;op-s JNZ2 ( T ) DUP #54 EQU ;op-t JNZ2
|
||||
( U ) DUP #55 EQU ;op-u JNZ2 ( V ) DUP #56 EQU ;op-v JNZ2
|
||||
( W ) DUP #57 EQU ;op-w JNZ2 ( X ) DUP #58 EQU ;op-x JNZ2
|
||||
( Y ) DUP #59 EQU ;op-y JNZ2 ( Z ) DUP #5a EQU ;op-z JNZ2
|
||||
( * ) DUP #2a EQU ;op-bang JNZ2
|
||||
POP POP2
|
||||
|
||||
RTN
|
||||
|
||||
@init ( -- )
|
||||
|
||||
#00 ~grid.height
|
||||
$ver
|
||||
#00 ~grid.width
|
||||
$hor
|
||||
#00 .grid/height PEK
|
||||
&ver
|
||||
#00 .grid/width PEK
|
||||
&hor
|
||||
( get x,y ) SWP2 OVR STH SWP2 OVR STHr
|
||||
( unlock ) #00 SET-LOCK
|
||||
( incr ) SWP ++ SWP
|
||||
DUP2 LTH ^$hor JNZ
|
||||
DUP2 LTH ,&hor JNZ
|
||||
POP2
|
||||
( incr ) SWP ++ SWP
|
||||
DUP2 LTH ^$ver JNZ
|
||||
DUP2 LTH ,&ver JNZ
|
||||
POP2
|
||||
|
||||
RTN
|
||||
|
||||
@run ( -- )
|
||||
|
||||
,init JSR2
|
||||
;init JSR2
|
||||
|
||||
#00 ~grid.height
|
||||
$ver
|
||||
#00 ~grid.width
|
||||
$hor
|
||||
#00 .grid/height PEK
|
||||
&ver
|
||||
#00 .grid/width PEK
|
||||
&hor
|
||||
( get x,y ) SWP2 OVR STH SWP2 OVR STHr
|
||||
DUP2 GET-CELL ,run-char JSR2
|
||||
( incr ) SWP ++ SWP
|
||||
DUP2 LTH ^$hor JNZ
|
||||
DUP2 GET-CELL ;run-char JSR2
|
||||
( incr ) SWP ++ SWP
|
||||
DUP2 LTH ,&hor JNZ
|
||||
POP2
|
||||
( incr ) SWP ++ SWP
|
||||
DUP2 LTH ^$ver JNZ
|
||||
DUP2 LTH ,&ver JNZ
|
||||
POP2
|
||||
,redraw JSR2
|
||||
;redraw JSR2
|
||||
|
||||
RTN
|
||||
|
||||
@draw-interface ( -- )
|
||||
|
||||
~Screen.height #0008 SUB2 =Screen.y
|
||||
.Screen/height DEI2 #0008 SUB2 .Screen/y DEO2
|
||||
|
||||
( Positionx )
|
||||
#0000 =Screen.x
|
||||
~selection.x1
|
||||
DUP #04 SFT GET-CHAR #20 SUB #00 SWP #0008 MUL2 ,font ADD2 =Screen.addr
|
||||
#22 =Screen.color
|
||||
#0008 =Screen.x
|
||||
#0f AND GET-CHAR #20 SUB #00 SWP #0008 MUL2 ,font ADD2 =Screen.addr
|
||||
#22 =Screen.color
|
||||
#0000 .Screen/x DEO2
|
||||
.selection/x1 PEK
|
||||
DUP #04 SFT GET-CHAR #20 SUB #00 SWP #0008 MUL2 ;font ADD2 .Screen/addr DEO2
|
||||
#22 .Screen/color DEO
|
||||
#0008 .Screen/x DEO2
|
||||
#0f AND GET-CHAR #20 SUB #00 SWP #0008 MUL2 ;font ADD2 .Screen/addr DEO2
|
||||
#22 .Screen/color DEO
|
||||
|
||||
( Positiony )
|
||||
#0010 =Screen.x
|
||||
~selection.y1
|
||||
DUP #04 SFT GET-CHAR #20 SUB #00 SWP #0008 MUL2 ,font ADD2 =Screen.addr
|
||||
#22 =Screen.color
|
||||
#0018 =Screen.x
|
||||
#0f AND GET-CHAR #20 SUB #00 SWP #0008 MUL2 ,font ADD2 =Screen.addr
|
||||
#22 =Screen.color
|
||||
#0010 .Screen/x DEO2
|
||||
.selection/y1 PEK
|
||||
DUP #04 SFT GET-CHAR #20 SUB #00 SWP #0008 MUL2 ;font ADD2 .Screen/addr DEO2
|
||||
#22 .Screen/color DEO
|
||||
#0018 .Screen/x DEO2
|
||||
#0f AND GET-CHAR #20 SUB #00 SWP #0008 MUL2 ;font ADD2 .Screen/addr DEO2
|
||||
#22 .Screen/color DEO
|
||||
|
||||
#0020 =Screen.x
|
||||
,position_icn =Screen.addr
|
||||
#23 =Screen.color
|
||||
#0020 .Screen/x DEO2
|
||||
;position_icn .Screen/addr DEO2
|
||||
#23 .Screen/color DEO
|
||||
|
||||
( Frame )
|
||||
#0030 =Screen.x
|
||||
~timer.frame
|
||||
DUP #04 SFT GET-CHAR #20 SUB #00 SWP #0008 MUL2 ,font ADD2 =Screen.addr
|
||||
#22 =Screen.color
|
||||
#0038 =Screen.x
|
||||
#0f AND GET-CHAR #20 SUB #00 SWP #0008 MUL2 ,font ADD2 =Screen.addr
|
||||
#22 =Screen.color
|
||||
#0030 .Screen/x DEO2
|
||||
.timer/frame PEK
|
||||
DUP #04 SFT GET-CHAR #20 SUB #00 SWP #0008 MUL2 ;font ADD2 .Screen/addr DEO2
|
||||
#22 .Screen/color DEO
|
||||
#0038 .Screen/x DEO2
|
||||
#0f AND GET-CHAR #20 SUB #00 SWP #0008 MUL2 ;font ADD2 .Screen/addr DEO2
|
||||
#22 .Screen/color DEO
|
||||
|
||||
#0040 =Screen.x
|
||||
,beat_icn =Screen.addr
|
||||
#21 ~timer.frame #08 MOD #00 EQU #02 MUL ADD =Screen.color
|
||||
#0040 .Screen/x DEO2
|
||||
;beat_icn .Screen/addr DEO2
|
||||
#21 .timer/frame PEK #08 MOD #00 EQU #02 MUL ADD .Screen/color DEO
|
||||
|
||||
( Speed )
|
||||
#0050 =Screen.x
|
||||
~timer.speed
|
||||
DUP #04 SFT GET-CHAR #20 SUB #00 SWP #0008 MUL2 ,font ADD2 =Screen.addr
|
||||
#22 =Screen.color
|
||||
#0058 =Screen.x
|
||||
#0f AND GET-CHAR #20 SUB #00 SWP #0008 MUL2 ,font ADD2 =Screen.addr
|
||||
#22 =Screen.color
|
||||
#0050 .Screen/x DEO2
|
||||
.timer/speed PEK
|
||||
DUP #04 SFT GET-CHAR #20 SUB #00 SWP #0008 MUL2 ;font ADD2 .Screen/addr DEO2
|
||||
#22 .Screen/color DEO
|
||||
#0058 .Screen/x DEO2
|
||||
#0f AND GET-CHAR #20 SUB #00 SWP #0008 MUL2 ;font ADD2 .Screen/addr DEO2
|
||||
#22 .Screen/color DEO
|
||||
|
||||
( TODO: Signal VU )
|
||||
|
||||
( File )
|
||||
~Screen.width #0028 SUB2 =Screen.x
|
||||
~Screen.x 8+ =Screen.x ,eye_icns =Screen.addr #21 =Screen.color
|
||||
~Screen.x 8+ =Screen.x ,filestate_icn =Screen.addr #21 =Screen.color
|
||||
~Screen.x 8+ =Screen.x ,load_icn =Screen.addr #21 =Screen.color
|
||||
~Screen.x 8+ =Screen.x ,save_icn =Screen.addr #21 =Screen.color
|
||||
.Screen/width DEI2 #0028 SUB2 .Screen/x DEO2
|
||||
.Screen/x DEI2 8+ .Screen/x DEO2 ;eye_icns .Screen/addr DEO2 #21 .Screen/color DEO
|
||||
.Screen/x DEI2 8+ .Screen/x DEO2 ;filestate_icn .Screen/addr DEO2 #21 .Screen/color DEO
|
||||
.Screen/x DEI2 8+ .Screen/x DEO2 ;load_icn .Screen/addr DEO2 #21 .Screen/color DEO
|
||||
.Screen/x DEI2 8+ .Screen/x DEO2 ;save_icn .Screen/addr DEO2 #21 .Screen/color DEO
|
||||
|
||||
RTN
|
||||
|
||||
@redraw ( -- )
|
||||
|
||||
#00 ~grid.height
|
||||
$ver
|
||||
( pos-y ) OVR #00 SWP #0008 MUL2 =Screen.y
|
||||
#00 ~grid.width
|
||||
$hor
|
||||
( pos-x ) OVR #00 SWP #0008 MUL2 =Screen.x
|
||||
#00 .grid/height PEK
|
||||
&ver
|
||||
( pos-y ) OVR #00 SWP #0008 MUL2 .Screen/y DEO2
|
||||
#00 .grid/width PEK
|
||||
&hor
|
||||
( pos-x ) OVR #00 SWP #0008 MUL2 .Screen/x DEO2
|
||||
( get x,y ) SWP2 OVR STH SWP2 OVR STHr
|
||||
( sprite ) DUP2 ,get-cell-sprite JSR2 =Screen.addr
|
||||
( draw ) ,is-selected JSR2 #0d MUL #21 ADD =Screen.color
|
||||
( incr ) SWP ++ SWP
|
||||
DUP2 LTH ^$hor JNZ
|
||||
( sprite ) DUP2 ;get-cell-sprite JSR2 .Screen/addr DEO2
|
||||
( draw ) ;is-selected JSR2 #0d MUL #21 ADD .Screen/color DEO
|
||||
( incr ) SWP ++ SWP
|
||||
DUP2 LTH ,&hor JNZ
|
||||
POP2
|
||||
( incr ) SWP ++ SWP
|
||||
DUP2 LTH ^$ver JNZ
|
||||
DUP2 LTH ,&ver JNZ
|
||||
POP2
|
||||
|
||||
,draw-interface JSR2
|
||||
;draw-interface JSR2
|
||||
|
||||
RTN
|
||||
|
||||
|
|
Loading…
Reference in New Issue