~rabbits/orca-toy

9d306f8fcc1d5a0fac4d74042a12ae959a1ba70f — Devine Lu Linvega 2 months ago 356a126
Returned the MOD/MOD2 macros
2 files changed, 15 insertions(+), 13 deletions(-)

M src/library.tal
M src/orca.tal
M src/library.tal => src/library.tal +7 -7
@@ 145,7 145,7 @@ JMP2r
	( get mod ) STH2kr INC2 ;get-port-right-raw JSR2
		( get case ) DUP ;ciuc JSR2 ,&case STR
		( to value ) ;chrb36 JSR2 DUP #00 EQU ADD
	( res ) #00 SWP ROT #00 SWP .timer/frame LDZ2 SWP2 DIV2 SWP2 DIV2k MUL2 SUB2 NIP
	( res ) #00 SWP ROT #00 SWP .timer/frame LDZ2 SWP2 DIV2 SWP2 MOD2 NIP
	( set case ) ;b36chr JSR2 DUP #60 GTH [ LIT &case $1 ] AND #50 SFT SUB
	( output ) STH2r #00 .grid/width LDZ ADD2 ;set-port-output JSR2



@@ 159,7 159,7 @@ JMP2r
	( set type ) OPERATOR-TYPE STH2kr ;data/types ADD2 STA
	( get rate ) #0001 SUB2 ;get-port-left-value JSR2 DUP #00 EQU ADD
	( get mod ) STH2kr INC2 ;get-port-right-value JSR2 DUP #00 EQU ADD
	( res ) MUL #00 SWP .timer/frame LDZ2 SWP2 DIV2k MUL2 SUB2 #0000 EQU2
	( res ) MUL #00 SWP .timer/frame LDZ2 SWP2 MOD2 #0000 EQU2
	( bang on equal ) #fc MUL LIT '. ADD
	( output ) STH2r #00 .grid/width LDZ ADD2 ;set-port-output JSR2



@@ 240,7 240,7 @@ JMP2r
	( mod ) STH2kr INC2 ;get-port-right-raw JSR2
		( get case ) DUP ;ciuc JSR2 ,&case STR
		( to value ) ;chrb36 JSR2 DUP #00 EQU ADD
	( res ) SWP STH2kr #00 .grid/width LDZ ADD2 [ ;data/cells ADD2 LDA ;chrb36 JSR2 ] ADD SWP DIVk MUL SUB
	( res ) SWP STH2kr #00 .grid/width LDZ ADD2 [ ;data/cells ADD2 LDA ;chrb36 JSR2 ] ADD SWP MOD
	( set case ) ;b36chr JSR2 DUP #60 GTH [ LIT &case $1 ] AND #50 SFT SUB
	( output ) STH2r #00 .grid/width LDZ ADD2 ;set-port-output JSR2



@@ 364,7 364,7 @@ JMP2r
		INC GTHk ,&loop JCN
	POP
	( read ) STH2kr INC2 ;get-port-right-raw JSR2
	( output ) ROT ROT DIVk MUL SUB #00 SWP STH2r #00 .grid/width LDZ ADD2 ADD2 ;set-port-output JSR2
	( output ) ROT ROT MOD #00 SWP STH2r #00 .grid/width LDZ ADD2 ADD2 ;set-port-output JSR2

JMP2r
	&? 'P "Writes 20 "eastward 20 "operand $1


@@ 401,7 401,7 @@ JMP2r
	( b-max ) STH2kr INC2 ;get-port-right-raw JSR2
		( get case ) DUP ;ciuc JSR2 ,&case STR
		( to value ) ;chrb36 JSR2 DUP #00 EQU ADD
	( mod ) OVR SUB ;prng JSR2 ADD SWP DUP #00 EQU ADD DIVk MUL SUB ADD
	( mod ) OVR SUB ;prng JSR2 ADD SWP DUP #00 EQU ADD MOD ADD
	( set case ) ;b36chr JSR2 DUP #60 GTH [ LIT &case $1 ] AND #50 SFT SUB
	( output ) STH2r #00 .grid/width LDZ ADD2 ;set-port-output JSR2



@@ 439,7 439,7 @@ JMP2r
		( type ) LOCKED-TYPE STH2r ;data/types ADD2 STA
		INC GTHk ,&loop JCN
	POP
	( read ) DIVk MUL SUB #00 SWP STH2kr INC2 ADD2 ;get-port-right-raw JSR2
	( read ) MOD #00 SWP STH2kr INC2 ADD2 ;get-port-right-raw JSR2
	STH2r #00 .grid/width LDZ ADD2 ;set-port-output JSR2

JMP2r


@@ 454,7 454,7 @@ JMP2r
	( max ) STH2kr INC2 ;get-port-right-value JSR2 DUP #00 EQU ADD STH2
	( frame ADD max SUB 1 ) .timer/frame LDZ2 STHkr #00 SWP ADD2 #0001 SUB2
	( MUL step ) OVRr STHr #00 SWP MUL2
	( % max ) STHkr #00 SWP DIV2k MUL2 SUB2
	( % max ) STHkr #00 SWP MOD2
	( ADD step ) SWPr STHr #00 SWP ADD2
	( bucket GTH= max ) STHr #00 SWP LTH2 #01 NEQ
	( bang if equal ) #fc MUL LIT '. ADD

M src/orca.tal => src/orca.tal +8 -6
@@ 16,6 16,9 @@
%OPERATOR-TYPE { #03 } %PORTER-TYPE { #04 }
%OUTPUT-TYPE { #05 } %IO-TYPE { #07 }

%MOD  { DIVk MUL SUB }
%MOD2 { DIV2k MUL2 SUB2 }

%menu-def { #01 }
%menu-sel { #04 }
%menu-hov { #08 }


@@ 571,15 574,13 @@ JMP2r
		.grid/width LDZ #00
		&hor
			DUP .head/x STZ
			STH2kr .head/addr STZ2
			,run-char JSR
			STH2kr ,run-char JSR
			INC2r
			INC GTHk ,&hor JCN
		POP2
		INC GTHk ,&ver JCN
	POP2
	POP2r

	( do not draw when menu )
	;draw-menu/sel LDA #ff NEQ ,&skip JCN
		;draw-grid JSR2


@@ 588,10 589,11 @@ JMP2r

JMP2r

@run-char ( -- )
@run-char ( id* -- )

	( cache )
	DUP2 .head/addr STZ2
	( skip locked )
	.head/addr LDZ2
	DUP2 ;data/locks ADD2 LDA ,&locked JCN
	( run unlocked )
	DUP2 ;data/cells ADD2 LDA


@@ 603,7 605,7 @@ JMP2r

( operations )

@b36chr ( b36 -- char ) #24 DIVk MUL SUB #00 SWP ;b36clc ADD2 LDA JMP2r
@b36chr ( b36 -- char ) #24 MOD #00 SWP ;b36clc ADD2 LDA JMP2r
@chrb36 ( char -- b36 ) #20 SUB #00 SWP ;values ADD2 LDA JMP2r
@chrmid ( char -- midi ) DUP ,chrb36 JSR SWP ;ciuc JSR2 #24 MUL ADD #00 SWP ;notes ADD2 LDA JMP2r