~rabbits/potato

24aba4e2ab19f4d14a2691f5423f84922cdb4b88 — Devine Lu Linvega a month ago 41ed58d
Cleaned up calendar app
1 files changed, 117 insertions(+), 136 deletions(-)

M src/apps.tal
M src/apps.tal => src/apps.tal +117 -136
@@ 20,21 20,21 @@

&on-draw ( win* -- )

	;draw-memory JSR2
	draw-memory

	DUP2
	LDA2k #0008 ADD2 .Screen/x DEO2 POP2
	.Screen/y DEI2k #000c ADD2 ROT DEO2
	;mem .bounds LDZ2 ADD2 ;draw-dec JSR2
	LIT "/ ;draw-chr JSR2
	;&full ;draw-text JSR2
	#20 ;draw-chr JSR2
	;dict/bytes ;draw-text JSR2
	;mem .bounds LDZ2 ADD2 draw-dec
	LIT "/ draw-chr
	;&full draw-text
	#20 draw-chr
	;dict/bytes draw-text

	DUP2
	LDA2k .Screen/x DEO2 POP2
	.Screen/y DEI2k #000c ADD2 ROT DEO2
	#220a ;draw-dotted JSR2
	#220a draw-dotted

	LDA2k #0008 ADD2 ,&x STR2 INC2 INC2
	LDA2k #0030 ADD2 ,&y STR2 POP2


@@ 46,7 46,7 @@
		LDA2 INC2r INC2r
		STH2kr LDA2 SUB2 INC2r INC2r
		STH2kr LDA2 INC2r INC2r
		STH2r LDA2 ;draw-icon-size JSR2
		STH2r LDA2 draw-icon-size
		INC GTHk ,&loop JCN
	POP2



@@ 61,24 61,24 @@ JMP2r
(
@|calendar )

@calendar-manifest
@app-calendar
	=&manifest
	=&on-init
	=&on-draw
	=void-mouse
	=void-button

&manifest
	03 "Calendar $1
		1200 =expand-win "Expand $1
		2200 =tab-win "Tab $1
		4200 =close-win "Close $1
	03 "View $1
		0000 =now-month "Today $1
		4000 =prev-month "Prev 20 "Month $1
		8000 =next-month "Next 20 "Month $1
		001b =&select-now "Today $1
		4000 =&select-prev "Prev 20 "Month $1
		8000 =&select-next "Next 20 "Month $1
	$1

@app-calendar
	=calendar-manifest
	=&on-init
	=&on-draw
	=&on-mouse
	=void-button

&on-init ( win* -- )

	POP2


@@ 87,66 87,53 @@ JMP2r

JMP2r

&on-mouse ( x* y* win* -> )

	POP2 POP2 POP2

BRK

&on-draw ( win* -- )

	POP2
	;draw-month ( .. )

JMP2
!draw-month

@now-month ( -- )
&select-now ( -- )

	.DateTime/year DEI2
	.DateTime/month DEI

@select-month ( year* m -- )
&select-month ( year* m -- )

	( TODO: Remove from zero-page )
	.month STZ .year STZ2
	;get-active-win JSR2 ;draw-win ( .. )
	get-active-win

JMP2
!draw-win

@prev-month ( -- )
&select-prev ( -- )

	.month LDZ
		DUP #00 EQU ,&year JCN
		#01 SUB .year LDZ2 ROT ;select-month ( .. )

JMP2
		DUP ,&no-jan JCN
			.year LDZ2k #0001 SUB2 ROT STZ2
			POP #0b .year LDZ2 ROT !app-calendar/select-month
	&no-jan
		#01 SUB .year LDZ2 ROT !app-calendar/select-month

&year ( m -- )

	.year LDZ2k #0001 SUB2 ROT STZ2
	POP #0b .year LDZ2 ROT ;select-month ( .. )

JMP2

@next-month ( -- )
&select-next ( -- )

	.month LDZ
		DUP #0b EQU ,&year JCN
		INC .year LDZ2 ROT ;select-month ( .. )

JMP2

&year ( m -- )

	.year LDZ2k INC2 ROT STZ2
	POP #00 .year LDZ2 ROT ;select-month ( .. )

JMP2
		DUP #0b NEQ ,&no-dec JCN
			.year LDZ2k INC2 ROT STZ2
			POP #00 .year LDZ2 ROT !app-calendar/select-month
		&no-dec
			INC .year LDZ2 ROT !app-calendar/select-month

(
@|color )

@color-manifest
@app-color
	=&manifest
	=void-init
	=&on-draw
	=&on-mouse
	=void-button

&manifest

	03 "Color $1
		12 00 =expand-win "Expand $1


@@ 161,13 148,6 @@ JMP2
		00 "4 =select-color/3 "Color3 $1
	$1

