~rabbits/adelie

cc37e6041f53f4a805e6994942a33da026bbc9bb — neauoire 1 year, 3 months ago 0ded36b
Removed tail-calls
2 files changed, 40 insertions(+), 46 deletions(-)

M src/adelie.tal
M src/tga.tal
M src/adelie.tal => src/adelie.tal +38 -44
@@ 26,7 26,7 @@
	;meta #06 DEO2
	( | startup )
	.Console/type DEI ?&>has-arg
		;dict/usage <print-str>
		;dict/usage <print-str>/
		#010f DEO &>has-arg
	( | unlock )
	;&await-src .Console/vector DEO2


@@ 111,7 111,7 @@
	[ LIT2 00 -Mouse/state ] DEI NEQ #41 ADD ;brush-icn <update-cursor>
	[ LIT &last $1 ] .Mouse/state DEI DUP ,&last STR
	DUP2 #0001 EQU2 ?&on-down
	#0101 EQU2 ?&on-drag
	AND ?&on-drag
	BRK
	&on-down ( states* -> )
		.Mouse/x DEI2 ,&x1 STR2


@@ 136,7 136,7 @@
	( ) DUP2 STH2r EQU2 ?&err-limit
	( ) DUP2 #0000 EQU2 ?&err-empty
	#fff0 ;slides SUB2 OVR2 SUB2 <print-dec>
	;dict/bytes-free <print-str>
	;dict/bytes-free <print-str>/
	( | print free bytes )
	;slides ADD2 .eof STZ2
	( | replace 0a with 00 )


@@ 146,11 146,11 @@
		INC2 LDAk ?&w
	POP2 POP JMP2r
	&err-limit ( size* -> )
		POP2 ;errors/file-max <print-str>
		POP2 ;errors/file-max <print-str>/
		#010f DEO
		BRK
	&err-empty ( size* -> )
		POP2 ;errors/empty <print-str>
		POP2 ;errors/empty <print-str>/
		#010f DEO
		BRK



@@ 159,52 159,49 @@

@start ( -- )
	<start-watch>
	;slides setup !view-slide
	;slides
	&w ( -- )
		DUP2 find-op JSR2 scap/ INC2 & ;dict/name OVR2 sseg #00 EQU ?&w
	( >> )

(
@|controls )

@setup ( addr* -- addr* )
	!&a
	&w ( -- )
		DUP2 find-op JSR2 scap INC2 &a ;dict/name OVR2 sseg #00 EQU ?&w
	JMP2r

@view-slide ( addr* -- )
	#40 ;cursor-icn <update-cursor>
	#00 .links/length STZ
	DUP2 .slide STZ2
	&w ( -- )
		DUP2 find-op JSR2 scap INC2 ;dict/name OVR2 sseg #00 EQU ?&w
		DUP2 find-op JSR2 scap/ INC2 ;dict/name OVR2 sseg #00 EQU ?&w
	POP2 !<draw-interface>

@prev-slide ( -- )
	.slide LDZ2 is-stopped ?&e
	;slides .slide LDZ2 #0001 SUB2 !&a
	.slide LDZ2 is-stopped/ ?&e
	;slides .slide LDZ2 #0001 SUB2 !&
	&w ( -- )
		LDAk ?&a
		LDAk ?&
		INC2k ;dict/name SWP2 sseg ?&jump
		&a #0001 SUB2 LTH2k ?&w
		& #0001 SUB2 LTH2k ?&w
	POP2 POP2 &e JMP2r
	&jump ( eof* slide* -- )
		NIP2 INC2 !view-slide

@next-slide ( -- )
	#00 ;on-frame/wait STA
	.slide LDZ2 is-stopped ?&e
	.eof LDZ2 .slide LDZ2 !&a
	.slide LDZ2 is-stopped/ ?&e
	.eof LDZ2 .slide LDZ2 !&
	&w ( -- )
		;dict/name OVR2 sseg ?&jump
		&a scap INC2 GTH2k ?&w
		& scap/ INC2 GTH2k ?&w
	POP2 POP2 &e JMP2r
	&jump ( eof* slide* -- )
		NIP2 !view-slide

@find-next-slide ( -- slide* )
	.eof LDZ2 .slide LDZ2 !&a
	.eof LDZ2 .slide LDZ2 !&
	&w ( -- )
		;dict/name OVR2 sseg ?&jump
		&a scap INC2 GTH2k ?&w
		& scap/ INC2 GTH2k ?&w
	POP2 .slide LDZ2
	&jump ( eof* slide* -- )
		NIP2 JMP2r


@@ 215,7 212,7 @@
	&w ( -- )
		;dict/name OVR2 sseg #00 EQU ?{
			DUP2 next-word [ LIT2 &t $2 ] scmp ?&found }
		scap INC2 GTH2k ?&w
		scap/ INC2 GTH2k ?&w
	POP2 POP2 .slide LDZ2 JMP2r
	&found ( eof* slides* -- )
		NIP2 JMP2r


