d6
/
uxn
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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:
Andrew Alderwick 2021-04-23 15:34:03 +01:00
parent e065b8015a
commit 3c758b734b
12 changed files with 2595 additions and 2546 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

158
projects/demos/clock.usm
View File

@ -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

608
projects/demos/musictracker.usm
View File

@ -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 }
%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
&notes-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 ,&notes-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 ]

422
projects/demos/theme.usm
View File

@ -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
@ -347,9 +353,9 @@ RTN
[ 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.. )
[

118
projects/examples/gui.hover.usm
View File

@ -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

98
projects/examples/gui.label.usm
View File

@ -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 ]

114
projects/examples/gui.picture.usm
View File

@ -3,101 +3,107 @@
%RTN { JMP2r }
%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 [ ]

184
projects/examples/gui.shapes.usm
View File

@ -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

86
projects/examples/gui.wallpaper.usm
View File

@ -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
( 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
&loop
DUP2 ,row JSR
#0001 ADD2
DUP2 ~Screen.height LTH2 ^$loop JNZ
DUP2 .Screen/height DEI2 LTH2 ,&loop JNZ
POP2
~scroll.wait ^$noscroll JNZ
~scroll.y #0001 ADD2 =scroll.y
.scroll/wait PEK ,&noscroll JNZ
.scroll/y PEK2 #0001 ADD2 .scroll/y POK2
BRK
$noscroll
~scroll.wait #01 SUB =scroll.wait
&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
.Screen/width DEI2
&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
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
&rest
DUP2 ORA ,&loop JNZ
POP2 POP2
JMP2r
#15 =Screen.color
#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
&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
,&rest JMP

744
projects/software/left.usm
View File

@ -14,8 +14,11 @@
- Don't scroll past oef
- Hor scroll
- Real scrolling distance
FIXME
- Imperfect port from previous assembler syntax
)
%RTN { JMP2r }
%RTN? { #00 EQU #02 JNZ STH2r JMP2 }
@ -23,420 +26,422 @@
%8/ { #0003 SFT2 } %8* { #0030 SFT2 }
%8- { #0008 SUB2 } %8+ { #0008 ADD2 }
( variables )
;lock { byte 1 }
;k { byte 1 }
;l { byte 1 }
;i { short 2 }
;j { short 2 }
;addr { short 2 }
;selection { from 2 to 2 }
;position { x 2 y 2 }
;scroll { x 2 y 2 }
;pt { x 2 y 2 }
;mouse { x 2 y 2 }
;touch { x1 2 y1 2 x2 2 y2 2 state 1 }
;textarea { x1 2 y1 2 x2 2 y2 2 addr 2 cursor 1 }
;label { x 2 y 2 color 1 addr 2 } ( remove )
( 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 }
|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 ]
|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 ]
( variables )
|0000
@lock [ &byte $1 ]
@k [ &byte $1 ]
@l [ &byte $1 ]
@i [ &short $2 ]
@j [ &short $2 ]
@addr [ &short $2 ]
@selection [ &from $2 &to $2 ]
@position [ &x $2 &y $2 ]
@scroll [ &x $2 &y $2 ]
@pt [ &x $2 &y $2 ]
@mouse [ &x $2 &y $2 ]
@touch [ &x1 $2 &y1 $2 &x2 $2 &y2 $2 &state $1 ]
@textarea [ &x1 $2 &y1 $2 &x2 $2 &y2 $2 &addr $2 &cursor $1 ]
@label [ &x $2 &y $2 &color $1 &addr $2 ] ( remove )
( program )
|0200 @RESET
|0100 @RESET
( theme ) #e0fa =System.r #30fa =System.g #30fa =System.b
( 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-mouse .Mouse/vector DEO2
( vectors ) ;on-button .Controller/vector DEO2
( load file )
,filepath ,load-file JSR2
;filepath ;load-file JSR2
( place textarea )
#0018 =textarea.x1 ~Screen.height 8- =textarea.y2
#0018 .textarea/x1 POK2 .Screen/height DEI2 8- .textarea/y2 POK2
,select JSR2
,redraw JSR2
;select JSR2
;redraw JSR2
BRK
@on-button ( -> )
( alt + arrow )
~Controller.button #0f AND #02 NEQ ^$no-alt JNZ
~Controller.button #04 SFT
DUP #01 NEQ ^$no-aup JNZ
( sel word ) ,find-wordstart JSR2 =selection.to $no-aup
DUP #02 NEQ ^$no-adown JNZ
( sel word ) ,find-wordend JSR2 =selection.to $no-adown
DUP #04 NEQ ^$no-aleft JNZ
( sel decr ) ~selection.to -- =selection.to $no-aleft
DUP #08 NEQ ^$no-aright JNZ
( sel incr ) ~selection.to ++ =selection.to $no-aright
.Controller/button DEI #0f AND #02 NEQ ,&no-alt JNZ
.Controller/button DEI #04 SFT
DUP #01 NEQ ,&no-aup JNZ
( sel word ) ;find-wordstart JSR2 .selection/to POK2 &no-aup
DUP #02 NEQ ,&no-adown JNZ
( sel word ) ;find-wordend JSR2 .selection/to POK2 &no-adown
DUP #04 NEQ ,&no-aleft JNZ
( sel decr ) .selection/to PEK2 -- .selection/to POK2 &no-aleft
DUP #08 NEQ ,&no-aright JNZ
( sel incr ) .selection/to PEK2 ++ .selection/to POK2 &no-aright
POP
,clamp-selection JSR2
,redraw JSR2
;clamp-selection JSR2
;redraw JSR2
BRK
$no-alt
&no-alt
( ctrl + arrow )
~Controller.button #0f AND #01 NEQ ^$no-ctrl JNZ
~Controller.button #04 SFT
DUP #01 NEQ ^$no-cup JNZ
( jump scroll ) #0004 ,scroll-up JSR2 $no-cup
DUP #02 NEQ ^$no-cdown JNZ
( jump scroll ) #0004 ,scroll-down JSR2 $no-cdown
DUP #04 NEQ ^$no-cleft JNZ
( jump line ) ,goto-linestart JSR2 $no-cleft
DUP #08 NEQ ^$no-cright JNZ
( jump line ) ,goto-lineend JSR2 $no-cright
.Controller/button DEI #0f AND #01 NEQ ,&no-ctrl JNZ
.Controller/button DEI #04 SFT
DUP #01 NEQ ,&no-cup JNZ
( jump scroll ) #0004 ;scroll-up JSR2 &no-cup
DUP #02 NEQ ,&no-cdown JNZ
( jump scroll ) #0004 ;scroll-down JSR2 &no-cdown
DUP #04 NEQ ,&no-cleft JNZ
( jump line ) ;goto-linestart JSR2 &no-cleft
DUP #08 NEQ ,&no-cright JNZ
( jump line ) ;goto-lineend JSR2 &no-cright
POP
,redraw JSR2
;redraw JSR2
BRK
$no-ctrl
&no-ctrl
( arrow )
~Controller.button #f0 AND #00 EQU ,$no-arrow JNZ2
~Controller.button #f0 AND
DUP #10 NEQ ^$no-arrowup JNZ
( clamp ) ~position.y #0000 EQU2 ^$no-arrowup JNZ
,find-lineoffset JSR2 =position.x ~position.y -- =position.y
,find-selection JSR2 DUP2 =selection.from ++ =selection.to $no-arrowup
DUP #20 NEQ ^$no-arrowdown JNZ
.Controller/button DEI #f0 AND #00 EQU ;&no-arrow JNZ2
.Controller/button DEI #f0 AND
DUP #10 NEQ ,&no-arrowup JNZ
( clamp ) .position/y PEK2 #0000 EQU2 ,&no-arrowup JNZ
;find-lineoffset JSR2 .position/x POK2 .position/y PEK2 -- .position/y POK2
;find-selection JSR2 DUP2 .selection/from POK2 ++ .selection/to POK2 &no-arrowup
DUP #20 NEQ ,&no-arrowdown JNZ
( clamp:TODO )
,find-lineoffset JSR2 =position.x ~position.y ++ =position.y
,find-selection JSR2 DUP2 =selection.from ++ =selection.to $no-arrowdown
DUP #40 NEQ ^$no-arrowleft JNZ
( clamp ) ~selection.from ,document.body EQU2 ^$no-arrowleft JNZ
~selection.from -- DUP2 =selection.from ++ =selection.to $no-arrowleft
DUP #80 NEQ ^$no-arrowright JNZ
;find-lineoffset JSR2 .position/x POK2 .position/y PEK2 ++ .position/y POK2
;find-selection JSR2 DUP2 .selection/from POK2 ++ .selection/to POK2 &no-arrowdown
DUP #40 NEQ ,&no-arrowleft JNZ
( clamp ) .selection/from PEK2 ;document/body EQU2 ,&no-arrowleft JNZ
.selection/from PEK2 -- DUP2 .selection/from POK2 ++ .selection/to POK2 &no-arrowleft
DUP #80 NEQ ,&no-arrowright JNZ
( clamp:TODO )
#aa =Console.byte
~selection.from ++ DUP2 =selection.from ++ =selection.to $no-arrowright
#aa .Console/byte DEO
.selection/from PEK2 ++ DUP2 .selection/from POK2 ++ .selection/to POK2 &no-arrowright
POP
,clamp-selection JSR2
,follow-selection JSR2
,redraw JSR2
$no-arrow
;clamp-selection JSR2
;follow-selection JSR2
;redraw JSR2
&no-arrow
~Controller.key #08 NEQ ^$no-backspace JNZ
.Controller/key DEI #08 NEQ ,&no-backspace JNZ
( erase )
~selection.to ~selection.from SUB2 #0001 NEQ2 ^$erase-multiple JNZ
~selection.to ~selection.from SUB2 ,shift-left JSR2
,$erase-end JMP2
$erase-multiple
~selection.from ++ =selection.from
~selection.to ~selection.from SUB2 ++ ,shift-left JSR2
$erase-end
~selection.from -- =selection.from
~selection.from ++ =selection.to
,redraw JSR2
.selection/to PEK2 .selection/from PEK2 SUB2 #0001 NEQ2 ,&erase-multiple JNZ
.selection/to PEK2 .selection/from PEK2 SUB2 ;shift-left JSR2
;&erase-end JMP2
&erase-multiple
.selection/from PEK2 ++ .selection/from POK2
.selection/to PEK2 .selection/from PEK2 SUB2 ++ ;shift-left JSR2
&erase-end
.selection/from PEK2 -- .selection/from POK2
.selection/from PEK2 ++ .selection/to POK2
;redraw JSR2
BRK
$no-backspace
&no-backspace
( insert )
~selection.to ~selection.from SUB2 ,shift-right JSR2
~Controller.key ~selection.from POK2
~selection.from ++ =selection.from
~selection.from ++ =selection.to
,redraw JSR2
.selection/to PEK2 .selection/from PEK2 SUB2 ;shift-right JSR2
.Controller/key DEI .selection/from PEK2 PUT
.selection/from PEK2 ++ .selection/from POK2
.selection/from PEK2 ++ .selection/to POK2
;redraw JSR2
BRK
@on-mouse ( -> )
~Mouse.state #00 EQU ^$touch-end JNZ
~Mouse.x #0010 LTH2 ,touch-linebar JNZ2
~Mouse.x ~Screen.width 8- LTH2 ,touch-body JNZ2
,touch-scrollbar JMP2
$touch-end
.Mouse/state DEI #00 EQU ,&touch-end JNZ
.Mouse/x DEI2 #0010 LTH2 ;touch-linebar JNZ2
.Mouse/x DEI2 .Screen/width DEI2 8- LTH2 ;touch-body JNZ2
;touch-scrollbar JMP2
&touch-end
~Mouse.state =touch.state
.Mouse/state DEI .touch/state POK
,draw-cursor JSR2
;draw-cursor JSR2
BRK
@touch-linebar ( -- )
#0000 =position.x
~Mouse.y 8/ ~scroll.y ADD2 =position.y
,find-selection JSR2 DUP2 =selection.from ++ =selection.to
,goto-linestart JSR2
,redraw JSR2
,draw-cursor JSR2
#0000 .position/x POK2
.Mouse/y DEI2 8/ .scroll/y PEK2 ADD2 .position/y POK2
;find-selection JSR2 DUP2 .selection/from POK2 ++ .selection/to POK2
;goto-linestart JSR2
;redraw JSR2
;draw-cursor JSR2
BRK
@touch-body ( -- )
~Mouse.y 8/ ~scroll.y ADD2 =position.y
~Mouse.x ~textarea.x1 SUB2 #0007 ADD2 #0007 DIV2 =position.x
.Mouse/y DEI2 8/ .scroll/y PEK2 ADD2 .position/y POK2
.Mouse/x DEI2 .textarea/x1 PEK2 SUB2 #0007 ADD2 #0007 DIV2 .position/x POK2
( chords )
~Mouse.chord #00 EQU ^$no-chords JNZ
~Mouse.chord
DUP #01 NEQ ^$no-chord-cut JNZ
,cut JSR2 ( release ) #00 DUP =Mouse.state =Mouse.chord $no-chord-cut
DUP #10 NEQ ^$no-chord-paste JNZ
,paste JSR2 ( release ) #00 DUP =Mouse.state =Mouse.chord $no-chord-paste
.Mouse/chord DEI #00 EQU ,&no-chords JNZ
.Mouse/chord DEI
DUP #01 NEQ ,&no-chord-cut JNZ
;cut JSR2 ( release ) #00 DUP .Mouse/state DEO .Mouse/chord DEO &no-chord-cut
DUP #10 NEQ ,&no-chord-paste JNZ
;paste JSR2 ( release ) #00 DUP .Mouse/state DEO .Mouse/chord DEO &no-chord-paste
POP
,redraw JSR2
;redraw JSR2
BRK
$no-chords
&no-chords
( drag )
~Mouse.state ~touch.state NEQ ~Controller.button #0f AND #02 NEQ #0101 EQU2 ^$no-drag JNZ
.Mouse/state DEI .touch/state PEK NEQ .Controller/button DEI #0f AND #02 NEQ #0101 EQU2 ,&no-drag JNZ
( on drag )
,find-selection JSR2 ++ =selection.to
,clamp-selection JSR2
^$end JMP
$no-drag
;find-selection JSR2 ++ .selection/to POK2
;clamp-selection JSR2
,&end JMP
&no-drag
( on click )
,find-selection JSR2 DUP2 =selection.from ++ =selection.to
$end
~Mouse.state =touch.state
,draw-cursor JSR2
,redraw JSR2
;find-selection JSR2 DUP2 .selection/from POK2 ++ .selection/to POK2
&end
.Mouse/state DEI .touch/state POK
;draw-cursor JSR2
;redraw JSR2
BRK
@touch-scrollbar ( -- )
~Mouse.y #0008 GTH2 ^$no-up JNZ
( decr ) ~scroll.y #00 ~scroll.y #0000 NEQ2 SUB2 =scroll.y
^$end JMP
$no-up
~Mouse.y ~Screen.height 8- LTH2 ^$no-down JNZ
( incr ) ~scroll.y ++ =scroll.y
^$end JMP
$no-down
~Mouse.y 8- =scroll.y
$end
~Mouse.state =touch.state
,draw-cursor JSR2
,redraw JSR2
.Mouse/y DEI2 #0008 GTH2 ,&no-up JNZ
( decr ) .scroll/y PEK2 #00 .scroll/y PEK2 #0000 NEQ2 SUB2 .scroll/y POK2
,&end JMP
&no-up
.Mouse/y DEI2 .Screen/height DEI2 8- LTH2 ,&no-down JNZ
( incr ) .scroll/y PEK2 ++ .scroll/y POK2
,&end JMP
&no-down
.Mouse/y DEI2 8- .scroll/y POK2
&end
.Mouse/state DEI .touch/state POK
;draw-cursor JSR2
;redraw JSR2
BRK
@load-file ( path )
=File.name #8000 =File.length ,document.body =File.load
.File/name DEO2 #8000 .File/length DEO2 ;document/body .File/load DEO2
( get file length )
,document.body =document.eof
$loop
( incr ) ~document.eof ++ =document.eof
~document.eof PEK2 #00 NEQ ^$loop JNZ
;document/body ;document/eof PUT2
&loop
( incr ) ;document/eof GET2 ++ ;document/eof PUT2
;document/eof GET2 GET #00 NEQ ,&loop JNZ
RTN
@scroll-up ( length -- )
DUP2 ~scroll.y LTH2 ^$clamp JNZ
#0000 =scroll.y POP2 RTN
$clamp
~scroll.y SWP2 SUB2 =scroll.y
DUP2 .scroll/y PEK2 LTH2 ,&clamp JNZ
#0000 .scroll/y POK2 POP2 RTN
&clamp
.scroll/y PEK2 SWP2 SUB2 .scroll/y POK2
RTN
@scroll-down ( length -- )
( TODO: Clamp )
~scroll.y SWP2 ADD2 =scroll.y
.scroll/y PEK2 SWP2 ADD2 .scroll/y POK2
RTN
@shift-left ( length -- )
=i
~selection.from -- =j ( start -> end )
$loop
( move ) ~j ~i ADD2 PEK2 ~j POK2
( incr ) ~j ++ =j
~j ~document.eof LTH2 ^$loop JNZ
~document.eof ~i SUB2 =document.eof
.i POK2
.selection/from PEK2 -- .j POK2 ( start -> end )
&loop
( move ) .j PEK2 .i PEK2 ADD2 GET .j PEK2 PUT
( incr ) .j PEK2 ++ .j POK2
.j PEK2 ;document/eof GET2 LTH2 ,&loop JNZ
;document/eof GET2 .i PEK2 SUB2 ;document/eof PUT2
RTN
@shift-right ( length -- )
=i
~document.eof =j ( end -> start )
$loop
( move ) ~j ~i SUB2 PEK2 ~j POK2
( decr ) ~j -- =j
~j ~selection.from GTH2 ^$loop JNZ
~document.eof ~i ADD2 =document.eof
.i POK2
;document/eof GET2 .j POK2 ( end -> start )
&loop
( move ) .j PEK2 .i PEK2 SUB2 GET .j PEK2 PUT
( decr ) .j PEK2 -- .j POK2
.j PEK2 .selection/from PEK2 GTH2 ,&loop JNZ
;document/eof GET2 .i PEK2 ADD2 ;document/eof PUT2
RTN
@follow-selection ( -- )
~position.y ~scroll.y GTH2 ^$no-up JNZ
~position.y =scroll.y RTN
$no-up
~position.y ~Screen.height #0010 SUB2 8/ ~scroll.y ADD2 LTH2 ^$no-down JNZ
~position.y ~Screen.height #0010 SUB2 8/ SUB2 =scroll.y RTN
$no-down
.position/y PEK2 .scroll/y PEK2 GTH2 ,&no-up JNZ
.position/y PEK2 .scroll/y POK2 RTN
&no-up
.position/y PEK2 .Screen/height DEI2 #0010 SUB2 8/ .scroll/y PEK2 ADD2 LTH2 ,&no-down JNZ
.position/y PEK2 .Screen/height DEI2 #0010 SUB2 8/ SUB2 .scroll/y POK2 RTN
&no-down
RTN
@clamp-selection ( -- )
~selection.from ~selection.to LTH2 RTN?
~selection.from ++ =selection.to
.selection/from PEK2 .selection/to PEK2 LTH2 RTN?
.selection/from PEK2 ++ .selection/to POK2
RTN
@goto-linestart ( -- )
$loop
~selection.from -- PEK2 #0a EQU RTN?
~selection.from -- PEK2 #0d EQU RTN?
( decr ) ~selection.from DUP2 =selection.to -- =selection.from
~selection.from PEK2 #00 NEQ ^$loop JNZ
&loop
.selection/from PEK2 -- GET #0a EQU RTN?
.selection/from PEK2 -- GET #0d EQU RTN?
( decr ) .selection/from PEK2 DUP2 .selection/to POK2 -- .selection/from POK2
.selection/from PEK2 GET #00 NEQ ,&loop JNZ
( clamp at document body )
~selection.from ,document.body GTH2 RTN?
,document.body DUP2 =selection.from ++ =selection.to
.selection/from PEK2 ;document/body GTH2 RTN?
;document/body DUP2 .selection/from POK2 ++ .selection/to POK2
RTN
@goto-lineend ( -- )
$loop
~selection.from PEK2 #0a EQU RTN?
~selection.from PEK2 #0d EQU RTN?
( incr ) ~selection.from ++ DUP2 ++ =selection.to =selection.from
~selection.from PEK2 #00 NEQ ^$loop JNZ
&loop
.selection/from PEK2 GET #0a EQU RTN?
.selection/from PEK2 GET #0d EQU RTN?
( incr ) .selection/from PEK2 ++ DUP2 ++ .selection/to POK2 .selection/from POK2
.selection/from PEK2 GET #00 NEQ ,&loop JNZ
( clamp at document body )
~selection.from ,document.eof LTH2 RTN?
,document.eof -- DUP2 =selection.from ++ =selection.to
.selection/from PEK2 ;document/eof LTH2 RTN?
;document/eof -- DUP2 .selection/from POK2 ++ .selection/to POK2
RTN
@find-wordstart ( -- )
~selection.to =j
$loop
( decr ) ~j -- =j
~j PEK2 #20 EQU ^$end JNZ
~j PEK2 #0a EQU ^$end JNZ
~j PEK2 #0d EQU ^$end JNZ
~j ,document.body GTH2 ^$loop JNZ
$end
( return ) ~j --
.selection/to PEK2 .j POK2
&loop
( decr ) .j PEK2 -- .j POK2
.j PEK2 GET #20 EQU ,&end JNZ
.j PEK2 GET #0a EQU ,&end JNZ
.j PEK2 GET #0d EQU ,&end JNZ
.j PEK2 ;document/body GTH2 ,&loop JNZ
&end
( return ) .j PEK2 --
RTN
@find-wordend ( -- )
~selection.to =j
$loop
( incr ) ~j ++ =j
~j PEK2 #20 EQU ^$end JNZ
~j PEK2 #0a EQU ^$end JNZ
~j PEK2 #0d EQU ^$end JNZ
~j ,document.body GTH2 ^$loop JNZ
$end
( return ) ~j ++
.selection/to PEK2 .j POK2
&loop
( incr ) .j PEK2 ++ .j POK2
.j PEK2 GET #20 EQU ,&end JNZ
.j PEK2 GET #0a EQU ,&end JNZ
.j PEK2 GET #0d EQU ,&end JNZ
.j PEK2 ;document/body GTH2 ,&loop JNZ
&end
( return ) .j PEK2 ++
RTN
@find-lineoffset ( return character offset from linestart )
#0000 =j
$loop
( incr ) ~j ++ =j
~selection.from ~j SUB2 PEK2 #0a EQU ^$end JNZ
~selection.from ~j SUB2 PEK2 #0d EQU ^$end JNZ
~selection.from ~j SUB2 ,document.body GTH2 ^$loop JNZ
$end
( return ) ~j
#0000 .j POK2
&loop
( incr ) .j PEK2 ++ .j POK2
.selection/from PEK2 .j PEK2 SUB2 GET #0a EQU ,&end JNZ
.selection/from PEK2 .j PEK2 SUB2 GET #0d EQU ,&end JNZ
.selection/from PEK2 .j PEK2 SUB2 ;document/body GTH2 ,&loop JNZ
&end
( return ) .j PEK2
RTN
@find-line ( position -> addr )
,document.body =j #0000 =pt.y
$loop
~pt.y ~position.y -- GTH2 ^$end JNZ
~j PEK2 #0a NEQ ~j PEK2 #0d NEQ #0101 EQU2 ^$no-space JNZ
( incr ) ~pt.y ++ =pt.y
$no-space
( incr ) ~j ++ =j
~j PEK2 #00 NEQ ^$loop JNZ
$end
( return ) ~j
;document/body .j POK2 #0000 .pt/y POK2
&loop
.pt/y PEK2 .position/y PEK2 -- GTH2 ,&end JNZ
.j PEK2 GET #0a NEQ .j PEK2 GET #0d NEQ #0101 EQU2 ,&no-space JNZ
( incr ) .pt/y PEK2 ++ .pt/y POK2
&no-space
( incr ) .j PEK2 ++ .j POK2
.j PEK2 GET #00 NEQ ,&loop JNZ
&end
( return ) .j PEK2
RTN
@find-selection ( position -> addr )
,find-line JSR2 ( find line )
#0000 =pt.x
$loop
~j ~pt.x ADD2 PEK2 #0a EQU ^$end JNZ
~j ~pt.x ADD2 PEK2 #0d EQU ^$end JNZ
( incr ) ~pt.x ++ =pt.x
~pt.x ~position.x -- LTH2 ^$loop JNZ
$end
( return ) ~pt.x ADD2
;find-line JSR2 ( find line )
#0000 .pt/x POK2
&loop
.j PEK2 .pt/x PEK2 ADD2 GET #0a EQU ,&end JNZ
.j PEK2 .pt/x PEK2 ADD2 GET #0d EQU ,&end JNZ
( incr ) .pt/x PEK2 ++ .pt/x POK2
.pt/x PEK2 .position/x PEK2 -- LTH2 ,&loop JNZ
&end
( return ) .pt/x PEK2 ADD2
RTN
@cut ( -- )
,copy JSR2
~selection.to ~selection.from SUB2 ,shift-left JSR2
~selection.from ++ =selection.to
;copy JSR2
.selection/to PEK2 .selection/from PEK2 SUB2 ;shift-left JSR2
.selection/from PEK2 ++ .selection/to POK2
RTN
@copy ( -- )
#0000 =i ( start )
~selection.to ~selection.from SUB2 =j ( end )
~j =clip.len
$loop
~selection.from ~i ADD2 PEK2 ,clip.body ~i ADD2 POK2
( incr ) ~i ++ =i
~i ~j LTH2 ^$loop JNZ
#0000 .i POK2 ( start )
.selection/to PEK2 .selection/from PEK2 SUB2 .j POK2 ( end )
.j PEK2 ;clip/len PUT2
&loop
.selection/from PEK2 .i PEK2 ADD2 GET ;clip/body .i PEK2 ADD2 PUT
( incr ) .i PEK2 ++ .i POK2
.i PEK2 .j PEK2 LTH2 ,&loop JNZ
RTN
@paste ( -- )
~clip.len ,shift-right JSR2
#0000 =i ( start )
~clip.len =j ( end )
$loop
,clip.body ~i ADD2 PEK2 ~selection.from ~i ADD2 POK2
( incr ) ~i ++ =i
~i ~j LTH2 ^$loop JNZ
;clip/len GET2 ;shift-right JSR2
#0000 .i POK2 ( start )
;clip/len GET2 .j POK2 ( end )
&loop
;clip/body .i PEK2 ADD2 GET .selection/from PEK2 .i PEK2 ADD2 PUT
( incr ) .i PEK2 ++ .i POK2
.i PEK2 .j PEK2 LTH2 ,&loop JNZ
RTN
@select ( position -> selection )
,document.body =selection.from #0000 =pt.x #0000 =pt.y
$loop
~selection.from PEK2 #0a NEQ ~selection.from PEK2 #0d NEQ #0101 EQU2 ^$no-space JNZ
( incr ) ~pt.y ++ =pt.y
#0000 =pt.x
$no-space
~pt.y ~position.y -- GTH2 ~pt.x ~position.x -- GTH2 #0101 NEQ2 ^$no-reached JNZ
~selection.from ++ =selection.to
;document/body .selection/from POK2 #0000 .pt/x POK2 #0000 .pt/y POK2
&loop
.selection/from PEK2 GET #0a NEQ .selection/from PEK2 GET #0d NEQ #0101 EQU2 ,&no-space JNZ
( incr ) .pt/y PEK2 ++ .pt/y POK2
#0000 .pt/x POK2
&no-space
.pt/y PEK2 .position/y PEK2 -- GTH2 .pt/x PEK2 .position/x PEK2 -- GTH2 #0101 NEQ2 ,&no-reached JNZ
.selection/from PEK2 ++ .selection/to POK2
RTN
$no-reached
( incr ) ~pt.x ++ =pt.x
( incr ) ~selection.from ++ =selection.from
~selection.from PEK2 #00 NEQ ^$loop JNZ
&no-reached
( incr ) .pt/x PEK2 ++ .pt/x POK2
( incr ) .selection/from PEK2 ++ .selection/from POK2
.selection/from PEK2 GET #00 NEQ ,&loop JNZ
RTN
@ -444,180 +449,180 @@ RTN
@redraw
,draw-textarea JSR2
,draw-scrollbar JSR2
,draw-titlebar JSR2
;draw-textarea JSR2
;draw-scrollbar JSR2
;draw-titlebar JSR2
( save/load icons )
~Screen.height 8- =Screen.y
.Screen/height DEI2 8- .Screen/y DEO2
~Screen.width #0030 SUB2 =Screen.x
,eye_icn =Screen.addr
#22 =Screen.color
.Screen/width DEI2 #0030 SUB2 .Screen/x DEO2
;eye_icn .Screen/addr DEO2
#22 .Screen/color DEO
~Screen.width #0028 SUB2 =Screen.x
,name_icn =Screen.addr
#22 =Screen.color
.Screen/width DEI2 #0028 SUB2 .Screen/x DEO2
;name_icn .Screen/addr DEO2
#22 .Screen/color DEO
~Screen.width #0020 SUB2 =Screen.x
,load_icn =Screen.addr
#22 =Screen.color
.Screen/width DEI2 #0020 SUB2 .Screen/x DEO2
;load_icn .Screen/addr DEO2
#22 .Screen/color DEO
~Screen.width #0018 SUB2 =Screen.x
,save_icn =Screen.addr
#22 =Screen.color
.Screen/width DEI2 #0018 SUB2 .Screen/x DEO2
;save_icn .Screen/addr DEO2
#22 .Screen/color DEO
RTN
@draw-short ( short )
=addr
,font_hex #00 ,addr PEK2 #f0 AND #04 SFT #08 MUL ADD2 =Screen.addr
( draw ) #2e =Screen.color
~Screen.x 8+ =Screen.x
,font_hex #00 ,addr PEK2 #0f AND #08 MUL ADD2 =Screen.addr
( draw ) #2e =Screen.color
~Screen.x 8+ =Screen.x
,font_hex #00 ,addr ++ PEK2 #f0 AND #04 SFT #08 MUL ADD2 =Screen.addr
( draw ) #2e =Screen.color
~Screen.x 8+ =Screen.x
,font_hex #00 ,addr ++ PEK2 #0f AND #08 MUL ADD2 =Screen.addr
( draw ) #2e =Screen.color
.addr POK2
;font_hex #00 ;addr GET #f0 AND #04 SFT #08 MUL ADD2 .Screen/addr DEO2
( draw ) #2e .Screen/color DEO
.Screen/x DEI2 8+ .Screen/x DEO2
;font_hex #00 ;addr GET #0f AND #08 MUL ADD2 .Screen/addr DEO2
( draw ) #2e .Screen/color DEO
.Screen/x DEI2 8+ .Screen/x DEO2
;font_hex #00 ;addr ++ GET #f0 AND #04 SFT #08 MUL ADD2 .Screen/addr DEO2
( draw ) #2e .Screen/color DEO
.Screen/x DEI2 8+ .Screen/x DEO2
;font_hex #00 ;addr ++ GET #0f AND #08 MUL ADD2 .Screen/addr DEO2
( draw ) #2e .Screen/color DEO
RTN
@draw-cursor
( clear last cursor )
~mouse.x =Screen.x
~mouse.y =Screen.y
,blank_icn =Screen.addr
#30 =Screen.color
.mouse/x PEK2 .Screen/x DEO2
.mouse/y PEK2 .Screen/y DEO2
;blank_icn .Screen/addr DEO2
#30 .Screen/color DEO
( record mouse positions )
~Mouse.x =mouse.x
~Mouse.y =mouse.y
.Mouse/x DEI2 .mouse/x POK2
.Mouse/y DEI2 .mouse/y POK2
( draw new cursor )
~mouse.x =Screen.x
~mouse.y =Screen.y
,cursor_icn =Screen.addr
#3f ~Mouse.state #01 EQU #0a MUL SUB =Screen.color
.mouse/x PEK2 .Screen/x DEO2
.mouse/y PEK2 .Screen/y DEO2
;cursor_icn .Screen/addr DEO2
#3f .Mouse/state DEI #01 EQU #0a MUL SUB .Screen/color DEO
RTN
@draw-textarea ( x y color addr )
,document.body =textarea.addr
;document/body .textarea/addr POK2
( scroll to position )
#0000 =j ( j is linebreaks )
$find-offset
~scroll.y ~j EQU2 ^$find-offset-end JNZ
~textarea.addr PEK2 #0a NEQ ~textarea.addr PEK2 #0d NEQ #0101 EQU2 ^$no-break JNZ
( incr ) ~j ++ =j $no-break
( incr ) ~textarea.addr ++ =textarea.addr
~textarea.addr PEK2 #00 NEQ ^$find-offset JNZ
$find-offset-end
#0000 .j POK2 ( j is linebreaks )
&find-offset
.scroll/y PEK2 .j PEK2 EQU2 ,&find-offset-end JNZ
.textarea/addr PEK2 GET #0a NEQ .textarea/addr PEK2 GET #0d NEQ #0101 EQU2 ,&no-break JNZ
( incr ) .j PEK2 ++ .j POK2 &no-break
( incr ) .textarea/addr PEK2 ++ .textarea/addr POK2
.textarea/addr PEK2 GET #00 NEQ ,&find-offset JNZ
&find-offset-end
#0018 =Screen.x #0000 =Screen.y
~textarea.addr =i
#0018 .Screen/x DEO2 #0000 .Screen/y DEO2
.textarea/addr PEK2 .i POK2
$loop
&loop
~Screen.y ~Screen.height #0010 SUB2 GTH2 ,$end JNZ2
.Screen/y DEI2 .Screen/height DEI2 #0010 SUB2 GTH2 ;&end JNZ2
~i PEK2 #0a NEQ ~i PEK2 #0d NEQ #0101 EQU2 ,$no-linebreak JNZ2
.i PEK2 GET #0a NEQ .i PEK2 GET #0d NEQ #0101 EQU2 ;&no-linebreak JNZ2
( draw linebreak )
,linebreak_icn =Screen.addr
;linebreak_icn .Screen/addr DEO2
( draw ) #02
~i ~selection.from -- GTH2
~i ~selection.to LTH2 #0101 EQU2
#26 MUL ADD =Screen.color
.i PEK2 .selection/from PEK2 -- GTH2
.i PEK2 .selection/to PEK2 LTH2 #0101 EQU2
#26 MUL ADD .Screen/color DEO
( fill clear )
$fill-clear
( incr ) ~Screen.x 8+ =Screen.x
,font =Screen.addr
#21 =Screen.color
~Screen.x ~Screen.width 8- LTH2 ^$fill-clear JNZ
&fill-clear
( incr ) .Screen/x DEI2 8+ .Screen/x DEO2
;font .Screen/addr DEO2
#21 .Screen/color DEO
.Screen/x DEI2 .Screen/width DEI2 8- LTH2 ,&fill-clear JNZ
( draw line number )
#0000 =Screen.x
~scroll.y ~Screen.y 8/ ADD2 DUP2 SWP POP =k
~position.y EQU2 #05 MUL =l
,font_hex #00 ~k #f0 AND #04 SFT #08 MUL ADD2 =Screen.addr
#24 ~l ADD =Screen.color
#0008 =Screen.x
,font_hex #00 ~k #0f AND #08 MUL ADD2 =Screen.addr
#24 ~l ADD =Screen.color
#0000 .Screen/x DEO2
.scroll/y PEK2 .Screen/y DEI2 8/ ADD2 DUP2 SWP POP .k POK
.position/y PEK2 EQU2 #05 MUL .l POK
;font_hex #00 .k PEK #f0 AND #04 SFT #08 MUL ADD2 .Screen/addr DEO2
#24 .l PEK ADD .Screen/color DEO
#0008 .Screen/x DEO2
;font_hex #00 .k PEK #0f AND #08 MUL ADD2 .Screen/addr DEO2
#24 .l PEK ADD .Screen/color DEO
#0010 =Screen.x
( incr ) ~Screen.y 8+ =Screen.y
$no-linebreak
#0010 .Screen/x DEO2
( incr ) .Screen/y DEI2 8+ .Screen/y DEO2
&no-linebreak
( get character )
,font #00 ~i PEK2 #20 SUB 8* ADD2 =Screen.addr
;font #00 .i PEK2 GET #20 SUB 8* ADD2 .Screen/addr DEO2
( is a special character )
~i PEK2 #20 GTH ^$no-tab JNZ ,font =Screen.addr $no-tab
.i PEK2 GET #20 GTH ,&no-tab JNZ ;font .Screen/addr DEO2 &no-tab
( draw ) #21
~i ~selection.from -- GTH2
~i ~selection.to LTH2 #0101 EQU2
#05 MUL ADD =Screen.color
.i PEK2 .selection/from PEK2 -- GTH2
.i PEK2 .selection/to PEK2 LTH2 #0101 EQU2
#05 MUL ADD .Screen/color DEO
( incr ) ~i ++ =i
( incr ) ~Screen.x #0007 ADD2 =Screen.x
( incr ) .i PEK2 ++ .i POK2
( incr ) .Screen/x DEI2 #0007 ADD2 .Screen/x DEO2
~i PEK2 #00 NEQ ,$loop JNZ2
.i PEK2 GET #00 NEQ ;&loop JNZ2
$end
&end
RTN
@draw-scrollbar ( -- )
,scrollbar_icn ( keeping a copy on stack )
;scrollbar_icn ( keeping a copy on stack )
~Screen.width 8- =Screen.x
#0008 =Screen.y
DUP2 =Screen.addr
.Screen/width DEI2 8- .Screen/x DEO2
#0008 .Screen/y DEO2
DUP2 .Screen/addr DEO2
#0008 ~Screen.height 8-
$loop
( draw ) #21 =Screen.color
( incr ) SWP2 8+ DUP2 =Screen.y SWP2
OVR2 OVR2 LTH2 ^$loop JNZ
#0008 .Screen/height DEI2 8-
&loop
( draw ) #21 .Screen/color DEO
( incr ) SWP2 8+ DUP2 .Screen/y DEO2 SWP2
OVR2 OVR2 LTH2 ,&loop JNZ
POP2 POP2
~scroll.y 8+ =Screen.y
DUP2 #0008 ADD2 =Screen.addr
( draw ) #21 =Screen.color
.scroll/y PEK2 8+ .Screen/y DEO2
DUP2 #0008 ADD2 .Screen/addr DEO2
( draw ) #21 .Screen/color DEO
#0000 =Screen.y
DUP2 #0010 ADD2 =Screen.addr
( draw ) #24 =Screen.color
#0000 .Screen/y DEO2
DUP2 #0010 ADD2 .Screen/addr DEO2
( draw ) #24 .Screen/color DEO
~Screen.height 8- =Screen.y
#0018 ADD2 =Screen.addr
( draw ) #24 =Screen.color
.Screen/height DEI2 8- .Screen/y DEO2
#0018 ADD2 .Screen/addr DEO2
( draw ) #24 .Screen/color DEO
RTN
@draw-titlebar
#0018 ~Screen.height 8- #29 ,filepath
( load ) =label.addr =label.color =Screen.y =Screen.x
~label.addr
$loop
( draw ) DUP2 PEK2 #00 SWP #20 SUB 8* ,font ADD2 =Screen.addr ~label.color =Screen.color
#0018 .Screen/height DEI2 8- #29 ;filepath
( load ) .label/addr POK2 .label/color POK .Screen/y DEO2 .Screen/x DEO2
.label/addr PEK2
&loop
( draw ) DUP2 GET #00 SWP #20 SUB 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
( selection )
~selection.from ,document.body SUB2 ,draw-short JSR2
.selection/from PEK2 ;document/body SUB2 ;draw-short JSR2
RTN
@ -705,8 +710,9 @@ RTN
@blank_icn [ 0000 0000 0000 0000 ]
@cursor_icn [ 80c0 e0f0 f8e0 1000 ]
@filepath1 [ projects/examples/gui.hover.usm 00 ]
@filepath [ projects/examples/dev.time.usm 00 ]
@filepath1 [ "projects/examples/gui.hover.usm 00 ]
@filepath [ "README.md 00 ]
@clip [ &len $2 &body $100 ]
@document [ &eof $2 &body $0 ]
;clip { len 2 body 256 }
;document { eof 2 body 2 }

881
projects/software/nasu.usm
View File

File diff suppressed because it is too large Load Diff

1084
projects/software/noodle.usm
View File

File diff suppressed because it is too large Load Diff

364
projects/software/orca.usm
View File

@ -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
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 ,&not-edge JNZ
#2a SET-CELL POP STHr RTN
$not-edge
&not-edge
( collide )
DUP2 -- GET-CELL #2e EQU ^$not-collide JNZ
DUP2 -- GET-CELL #2e EQU ,&not-collide JNZ
#2a SET-CELL POP STHr RTN
$not-collide
&not-collide
( move )
DUP2 STHr
SWP -- SWP SET-CELL
@ -373,13 +373,13 @@ RTN
STH
( limit )
OVR #00 NEQ ^$not-edge JNZ
OVR #00 NEQ ,&not-edge JNZ
#2a SET-CELL POP STHr RTN
$not-edge
&not-edge
( collide )
DUP2 SWP -- SWP GET-CELL #2e EQU ^$not-collide JNZ
DUP2 SWP -- SWP GET-CELL #2e EQU ,&not-collide JNZ
#2a SET-CELL POP STHr RTN
$not-collide
&not-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 ,&not-dot JNZ
POP POP2 RTN
$not-dot
&not-dot
( skip locked )
ROT ROT DUP2 GET-LOCK #00 EQU ^$not-locked JNZ
ROT ROT DUP2 GET-LOCK #00 EQU ,&not-locked JNZ
POP POP2 RTN
$not-locked
&not-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
DUP2 GET-CELL ;run-char JSR2
( incr ) SWP ++ SWP
DUP2 LTH ^$hor JNZ
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
( 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
DUP2 LTH ,&hor JNZ
POP2
( incr ) SWP ++ SWP
DUP2 LTH ^$ver JNZ
DUP2 LTH ,&ver JNZ
POP2
,draw-interface JSR2
;draw-interface JSR2
RTN