~rabbits/cccc

e7ea26c114d99f3d9ab19b208b55c39cea7226e3 — Devine Lu Linvega a month ago 67d5398
Housekeeping
1 files changed, 127 insertions(+), 187 deletions(-)

M src/cccc.tal
M src/cccc.tal => src/cccc.tal +127 -187
@@ 10,14 10,9 @@

|0000

	@mode
		&dec $1
		&dot $1
	@cursor
		&x $2 &y $2
		&d &dx $1 &dy $1
	@input 
		&num $2 &den $2
	@mode &dec $1 &dot $1
	@cursor &x $2 &y $2 &d &dx $1 &dy $1
	@input &num $2 &den $2
	@length $2

|0100


@@ 37,11 32,12 @@
	#00f0 .Screen/height DEO2

	( setup synth )
	#0003 .Audio0/adsr DEO2
	#1006 .Audio0/adsr DEO2
	;tone .Audio0/addr DEO2
	#0100 .Audio0/length DEO2
	#ff .Audio0/volume DEO ( TODO: turn ON )
	#ff .Audio0/volume DEO ( TODO: toggle ON/OFF )

	( defaults )
	#0001 .input/den STZ2
	#0101 .mode STZ2



@@ 61,7 57,9 @@ BRK
	( name ) "CCCC 0a
	( details ) "A 20 "Desktop 20 "Calculator 0a
	( author ) "By 20 "Devine 20 "Lu 20 "Linvega 0a
	( date ) "Jan 20 "8, 20 "2023 0000
	( date ) "Jan 20 "19, 20 "2023 0000

	( TODO: Add appicon )

(
@|vectors )


@@ 78,27 76,16 @@ BRK
		snarf-paste
		&no-paste

	( buttons )
	.Controller/button DEI
	DUP #10 NEQ ?&no-u
		.cursor/dx LDZ .cursor/dy LDZ #01 SUB set-sel
		&no-u
	DUP #20 NEQ ?&no-d
		.cursor/dx LDZ .cursor/dy LDZ INC set-sel
		&no-d
	DUP #40 NEQ ?&no-l
		.cursor/dx LDZ #01 SUB .cursor/dy LDZ set-sel
		&no-l
	DUP #80 NEQ ?&no-r
		.cursor/dx LDZ INC .cursor/dy LDZ set-sel
		&no-r
	DUP #01 NEQ ?&no-a
		press-sel
		&no-a
	DUP #02 NEQ ?&no-b
		erase
		&no-b
	DUP #10 NEQ ?&no-u ( up ) .cursor/dx LDZ .cursor/dy LDZ #01 SUB set-sel &no-u
	DUP #20 NEQ ?&no-d ( down ) .cursor/dx LDZ .cursor/dy LDZ INC set-sel &no-d
	DUP #40 NEQ ?&no-l ( left ) .cursor/dx LDZ #01 SUB .cursor/dy LDZ set-sel &no-l
	DUP #80 NEQ ?&no-r ( right ) .cursor/dx LDZ INC .cursor/dy LDZ set-sel &no-r
	DUP #01 NEQ ?&no-a ( A ) press-sel &no-a
	DUP #02 NEQ ?&no-b ( B ) erase &no-b
	POP

	( keys )
	.Controller/key DEI listen

BRK


@@ 134,15 121,16 @@ BRK
	;cursor-icn .Screen/addr DEO2
	#43 .Mouse/state DEI #00 NEQ DUP ADD SUB draw-cursor

	.Mouse/state DEI ?&on-mouse-touch
	.Mouse/state DEI ?on-mouse-touch

BRK
	&on-mouse-touch ( -> )

@on-mouse-touch ( -> )

	.Mouse/x DEI2 #0010 SUB2 #03 SFT2 NIP #03 DIV
	.Mouse/y DEI2 #0078 SUB2 #03 SFT2 NIP

	#00 .Mouse/state DEO
	( release ) #00 .Mouse/state DEO

	OVR #07 GTH ?&skip
	DUP #fd GTH ?on-touch-bitpad


