750 lines
18 KiB
Tal
750 lines
18 KiB
Tal
( A port of the macintosh classic notepad )
|
|
|
|
|00 @System &vector $2 &expansion $2 &wst $1 &rst $1 &metadata $2 &r $2 &g $2 &b $2 &debug $1 &state $1
|
|
|10 @Console &vector $2 &read $1 &pad $4 &type $1 &write $1 &error $1
|
|
|20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1
|
|
|80 @Controller &vector $2 &button $1 &key $1
|
|
|90 @Mouse &vector $2 &x $1 &lx $1 &y $1 &ly $1 &state $1 &chord $1
|
|
|a0 @File &vector $2 &success $1 &success-lb $1 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2
|
|
|
|
|000
|
|
|
|
@page $1
|
|
@collapsed $1
|
|
@selection &a $2 &b $2 &length $2 &sketch $1
|
|
|
|
|100
|
|
|
|
@on-reset ( -> )
|
|
( | meta )
|
|
;meta #06 DEO2
|
|
( | theme )
|
|
#f00f .System/r DEO2
|
|
#f00f .System/g DEO2
|
|
#f00f .System/b DEO2
|
|
#00e0 .Screen/width DEO2
|
|
#00f8 .Screen/height DEO2
|
|
<load-theme>
|
|
( | unlock )
|
|
;on-console .Console/vector DEO2
|
|
;on-mouse-body .Mouse/vector DEO2
|
|
;on-frame .Screen/vector DEO2
|
|
;on-control .Controller/vector DEO2
|
|
( | let's go! )
|
|
file-init <draw-header>
|
|
#00 change-page BRK
|
|
|
|
@meta 00
|
|
( name ) "Note 20 "Pad 0a
|
|
( details ) "Original 20 "by 20 "Donn 20 "Denman 0a
|
|
( author ) "By 20 "Devine 20 "Lu 20 "Linvega 0a
|
|
( date ) "21 20 "Jul 20 "2024 $1
|
|
( fields ) 01
|
|
( > icon ) 83 =appicon
|
|
|
|
(
|
|
@|vectors )
|
|
|
|
@on-console ( -> )
|
|
.Console/read DEI insert BRK
|
|
|
|
@on-control ( -> )
|
|
.Controller/key DEI .Controller/button DEI
|
|
( | shortcuts )
|
|
DUP2 [ LIT2 "a 01 ] NEQ2 ?{ POP2 <select-all>
|
|
BRK }
|
|
DUP2 [ LIT2 "x 01 ] NEQ2 ?{ POP2 edit-cut BRK }
|
|
DUP2 [ LIT2 "c 01 ] NEQ2 ?{ POP2 edit-copy BRK }
|
|
DUP2 [ LIT2 "v 01 ] NEQ2 ?{ POP2 edit-paste BRK }
|
|
DUP2 [ LIT2 "p 01 ] NEQ2 ?{ POP2 edit-print BRK }
|
|
( | mask shift key )
|
|
#fb AND
|
|
( | arrows )
|
|
DUP #10 NEQ ?{
|
|
get-to #0001 SUB2 find-line-start <select-variable> }
|
|
DUP #20 NEQ ?{ get-to INC2 find-line-end <select-variable> }
|
|
DUP #40 NEQ ?{ <select-left> }
|
|
DUP #80 NEQ ?{ <select-right> }
|
|
DUP #42 NEQ ?{
|
|
.selection/b LDZ2 #0001 SUB2 find-word-start <select-variable> }
|
|
DUP #82 NEQ ?{
|
|
.selection/b LDZ2 INC2 find-word-end <select-variable> }
|
|
( | pagination )
|
|
DUP #21 NEQ OVR #81 NEQ AND ?{ next-page }
|
|
DUP #11 NEQ OVR #41 NEQ AND ?{ prev-page }
|
|
POP
|
|
( | key )
|
|
DUP #1b NEQ ?{ toggle-sketch POP BRK }
|
|
DUP #08 NEQ ?{
|
|
.selection/sketch LDZ ?{ erase POP BRK }
|
|
erase-sketch POP BRK }
|
|
DUP #7f NEQ ?{
|
|
.selection/sketch LDZ ?{ delete POP BRK }
|
|
erase-sketch POP BRK }
|
|
DUP #09 LTH ?{ DUP insert }
|
|
POP BRK
|
|
|
|
@on-mouse-head ( -> )
|
|
[ LIT2 00 -Mouse/state ] DEI NEQ #41 ADD ;mouse-icn <update-cursor>
|
|
<trap-mouse>
|
|
.Mouse/y DEI2 #0010 LTH2 ?{ BRK }
|
|
( | collapse on mouse2 )
|
|
.Mouse/state DEI #02 LTH ?{
|
|
#00f8 #0011 .collapsed LDZ ?{ SWP2 }
|
|
POP2 .Screen/height DEO2
|
|
[ LIT2 00 -collapsed ] LDZ EQU .collapsed STZ
|
|
<draw-header>
|
|
<redraw>
|
|
[ LIT2 00 -Mouse/state ] DEO
|
|
BRK }
|
|
[ LIT &last $1 ] .Mouse/state DEI DUP ,&last STR
|
|
EQU ?&unchanged
|
|
<draw-header>
|
|
( release on close button ) .Mouse/state DEI ?&unchanged
|
|
.Mouse/x DEI2 #0008 SUB2 #000a GTH2 ?&unchanged
|
|
( exit ) #800f DEO &unchanged BRK
|
|
|
|
@on-mouse-body ( -> )
|
|
<trap-mouse>
|
|
.selection/sketch LDZ ?on-mouse-sketch
|
|
[ LIT2 00 -Mouse/state ] DEI NEQ #41 ADD ;caret-icn <update-cursor>
|
|
[ LIT &last $1 ] .Mouse/state DEI DUP #02 LTH ?{
|
|
get-position <select-word>
|
|
[ LIT2 00 -Mouse/state ] DEO }
|
|
DUP2 #0001 NEQ2 ?{ get-position <select-variable> }
|
|
DUP2 #0101 NEQ2 ?{ get-position <select-to> }
|
|
,&last STR
|
|
POP BRK
|
|
|
|
@on-mouse-sketch ( -> )
|
|
[ LIT2 00 -Mouse/state ] DEI STHk NEQ #41 ADD ;eraser-icn ;pen-icn STHr #01 GTH ?{ SWP2 }
|
|
POP2 <update-cursor>
|
|
( | 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 ]
|
|
( to ) .Mouse/x DEI2 DUP2 ,&x1 STR2
|
|
.Mouse/y DEI2 #0012 SUB2 DUP2 ,&y1 STR2
|
|
( paint ) #01 <paint-line>
|
|
<draw-sketch> }
|
|
DUP #02 NEQ ?{
|
|
( | release/drag mouse2 )
|
|
.Mouse/x DEI2 .Mouse/y DEI2 #0012 SUB2 <eraser>
|
|
<redraw> }
|
|
POP2 BRK
|
|
|
|
@on-mouse-foot ( -> )
|
|
[ LIT2 00 -Mouse/state ] DEI NEQ #41 ADD ;mouse-icn <update-cursor>
|
|
<trap-mouse>
|
|
( | continue )
|
|
[ LIT2 00 -Mouse/state ] DEI NEQ .Mouse/x DEI2 #0018 LTH2 AND ?&down
|
|
BRK
|
|
|
|
&down ( -> )
|
|
[ LIT2 00 -Mouse/state ] DEO
|
|
.Mouse/y DEI2 #00da SUB2 NIP [ LIT2 18 -Mouse/lx ] DEI SUB ADD #18 LTH ?&go-next
|
|
prev-page BRK
|
|
&go-next next-page BRK
|
|
|
|
@on-frame ( -> )
|
|
[ LIT2 &last $1 &f $1 ] INCk ,&f STR
|
|
#05 SFT DUP ,&last STR
|
|
EQU ?{ <draw-note> }
|
|
BRK
|
|
|
|
(
|
|
@|editor )
|
|
|
|
@insert ( char -- )
|
|
DUP #7f LTH ?{ POP JMP2r }
|
|
#00 ;on-frame/f STA
|
|
get-from scap/ get-page #1000 ADD2 LTH2 ?{ POP JMP2r }
|
|
( | convert linebreaks )
|
|
DUP #0d EQU #03 MUL SUB .selection/length LDZ2 #0000 EQU2 ?{ erase-selection }
|
|
get-from STH2k #0001 SUB2 get-eof #0001 <msfr>
|
|
STH2kr STA
|
|
STH2r INC2 <select-from> !file-save
|
|
|
|
@erase ( -- )
|
|
#00 ;on-frame/f STA
|
|
.selection/length LDZ2 #0000 EQU2 ?{ erase-selection !<select-reset> }
|
|
get-from get-page NEQ2 [ JMP JMP2r ] get-from #0001 SUB2 DUP2 cut-char <select-from> !file-save
|
|
|
|
@erase-selection ( -- )
|
|
get-from get-eof .selection/length LDZ2 <msfl> !file-save
|
|
|
|
@delete ( -- )
|
|
#00 ;on-frame/f STA
|
|
.selection/length LDZ2 ORA ?{
|
|
get-from INC2k get-eof NEQ2 ?{ POP2 JMP2r }
|
|
cut-char <redraw> !file-save }
|
|
erase-selection !<select-reset>
|
|
|
|
@get-eof ( -- addr* )
|
|
get-page !scap/
|
|
|
|
@cut-char ( addr* -- )
|
|
get-eof #0001 !<msfl>
|
|
|
|
(
|
|
@|sketch )
|
|
|
|
@toggle-sketch ( -- )
|
|
.selection/sketch LDZk #01 EOR SWP STZ
|
|
#41 ;pen-icn ;caret-icn .selection/sketch LDZ ?{ SWP2 }
|
|
POP2 !<update-cursor>
|
|
|
|
@erase-sketch ( -- )
|
|
;&mcpy .System/expansion DEO2 !<redraw>
|
|
|
|
&mcpy [ 00 1500 0000 =sketch 00 ]
|
|
|
|
@get-row ( x* y* -- row* )
|
|
STH2k #03 SFT2 SWP2 #03 SFT2 SWP2 #001c MUL2 ADD2 #30 SFT2 STH2r #0007 AND2 ADD2 ;sketch ADD2 JMP2r
|
|
|
|
@<set-pixel> ( x* y* color -- )
|
|
?<add-pixel>
|
|
( >> )
|
|
|
|
@<remove-pixel> ( x* y* -- )
|
|
( keep x* ) OVR2 NIP #07 AND STH
|
|
( get byte ) get-row LDAk
|
|
( mask ) #0107 STHr SUB #40 SFT SFT #ff EOR AND
|
|
( save ) ROT ROT STA
|
|
JMP2r
|
|
|
|
@<add-pixel> ( x* y* -- )
|
|
( keep x* ) OVR2 NIP #07 AND STH
|
|
( get byte ) get-row LDAk
|
|
( mask ) #0107 STHr SUB #40 SFT SFT ORA
|
|
( save ) ROT ROT STA
|
|
JMP2r
|
|
|
|
@<eraser> ( x* y* -- )
|
|
,&y STR2
|
|
,&x STR2
|
|
#000a #0000
|
|
&>v ( -- )
|
|
STH2k #0006 #0000
|
|
&>h ( -- )
|
|
( x ) DUP2 [ LIT2 &x $2 ] ADD2
|
|
( y ) STH2kr [ LIT2 &y $2 ] ADD2 <remove-pixel>
|
|
INC2 GTH2k ?&>h
|
|
POP2 POP2 POP2r INC2 GTH2k ?&>v
|
|
POP2 POP2 JMP2r
|
|
|
|
@<paint-line> ( x1* y1* x2* y2* color -- )
|
|
,&color STR
|
|
,&y2 STR2
|
|
,&x2 STR2
|
|
STH2
|
|
STH2
|
|
( | x )
|
|
[ LIT2 ADD2r SUB2r ] ,&x2 LDR2 STH2kr SUB2k abs2 ,&dx STR2
|
|
SWP2 lts2 [ JMP SWP POP ] ,&sx STR
|
|
SWP2r
|
|
( | y )
|
|
[ LIT2 ADD2r SUB2r ] ,&y2 LDR2 STH2kr SUB2k abs2 #0000 SWP2 SUB2 ,&dy STR2
|
|
SWP2 lts2 [ JMP SWP POP ] ,&sy STR
|
|
,&dx LDR2 ,&dy LDR2 ADD2
|
|
&>while ( -- )
|
|
( draw ) OVR2r STH2r STH2kr [ LIT &color $1 ] <set-pixel>
|
|
( y ) STH2kr [ LIT2 &y2 $2 ] NEQ2 ?{
|
|
( x ) OVR2r STH2r [ LIT2 &x2 $2 ] EQU2 ?&end }
|
|
( e -> e2 ) DUP2k ADD2 DUP2
|
|
( y ) [ LIT2 &dy $2 ] lts2 ?{
|
|
( e+dy ) SWP2 ,&dy LDR2 ADD2 SWP2
|
|
( x1+sx ) SWP2r [ LIT2r 0001 ] [ &sx $1 ] SWP2r }
|
|
( x ) [ LIT2 &dx $2 ] gts2 ?{
|
|
( e+dx ) ,&dx LDR2 ADD2
|
|
( y1+sy ) [ LIT2r 0001 ] [ &sy $1 ] }
|
|
!&>while
|
|
&end POP2 POP2r POP2r JMP2r
|
|
|
|
@snap ( x1* x2* -- x* )
|
|
SUB2k abs2 #0008 LTH2 ?{ NIP2 JMP2r }
|
|
POP2 JMP2r
|
|
|
|
(
|
|
@|selection )
|
|
|
|
@<select-variable> ( addr* -- )
|
|
[ LIT2 04 -Controller/button ] DEI AND ?<select-to>
|
|
!<select-from>
|
|
|
|
@<select-reset> ( -- )
|
|
get-from
|
|
( >> )
|
|
|
|
@<select-from> ( addr* -- )
|
|
clamp-selection DUP2 .selection/a STZ2
|
|
.selection/b STZ2 !select
|
|
|
|
@<select-to> ( addr* -- )
|
|
clamp-selection DUP2 .selection/b LDZ2 NEQ2 ?{ POP2 JMP2r }
|
|
.selection/b STZ2 !select
|
|
|
|
@<select-word> ( addr* -- )
|
|
DUP2
|
|
&>back ( -- )
|
|
#0001 SUB2 LDAk #20 GTH ?&>back
|
|
INC2 SWP2
|
|
&>next ( -- )
|
|
INC2 LDAk #20 GTH ?&>next
|
|
OVR2 OVR2 is-selection ?{
|
|
.selection/b STZ2
|
|
.selection/a STZ2 !select }
|
|
POP2
|
|
( >> )
|
|
|
|
@<select-line> ( addr* -- )
|
|
DUP2 find-line-start .selection/a STZ2
|
|
find-line-end .selection/b STZ2 !select
|
|
|
|
@<select-all> ( -- )
|
|
get-page DUP2 .selection/a STZ2
|
|
scap/ #0001 SUB2 .selection/b STZ2
|
|
( >> )
|
|
|
|
@select ( -- )
|
|
get-to get-from SUB2 .selection/length STZ2
|
|
#00 ;on-frame/f STA !<redraw>
|
|
|
|
@<select-left> ( -- )
|
|
.selection/length LDZ2 #0000 EQU2 [ LIT2 04 -Controller/button ] DEI AND #00 NEQ ORA ?{ get-from !<select-from> }
|
|
.selection/b LDZ2 #0001 SUB2 !<select-variable>
|
|
|
|
@<select-right> ( -- )
|
|
.selection/length LDZ2 #0000 EQU2 [ LIT2 04 -Controller/button ] DEI AND #00 NEQ ORA ?{ get-to !<select-from> }
|
|
.selection/b LDZ2 INC2 !<select-variable>
|
|
|
|
@get-from ( -- addr* )
|
|
.selection/b LDZ2 .selection/a LDZ2 LTH2k [ JMP SWP2 POP2 ] JMP2r
|
|
|
|
@get-to ( -- addr* )
|
|
.selection/a LDZ2 .selection/b LDZ2 GTH2k [ JMP SWP2 POP2 ] JMP2r
|
|
|
|
@clamp-selection ( addr* -- addr* )
|
|
( min ) get-page GTH2k [ JMP SWP2 POP2 ]
|
|
( max ) get-eof #0001 SUB2 LTH2k [ JMP SWP2 POP2 ] JMP2r
|
|
|
|
@is-selected ( addr* -- addr* f )
|
|
DUP2 get-from LTH2 ?&false
|
|
DUP2 get-to #0001 SUB2 GTH2 ?&false
|
|
#01 JMP2r
|
|
&false #00 JMP2r
|
|
|
|
@is-selection ( a* b* -- f )
|
|
.selection/b LDZ2 EQU2 STH
|
|
.selection/a LDZ2 EQU2 STHr AND JMP2r
|
|
|
|
(
|
|
@|file )
|
|
|
|
@file-init ( -- )
|
|
;notepad-path file-size #0000 EQU2 ?file-new
|
|
( | load file )
|
|
;notepad-path .File/name DEO2
|
|
#9500 .File/length DEO2
|
|
;mem .File/read DEO2
|
|
JMP2r
|
|
|
|
@file-new ( -- )
|
|
( copy placeholder ) ;&mcpy .System/expansion DEO2
|
|
#0801
|
|
&>l ( -- )
|
|
#00 OVR #c0 SFT2 ;mem ADD2 STH2
|
|
#20 STH2r STA
|
|
INC GTHk ?&>l
|
|
POP2 JMP2r
|
|
|
|
&mcpy [ 01 0100 0000 =placeholder 0000 =mem ]
|
|
|
|
@file-save ( -- )
|
|
;notepad-path .File/name DEO2
|
|
#9500 .File/length DEO2
|
|
;mem .File/write DEO2
|
|
JMP2r
|
|
|
|
@file-size ( path* -- size* )
|
|
.File/name DEO2
|
|
#0001 .File/length DEO2
|
|
[ LIT2r 0000 ]
|
|
&>s ( -- )
|
|
;&b .File/read DEO2
|
|
[ LIT2 00 -File/success-lb ] DEI EQU ?&eof
|
|
INC2r !&>s
|
|
&eof STH2r JMP2r
|
|
&b $1
|
|
|
|
@file-inject ( name* -- )
|
|
DUP2 file-size ORAk ?{ POP2 POP2 JMP2r }
|
|
STH2
|
|
.File/name DEO2
|
|
DUP2r [ LITr -File/length ] DEO2r
|
|
( | erase when selection length )
|
|
.selection/length LDZ2 #0000 EQU2 ?{
|
|
get-from get-eof .selection/length LDZ2 <msfl> }
|
|
( push right ) get-from #0001 SUB2 get-eof STH2kr <msfr>
|
|
get-from .File/read DEO2
|
|
get-from STH2r ADD2 !<select-from>
|
|
|
|
@edit-cut ( -- )
|
|
.selection/length LDZ2 #0001 GTH2 [ JMP JMP2r ] edit-copy erase-selection <select-reset> !file-save
|
|
|
|
@edit-copy ( -- )
|
|
.selection/length LDZ2 #0001 GTH2 [ JMP JMP2r ] ;snarf-path .File/name DEO2
|
|
.selection/length LDZ2 .File/length DEO2
|
|
get-from .File/write DEO2
|
|
JMP2r
|
|
|
|
@edit-paste ( -- )
|
|
;snarf-path file-inject !file-save
|
|
|
|
@edit-print ( -- )
|
|
get-to get-from
|
|
&>l ( -- )
|
|
LDAk .Console/write DEO
|
|
INC2 GTH2k ?&>l
|
|
POP2 POP2 [ LIT2 0a -Console/write ] DEO
|
|
JMP2r
|
|
|
|
(
|
|
@|core )
|
|
|
|
@<trap-mouse> ( -- )
|
|
#00 <update-corner>
|
|
.Mouse/y DEI2 DUP2 #0018 GTH2 ?{
|
|
POP2 ;on-mouse-head .Mouse/vector DEO2
|
|
JMP2r }
|
|
DUP2 #00d6 LTH2 ?{
|
|
POP2 ;on-mouse-foot .Mouse/vector DEO2
|
|
JMP2r }
|
|
POP2 ;on-mouse-body .Mouse/vector DEO2
|
|
JMP2r
|
|
|
|
@change-page ( id -- )
|
|
.page STZ
|
|
get-page scap/ #0001 SUB2 !<select-from>
|
|
|
|
@prev-page ( -- )
|
|
.page LDZ #01 SUB #07 AND !change-page
|
|
|
|
@next-page ( -- )
|
|
.page LDZ INC #07 AND !change-page
|
|
|
|
@pos-to-line ( y* -- line )
|
|
#0012 SUB2 #04 SFT2 NIP JMP2r
|
|
|
|
@get-position ( -- addr* )
|
|
#0008 .Screen/x DEO2
|
|
#0018 .Screen/y DEO2
|
|
( | walk to line )
|
|
.Mouse/y DEI2 pos-to-line ,&line STR
|
|
get-page
|
|
&>walk-line ( -- )
|
|
.Screen/y DEI2 pos-to-line [ LIT &line $1 ] EQU ?&end-line
|
|
walk-char POP INC2 LDAk ?&>walk-line
|
|
&end-line ( walk to char )
|
|
.Mouse/x DEI2 #0001 SUB2 ,&x STR2
|
|
&>walk-char ( -- )
|
|
.Screen/x DEI2 [ LIT2 &x $2 ] GTH2 ?&end-char
|
|
walk-char ?&end-char
|
|
INC2 LDAk ?&>walk-char &end-char JMP2r
|
|
|
|
@walk-char ( addr* -- addr* lb )
|
|
( | wrap )
|
|
LDAk #20 GTH ?&no-wrap
|
|
DUP2 word-width .Screen/x DEI2 ADD2 #00d0 LTH2 ?&no-wrap
|
|
( | tabbed )
|
|
DUP2 find-line-start
|
|
( tab line ) LDA2k #093e NEQ2 ?{ POP2 #01 #0021 !<draw-linebreak> }
|
|
( tab caret ) LDA2k #092d NEQ2 ?{ POP2 #01 #0022 !<draw-linebreak> }
|
|
#0001 SUB2 LDA2 SWP #20 LTH SWP
|
|
( lb line ) DUP2 #013e NEQ2 ?{ POP2 #01 #0011 !<draw-linebreak> }
|
|
( lb caret ) DUP2 #012d NEQ2 ?{ POP2 #01 #0012 !<draw-linebreak> }
|
|
POP2 #01 #0008 !<draw-linebreak>
|
|
|
|
&no-wrap ( char )
|
|
LDAk char-width .Screen/x DEI2 ADD2 .Screen/x DEO2
|
|
( | tab )
|
|
LDAk #09 NEQ ?{ #00 !<draw-tab> }
|
|
( | linebreak )
|
|
LDAk #0a NEQ ?{ #01 #0008 !<draw-linebreak> }
|
|
#00 JMP2r
|
|
|
|
@get-page ( -- addr* )
|
|
;mem [ LIT2 00 -page ] LDZ #c0 SFT2 ADD2 JMP2r
|
|
|
|
@char-addr ( prev char -- addr* )
|
|
DUP #7e GTH ?&missing
|
|
DUP #20 LTH ?&blank
|
|
SWP #20 LTH
|
|
( - ) DUP2 #3e01 EQU2 ?&marker
|
|
( > ) DUP2 #2d01 EQU2 ?&bullet
|
|
POP #20 SUB #00 SWP #50 SFT2 ;font/glyphs ADD2 JMP2r
|
|
&blank POP2 ;font/glyphs JMP2r
|
|
&missing POP2 ;error-icn JMP2r
|
|
&marker POP2 ;marker-icn JMP2r
|
|
&bullet POP2 ;bullet-icn JMP2r
|
|
|
|
@char-width ( char -- width* )
|
|
DUP #7e GTH ?{
|
|
#20 SUB #00 SWP ;font ADD2 LDA #00 SWP JMP2r }
|
|
POP #0008 JMP2r
|
|
|
|
@word-width ( str* -- length* )
|
|
[ LIT2r 0000 ]
|
|
&>w ( -- )
|
|
LDAk char-width STH2
|
|
ADD2r INC2 LDAk #20 GTH ?&>w
|
|
POP2 STH2r JMP2r
|
|
|
|
@find-line-start ( addr* -- addr* )
|
|
;mem #0001 SUB2 SWP2
|
|
&>l ( -- )
|
|
#0001 SUB2 LDAk DUP #0a EQU SWP #00 EQU ORA ?&end
|
|
LTH2k ?&>l &end NIP2 INC2 JMP2r
|
|
|
|
@find-line-end ( addr* -- addr* )
|
|
get-eof SWP2
|
|
&>l ( -- )
|
|
LDAk #0a EQU ?&end
|
|
LDAk #00 EQU ?&end
|
|
INC2 GTH2k ?&>l &end NIP2 JMP2r
|
|
|
|
@find-word-start ( addr* -- addr* )
|
|
;mem SWP2
|
|
&>l ( -- )
|
|
#0001 SUB2 LDAk #21 LTH ?&end
|
|
LTH2k ?&>l &end NIP2 INC2 JMP2r
|
|
|
|
@find-word-end ( addr* -- addr* )
|
|
get-eof SWP2
|
|
&>l ( -- )
|
|
LDAk #21 LTH ?&end
|
|
INC2 GTH2k ?&>l &end NIP2 JMP2r
|
|
|
|
(
|
|
@|drawing )
|
|
|
|
@<draw-header> ( -- )
|
|
( | a )
|
|
#0000 DUP2 .Screen/x DEO2
|
|
.Screen/y DEO2
|
|
[ LIT2 15 -Screen/auto ] DEO
|
|
;bar-icn/a .Screen/addr DEO2
|
|
[ LIT2 01 -Screen/sprite ] DEO
|
|
( | close )
|
|
;close-icn #00 [ LIT2 00 -Mouse/state ] DEI NEQ .Mouse/x DEI2 #0008 SUB2 #000a LTH2 AND #50 SFT2 ADD2 .Screen/addr DEO2
|
|
[ LIT2 01 -Screen/sprite ] DEOk DEO
|
|
( | lead )
|
|
#e9
|
|
&>l ( -- )
|
|
;bar-icn/b .Screen/addr DEO2
|
|
[ LIT2 01 -Screen/sprite ] DEO
|
|
INC DUP ?&>l
|
|
POP ;bar-icn/b .Screen/addr DEO2
|
|
[ LIT2 01 -Screen/sprite ] DEOk DEO
|
|
( | title )
|
|
#004b .Screen/x DEO2
|
|
[ LIT2 86 -Screen/auto ] DEO
|
|
;title-icn .Screen/addr DEO2
|
|
[ LIT2 01 -Screen/sprite ] DEOk DEO
|
|
( | line )
|
|
[ LIT2 d2 -Screen/auto ] DEO
|
|
#0000 .Screen/x DEO2
|
|
#0010 .Screen/y DEO2
|
|
;line-icn .Screen/addr DEO2
|
|
[ LIT2 01 -Screen/sprite ] DEO
|
|
#0070 .Screen/x DEO2
|
|
#0010 .Screen/y DEO2
|
|
[ LIT2 01 -Screen/sprite ] DEO
|
|
JMP2r
|
|
|
|
@<redraw> ( -- )
|
|
#0000 .Screen/x DEO2
|
|
#0018 .Screen/y DEO2
|
|
[ LIT2 80 -Screen/pixel ] DEO
|
|
<draw-note> !<draw-footer>
|
|
|
|
@<draw-note> ( -- )
|
|
[ LIT2 00 -collapsed ] LDZ EQU ?{ JMP2r }
|
|
[ LIT2 15 -Screen/auto ] DEO
|
|
#0008 .Screen/x DEO2
|
|
#0018 .Screen/y DEO2
|
|
get-page
|
|
&>w ( -- )
|
|
( | page end )
|
|
.Screen/y DEI2 #00c8 NEQ2 ?{
|
|
;etc-icn .Screen/addr DEO2
|
|
[ LIT2 01 -Screen/sprite ] DEO
|
|
POP2 !<draw-sketch> }
|
|
( | draw char )
|
|
DUP2 #0001 SUB2 LDA2 char-addr .Screen/addr DEO2
|
|
is-selected STH
|
|
#0701 STHr [ JMP SWP POP ] .Screen/sprite DEOk DEO
|
|
.Screen/x DEI2k #0010 SUB2 ROT DEO2
|
|
( | draw selector )
|
|
get-from get-to NEQ2 ?&block
|
|
DUP2 get-from NEQ2 ?&block
|
|
;on-frame/last LDA #01 AND ?&block
|
|
;blink-icn .Screen/addr DEO2
|
|
[ LIT2 05 -Screen/sprite ] DEO
|
|
.Screen/x DEI2k #0008 SUB2 ROT DEO2 &block walk-char POP INC2 LDAk ?&>w
|
|
POP2
|
|
( >> )
|
|
|
|
@<draw-sketch> ( -- )
|
|
#0000 .Screen/x DEO2
|
|
#0012 .Screen/y DEO2
|
|
;sketch .Screen/addr DEO2
|
|
[ LIT2 05 -Screen/auto ] DEO
|
|
#1800
|
|
&>h ( -- )
|
|
#1c00
|
|
&>w ( -- )
|
|
[ LIT2 0a -Screen/sprite ] DEO
|
|
INC GTHk ?&>w
|
|
POP2 #0000 .Screen/x DEO2
|
|
.Screen/y DEI2k #0008 ADD2 ROT DEO2
|
|
INC GTHk ?&>h
|
|
POP2 JMP2r
|
|
|
|
@<draw-footer> ( -- )
|
|
[ LIT2 00 -collapsed ] LDZ EQU ?{ JMP2r }
|
|
#01 <update-corner>
|
|
( | across )
|
|
[ LIT2 01 -Screen/auto ] DEO
|
|
#0018 .Screen/x DEO2
|
|
.Screen/height DEI2 DUP2 #0008 SUB2 .Screen/y DEO2
|
|
;bottom-icn .Screen/addr DEO2
|
|
#e7
|
|
&>l ( -- )
|
|
[ LIT2 01 -Screen/sprite ] DEO
|
|
INC DUP ?&>l
|
|
POP
|
|
( | page number )
|
|
[ LIT2 15 -Screen/auto ] DEO
|
|
.Screen/width DEI2 #01 SFT2 #0003 SUB2 .Screen/x DEO2
|
|
#001e SUB2 .Screen/y DEO2
|
|
#0011 .page LDZ ADD #50 SFT2 ;font/glyphs ADD2 .Screen/addr DEO2
|
|
[ LIT2 01 -Screen/sprite ] DEO
|
|
JMP2r
|
|
|
|
@<update-corner> ( force -- )
|
|
( get positions ) .Mouse/lx DEI .Mouse/ly DEI
|
|
( test x ) OVR #18 GTH ?&skip
|
|
( test y ) DUP #db LTH ?&skip
|
|
#da SUB #18 ROT SUB ADD #18 LTH INC SWP !<draw-corner>
|
|
&skip POP2 #00 SWP
|
|
( >> )
|
|
|
|
@<draw-corner> ( state force -- )
|
|
( force ) ?{
|
|
[ LIT &last ff ] NEQk ?{ POP2 JMP2r }
|
|
POP DUP ,&last STR }
|
|
[ LIT2 26 -Screen/auto ] DEO
|
|
#0000 .Screen/x DEO2
|
|
.Screen/height DEI2 #0020 SUB2 .Screen/y DEO2
|
|
#00 SWP #0060 MUL2 ;corner-icn ADD2 .Screen/addr DEO2
|
|
[ LIT2 01 -Screen/sprite ] DEOk DEOk DEOk DEO
|
|
JMP2r
|
|
|
|
@<draw-tab> ( -- )
|
|
.Screen/x DEI2 #0020 ADD2 #55 SFT2 #0008 ADD2 .Screen/x DEO2
|
|
JMP2r
|
|
|
|
@<draw-linebreak> ( x* -- )
|
|
.Screen/x DEO2
|
|
.Screen/y DEI2k #0010 ADD2 ROT DEO2
|
|
JMP2r
|
|
|
|
@<update-cursor> ( color addr* -- )
|
|
[ LIT2 15 -Screen/auto ] DEO
|
|
;fill-icn .Screen/addr DEO2
|
|
#40 <draw-cursor>
|
|
.Mouse/x DEI2 ,<draw-cursor>/x STR2
|
|
.Mouse/y DEI2 ,<draw-cursor>/y STR2
|
|
.Screen/addr DEO2
|
|
( >> )
|
|
|
|
@<draw-cursor> ( color -- )
|
|
[ LIT2 &x $2 ] .Screen/x DEO2
|
|
[ LIT2 &y $2 ] .Screen/y DEO2
|
|
.Screen/sprite DEO
|
|
JMP2r
|
|
|
|
(
|
|
@|stdlib )
|
|
|
|
@scap ( str* -- end* )
|
|
INC2 & LDAk ?scap
|
|
JMP2r
|
|
|
|
@<phex> ( short* -: )
|
|
SWP /b
|
|
&b ( byte -: )
|
|
DUP #04 SFT /c
|
|
&c ( byte -: )
|
|
#0f AND DUP #09 GTH #27 MUL ADD [ LIT "0 ] ADD #18 DEO
|
|
JMP2r
|
|
|
|
@<load-theme> ( -- )
|
|
;theme-path .File/name DEO2
|
|
#0002 .File/length DEO2
|
|
;&r .File/read DEO2
|
|
;&g .File/read DEO2
|
|
;&b .File/read DEO2
|
|
[ LIT2 00 -File/success-lb ] DEI EQU ?{
|
|
[ LIT2 &r $2 ] .System/r DEO2
|
|
[ LIT2 &g $2 ] .System/g DEO2
|
|
[ LIT2 &b $2 ] .System/b DEO2 }
|
|
JMP2r
|
|
|
|
@<msfl> ( b* a* len* -- )
|
|
STH2
|
|
SWP2 EQU2k ?&e
|
|
&>l ( -- )
|
|
DUP2k STH2kr ADD2 LDA ROT ROT STA
|
|
INC2 GTH2k ?&>l
|
|
POP2 POP2 &e POP2r JMP2r
|
|
|
|
@<msfr> ( b* a* len* -- )
|
|
STH2
|
|
EQU2k ?&e
|
|
&>l ( -- )
|
|
DUP2 LDAk ROT ROT STH2kr ADD2 STA
|
|
#0001 SUB2 LTH2k ?&>l
|
|
POP2 POP2 &e POP2r JMP2r
|
|
|
|
@abs2 ( a* -- f )
|
|
DUP2 #0f SFT2 EQU ?{ #0000 SWP2 SUB2 }
|
|
JMP2r
|
|
|
|
@lts2 ( a* b* -- f )
|
|
SUB2 POP #07 SFT JMP2r
|
|
|
|
@gts2 ( a* b* -- f )
|
|
SWP2 SUB2 POP #07 SFT JMP2r
|
|
|
|
(
|
|
@|strings )
|
|
|
|
@snarf-path ".snarf $1
|
|
|
|
@theme-path ".theme $1
|
|
|
|
@notepad-path ".notepad $1
|
|
|
|
~src/assets.tal
|
|
|