(
app/neralie : clock with arvelie date
TODO
- use splash screen when FPS calculation is unstable
)
%+ { ADD } %- { SUB } %/ { DIV }
%< { LTH } %> { GTH } %= { EQU } %! { NEQ }
%++ { ADD2 } %-- { SUB2 } %// { DIV2 }
%<< { LTH2 } %>> { GTH2 } %== { EQU2 } %!! { NEQ2 }
%2* { #10 SFT } %2/ { #01 SFT }
%4* { #20 SFT } %4/ { #02 SFT }
%8* { #30 SFT } %8/ { #03 SFT }
%10* { #40 SFT } %10/ { #04 SFT }
%20* { #50 SFT } %20/ { #05 SFT }
%2** { #10 SFT2 } %2// { #01 SFT2 }
%4** { #20 SFT2 } %4// { #02 SFT2 }
%8** { #30 SFT2 } %8// { #03 SFT2 }
%10** { #40 SFT2 } %10// { #04 SFT2 }
%20** { #50 SFT2 } %20// { #05 SFT2 }
%MOD { DUP2 DIV MUL SUB }
%MOD2 { DIV2k MUL2 SUB2 }
%TOS { #00 SWP }
%h { .DateTime/hour DEI }
%m { .DateTime/minute DEI }
%s { .DateTime/second DEI }
%1-- { #0001 -- }
%PAD { #0018 }
%RTN { JMP2r }
( devices )
|00 @System [ &vector $2 &pad $6 &r $2 &g $2 &b $2 ]
|10 @Console [ &vector $2 &read $1 &pad $5 &write $1 &error $1 ]
|20 @Screen [ &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1 ]
|b0 @DateTime [ &year $2 &month $1 &day $1 &hour $1 &minute $1 &second $1 &dotw $1 &doty $2 &isdst $1 ]
( variables )
|0000
@fps [ ¤t $1 &next $1 &second $1 ]
@number [ &started $1 &count $1 ]
@lines [ &addr $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 ]
@frame
&x1 $2 &x2 $2 &y1 $2 &y2 $2
( program )
|0100
( theme )
#0f3d .System/r DEO2
#0fe3 .System/g DEO2
#0fb2 .System/b DEO2
( vectors )
;on-screen .Screen/vector DEO2
( window )
#0160 .Screen/width DEO2
#0110 .Screen/height DEO2
#01 .fps/current STZ
( set size )
PAD
DUP2 .frame/x1 STZ2
DUP2 .frame/y1 STZ2
DUP2 .Screen/width DEI2 SWP2 -- #0001 -- .frame/x2 STZ2
.Screen/height DEI2 SWP2 -- .frame/y2 STZ2
#01 .neralie/color STZ
.frame/x1 LDZ2 .frame/x2 LDZ2
OVR2 OVR2 .frame/y1 LDZ2 ;h JSR2
.frame/y2 LDZ2 ;h JSR2
.frame/y1 LDZ2 #0001 -- .frame/y2 LDZ2 INC2
OVR2 OVR2 .frame/x1 LDZ2 ;v JSR2
.frame/x2 LDZ2 ;v JSR2
@on-screen ( -> )
;update-fps JSR2
#00 .neralie/color STZ
;draw-clock JSR2
;neralie-calc JSR2
#01 .neralie/color STZ
;draw-date JSR2
;draw-clock JSR2
BRK
@neralie-calc ( -- )
( add up fractions of a pulse, store tenths in n6 )
#0120 #00 h MUL2
#00c0 #00 m MUL2 ADD2
#00f8 #00 s MUL2 ADD2
#0271 #00 .fps/next LDZ MUL2 #00 .fps/current LDZ DIV2 8** ADD2
#01b0 ;modf JSR2 SWP2 #0017 MUL2 #03e8 DIV2 .neralie/n6 STZ POP
( add up units and tens of pulses, store in n5 and n4 )
#0042 #00 h MUL2 ADD2
#005e #00 m MUL2 ADD2
#000b #00 s MUL2 ADD2
#000a ;modf JSR2 SWP2 .neralie/n5 STZ POP
#000a ;modf JSR2 SWP2 .neralie/n4 STZ POP
( add up hundreds of pulses + 10 x beats, store in n0123 )
#01a0 #00 h MUL2 ADD2
#0006 #00 m MUL2 ADD2 .neralie/n0123 STZ2
RTN
@draw-date ( -- )
( auto x ) #01 .Screen/auto DEO
.Screen/width DEI2 2// #0034 -- .Screen/x DEO2
.Screen/height DEI2 #0010 -- .Screen/y DEO2
( arvelie )
.DateTime/year DEI2 #07d6 -- NIP
DUP #0a DIV TOS 8** ;font-numbers ++ .Screen/addr DEO2
#01 .Screen/sprite DEO
#0a MOD TOS 8** ;font-numbers ++ .Screen/addr DEO2
#01 .Screen/sprite DEO
.DateTime/doty DEI2
DUP2 #000e DIV2 8** ;font-letters ++ .Screen/addr DEO2
#01 .Screen/sprite DEO
#000e MOD2
DUP2 #000a DIV2 ,digit JSR
#000a MOD2 ,digit JSR
.Screen/x DEI2 #0008 ++ .Screen/x DEO2
( neralie )
.neralie/n0123 LDZ2
#03e8 ;modf JSR2 ,digit JSR
#0064 ;modf JSR2 ,digit JSR
#000a ;modf JSR2 ,digit JSR
#000b ,digit JSR ( the colon )
,digit JSR
#00 .neralie/n4 LDZ ,digit JSR
#00 .neralie/n5 LDZ ,digit JSR
( auto none ) #00 .Screen/auto DEO
RTN
@digit ( index* -- )
8** ;font-numbers ++ .Screen/addr DEO2
.neralie/color LDZ .Screen/sprite DEO
RTN
@draw-clock ( -- )
.frame/x2 LDZ2 .frame/x1 LDZ2
DUP2 .neralie/x STZ2 SUB2 .neralie/w STZ2
.frame/y2 LDZ2 .frame/y1 LDZ2
DUP2 .neralie/y STZ2 SUB2 .neralie/h STZ2
;neralie/n4 NIP .neralie/n0123 LDZ2
DUP2 ;&h JSR2
;&next JSR2 #0008 .Screen/x DEO2 .neralie/y LDZ2 #0003 SUB2 .Screen/y DEO2 ,digit JSR
DUP2 ;&v JSR2
#04 ;v/spacing STA
.frame/y1 LDZ2 #0003 SUB2 .neralie/y LDZ2 .neralie/x LDZ2 ;v JSR2
#01 ;v/spacing STA
,&next JSR #0008 .Screen/y DEO2 .neralie/x LDZ2 #0003 SUB2 .Screen/x DEO2 ;digit JSR2
DUP2 ,&h JSR
,&next JSR .Screen/width DEI2 #0010 SUB2 .Screen/x DEO2 .neralie/y LDZ2 #0003 SUB2 .Screen/y DEO2 ;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 INC ROT ROT
#00 STHr LDZ ADD2
STH2r
JMP2r
&h ( number* -- )
,scale JSR
.neralie/h LDZ2 ;mul2hi JSR2
ORAk #02 JCN POP2 JMP2r
DUP2 .neralie/y LDZ2 ADD2 .neralie/y STZ2
.neralie/h LDZ2 SWP2 SUB2 .neralie/h STZ2
.neralie/x LDZ2 DUP2 .neralie/w LDZ2 ADD2 .neralie/y LDZ2 ,h JMP
&v ( number* -- )
,scale JSR
.neralie/w LDZ2 ;mul2hi JSR2
ORAk #02 JCN POP2 JMP2r
DUP2 .neralie/x LDZ2 ADD2 .neralie/x STZ2
.neralie/w LDZ2 SWP2 SUB2 .neralie/w STZ2
.neralie/y LDZ2 DUP2 .neralie/h LDZ2 ADD2 .neralie/x LDZ2 ,v JMP
@scale ( 0..10000* -- 0..65535* )
DUP2 #8db8 ;mul2hi JSR2
SWP2 #0006 MUL2 ADD2
JMP2r
@h ( x1* x2* y* -- )
.Screen/y DEO2
.Screen/x .lines/addr STZ
,v/draw-line JMP
@v ( y1* y2* x* -- )
.Screen/x DEO2
.Screen/y .lines/addr STZ
&draw-line ( v1* v2* -- )
OVR2 OVR2 LTH2 #01 JCN SWP2
STH2
&loop
LIT2 [ 00 ] &spacing [ 01 ] ADD2
DUP2 DUP2r STH2r LTH2 ,&keep-going JCN
POP2 POP2r
JMP2r
&keep-going
DUP2 .lines/addr LDZ DEO2
.neralie/color LDZ .Screen/pixel DEO
,&loop JMP
@update-fps ( -- )
.fps/next LDZ INC .fps/next STZ
s .fps/second LDZ NEQ JMP JMP2r
s .fps/second STZ
.fps/next LDZ .fps/current STZ
#00 .fps/next STZ
JMP2r
@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 STA2 ;mul/ahi STA2
#00
#00
#00 .mul/alo LDZ #00 .mul/blo LDZ MUL2
POP
#00 .mul/ahi LDZ #00 .mul/blo LDZ MUL2 ,&adc JSR
#00 .mul/alo LDZ #00 .mul/bhi LDZ MUL2 ,&adc JSR
POP
#00 .mul/ahi LDZ #00 .mul/bhi LDZ MUL2 ADD2
JMP2r
&adc ( 31..24 a* b* -- 31..24 sum* )
OVR2 ADD2 SWP2 OVR2
GTH2 ,&carry JCN
JMP2r
&carry
ROT INC ROT ROT
JMP2r
@font-numbers
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 7cc6 ced6 e6c6 7c00 0018 1800 1818 0000
@font-letters
183c 6666 7e66 6600 fc66 667c 6666 fc00 3c66 c0c0 c066 3c00
f86c 6666 666c f800 fe62 6878 6862 fe00 fe62 6878 6860 f000
3c66 c0c0 ce66 3e00 6666 667e 6666 6600 7e18 1818 1818 7e00
1e0c 0c0c cccc 7800 e666 6c78 6c66 e600 f060 6060 6266 fe00
c6ee fefe d6c6 c600 c6e6 f6de cec6 c600 386c c6c6 c66c 3800
fc66 667c 6060 f000 386c c6c6 dacc 7600 fc66 667c 6c66 e600
3c66 603c 0666 3c00 7e5a 1818 1818 3c00 6666 6666 6666 3c00
6666 6666 663c 1800 c6c6 c6d6 feee c600 c66c 3838 6cc6 c600
6666 663c 1818 3c00 fec6 8c18 3266 fe00 0018 187e 1818 0000