@app-color
	=color-manifest
	=void-init
	=&on-draw
	=&on-mouse
	=void-button

&on-mouse ( x* y* win* -> )

	.Mouse/state DEI ,&on-click JCN


@@ 189,7 169,7 @@ JMP2
		&no-b
	DUP #09 NEQ ,&no-swatch JCN
		OVR #02 SFT select-color
		[ LIT2 &win $2 ] ;draw-win JSR2
		[ LIT2 &win $2 ] draw-win
		,&release JMP
		&no-swatch
		&skip


@@ 204,9 184,9 @@ BRK
&set-nibble ( -- )

	.cursor/color LDZ #01 SFT ADD DEO
	;get-active-win JSR2 ;draw-win ( .. )
	get-active-win

JMP2
!draw-win

&set-color ( value color -- )



@@ 224,19 204,19 @@ JMP2r

	POP2
	[ .System/r ,&get-color JSR ] ;dict/red
		;draw-slider JSR2
		draw-slider
	[ .System/g ,&get-color JSR ] ;dict/green
		;draw-slider JSR2
		draw-slider
	[ .System/b ,&get-color JSR ] ;dict/blue
		;draw-slider JSR2
		draw-slider

	( swatches )

	;draw-swatches JSR2
	draw-swatches

	.System/r ,&get-color JSR ;draw-hex JSR2
	.System/g ,&get-color JSR ;draw-hex JSR2
	.System/b ,&get-color JSR ;draw-hex JSR2
	.System/r ,&get-color JSR draw-hex
	.System/g ,&get-color JSR draw-hex
	.System/b ,&get-color JSR draw-hex

JMP2r



@@ 294,7 274,7 @@ JMP2r
	&v
		#00 OVR #07 AND #30 SFT2 [ LIT2 &x $2 ] ADD2 .Screen/x DEO2
		#00 OVR #33 SFT2 [ LIT2 &y $2 ] ADD2 .Screen/y DEO2
		DUP ;paint-patt/addr LDA2 ROT ;get-chr JSR2
		DUP ;paint-patt/addr LDA2 ROT get-chr
		#8c ADD .Screen/sprite DEO
		INC GTHk ,&v JCN
	POP2


@@ 303,14 283,14 @@ JMP2r
	.Screen/y DEI2k #0010 ADD2 ROT DEO2

	( swatches )
	;draw-swatches JSR2
	draw-swatches

	( addr )
	#01 .Screen/auto DEO
	;arrow-icns/h .Screen/addr DEO2
	#0a .Screen/sprite DEO
	#0f .Screen/sprite DEO
	;paint-patt/addr LDA2 ;draw-short JSR2
	;paint-patt/addr LDA2 draw-short
	#0f .Screen/sprite DEO
	;arrow-icns/h .Screen/addr DEO2
	#1a .Screen/sprite DEO


@@ 326,20 306,20 @@ JMP2r
	#03 SFT2 NIP ROT ROT #03 SFT2 NIP SWP
	OVR #07 GTH ,&skip JCN
	DUP #07 GTH ,&no-paint JCN
		;paint-patt JSR2 BRK
		paint-patt BRK
		&no-paint
	DUP #09 NEQ ,&no-swatch JCN
		OVR #01 SFT select-color
		#ffff ;paint-patt/last STA2
		;get-active-win JSR2 ;draw-win JSR2
		get-active-win draw-win
		,&release JMP
		&no-swatch
	DUP2 #000b NEQ2 ,&no-l JCN
		;app-tile/prev-tile JSR2
		app-tile/prev-tile
		,&release JMP
		&no-l
	DUP2 #070b NEQ2 ,&no-r JCN
		;app-tile/next-tile JSR2
		app-tile/next-tile
		,&release JMP
		&no-r
	&skip


@@ 383,7 363,7 @@ JMP2

&clear-patt ( -- )

	;paint-patt/addr LDA2 #0010 ;mclr JSR2 ;draw-desktop ( .. )
	;paint-patt/addr LDA2 #0010 mclr ;draw-desktop ( .. )

JMP2



@@ 466,19 446,19 @@ JMP2r
	LDA2k #0038 ADD2 .Screen/x DEO2
	INC2k INC2 LDA2 #001c ADD2 .Screen/y DEO2

	DUP2 #0008 ADD2 LDA2 ;make-src JSR2
		;has-metadata JSR2 ,&valid-metadata JCN
	DUP2 #0008 ADD2 LDA2 make-src
		has-metadata ,&valid-metadata JCN
	( TODO: make prettier )
	;dict/no-metadata ;draw-str JSR2 POP2
	;dict/no-metadata draw-str POP2
	POP2

JMP2r

&valid-metadata ( win* -- )

	;load-metadata JSR2
	load-metadata

	;metadata/body ;draw-txt JSR2 POP2
	;metadata/body draw-txt POP2

	LDA2k #0010 ADD2 .Screen/x DEO2
	INC2k INC2 LDA2 #0020 ADD2 .Screen/y DEO2