@@ 212,7 200,7 @@ BRK
	;keys/end ;keys
	&loop
		LDAk STHkr NEQ ?&continue
			INC2k LDA2 JSR2 ,&end JMP
			INC2k LDA2 JSR2 !&end
			&continue
		INC2 INC2 INC2 GTH2k ?&loop
	&end


@@ 246,7 234,7 @@ JMP2
	( clamp )
	.input LDZ2 ORA ?&has-input
		;buttons/pop press-button
		.length LDZ2 ORA #01 JCN JMP2r
		.length LDZ2 ORA #01 [ JCN JMP2r ]
		pop POP2 POP2
		;draw-display JMP2
		&has-input


@@ 316,27 304,32 @@ JMP2

JMP2

@gcd ( num* den* -- d* ) ORAk ?&ok POP2 JMP2r &ok SWP2 OVR2 ( MOD2 ) [ DIV2k MUL2 SUB2 ] ,gcd JMP
@gcd ( num* den* -- d* )

	ORAk ?&ok POP2 JMP2r &ok SWP2 OVR2 
	( MOD2 ) [ DIV2k MUL2 SUB2 ]

!gcd

@push ( num* den* -- )

	OVR2 #0000 EQU2 ?&invalid
	ORAk #00 EQU ?&invalid
	( reduce )
	OVR2 OVR2 ,gcd JSR STH2k DIV2 SWP2 STH2r DIV2
	OVR2 OVR2 gcd STH2k DIV2 SWP2 STH2r DIV2
	( store )
	.length LDZ2 #20 SFT2 ;memory ADD2 STH2k STA2
	STH2r INC2 INC2 STA2
	.length LDZ2k INC2 ROT STZ2
	( inc ) .length LDZ2k INC2 ROT STZ2

JMP2r
	&invalid POP2 POP2 JMP2r

@pop ( -- num* den* )

	.length LDZ2 #01 SUB #20 SFT2 ;memory ADD2
	( dec ) .length LDZ2k #0001 SUB2 ROT STZ2
	.length LDZ2 #20 SFT2 ;memory ADD2
	LDA2k SWP2 INC2 INC2 LDA2
	.length LDZ2k #0001 SUB2 ROT STZ2

JMP2r



@@ 345,18 338,18 @@ JMP2r

@dup ( -- )

	;buttons/dup press-button
	eval
	.length LDZ2 ORA #01 JCN JMP2r
	;buttons/dup press-button eval
	.length LDZ2 #0001 LTH2 ?&skip

	pop OVR2 OVR2 push push
	draw-display
	&skip

!draw-display
JMP2r

@swp ( -- )

	;buttons/swp press-button
	eval
	;buttons/swp press-button eval
	.length LDZ2 #0002 LTH2 ?&skip

	pop pop ROT2 STH2 ROT2 STH2r push push


@@ 367,11 360,10 @@ JMP2r

@vid ( -- )

	;buttons/vid press-button
	eval
	.length LDZ2 ORA #01 JCN JMP2r
	.length LDZ2 #20 SFT2 #0002 SUB2 ;memory ADD2 LDA2 #0001 EQU2 ?&skip
	;buttons/vid press-button eval
	.length LDZ2 #0001 LTH2 ?&skip

	.length LDZ2 #20 SFT2 #0002 SUB2 ;memory ADD2 LDA2 #0001 EQU2 ?&skip
	pop SWP2 #0001 push
	#0001 push
	draw-display


@@ 381,18 373,18 @@ JMP2r

@inv ( -- )

	;buttons/inv press-button
	eval
	.length LDZ2 ORA #01 JCN JMP2r
	;buttons/inv press-button eval
	.length LDZ2 #0001 LTH2 ?&skip

	pop SWP2 push
	draw-display
	&skip

!draw-display
JMP2r

