~rabbits/adelie

a87513914923a4211d3dca79cea6283d51801241 — Devine Lu Linvega 9 days ago fd691e9
Removed uncalls
1 files changed, 111 insertions(+), 109 deletions(-)

M src/adelie.tal
M src/adelie.tal => src/adelie.tal +111 -109
@@ 46,7 46,7 @@
	#0300 .Screen/width DEO2 ( 768 )
	#01c0 .Screen/height DEO2 ( 448 )

	;load-theme JSR2
	load-theme

	( vectors )
	;on-console .Console/vector DEO2


@@ 73,32 73,32 @@ BRK
	LIT2r :src
	( read source )
	.Console/read DEI
	DUP #20 LTH OVR #7f GTH ORA ,&end JCN
	STH2kr ;slen JSR2 #003f GTH2 ,&end JCN
		STH2r ;sput JSR2 BRK
	DUP #20 LTH OVR #7f GTH ORA ?&end
	STH2kr slen #003f GTH2 ?&end
		STH2r sput BRK
		&end
	POP

	STH2r ;start JSR2
	STH2r start

BRK

@on-screen ( -> )

	.src LDZ #00 NEQ ,&has-slides JCN
		;errors/empty ;pstr JSR2
	.src LDZ #00 NEQ ?&has-slides
		;errors/empty pstr
		( halt ) #010f DEO
		&has-slides

	.slideshow/wait LDZ INC ,&has-timer JCN
	.slideshow/wait LDZ INC ?&has-timer
		BRK
		&has-timer

	.slideshow/wait LDZk #01 SUB STHk SWP STZ

	STHr INC ,&no-end JCN
	STHr INC ?&no-end
		#00 .slideshow/stop STZ
		;next-slide JSR2
		next-slide
		&no-end

BRK


@@ 106,13 106,13 @@ BRK
@on-button ( -> )

	.Controller/button DEI
	DUP #00 EQU ,&no-button JCN
	DUP #01 NEQ ,&no-a JCN ;next-slide JSR2 &no-a
	DUP #02 NEQ ,&no-b JCN ;prev-slide JSR2 &no-b
	DUP #04 NEQ ,&no-s JCN ;toggle-link JSR2 &no-s
	DUP #08 NEQ ,&no-S JCN ;restart JSR2 &no-S
	DUP #40 NEQ ,&no-l JCN ;prev-slide JSR2 &no-l
	DUP #80 NEQ ,&no-r JCN ;next-slide JSR2 &no-r
	DUP #00 EQU ?&no-button
	DUP #01 NEQ ?&no-a next-slide &no-a
	DUP #02 NEQ ?&no-b prev-slide &no-b
	DUP #04 NEQ ?&no-s toggle-link &no-s
	DUP #08 NEQ ?&no-S restart &no-S
	DUP #40 NEQ ?&no-l prev-slide &no-l
	DUP #80 NEQ ?&no-r next-slide &no-r
	&no-button
	POP



@@ 120,34 120,34 @@ BRK

@on-mouse ( -> )

	#40 ;draw-cursor JSR2
	#40 draw-cursor
	( record mouse positions )
	.Mouse/x DEI2 .cursor/x STZ2
	.Mouse/y DEI2 .cursor/y STZ2
	( draw new cursor )
	;cursor-icn .Screen/addr DEO2
	#42 .Mouse/state DEI #00 NEQ ADD ;draw-cursor JSR2
	#42 .Mouse/state DEI #00 NEQ ADD draw-cursor

	.Mouse/state DEI
	DUP #00 EQU ,&no-touch JCN
	DUP #00 EQU ?&no-touch
	( left-click )
	DUP #01 NEQ ,&no-mouse1 JCN
		.Mouse/x DEI2 .Mouse/y DEI2 ;find-link JSR2
		ORAk #00 EQU ,&no-link JCN
			;find-slide JSR2 ;select-slide JSR2
	DUP #01 NEQ ?&no-mouse1
		.Mouse/x DEI2 .Mouse/y DEI2 find-link
		ORAk #00 EQU ?&no-link
			find-slide select-slide
			,&no-touch JMP
			&no-link
		POP2
		;next-slide JSR2 
		next-slide 
		&no-mouse1
	( middle-click )
	DUP #02 NEQ ,&no-mouse2 JCN
		;draw-marker JSR2
	DUP #02 NEQ ?&no-mouse2
		draw-marker
		,&no-touch JMP
		&no-mouse2
	( right-click )
	DUP #04 NEQ ,&no-mouse3 JCN
		;prev-slide JSR2 
	DUP #04 NEQ ?&no-mouse3
		prev-slide 
		&no-mouse3
	&no-touch
	POP