@@ 487,7 467,7 @@ JMP2r
	INC2 DUP2 STH2r ADD2 SWP2
	&l
		LDAk #83 NEQ ,&no-pict JCN
			INC2k LDA2 #0100 SUB2 ;draw-metaicon JSR2
			INC2k LDA2 #0100 SUB2 draw-metaicon
			&no-pict
		INC2 GTH2k ,&l JCN
	POP2 POP2


@@ 523,14 503,14 @@ JMP2r
&on-init ( win* -- )

	STH2k ( win/name ) #0008 ADD2 LDA2
		;make-src JSR2 .File/name DEO2
		make-src .File/name DEO2

	#2100 ;mem-try JSR2 .File/length DEO2
	;mem-ptr JSR2
	#2100 mem-try .File/length DEO2
	mem-ptr
		DUP2 .File/read DEO2
		STH2kr ( win/mem-ptr ) #000a ADD2 STA2
	.File/success DEI2 ( eof ) INC2
		DUP2 ;mem-pad JSR2
		DUP2 mem-pad
		STH2r ( win/mem-len ) #000c ADD2 STA2

JMP2r


@@ 547,7 527,7 @@ JMP2r
	#0e ;draw-chr/color STA

	DUP2 ( win/scroll ) #000e ADD2 LDA2
	OVR2 ( win/mem-ptr ) #000a ADD2 LDA2 ;find-line JSR2
	OVR2 ( win/mem-ptr ) #000a ADD2 LDA2 find-line
	&w
		.Screen/y DEI2 [ LIT2 &bound-y $2 ] GTH2 ,&end JCN
		LDAk #0a NEQ ,&no-lb JCN


@@ 555,15 535,15 @@ JMP2r
			.Screen/y DEI2k #0008 ADD2 ROT DEO2
			,&resume JMP
			&no-lb
		DUP2 ;wlen JSR2 #30 SFT2 .Screen/x DEI2 ADD2 [ LIT2 &bound-x $2 ] LTH2 ,&no-wrap JCN
		DUP2 wlen #30 SFT2 .Screen/x DEI2 ADD2 [ LIT2 &bound-x $2 ] LTH2 ,&no-wrap JCN
			#0c ;draw-chr/color STA
			#0b ;draw-chr JSR2
			#0b draw-chr
			,&anchor LDR2 .Screen/x DEO2
			.Screen/y DEI2k #0008 ADD2 ROT DEO2
			#06 ;draw-chr JSR2
			#06 draw-chr
			#0e ;draw-chr/color STA
			&no-wrap
		LDAk ;draw-chr JSR2
		LDAk draw-chr
		&resume
		INC2 LDAk ,&w JCN
	&end


@@ 597,7 577,7 @@ BRK
			POP2 POP2 POP2 POP2 POP2 BRK
			&valid
		SWP2 STA2
	NIP2 NIP2 ;draw-win JSR2
	NIP2 NIP2 draw-win

BRK



@@ 630,7 610,7 @@ BRK
	.Screen/y DEI2k #0002 SUB2 ROT DEO2

	( image )
	#0008 ADD2 LDA2 ;make-src JSR2 ;draw-pict ( .. )
	#0008 ADD2 LDA2 make-src ;draw-pict ( .. )

JMP2



@@ 638,17 618,17 @@ JMP2

	#0e0b ;draw-pict/1bit LDA #0e NEQ [ JMP SWP POP ] ;draw-pict/1bit STA

	;get-active-win JSR2
		DUP2 ;set-anchor-body JSR2 POP2
	get-active-win
		DUP2 set-anchor-body POP2
	;app-pict/on-draw ( .. )

JMP2

&prev ( -- )

	;get-active-win JSR2
	get-active-win
		( /name ) #0008 ADD2 LDA2
		( desktop id ) ;find-name JSR2
		( desktop id ) find-name

	( check start )
	DUP ,&no-start JCN


@@ 656,29 636,29 @@ JMP2
		&no-start

	( next name )
	;close-win JSR2
	close-win
	#01 SUB
		DUP ;draw-item-text/sel STA
		;get-file JSR2 ;open-pict ( .. )
		get-file ;open-pict ( .. )

JMP2

&next ( -- )

	;get-active-win JSR2
	get-active-win
		( /name ) #0008 ADD2 LDA2
		( desktop id ) ;find-name JSR2
		( desktop id ) find-name

	( check end )
	DUP ;desk-len JSR2 LTH ,&no-end JCN
	DUP desk-len LTH ,&no-end JCN
		POP JMP2r
		&no-end

	( next name )
	;close-win JSR2
	close-win
	INC
		DUP ;draw-item-text/sel STA
		;get-file JSR2 ;open-pict ( .. )
		get-file ;open-pict ( .. )

