Fixed leak in mouse

This commit is contained in:
Devine Lu Linvega 2024-06-04 16:30:47 -08:00
parent 505d36f61e
commit 2084fe4025
1 changed files with 56 additions and 1 deletions

View File

@ -122,13 +122,17 @@
( | handle states )
[ LIT &last $1 ] .Mouse/state DEI DUP #02 LTH ?{ POP #02 }
DUP ,&last STR
( ) SWPk #00 NEQ #0001 NEQ2 ?{ file-save }
DUP2 #0001 NEQ2 ?{
( | down mouse1 )
.Mouse/x DEI2 DUP2 ,&x1 STR2
.Mouse/y DEI2 #0012 SUB2 DUP2 ,&y1 STR2
#01 <set-pixel>
<draw-sketch> }
DUP #01 NEQ ?{
( release/drag mouse1 )
( from* ) [ LIT2 &x1 $2 ] [ LIT2 &y1 $2 ]
@ -136,7 +140,8 @@
.Mouse/y DEI2 #0012 SUB2 DUP2 ,&y1 STR2
( paint ) #01 <paint-line>
<draw-sketch> }
DUP #02 NEQ2 ?{
DUP #02 NEQ ?{
( | release/drag mouse2 )
.Mouse/x DEI2 .Mouse/y DEI2 #0012 SUB2 <eraser>
<redraw> }
@ -244,6 +249,50 @@
POP2 POP2 POP2r INC2 GTH2k ?&>v
POP2 POP2 JMP2r
@<paint-line2> ( ax* ay* bx* by* color -- )
( pixel ) POP
ROT2 ( by ay )
( dy = -abs[by - ay] ) SUB2k abs2 #0000 SWP2 SUB2 ,&dy STR2
SWP2 ( ay by )
( sy = ay < by ? 1 : -1 ) LTS2k STH #0001 #ffff STHr [ JMP SWP2 POP2 ] ,&sy STR2
POP2 ( ay ) STH2 ( | ay )
( ax bx )
( sx = ax < bx ? 1 : -1 ) LTS2k STH #0001 #ffff STHr [ JMP SWP2 POP2 ] ,&sx STR2
SWP2 ( bx ax )
SUB2k abs2 ,&dx STR2
POP2 ( ax ) STH2 ( | ax )
SWP2r
( err = dx + dy )
,&dx LDR2 ,&dy LDR2 ADD2
( POP2 POP2r POP2r JMP2r )
( rst: ax bx )
( wst: err )
&>loop ( -- )
( draw ) OVR2r STH2r STH2kr [ LIT &color 01 ] <set-pixel>
( rst: e* e2* ) DUP2 #10 SFT2
( e2 >= dy ) [ LIT2 &dy $2 ] LTS2k ?{
( e += dy ) ADD2 #0000
( ax += sx ) SWP2r [ LIT2r &sx $2 ] ADD2r SWP2
} POP2
( e2 <= dx ) [ LIT2 &dx $2 ] GTS2k ?{
( e += dx ) ADD2 #0000
( ay += sy ) [ LIT2r &sy $2 ] ADD2r
} POP2
( remove e2 ) POP2
DUP2 [ LIT2 &by $2 ] NEQ2 ?&>loop
OVR2 [ LIT2 &bx $2 ] NEQ2 ?&>loop
( end )
JMP2r
@<paint-line> ( x1* y1* x2* y2* color -- )
,&color STR
,&y STR2
@ -741,6 +790,12 @@
DUP2 #0f SFT2 EQU ?{ #0000 SWP2 SUB2 }
JMP2r
@LTS2k ( a* b* -- f )
SUB2k POP #07 SFT JMP2r
@GTS2k ( a* b* -- f )
SWP2k SUB2 POP #07 SFT JMP2r
@lts2 ( a* b* -- f )
SUB2 POP #07 SFT JMP2r