@do-add ( -- )

	;buttons/add press-button
	eval
	;buttons/add press-button eval
	.length LDZ2 #0002 LTH2 ?&skip

	pop ,&bd STR2 ,&bn STR2


@@ 407,8 399,7 @@ JMP2r

@do-sub ( -- )

	;buttons/sub press-button
	eval
	;buttons/sub press-button eval
	.length LDZ2 #0002 LTH2 ?&skip

	pop ,&bd STR2 ,&bn STR2


@@ 423,8 414,7 @@ JMP2r

@do-mul ( -- )

	;buttons/mul press-button
	eval
	;buttons/mul press-button eval
	.length LDZ2 #0002 LTH2 ?&skip

	pop ,&bd STR2 ,&bn STR2


@@ 439,8 429,7 @@ JMP2r

@do-div ( -- )

	;buttons/div press-button
	eval
	;buttons/div press-button eval
	.length LDZ2 #0002 LTH2 ?&skip

	pop ,&bd STR2 ,&bn STR2


@@ 455,8 444,7 @@ JMP2r

@do-and ( -- )

	;buttons/and press-button
	eval
	;buttons/and press-button eval
	.length LDZ2 #0002 LTH2 ?&skip

	pop ,&bd STR2 ,&bn STR2


@@ 471,8 459,7 @@ JMP2r

@do-ora ( -- )

	;buttons/ora press-button
	eval
	;buttons/ora press-button eval
	.length LDZ2 #0002 LTH2 ?&skip

	pop ,&bd STR2 ,&bn STR2


@@ 487,88 474,49 @@ JMP2r

@do-sfl ( -- )

	;buttons/sfl press-button
	eval
	.length LDZ2 ORA #01 JCN JMP2r
	;buttons/sfl press-button eval
	.length LDZ2 #0001 LTH2 ?&skip

	pop SWP2 DUP2 ADD2 SWP2 push
	draw-display
	&skip

!draw-display
JMP2r

@do-sfr ( -- )

	;buttons/sfr press-button
	eval
	.length LDZ2 ORA #01 JCN JMP2r
	;buttons/sfr press-button eval
	.length LDZ2 #0001 LTH2 ?&skip

	pop SWP2 #01 SFT2 SWP2 push
	draw-display
	&skip

!draw-display
JMP2r

@put0 ( -- )
	;buttons/0 press-button
	#0b play-note
	#00 !append
@put1 ( -- ) 
	;buttons/1 press-button
	#0c play-note
	#01 !append
@put2 ( -- ) 
	;buttons/2 press-button
	#0e play-note
	#02 !append
@put3 ( -- ) 
	;buttons/3 press-button
	#10 play-note
	#03 !append
@put4 ( -- ) 
	;buttons/4 press-button
	#11 play-note
	#04 !append
@put5 ( -- ) 
	;buttons/5 press-button
	#13 play-note
	#05 !append
@put6 ( -- ) 
	;buttons/6 press-button
	#15 play-note
	#06 !append
@put7 ( -- ) 
	;buttons/7 press-button
	#17 play-note
	#07 !append
@put8 ( -- ) 
	;buttons/8 press-button
	#18 play-note
	#08 !append
@put9 ( -- ) 
	;buttons/9 press-button
	#1a play-note
	#09 !append
@puta ( -- ) 
	;buttons/a press-button
	#09 play-note
	#0a !append
@putb ( -- ) 
	;buttons/b press-button
	#07 play-note
	#0b !append
@putc ( -- ) 
	;buttons/c press-button
	#21 play-note
	#0c !append
@putd ( -- ) 
	;buttons/d press-button
	#1f play-note
	#0d !append
@pute ( -- ) 
	;buttons/e press-button
	#1d play-note
	#0e !append
@putf ( -- ) 
	;buttons/f press-button
	#1c play-note
	#0f !append
