Improved arrow controls

src/main.tal

@@ -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
+	.Controller/button DEI #04 SFT
-		DUP #04 SFT #01 AND #01 ! ,&no-up JCN
+	[ #01 ] !~ ,&no-up JCN
-			( clamp ) .settings/focus LDZ2 BANK #0020 10** ++ << ,&no-up JCN
+		#00 #ff ;mod-selection JSR2 POP BRK &no-up
-			( up )    .settings/focus LDZ2 #0010 20** -- .settings/focus STZ2 &no-up
+	[ #02 ] !~ ,&no-down JCN
-		DUP #05 SFT #01 AND #01 ! ,&no-down JCN
+		#00 #01 ;mod-selection JSR2 POP BRK &no-down
-			( clamp ) .settings/focus LDZ2 BANK LENGTH #0020 10** -- ++ >> ,&no-down JCN
+	[ #04 ] !~ ,&no-left JCN
-			( down )  .settings/focus LDZ2 #0010 20** ++ .settings/focus STZ2 &no-down
+		#ff #00 ;mod-selection JSR2 POP BRK &no-left
-		DUP #06 SFT #01 AND #01 ! ,&no-left JCN
+	[ #08 ] !~ ,&no-right JCN
-			( clamp ) .settings/focus LDZ2 BANK INC2 << ,&no-left JCN
+		#01 #00  ;mod-selection JSR2 POP BRK &no-right
-			( 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
 	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 4MOD TOS 8** .blendview/x1 LDZ2 ++ .Screen/x DEO2
-		DUP 4/ #00 SWP 8** .blendview/y1 LDZ2 ++ .Screen/y 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 
+	ROT OVR ,draw-byte JSR
-		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
 	.Screen/x DEI2 #0008 ++ .Screen/x DEO2
-		#0f AND ,&parse JSR .Screen/addr DEO2
+	,draw-byte JSR
-		( 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
 
 RTN
 
 @draw-byte ( byte color -- )
 	
-	STH
+	STH 
-		DUP #04 SFT ,draw-short/parse JSR .Screen/addr DEO2
+	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 )