~rabbits/nasu

de0ee35a219ed624a0c02beb397b7efbb5b626c5 — neauoire 1 year, 6 months ago a9b2e29
Improved arrow controls
1 files changed, 60 insertions(+), 43 deletions(-)

M src/main.tal
M src/main.tal => src/main.tal +60 -43
@@ 21,6 21,7 @@
%<  { LTH }  %>  { GTH }  %=  { EQU }  %!  { NEQ }
%++ { ADD2 } %-- { SUB2 }
%<< { LTH2 } %>> { GTH2 } %== { EQU2 } %!! { NEQ2 }
%!~ { NEQk NIP }

%DEBUG  { ;print-hex JSR2 #0a .Console/write DEO }
%DEBUG2 { SWP ;print-hex JSR2 ;print-hex JSR2 #0a .Console/write DEO }


@@ 43,6 44,8 @@
%2MOD { #01 AND }
%4MOD { #03 AND }
%8MOD { #07 AND }
%10MOD { #0f AND }
%20MOD { #1f AND }
%8MOD2 { #0007 AND2 }
%100MOD2 { #00ff AND2 }



@@ 67,12 70,13 @@
%BANK      { #2000 }
%BANK-TEMP { #4000 }

%GET-HEX-ADDR  { TOS 8** ;font-hex ++ .Screen/addr DEO2 }
%GET-COLOR     { .settings/color LDZ STHk 2/ + DEI #01 STHr #01 AND - 4* SFT #0f AND }
%GET-POSITION  { .settings/focus LDZ2 BANK -- DUP2 2// 100MOD2 SWP2 WIDTH 2** DIV2 8** }
%ADD-POSITIONS { ROT2 ++ ROT2 ROT2 ++ SWP2 }
%RELEASE-MOUSE { #00 .Mouse/state DEO }
%RESET-SELECTION { .selection/x1 LDZ2 .selection/x2 STZ2 }
%GET-ADDR { TOS 20** ROT TOS ++ 10** BANK ++ }
%GET-ADDR { TOS 20** ROT TOS ++ 10** BANK ++ } ( x y -- addr* )

%SET-STATE { #01 .state/changed STZ ;draw-state JSR2 }
%RESET-STATE { #00 .state/changed STZ ;draw-state JSR2 }


@@ 239,19 243,15 @@ BRK

	( release ) #00 .Controller/key DEO

	.Controller/button DEI #f0 AND
		DUP #04 SFT #01 AND #01 ! ,&no-up JCN
			( clamp ) .settings/focus LDZ2 BANK #0020 10** ++ << ,&no-up JCN
			( up )    .settings/focus LDZ2 #0010 20** -- .settings/focus STZ2 &no-up
		DUP #05 SFT #01 AND #01 ! ,&no-down JCN
			( clamp ) .settings/focus LDZ2 BANK LENGTH #0020 10** -- ++ >> ,&no-down JCN
			( down )  .settings/focus LDZ2 #0010 20** ++ .settings/focus STZ2 &no-down
		DUP #06 SFT #01 AND #01 ! ,&no-left JCN
			( clamp ) .settings/focus LDZ2 BANK INC2 << ,&no-left JCN
			( left )  .settings/focus LDZ2 #0010 -- .settings/focus STZ2 &no-left
		DUP #07 SFT #01 AND #01 ! ,&no-right JCN
			( clamp ) .settings/focus LDZ2 BANK LENGTH #0020 -- ++ >> ,&no-right JCN
			( right ) .settings/focus LDZ2 #0010 ++ .settings/focus STZ2 &no-right
	.Controller/button DEI #04 SFT
	[ #01 ] !~ ,&no-up JCN
		#00 #ff ;mod-selection JSR2 POP BRK &no-up
	[ #02 ] !~ ,&no-down JCN
		#00 #01 ;mod-selection JSR2 POP BRK &no-down
	[ #04 ] !~ ,&no-left JCN
		#ff #00 ;mod-selection JSR2 POP BRK &no-left
	[ #08 ] !~ ,&no-right JCN
		#01 #00  ;mod-selection JSR2 POP BRK &no-right
	POP

	;redraw JSR2 


@@ 614,6 614,27 @@ BRK

( operations )

@mod-selection ( x y -- )

	DUP
	.selection/y2 LDZ + 10MOD .selection/y2 STZ
	.selection/y1 LDZ + 10MOD .selection/y1 STZ
	DUP
	.selection/x2 LDZ + 20MOD .selection/x2 STZ
	.selection/x1 LDZ + 20MOD .selection/x1 STZ
	( clamp )
	.selection/x2 LDZ .selection/x1 LDZ GTH ,&no-x JCN
		.selection/x1 LDZ .selection/x2 STZ
		&no-x
	.selection/y2 LDZ .selection/y1 LDZ GTH ,&no-y JCN
		.selection/y1 LDZ .selection/y2 STZ
		&no-y
	( focus )
	.selection LDZ2 GET-ADDR .settings/focus STZ2
	;redraw JSR2

RTN

@run-selection ( op* -- )
	
	STH2


@@ 819,7 840,7 @@ RTN
	( guides )
	VER 8/ #01 - #00
	&guides-hor
		DUP STH
		STHk
		.tileview/x1 LDZ2 
			.tileview/x2 LDZ2 
			.tileview/y1 LDZ2 STHr INC 40* #01 - TOS ++ 


@@ 830,7 851,7 @@ RTN

	HOR 8/ #01 - #00
	&guides-ver
		DUP STH
		STHk
		.tileview/x1 LDZ2 STHr INC 40* #01 - TOS ++ 
			.tileview/y1 LDZ2 
			.tileview/y2 LDZ2 


@@ 882,7 903,7 @@ RTN
@toggle-pixel ( x* addr* color* -- )
	
	STH2
	DUP2 LDA
	LDAk
	STH SWP2 NIP
	STHr SWP 
	STH2r SFT #01 AND ,&do-set JCN


@@ 966,8 987,8 @@ RTN
	.settings/focus LDZ2 .Screen/addr DEO2
	#10 #00
	&loop
		DUP 4MOD #00 SWP 8** .blendview/x1 LDZ2 ++ .Screen/x DEO2
		DUP 4/ #00 SWP 8** .blendview/y1 LDZ2 ++ .Screen/y DEO2
		DUP 4MOD TOS 8** .blendview/x1 LDZ2 ++ .Screen/x DEO2
		DUP 4/ TOS 8** .blendview/y1 LDZ2 ++ .Screen/y DEO2
		#00 .Screen/sprite DEO
		DUP #00 + .settings/depth LDZ 80* + .Screen/sprite DEO
		INC GTHk ,&loop JCN


@@ 1018,13 1039,13 @@ RTN
	
	.colorview/y2 LDZ2 INC2 .Screen/y DEO2
	.colorview/x1 LDZ2 .Screen/x DEO2
	.System/r GET-COLOR ;draw-short/parse JSR2 .Screen/addr DEO2
	.System/r GET-COLOR GET-HEX-ADDR 
	#02 .Screen/sprite DEO
	.Screen/x DEI2 #0008 ++ .Screen/x DEO2
	.System/g GET-COLOR ;draw-short/parse JSR2 .Screen/addr DEO2
	.System/g GET-COLOR GET-HEX-ADDR 
	#02 .Screen/sprite DEO
	.Screen/x DEI2 #0008 ++ .Screen/x DEO2
	.System/b GET-COLOR ;draw-short/parse JSR2 .Screen/addr DEO2
	.System/b GET-COLOR GET-HEX-ADDR 
	#02 .Screen/sprite DEO

	.colorview/x1 LDZ2 .colorview/y1 LDZ2 


@@ 1159,35 1180,21 @@ RTN
RTN

@draw-short ( short* color -- )

	STH SWP 
		DUP #04 SFT ,&parse JSR .Screen/addr DEO2
		( draw ) STHkr .Screen/sprite DEO
	.Screen/x DEI2 #0008 ++ .Screen/x DEO2
		#0f AND ,&parse JSR .Screen/addr DEO2
		( draw ) STHkr .Screen/sprite DEO
	.Screen/x DEI2 #0008 ++ .Screen/x DEO2
		DUP #04 SFT ,&parse JSR .Screen/addr DEO2
		( draw ) STHkr .Screen/sprite DEO
	
	ROT OVR ,draw-byte JSR
	.Screen/x DEI2 #0008 ++ .Screen/x DEO2
		#0f AND ,&parse JSR .Screen/addr DEO2
		( draw ) STHr .Screen/sprite DEO
	RTN
	&parse ( value -- addr* )
		DUP #09 GTH ,&above JCN 
			#30 ADD #20 - TOS 8** ;font ++ RTN 
		&above 
			#09 SUB #40 ADD #20 - TOS 8** ;font ++ RTN
	,draw-byte JSR

RTN

@draw-byte ( byte color -- )
	
	STH
		DUP #04 SFT ,draw-short/parse JSR .Screen/addr DEO2
	STH 
	DUP 
		#04 SFT GET-HEX-ADDR 
		( draw ) STHkr .Screen/sprite DEO
	.Screen/x DEI2 #0008 ++ .Screen/x DEO2
		#0f AND ,draw-short/parse JSR .Screen/addr DEO2
		#0f AND GET-HEX-ADDR 
		( draw ) STHr .Screen/sprite DEO

RTN


@@ 1415,6 1422,16 @@ RTN

@untitled-txt  "untitled.chr $1

@font-hex ( 0-F )
	007c 8282 8282 827c 0030 1010 1010 1010
	007c 8202 7c80 80fe 007c 8202 1c02 827c
	000c 1424 4484 fe04 00fe 8080 7c02 827c
	007c 8280 fc82 827c 007c 8202 1e02 0202
	007c 8282 7c82 827c 007c 8282 7e02 827c
	007c 8202 7e82 827e 00fc 8282 fc82 82fc
	007c 8280 8080 827c 00fc 8282 8282 82fc
	007c 8280 f080 827c 007c 8280 f080 8080

@slider-icns
	f0f0 f0f0 f0f0 f000 ( full )
	50a0 50a0 50a0 5000 ( empty )