~rabbits/adelie

d59bcfb181c7a77fe2584149979b8e454783074c — Devine Lu Linvega 9 days ago a875139
Housekeeping
2 files changed, 48 insertions(+), 46 deletions(-)

M src/adelie.tal
M src/tga.tal
M src/adelie.tal => src/adelie.tal +23 -31
@@ 135,23 135,23 @@ BRK
		.Mouse/x DEI2 .Mouse/y DEI2 find-link
		ORAk #00 EQU ?&no-link
			find-slide select-slide
			,&no-touch JMP
			!&no-touch
			&no-link
		POP2
		next-slide 
		next-slide
		&no-mouse1
	( middle-click )
	DUP #02 NEQ ?&no-mouse2
		draw-marker
		,&no-touch JMP
		!&no-touch
		&no-mouse2
	( right-click )
	DUP #04 NEQ ?&no-mouse3
		prev-slide 
		prev-slide
		&no-mouse3
	&no-touch
	POP
	( release ) 
	( release )
	#00 .Mouse/state DEO

BRK


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


@@ 399,7 399,7 @@ JMP2r
	DUP2 ;draw-icn ( .. )

JMP2
	&tga DUP2  ;draw-tga JMP2
	&tga DUP2 ;draw-tga JMP2
	&tga-ext ".tga $1

@op-goto ( addr* -- addr* )


@@ 554,8 554,8 @@ JMP2r

@draw-byte ( byte -- )

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

JMP2



@@ 600,10 600,10 @@ JMP2
		LDAk LIT "` NEQ ?&no-lb
			.Screen/y DEI2k #0014 ADD2 ROT DEO2
			[ LIT2 &x $2 ] .Screen/x DEO2
			,&resume JMP
			!&resume
			&no-lb
		( draw )
		LDAk ,draw-uf2-char JSR
		LDAk draw-uf2-char
		&resume
		INC2 LDAk ?&while
	POP2


@@ 632,7 632,7 @@ JMP2r
		LDAk LIT "` NEQ ?&no-lb
			.Screen/y DEI2k #0028 ADD2 ROT DEO2
			[ LIT2 &x $2 ] .Screen/x DEO2
			,&resume JMP
			!&resume
			&no-lb
		( draw )
		LDAk #20 SUB #00 SWP


@@ 689,18 689,18 @@ JMP2r
	scap #0009 SUB2 read-size
	,&h STR ,&w STR

	[ LIT &h $1 ] #00
	[ LIT2 00 &h $1 ] SUB
	&y
		[ LIT &w $1 ] #00
		[ LIT2 00 &w $1 ] SUB
		&x
			;&buf .File/read DEO2
			.slideshow/mode LDZ .Screen/sprite DEO
			INC GTHk ?&x
		POP2
			INC DUP ?&x
		POP
		.Screen/x DEI2k #00 ,&w LDR #30 SFT2 SUB2 ROT DEO2
		.Screen/y DEI2k #0008 ADD2 ROT DEO2
		INC GTHk ?&y
	POP2
		INC DUP ?&y
	POP
	#00 .Screen/auto DEO

JMP2r


@@ 711,15 711,15 @@ JMP2r

@shex ( string* -- byte )

	LDAk ,chex JSR #40 SFT STH INC2
	LDA ,chex JSR STHr ADD
	LDAk chex #40 SFT STH INC2
	LDA chex STHr ADD

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 JMP2r
@sput ( chr str* -- ) ,scap JSR STA JMP2r
@slen ( str* -- len* ) DUP2 ,scap JSR SWP2 SUB2 JMP2r
@sput ( chr str* -- ) scap STA JMP2r
@slen ( str* -- len* ) DUP2 scap SWP2 SUB2 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


@@ 727,14 727,6 @@ 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 POP2 JMP2r

@print ( short* -- )

	SWP ,&byte JSR
	&byte ( byte -- ) DUP #04 SFT ,&char JSR
	&char ( char -- ) #0f AND DUP #09 GTH #27 MUL ADD #30 ADD #18 DEO

JMP2r

( theme )

@load-theme ( -- )

M src/tga.tal => src/tga.tal +25 -15
@@ 21,26 21,32 @@
	;tga/w STH2k LDA2 SWP STH2r STA2 ;tga/h STH2k LDA2 SWP STH2r STA2
	( get parser )
	;tga/image-type LDA
	#02 NEQk NIP ,&no-rawt JCN
		;tga-rawt #0004 ,parse-tga JSR
	#02 NEQk NIP ?&no-rawt
		;tga-rawt #0004 parse-tga
		POP JMP2r
		&no-rawt
	#03 NEQk NIP ,&no-rawm JCN
		;tga-rawm #0001 ,parse-tga JSR
	#03 NEQk NIP ?&no-rawm
		;tga-rawm #0001 parse-tga
		POP JMP2r
		&no-rawm
	( error )
	;&error-txt ;pstr JSR2
	#00 ;tga/image-type LDA DUP ADD ;tga-types ADD2 LDA2 ;pstr JSR2 #0a18 DEO
	;&error-txt pstr
	#00 ;tga/image-type LDA DUP ADD ;tga-types ADD2 LDA2 pstr #0a18 DEO

JMP2r
	&error-txt "Unsupported 20 "image-type: 20 $1

@parse-tga ( filter* length* -- )

	.File/length DEO2 ,&filter STR2
	( cache size )
	.File/length DEO2 
	,&filter STR2
	.Screen/x DEI2 ,&x STR2
	.Screen/y DEI2 ,&y STR2
	;tga/w LDA2 ,&w STR2
	;tga/h LDA2 ,&h STR2

	( paint )
	#01 .Screen/auto DEO
	LIT2r 0000
	&stream


@@ 49,13 55,13 @@ JMP2r
			[ LIT2 &filter $2 ] JSR2 .Screen/pixel DEO
		INC2r
		( skip line )
		STH2kr ;tga/w LDA2 NEQ2 ,&continue JCN
		STH2kr [ LIT2 &w $2 ] NEQ2 ?&continue
			[ LIT2 &x $2 ] .Screen/x DEO2
			POP2r LIT2r 0000
			.Screen/y DEI2k INC2 ROT DEO2
			.Screen/y DEI2 [ LIT2 &y $2 ] SUB2 ;tga/h LDA2 EQU2 ,&end JCN
			.Screen/y DEI2k INC2 ROT DEO2k POP
				[ LIT2 &y $2 ] SUB2 [ LIT2 &h $2 ] EQU2 ?&end
			&continue
		.File/success DEI2 ORA ,&stream JCN
		.File/success DEI2 ORA ?&stream
		&end
	POP2r
	#00 .Screen/auto DEO


@@ 63,14 69,15 @@ JMP2r
JMP2r
	&pixel $4

( pixel filters )
(
@|filters )

@tga-rawt ( rgba* -- color )

	STH2
	( b ) #00 STH2kr LDA INC2r
	( g ) #00 STH2kr LDA INC2r
	( r ) #00 STH2r LDA
	( b ) #00 LDAkr STHr INC2r
	( g ) #00 LDAkr STHr INC2r
	( r ) #00 LDAr STHr
	( res ) ADD2 ADD2 #0003 DIV2 NIP #06 SFT

JMP2r


@@ 81,6 88,9 @@ JMP2r

JMP2r

(
@|luts )

@tga-types-txts
	&null "missing-type $1
	&rawc "RAW-color $1