@@ 157,11 157,12 @@ BRK
BRK

(
@|operations )

@operations )

@restart ( -- )

	;slideshow #0100 ;slideshow SUB2 ;mclr JSR2
	;slideshow #0100 ;slideshow SUB2 mclr

	;src



@@ 172,27 173,27 @@ BRK
	;slides .File/read DEO2

	( catch overflowing file )
	.File/success DEI2 STH2r NEQ2 ,&file-ok JCN
		;errors/file-max ;pstr JSR2 #010f DEO BRK
	.File/success DEI2 STH2r NEQ2 ?&file-ok
		;errors/file-max pstr #010f DEO BRK
		&file-ok

	( replace 0a with 00 )
	;slides
	&while
		LDAk #0a NEQ ,&no-lb JCN
		LDAk #0a NEQ ?&no-lb
			DUP2 #00 ROT ROT STA
			&no-lb
		INC2 LDAk ,&while JCN
		INC2 LDAk ?&while
	POP2

	( parse )
	;slides STH2k .File/success DEI2 ADD2 STH2r
	&parse-loop
		DUP2 ;op-txt/name SWP2 ;sseg JSR2 #01 NEQ ,&skip JCN
			DUP2 ;add-jump JSR2
		DUP2 ;op-txt/name SWP2 sseg #01 NEQ ?&skip
			DUP2 add-jump
			&skip
		;scap JSR2
		INC2 GTH2k ,&parse-loop JCN
		scap
		INC2 GTH2k ?&parse-loop
	POP2
	.slideshow/length LDZ DUP ADD .slideshow/jumps ADD STZ2



@@ 200,8 201,8 @@ BRK
	.slideshow/jumps LDZ2 ;slides
	&loop
		[ DUP2 ;find-op JSR2 ] JSR2
		;scap JSR2
		INC2 GTH2k ,&loop JCN
		scap
		INC2 GTH2k ?&loop
	POP2 POP2

	( select first )


@@ 214,12 215,12 @@ JMP2

@prev-slide ( -- )

	.slideshow/stop LDZ ,&skip JCN
	.slideshow/stop LDZ ?&skip
	.slideshow/selection LDZ
	DUP ,&continue JCN
	DUP ?&continue
		POP JMP2r
		&continue
	#01 SUB ;select-slide JSR2
	#01 SUB select-slide
	&skip
	#40 ;draw-cursor ( .. )



@@ 227,13 228,13 @@ JMP2

@next-slide ( -- )

	.slideshow/stop LDZ ,&skip JCN
	.slideshow/stop LDZ ?&skip

	.slideshow/selection LDZ
	DUP .slideshow/length LDZ #01 SUB LTH ,&continue JCN
	DUP .slideshow/length LDZ #01 SUB LTH ?&continue
		POP JMP2r
		&continue
	INC ;select-slide JSR2
	INC select-slide
	&skip
	#40 ;draw-cursor ( .. )



@@ 251,7 252,7 @@ JMP2
@select-slide ( id -- )

	( missing slide )
	INCk ,&continue JCN
	INCk ?&continue
		POP JMP2r
		&continue



@@ 261,7 262,7 @@ JMP2
	STHk

	( clear links )
	;links/length #0051 ;mclr JSR2
	;links/length #0051 mclr

	( get addr )
	DUP ADD .slideshow/jumps ADD LDZ2


@@ 272,8 273,8 @@ JMP2
	SWP2
	&loop
		[ DUP2 ;find-op JSR2 ] JSR2
		;scap JSR2
		INC2 GTH2k ,&loop JCN
		scap
		INC2 GTH2k ?&loop
	POP2 POP2

