( GUI Shapes )
%RTN { JMP2r }
%++ { #0001 ADD2 }
%-- { #0001 SUB2 }
%8+ { #0008 ADD2 }
%ABS2 { DUP2 #000f SFT2 EQU #04 JCN #ffff MUL2 }
%LTS2 { #8000 ADD2 SWP2 #8000 ADD2 GTH2 }
%GTS2 { #8000 ADD2 SWP2 #8000 ADD2 LTH2 }
%SIZE-TO-RECT {
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 ]
@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 )
|0100
( theme ) #f03f .System/r DEO2 #f03f .System/g DEO2 #003f .System/b DEO2
( 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
BRK
@line-slow ( x1 y1 x2 y2 color -- )
( 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 JCN
.line/e1 PEK2 #0002 MUL2 .line/e2 POK2
.line/e2 PEK2 .line/dy PEK2 LTS2 ,&skipy JCN
.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 JCN
.line/e1 PEK2 .line/dx PEK2 ADD2 .line/e1 POK2
.line/y PEK2 .line/sy PEK2 ADD2 .line/y POK2
&skipx
;&loop JMP2
&end
RTN
@line-rect ( x1 y1 x2 y2 color -- )
( 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 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 JCN
POP2 POP2
.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 JCN
POP2 POP2
RTN
@fill-rect ( x1 y1 x2 y2 color -- )
.color POK
( x1 x2 y1 y2 ) ROT2 SWP2
&ver
( save ) OVR2 .Screen/y DEO2
STH2 STH2 OVR2 OVR2
&hor
( save ) OVR2 .Screen/x DEO2
( draw ) .color PEK .Screen/color DEO
( incr ) SWP2 ++ SWP2
OVR2 OVR2 LTS2 ,&hor JCN
POP2 POP2 STH2r STH2r
( incr ) SWP2 ++ SWP2
OVR2 OVR2 LTS2 ,&ver JCN
POP2 POP2 POP2 POP2
RTN
@draw-circle ( xc yc r color -- )
( 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 JCN
( 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 JCN
RTN
&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 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 JCN
POP2 POP2
( incr ) SWP2 8+ SWP2
OVR2 OVR2 LTH2 ,&ver JCN
POP2 POP2
RTN
@checker_icn [ f0f0 f0f0 0f0f 0f0f ]