@@ 245,11 242,10 @@
@|helpers )

@is-stopped ( slide* -- f )
	!&a
	&w ( -- )
		;dict/stop OVR2 sseg ?&end
		;dict/name OVR2 sseg ?&end
		&a scap INC2 LDAk ?&w
		& scap/ INC2 LDAk ?&w
	&end ;dict/stop SWP2 !sseg

@find-link ( x* y* -- name* )


@@ 282,7 278,7 @@
		POP2 POP2 POPr #00 JMP2r

@add-link ( addr* -- )
	.links/length LDZ #08 NEQ ?{ ;errors/links-max !<print-str> }
	.links/length LDZ #08 NEQ ?{ ;errors/links-max !<print-str>/ }
	;links/data #00 .links/length LDZ #0a MUL ADD2 #000a mcpy
	( + ) .links/length LDZ INC .links/length STZ
	JMP2r


@@ 291,7 287,7 @@
	INC2k INC2 INC2 shex STH shex STHr JMP2r

@next-word ( str* -- next* )
	wcap INC2 !&
	wcap/ INC2 !&
	&w INC2 & LDAk #21 LTH ?&w
	JMP2r



@@ 299,9 295,9 @@
@|operations )

@op-name ( addr* -- addr* )
	next-word LDAk LIT "[ EQU ?&skip
	DUP2 <print-str>
	;<draw-title>/spacer-txt <print-str>
	next-word LDAk #5b EQU ?&skip
	DUP2 <print-str>/
	;<draw-title>/spacer-txt <print-str>/
	find-next-slide next-word <print-line>
	#0a18 DEO
	( | print speaker's notes )


@@ 309,7 305,7 @@
	&w ( -- )
		LDAk #09 NEQ ?{ DUP2 <print-line> }
		;dict/name OVR2 sseg ?&end
		scap INC2 GTH2k ?&w
		scap/ INC2 GTH2k ?&w
	&end POP2 POP2 #0a18 DEO
	&skip JMP2r



@@ 317,13 313,13 @@
	.pen/x LDZ2 .Screen/x DEO2
	.pen/y LDZ2 .Screen/y DEO2
	next-word DUP2 file-exists #00 EQU ?&err
	DUP2 wcap #0004 SUB2 ;&tga-ext scmp ?&tga
	DUP2 wcap/ #0004 SUB2 ;&tga-ext scmp ?&tga
	DUP2 !<draw-icn>
	&tga DUP2 !<draw-tga>
	&tga-ext ".tga $1
	&err ( addr* -- )
		;errors/file-missing <print-str>
		DUP2 <print-str>
		;errors/file-missing <print-str>/
		DUP2 <print-str>/
		#0a18 DEO
		JMP2r



@@ 495,7 491,8 @@
	LIT ": <draw-uf2-char>
	( m ) DUP2 #003c DIV2 NIP <draw-dec>
	LIT ": <draw-uf2-char>
	( m ) #003c DIV2k MUL2 SUB2 NIP !<draw-dec>
	( m ) #003c DIV2k MUL2 SUB2 NIP
	( >> )

@<draw-dec> ( dec -- )
	DUP #0a DIV LIT "0 ADD <draw-uf2-char>


@@ 574,7 571,7 @@
	DUP2 .File/name DEO2
	#0008 .File/length DEO2
	;&buf .Screen/addr DEO2
	scap #0009 SUB2 read-point
	scap/ #0009 SUB2 read-point
	( ) ,&h STR
	( ) ,&w STR
	( | is pos auto )


@@ 655,19 652,17 @@
		POP2 #01 JMP2r

@scap ( str* -- end* )
	!&a
	&w ( -- )
		INC2 &a LDAk ?&w
		INC2 & LDAk ?&w
	JMP2r

@wcap ( str* -- end* )
	!&a
	&w ( -- )
		INC2 &a LDAk #20 GTH ?&w
		INC2 & LDAk #20 GTH ?&w
	JMP2r

@sput ( chr str* -- )
	scap STA
	scap/ STA
	JMP2r

@scmp ( a* b* -- f )


@@ 712,14 707,13 @@
		JMP2r

@<print-str> ( str* -- )
	!&a
	&w ( -- )
		LDAk #18 DEO
		INC2 &a LDAk ?&w
		INC2 & LDAk ?&w
	POP2 JMP2r

@<print-line> ( str* -- )
	<print-str>
	<print-str>/
	#0a18 DEO
	JMP2r


M src/tga.tal => src/tga.tal +2 -2
@@ 31,8 31,8 @@
	( ) DUP #03 EQU ?&rawm
	POP
	( | error )
	;&error-txt <print-str>
	#00 ;tga/image-type LDA DUP ADD ;tga-types ADD2 LDA2 <print-str>
	;&error-txt <print-str>/
	#00 ;tga/image-type LDA DUP ADD ;tga-types ADD2 LDA2 <print-str>/
	#0a18 DEO
	JMP2r
	&rawt ( type -- )