JMP2r


@@ 283,8 284,8 @@ JMP2r
	STH2
	.slideshow/length LDZ #00
	&loop
		DUPk ADD .slideshow/jumps ADD LDZ2 #0005 ADD2 STH2kr ;scmp JSR2 ,&found JCN
		INC GTHk ,&loop JCN
		DUPk ADD .slideshow/jumps ADD LDZ2 #0005 ADD2 STH2kr scmp ?&found
		INC GTHk ?&loop
	POP2
	POP2r
	#ff


@@ 296,12 297,12 @@ JMP2r

	,&y STR2 ,&x STR2
	.links/length LDZ #00
	OVR #00 EQU ,&skip JCN
	OVR #00 EQU ?&skip
	&loop
		STHk
		[ LIT2 &x $2 ] [ LIT2 &y $2 ] STHr #0a MUL .links/data ADD
			;within-rect JSR2 ,&found JCN
		INC GTHk ,&loop JCN
			within-rect ?&found
		INC GTHk ?&loop
	&skip
	POP2
	#0000


@@ 314,10 315,10 @@ JMP2r
	STH2
	#0f00
	&loop
		#00 OVRk ADD2 ;op-tbl ADD2 LDA2 STH2kr ;sseg JSR2 #01 NEQ ,&continue JCN
		#00 OVRk ADD2 ;op-tbl ADD2 LDA2 STH2kr ;sseg JSR2 #01 NEQ ?&continue
			NIP ,&end JMP
			&continue
		INC GTHk ,&loop JCN
		INC GTHk ?&loop
	POP2
	#00
	&end


@@ 329,11 330,11 @@ JMP2r
@within-rect ( x* y* rect -- flag )

	STH
	( y LTH rect.y1 ) DUP2 STHkr INC2 INC2 LDZ2 LTH2 ,&skip JCN
	( y GTH rect.y2 ) DUP2 STHkr #06 ADD LDZ2 GTH2 ,&skip JCN
	( y LTH rect.y1 ) DUP2 STHkr INC2 INC2 LDZ2 LTH2 ?&skip
	( y GTH rect.y2 ) DUP2 STHkr #06 ADD LDZ2 GTH2 ?&skip
	SWP2
	( x LTH rect.x1 ) DUP2 STHkr LDZ2 LTH2 ,&skip JCN
	( x GTH rect.x2 ) DUP2 STHkr #04 ADD LDZ2 GTH2 ,&skip JCN
	( x LTH rect.x1 ) DUP2 STHkr LDZ2 LTH2 ?&skip
	( x GTH rect.x2 ) DUP2 STHkr #04 ADD LDZ2 GTH2 ?&skip
	POP2 POP2 POPr
	#01
JMP2r


@@ 345,7 346,7 @@ JMP2r

@add-jump ( addr* -- )

	.slideshow/length LDZ ( max jumps ) #40 NEQ ,&continue JCN
	.slideshow/length LDZ ( max jumps ) #40 NEQ ?&continue
		;errors/jumps-max ;pstr JMP2
		&continue



@@ 356,32 357,33 @@ JMP2r

