~rabbits/adelie

29e75900e5a421d2f15a4017c913cd8ba37a32b5 — Devine Lu Linvega 6 months ago 8b16b64
Various tail-calls opt
1 files changed, 27 insertions(+), 30 deletions(-)

M src/adelie.tal
M src/adelie.tal => src/adelie.tal +27 -30
@@ 58,7 58,7 @@ BRK
	( name ) "Adelie 0a
	( details ) "A 20 "Slideshow 20 "Program 0a
	( author ) "By 20 "Hundred 20 "Rabbits 0a
	( date ) "Jan 20 "8, 20 "2023 00
	( date ) "Mar 20 "8, 20 "2023 00
	02
		( icon ) 83 =appicon
		( mask ) 41 1705


@@ 83,7 83,7 @@ BRK

@on-screen ( -> )

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


@@ 178,7 178,7 @@ BRK
	;slides
	&while
		LDAk #0a NEQ ?&no-lb
			DUP2 #00 ROT ROT STA
			STH2k #00 STH2r STA
			&no-lb
		INC2 LDAk ?&while
	POP2


@@ 186,7 186,7 @@ BRK
	( parse )
	;slides STH2k .File/success DEI2 ADD2 STH2r
	&parse-loop
		DUP2 ;op-txt/name SWP2 sseg #01 NEQ ?&skip
		;op-txt/name OVR2 sseg #01 NEQ ?&skip
			DUP2 add-jump
			&skip
		scap


@@ 204,9 204,9 @@ BRK

	( select first )
	#ff .slideshow/wait STZ
	#00 ;select-slide ( .. )
	#00

JMP2
!select-slide

( controls )



@@ 219,9 219,9 @@ JMP2
		&continue
	#01 SUB select-slide
	&skip
	#40 ;draw-cursor ( .. )
	#40

JMP2
!draw-cursor

@next-slide ( -- )



@@ 233,9 233,8 @@ JMP2
		&continue
	INC select-slide
	&skip
	#40 ;draw-cursor ( .. )

JMP2
	#40
!draw-cursor

@toggle-link ( -- )



@@ 344,7 343,7 @@ JMP2r
@add-jump ( addr* -- )

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

	.slideshow/length LDZ DUP ADD .slideshow/jumps ADD STZ2


@@ 355,7 354,7 @@ JMP2r
@add-link ( addr* -- )

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

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


@@ 390,10 389,9 @@ JMP2r
	.pen/x LDZ2 .Screen/x DEO2
	.pen/y LDZ2 .Screen/y DEO2
	DUP2 scap #0004 SUB2 ;&tga-ext scmp ?&tga
	DUP2

	DUP2 ;draw-icn ( .. )

JMP2
!draw-icn
	&tga DUP2 !draw-tga
	&tga-ext ".tga $1



@@ 433,9 431,9 @@ JMP2r
	.pen/x LDZ2 .Screen/x DEO2
	.pen/y LDZ2 .Screen/y DEO2

	DUP2 ;draw-uf5 ( .. )
	DUP2

JMP2
!draw-uf5

@op-text ( addr* -- addr* )



@@ 444,9 442,9 @@ JMP2
	.pen/x LDZ2 .Screen/x DEO2
	.pen/y LDZ2 .Screen/y DEO2

	DUP2 ;draw-uf2 ( .. )
	DUP2

JMP2
!draw-uf2

@op-mode ( addr* -- addr* )



@@ 481,16 479,16 @@ JMP2r
	#0003 ADD2
	DUP2 shex STH
	ROTr ROTr
	STH2r ;patt-icn STHr ;draw-rect ( .. )
	STH2r ;patt-icn STHr

JMP2
!draw-rect

@op-fill ( addr* -- addr* )

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

JMP2
!draw-fill

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



@@ 514,9 512,8 @@ JMP2r

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

JMP2
!draw-link
	&link &x $2 &y $2 &x2 $2 &y2 $2 &name $2

@op-stop ( addr* -- addr* )


@@ 561,9 558,9 @@ JMP2r
@draw-byte ( byte -- )

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

JMP2
!draw-uf2-char

@hexc ( hex -- char )



@@ 591,9 588,9 @@ JMP2r
	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
	INC2 INC2 LDA2 ;draw-uf2 ( .. )
	INC2 INC2 LDA2

JMP2
!draw-uf2

@draw-uf2 ( text* -- )