Wright Hobbies Robotics

Home | Store | Showcase | Forums | Examples | Guides | Reviews | Support | Download | About Us

'Slot Car Racing Control System
'2 car lap timer and counter.
'Eddy Wright
'Wright Hobbies, LLC
'http://www.wrighthobbies.net

'Define Variables
'Variables used for time keeping
Dim Centiseconds As Long , Seconds As Long , Minutes As Long

'Cs = race clock in centiseconds (1/100 second)
Dim Cs As Long

'Car1, Car2 = lap time for each car, car1best,car2best = best lap speed
Dim Car1 As Long , Car2 As Long , Car1best As Long , Car2best As Long

'Carstart1, Carstart2 = Time capture at start of each lap, used to calc lap time
Dim Carstart1 As Long , Carstart2 As Long

'Laps1, Laps2 = Number of laps each car completes
'Laps = Number of laps in a race
Dim Laps1 As Byte , Laps2 As Byte , Laps As Byte

'Stime = string for displaying lap time
Dim Stime As String * 10

'Lapdelay1, Lapdelay2 = Used to ensure 1 sec delay before counting another lap
Dim Lapdelay1 As Long , Lapdelay2 As Long

'Winner = winning car (3=tie)
Dim Winner As Byte

'Menu Variables
Dim Menu As Byte

'Temp Variables
Dim Temp As Long , Temp1 As String * 2 , Temp2 As String * 20 , Temp3 As Long
Dim X As Byte , I As Byte

'Throttle control variables
Dim Throttle1 As Long , Throttle2 As Long
'User selectable percentage of full throttle (for children)
Dim Factor1 As Byte , Factor2 As Byte

'Flags
Dim Throttle1_active As Bit , Throttle2_active As Bit , Racetype As Bit
Dim Startrace As Bit , Racerunning As Bit , Fault1 As Bit , Fault2 As Bit

'EEProm Variables
'Allows for setting to be saved between sessions
Dim Elaps As Eram Byte , Efactor1 As Eram Byte , Efactor2 As Eram Byte , Erasetype As Eram Byte

'Constants
'Range of throttle that is the same for both controllers
'Helps compensate for variation on low and high readings from pots in
'throttle controllers
Const Throttle_off = 110
Const Throttle_full = 375
Const Throttle_range = 265
'True and False
Const Pushed = 0
Const Notpushed = 1
Const Total_menus = 6
Const True = 1
Const False = 0

'Aliases

Change Alias Pind.5
Enter Alias Pind.6
Yellow1 Alias Portc.0
Yellow2 Alias Portc.1
Yellow3 Alias Portc.2
Green Alias Portc.3
Red Alias Portc.4
Speed1 Alias Ocr0
Speed2 Alias Ocr2

'Declarations
Declare Function Formattime(byval Work As Long) As String
Declare Function Formatlaps(byval X As Byte) As String
Declare Sub Waitforbutton()
Declare Function Getbutton() As Byte

'Config Statements
Config Timer1 = Timer , Compare A = Disconnect , Compare B = Disconnect , Prescale = 8
Config Timer2 = Pwm , Prescale = 64 , Compare Pwm = Clear Up , Pwm = On
'Bascom doesn't support PWM on Timer0 so we manually set the registers
Tccr0 = &B01100100 'Load 01100100, setting up PWM on Timer0

Config Adc = Single , Prescaler = Auto , Reference = Avcc

Config Portd.2 = Input
Config Portd.3 = Input
Config Portb.3 = Output
Config Portd.7 = Output
Config Portc = Output

'Configure 2 buttons - Change and Select (choose)
Config Portd.5 = Input
Config Portd.6 = Input

'Set the 2 external interrupts to trigger on rising edge
Config Int0 = Falling
Config Int1 = Falling

'Turn on internal Pull-up resistors for switches
Portd.5 = 1
Portd.6 = 1

Start Adc

On Int0 Car1lap
On Int1 Car2lap

'Set default values
Timer1 = 55535
Ocr0 = 0
Ocr2 = 0
Laps1 = 0
Laps2 = 0
Car1best = &HFFFFFFFF
Car2best = &HFFFFFFFF
Red = False
Green = False
Yellow1 = False
Yellow2 = False
Yellow3 = False

'Load stored settings from EProm
If Elaps = 255 Then
Laps = 10
Else
Laps = Elaps
End If

If Efactor1 = 255 Then
Factor1 = 80
Else
Factor1 = Efactor1
End If

If Efactor2 = 255 Then
Factor2 = 80
Else
Factor2 = Efactor2
End If

If Erasetype = 255 Then
Racetype = 0
Else
If Erasetype = 1 Then
Racetype = 1
Else
Racetype = 0
End If
End If

'Define Timer1 Interrupt Routine
On Timer1 Timer1_isr 'Routine that runs when timer overflows

'Enable the Timers
Enable Timer0
Enable Timer1
Enable Timer2

'Enable the Interrupts
Enable Int0
Enable Int1
Enable Interrupts

