You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 

450 lines
7.7 KiB

(
@|manifest )
@trap-menu ( -> )
;on-mouse-menu .Mouse/vector DEO2
;on-control-menu .Controller/vector DEO2
#40 draw-cursor
BRK
@on-mouse-menu ( -> )
#42 .Mouse/state DEI #00 NEQ ADD ;hand-icn update-cursor
( when touch cat )
.Mouse/state DEI #00 EQU ?&no-touch-cat
.Mouse/y DEI2 #000c GTH2 ?&no-touch-cat
.Mouse/x DEI2 get-xcat menu-select
( release ) #00 .Mouse/state DEO
BRK
&no-touch-cat
( when sub active )
;draw-menu/sel LDA #ff EQU ?&no-sub
( when sel changed )
.Mouse/y DEI2 #0004 SUB2 #03 SFT2 NIP #01 SUB
DUP ;draw-sub/sel LDA EQU ?&no-change
DUP ;draw-sub/sel STA
;draw-menu/sel LDA #ff draw-sub
&no-change
POP
( when touch sub )
.Mouse/state DEI #00 EQU ?&no-touch-sub
;draw-sub/sel LDA menu-select-sub
( release ) #00 .Mouse/state DEO
&no-touch-sub
BRK
&no-sub
( do not leave if menu is active )
;draw-menu/sel LDA INC ?&no-leave
.Mouse/y DEI2 #000c LTH2 ?&no-leave
menu-close
&no-leave
BRK
@menu-close ( -- )
untrap
;draw-menu/sel LDA
DUP #ff EQU ?&no-clear
DUP #00 draw-sub
#ff ;draw-menu/sel STA
redraw-all
draw-menu
&no-clear
POP
JMP2r
@menu-select ( cat -- )
( exists )
DUP get-cat ORA ?&exists
POP JMP2r
&exists
( clear )
;draw-menu/sel LDA
( unchanged ) EQUk ?menu-deselect
( unselected ) DUP #ff EQU ?&no-clear
DUP #00 draw-sub
&no-clear
POP
( draw )
redraw-all
#ff ;draw-sub/sel STA
DUP ;draw-menu/sel STA
#ff draw-sub
!draw-menu
@menu-deselect ( cat cat -- )
POP2
!menu-close
@menu-select-sub ( sub -- )
get-sub
menu-close
ORAk ROT ROT JCN2
JMP2r
@on-control-menu ( -> )
( TODO )
BRK
@get-cat ( cat -- cat* )
STH
#00 ,&id STR
;draw-menu/manifest LDA2
&cat
[ LIT &id 00 ] STHkr EQU ?&end
skip-sub
,&id LDR INC ,&id STR
LDAk ?&cat
POP2
#0000
&end
POPr
JMP2r
@get-sub ( sub -- sub* )
STH
;draw-menu/sel LDA get-cat
LDAk STH INC2 skip-str
STHr #00
&subcat
DUP STHkr EQU ?&end
SWP2 #0004 ADD2 skip-str SWP2
INC GTHk ?&subcat
POP2 POP2
( TODO: merge tails )
POPr
#0000
JMP2r
&end
POP2
INC2 INC2 LDA2
POPr
JMP2r
@get-catx ( cat -- x* )
LIT2r 0000
,&target STR
#00 ,&id STR
;draw-menu/manifest LDA2
&cat
[ LIT &id 00 ] [ LIT &target $1 ] EQU ?&end
INC2k get-strw #0008 ADD2 STH2 ADD2r
skip-sub
,&id LDR INC ,&id STR
LDAk ?&cat
POP2
&end
STH2r
#0010 ADD2
JMP2r
@get-xcat ( x* -- <cat> )
#0010 SUB2
LIT2r 0000
,&target STR2
#00 ,&id STR
;draw-menu/manifest LDA2
&cat
INC2k get-strw #0008 ADD2 STH2r ADD2
DUP2 [ LIT2 &target $2 ] LTH2 ?&continue
POP2 POP2 [ LIT &id 00 ] JMP2r
&continue
STH2
skip-sub
,&id LDR INC ,&id STR
LDAk ?&cat
POP2
POP2r
#ff
JMP2r
@find-modkey ( mod key -- fn* )
ORAk ?&no-null JMP2r &no-null
( not null )
,&mk STR2
;draw-menu/manifest LDA2
&cat
LDAk STH INC2 skip-str
STHr #00
&subcat
OVR2 LDA2 [ LIT2 &mk $2 ] NEQ2 ?&continue
POP2 INC2 INC2 LDA2 JMP2r
&continue
SWP2 #0004 ADD2 skip-str SWP2
INC GTHk ?&subcat
POP2
LDAk ?&cat
POP2
#0000
JMP2r
@skip-sub ( sub* -- sub* )
LDAk STH INC2 skip-str
STHr #00
&subcat
SWP2 #0004 ADD2 skip-str SWP2
INC GTHk ?&subcat
POP2
JMP2r
@skip-str ( str* -- str* )
&skip INC2 LDAk ?&skip INC2
JMP2r
@draw-menu ( mask -- )
#0010 .Screen/x DEO2
#0004 .Screen/y DEO2
#00 ,&id STR
[ LIT2 &manifest =manifest ]
&cat
( theme ) #0b03 [ LIT &sel ff ] [ LIT &id $1 ] EQU [ JMP SWP POP ] ;draw-chr/color STA
INC2k draw-str POP2 #20 draw-chr
skip-sub
,&id LDR INC ,&id STR
LDAk ?&cat
POP2
JMP2r
@draw-sub ( cat mask -- )
,&mask STR POP
;draw-menu/sel LDA get-cat
ORAk #00 EQU ?&skip
;draw-menu/sel LDA get-catx ,&anchor STR2
LDAk STH INC2 skip-str
STHr #00
&subcat
( theme ) STHk #070b STHr [ LIT &sel ff ] EQU [ JMP SWP POP ] [ LIT &mask $1 ] AND ;draw-chr/color STA
[ LIT2 &anchor $2 ] .Screen/x DEO2
#00 OVR INC #30 SFT2 #0004 ADD2 .Screen/y DEO2
SWP2 draw-label SWP2
INC GTHk ?&subcat
POP2 POP2
&skip
POP2
JMP2r
@draw-label ( label* -- next-label* )
.Screen/x DEI2
.Screen/y DEI2
.Screen/auto DEI
#f2 .Screen/auto DEO
;blank-icn .Screen/addr DEO2
;draw-chr/color LDA .Screen/sprite DEO
.Screen/auto DEO
.Screen/y DEO2
( mod )
STH2k #0078 ADD2 .Screen/x DEO2
LDA2k get-modkey-str draw-str-right POP2
STH2r .Screen/x DEO2
#0004 ADD2
!draw-str
@get-modkey-str ( mod key -- str* )
;&buf #0008 mclr
( mod )
SWP STH
#0800
&loop
STHkr OVR SFT #01 AND #00 EQU ?&no-button
#00 OVR ;&buttons ADD2 LDA ;&buf sput
&no-button
INC GTHk ?&loop
POP2
( mix )
DUP #00 NEQ STHr #00 NEQ #0101 NEQ2 ?&no-mod
LIT "+ ;&buf sput
&no-mod
( key )
DUP #08 NEQ ?&no-bsp ;&bsp !&cat &no-bsp
DUP #09 NEQ ?&no-tab ;&tab !&cat &no-tab
DUP #0d NEQ ?&no-ent ;&ent !&cat &no-ent
DUP #20 NEQ ?&no-spc ;&spc !&cat &no-spc
DUP #1b NEQ ?&no-esc ;&esc !&cat &no-esc
DUP #7f NEQ ?&no-del ;&del !&cat &no-del
DUP ;&buf sput
&end
POP
;&buf
JMP2r
&buf $8
&buttons "ABsSUDLR $1
&cat ;&buf scat ,&end JMP
&bsp "bsp $1 &tab "tab $1 &ent "ent $1 &spc "spc $1 &esc "esc $1 &del "del $1
@update-cursor ( color addr* -- )
#00 .Screen/auto DEO
#40 draw-cursor
.Mouse/x DEI2 DUP2 .cursor/x STZ2 .Screen/x DEO2
.Mouse/y DEI2 DUP2 .cursor/y STZ2 .Screen/y DEO2
.Screen/addr DEO2
.Screen/sprite DEO
JMP2r
@draw-cursor ( color -- )
.cursor/x LDZ2 .Screen/x DEO2
.cursor/y LDZ2 .Screen/y DEO2
.Screen/sprite DEO
JMP2r
(
@|about )
@about
&on-mouse ( -> )
.Mouse/state DEI ?&on-control
BRK
&on-control ( -> )
,&hide JSR
BRK
&toggle ( -- )
[ LIT &active 00 ] ?&hide
#01 ,&active STR
draw-about
;&on-mouse .Mouse/vector DEO2
;&on-control .Controller/vector DEO2
JMP2r
&hide ( -- )
#00 ,&active STR
clear-about
!untrap
@draw-about ( -- )
( frame )
.Screen/width DEI2 #01 SFT2 #0070 SUB2 STH2k .Screen/x DEO2
.Screen/height DEI2 #01 SFT2 #0010 SUB2 STH2k .Screen/y DEO2
#1c06 ;frame1-chr draw-frame
( fill )
STH2r .Screen/y DEO2
STH2r .Screen/x DEO2
#1c #0351 ;fill-icn draw-fill-fast
.Screen/x DEI2k #00e0 SUB2 ROT DEO2
( icon )
.Screen/x DEI2k #0008 ADD2 ROT DEO2
.Screen/y DEI2k #000c ADD2 ROT DEO2
#03 #8526 ;appicon draw-fill-fast
.Screen/x DEI2k #0020 ADD2 ROT DEO2
.Screen/y DEI2k #001c SUB2 ROT DEO2
#0a ;draw-chr/color STA
;meta/body ( .. )
@draw-txt ( txt* -- )
#01 .Screen/auto DEO
.Screen/x DEI2 ,&anchor STR2
&w
LDAk #20 LTH ?&no-char
LDAk draw-chr
&no-char
LDAk #0a NEQ ?&no-lb
[ LIT2 &anchor $2 ] .Screen/x DEO2
draw-lb
&no-lb
INC2 LDAk ?&w
POP2
JMP2r
@draw-lb ( -- )
.Screen/y DEI2k #0008 ADD2 ROT DEO2
JMP2r
@clear-about ( -- )
.Screen/width DEI2 #01 SFT2 #0088 SUB2 .Screen/x DEO2
.Screen/height DEI2 #01 SFT2 #0028 SUB2 .Screen/y DEO2
#22 #0091 draw-fill-fast/blank
redraw-all
!draw-menu
(
@|theme )
@load-theme ( -- )
;&path .File/name DEO2
#0002 .File/length DEO2
;&r .File/read DEO2
;&g .File/read DEO2
;&b .File/read DEO2
.File/success DEI2 ORA #01 [ JCN JMP2r ]
LIT2 &r $2 .System/r DEO2
LIT2 &g $2 .System/g DEO2
LIT2 &b $2 .System/b DEO2
JMP2r
&path ".theme $1
( stdlib )
@scap ( str* -- end* ) LDAk #00 NEQ JMP JMP2r &w INC2 LDAk ?&w JMP2r
@spop ( str* -- ) LDAk ,&n JCN POP2 JMP2r &n ,scap JSR #0001 SUB2 #00 ROT ROT STA JMP2r
@sput ( chr str* -- ) ,scap JSR INC2k #00 ROT ROT STA STA JMP2r
@slen ( str* -- len* ) DUP2 ,scap JSR SWP2 SUB2 JMP2r
@scat ( src* dst* -- ) ,scap JSR
@scpy ( src* dst* -- ) STH2 &w LDAk STH2kr STA INC2r INC2 LDAk ,&w JCN POP2 #00 STH2r STA JMP2r
@mclr ( src* len* -- ) OVR2 ADD2 SWP2 &l STH2k #00 STH2r STA INC2 GTH2k ,&l JCN POP2 POP2 JMP2r
@phex ( short* -- )
SWP phex/b
&b ( byte -- ) DUP #04 SFT phex/b
&c ( char -- ) #0f AND DUP #09 GTH #27 MUL ADD #30 ADD #18 DEO
JMP2r
@exit ( -- )
#010f DEO
JMP2r
( assets )
@hand-icn [
2020 20b8 7c7c 3838 ]
@blank-icn [
0000 0000 0000 0000 ]
~src/assets.tal