selection almost kinda working

This commit is contained in:
~d6 2023-02-09 20:56:08 -05:00
parent 0768b2302d
commit f5017b1988
1 changed files with 143 additions and 34 deletions

177
term.tal
View File

@ -89,7 +89,7 @@
|0000
@tint $1 ( draw mode. 01=regular, 04=inverted )
@attr $1 ( 5 bits: RxxxBBFF )
@dirty? $1 ( screen needs redraw? )
@dirty $1 ( screen needs redraw? )
@lastkey $1 ( last button press )
@rows $2 ( height in characters )
@cols $2 ( width in characters )
@ -102,6 +102,11 @@
@lastmouse-x $2 ( last mouse x )
@lastmouse-y $2 ( last mouse y )
@lastmouse-st $1 ( last mouse press )
@is-lit $1
@lit-first-x $2
@lit-first-y $2
@lit-last-x $2
@lit-last-y $2
( terminal settings )
@irm $1 ( 01: insert and move right, 00: replace and overwrite )
@ -172,8 +177,8 @@
( set to 01 to enable debug log )
#00 .debug STZ
.debug LDZ ?&continue BRK &continue
#99 #010e DEO
.debug LDZ ?&continue BRK &continue
;debug-log .File1/name DEO2
#01 .File1/append DEO
BRK
@ -214,7 +219,7 @@
LTH2k JMP SWP2 NIP2 JMP2r
@clear-screen
#01 .dirty? STZ
#01 .dirty STZ
LIT2r =cells ( [addr*] )
#0000 &yloop ( y* [addr*] y* )
#0000 &xloop ( y* x* [addr*] )
@ -227,15 +232,21 @@
LTH2 ?&yloop ( y+1* [addr*] )
POP2 POP2r JMP2r ( )
@redraw
.dirty? LDZ #00 EQU ?&done
@redraw ( -> )
.dirty LDZ #00 EQU ?&done
LIT2r =cells ( [addr*] )
.rows LDZ2 #0000 DUP2 #0008 ( border ) ADD2 .Screen/y DEO2
&yloop
.cols LDZ2 #0000 DUP2 #0008 ( border ) ADD2 .Screen/x DEO2
&xloop
STH2kr LDA2 draw-cell
.Screen/x DEI2k #0008 ( width ) ADD2 ROT DEO2
STH2kr LDA2 ( DUP2 erase-cell ) draw-cell
#40 .Screen/sprite DEO
( FIXME start )
.Screen/y DEI2k #0004 ADD2 ROT DEO2
#40 .Screen/sprite DEO
.Screen/y DEI2k #0004 SUB2 ROT DEO2
( FIXME end )
.Screen/x DEI2k #0008 ( width/2 ) ADD2 ROT DEO2
INC2 INC2r INC2r
GTH2k ?&xloop
POP2 POP2
@ -243,28 +254,25 @@
INC2
GTH2k ?&yloop
POP2 POP2 POP2r
draw-cursor #00 .dirty? STZ &done BRK
.is-lit LDZ #00 EQU ?&cursor redraw-selection
&cursor draw-cursor #00 .dirty STZ
&done BRK
@clear-cursor
.cur-x LDZ2 #30 SFT2 ( width ) #0008 ( border ) ADD2 .Screen/x DEO2
.cur-y LDZ2 #000c MUL2 ( height ) #0008 ( border ) ADD2 .Screen/y DEO2
cur-addr LDA2
!draw-cell
@screen-to-cursor
.cur-x LDZ2 #30 SFT2 ( width ) #0008 ( border ) ADD2 .Screen/x DEO2
.cur-y LDZ2 #000c MUL2 ( height ) #0008 ( border ) ADD2 .Screen/y DEO2
@screen-to-cell ( row* col* -> )
#30 SFT2 ( width ) #0008 ( border ) ADD2 .Screen/x DEO2
#000c MUL2 ( height ) #0008 ( border ) ADD2 .Screen/y DEO2
JMP2r
@screen-to-cursor ( -> )
.cur-y LDZ2 .cur-x LDZ2 !screen-to-cell
@clear-cursor
screen-to-cursor cur-addr LDA2 !draw-cell
@draw-cursor
( .cur-x LDZ2 #30 SFT2 ( width ) #0008 ( border ) ADD2 .Screen/x DEO2
.cur-y LDZ2 #000c MUL2 ( height ) #0008 ( border ) ADD2 .Screen/y DEO2 )
screen-to-cursor
cur-addr LDA2
.tcem LDZ #00 EQU ?&skip
SWP reverse-tint SWP
&skip
!draw-cell
screen-to-cursor cur-addr LDA2
.tcem LDZ #00 EQU ?&skip SWP reverse-tint SWP
&skip !draw-cell
@on-button ( -> )
.lastkey LDZ ( last^ )
@ -315,13 +323,86 @@
.paste LDZ #00 EQU ?&end LIT "1 ;bracket-paste JSR2 &end
JMP2r [ &path ".snarf 00 ]
@redraw-selection ( -> )
#010e DEO
.lit-first-y LDZ2 .cols LDZ2 MUL2 ( y0*cols* )
.lit-first-x LDZ2 ADD2 #0002 MUL2 ( 2(y0*cols+x0)* )
;cells ADD2 STH2 ( [addr*] )
.lit-last-y LDZ2 INC2 .lit-first-y LDZ2 ( yn* y0* [addr*] )
DUP2 .lit-first-x LDZ2 STH2k ( yn* y0* x0* [addr* x0*] )
screen-to-cell ( yn* y0* [addr* x0*] )
&yloop ( yn* y* [addr* x*] )
OVR2 OVR2 INC2 GTH2 STH .cols LDZ2 ( yn* y* cols* [addr* x* last^] )
.lit-last-x LDZ2 INC2 ( yn* y* cols* xn* [addr* x* last^] )
STHr JMP SWP2 POP2 STH2r ( yn* y* xlim* x* [addr*] )
&xloop ( yn* y* xlim* x* [addr*] )
STH2kr LDA2 highlight-cell ( yn* y* xlim* x* [addr*] )
.Screen/x DEI2k #0008 ADD2 ROT DEO2 ( yn* y* xlim* x* [addr*] )
INC2 INC2r INC2r ( yn* y* xlim* x+1* [addr+2*] )
GTH2k ?&xloop ( yn* y* xlim* x+1* [addr+2*] )
POP2 POP2 ( yn* y* [addr+2*] )
.Screen/y DEI2k #000c ADD2 ROT DEO2 ( yn* y* [addr+2*] )
#0008 .Screen/x DEO2 ( yn* y* [addr+2*] )
LIT2r 0000 INC2 GTH2k ?&yloop ( yn* y+1* [addr+2* 0*] )
POP2 POP2 POP2r POP2r ( )
#010e DEO
JMP2r ( )
@point-to-coord ( x* y* -> row* col* )
DUP2 #0008 SUB2 min #000c DIV2 #0017 min SWP2 ( row=(y-8)/12* x* )
DUP2 #0008 SUB2 min #0008 DIV2 #004f min JMP2r ( row* col=(x-8)/8* )
@start-selection ( -> )
#01 .is-lit STZ ( )
.Mouse/x DEI2 .Mouse/y DEI2 ( x* y* )
point-to-coord OVR2 OVR2 ( row* col* row* col* )
.lit-first-x STZ2 .lit-first-y STZ2 ( row* col* )
.lit-last-x STZ2 .lit-last-y STZ2 ( )
redraw-selection !draw-cursor ( )
@selection-is-empty ( -> bool^ )
.lit-first-y LDZ2 .lit-last-y LDZ2 EQU2
.lit-first-x LDZ2 .lit-last-x LDZ2 EQU2 AND JMP2r
@handle-selection ( -> )
selection-is-empty ?&skip
( .lit-first-y LDZ2 .lit-first-x LDZ2
.lit-last-y LDZ2 .lit-last-x LDZ2
#010e DEO POP2 POP2 POP2 POP2 )
&skip !clear-selection
@clear-selection ( -> )
#00 .is-lit STZ
#01 .dirty STZ
#0000 DUP2 .lit-first-y STZ2
DUP2 .lit-first-x STZ2
DUP2 .lit-last-y STZ2
.lit-last-x STZ2 JMP2r
@update-selection ( -> )
.Mouse/x DEI2 .Mouse/y DEI2 ( x* y* )
point-to-coord OVR2 ( row* col* row* )
.lit-first-y LDZ2 LTH2 ?&earlier ( row* col* )
.lit-last-x STZ2 .lit-last-y STZ2 JMP2r ( )
&earlier ( row* col* )
.lit-first-x STZ2 .lit-first-y STZ2 JMP2r ( )
@end-selection ( -> )
update-selection redraw-selection ( )
draw-cursor !handle-selection ( )
@on-click-down ( click^ -> )
#02 AND ?&middle-click !&done
&middle-click paste-snarf
&done JMP2r
DUP #01 AND ?&left-click
DUP #02 AND ?&middle-click
!&done
&left-click POP !start-selection
&middle-click POP !paste-snarf
&done POP JMP2r
@on-click-up ( unclick^ -> )
POP JMP2r
#01 AND ?&left-click !&done
&left-click !end-selection
&done JMP2r
@draw-at ( x* y* addr* -> )
STH2k .Screen/addr DEO2 ( x* y* [addr*] )
@ -332,11 +413,15 @@
STH2r #0008 ADD2 .Screen/addr DEO2 ( 43 sprite^ )
DEO JMP2r ( )
( TODO: need to adjust first/last x/y while dragging )
@on-move ( -> )
.Mouse/x DEI2 .lastmouse-x LDZ2 NEQ2 ?&redraw ( )
.Mouse/y DEI2 .lastmouse-y LDZ2 NEQ2 ?&redraw ( )
JMP2r ( )
&redraw ( )
.is-lit LDZ #00 EQU ?&next redraw-selection &next
update-selection ( )
.lastmouse-x LDZ2 .lastmouse-y LDZ2 ( lx* ly* )
#0200 ;cp437 ADD2 draw-at ( )
.Mouse/x DEI2 .Mouse/y DEI2 ( x* y* )
@ -604,7 +689,7 @@
STA2k INC2 INC2 INC2r INC2r ( 4220 addr+2* [i+1*] )
ORAkr STHr ?&loop ( 4220 addr+2* [i+2*] )
POP2r POP2 POP2 ( )
#01 .dirty? STZ ( ; FIXME just redraw affected tiles )
#01 .dirty STZ ( ; FIXME just redraw affected tiles )
JMP2r ( )
&skip POP2 POP2 JMP2r ( )
@ -801,7 +886,7 @@
#0002 SUB2 ( bound* pos-2* [i*] )
GTH2k #00 EQU ?&loop ( bound* pos-2* [i*] )
POP2 POP2 POP2r ( )
#01 .dirty? STZ JMP2r ( )
#01 .dirty STZ JMP2r ( )
@insert-n-spaces ( n* -> )
STH2 ( [n*] )
@ -822,7 +907,7 @@
STA2k INC2 INC2 INC2r ( 4220 pos+2* [-i+1*] )
ORAkr STHr ?&loop2 ( 4220 pos+2* [-i+1*] )
POP2 POP2 POP2r ( )
#01 .dirty? STZ JMP2r ( )
#01 .dirty STZ JMP2r ( )
( starts with cursor pos )
@delete-n-chars ( n* -> )
@ -835,7 +920,7 @@
OVR2 STA2 INC2 INC2 ( limit* pos+2* [i*] ; pos<-x )
GTH2k ?&loop ( limit* pos+2* [i*] )
POP2 POP2 POP2r ( )
#01 .dirty? STZ JMP2r ( )
#01 .dirty STZ JMP2r ( )
( starts below current line )
@delete-n-lines ( n* -> )
@ -852,7 +937,7 @@
STH2kr .col-bytes LDZ2 SUB2 STA2
INC2r INC2r GTH2kr STHr ?&loop
POP2r POP2r
#01 .dirty? STZ
#01 .dirty STZ
draw-cursor BRK
( ( 0 <= index < 128 )
@ -895,6 +980,28 @@
.Screen/y DEI2k #0004 SUB2 ROT DEO2 ( )
JMP2r ( )
@erase-cell ( cell* -> )
NIP LITr 40 ( c^ [tint^] )
#00 SWP #40 SFT2 ;cp437 ADD2 ( addr* [tint^] )
.Screen/addr DEO2k ( addr* s^ [tint^] )
STHkr .Screen/sprite DEO ( addr* s^ [tint^] )
.Screen/y DEI2k #0004 ADD2 ROT DEO2 ( addr* s^ [tint^] )
STH #0004 ADD2 STHr DEO2 ( [tint^] )
STHr .Screen/sprite DEO ( )
.Screen/y DEI2k #0004 SUB2 ROT DEO2 ( )
JMP2r ( )
@highlight-cell ( cell* -> )
NIP LITr 47 ( c^ [tint^] )
#00 SWP #40 SFT2 ;cp437 ADD2 ( addr* [tint^] )
.Screen/addr DEO2k ( addr* s^ [tint^] )
STHkr .Screen/sprite DEO ( addr* s^ [tint^] )
.Screen/y DEI2k #0004 ADD2 ROT DEO2 ( addr* s^ [tint^] )
STH #0004 ADD2 STHr DEO2 ( [tint^] )
STHr .Screen/sprite DEO ( )
.Screen/y DEI2k #0004 SUB2 ROT DEO2 ( )
JMP2r ( )
@next-arg ( c^ -> )
POP
( TODO: check if we already have max args )
@ -948,5 +1055,7 @@
01
( device mask ) 41 0d07
@lengths $18 ( keep consistent with .cols )
( store tint+char for each screen position )
@cells