Start Timer1
'(
* * * * * * * * * * * * * * * * * * * * * * * * * *
Main Program
* * * * * * * * * * * * * * * * * * * * * * * * * *

')

Cursor Off
Cls
Display Off

'wait patiently for a button to be pushed
Waitforbutton

'Wake up Message

Display On
Lcd "Welcome to RaceTime"
Locate 3 , 1
Lcd " Press Change "

Locate 4 , 1
Lcd " For Menu "
Waitms 500
Menu = 0

Do
X = Getbutton()

'Change Button is pressed, Show the appropriate menu item
'And stop the race if it's in progress
If X = 1 Then
Startrace = False
Racerunning = False
Speed1 = 0
Speed2 = 0
Laps1 = 0
Laps2 = 0
Winner = 0
Car1best = 999999
Car2best = 999999
Lapdelay1 = 0
Lapdelay2 = 0
Red = True
Green = True
Yellow1 = True
Yellow2 = True
Yellow3 = True

Incr Menu
If Menu > Total_menus Then Menu = 1

Select Case Menu
Case 1
Cls
Locate 2 , 1
Lcd " Start Race"

Case 2
'Select Race Type
Cls
Locate 1 , 1
Lcd "Select Race Type"
Locate 3 , 1
Lcd "Type: "
If Racetype = 1 Then
Lcd "Timed Race"
Else
Lcd "Open Racing"
End If

Case 3
'Top Speed car 1
Cls
Locate 1 , 1
Lcd "Select Car 1 Speed"
Locate 2 , 1
Lcd " 20% - 100%"
Locate 3 , 1
Lcd "Car 1: "
Temp2 = Str(factor1)
Temp2 = Temp2 + "%"
Lcd Temp2

Case 4
'Top Speed car 2
Cls
Locate 1 , 1
Lcd "Select Car 2 Speed"
Locate 2 , 1
Lcd " 20% - 100%"
Locate 3 , 1
Lcd "Car 2: "
Temp2 = Str(factor2)
Temp2 = Temp2 + "%"
Lcd Temp2

Case 5
Cls
Locate 1 , 1
Lcd "Select # Laps"
Locate 3 , 1
Lcd "Laps: "
Temp2 = Str(laps)
Lcd Temp2

Case 6
Cls
Locate 2 , 1
Lcd " Shut Down"

End Select

End If

If X = 2 Then
'Enter Pressed, Process Menu choice
Select Case Menu
Case 1
'Start Race
Startrace = True
Menu = 0
Cls

Case 2
'Change Race Type
Cursor Blink
Do
X = Getbutton()
If X = 1 Then
Toggle Racetype
Locate 3 , 7
Lcd " "
Locate 3 , 7
If Racetype = 1 Then
Lcd "Timed Race"
Else
Lcd "Open Racing"
End If
End If
If X = 2 Then
Cursor Noblink

If Racetype = 1 Then
Erasetype = 1
Else
Erasetype = 0
End If

Exit Do
End If
Loop

Case 3
'Change Car 1 top speed
Cursor Blink
Do
X = Getbutton()
If X = 1 Then
Factor1 = Factor1 + 5
If Factor1 > 100 Then Factor1 = 20
Temp2 = Str(factor1)
Temp2 = Temp2 + "%"
Locate 3 , 8
Lcd " "
Locate 3 , 8
Lcd Temp2
End If

If X = 2 Then
Cursor Noblink
Efactor1 = Factor1
Exit Do
End If
Loop

Case 4
'Change Car 2 top speed
Cursor Blink
Do
X = Getbutton()
If X = 1 Then
Factor2 = Factor2 + 5
If Factor2 > 100 Then Factor2 = 20
Temp2 = Str(factor2)
Temp2 = Temp2 + "%"
Locate 3 , 8
Lcd " "
Locate 3 , 8
Lcd Temp2
End If
If X = 2 Then
Cursor Noblink
Efactor2 = Factor2
Exit Do
End If
Loop

Case 5
'Change Lap count
Cursor Blink
Do
X = Getbutton()
If X = 1 Then
Incr Laps
If Laps > 25 Then Laps = 1
Temp2 = Str(laps)
Locate 3 , 7
Lcd " "
Locate 3 , 7
Lcd Temp2
End If
If X = 2 Then
Cursor Noblink
Elaps = Laps
Exit Do
End If
Loop

Case 6
'Shutdown
jmp $0000

End Select
End If

If Startrace = True Then
'Race Startup code goes here
Racerunning = True
Red = False
Green = False
Yellow1 = False
Yellow2 = False
Yellow3 = False
Cls
Locate 1 , 1
Lcd " RACE TIME! "
Lcd "Press Enter To Start"
Do
X = Getbutton()
Loop Until X = 2

Cls
Lcd "Race Time: 00:00:00"
Locate 3 , 1
Lcd "1: 00:00:00 laps: 00"
Locate 4 , 1
Lcd "2: 00:00:00 laps: 00"
Wait 5
Yellow1 = True
Wait 1
Yellow2 = True
Wait 1
Yellow3 = True
Wait 1
Green = True
Cs = 0
Carstart1 = 0
Carstart2 = 0
Start Timer1