@put
	&0 ( -- ) #00 #0b ;buttons/0 !press-number
	&1 ( -- ) #01 #0c ;buttons/1 !press-number
	&2 ( -- ) #02 #0e ;buttons/2 !press-number
	&3 ( -- ) #03 #10 ;buttons/3 !press-number
	&4 ( -- ) #04 #11 ;buttons/4 !press-number
	&5 ( -- ) #05 #13 ;buttons/5 !press-number
	&6 ( -- ) #06 #15 ;buttons/6 !press-number
	&7 ( -- ) #07 #17 ;buttons/7 !press-number
	&8 ( -- ) #08 #18 ;buttons/8 !press-number
	&9 ( -- ) #09 #1a ;buttons/9 !press-number
	&a ( -- ) #0a #09 ;buttons/a !press-number
	&b ( -- ) #0b #07 ;buttons/b !press-number
	&c ( -- ) #0c #21 ;buttons/c !press-number
	&d ( -- ) #0d #1f ;buttons/d !press-number
	&e ( -- ) #0e #1d ;buttons/e !press-number
	&f ( -- ) #0f #1c ;buttons/f !press-number

@press-number ( value note button* -- )

	press-button play-note

!append

@press-button ( button* -- )



@@ 586,7 534,7 @@ JMP2

@play-note ( pitch -- )

	#24 ADD .Audio0/pitch DEO
	#18 ADD .Audio0/pitch DEO

JMP2r



@@ 825,18 773,16 @@ JMP2r
	.mode/dot LDZ ?&proper-dot
	SWP2 ,draw-value JSR
	draw-slash
	,draw-value ( .. )

JMP
!draw-value

&proper-dot ( num* den* -- )

	#00 draw-num
	;draw-dot JSR2
	SWP2 #03e8 #1000 .mode/dec LDZ [ JMP SWP2 POP2 ] MUL2 SWP2 DIV2
	,draw-value ( .. )

JMP
!draw-value

&mixed ( num* den* -- )



@@ 844,9 790,8 @@ JMP
	DIV2k ,draw-value JSR
	draw-quote
	STH2k ( MOD2 ) [ DIV2k MUL2 SUB2 ] STH2r
	,&proper ( .. )

JMP
!&proper

&mixed-dot ( num* den* -- )



@@ 854,9 799,8 @@ JMP
	draw-dot
	STH2k ( MOD2 ) [ DIV2k MUL2 SUB2 ] STH2r
	SWP2 #03e8 #1000 .mode/dec LDZ [ JMP SWP2 POP2 ] MUL2 SWP2 DIV2
	,draw-value ( .. )

JMP
!draw-value

&whole ( num* den* -- )



@@ 923,11 867,11 @@ JMP2r

@draw-dot ( -- )

	;dot-icns ,draw-type JMP
	;dot-icns !draw-type

@draw-quote ( -- )

	;quote-icns ,draw-type JMP
	;quote-icns !draw-type

@draw-slash ( -- )



@@ 1012,7 956,8 @@ JMP2r

JMP2r

( print )
(
@|printing )

@print ( -- )



@@ 1033,20 978,18 @@ JMP2r

	SWP2 ,print-value JSR
	LIT "/ #18 DEO
	,print-value JSR #0a18 DEO
	print-value #0a18 DEO

JMP2r

&mixed ( num* den* -- )

	DIV2k ,print-value JSR STH2k ( MOD2 ) [ DIV2k MUL2 SUB2 ] STH2r
	LIT "' #18 DEO ,&proper ( .. )

JMP
	DIV2k print-value STH2k ( MOD2 ) [ DIV2k MUL2 SUB2 ] STH2r
	LIT "' #18 DEO !&proper ( .. )

&whole ( num* den* -- )

	POP2 ,print-value JSR #0a18 DEO
	POP2 print-value #0a18 DEO

JMP2r



@@ 1095,9 1038,9 @@ JMP2r

@print-str ( str* -- )

	&while
	&w
		LDAk #18 DEO
		INC2 LDAk ?&while
		INC2 LDAk ?&w
	POP2