@add-link ( addr* -- )

	.links/length LDZ ( max links ) #08 NEQ ,&continue JCN
	.links/length LDZ ( max links ) #08 NEQ ?&continue
		;errors/links-max ;pstr ( .. )
		&continue

	;links/data [ #00 .links/length LDZ #0a MUL ] ADD2 #000a ;mcpy JSR2
	;links/data [ #00 .links/length LDZ #0a MUL ] ADD2 #000a mcpy
	.links/length LDZ INC .links/length STZ

JMP2r

@read-size ( 00x00* -- w h )

	INC2k INC2 INC2 ;shex JSR2 STH
	;shex JSR2 STHr
	INC2k INC2 INC2 shex STH
	shex STHr

JMP2r

(

@|operations )

@op-name ( addr* -- addr* )

	.slideshow/selection LDZ ;phex/b JSR2
	.slideshow/selection LDZ phex/b
	LIT "/ #18 DEO
	.slideshow/length LDZ #01 SUB ;phex/b JSR2
	.slideshow/length LDZ #01 SUB phex/b
	#2018 DEO
	DUP2 #0005 ADD2 ;pstr JSR2 #0a18 DEO
	DUP2 #0005 ADD2 pstr #0a18 DEO

JMP2r



@@ 392,7 394,7 @@ JMP2r
	.pen/x LDZ2 .Screen/x DEO2
	.pen/y LDZ2 .Screen/y DEO2

	DUP2 ;scap JSR2 #0004 SUB2 ;&tga-ext ;scmp JSR2 ;&tga JCN2
	DUP2 scap #0004 SUB2 ;&tga-ext scmp ?&tga

	DUP2 ;draw-icn ( .. )



@@ 403,18 405,18 @@ JMP2
@op-goto ( addr* -- addr* )

	#0005 ADD2
	DUP2 ;shex JSR2 #00 SWP #30 SFT2 .pen/x STZ2
	DUP2 shex #00 SWP #30 SFT2 .pen/x STZ2
	#0003 ADD2
	DUP2 ;shex JSR2 #00 SWP #30 SFT2 .pen/y STZ2
	DUP2 shex #00 SWP #30 SFT2 .pen/y STZ2

JMP2r

@op-move ( addr* -- addr* )

	#0005 ADD2
	DUP2 ;shex JSR2 #00 SWP #30 SFT2 .pen/x LDZ2 ADD2 .pen/x STZ2
	DUP2 shex #00 SWP #30 SFT2 .pen/x LDZ2 ADD2 .pen/x STZ2
	#0003 ADD2
	DUP2 ;shex JSR2 #00 SWP #30 SFT2 .pen/y LDZ2 ADD2 .pen/y STZ2
	DUP2 shex #00 SWP #30 SFT2 .pen/y LDZ2 ADD2 .pen/y STZ2

JMP2r



@@ 443,7 445,7 @@ JMP2
@op-mode ( addr* -- addr* )

	#0005 ADD2
	DUP2 ;shex JSR2 .slideshow/mode STZ
	DUP2 shex .slideshow/mode STZ

JMP2r



@@ 453,9 455,9 @@ JMP2r
	STH2k
	#0800
	&loop
		#00 OVR #03 MUL STH2kr ADD2 ;shex JSR2 STH
		#00 OVR #03 MUL STH2kr ADD2 shex STH
		#00 OVR ;patt-icn ADD2 STHr ROT ROT STA
		INC GTHk ,&loop JCN
		INC GTHk ?&loop
	POP2
	POP2r



@@ 467,11 469,11 @@ JMP2r
	.pen/y LDZ2 .Screen/y DEO2

	#0005 ADD2
	DUP2 ;shex JSR2 STH
	DUP2 shex STH
	#0003 ADD2
	DUP2 ;shex JSR2 STH
	DUP2 shex STH
	#0003 ADD2
	DUP2 ;shex JSR2 STH
	DUP2 shex STH
	ROTr ROTr
	STH2r ;patt-icn STHr ;draw-rect ( .. )



@@ 480,16 482,16 @@ JMP2
@op-fill ( addr* -- addr* )

	#0005 ADD2
	DUP2 ;shex JSR2 ;draw-fill ( .. )
	DUP2 shex ;draw-fill ( .. )

JMP2

@op-size ( addr* -- addr* )

	#0005 ADD2
	( w ) DUP2 ;shex JSR2 #00 SWP #40 SFT2 .Screen/width DEO2
	( w ) DUP2 shex #00 SWP #40 SFT2 .Screen/width DEO2
	#0003 ADD2
	( h ) DUP2 ;shex JSR2 #00 SWP #40 SFT2 .Screen/height DEO2
	( h ) DUP2 shex #00 SWP #40 SFT2 .Screen/height DEO2

JMP2r



@@ 498,14 500,14 @@ JMP2r
	.pen/x LDZ2 ,&x STR2
	.pen/y LDZ2 ,&y STR2
	#0005 ADD2
	DUP2 ;shex JSR2 #00 SWP #30 SFT2 .pen/x LDZ2 ADD2 ,&x2 STR2
	DUP2 shex #00 SWP #30 SFT2 .pen/x LDZ2 ADD2 ,&x2 STR2
	#0003 ADD2
	DUP2 ;shex JSR2 #00 SWP #30 SFT2 .pen/y LDZ2 ADD2 ,&y2 STR2
	DUP2 shex #00 SWP #30 SFT2 .pen/y LDZ2 ADD2 ,&y2 STR2
	#0003 ADD2
	DUP2 ,&name STR2

	;&link
		DUP2 ;add-link JSR2
		DUP2 add-link
		;draw-link ( .. )

JMP2


@@ 521,7 523,7 @@ JMP2r

	#01 .slideshow/stop STZ
	#0005 ADD2
	DUP2 ;shex JSR2 .slideshow/wait STZ
	DUP2 shex .slideshow/wait STZ

JMP2r



@@ 542,9 544,9 @@ JMP2r

	#15 .Screen/auto DEO
	#07 ;draw-uf2-char/color STA
	,&x LDR ;draw-byte JSR2
	LIT ", ;draw-uf2-char JSR2
	,&y LDR ;draw-byte JSR2
	,&x LDR draw-byte
	LIT ", draw-uf2-char
	,&y LDR draw-byte
	#00 .Screen/auto DEO

JMP2r


@@ 552,7 554,7 @@ JMP2r

@draw-byte ( byte -- )

	DUP #04 SFT ,hexc JSR ;draw-uf2-char JSR2
	DUP #04 SFT ,hexc JSR draw-uf2-char
	#0f AND ,hexc JSR ;draw-uf2-char ( .. )

JMP2


@@ 573,7 575,7 @@ JMP2r

@draw-link ( addr* -- )

	.links/visible LDZ ,&continue JCN
	.links/visible LDZ ?&continue
		POP2 JMP2r
		&continue



@@ 582,7 584,7 @@ JMP2r
	SWP2r
	INC2 INC2 LDA2k STH2r SUB2 #03 SFT2 NIP ,&w STR
	INC2 INC2 LDA2k STH2r SUB2 #03 SFT2 NIP ,&h STR
	[ LIT &w $1 ] [ LIT &h $1 ] ;halftone-icn #0a ;draw-rect JSR2
	[ LIT &w $1 ] [ LIT &h $1 ] ;halftone-icn #0a draw-rect
	INC2 INC2 LDA2 ;draw-uf2 ( .. )

JMP2


@@ 595,7 597,7 @@ JMP2
	#15 .Screen/auto DEO
	&while
		( linebreak )
		LDAk LIT "` NEQ ,&no-lb JCN
		LDAk LIT "` NEQ ?&no-lb
			.Screen/y DEI2k #0014 ADD2 ROT DEO2
			[ LIT2 &x $2 ] .Screen/x DEO2
			,&resume JMP


@@ 603,7 605,7 @@ JMP2
		( draw )
		LDAk ,draw-uf2-char JSR
		&resume
		INC2 LDAk ,&while JCN
		INC2 LDAk ?&while
	POP2
	#00 .Screen/auto DEO



@@ 627,7 629,7 @@ JMP2r
	#45 .Screen/auto DEO
	&while
		( linebreak )
		LDAk LIT "` NEQ ,&no-lb JCN
		LDAk LIT "` NEQ ?&no-lb
			.Screen/y DEI2k #0028 ADD2 ROT DEO2
			[ LIT2 &x $2 ] .Screen/x DEO2
			,&resume JMP


@@ 639,7 641,7 @@ JMP2r
		[ LIT &color $1 ] .Screen/sprite DEOk DEOk DEOk DEOk DEO
		#0002 SUB2 .Screen/x DEO2
		&resume
		INC2 LDAk ,&while JCN
		INC2 LDAk ?&while
	POP2
	#00 .Screen/auto DEO



@@ 667,10 669,10 @@ JMP2r
		STHkr #00
		&wloop
			[ LIT &color 0f ] .Screen/sprite DEO
			INC GTHk ,&wloop JCN
			INC GTHk ?&wloop
		POP2
		.Screen/y DEI2k #0008 ADD2 ROT DEO2
		INC GTHk ,&hloop JCN
		INC GTHk ?&hloop
	POP2
	POPr
	,&x LDR2 .Screen/x DEO2


@@ 684,7 686,7 @@ JMP2r
	DUP2 .File/name DEO2
	#0008 .File/length DEO2
	;&buf .Screen/addr DEO2
	;scap JSR2 #0009 SUB2 ;read-size JSR2
	scap #0009 SUB2 read-size
	,&h STR ,&w STR

	[ LIT &h $1 ] #00


@@ 693,11 695,11 @@ JMP2r
		&x
			;&buf .File/read DEO2
			.slideshow/mode LDZ .Screen/sprite DEO
			INC GTHk ,&x JCN
			INC GTHk ?&x
		POP2
		.Screen/x DEI2k #00 ,&w LDR #30 SFT2 SUB2 ROT DEO2
		.Screen/y DEI2k #0008 ADD2 ROT DEO2
		INC GTHk ,&y JCN
		INC GTHk ?&y
	POP2
	#00 .Screen/auto DEO



@@ 715,15 717,15 @@ JMP2r
JMP2r

@chex ( c -- val|ff ) LIT "0 SUB DUP #09 GTH JMP JMP2r #27 SUB DUP #0f GTH JMP JMP2r POP #ff JMP2r
@scap ( str* -- end* ) LDAk #00 NEQ JMP JMP2r &w INC2 LDAk ,&w JCN JMP2r
@scap ( str* -- end* ) LDAk #00 NEQ JMP JMP2r &w INC2 LDAk ?&w JMP2r
@sput ( chr str* -- ) ,scap JSR STA JMP2r
@slen ( str* -- len* ) DUP2 ,scap JSR SWP2 SUB2 JMP2r
@scmp ( a* b* -- f ) STH2 &l LDAk LDAkr STHr ANDk #00 EQU ,&e JCN NEQk ,&e JCN POP2 INC2 INC2r ,&l JMP &e NIP2 POP2r EQU JMP2r
@sseg ( a* b* -- f ) STH2 &l LDAk LDAkr STHr NEQ ,&e JCN INC2k LDA #00 EQU ,&e JCN INC2 INC2r ,&l JMP &e LDA LDAr STHr EQU JMP2r
@mclr ( src* len* -- ) OVR2 ADD2 SWP2 &l STH2k #00 STH2r STA INC2 GTH2k ,&l JCN POP2 POP2 JMP2r
@mcpy ( src* dst* len* -- ) SWP2 STH2 OVR2 ADD2 SWP2 &loop LDAk STH2kr STA INC2r INC2 GTH2k ,&loop JCN POP2 POP2 POP2r JMP2r
@scmp ( a* b* -- f ) STH2 &l LDAk LDAkr STHr ANDk #00 EQU ?&e NEQk ?&e POP2 INC2 INC2r ,&l JMP &e NIP2 POP2r EQU JMP2r
@sseg ( a* b* -- f ) STH2 &l LDAk LDAkr STHr NEQ ?&e INC2k LDA #00 EQU ?&e INC2 INC2r ,&l JMP &e LDA LDAr STHr EQU JMP2r
@mclr ( src* len* -- ) OVR2 ADD2 SWP2 &l STH2k #00 STH2r STA INC2 GTH2k ?&l POP2 POP2 JMP2r
@mcpy ( src* dst* len* -- ) SWP2 STH2 OVR2 ADD2 SWP2 &loop LDAk STH2kr STA INC2r INC2 GTH2k ?&loop POP2 POP2 POP2r JMP2r
@phex ( hex* -- ) SWP ,&b JSR &b DUP #04 SFT ,&c JSR &c #0f AND DUP #09 GTH #27 MUL ADD #30 ADD #18 DEO JMP2r
@pstr ( str* -- ) &w LDAk #18 DEO INC2 LDAk ,&w JCN POP2 JMP2r
@pstr ( str* -- ) &w LDAk #18 DEO INC2 LDAk ?&w POP2 JMP2r

@print ( short* -- )