End If

If Racerunning = True Then

Stime = Formattime(cs) 'Display Race Clock
Locate 1 , 12
Lcd Stime
'Read Throttle controllers
Throttle1 = Getadc(0)
Throttle2 = Getadc(1)

If Startrace = True Then
If Throttle1 > Throttle_off Then
'Throttle1 is in fault mode (holding trigger at start)
'Turn on fault light and turn off throttle
Red = True
Fault1 = True
Else
Fault1 = False
End If

If Throttle2 > Throttle_off Then
'Throttle2 is in fault mode (holding trigger at start)
'Turn on fault light and turn off throttle
Red = True
Fault2 = True
Else
Fault2 = False
End If

Startrace = False
End If

'Check Car1 Throttle
Throttle1_active = True
Throttle2_active = True

If Fault1 = False Then
Select Case Throttle1
Case 1023
'Throttle1 is not plugged in
Throttle1_active = False
Case 0 To Throttle_off
'Throttle is in the low end dead space
Ocr0 = 0
Case Throttle_full To 1000
'Throttle is in the high end dead space
Temp = 255

'Adjust top speed
Temp = Temp * Factor1
Temp = Temp / 100

Ocr0 = Temp

Case Throttle_off To Throttle_full
Temp = Throttle1 - Throttle_off
Temp = Temp * 255
Temp = Temp / Throttle_range

'Adjust top speed
Temp = Temp * Factor1
Temp = Temp / 100

Ocr0 = Temp
End Select
Else
If Throttle1 <= Throttle_off Then
Fault1 = False
Red = False
Else
Red = True
End If

End If

'Check Car2 Throttle
If Fault2 = False Then
Select Case Throttle2
Case 1023
'Throttle2 is not plugged in
Throttle2_active = False
Case 0 To Throttle_off
Ocr2 = 0
Case Throttle_full To 1000
Temp = 255
'Adjust top Speed
Temp = Temp * Factor2
Temp = Temp / 100
Ocr2 = Temp
Case Throttle_off To Throttle_full
Temp = Throttle2 - Throttle_off
Temp = Temp * 255
Temp = Temp / Throttle_range

'Adjust top Speed
Temp = Temp * Factor2
Temp = Temp / 100

Ocr2 = Temp
End Select
Else
'Test to see if the trigger is released yet
If Throttle2 <= Throttle_off Then
Fault2 = False
Red = False
Else
Red = True
End If

End If

Stime = Formattime(car1) 'Display Car 1 Lap Time
Locate 3 , 4
Lcd Stime

Stime = Formattime(car2) 'Display Car 2 Lap Time
Locate 4 , 4
Lcd Stime

Locate 3 , 19
Temp1 = Str(laps1)
Temp1 = Format(temp1 , "00")
Lcd Temp1 'Display Car 1 Laps

Locate 4 , 19
Temp1 = Str(laps2)
Temp1 = Format(temp1 , "00")
Lcd Temp1 'Display Car 2 Laps

'(
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Check For Winner If R = It Is A Timed Race
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
')

If Racetype = 1 Then
If Laps1 = Laps Then
If Laps1 > Laps2 Then
'Car 1 wins race
Winner = 1
End If
End If

If Laps2 = Laps Then
If Laps2 > Laps1 Then
'Car 2 wins race
Winner = 2
End If
End If

If Laps1 = Laps Then
If Laps2 = Laps Then
'We have a tie!
Winner = 3
End If
End If

Select Case Winner

Case 0
'Do nothing, race still on

Case 1
'Car 1 Wins
'Waitforbutton
Stop Timer1
Racerunning = False
Speed1 = 0
Speed2 = 0
Cls
Lcd "Car 1 is the Winner!"
Locate 2 , 1
Lcd "Race Time: "
Temp1 = Formattime(cs)
Lcd Temp1
Locate 3 , 1
Lcd "Best Lap 1: "
Temp1 = Formattime(car1best)
Lcd Temp1
Locate 4 , 1
Lcd "Best Lap 2: "
Temp1 = Formattime(car2best)
Lcd Temp1
Waitforbutton
Waitms 500
Case 2
'Car 2 wins
'Waitforbutton
Stop Timer1
Racerunning = False
Speed1 = 0
Speed2 = 0
Cls
Lcd "Car 2 is the Winner!"
Locate 2 , 1
Lcd "Race Time: "
Temp1 = Formattime(cs)
Lcd Temp1
Locate 3 , 1
Lcd "Best Lap 2: "
Temp1 = Formattime(car2best)
Lcd Temp1
Locate 4 , 1
Lcd "Best Lap 1: "
Temp1 = Formattime(car1best)
Lcd Temp1

Waitforbutton
Waitms 500

Case 3
'We have a tie, use best lap time to determine winner
'Stop Timer1

End Select

If Winner <> 0 Then
Cls
Lcd "Welcome to RaceTime"
Locate 3 , 1
Lcd " Press Change "
Locate 4 , 1
Lcd " For Menu "
Start Timer1
End If
End If
End If
Loop
End