Finished first draft of neralie.

projects/software/neralie.usm

@@ -1,23 +1,15 @@
-( Prints Neralie time to console.
+(
+	app/neralie : clock with arvelie date
 
-  Formatting isn't great, but it demonstrates that
+	TODO
-  the conversion works correctly. It's a little jittery
+		- Implement higher resolution time rather than counting fps
-  at the beginning because the FPS calculation isn't
-  accurate, so in the finished program delay showing
-  pulses for up to the first two seconds.
-
-  When compiled to bin/boot.rom, the faketime package
-  allows easy testing of midnight roll-over:
-
-  faketime '23:59:42' bin/emulator bin/boot.rom
 )
 
-%HCF { #0000 DIV }
-
 ;fps { current 1 next 1 second 1 }
 ;number { started 1 count 1 }
 ;lines { x1 2 x2 2 y1 2 y2 2 addr 2 }
-;neralie { n6543 2 n21 1 }
+;neralie { n0123 2 n4 1 n5 1 n6 1 n7 1 n8 1 n9 1 color 1 x 2 y 2 w 2 h 2 }
+;mul { ahi 1 alo 1 bhi 1 blo 1 }
 
 |0100 ;Console { pad 8 char 1 byte 1 short 2 }
 |0110 ;Screen { width 2 height 2 pad 4 x 2 y 2 color 1 }
@@ -27,14 +19,15 @@
 |01F8 [ 13fd 1ef3 1bf2 ] ( palette )
 
 |0200 @RESET
-	#3c =fps.current
+	#01 =fps.current
 
-	#000b
+	#000c
 	DUP2 =lines.x1
 	DUP2 =lines.y1
-	DUP2 ~Screen.width SWP2 SUB2 =lines.x2
+	DUP2 ~Screen.width SWP2 SUB2 #0001 SUB2 =lines.x2
 	     ~Screen.height SWP2 SUB2 =lines.y2
 
+	#02 =neralie.color
 	~lines.x1 ~lines.x2
 	OVR2 OVR2 ~lines.y1 ,h JSR2
 	          ~lines.y2 ,h JSR2
@@ -46,9 +39,13 @@
 
 @FRAME
 	,update-fps JSR2
+	#00 =neralie.color
+	,neralie-lines JSR2
 	,neralie-calc JSR2
+	#02 =neralie.color
 	,arvelie-text JSR2
 	,neralie-text JSR2
+	,neralie-lines JSR2
 	BRK
 
 	#02 =Sprite.color
@@ -56,23 +53,23 @@
 	~number.count #01 ADD =number.count
 
 @neralie-calc ( -- )
-	( add up fractions of a pulse )
+	( add up fractions of a pulse, store tenths in n6 )
 	#0120 #00 ~DateTime.hour MUL2
 	#00c0 #00 ~DateTime.minute MUL2 ADD2
 	#00f8 #00 ~DateTime.second MUL2 ADD2
 	#0271 #00 ~fps.next MUL2 #00 ~fps.current DIV2 #0008 MUL2 ADD2
-	#01b0 DIV2
+	#01b0 ,modf JSR2 SWP2 #0017 MUL2 #03e8 DIV2 =neralie.n6 POP
 
-	( add up units and tens of pulses )
+	( add up units and tens of pulses, store in n5 and n4 )
 	#0042 #00 ~DateTime.hour MUL2 ADD2
 	#005e #00 ~DateTime.minute MUL2 ADD2
 	#000b #00 ~DateTime.second MUL2 ADD2
-	DUP2 #0064 DIV2 DUP2 STH2 #0064 MUL2 SUB2 =neralie.n21 POP
+	#000a ,modf JSR2 SWP2 =neralie.n5 POP
+	#000a ,modf JSR2 SWP2 =neralie.n4 POP
 
-	( add up hundreds of pulses + 10 x beats )
+	( add up hundreds of pulses + 10 x beats, store in n0123 )
-	STH2r
 	#01a0 #00 ~DateTime.hour MUL2 ADD2
-	#0006 #00 ~DateTime.minute MUL2 ADD2 =neralie.n6543
+	#0006 #00 ~DateTime.minute MUL2 ADD2 =neralie.n0123
 
 	JMP2r
 
@@ -90,15 +87,14 @@
 
 @neralie-text ( -- )
 	~Screen.width #0002 DIV2 #0004 SUB2 =Sprite.x
-	~neralie.n6543
+	~neralie.n0123
 	#03e8 ,modf JSR2 ^digit JSR
 	#0064 ,modf JSR2 ^digit JSR
 	#000a ,modf JSR2 ^digit JSR
-	           #000a ^digit JSR ( the colon )
+	           #000b ^digit JSR ( the colon )
-	                 ^digit JSR
-	#00 ~neralie.n21
-	#000a ,modf JSR2 ^digit JSR
 	                 ^digit JSR
+	#00 ~neralie.n4  ^digit JSR
+	#00 ~neralie.n5  ^digit JSR
 	JMP2r
 
 @letter ( index* -- )
@@ -108,33 +104,82 @@
 @digit ( index* -- )
 	#0008 MUL2 ,font-numbers ADD2 =Sprite.addr
 	$middle
-	#02 =Sprite.color
+	~neralie.color =Sprite.color
 	~Sprite.x #0008 ADD2 =Sprite.x
 	JMP2r
 
+@neralie-lines ( -- )
+	~lines.x2 ~lines.x1 DUP2 =neralie.x SUB2 =neralie.w
+	~lines.y2 ~lines.y1 DUP2 =neralie.y SUB2 =neralie.h
+
+	,neralie.n4 SWP POP ~neralie.n0123
+	DUP2 ,$h JSR2
+	,$next JSR2 #0001 =Sprite.x ~neralie.y #0003 SUB2 =Sprite.y ^digit JSR
+	DUP2 ,$v JSR2
+	#04 ,v-spacing POK2
+	~lines.y1 #0003 SUB2 ~neralie.y ~neralie.x ,v JSR2
+	#01 ,v-spacing POK2
+	^$next JSR #0001 =Sprite.y ~neralie.x #0003 SUB2 =Sprite.x ,digit JSR2
+	DUP2 ^$h JSR
+	^$next JSR ~Screen.width #0009 SUB2 =Sprite.x ~neralie.y #0003 SUB2 =Sprite.y ,digit JSR2
+	DUP2 ^$v JSR
+	^$next JSR POP2
+	DUP2 ^$h JSR
+	^$next JSR POP2
+	DUP2 ^$v JSR
+	POP2 POP
+	JMP2r
+
+	$next ( digit-addr number* -- next-digit-addr next-number* prev-digit* )
+	#03e8 ,modf JSR2 STH2 #000a MUL2
+	ROT DUP STH #01 ADD ROT ROT
+	#00 STHr PEK ADD2
+	STH2r
+	JMP2r
+
+	$h ( number* -- )
+	^scale JSR
+	~neralie.h ,mul2hi JSR2
+	DUP2 #0000 NEQ2 #02 JNZ POP2 JMP2r
+	DUP2 ~neralie.y ADD2 =neralie.y
+	~neralie.h SWP2 SUB2 =neralie.h
+	~neralie.x DUP2 ~neralie.w ADD2 ~neralie.y ^h JMP
+
+	$v ( number* -- )
+	^scale JSR
+	~neralie.w ,mul2hi JSR2
+	DUP2 #0000 NEQ2 #02 JNZ POP2 JMP2r
+	DUP2 ~neralie.x ADD2 =neralie.x
+	~neralie.w SWP2 SUB2 =neralie.w
+	~neralie.y DUP2 ~neralie.h ADD2 ~neralie.x ^v JMP
+
+@scale ( 0..10000* -- 0..65535* )
+	DUP2 #8db8 ,mul2hi JSR2
+	SWP2 #0006 MUL2 ADD2
+	JMP2r
 
 @h ( x1* x2* y* -- )
 	=Screen.y
 	,Screen.x =lines.addr
-	^draw-line JMP
+	^v-draw-line JMP
 
 @v ( y1* y2* x* -- )
 	=Screen.x
 	,Screen.y =lines.addr
 
-@draw-line ( v1* v2* -- )
+	$draw-line ( v1* v2* -- )
 	OVR2 OVR2 LTH2 #01 JNZ SWP2
 	STH2
 
 	$loop
-	#0001 ADD2
+	LIT2 [ 00 ] $spacing [ 01 ] ADD2
 	DUP2 DUP2r STH2r LTH2 ^$keep-going JNZ
 	POP2 POP2r
 	JMP2r
 
 	$keep-going
 	DUP2 ~lines.addr STR2
-	#02 =Screen.color
+	~neralie.color =Screen.color
 	^$loop JMP
 
 @update-fps ( -- )
@@ -144,16 +189,14 @@
 	~DateTime.second =fps.second
 	~fps.next =fps.current
 
-	~fps.next ^print-byte-decimal JSR
+	( ~fps.next ^print-byte-decimal JSR
-	,strings-fps ^print-string JSR
+	,strings-fps ^print-string JSR )
 
 	#00 =fps.next
 	JMP2r
 
 @print-string ( string* -- )
 	DUP2 PEK2 DUP ^$not-end JNZ
-
-	$end
 	POP POP2 JMP2r
 
 	$not-end
@@ -188,6 +231,42 @@
 @modf ( dividend* divisor* -- remainder* quotient* )
 	OVR2 OVR2 DIV2 DUP2 STH2 MUL2 SUB2 STH2r JMP2r
 
+@mul2hi ( a* b* -- product-top-16-bits* )
+	(
+		Multiplying two 16-bit numbers yields a 32-bit number.
+		MUL2 returns the lowest 16 bits, we want the highest.
+
+		We split each short into hi and lo bytes, then sum
+		the following multiplications:
+
+		31..24 23..16 15..08 07..00
+		{ ahi * bhi }
+		       { alo * bhi }
+		       { ahi * blo }
+		              { alo * blo }
+
+		Bits 07..00 can be ignored, but each sum in bits 23..16
+		can end up overflowing into bit 24.
+	)
+	,mul.bhi STR2 ,mul.ahi STR2
+	#00
+		#00
+			#00 ~mul.alo #00 ~mul.blo MUL2
+		POP
+		#00 ~mul.ahi #00 ~mul.blo MUL2 ^$adc JSR
+		#00 ~mul.alo #00 ~mul.bhi MUL2 ^$adc JSR
+	POP
+	#00 ~mul.ahi #00 ~mul.bhi MUL2 ADD2
+	JMP2r
+
+	$adc ( 31..24 a* b* -- 31..24 sum* )
+	OVR2 ADD2 SWP2 OVR2
+	GTH2 ^$carry JNZ
+	JMP2r
+	$carry
+	ROT #01 ADD ROT ROT
+	JMP2r
+
 @strings
 	$fps [ 20 fps 0a 00 ]
 
@@ -196,7 +275,7 @@
 	7cc6 ced6 e6c6 7c00 1838 1818 1818 7e00 3c66 063c 6066 7e00
 	3c66 061c 0666 3c00 1c3c 6ccc fe0c 1e00 7e62 607c 0666 3c00
 	3c66 607c 6666 3c00 7e66 060c 1818 1800 3c66 663c 6666 3c00
-	3c66 663e 0666 3c00 0018 1800 1818 0000
+	3c66 663e 0666 3c00 7cc6 ced6 e6c6 7c00 0018 1800 1818 0000
 ]
 
 @font-letters