\ Drag race timer for Nucleo F042
\ Created by Duncan Louttit September 2017
\ Uses 4 sensors
PA 12 PIO: LSTART
PB 0 PIO: LEND
PB 7 PIO: RSTART
PB 6 PIO: REND

: IOSETUP	( --- )
	LSTART ISINPUT 	LEND ISINPUT
	RSTART ISINPUT	REND ISINPUT ;

VARIABLE LSTARTED
VARIABLE LENDED
VARIABLE RSTARTED
VARIABLE RENDED

: CLEARTIMES	( --- )
	0 LSTARTED !
	0 LENDED !
	0 RSTARTED !
	0 RENDED ! ;

VARIABLE LJUMP
VARIABLE RJUMP

: CLEARJUMPS	( --- )
	0 LJUMP ! 0 RJUMP ! ;

: TSTART	( --- )
	IOSETUP CLEARTIMES
	0 <TICKS> ! ;

: TESTBITS	( --- )
	LSTARTED @ 0= IF LSTART GETPIN IF TICKS LSTARTED ! THEN THEN
	LENDED @ 0= IF LEND GETPIN IF TICKS LENDED ! THEN THEN
	RSTARTED @ 0= IF RSTART GETPIN IF TICKS RSTARTED ! THEN THEN
	RENDED @ 0= IF REND GETPIN IF TICKS RENDED ! THEN THEN ;

: DOTIMING	( --- )
	BEGIN TESTBITS PAUSE AGAIN ;

TASK TIMING

: STARTTIMING		( --- )
	MULTI ASSIGN DOTIMING TIMING INITIATE ;

: .TIME	( n --- . Print time if not maximum. )
	DUP 1000000 =
	IF DROP  
	ELSE S>D <# # # # [CHAR] . HOLD #S #> TYPE
	THEN ;

: TESTHEADINGS	( --- )
	." LEFTSTART  LEFTEND  RIGHTSTART  RIGHTEND " CR ;

: .STATE		( pin --- )
	GETPIN IF ."  BLOCKED  " ELSE ."    CLEAR   " THEN ;

: .TEST		( --- )
	LSTART .STATE LEND .STATE
	RSTART .STATE REND .STATE ;

: TEST		( --- )
	CR TESTHEADINGS BEGIN 13 EMIT .TEST 100 MS KEY? UNTIL KEY DROP ;

: LACT		( --- . Position for left reaction time. )
	3 4 GOTOXY ;

: RACT		( --- . Position for right reaction time. )
	15 4 GOTOXY ;

: .HEADINGS	( --- )
	0 5 GOTOXY ." Reaction"
	13 5 GOTOXY ." Reaction"
	3 3 GOTOXY ." Left"
	15 3 GOTOXY ." Right" ;

: LSPOS	( --- . Position for left reaction time. )
	2 6 GOTOXY ;

: RSPOS	( --- . Position for right reaction time. )
	15 6 GOTOXY ;

: CENTRE	( --- )
	8 0 GOTOXY ;

: .COUNT	( n --- )
	CENTRE . 600 MS CENTRE ."   " 400 MS ;

: RANDOM	( --- n. Returns random number between 1000 AND 2000 )
	TICKS 10 MOD 100 * 1000 + ;
	
: COUNTDOWN	( --- )
	CLEARSCREEN 1 5 DO I .COUNT -1 +LOOP ;

: GO		( --- )
	CENTRE ." GO! " 7 EMIT 600 MS CENTRE ."    " ;

: DONE?	( ---. True while race running. )
	LENDED @ 0= RENDED @ 0= OR 0= ;

: CHECKJUMP	( ms --- . Check for jump start on either side while waiting.)
	TSTART CLEARJUMPS MS
	LSTARTED @ IF -1 LJUMP ! THEN
	RSTARTED @ IF -1 RJUMP ! THEN ;

: .LREACT	( --- . Print left reaction time. )
	LSPOS LJUMP @ 
	IF ." JUMP!" 
	ELSE LSTARTED @ IF LSTARTED @ .TIME THEN
	THEN ; 

: .RREACT	( --- . Print left reaction time. )
	RSPOS RJUMP @ 
	IF ." JUMP!" 
	ELSE RSTARTED @ IF RSTARTED @ .TIME THEN
	THEN ; 

: .LTIME	( --- . Print left E.T. )
	LENDED @ IF LENDED @ 3 4 GOTOXY .TIME THEN ; 

: .RTIME	( --- . Print left E.T. )
	RENDED @ IF RENDED @ 15 4 GOTOXY .TIME THEN ; 

: .CLOCK	( --- )
	CENTRE TICKS .TIME ;

: .TIMES	( --- )
	.CLOCK
	.LREACT .RREACT .LTIME .RTIME ;

: UPDATE	( --- . Update times until finished. )
	BEGIN 10 MS .TIMES DONE? KEY? OR UNTIL .TIMES ;

: CLEARTIME	( --- )
	0 0 GOTOXY ."                                  " ;

: RWIN		( --- )
	15 0 GOTOXY ." WINNER!" ;

: LWIN		( --- )
	3 0 GOTOXY ." WINNER!" ;
 
: FINISHED	( --- . )
	CLEARTIME LJUMP @ RJUMP @ AND
	IF CENTRE ." Both disqualified!"
	ELSE
		LJUMP @
		IF RWIN 
		ELSE RJUMP @
			IF LWIN
			ELSE RENDED @ LENDED @ > IF LWIN ELSE RWIN THEN
			THEN
		THEN
	THEN ;  

: CLEANUP	( --- )
	0 7 GOTOXY 
	KEY? IF ." STOPPED" ELSE FINISHED THEN ;
	
: DRAG	( --- )
	CURSOROFF RANDOM COUNTDOWN CHECKJUMP TSTART GO
	.HEADINGS UPDATE CLEANUP 0 7 GOTOXY CURSORON ;

: WAITSTART	( --- )
	." Waiting for start"
	BEGIN LSTART GETPIN KEY? OR UNTIL ;

: SHOWTIME	( ---  Takes about 10ms. )
	9 MS .CLOCK ;

: WAITEND	( --- )
	BEGIN SHOWTIME LEND GETPIN KEY? OR UNTIL ;

: ONELAP	( --- )
	WAITSTART TSTART
	7 0 GOTOXY 20 SPACES
	WAITEND ;

: .BESTTIME	( n --- )
	HOME KEY? 0= IF SCROLLUP THEN ." Best time is " .TIME 
	0 7 GOTOXY ;

: FIXTIME	( n --- . Set time to very big if key pressed. )
	KEY? IF DROP 1000000 THEN ;

: LINE		( --- )
	CLEARSCREEN
	1000000 
	4 1 DO 	
		KEY? 0= IF HOME SCROLLUP		\ Move previous results down
				." Lap " I . ONELAP LENDED @ FIXTIME DUP CENTRE .TIME MIN
			THEN
	LOOP .BESTTIME ;

: DEADTIME	( n --- . Wait about N/10 ms for mouse to clear sensor. )
	0 DO SHOWTIME LOOP 0 LSTARTED ! ;

: LAPSTART	( --- )
	HOME SCROLLUP WAITSTART TSTART 0 0 GOTOXY 20 SPACES
	150 DEADTIME ;

: LAP		( --- )
	CLEARSCREEN
	1000000 BEGIN LAPSTART
			BEGIN SHOWTIME LSTART GETPIN KEY? OR UNTIL
			LSTARTED @ FIXTIME DUP CENTRE .TIME MIN 
		KEY? UNTIL
	.BESTTIME ;