Compare commits

...

12 Commits

15 changed files with 1305 additions and 1 deletions

4
.gitignore vendored
View File

@ -1 +1,3 @@
*.rom
*.rom
/untracked/

156
_common_macros.tal Normal file
View File

@ -0,0 +1,156 @@
( ---------------------------------------------------------------------------- )
( M A C R O T O O L B O X )
%GTH0 { }
%GTH0* { ORA }
%ADD2* { INC* INC* }
%CALL { JSR* }
%GOTO { JMP* }
%RETURN { JMPr* }
%CALLRETURN { JMP* }
%NORETURN { POPr* }
%NOP { POPk }
%DOUBLE { DUP ADD } %DOUBLE* { DUP* ADD* }
%DOUBLEkr { DUPkr ADDr } %DOUBLEkr* { DUPkr* ADDr* }
%SHL1 { #10 SFT } %SHL1* { #10 SFT* }
%SHL2 { #20 SFT } %SHL2* { #20 SFT* }
%SHL3 { #30 SFT } %SHL3* { #30 SFT* }
%SHL4 { #40 SFT } %SHL4* { #40 SFT* }
%SHL5 { #50 SFT } %SHL5* { #50 SFT* }
%SHL6 { #60 SFT } %SHL6* { #60 SFT* }
%SHL7 { #70 SFT } %SHL7* { #70 SFT* }
%SHL8 { #80 SFT } %SHL8* { #80 SFT* }
%SHR1 { #01 SFT } %SHR1* { #01 SFT* }
%SHR2 { #02 SFT } %SHR2* { #02 SFT* }
%SHR3 { #03 SFT } %SHR3* { #03 SFT* }
%SHR4 { #04 SFT } %SHR4* { #04 SFT* }
%SHR5 { #05 SFT } %SHR5* { #05 SFT* }
%SHR6 { #06 SFT } %SHR6* { #06 SFT* }
%SHR7 { #07 SFT } %SHR7* { #07 SFT* }
%SHR8 { #08 SFT } %SHR8* { #08 SFT* }
%MUL4 { SHL2 } %MUL4* { SHL2* }
%MUL8 { SHL3 } %MUL8* { SHL3* }
%MUL16 { SHL4 } %MUL16* { SHL4* }
%MUL32 { SHL5 } %MUL32* { SHL5* }
%MUL64 { SHL6 } %MUL64* { SHL6* }
%MUL128 { SHL7 } %MUL128* { SHL7* }
%MUL256 { SHL8 } %MUL256* { SHL8* }
%HALVE { SHR1 } %HALVE* { SHR1* }
%DIV4 { SHR2 } %DIV4* { SHR2* }
%DIV8 { SHR3 } %DIV8* { SHR3* }
%DIV16 { SHR4 } %DIV16* { SHR4* }
%DIV32 { SHR5 } %DIV32* { SHR5* }
%DIV64 { SHR6 } %DIV64* { SHR6* }
%DIV128 { SHR7 } %DIV128* { SHR7* }
%DIV256 { SHR8 } %DIV256* { SHR8* }
%FLOOR8 { #07 EOR } %FLOOR8* { #0007 EOR* }
%CEIL8 { #07 ADD FLOOR8 } %CEIL8* { #0007 ADD* FLOOR8* }
%CEIL8DIV8 { #07 ADD DIV8 } %CEIL8DIV8* { #0007 ADD* DIV8* }
%MOD { DIVk MUL SUB } ( val mod -- remainder )
%MODr { DIVkr MULr SUBr } ( val mod -- remainder )
%MOD* { DIVk* MUL* SUB* } ( val* mod* -- remainder* )
%MODr* { DIVkr* MULr* SUBr* } ( val* mod* -- remainder* )
%MOD2 { #01 AND } %MOD2* { #0001 AND* }
%MOD4 { #03 AND } %MOD4* { #0003 AND* }
%MOD8 { #07 AND } %MOD8* { #0007 AND* }
%MOD16 { #0f AND } %MOD16* { #000f AND* }
%DIVMOD { DIVk MULk STH ROT STHr SUB ROT POP } ( val mod -- quotient remainder )
%DIVMOD* { DIVk* MULk* STH* ROT* STHr* SUB* ROT* POP* } ( val* mod* -- quotient* remainder* )
%DEC { #01 SUB } %DEC* { #0001 SUB* }
%DECr { LITr 01 SUBr } %DECr* { LITr* 0001 SUBr* }
%DECk { DUP #01 SUB } %DECk* { DUP* #0001 SUB* }
%DECkr { DUPr LITr 01 SUBr } %DECkr* { DUPr* LITr* 0001 SUBr* }
%MOVE_LEFT { /SCREEN.X? SWP* SUB* /SCREEN.X! }
%MOVE_RIGHT { /SCREEN.X? ADD* /SCREEN.X! }
%MOVE_UP { /SCREEN.Y? SWP* SUB* /SCREEN.Y! }
%MOVE_DOWN { /SCREEN.Y? ADD* /SCREEN.Y! }
%MOVE_LEFT_1 { /SCREEN.X? DEC* /SCREEN.X! }
%MOVE_RIGHT_1 { /SCREEN.X? INC* /SCREEN.X! }
%MOVE_UP_1 { /SCREEN.Y? DEC* /SCREEN.Y! }
%MOVE_DOWN_1 { /SCREEN.Y? INC* /SCREEN.Y! }
%BREAKPOINT { #0101 /SYSTEM.DEBUG DEO* BRK }
%DEBUG { #01 /SYSTEM.DEBUG! }
%HALT { #01 /SYSTEM.HALT! BRK }
%PANIC { BREAKPOINT }
%TO_SHORT { #00 SWP }
%DIGIT_TO_ASCII { #30 ADD }
%INDEX_TO_ASCII { #20 ADD }
%ASCII_TO_INDEX { #20 SUB }
%AND_FLIPX { #10 ORA }
%AND_FLIPY { #20 ORA }
%AND_FG { #40 ORA }
%AND_2BIT { #80 ORA }
%IF_FALSE { JMP } ( value -- )
%IF_FALSE* { NIP JMP } ( value* -- )
%IF_FALSEY { #01 JCN } ( value -- )
%IF_FALSEY* { ORA #01 JCN } ( value* -- )
%IF_TRUE { IF_TRUTHY }
%IF_TRUE* { IF_TRUTHY* }
%IF_TRUTHY { NOT JMP } ( value -- )
%IF_TRUTHY* { NOT* JMP } ( value -- )
%IF_EQUAL { NEQ JMP } ( value1 value2 -- )
%IF_EQUAL* { NEQ* JMP } ( value1* value2* -- )
%IF_NOT_EQUAL { EQU JMP } ( value1 value2 -- )
%IF_NOT_EQUAL* { EQU* JMP } ( value1* value2* -- )
%IF_MASK { AND IF_TRUTHY } ( value1 value2 -- )
%IF_MASK* { AND* IF_TRUTHY* } ( value1 value2 -- )
%IF_NOT_MASK { AND IF_FALSEY } ( value1 value2 -- )
%IF_NOT_MASK* { AND* IF_FALSEY* } ( value1 value2 -- )
%TO_BOOL { #00 GTH }
%TO_BOOL* { ORA TO_BOOL }
%NOT { #00 EQU }
%NOT* { ORA NOT }
%INC_Z { LDZk INC SWP STZ }
%DEC_Z { LDZk DEC SWP STZ }
%INC_Z* { LDZk* INC* ROT STZ* }
%DEC_Z* { LDZk* DEC* ROT STZ* }
%INC_A { LDAk INC ROT ROT STA }
%DEC_A { LDAk DEC ROT ROT STA }
%INC_A* { LDAk* INC* SWP* STA* }
%DEC_A* { LDAk* DEC* SWP* STA* }
%INC_R { PANIC } ( Not possible to implement for relative addresses )
%DEC_R { PANIC } ( Not possible to implement for relative addresses )
%INC_R* { PANIC } ( Not possible to implement for relative addresses )
%DEC_R* { PANIC } ( Not possible to implement for relative addresses )
%<NULL> { 00 }
%<SPACE> { 20 }
%<LINEFEED> { 0a }
%CHOOSE { ROT JMP SWP NIP } ( flag value0 value1 -- value )
%CHOOSE* { STH* ROT STHr* ROT JMP SWP* NIP* } ( flag value0* value1* -- value* )
%IS_POSITIVE { #80 LTH }
%IS_POSITIVE* { #8000 LTH* }
%IS_NEGATIVE { #7f GTH }
%IS_NEGATIVE* { #7fff GTH* }
%ABS* { DUP* #8000 LTH* #05 JCN #0000 SWP* SUB* }
%NEG { LIT 00 SWP SUB }
%NEGr { LITr 00 SWPr SUBr }
%NEG* { LIT* 0000 SWP* SUB* }
%NEGr* { LITr* 0000 SWPr* SUBr* }

51
_constants.tal Normal file
View File

@ -0,0 +1,51 @@
( ---------------------------------------------------------------------------- )
( C O N S T A N T S M A C R O S )
%BUTTON_MASK_UP { #10 } %BUTTON_MASK_A { #01 }
%BUTTON_MASK_DOWN { #20 } %BUTTON_MASK_B { #02 }
%BUTTON_MASK_LEFT { #40 } %BUTTON_MASK_SELECT { #04 }
%BUTTON_MASK_RIGHT { #80 } %BUTTON_MASK_START { #08 }
%BITMASK_1 { #01 } %BITMASK_5 { #10 }
%BITMASK_2 { #02 } %BITMASK_6 { #20 }
%BITMASK_3 { #04 } %BITMASK_7 { #40 }
%BITMASK_4 { #08 } %BITMASK_8 { #80 }
( Colour mappings for pixel colours, 1-bit sprite colours, and 2-bit sprite colours. )
%COL_0 { #00 } %COL_00 { #00 } %COL_0012 { #00 }
%COL_1 { #01 } %COL_01 { #01 } %COL_0123 { #01 }
%COL_2 { #02 } %COL_02 { #02 } %COL_0231 { #02 }
%COL_3 { #03 } %COL_03 { #03 } %COL_0312 { #03 }
%COL_10 { #04 } %COL_1012 { #04 }
%COL_T1 { #05 } %COL_T123 { #05 }
%COL_12 { #06 } %COL_1231 { #06 }
%COL_13 { #07 } %COL_1312 { #07 }
%COL_20 { #08 } %COL_2012 { #08 }
%COL_21 { #09 } %COL_2123 { #09 }
%COL_T2 { #0a } %COL_T231 { #0a }
%COL_23 { #0b } %COL_2312 { #0b }
%COL_30 { #0c } %COL_3012 { #0c }
%COL_31 { #0d } %COL_3123 { #0d }
%COL_32 { #0e } %COL_3231 { #0e }
%COL_T3 { #0f } %COL_T312 { #0f }
%COL_0123_2B { #81 }
( Colour mappings for pixel colours, 1-bit sprite colours, and 2-bit sprite colours. )
%COL_0_FG { #40 } %COL_00_FG { #40 } %COL_0012_FG { #40 }
%COL_1_FG { #41 } %COL_01_FG { #41 } %COL_0123_FG { #41 }
%COL_2_FG { #42 } %COL_02_FG { #42 } %COL_0231_FG { #42 }
%COL_3_FG { #43 } %COL_03_FG { #43 } %COL_0312_FG { #43 }
%COL_10_FG { #44 } %COL_1012_FG { #44 }
%COL_T1_FG { #45 } %COL_T123_FG { #45 }
%COL_12_FG { #46 } %COL_1231_FG { #46 }
%COL_13_FG { #47 } %COL_1312_FG { #47 }
%COL_20_FG { #48 } %COL_2012_FG { #48 }
%COL_21_FG { #49 } %COL_2123_FG { #49 }
%COL_T2_FG { #4a } %COL_T231_FG { #4a }
%COL_23_FG { #4b } %COL_2312_FG { #4b }
%COL_30_FG { #4c } %COL_3012_FG { #4c }
%COL_31_FG { #4d } %COL_3123_FG { #4d }
%COL_32_FG { #4e } %COL_3231_FG { #4e }
%COL_T3_FG { #4f } %COL_T312_FG { #4f }
%TRUE { #01 }
%FALSE { #01 }

74
_device_macros.tal Normal file
View File

@ -0,0 +1,74 @@
( ---------------------------------------------------------------------------- )
( D E V I C E M A C R O S )
( Device port numbers )
%/SYSTEM.WST { LIT 02 } %r/SYSTEM.WST { LITr 02 }
%/SYSTEM.RST { LIT 03 } %r/SYSTEM.RST { LITr 03 }
%/SYSTEM.RED { LIT 08 } %r/SYSTEM.RED { LITr 08 }
%/SYSTEM.GREEN { LIT 0a } %r/SYSTEM.GREEN { LITr 0a }
%/SYSTEM.BLUE { LIT 0c } %r/SYSTEM.BLUE { LITr 0c }
%/SYSTEM.DEBUG { LIT 0e } %r/SYSTEM.DEBUG { LITr 0e }
%/SYSTEM.HALT { LIT 0f } %r/SYSTEM.HALT { LITr 0f }
%/CONSOLE.VECTOR { LIT 10 } %r/CONSOLE.VECTOR { LITr 10 }
%/CONSOLE.READ { LIT 12 } %r/CONSOLE.READ { LITr 12 }
%/CONSOLE.WRITE { LIT 18 } %r/CONSOLE.WRITE { LITr 18 }
%/CONSOLE.ERROR { LIT 19 } %r/CONSOLE.ERROR { LITr 19 }
%/SCREEN.VECTOR { LIT 20 } %r/SCREEN.VECTOR { LITr 20 }
%/SCREEN.WIDTH { LIT 22 } %r/SCREEN.WIDTH { LITr 22 }
%/SCREEN.HEIGHT { LIT 24 } %r/SCREEN.HEIGHT { LITr 24 }
%/SCREEN.AUTO { LIT 26 } %r/SCREEN.AUTO { LITr 26 }
%/SCREEN.X { LIT 28 } %r/SCREEN.X { LITr 28 }
%/SCREEN.Y { LIT 2a } %r/SCREEN.Y { LITr 2a }
%/SCREEN.ADDR { LIT 2c } %r/SCREEN.ADDR { LITr 2c }
%/SCREEN.PIXEL { LIT 2e } %r/SCREEN.PIXEL { LITr 2e }
%/SCREEN.SPRITE { LIT 2f } %r/SCREEN.SPRITE { LITr 2f }
%/CONTROLLER.VECTOR { LIT 80 } %r/CONTROLLER.VECTOR { LITr 80 }
%/CONTROLLER.BUTTON { LIT 82 } %r/CONTROLLER.BUTTON { LITr 82 }
%/CONTROLLER.KEY { LIT 83 } %r/CONTROLLER.KEY { LITr 83 }
%/MOUSE.VECTOR { LIT 90 } %r/MOUSE.VECTOR { LITr 90 }
%/MOUSE.X { LIT 92 } %r/MOUSE.X { LITr 92 }
%/MOUSE.Y { LIT 94 } %r/MOUSE.Y { LITr 94 }
%/MOUSE.STATE { LIT 96 } %r/MOUSE.STATE { LITr 96 }
%/MOUSE.SCROLLX { LIT 9a } %r/MOUSE.SCROLLX { LITr 9a }
%/MOUSE.SCROLLY { LIT 9c } %r/MOUSE.SCROLLY { LITr 9c }
( Read from device ports )
%/SYSTEM.WST? { /SYSTEM.WST DEI } %r/SYSTEM.WST? { r/SYSTEM.WST DEIr }
%/SYSTEM.RST? { /SYSTEM.RST DEI } %r/SYSTEM.RST? { r/SYSTEM.RST DEIr }
%/CONSOLE.READ? { /CONSOLE.READ DEI } %r/CONSOLE.READ? { r/CONSOLE.READ DEIr }
%/SCREEN.WIDTH? { /SCREEN.WIDTH DEI* } %r/SCREEN.WIDTH? { r/SCREEN.WIDTH DEIr* }
%/SCREEN.HEIGHT? { /SCREEN.HEIGHT DEI* } %r/SCREEN.HEIGHT? { r/SCREEN.HEIGHT DEIr* }
%/SCREEN.AUTO? { /SCREEN.AUTO DEI } %r/SCREEN.AUTO? { r/SCREEN.AUTO DEIr }
%/SCREEN.X? { /SCREEN.X DEI* } %r/SCREEN.X? { r/SCREEN.X DEIr* }
%/SCREEN.Y? { /SCREEN.Y DEI* } %r/SCREEN.Y? { r/SCREEN.Y DEIr* }
%/SCREEN.ADDR? { /SCREEN.ADDR DEI* } %r/SCREEN.ADDR? { r/SCREEN.ADDR DEIr* }
%/CONTROLLER.BUTTON? { /CONTROLLER.BUTTON DEI } %r/CONTROLLER.BUTTON? { r/CONTROLLER.BUTTON DEIr }
%/CONTROLLER.KEY? { /CONTROLLER.KEY DEI } %r/CONTROLLER.KEY? { r/CONTROLLER.KEY DEIr }
%/MOUSE.X? { /MOUSE.X DEI* } %r/MOUSE.X? { r/MOUSE.X DEIr* }
%/MOUSE.Y? { /MOUSE.Y DEI* } %r/MOUSE.Y? { r/MOUSE.Y DEIr* }
%/MOUSE.STATE? { /MOUSE.STATE DEI } %r/MOUSE.STATE? { r/MOUSE.STATE DEIr }
%/MOUSE.SCROLLX? { /MOUSE.SCROLLX DEI } %r/MOUSE.SCROLLX? { r/MOUSE.SCROLLX DEIr }
%/MOUSE.SCROLLY? { /MOUSE.SCROLLY DEI } %r/MOUSE.SCROLLY? { r/MOUSE.SCROLLY DEIr }
( Write to device ports )
%/SYSTEM.WST! { /SYSTEM.WST DEO } %r/SYSTEM.WST! { r/SYSTEM.WST DEOr }
%/SYSTEM.RST! { /SYSTEM.RST DEO } %r/SYSTEM.RST! { r/SYSTEM.RST DEOr }
%/SYSTEM.RED! { /SYSTEM.RED DEO* } %r/SYSTEM.RED! { r/SYSTEM.RED DEOr* }
%/SYSTEM.GREEN! { /SYSTEM.GREEN DEO* } %r/SYSTEM.GREEN! { r/SYSTEM.GREEN DEOr* }
%/SYSTEM.BLUE! { /SYSTEM.BLUE DEO* } %r/SYSTEM.BLUE! { r/SYSTEM.BLUE DEOr* }
%/SYSTEM.DEBUG! { /SYSTEM.DEBUG DEO } %r/SYSTEM.DEBUG! { r/SYSTEM.DEBUG DEOr }
%/SYSTEM.HALT! { /SYSTEM.HALT DEO } %r/SYSTEM.HALT! { r/SYSTEM.HALT DEOr }
%/CONSOLE.VECTOR! { /CONSOLE.VECTOR DEO* } %r/CONSOLE.VECTOR! { r/CONSOLE.VECTOR DEOr* }
%/CONSOLE.WRITE! { /CONSOLE.WRITE DEO } %r/CONSOLE.WRITE! { r/CONSOLE.WRITE DEOr }
%/CONSOLE.ERROR! { /CONSOLE.ERROR DEO } %r/CONSOLE.ERROR! { r/CONSOLE.ERROR DEOr }
%/SCREEN.VECTOR! { /SCREEN.VECTOR DEO* } %r/SCREEN.VECTOR! { r/SCREEN.VECTOR DEOr* }
%/SCREEN.WIDTH! { /SCREEN.WIDTH DEO* } %r/SCREEN.WIDTH! { r/SCREEN.WIDTH DEOr* }
%/SCREEN.HEIGHT! { /SCREEN.HEIGHT DEO* } %r/SCREEN.HEIGHT! { r/SCREEN.HEIGHT DEOr* }
%/SCREEN.AUTO! { /SCREEN.AUTO DEO } %r/SCREEN.AUTO! { r/SCREEN.AUTO DEOr }
%/SCREEN.X! { /SCREEN.X DEO* } %r/SCREEN.X! { r/SCREEN.X DEOr* }
%/SCREEN.Y! { /SCREEN.Y DEO* } %r/SCREEN.Y! { r/SCREEN.Y DEOr* }
%/SCREEN.ADDR! { /SCREEN.ADDR DEO* } %r/SCREEN.ADDR! { r/SCREEN.ADDR DEOr* }
%/SCREEN.PIXEL! { /SCREEN.PIXEL DEO } %r/SCREEN.PIXEL! { r/SCREEN.PIXEL DEOr }
%/SCREEN.SPRITE! { /SCREEN.SPRITE DEO } %r/SCREEN.SPRITE! { r/SCREEN.SPRITE DEOr }
%/CONTROLLER.VECTOR! { /CONTROLLER.VECTOR DEO* } %r/CONTROLLER.VECTOR! { r/CONTROLLER.VECTOR DEOr* }
%/MOUSE.VECTOR! { /MOUSE.VECTOR DEO* } %r/MOUSE.VECTOR! { r/MOUSE.VECTOR DEOr* }

51
_draw_line.tal Normal file
View File

@ -0,0 +1,51 @@
@draw_line ( x0* y0* x1* y1* callback* -- )
,&callback STR* ( x0* y0* x1* y1* )
ROT* STH* ROT* ROTk* NIP* SWP* STH* ( x1* y1* : x0* x1* | y0* y1* )
OVRk* ( .. x0* x1* x0* x1* x0* | y0* y1* )
( Store x0 )
,&x_end STR* ( .. x0* x1* x0* x1* | y0* y1* )
( Calculate and store xi )
,&calc_xi_yi JSR ,&xi STR* ( .. x0* x1* | y0* y1* )
( Calculate |dx| )
,&abs_diff* JSR STH* ( .. | y0* y1* dx* )
( Move y to working stack and explode )
ROTr* STHr* SWPr* STHr* OVRk* ( .. y0* y1* y0* y1* y0* | dx* )
( Store y0 )
,&y_end STR* ( .. y0* y1* y0* y1* | dx* )
( Calculate and store yi )
,&calc_xi_yi JSR ,&yi STR* ( .. y0* y1* | dx* )
( Calculate -|dy| )
,&abs_diff* JSR NEG* STH* ( x1* y1* : | dx* dy* )
( e0 = dx + dy )
ADDkr* ( x1* y1* | dx* dy* e0* )
&loop ( x* y* | dx* dy* e0* )
( Paint a pixel )
OVR* OVR* [ LIT* &callback $2 ] CALL
( Jump to end if x=x0 and y=y0 )
OVR* [ LIT* &x_end $2 ] EQU* STH
DUP* [ LIT* &y_end $2 ] EQU* STHr
AND ,&end JCN ( x* y* | dx* dy* e0* )
( e1 = e0 * 2 )
DOUBLEkr* STHr* ( x* y* e1* | dx* dy* e0* )
( If e1 >= dy: ) ( x* y* e1* | dx* dy* e0* )
DUP* OVRr* STHr* ;lth_signed* CALL ,&skipy JCN
( e0 += dy ) OVRr* ADDr*
( x += xi ) ROT* [ LIT* &xi $2 ] ADD* ROT* ROT*
&skipy
( If e1 <= dx: ) ( x* y* e1* | dx* dy* e0* )
ROTr* STHkr* ROTr* ROTr* ;gth_signed* CALL ,&skipx JCN
( e0 += dx ) STHr* OVRr* STH* ADDr*
( y += yi ) [ LIT* &yi $2 ] ADD*
&skipx
,&loop JMP ( x* y* | dx* dy* e0* )
&end POP* POP* POPr* POPr* POPr* RETURN ( -- )
&abs_diff* SUB* ABS* RETURN ( a* b* -- |a-b| )
&calc_xi_yi ( x0 x1 -- xi )
;gth_signed* CALL TO_SHORT DOUBLE* #ffff ADD* RETURN

43
_draw_rect.tal Normal file
View File

@ -0,0 +1,43 @@
( Draw a rectange outline. Width and height must not be zero. )
@draw_rect_outline ( colour width* height* )
/SCREEN.X? ,&startx STR*
/SCREEN.Y? ,&starty STR*
STH* STH* DUP #0001 SWP* STHkr* ( 1* colour* width* | height* width* )
;draw_horizontal_line CALL ( 1* colour | height* width* )
DUP OVR* OVRr* STHr* ,&reset JSR ( 1* colour* | height* width* )
STHkr* ;draw_horizontal_line CALL ( 1* colour | height* width* )
DUP OVR* STHr* SWP* ,&reset JSR ( 1* colour* | height* )
STHkr* ;draw_vertical_line CALL ( 1* colour | height* )
DUP OVR* DUP* ,&reset JSR ( 1* colour* | height* )
POP STHr* ;draw_vertical_line CALL ( -- )
DUP* ,&reset JMP
&reset
LIT* &starty $2 ADD* DEC* /SCREEN.Y!
LIT* &startx $2 ADD* DEC* /SCREEN.X!
RETURN
( Draw a solid rectange. Width and height must not be zero. )
@draw_rect_filled ( colour width* height* )
STH* ,&width STR* ,&colour STR STHr* ( height* )
/SCREEN.Y? DUP* ROT* ADD* SWP* ( target* starty* )
r/SCREEN.Y DEIkr* ROTr ( target* starty* | startx* port )
&loop ( target* y* | startx* port )
[ LIT &colour $1 LIT* &width $2 ] ( target* y* colour width* | startx* port )
;draw_horizontal_line CALL ( target* y* | startx* port )
INC* DUP* /SCREEN.Y! ( target* y+1* | startx* port )
NEQk* ,&loop JCN ( target* y* | startx* port )
( Clean up and return ) ( target* y* | startx* port )
POP* POP* DEOr* RETURN ( -- )
( Draw a horizontal or vertical line. Line length must not be zero. )
@draw_vertical_line #2a02 INCk JMP ( colour height* -- )
@draw_horizontal_line #2801 ( colour width* -- )
@__draw_line ( colour len* axis auto )
/SCREEN.AUTO! STH DEIkr* ROTr ( colour len* axis | start* axis )
&loop ( colour len* | start* axis )
ROTk /SCREEN.PIXEL! POP* ( colour len* | start* axis )
DEC* DUP* #0000 NEQ* ,&loop JCN ( colour len-1* | start* axis )
&end ( colour len* | start* axis )
DEOr* /SCREEN.AUTO! POP* RETURN ( -- )

31
_draw_shapes.tal Normal file
View File

@ -0,0 +1,31 @@
@draw_capsule ( colour width* height* )
r/SCREEN.X? r/SCREEN.Y? ( c w* h* | x* y* )
INCkr* r/SCREEN.Y! ( c w* h* | x* y* )
( Draw wider rectangle )
STH* STH* DUP STHkr* OVRr* STHr* ( c c w* h-2* | x* y* h* w* )
#0002 SUB* ;draw_rect_filled CALL ( c | x* y* h* w* )
( Draw taller rectangle )
STHr* #0002 SUB* STHr* ( c w-2* h* | x* y* )
SWPkr* INCr* r/SCREEN.X! r/SCREEN.Y! ( c w-2* h* | x* y* )
;draw_rect_outline CALL ( | x* y* )
( Clear stacks )
r/SCREEN.Y! r/SCREEN.X! RETURN ( -- )
@draw_capsule_smooth ( colour width* height* )
r/SCREEN.X? r/SCREEN.Y? SWPkr* ( c w* h* | sx* sy* sy* sx* )
INCr* r/SCREEN.X! INCr* r/SCREEN.Y! ( c w* h* | sx* sy* )
( Draw inner rectangle )
STH* STH* DUPk ( c c c | sx* sy* h* w* )
STHkr* #0002 SUB* OVRr* STHr* #0002 SUB* ( c c c w-2* h-2* | sx* sy* h* w* )
;draw_rect_filled CALL ( c c | sx* sy* h* w* )
( Draw wider rectangle )
#0001 INCk* MOVE_DOWN MOVE_LEFT
STHkr* OVRr* STHr* #0006 SUB* ( c c w* h-6* | sx* sy* h* w* )
;draw_rect_outline CALL ( c | sx* sy* h* w* )
( Draw taller rectangle )
#0003 DUP* MOVE_RIGHT MOVE_UP
STHr* #0006 SUB* STHr* ( c w-6* h* | sx* sy* )
;draw_rect_outline CALL ( | sx* sy* )
( Clear stacks )
r/SCREEN.Y! r/SCREEN.X! RETURN ( -- )

143
_drawing_routines.tal Normal file
View File

@ -0,0 +1,143 @@
( Convert between pixel colours [0,1,2,3] and sprite foreground colours [0,4,8,c] )
%TO_SPRITE_COLOUR { SHL2 }
%TO_PIXEL_COLOUR { SHR2 }
( ---------------------------------------------------------------------------- )
( U S E R I N T E R F A C E E L E M E N T S )
( Draw a variable-width 11-high button with a centered text label )
@draw_button ( sprite_colour width* text_addr* -- )
/SCREEN.X? STH* STH* STH* ( s_colour | startx* t_addr* width* )
DUP TO_PIXEL_COLOUR ( s_colour p_colour | startx* t_addr* width* )
STHkr* #000b ;draw_capsule CALL ( s_colour | startx* t_addr* width* )
( Draw text in center of button )
/SCREEN.Y? INC* INC* /SCREEN.Y! ( s_colour | startx* t_addr* width* )
SWPr* STHr* STHr* ( s_colour t_addr* width* | startx* )
OVR* ;get_text_width CALL SUB* HALVE* ( s_colour t_addr* t_x_offset* | startx* )
STHkr* ADD* /SCREEN.X! ;draw_text CALL ( s_colour t_addr* | startx* )
( Return pointer to initial position )
STHr* /SCREEN.X! ( -- )
/SCREEN.Y? #0002 SUB* /SCREEN.Y! ( -- )
RETURN ( -- )
( Draw a 10x10 square button containing an 8x8 2-bit icon sprite )
@draw_icon_button ( s_colour sprite_addr* -- )
/SCREEN.ADDR! DUP TO_PIXEL_COLOUR ( s_colour p_colour )
#000a DUP* ;draw_capsule CALL ( s_colour )
r/SCREEN.X? INCkr* r/SCREEN.X! ( s_colour | startx* )
r/SCREEN.Y? INCkr* r/SCREEN.Y! ( s_colour | startx* starty* )
/SCREEN.SPRITE! ( | startx* starty* )
r/SCREEN.Y! r/SCREEN.X! RETURN ( -- )
( Draw a two-option selector, 13-high. )
@draw_toggle ( bg_colour fg_colour width* text_addr_1* text_addr_2* value -- )
( Store calculated values )
r/SCREEN.Y? r/SCREEN.X? STH ( ... | y* x* val )
,&text_addr_2 STR* ,&text_addr_1 STR* ( bg fg width* | y* x* val )
DUP* #0004 SUB* HALVE* ,&half_width STR* ( bg fg width* | y* x* val )
DUP* #0001 AND* ,&pad STR* ,&width STR* ( bg fg | y* x* val )
( Convert [<edge,inner> <active,text>] to [<edge,inner> <active,text> <inner,text>] )
SWPk #03 AND SHL2 SWP #03 AND ORA ( bg active inactive | y* x* val )
STHr JMP SWP ( bg right left | y* x* )
,&left_colour STR ,&right_colour STR ( bg | y* x* )
( Draw edge )
DUP SHR2 [ LIT* &width $2 ] ( bg edge width* | y* x* )
#000d ;draw_capsule CALL ( bg | y* x* )
( Draw inner fill )
MOVE_RIGHT_1 MOVE_DOWN_1 ( bg | y* x* )
#03 AND ,&width LDR* #0002 SUB* ( inner width* | y* x* )
#000b ;draw_capsule CALL ( | y* x* )
( Draw left option )
[ LIT &left_colour $1 ] [ LIT* &half_width $2 ]
[ LIT* &text_addr_1 $2 ] ;draw_button CALL
,&half_width LDR* ADD2* [ LIT* &pad $2 ] ADD* MOVE_RIGHT
( Draw right option )
[ LIT &right_colour $1 ] ,&half_width LDR*
[ LIT* &text_addr_2 $2 ] ;draw_button CALL
r/SCREEN.X! r/SCREEN.Y!
RETURN
( Draw a numeric input widget )
@draw_numeric_input ( colour width* number* active -- )
/SCREEN.X? ,&start_x STR*
STH STH* STH* ( colour | active number* width* )
DUP ,&colour STR STHr* ( colour width* | active number* )
DUP* ,&width STR* STHr* ( colour width* number* | active )
;convert_short_to_decimal_string CALL ( colour width* text_addr* | active )
;draw_button CALL ( -- | active )
STHr JMP RETURN ( // return if inactive )
;sprite/left_chevron /SCREEN.ADDR!
#0002 MOVE_DOWN #0002 MOVE_RIGHT ( // position cursor for left-arrow )
,&colour LDR /SCREEN.SPRITE! ( // draw left arrow )
,&width LDR* #000c SUB* MOVE_RIGHT ( // position cursor for right-arrow )
,&colour LDR AND_FLIPX /SCREEN.SPRITE!
[ LIT* &start_x $2 ] /SCREEN.X!
#0002 MOVE_UP
RETURN
&colour $1 &width $2
( ---------------------------------------------------------------------------- )
( D R A W I N G S U B R O U T I N E S )
( Draw proportional text )
@draw_text ( colour text_addr* -- )
ROT ,&colour STR ( t_addr* )
r/SCREEN.X DEIkr* ROTr ( t_addr* | x* axis )
&loop ( t_addr* | x* axis )
LDAk DUP ,&render JCN ( t_addr* ascii | x* axis )
POP POP* DEOr* RETURN ( -- )
&render
ASCII_TO_INDEX TO_SHORT DUP* MUL8* ( t_addr* code* code8* | x* axis )
;acorn_font/characters ADD* ( t_addr* code* sprite* | x* axis )
/SCREEN.ADDR! ( t_addr* code* | x* axis )
[ LIT &colour $1 ] /SCREEN.SPRITE! ( t_addr* code* | x* axis )
;acorn_font/width ADD* LDA TO_SHORT ( t_addr* char_width* | x* axis )
/SCREEN.X? ADD* /SCREEN.X! ( t_addr* | x* axis )
INC* ,&loop JMP ( t_addr* | x* axis )
@get_text_width ( text_addr* -- width* )
#0000 SWP* ( width* t_addr* )
&loop ( width* t_addr* )
LDAk DUP ,&cont JCN ( width* t_addr* ascii )
&end ( width* t_addr* ascii )
POP POP* RETURN ( width* )
&cont ( width* t_addr* ascii )
ASCII_TO_INDEX TO_SHORT ( width* t_addr* code* )
;acorn_font/width ADD* LDA TO_SHORT ( width* t_addr* char_width* )
ROT* ADD* SWP* INC* ,&loop JMP ( width* t_addr* )
@draw_capsule ( colour width* height* )
r/SCREEN.X? r/SCREEN.Y? ( c w* h* | x* y* )
INCkr* r/SCREEN.Y! ( c w* h* | x* y* )
( Draw wider rectangle )
STH* STH* DUP STHkr* OVRr* STHr* ( c c w* h-2* | x* y* h* w* )
#0002 SUB* ;draw_rect_filled CALL ( c | x* y* h* w* )
( Draw taller rectangle )
STHr* #0002 SUB* STHr* ( c w-2* h* | x* y* )
SWPkr* INCr* r/SCREEN.X! r/SCREEN.Y! ( c w-2* h* | x* y* )
;draw_rect_outline CALL ( | x* y* )
( Clear stacks )
r/SCREEN.Y! r/SCREEN.X! RETURN ( -- )
@draw_capsule_smooth ( colour width* height* )
r/SCREEN.X? r/SCREEN.Y? SWPkr* ( c w* h* | sx* sy* sy* sx* )
INCr* r/SCREEN.X! INCr* r/SCREEN.Y! ( c w* h* | sx* sy* )
( Draw inner rectangle )
STH* STH* DUPk ( c c c | sx* sy* h* w* )
STHkr* #0002 SUB* OVRr* STHr* #0002 SUB* ( c c c w-2* h-2* | sx* sy* h* w* )
;draw_rect_filled CALL ( c c | sx* sy* h* w* )
( Draw wider rectangle )
#0001 INCk* MOVE_DOWN MOVE_LEFT
STHkr* OVRr* STHr* #0006 SUB* ( c c w* h-6* | sx* sy* h* w* )
;draw_rect_outline CALL ( c | sx* sy* h* w* )
( Draw taller rectangle )
#0003 DUP* MOVE_RIGHT MOVE_UP
STHr* #0006 SUB* STHr* ( c w-6* h* | sx* sy* )
;draw_rect_outline CALL ( | sx* sy* )
( Clear stacks )
r/SCREEN.Y! r/SCREEN.X! RETURN ( -- )

19
_fill_screen.tal Normal file
View File

@ -0,0 +1,19 @@
@clear_foreground ( -- )
COL_00_FG ( sprite_colour )
@fill_screen_with_colour ( sprite_colour -- )
;sprite/blank ( sprite_colour sprite_addr )
@fill_screen_with_sprite ( sprite_colour sprite_addr* -- )
/SCREEN.ADDR! ( colour )
#0000 DUP* /SCREEN.X! /SCREEN.Y! ( colour )
#f1 /SCREEN.AUTO! ( colour )
&loop ( colour )
DUP /SCREEN.SPRITE! ( colour )
/SCREEN.X? /SCREEN.WIDTH? LTH* ( colour is_line_incomplete? )
,&loop JCN ( colour )
&next_line ( colour )
#0000 /SCREEN.X! ( colour )
/SCREEN.Y? #0008 ADD* ( colour y* )
DUP* /SCREEN.Y! ( colour y* )
/SCREEN.HEIGHT? LTH* ( colour is_screen_incomplete? )
,&loop JCN
POP #00 /SCREEN.AUTO! RETURN

35
_instruction_renaming.tal Normal file
View File

@ -0,0 +1,35 @@
( ---------------------------------------------------------------------------- )
( I N S T R U C T I O N R E N A M I N G M A C R O S )
%LIT* { LIT2 } %LITr* { LIT2r } %LITk* { LIT2k } %LITkr* { LIT2kr }
%INC* { INC2 } %INCr* { INC2r } %INCk* { INC2k } %INCkr* { INC2kr }
%POP* { POP2 } %POPr* { POP2r } %POPk* { POP2k } %POPkr* { POP2kr }
%NIP* { NIP2 } %NIPr* { NIP2r } %NIPk* { NIP2k } %NIPkr* { NIP2kr }
%SWP* { SWP2 } %SWPr* { SWP2r } %SWPk* { SWP2k } %SWPkr* { SWP2kr }
%ROT* { ROT2 } %ROTr* { ROT2r } %ROTk* { ROT2k } %ROTkr* { ROT2kr }
%DUP* { DUP2 } %DUPr* { DUP2r } %DUPk* { DUP2k } %DUPkr* { DUP2kr }
%OVR* { OVR2 } %OVRr* { OVR2r } %OVRk* { OVR2k } %OVRkr* { OVR2kr }
%EQU* { EQU2 } %EQUr* { EQU2r } %EQUk* { EQU2k } %EQUkr* { EQU2kr }
%NEQ* { NEQ2 } %NEQr* { NEQ2r } %NEQk* { NEQ2k } %NEQkr* { NEQ2kr }
%GTH* { GTH2 } %GTHr* { GTH2r } %GTHk* { GTH2k } %GTHkr* { GTH2kr }
%LTH* { LTH2 } %LTHr* { LTH2r } %LTHk* { LTH2k } %LTHkr* { LTH2kr }
%JMP* { JMP2 } %JMPr* { JMP2r } %JMPk* { JMP2k } %JMPkr* { JMP2kr }
%JCN* { JCN2 } %JCNr* { JCN2r } %JCNk* { JCN2k } %JCNkr* { JCN2kr }
%JSR* { JSR2 } %JSRr* { JSR2r } %JSRk* { JSR2k } %JSRkr* { JSR2kr }
%STH* { STH2 } %STHr* { STH2r } %STHk* { STH2k } %STHkr* { STH2kr }
%LDZ* { LDZ2 } %LDZr* { LDZ2r } %LDZk* { LDZ2k } %LDZkr* { LDZ2kr }
%STZ* { STZ2 } %STZr* { STZ2r } %STZk* { STZ2k } %STZkr* { STZ2kr }
%LDR* { LDR2 } %LDRr* { LDR2r } %LDRk* { LDR2k } %LDRkr* { LDR2kr }
%STR* { STR2 } %STRr* { STR2r } %STRk* { STR2k } %STRkr* { STR2kr }
%LDA* { LDA2 } %LDAr* { LDA2r } %LDAk* { LDA2k } %LDAkr* { LDA2kr }
%STA* { STA2 } %STAr* { STA2r } %STAk* { STA2k } %STAkr* { STA2kr }
%DEI* { DEI2 } %DEIr* { DEI2r } %DEIk* { DEI2k } %DEIkr* { DEI2kr }
%DEO* { DEO2 } %DEOr* { DEO2r } %DEOk* { DEO2k } %DEOkr* { DEO2kr }
%ADD* { ADD2 } %ADDr* { ADD2r } %ADDk* { ADD2k } %ADDkr* { ADD2kr }
%SUB* { SUB2 } %SUBr* { SUB2r } %SUBk* { SUB2k } %SUBkr* { SUB2kr }
%MUL* { MUL2 } %MULr* { MUL2r } %MULk* { MUL2k } %MULkr* { MUL2kr }
%DIV* { DIV2 } %DIVr* { DIV2r } %DIVk* { DIV2k } %DIVkr* { DIV2kr }
%AND* { AND2 } %ANDr* { AND2r } %ANDk* { AND2k } %ANDkr* { AND2kr }
%ORA* { ORA2 } %ORAr* { ORA2r } %ORAk* { ORA2k } %ORAkr* { ORA2kr }
%EOR* { EOR2 } %EORr* { EOR2r } %EORk* { EOR2k } %EORkr* { EOR2kr }
%SFT* { SFT2 } %SFTr* { SFT2r } %SFTk* { SFT2k } %SFTkr* { SFT2kr }

92
_print_routines.tal Normal file
View File

@ -0,0 +1,92 @@
%PRINTF(\s) { ;print_space CALL }
%PRINTF(\n) { ;print_newline CALL }
%PRINTF(%s) { ;print_string CALL }
%PRINTF(%s\s) { PRINTF(%s) PRINTF(\s) }
%PRINTF(%s\n) { PRINTF(%s) PRINTF(\n) }
%PRINTF(%d) { ;print_byte_decimal CALL }
%PRINTF(%d\s) { PRINTF(%d) PRINTF(\s) }
%PRINTF(%d\n) { PRINTF(%d) PRINTF(\n) }
%PRINTF(%d*) { ;print_short_decimal CALL }
%PRINTF(%d*\s) { PRINTF(%d*) PRINTF(\s) }
%PRINTF(%d*\n) { PRINTF(%d*) PRINTF(\n) }
%PRINTF(%-d*) { ;print_short_decimal_signed CALL }
%PRINTF(%-d*\s) { PRINTF(%-d*) PRINTF(\s) }
%PRINTF(%-d*\n) { PRINTF(%-d*) PRINTF(\n) }
%PRINTF(%b) { ;print_byte_binary CALL }
%PRINTF(%b\s) { PRINTF(%b) PRINTF(\s) }
%PRINTF(%b\n) { PRINTF(%b) PRINTF(\n) }
%PRINTF(%?) { ;print_bool CALL }
%PRINTF(%?\s) { PRINTF(%?) PRINTF(\s) }
%PRINTF(%?\n) { PRINTF(%?) PRINTF(\n) }
%PRINTF(%?*) { ;print_bool_short CALL }
%PRINTF(%?*\s) { PRINTF(%?) PRINTF(\s) }
%PRINTF(%?*\n) { PRINTF(%?) PRINTF(\n) }
@print_newline LIT <LINEFEED> /CONSOLE.WRITE! RETURN
@print_space LIT <SPACE> /CONSOLE.WRITE! RETURN
( Print a byte to the console in binary )
@print_byte_binary ( byte -- )
#80
&loop ( byte mask )
ANDk TO_BOOL LIT* "01 CHOOSE ( byte mask ascii )
/CONSOLE.WRITE! SHR1 DUP ,&loop JCN ( byte mask )
&end POP* RETURN
( Print a single byte to the console in decimal )
@print_byte_decimal_signed ( byte -- )
DUP* IS_POSITIVE ,print_byte_decimal JCN
LIT "- /CONSOLE.WRITE! NEGATE
@print_byte_decimal ( byte -- )
;convert_byte_to_decimal_string CALL
PRINTF(%s) RETURN
( Print a single short to the console in decimal )
@print_short_decimal_signed ( short* -- )
DUP* IS_POSITIVE* ,print_short_decimal JCN
LIT "- /CONSOLE.WRITE! NEGATE*
@print_short_decimal ( short* -- )
;convert_short_to_decimal_string CALL
PRINTF(%s) RETURN
( Print a null-terminated string to the console )
@print_string ( text_addr* -- )
&loop LDAk DUP ,&print JCN POP POP* RETURN
&print /CONSOLE.WRITE! INC* ,&loop JMP
( Print a value as TRUE or FALSE )
@print_bool_short ( bool* -- )
TO_BOOL*
@print_bool ( bool -- )
;&true ROT ,&print JCN POP* ;&false &print PRINTF(%s) RETURN
&true "TRUE <NULL> &false "FALSE <NULL>
( Print a region of memory to the console as shorts, excluding the end address )
@print_memory_region_shorts ( start* end* -- )
SWP*
&loop
EQUk* ,&end JCN
LDAk* PRINTF(%d*\s)
INC* INC* ,&loop JMP
&end POP* POP* PRINTF(\n) RETURN
( Convert an integer to a null-terminated string )
@convert_byte_to_decimal_string ( byte -- text_addr* )
TO_SHORT
@convert_short_to_decimal_string ( value* -- text_addr* )
;&array_end SWP*
&loop ( addr* value* )
#000a DIVMOD* ( addr* value/10* digit* )
DIGIT_TO_ASCII ( addr* value* junk ascii )
ROT* STAk NIP* DEC* SWP* ( addr-1* value* )
DUP* ADD ,&loop JCN ( addr* value* )
&end
POP* INC* RETURN ( text_addr* )
&array $4 &array_end $1 <NULL>

View File

@ -0,0 +1,31 @@
( ---------------------------------------------------------------------------- )
( U S E R I N T E R F A C E C A L L B A C K S )
( )
( Callbacks are two-byte addresses )
@ui__callbacks
&on_screen $2
( One callback per UI element, signature [ -- ] )
&dec $32
&inc $32
&go $32
( One callback per controller button, signature [ -- ] )
&left $2
&right $2
&up $2
&down $2
&A $2
&B $2
&start $2
&select $2
( One callback per UI element, signature [ a -- ] )
&draw $32
( One callback per mouse action, signature [ state -- ]. 0: held, 1: released )
&mouse1 $2
&mouse2 $2
&mouse3 $2
&end
( Zones are groups of left* right* top* bottom* inclusive bounds for each control )
@ui__zones $128
&end

View File

@ -0,0 +1,284 @@
( ---------------------------------------------------------------------------- )
( U S E R I N T E R F A C E F R A M E W O R K )
( )
( A declarative callback-driven graphical user interface framework. )
( The coordinates of the center of the screen )
%/I.CENTER.X { #e3 } %/I.CENTER.X? { #e3 LDZ* } %/I.CENTER.X! { #e3 STZ* }
%/I.CENTER.Y { #e5 } %/I.CENTER.Y? { #e5 LDZ* } %/I.CENTER.Y! { #e5 STZ* }
( The last-known position of the mouse cursor )
%/I.CURSOR.X { #e7 } %/I.CURSOR.X? { #e7 LDZ* } %/I.CURSOR.X! { #e7 STZ* }
%/I.CURSOR.Y { #e9 } %/I.CURSOR.Y? { #e9 LDZ* } %/I.CURSOR.Y! { #e9 STZ* }
( Edge states for mouse and controller )
%/I.BUTTON.PRESSED { #eb } %/I.BUTTON.PRESSED? { #eb LDZ } %/I.BUTTON.PRESSED! { #eb STZ }
%/I.BUTTON.HELD { #ec } %/I.BUTTON.HELD? { #ec LDZ } %/I.BUTTON.HELD! { #ec STZ }
%/I.BUTTON.RELEASED { #ed } %/I.BUTTON.RELEASED? { #ed LDZ } %/I.BUTTON.RELEASED! { #ed STZ }
%/I.MOUSE.PRESSED { #ee } %/I.MOUSE.PRESSED? { #ee LDZ } %/I.MOUSE.PRESSED! { #ee STZ }
%/I.MOUSE.HELD { #ef } %/I.MOUSE.HELD? { #ef LDZ } %/I.MOUSE.HELD! { #ef STZ }
%/I.MOUSE.RELEASED { #f0 } %/I.MOUSE.RELEASED? { #f0 LDZ } %/I.MOUSE.RELEASED! { #f0 STZ }
( The index of the currently-selected and previously-selected UI element )
%/I.ACTIVE_ELEMENT { #f1 } %/I.ACTIVE_ELEMENT? { #f1 LDZ } %/I.ACTIVE_ELEMENT! { #f1 STZ }
%/I.PREV_ELEMENT { #f2 } %/I.PREV_ELEMENT? { #f2 LDZ } %/I.PREV_ELEMENT! { #f2 STZ }
%/I.NUM_ELEMENTS { #f3 } %/I.NUM_ELEMENTS? { #f3 LDZ } %/I.NUM_ELEMENTS! { #f3 STZ }
( The position of the mouse when each mouse button was pressed )
%/I.MOUSE1.X { #f4 } %/I.MOUSE1.X? { #f4 LDZ* } %/I.MOUSE1.X! { #f4 STZ* }
%/I.MOUSE1.Y { #f6 } %/I.MOUSE1.Y? { #f6 LDZ* } %/I.MOUSE1.Y! { #f6 STZ* }
%/I.MOUSE2.X { #f8 } %/I.MOUSE2.X? { #f8 LDZ* } %/I.MOUSE2.X! { #f8 STZ* }
%/I.MOUSE2.Y { #fa } %/I.MOUSE2.Y? { #fa LDZ* } %/I.MOUSE2.Y! { #fa STZ* }
%/I.MOUSE3.X { #fc } %/I.MOUSE3.X? { #fc LDZ* } %/I.MOUSE3.X! { #fc STZ* }
%/I.MOUSE3.Y { #fe } %/I.MOUSE3.Y? { #fe LDZ* } %/I.MOUSE3.Y! { #fe STZ* }
( Recall and register callbacks for raw input event handling )
%/I.CALLBACK.LEFT? { ;ui__callbacks/left LDA* } %/I.CALLBACK.LEFT! { ;ui__callbacks/left STA* }
%/I.CALLBACK.RIGHT? { ;ui__callbacks/right LDA* } %/I.CALLBACK.RIGHT! { ;ui__callbacks/right STA* }
%/I.CALLBACK.UP? { ;ui__callbacks/up LDA* } %/I.CALLBACK.UP! { ;ui__callbacks/up STA* }
%/I.CALLBACK.DOWN? { ;ui__callbacks/down LDA* } %/I.CALLBACK.DOWN! { ;ui__callbacks/down STA* }
%/I.CALLBACK.A? { ;ui__callbacks/A LDA* } %/I.CALLBACK.A! { ;ui__callbacks/A STA* }
%/I.CALLBACK.B? { ;ui__callbacks/B LDA* } %/I.CALLBACK.B! { ;ui__callbacks/B STA* }
%/I.CALLBACK.START? { ;ui__callbacks/start LDA* } %/I.CALLBACK.START! { ;ui__callbacks/start STA* }
%/I.CALLBACK.SELECT? { ;ui__callbacks/select LDA* } %/I.CALLBACK.SELECT! { ;ui__callbacks/select STA* }
%/I.CALLBACK.MOUSE1? { ;ui__callbacks/mouse1 LDA* } %/I.CALLBACK.MOUSE1! { ;ui__callbacks/mouse1 STA* }
%/I.CALLBACK.MOUSE2? { ;ui__callbacks/mouse2 LDA* } %/I.CALLBACK.MOUSE2! { ;ui__callbacks/mouse2 STA* }
%/I.CALLBACK.MOUSE3? { ;ui__callbacks/mouse3 LDA* } %/I.CALLBACK.MOUSE3! { ;ui__callbacks/mouse3 STA* }
( Convenience macros for setting the screen coordinates relative to center )
%CENTER_LEFT? { /I.CENTER.X? SWP* SUB* } %CENTER_LEFT! { CENTER_LEFT? /SCREEN.X! }
%CENTER_RIGHT? { /I.CENTER.X? ADD* } %CENTER_RIGHT! { CENTER_RIGHT? /SCREEN.X! }
%CENTER_UP? { /I.CENTER.Y? SWP* SUB* } %CENTER_UP! { CENTER_UP? /SCREEN.Y! }
%CENTER_DOWN? { /I.CENTER.Y? ADD* } %CENTER_DOWN! { CENTER_DOWN? /SCREEN.Y! }
( Draw all UI elements )
@ui__draw_all /I.NUM_ELEMENTS? #00 ( -- )
&loop EQUk ,&end JCN ( total index )
DUP ;ui__draw_single CALL ( total index )
INC ,&loop JMP ( total index )
&end POP* RETURN ( -- )
( Draw a single UI element by index )
@ui__draw_single ( index -- )
STHk /I.ACTIVE_ELEMENT? EQU ( active? | index )
#00 STHr DOUBLE* ;ui__callbacks/draw ADD* ( active? slot_addr* )
LDA* CALLRETURN ( active? )
( Call the callback for a single UI element by index, [ index -- ] )
@ui__press_inc ;ui__callbacks/inc ,__ui__call_callback JMP
@ui__press_dec ;ui__callbacks/dec ,__ui__call_callback JMP
@ui__press_go ;ui__callbacks/go ,__ui__call_callback JMP
( Calculate the real address of a callback and call )
@__ui__call_callback ( index callback_block_start_addr* )
ROT TO_SHORT DOUBLE ADD* LDA* CALL ( real_callback_addr* )
;ui__redraw_controls CALLRETURN ( -- )
( Register a separate callback for each user interface element.
Each of the following subroutines accepts a list of pairs of a control index
and a callback address, followed by the number of pairs that were provided.
For example: [ #00 ;func0 #01 ;func1 #04 ;func4 #03 ]
Draw callbacks MUST consume the 1-byte 'active?' bool that is passed to them.
Controller input callbacks (inc, dec, go) do not receive any data.
Callbacks SHOULD consume the return address on the return stack by calling
either RETURN or NORETURN.
Signature for each 'register' subroutine is: [index callback*]+ count -- )
@ui__register_draw_callbacks ;ui__callbacks/draw ,__ui__register_callbacks JMP
@ui__register_inc_callbacks ;ui__callbacks/inc ,__ui__register_callbacks JMP
@ui__register_dec_callbacks ;ui__callbacks/dec ,__ui__register_callbacks JMP
@ui__register_go_callbacks ;ui__callbacks/go ,__ui__register_callbacks JMP
@__ui__register_callbacks ( [index callback*]+ count block_addr* -- )
,&block_addr STR* ( [index callback*]+ count )
&loop ( [index callback*]+ count )
STH ROT DOUBLE TO_SHORT ( ... callback* offset* | count )
[ LIT* &block_addr $2 ] ADD* STA* ( ... | count )
STHr DEC DUP ,&loop JCN ( ... count )
POP RETURN ( -- )
( Register a single screen zone for each of multiple UI elements )
@ui__register_zones ( [index left* top* width* height*]+ count -- )
( Note: We decrement right* and bottom* because the bounds of the zone are inclusive )
&loop ( ... index left* top* width* height* count )
STH STH* STH* STH* STH* ( ... index | count height* width* top* left* )
TO_SHORT MUL8* ;ui__zones ADD* ( ... zone_left_addr* | count height* width* top* left* )
STHkr* ROTr* ADDr* DECr* STHr* ( ... zone_left_addr* left* right* | count height* top* )
STHkr* ADDr* DECr* STH* STH* ( ... zone_left_addr* left* | count bottom* top* right* )
OVR* STA* ADD2* ( ... zone_right_addr* | count bottom* top* right* )
STHr* OVR* STA* ADD2* ( ... zone_top_addr* | count bottom* top* )
STHr* OVR* STA* ADD2* ( ... zone_bottom_addr* | count bottom* )
STHr* SWP* STA* STHr ( ... count )
DEC DUP ,&loop JCN
POP RETURN
( Call to activate the declared user interface )
@ui__run_blank ( -- )
#0000
@ui__run ( active_element total_elements -- )
/I.NUM_ELEMENTS! DUP /I.ACTIVE_ELEMENT! /I.PREV_ELEMENT!
;ui__draw_all CALL
;ui__on_screen /SCREEN.VECTOR!
;ui__on_mouse /MOUSE.VECTOR!
;ui__on_controller /CONTROLLER.VECTOR!
( Clear both of the stacks, in case junk data has been left on them )
#0000 /SYSTEM.RST! /SYSTEM.WST! BRK
( Clears all of the callbacks and zones that were defined by the previous
screen, and wipes the foreground layer of the screen device. Call this
subroutine before declaring the UI for a new screen. )
@ui__clear
( Clear mouse button state, to prevent weird clicks when the new UI comes up )
#0000 DUP /I.MOUSE.PRESSED! /I.MOUSE.HELD! /I.MOUSE.RELEASED!
( Recalculate the center of the screen )
/SCREEN.WIDTH? HALVE* /I.CENTER.X! /SCREEN.HEIGHT? HALVE* /I.CENTER.Y!
;clear_foreground CALL
;ui__callbacks ;ui__callbacks/end ;&null_callback ,__ui__clear_memory_region JSR
;ui__callbacks/draw ;ui__callbacks/end ;&pop_null_callback ,__ui__clear_memory_region JSR
;ui__zones ;ui__zones/end #0000 ,__ui__clear_memory_region JMP
&pop_null_callback POP &null_callback RETURN
( Fill a region of memory with a repeated value. Address includes `start_addr`, but excludes `end_addr`. )
@__ui__clear_memory_region ( start_addr* end_addr* value* -- )
STH* SWP* ( end* addr* | val* )
&loop ( end* addr* | val* )
EQUk* ,&end JCN ( end* addr* | val* )
STHkr* OVR* STA* ( addr* )
ADD2* ,&loop JMP ( end* addr* | val* )
&end POP* POP* POPr* RETURN
( Mouse vector )
@ui__on_mouse ( -- )
( TODO: Add back in the mouse2 stuff )
/MOUSE.STATE? DUP /I.MOUSE.HELD? DUPk* ( held now prev now prev now prev )
EOR AND SWP SWP* EOR AND ( held released pressed )
/I.MOUSE.PRESSED! /I.MOUSE.RELEASED! /I.MOUSE.HELD!
,&mouse1_pressed JSR
,&mouse1_held JSR
,&mouse1_released JSR
,&process_cursor JSR
;ui__update_cursor_position CALL
BRK
&mouse1_pressed
/I.MOUSE.PRESSED? BITMASK_1 IF_NOT_MASK RETURN
;ui__press_go ;ui__call_on_hovered_element CALL
;ui__start_mouse1_drag CALL
#00 ;ui__callbacks/mouse1 LDA* CALLRETURN
&mouse1_held
/I.MOUSE.HELD? BITMASK_1 IF_NOT_MASK RETURN
,&return_if_cursor_not_moved JSR
#00 ;ui__callbacks/mouse1 LDA* CALLRETURN
&mouse1_released
/I.MOUSE.RELEASED? BITMASK_1 IF_NOT_MASK RETURN
#01 ;ui__callbacks/mouse1 LDA* CALLRETURN
&return_if_cursor_not_moved ( -- )
/I.CURSOR.X? /MOUSE.X? NEQ* ( diff_x? )
/I.CURSOR.Y? /MOUSE.Y? NEQ* ( diff_x? diff_y? )
ORA IF_FALSE NORETURN RETURN ( -- )
&process_cursor
,&return_if_cursor_not_moved JSR
;ui__redraw_cursor CALL
;ui__set_active_control ;ui__call_on_hovered_element CALLRETURN
@ui__redraw_cursor
;sprite/cursor /SCREEN.ADDR!
( Erase the mouse cursor from the previous mouse position )
/I.CURSOR.X? /SCREEN.X! /I.CURSOR.Y? /SCREEN.Y!
COL_00_FG /SCREEN.SPRITE!
( Draw the mouse cursor under the current mouse position )
/MOUSE.X? /SCREEN.X! /MOUSE.Y? /SCREEN.Y!
COL_T1_FG /SCREEN.SPRITE!
RETURN
@ui__start_mouse1_drag ( -- )
/I.MOUSE1.X /I.MOUSE1.Y ,_ui__store_cursor_position JMP
@ui__start_mouse2_drag ( -- )
/I.MOUSE2.X /I.MOUSE2.Y ,_ui__store_cursor_position JMP
@ui__start_mouse3_drag ( -- )
/I.MOUSE3.X /I.MOUSE3.Y ,_ui__store_cursor_position JMP
@ui__update_cursor_position ( -- )
/I.CURSOR.X /I.CURSOR.Y ( ,_ui__store_cursor_position JMP )
@_ui__store_cursor_position ( x_variable y_variable )
/MOUSE.Y? ROT STZ* /MOUSE.X? ROT STZ* RETURN
( The main controller logic, this handles all interactions with the declared
user interface )
@ui__on_controller
( Update the controller states )
/CONTROLLER.BUTTON? DUP /I.BUTTON.HELD? DUPk* ( held now prev now prev now prev )
EOR AND SWP SWP* EOR AND ( held released pressed )
/I.BUTTON.PRESSED! /I.BUTTON.RELEASED! /I.BUTTON.HELD!
/I.BUTTON.PRESSED? IF_FALSEY BRK
( mask user_callback_address ui_logic )
BUTTON_MASK_UP ;ui__callbacks/up ;&prev ,&call_if_pressed JSR
BUTTON_MASK_DOWN ;ui__callbacks/down ;&next ,&call_if_pressed JSR
BUTTON_MASK_LEFT ;ui__callbacks/left ;&dec ,&call_if_pressed JSR
BUTTON_MASK_RIGHT ;ui__callbacks/right ;&inc ,&call_if_pressed JSR
BUTTON_MASK_A ;ui__callbacks/A ;&go ,&call_if_pressed JSR
BUTTON_MASK_B ;ui__callbacks/B ;&null ,&call_if_pressed JSR
BUTTON_MASK_START ;ui__callbacks/start ;&null ,&call_if_pressed JSR
BUTTON_MASK_SELECT ;ui__callbacks/select ;&null ,&call_if_pressed JSR BRK
( Call two callbacks if the button matching this mask was pressed.
Calls a user-provided callback and a UI logic callback. )
&call_if_pressed ( mask user_callback* ui_callback* -- )
,&ui_callback STR* LDA* ,&user_callback STR* ( mask )
/I.BUTTON.PRESSED? IF_NOT_MASK RETURN ( -- )
/I.ACTIVE_ELEMENT? LIT* &ui_callback $2 CALL ( -- )
LIT* &user_callback $2 CALLRETURN ( -- )
&prev ( active -- )
IF_FALSEY RETURN /I.ACTIVE_ELEMENT DEC_Z RETURN
&next ( active -- )
INC /I.NUM_ELEMENTS? IF_EQUAL RETURN /I.ACTIVE_ELEMENT INC_Z RETURN
&dec ;ui__press_dec CALLRETURN
&inc ;ui__press_inc CALLRETURN
&go ;ui__press_go CALLRETURN
&null RETURN
( Redraw the active and previously-active controls, and set prev_active to active )
@ui__redraw_controls ( -- )
( Return early if no controls have been registered )
/I.NUM_ELEMENTS? ,&cont JCN RETURN &cont
/I.ACTIVE_ELEMENT? /I.PREV_ELEMENT? ( active prev_active )
;ui__draw_single CALL ( active // draw prev_active input )
DUP /I.PREV_ELEMENT! ( active )
;ui__draw_single CALLRETURN
( Update the active control and redraw prev and active controls )
@ui__set_active_control ( index -- )
DUP /I.ACTIVE_ELEMENT? NEQ ,&cont JCN POP RETURN &cont
/I.ACTIVE_ELEMENT! ;ui__redraw_controls CALLRETURN
( If there is a control under the mouse cursor, push the index of that
control to the stack and call the given routine. The index must be
consumed by the routine. )
@ui__call_on_hovered_element #00 ( func_addr* -- )
&loop ( f_addr* i )
/I.NUM_ELEMENTS? OVR GTH ,&cont JCN ( f_addr* i )
POP POP* RETURN ( // -- )
&cont ( f_addr* i )
DUP TO_SHORT MUL8* ( f_addr* i ix8* )
;ui__zones ADD* ( f_addr* i zone_left_addr* )
( Test horizontal bounds )
/I.CURSOR.X? OVR* LDA* LTH* STH ( f_addr* i zone_left_addr* | lth_left? )
#0002 ADD* ( f_addr* i zone_right_addr* | lth_left? )
/I.CURSOR.X? OVR* LDA* GTH* STHr ( f_addr* i zone_right_addr* gth_right? lth_left? )
ADD ,&no_match JCN #0002 ADD* ( f_addr* i zone_top_addr* )
( Test vertical bounds )
/I.CURSOR.Y? OVR* LDA* LTH* STH ( f_addr* i zone_top_addr* | lth_top? )
#0002 ADD* ( f_addr* i zone_bot_addr* )
/I.CURSOR.Y? OVR* LDA* GTH* STHr ( f_addr* i zone_top_addr* gth_bot? lth_top? )
ADD ,&no_match JCN POP* ,&match JMP ( // varies )
&no_match ( f_addr* i junk_addr* )
POP* INC ,&loop JMP ( f_addr* i )
&match ( f_addr* i )
ROT ROT GOTO ( i )
@ui__on_screen ( -- )
;&counter LDAk* INC* SWP* STA* BRK &counter $2 ( // increment the frame counter )
( Load the colour palette from the .theme file, returning 1 on success )
@ui__initialise_colour_palette ( -- success? )
( TODO: Implement .theme file loading )
PANIC
( Load a colour palette from an address in memory )
@ui__load_colour_palette ( colour_palette_addr* -- )
LDAk* /SYSTEM.RED! ADD2*
LDAk* /SYSTEM.GREEN! ADD2*
LDA* /SYSTEM.BLUE! RETURN

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.4 MiB

292
tungsten2.tal Normal file
View File

@ -0,0 +1,292 @@
~_instruction_renaming.tal
~_device_macros.tal
~_constants.tal
~_common_macros.tal
( ---------------------------------------------------------------------------- )
( G L O B A L V A R I A B L E S )
( Canvas origin in screen-space coords )
%/V.CANVAS.X { #00 } %/V.CANVAS.X? { #00 LDZ* } %/V.CANVAS.X! { #00 STZ* }
%/V.CANVAS.Y { #02 } %/V.CANVAS.Y? { #02 LDZ* } %/V.CANVAS.Y! { #02 STZ* }
( Canvas size )
%/V.CANVAS.WIDTH { #04 } %/V.CANVAS.WIDTH? { #04 LDZ* } %/V.CANVAS.WIDTH! { #04 STZ* }
%/V.CANVAS.HEIGHT { #06 } %/V.CANVAS.HEIGHT? { #06 LDZ* } %/V.CANVAS.HEIGHT! { #06 STZ* }
( Canvas colour palette )
|0008 @canvas_colour_palette
%/V.CANVAS.RED { #08 } %/V.CANVAS.RED? { #08 LDZ } %/V.CANVAS.RED! { #08 STZ }
%/V.CANVAS.GREEN { #0a } %/V.CANVAS.GREEN? { #0a LDZ } %/V.CANVAS.GREEN! { #0a STZ }
%/V.CANVAS.BLUE { #0c } %/V.CANVAS.BLUE? { #0c LDZ } %/V.CANVAS.BLUE! { #0c STZ }
( The currently active drawing tool. )
%/V.ACTIVE_TOOL { #0e } %/V.ACTIVE_TOOL? { #0e LDZ } %/V.ACTIVE_TOOL! { #0e STZ }
%TOOL_COUNT? { #05 }
( ---------------------------------------------------------------------------- )
( P R O G R A M S T A R T )
|0100
#0080 /V.CANVAS.WIDTH! #0060 /V.CANVAS.HEIGHT! #04 /V.ACTIVE_TOOL!
;default_colour_palette ;ui__load_colour_palette CALL
;ui__clear CALL
;recenter_canvas CALL
;canvas_screen GOTO
~_user_interface_framework.tal
( ---------------------------------------------------------------------------- )
( P R O G R A M S C R E E N S )
@canvas_screen
;ui__clear CALL
;draw_canvas CALL
;canvas_screen__tool /I.CALLBACK.MOUSE1!
;canvas_screen__B /I.CALLBACK.B!
;ui__run_blank GOTO
@canvas_screen__B NORETURN ;tool_screen GOTO
@canvas_screen__tool
( Dispatch control to the routine of the active tool )
/V.ACTIVE_TOOL? MUL4 JMP
;&pan GOTO ;&brush1 GOTO ;&brush2 GOTO ;&brush3 GOTO ;&line GOTO
&pan ,&pan_released JCN
( Erase old indicator rectangle )
/V.CANVAS.X? /SCREEN.X! /V.CANVAS.Y? /SCREEN.Y!
COL_0_FG /V.CANVAS.WIDTH? /V.CANVAS.HEIGHT? ;draw_rect_outline CALL
( Move canvas origin coordinates )
/MOUSE.X? /I.CURSOR.X? SUB* /V.CANVAS.X? ADD* /V.CANVAS.X!
/MOUSE.Y? /I.CURSOR.Y? SUB* /V.CANVAS.Y? ADD* /V.CANVAS.Y!
( Clamp canvas position so that canvas is always on-screen )
/V.CANVAS.X? /V.CANVAS.WIDTH? /SCREEN.WIDTH? ,&_pan_clamp JSR /V.CANVAS.X!
/V.CANVAS.Y? /V.CANVAS.HEIGHT? /SCREEN.HEIGHT? ,&_pan_clamp JSR /V.CANVAS.Y!
( Draw new indicator rectangle )
/V.CANVAS.X? /SCREEN.X! /V.CANVAS.Y? /SCREEN.Y!
COL_3_FG /V.CANVAS.WIDTH? /V.CANVAS.HEIGHT? ;draw_rect_outline CALLRETURN
&pan_released
;clear_foreground CALL
;draw_canvas CALLRETURN
&_pan_clamp ( start* len* screen* -- start* )
( Set up the stack. `left` is margin-size, `right` is screen-margin. )
#0010 ROTk* SUB* STH* POP* SUB* STH* ( start* len* | left* right* )
POP* STHr* OVR* STHr* ( start* right* start* left* )
( Check if start is out of left or right bounds, returning the bound if true )
SWPk* ;lth_signed* CALL ,&p_skip_l JCN ( start* right* start* left* )
NIP* NIP* NIP* RETURN ( // left* )
&p_skip_l POP* POP* ( start* right* )
SWPk* ;gth_signed* CALL ,&p_skip_r JCN ( start* right* )
NIP* RETURN ( // right* )
&p_skip_r POP* ( start* )
RETURN
&line ,&line_released JCN
/I.MOUSE1.X? /I.MOUSE1.Y? /I.CURSOR.X? /I.CURSOR.Y?
COL_0_FG ;get_callback_to_draw_pixel CALL ;draw_line CALL
/I.MOUSE1.X? /I.MOUSE1.Y? /MOUSE.X? /MOUSE.Y?
COL_3_FG ;get_callback_to_draw_pixel CALL ;draw_line CALLRETURN
&line_released
/I.MOUSE1.X? /I.MOUSE1.Y? /I.CURSOR.X? /I.CURSOR.Y?
COL_3 ;get_callback_to_commit_pixel CALL ;draw_line CALL
;draw_canvas CALLRETURN
&brush1 COL_1 ,&brush_colour STR ,&_brush JMP
&brush2 COL_2 ,&brush_colour STR ,&_brush JMP
&brush3 COL_3 ,&brush_colour STR ,&_brush JMP
&_brush ,&_brush_released JCN
/I.MOUSE1.X? /I.MOUSE1.Y? /MOUSE.X? /MOUSE.Y?
[ LIT &brush_colour $1 ] ;get_callback_to_commit_pixel CALL ;draw_line CALL
;ui__start_mouse1_drag CALLRETURN
&_brush_released
;draw_canvas CALLRETURN
@tool_screen
;ui__clear CALL
( Draw non-interactive elements )
COL_0 ;fill_screen_with_colour CALL
( Register inc/dec callbacks )
#00 ;tool_screen__dec__palette
#01 ;ui__register_dec_callbacks CALL
( Register draw callbacks )
#00 ;tool_screen__draw__palette
#01 ;ui__register_draw_callbacks CALL
( Register raw input callbacks )
;tool_screen__B /I.CALLBACK.B!
( Finish callback registration )
#0001 ;ui__run GOTO
@tool_screen__B NORETURN ;canvas_screen GOTO
@tool_screen__dec__palette
/V.ACTIVE_TOOL? INC TOOL_COUNT? MOD /V.ACTIVE_TOOL! RETURN
@tool_screen__draw__palette
;draw_tool_palette_background CALL
TOOL_COUNT? #00 ( total i )
&loop
EQUk ,&end JCN
DUPk /V.ACTIVE_TOOL? EQU
;draw_tool_palette_icon CALL
INC ,&loop JMP
&end
POP* RETURN
( Draw a single tool icon )
@draw_tool_palette_icon ( index active? )
LITr 00 STHk* POP LITr 00 STH ( | index* active index* )
#001a CENTER_UP! /SCREEN.WIDTH? ( s_width* | index* active index* )
,get_tool_palette_width JSR ( s_width* width* | index* active index* )
SUB* HALVE* ADD2* ( zone_0_x* | index* active index* )
STHr* #001a MUL* ADD* /SCREEN.X! ( | index* active )
STHr STHkr /V.ACTIVE_TOOL? EQU ( active? current_tool? | index* )
COL_0 COL_2 CHOOSE COL_3 CHOOSE ( colour | index* )
#0017 DUP* ;draw_capsule_smooth CALL ( | index* )
COL_T1 ;tool_icon STHr* #0048 MUL* ADD* ( colour 3x3_sprite_addr* )
;draw_3x3_sprite CALLRETURN
( Draw a large capsule to use as a background for the tool icons )
@draw_tool_palette_background ( -- )
#001c CENTER_UP! COL_1 ( colour -- )
,get_tool_palette_width JSR ( colour width* )
/SCREEN.WIDTH? OVR* SUB* HALVE* ( colour width* bg_x* )
/SCREEN.X! #001b ;draw_capsule CALLRETURN ( -- )
( Calculates the width of the tool palette from the number of icons )
@get_tool_palette_width ( -- width* )
#00 TOOL_COUNT? #001a MUL* INC* RETURN ( width* )
( Draw a 1-bit 3x3 sprite )
@draw_3x3_sprite ( colour sprite_addr* -- )
/SCREEN.ADDR! #26 /SCREEN.AUTO!
/SCREEN.SPRITE DEOk DEOk DEO
#00 /SCREEN.AUTO! #0018 MOVE_UP
RETURN
( Erase a foreground pixel, draw a background pixel, and set a canvas pixel )
@get_callback_to_commit_pixel ( colour -- callback* )
DUP ,&colour STR ,get_callback_to_set_pixel/colour STR ;&callback RETURN
&callback ( x* y* -- )
SWPk* /SCREEN.X! /SCREEN.Y!
COL_0_FG /SCREEN.PIXEL! [ LIT &colour $1 ] /SCREEN.PIXEL!
SWP* /V.CANVAS.X? SUB* SWP* /V.CANVAS.Y? SUB*
,get_callback_to_set_pixel/callback JMP
@get_callback_to_draw_pixel ( colour -- callback* )
,&colour STR ;&callback RETURN
&callback ( x* y* -- )
/SCREEN.Y! /SCREEN.X! [ LIT &colour $1 ] /SCREEN.PIXEL! RETURN
@get_callback_to_set_pixel ( colour -- callback* )
,&colour STR ;&callback RETURN
&callback ( x* y* -- )
[ LIT* 00 &colour $1 ] ROT* ROT* ;set_canvas_pixel CALL POP RETURN
@is_point_on_canvas? ( x* y* -- in_bounds? )
/V.CANVAS.HEIGHT? LTH* STH /V.CANVAS.WIDTH? LTH* STHr AND RETURN
@set_canvas_pixel ( colour x* y* -- )
OVR* OVR* ;is_point_on_canvas? CALL ,&cont JCN
POP* POP* POP RETURN &cont
,get_mask_and_address JSR ( colour mask row_addr* )
STH* STHk* SWPr* LDAkr STHr ( colour mask row | colour mask row_addr* )
( Test bit 1 of colour )
ROT #01 AND ,apply_mask JSR ( row_modified | colour mask row_addr* )
STHkr* STA SWPr* STHr* ( colour mask | row_addr* )
( Change row_addr to second row )
LITr* 0008 ADDr* LDAkr STHr ( colour mask row | row_addr* )
( Test bit 2 of colour )
ROT #02 AND ,apply_mask JSR ( row_modified | row_addr* )
STHr* STA RETURN ( -- )
( Set each one-masked bit in `row` to `value?` )
@apply_mask ( mask row value? -- row )
,&set_bits_to_on JCN #ff ROT SUB AND DUP &set_bits_to_on ORA RETURN
( Return the memory address and bitmask for this canvas pixel )
@get_mask_and_address ( x* y* -- mask row_address* )
OVR* OVR* ,get_sprite_address JSR ( x* y* sprite_addr* )
SWP* MOD8* ADD* ( x* row_addr* )
STH* ,get_mask JSR STHr* RETURN ( mask row_address* )
( Return the memory address for the 2-bit sprite containing this canvas pixel )
@get_sprite_address ( x* y* -- sprite_address* )
SWP* DIV8* SWP* DIV8* ( spritex* spritey* )
/V.CANVAS.WIDTH? CEIL8DIV8* ( sprite_x* sprite_y* sprite_width* )
MUL* ADD* MUL16* ( sprite_offset* )
;canvas_buffer ADD* RETURN ( sprite_addr* )
( Get a bitmask for the `x%8`th little-endian bit )
@get_mask ( x* -- mask )
NIP MOD8 #0107 ROT SUB SHL4 SFT RETURN
@gth_signed* SWP*
@lth_signed* #8000 STHk* ADD* SWP* STHr* ADD* GTH* RETURN
( Recalculate the canvas position in order to center the canvas on the screen )
@recenter_canvas ( -- )
/I.CENTER.X? /V.CANVAS.WIDTH? HALVE* SUB* /V.CANVAS.X!
/I.CENTER.Y? /V.CANVAS.HEIGHT? HALVE* SUB* /V.CANVAS.Y!
RETURN
( Render the canvas to the screen )
@draw_canvas ( -- )
COL_20 ;fill_screen_with_colour CALL ( -- )
#05 /SCREEN.AUTO! ( -- )
/V.CANVAS.Y? /SCREEN.Y! ( -- )
;canvas_buffer /SCREEN.ADDR! ( -- )
/V.CANVAS.HEIGHT? CEIL8DIV8* ( sprite_height* )
&new_line ( sprite_height* )
/V.CANVAS.X? /SCREEN.X! ( sprite_height* )
/V.CANVAS.WIDTH? CEIL8DIV8* ( sprite_height* sprite_width* )
&loop ( sprite_height* sprite_width* )
COL_0123_2B /SCREEN.SPRITE! ( sprite_height* sprite_width* )
DEC* DUP* GTH0* ,&loop JCN ( sprite_height* sprite_width* )
( Move down to the next sprite row )
POP* DEC* #0008 MOVE_DOWN ( sprite_height* )
DUP* ADD ,&new_line JCN ( sprite_height* )
&end ( 0* )
/SCREEN.AUTO! POP RETURN ( -- )
~_fill_screen.tal
~_draw_line.tal
~_draw_rect.tal
~_draw_shapes.tal
@default_colour_palette
1d9e 161a 1010
@tool_icon
&pan 0000 0000 0000 0000 0000 0010 387c d610 0000 0000 0000 0000
0206 0c1f 0c06 0200 1010 10ff 1010 1010 80c0 60f0 60c0 8000
0000 0000 0000 0000 d67c 3810 0000 0000 0000 0000 0000 0000
&brush 0000 0000 0000 0000 0000 0814 1c1c 1c7f 0000 0000 0000 0000
0000 0000 0100 0000 7f00 7dff fe00 0008 0000 0000 0000 0000
0000 0000 0000 0000 1808 081c 0000 0000 0000 0000 0000 0000
&brush_2 0000 0000 0000 0000 0000 0814 1c1c 1c7f 0000 0000 0000 0000
0000 0000 0100 0000 7f00 7dff fe00 0018 0000 0000 0000 0000
0000 0000 0000 0000 2408 103c 0000 0000 0000 0000 0000 0000
&brush_3 0000 0000 0000 0000 0000 0814 1c1c 1c7f 0000 0000 0000 0000
0000 0000 0100 0000 7f00 7dff fe00 0018 0000 0000 0000 0000
0000 0000 0000 0000 2408 2418 0000 0000 0000 0000 0000 0000
&line 0000 0000 0000 0000 0000 0000 0001 0001 0000 0040 40f0 4040
0000 0000 0000 0005 0204 0810 2040 8000 0000 0000 0000 0000
041f 0404 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000
@sprite
&cursor 80c0 e0f0 f8e0 1000
&blank 0000 0000 0000 0000
~_user_interface_callbacks.tal
@canvas_buffer