~rabbits/adelie

d1f6705da329718e8ab062affcd64de9d9b6f66d — Devine Lu Linvega a month ago 8ca8716
Housekeeping
1 files changed, 49 insertions(+), 40 deletions(-)

M src/adelie.tal
M src/adelie.tal => src/adelie.tal +49 -40
@@ 29,9 29,10 @@
	.Console/type DEI ?{ ;dict/usage <print-str>/
		#010f DEO }
	( | unlock )
	;&await-src .Console/vector DEO2
	;await-src .Console/vector DEO2
	BRK
	&await-src ( -> )

@await-src ( -> )
	.Console/read DEI .src skey ?on-path
	BRK



@@ 49,13 50,15 @@
	;on-button .Controller/vector DEO2
	;on-mouse .Mouse/vector DEO2
	;on-frame .Screen/vector DEO2
	;src load-file start BRK
	<load-file>
	<start>
	BRK

@meta 00
	( name ) "Adelie 0a
	( details ) "A 20 "Slideshow 20 "Program 0a
	( author ) "By 20 "Hundred 20 "Rabbits 0a
	( date ) "3 20 "Jun, 20 "2024 00
	( date ) "11 20 "Jun, 20 "2024 00
	( > ) 02
	( icon ) 83 =appicon
	( mask ) 41 1705


@@ 73,17 76,17 @@
	POP BRK
	&on-timer ( time -> )
	#01 SUB DUP ,&wait STR
	?{ next-slide }
	?{ <next-slide> }
	BRK

@on-button ( -> )
	.Controller/button DEI DUP #00 EQU ?{
		DUP #01 NEQ ?{ next-slide }
		DUP #02 NEQ ?{ prev-slide }
		DUP #01 NEQ ?{ <next-slide> }
		DUP #02 NEQ ?{ <prev-slide> }
		DUP #04 NEQ ?{ toggle-interface }
		DUP #08 NEQ ?{ restart }
		DUP #40 NEQ ?{ prev-slide }
		DUP #80 NEQ ?{ next-slide }
		DUP #08 NEQ ?{ <restart> }
		DUP #40 NEQ ?{ <prev-slide> }
		DUP #80 NEQ ?{ <next-slide> }
		}
	POP BRK



@@ 96,12 99,14 @@
	DUP #02 EQU ?&on-mouse2
	#04 EQU ?&on-mouse3
	.Mouse/x DEI2 .Mouse/y DEI2 find-link ORAk ?&on-link
	POP2 next-slide BRK
	POP2 <next-slide>
	BRK
	&on-mouse2 ( touch -> )
	POP <draw-marker>
	BRK
	&on-mouse3 ( -> )
	prev-slide BRK
	<prev-slide>
	BRK
	&on-link ( name* -> )
	find-slide view-slide BRK



@@ 125,8 130,8 @@
(
@|operations )

@load-file ( src* -- )
	.File/name DEO2
@<load-file> ( src* -- )
	;src .File/name DEO2
	#fff0 ;slides SUB2 STH2k .File/length DEO2
	;slides .File/read DEO2
	( | check size )


@@ 152,10 157,10 @@
	#010f DEO
	BRK

@restart ( -- )
	;src load-file
@<restart> ( -- )
	<load-file>

@start ( -- )
@<start> ( -- )
	<start-watch>
	;slides
	&w ( -- )


@@ 173,7 178,7 @@
	DUP2 find-op JSR2 scap/ INC2 ;dict/name OVR2 sseg #00 EQU ?&w
	POP2 !<draw-interface>

@prev-slide ( -- )
@<prev-slide> ( -- )
	.slide LDZ2 is-stopped/ ?&e
	;slides .slide LDZ2 #0001 SUB2 !&
	&w ( -- )


@@ 184,7 189,7 @@
	&jump ( eof* slide* -- )
	NIP2 INC2 !view-slide

@next-slide ( -- )
@<next-slide> ( -- )
	#00 ;on-frame/wait STA
	.slide LDZ2 is-stopped/ ?&e
	.eof LDZ2 .slide LDZ2 !&


@@ 589,29 594,33 @@

@<draw-line> ( x1* y1* x2* y2* color -- )
	,&color STR
	,&y STR2
	,&x STR2
	,&y2 STR2
	,&x2 STR2
	,&x LDR2 ,&x2 LDR2 SUB2 abs2 ,&dx STR2
	#0000 ,&y LDR2 ,&y2 LDR2 SUB2 abs2 SUB2 ,&dy STR2
	#ffff [ LIT2 00 _&x2 ] LDR2 ,&x LDR2 lts2 DUP2 ADD2 ADD2 ,&sx STR2
	#ffff [ LIT2 00 _&y2 ] LDR2 ,&y LDR2 lts2 DUP2 ADD2 ADD2 ,&sy STR2
	[ LIT2 &dx $2 ] [ LIT2 &dy $2 ] ADD2 STH2
	&while ( -- )
	[ LIT2 &x2 $2 ] DUP2 .Screen/x DEO2
	[ LIT2 &x $2 ] EQU2 [ LIT2 &y2 $2 ] DUP2 .Screen/y DEO2
	[ LIT2 &y $2 ] EQU2 [ LIT2 &color $1 -Screen/pixel ] DEO
	AND ?&end
	STH2kr DUP2 ADD2 DUP2 ,&dy LDR2 lts2 ?&skipy
	STH2r ,&dy LDR2 ADD2 STH2
	,&x2 LDR2 [ LIT2 &sx $2 ] ADD2 ,&x2 STR2
	&skipy ( -- )
	,&dx LDR2 gts2 ?&while
	STH2r ,&dx LDR2 ADD2 STH2
	,&y2 LDR2 [ LIT2 &sy $2 ] ADD2 ,&y2 STR2
	!&while
	&end POP2r JMP2r
	STH2
	STH2
	( | x )
	[ LIT2 ADD2r SUB2r ] ,&x2 LDR2 STH2kr SUB2k abs2 ,&dx STR2
	SWP2 lts2 [ JMP SWP POP ] ,&sx STR
	SWP2r
	( | y )
	[ LIT2 ADD2r SUB2r ] ,&y2 LDR2 STH2kr SUB2k abs2 #0000 SWP2 SUB2 ,&dy STR2
	SWP2 lts2 [ JMP SWP POP ] ,&sy STR
	,&dx LDR2 ,&dy LDR2 ADD2
	&>while ( -- )
		DUP2r [ LITr -Screen/y ] DEO2r
		OVR2r [ LITr -Screen/x ] DEO2r
		[ LIT2 &color $1 -Screen/pixel ] DEO
		( y ) STH2kr [ LIT2 &y2 $2 ] NEQ2 ?{
			( x ) OVR2r STH2r [ LIT2 &x2 $2 ] EQU2 ?&end }
		( e -> e2 ) DUP2k ADD2 DUP2
		( y ) [ LIT2 &dy $2 ] lts2 ?{
			( e+dy ) SWP2 ,&dy LDR2 ADD2 SWP2
			( x1+sx ) SWP2r [ LIT2r 0001 ] [ &sx $1 ] SWP2r }
		( x ) [ LIT2 &dx $2 ] gts2 ?{
			( e+dx ) ,&dx LDR2 ADD2
			( y1+sy ) [ LIT2r 0001 ] [ &sy $1 ] }
		!&>while
	&end POP2 POP2r POP2r JMP2r

(
@|stdlib )