JMP2



@@ 706,14 686,14 @@ JMP2
&on-init ( win* -- )

	STH2k ( win/name ) #0008 ADD2 LDA2
		;make-src JSR2 .File/name DEO2
		make-src .File/name DEO2

	#2100 ;mem-try JSR2 .File/length DEO2
	;mem-ptr JSR2
	#2100 mem-try .File/length DEO2
	mem-ptr
		DUP2 .File/read DEO2
		STH2kr ( win/mem-ptr ) #000a ADD2 STA2
	.File/success DEI2
		DUP2 ;mem-pad JSR2
		DUP2 mem-pad
		STH2r ( win/mem-len ) #000c ADD2 STA2

JMP2r


@@ 737,9 717,9 @@ JMP2r

&prev ( -- )

	;get-active-win JSR2
	get-active-win
		( /name ) #0008 ADD2 LDA2
		( desktop id ) ;find-name JSR2
		( desktop id ) find-name

	( check start )
	DUP ,&no-start JCN


@@ 747,16 727,16 @@ JMP2r
		&no-start

	( next name )
	;close-win JSR2
	close-win
	#01 SUB
		DUP ;draw-item-text/sel STA
		;get-file JSR2 ;open-font ( .. )
		get-file ;open-font ( .. )

JMP2

&next ( -- )

	;get-active-win JSR2
	get-active-win
		( /name ) #0008 ADD2 LDA2
		( desktop id ) ;find-name JSR2



@@ 822,16 802,16 @@ JMP2
	.Screen/x DEI2 #0010 ADD2
	.Screen/y DEI2
	( env )
	OVR2 OVR2 #01 ;draw-knob JSR2
	OVR2 #0018 ADD2 OVR2 #07 ;draw-knob JSR2
	OVR2 #0030 ADD2 OVR2 #06 ;draw-knob JSR2
	OVR2 #0048 ADD2 OVR2 #0e ;draw-knob JSR2
	OVR2 OVR2 #01 draw-knob
	OVR2 #0018 ADD2 OVR2 #07 draw-knob
	OVR2 #0030 ADD2 OVR2 #06 draw-knob
	OVR2 #0048 ADD2 OVR2 #0e draw-knob
	( loop )
	OVR2 #0060 ADD2 .Screen/x DEO2 DUP2 .Screen/y DEO2
	;play-note/hit LDA ;draw-flip JSR2
	;play-note/hit LDA draw-flip
	( vol )
	OVR2 #0078 ADD2 OVR2 #0f ;draw-knob JSR2
	OVR2 #0090 ADD2 OVR2 #0f ;draw-knob JSR2
	OVR2 #0078 ADD2 OVR2 #0f draw-knob
	OVR2 #0090 ADD2 OVR2 #0f draw-knob
	POP2 POP2

JMP2r


@@ 855,7 835,7 @@ BRK

&prev ( -- )

	;get-active-win JSR2
	get-active-win
		( /name ) #0008 ADD2 LDA2
		( desktop id ) ;find-name JSR2



@@ 874,7 854,7 @@ JMP2

&next ( -- )

	;get-active-win JSR2
	get-active-win
		( /name ) #0008 ADD2 LDA2
		( desktop id ) ;find-name JSR2



@@ 894,9 874,10 @@ JMP2
&toggle-loop ( -- )

	;play-note/hit LDA #00 EQU ;play-note/hit STA
	;get-active-win JSR2 ;draw-win ( .. )
	get-active-win

!draw-win

JMP2

&notec ( -- ) #00 ,&press-key JMP
&notecs ( -- ) #01 ,&press-key JMP


@@ 915,16 896,16 @@ JMP2

	;mem .Audio0/addr DEO2
	;play-note JSR2
	;get-active-win JSR2 ;draw-win JSR2
	#00 .Mouse/state DEO
	get-active-win

JMP2r
!draw-win

&zoomin ( -- )

	;&zoom LDA2 #0001 EQU2 ,&skip JCN
		;&zoom LDA2 #0001 SUB2 ;&zoom STA2
		;get-active-win JSR2 ;draw-win JSR2
		get-active-win ;draw-win JSR2
		&skip

JMP2r


@@ 932,9 913,9 @@ JMP2r
&zoomout ( -- )

	;&zoom LDA2 INC2 ;&zoom STA2
	;get-active-win JSR2 ;draw-win ( .. )
	get-active-win

JMP2
!draw-win

(
@|form )


@@ 983,7 964,7 @@ BRK
	DUP #0d EQU ,&validate-key JCN
	( handle key )
	;buf/form #0040 ;skey JSR2
	;draw-win JSR2
	draw-win

BRK
	&validate-key ( key win* -- ) POP #0000 .Controller/button DEO2 POP2