( launcher )

%+  { ADD } %-   { SUB }  %*  { MUL }  %/  { DIV }
%<  { LTH } %>   { GTH }  %=  { EQU }  %!  { NEQ }
%++ { ADD2 } %-- { SUB2 } %** { MUL2 } %// { DIV2 }
%<< { LTH2 } %>> { GTH2 } %== { EQU2 } %!! { NEQ2 }

%AUTO-X      { #01 .Screen/auto DEO }
%AUTO-Y      { #02 .Screen/auto DEO }
%AUTO-YADDR  { #06 .Screen/auto DEO }

%HALT   { #010f DEO }
%EMIT   { #18 DEO }
%PRINT  { ;print-str JSR2 #0a EMIT }
%DEBUG  { ;print-hex/byte JSR2 #0a EMIT }
%DEBUG2 { ;print-hex JSR2 #0a EMIT }

%MODALW { #0024 }
%MODALH { #0009 }

%RTN { JMP2r }
%2//  { #01 SFT2 }
%8**  { #30 SFT2 }

%EADDR { #fd04 }
%ECODE { #fd06 }

( devices )

|00 @System     &vector $2 &wst      $1 &rst    $1 &eaddr  $2 &ecode  $1 &pad     $1 &r       $2 &g      $2 &b     $2 &debug  $1 &halt $1
|20 @Screen     &vector $2 &width    $2 &height $2 &auto   $1 &pad $1 &x      $2 &y      $2 &addr $2 &pixel $1 &sprite $1

( variables )

|0000

@center
	&x $2 &y $2
@modal
	&x $2 &y $2

( init )

|0100 ( -> )
	
	.Screen/width DEI2 2// 
		DUP2 .center/x STZ2
		MODALW #31 SFT2 -- .modal/x STZ2
	.Screen/height DEI2 2// 
		DUP2 .center/y STZ2
		MODALH #31 SFT2 -- .modal/y STZ2

	( vectors )
	;on-error .System/vector DEO2
	;on-frame .Screen/vector DEO2

BRK

@on-frame ( -> )

	;draw-cross JSR2
	;draw-stacks JSR2

BRK

@on-error ( -> )

	( background )
	#00 .Screen/auto DEO
	;bg-icn .Screen/addr DEO2
	MODALH #0000
	&ver
		DUP2 8** .modal/y LDZ2 ++ .Screen/y DEO2
		MODALW #0000
		&hor
			DUP2 8** .modal/x LDZ2 ++ .Screen/x DEO2
			#42 .Screen/sprite DEO
			INC2 GTH2k ,&hor JCN
		POP2 POP2
		INC2 GTH2k ,&ver JCN
	POP2 POP2

	( corners )
	;corner-icn .Screen/addr DEO2
	.modal/x LDZ2 .Screen/x DEO2
	.modal/y LDZ2 .Screen/y DEO2
	#42 .Screen/sprite DEO
	.modal/x LDZ2 MODALW #0001 -- 8** ++ .Screen/x DEO2
	#52 .Screen/sprite DEO

	.modal/y LDZ2 MODALH #0001 -- 8** ++ .Screen/y DEO2
	#72 .Screen/sprite DEO

	.modal/x LDZ2 .Screen/x DEO2
	#62 .Screen/sprite DEO

	( text )
	.modal/x LDZ2 #0010 ++ .Screen/x DEO2
	.modal/y LDZ2 #0010 ++ .Screen/y DEO2
	;error-txts/0 #4f ;draw-str JSR2

	;at-txt #4f ;draw-str JSR2

	EADDR LDA2 #47 ;draw-short JSR2

	#0000 EADDR STA2

BRK

@draw-stacks ( -- )

	AUTO-YADDR
	#0010 #0000 
	&wst
		( working stack )
		#0010 .Screen/y DEO2
		DUP2 #0018 ** #0010 ++ .Screen/x DEO2
		DUP #fe00 LDA ( ptr ) EQU #41 + STH
		DUP2 #fe01 ++ LDA STHr ;draw-byte JSR2
		( return stack )
		#0028 .Screen/y DEO2
		DUP2 #0018 ** #0010 ++ .Screen/x DEO2
		DUP #ff00 LDA ( ptr ) EQU #41 + STH
		DUP2 #ff01 ++ LDA STHr ;draw-byte JSR2
		INC2 GTH2k ,&wst JCN
	POP2 POP2

RTN

@draw-cross ( -- )

	( ver )
	AUTO-Y
	#0000 .Screen/y DEO2
	.center/x LDZ2 .Screen/x DEO2
	.Screen/height DEI2 #0000
	&ver
		#43 .Screen/pixel DEO
		.Screen/y DEI2k INC2 ROT DEO2
		INC2 GTH2k ,&ver JCN
	POP2 POP2

	( hor )
	AUTO-X
	#0000 .Screen/x DEO2
	.center/y LDZ2 .Screen/y DEO2
	.Screen/width DEI2 #0000
	&hor
		#43 .Screen/pixel DEO
		.Screen/x DEI2k INC2 ROT DEO2
		INC2 GTH2k ,&hor JCN
	POP2 POP2

RTN

@draw-str ( text* color -- )

	AUTO-YADDR
	STH
	&while
		LDAk STHkr ,draw-char JSR
		INC2 LDAk ,&while JCN
	POP2
	POPr

RTN

@draw-short ( short* color -- )

	STH SWP STHkr ,draw-byte JSR
	STHr ,draw-byte JSR

RTN

@draw-byte ( byte color -- )

	STH
	DUP #04 SFT ,&parse JSR STHkr ,draw-char JSR
	#0f AND ,&parse JSR STHr ,draw-char JSR

RTN
	&parse ( byte -- char ) DUP #09 GTH ,&above JCN #30 ADD JMP2r 
	&above #57 ADD JMP2r

@draw-char ( char color -- )

	SWP
	[ #20 - #00 SWP #40 SFT2 ;font ++ ] .Screen/addr DEO2
	.Screen/sprite DEOk DEO
	.Screen/x DEI2k #0008 ++ ROT DEO2
	.Screen/y DEI2k #0010 -- ROT DEO2

JMP2r

@print-hex ( value* -- )

	SWP ,&byte JSR 
	&byte ( byte -- )
		STHk #04 SFT ,&parse JSR #18 DEO
		STHr #0f AND ,&parse JSR #18 DEO
	JMP2r
	&parse ( byte -- char ) DUP #09 GTH ,&above JCN #30 ADD JMP2r 
	&above #57 ADD JMP2r

JMP2r

@error-txts
	&0 "Working-stack 20 "underflow $1
	&1 "Return-stack 20 "underflow $1
	&2 "Working-stack 20 "overflow $1
	&3 "Return-stack 20 "overflow $1
	&4 "Working-stack 20 "division 20 "by 20 "zero $1
	&5 "Return-stack 20 "division 20 "by 20 "zero $1
@at-txt
	', 20 "at 20 $1

@bg-icn
	ffff ffff ffff ffff
@corner-icn
	1f7f 7fff ffff ffff

~projects/assets/msx01x02.tal