\ Tachyon Forth 
\ Single Digit Clock
( singleclock.fth )

TACHYON

{ singleclock.fth }

pri SINGLE_CLOCK.fth        ." Single Digit Clock Application written in Tachyon " ;

\
\
\

DECIMAL
\ words to turn on the basic segments of the LED

: SEG_A1 0 MASK OUTSET ;
: SEG_A2 1 MASK OUTSET ;
: SEG_B 2 MASK OUTSET ;
: SEG_C 3 MASK OUTSET ;
: SEG_D1 4 MASK OUTSET ;
: SEG_D2 5 MASK OUTSET ;
: SEG_E 6 MASK OUTSET ;
: SEG_F 7 MASK OUTSET ;
: SEG_H 8 MASK OUTSET ;
: SEG_I 9 MASK OUTSET ;
: SEG_J 10 MASK OUTSET ;
: SEG_G2 11 MASK OUTSET ;
: SEG_K 12 MASK OUTSET ;
: SEG_L 13 MASK OUTSET ;
: SEG_M 14 MASK OUTSET ;
: SEG_G1 15 MASK OUTSET ;
: SEG_DP 16 MASK OUTSET ;
\
\ words to affect entire LED
\

: LED_BLANK $FFFF OUTCLR ;
: LED_ALL $FFFF OUTSET ;
: LED_0 
	LED_BLANK 
	SEG_A1 
	SEG_A2 
	SEG_B 
	SEG_C 
	SEG_D1 
	SEG_D2 
	SEG_E 
	SEG_F ;
: LED_1 
	LED_BLANK 
	SEG_I 
	SEG_L ;
: LED_2 
	LED_BLANK 
	SEG_A1 
	SEG_A2 
	SEG_B 
	SEG_G1 
	SEG_G2 
	SEG_E 
	SEG_D2 
	SEG_D1 ;
: LED_3 
	LED_BLANK 
	SEG_A1 
	SEG_A2 
	SEG_B 
	SEG_G2 
	SEG_C 
	SEG_D1 
	SEG_D2 ;
: LED_4
	LED_BLANK
	SEG_F
	SEG_G1
	SEG_G2
	SEG_B
	SEG_C ;
: LED_5
	LED_BLANK
	SEG_A1
	SEG_A2
	SEG_F
	SEG_G1
	SEG_G2
	SEG_C
	SEG_D1
	SEG_D2 ;
: LED_6
	LED_BLANK
	SEG_A1
	SEG_A2
	SEG_F
	SEG_E
	SEG_D1
	SEG_D2
	SEG_C
	SEG_G2
	SEG_G1 ;
: LED_7
	LED_BLANK
	SEG_A1
	SEG_A2
	SEG_B
	SEG_C ;
: LED_8
	LED_BLANK
	SEG_A1
	SEG_A2
	SEG_B
	SEG_C
	SEG_D1
	SEG_D2
	SEG_E
	SEG_F
	SEG_G1
	SEG_G2 ;
: LED_9
	LED_BLANK
	SEG_A1
	SEG_A2
	SEG_B
	SEG_C
	SEG_F
	SEG_G1
	SEG_G2 ;
: LED_SPLAT
	LED_BLANK
	SEG_H
	SEG_I
	SEG_J
	SEG_G2
	SEG_K
	SEG_L
	SEG_M
	SEG_G1 ;
: LED_+
	LED_BLANK
	SEG_I
	SEG_L
	SEG_G1
	SEG_G2 ;
: LED_X
	LED_BLANK
	SEG_H
	SEG_J
	SEG_K
	SEG_M ;
: .LED_NUM ( num -- )
	10 LOOKUP LED_SPLAT \ default if out of range
		LED_0
		LED_1
		LED_2
		LED_3
		LED_4
		LED_5
		LED_6
		LED_7
		LED_8
		LED_9 ;

: SPLITDIGITS ( nn -- n1 n10 )
	DUP 10 MOD SWAP 10 / ;
	
: SPLIT_TIME ( hh mm -- 1min 10min 1hr 10hr )
	SPLITDIGITS ROT SPLITDIGITS ;
	
: .TIME ( 1min 10min 1hr 10hr-- )
	LED_BLANK 500 ms
	LED_+ 500 ms
	LED_X 500 ms
	LED_+ 500 ms
	LED_X 500 ms
	GET_HOURS
	SPLITDIGITS
	.LED_NUM 750 ms
	.LED_NUM 750 ms
	GET_MINUTES
	SPLITDIGITS
	.LED_NUM 750 ms
	.LED_NUM 750 ms ;
	
: CLOCK
	0 BEGIN .TIME UNTIL ;