JMP2r


@@ 1113,7 1056,7 @@ JMP2r
		;&buf .File/read DEO2
		.File/success DEI2 #0000 EQU2 ?&end
		[ LIT &buf 20 ] listen
		,&stream JMP
		!&stream
	&end

JMP2r


@@ 1128,7 1071,7 @@ JMP2r
	;&r .File/read DEO2
	;&g .File/read DEO2
	;&b .File/read DEO2
	.File/success DEI2 ORA #01 JCN JMP2r
	.File/success DEI2 ORA #01 [ JCN JMP2r ]
	LIT2 &r $2 .System/r DEO2
	LIT2 &g $2 .System/g DEO2
	LIT2 &b $2 .System/b DEO2


@@ 1136,9 1079,6 @@ JMP2r
JMP2r
	&path ".theme $1

(
@|stdlib )

@empty-txt "Empty 20 "Stack $1

(


@@ 1149,10 1089,10 @@ JMP2r
	=tog-mode =inv =vid =eval =eval =eval

@numpad
	=put7 =put8 =put9 =putf
	=put4 =put5 =put6 =pute
	=put1 =put2 =put3 =putd
	=put0 =puta =putb =putc
	=put/7 =put/8 =put/9 =put/f
	=put/4 =put/5 =put/6 =put/e
	=put/1 =put/2 =put/3 =put/d
	=put/0 =put/a =put/b =put/c

@modpad
	=do-div =do-mul =do-sub =do-add


@@ 1163,10 1103,10 @@ JMP2r
	"+ =do-add "- =do-sub "* =do-mul "/ =do-div
	"& =do-and "| =do-ora "< =do-sfl "> =do-sfr
	20 =eval 08 =erase "% =swp "" =dup
	"7 =put7 "8 =put8 "9 =put9 "f =putf
	"4 =put4 "5 =put5 "6 =put6 "e =pute
	"1 =put1 "2 =put2 "3 =put3 "d =putd
	"0 =put0 "a =puta "b =putb "c =putc
	"7 =put/7 "8 =put/8 "9 =put/9 "f =put/f
	"4 =put/4 "5 =put/5 "6 =put/6 "e =put/e
	"1 =put/1 "2 =put/2 "3 =put/3 "d =put/d
	"0 =put/0 "a =put/a "b =put/b "c =put/c
	0d =eval
	"! =erase
	". =print


@@ 1178,34 1118,34 @@ JMP2r
@layout
	=buttons/clr =clear
	=buttons/mode =tog-mode
	=buttons/7 =put7
	=buttons/8 =put8
	=buttons/9 =put9
	=buttons/f =putf
	=buttons/7 =put/7
	=buttons/8 =put/8
	=buttons/9 =put/9
	=buttons/f =put/f
	=buttons/div =do-div
	=buttons/and =do-and
	=buttons/swp =swp
	=buttons/inv =inv
	=buttons/4 =put4
	=buttons/5 =put5
	=buttons/6 =put6
	=buttons/e =pute
	=buttons/4 =put/4
	=buttons/5 =put/5
	=buttons/6 =put/6
	=buttons/e =put/e
	=buttons/mul =do-mul
	=buttons/ora =do-ora
	=buttons/dup =dup
	=buttons/vid =vid
	=buttons/1 =put1
	=buttons/2 =put2
	=buttons/3 =put3
	=buttons/d =putd
	=buttons/1 =put/1
	=buttons/2 =put/2
	=buttons/3 =put/3
	=buttons/d =put/d
	=buttons/sub =do-sub
	=buttons/sfl =do-sfl
	=buttons/pop =erase
	=buttons/push =eval
	=buttons/0 =put0
	=buttons/a =puta
	=buttons/b =putb
	=buttons/c =putb
	=buttons/0 =put/0
	=buttons/a =put/a
	=buttons/b =put/b
	=buttons/c =put/b
	=buttons/add =do-add
	=buttons/sfr =do-sfr