These Displays are great although a little heavy on the juice, half amp at 5 volts, which equates to 2.5 watts. I had actually bought two of these displays in 2016 from RS
But a usual it took me a while to get it all together. It only took a pandemic in 2020 with lock downs and all that to rethink these little ditties.
Oh Noooo, just found out that these displays are discontinued.. Bugger (December 2021), in fact it seems RS is no longer doing any VFD stuff. Ho Hum. Well perhaps you could use a 128x64 OLED display instead, and modify the code a little to suit..
I think it took me about 3 months to write the code and came to arround 2500 lines. I'll post below should you want to have a go at making this project.
OSCCON = %01111100 'bit 0 and 1 should be 0 for PLL speeds OSCTUNE = %01000000 'bit 6 enables PLL bit 0-4 set for INTCON = %00000000 'Interrupt controle (at Mo all off) INTCON2 = %10000000 'Bit 7= pullups on or off 1=off PIE1 = %00000000 'Peripheral intrurrpts IPR1 = %00000000 'Peripheral priority zero = everything low T0CON = %11001111 'Timer zero control 0=off 'Setup Ports TRISA = %00111111 TRISB = 0 TRISC = 0
'Display CONTROL LINES Symbol we = PORTC.0 'Write Data Symbol gt = PORTC.1 'Read Data Symbol cs = PORTC.2 'Chip select Symbol cd = PORTC.3 'Command/data 1=command, 0=data Symbol alarm = PORTC.4 'LED 'Clock control lines Symbol scl = RC6 Symbol sda = RC7
'Dim dummy As Single Dim rand As Long Dim bst_march As Byte Dim bst_oct As Byte Dim bst As Bit Dim menu_timer As Word Dim second As Byte Dim minute As Byte Dim hour As Byte Dim day As Byte Dim date As Byte Dim month As Byte Dim year As Byte Dim age As Byte Dim degrees As Word Dim datemax As Byte Dim bright As Byte Dim brt As Byte Dim x As Word Dim once As Bit Dim temp As Byte Dim gsel As Byte gsel = 1 'Dim data_read As Byte Dim ticker As Long Dim tickerg As Byte Dim mode As Byte Dim flash As Byte Dim fl As Bit 'Dim str1 As String Dim str As String Dim invader1(13) As Byte Dim invader2(13) As Byte Dim old_year As Byte 'Shape Invasers 1 & 2 For x = 0 To 12 invader1(x) = LookUp(0, 14, 24, 190, 109, 61, 60, 61, 109, 190, 24, 14, 0), x invader2(x) = LookUp(0, 120, 29, 190, 108, 60, 60, 60, 108, 190, 29, 120, 0), x Next x
Call command(0x0e) 'set data address 0 Call data_w(0) Call command(0x0f) Call data_w(0) Call command(0x05) 'Address is not incremented Call command(0x15) 'Int set to no signal Call data_w(0)
'###################################### Begin ######################################### PORTA = 0 loop:
Call screen(0)
'If mode = 0 Then Call get_time()
If mode < 8 Then Call display_time(0, 0) Endif
'Dim screen when late night If mode = 0 Then If hour > 22 Or hour < 6 Then 'Display OFF Call command(0x13) WaitMs 1 Call data_w(0xff) Else 'Display on Call command(0x07) WaitMs 1 Call data_w(0x00) WaitMs 1 Call command(0x13) Call data_w(bright) Endif Else 'Display on Call command(0x07) WaitMs 1 Call data_w(0x00) WaitMs 1 Call command(0x13) Call data_w(bright) Endif
If mode = 0 And RA0 = 0 Then brt = brt + 1 If brt > 8 Then brt = 8 While RA0 = 0 Wend Endif
If mode = 0 And RA2 = 0 Then brt = brt - 1 If brt = 255 Then brt = 0 While RA2 = 0 Wend Endif
Select Case brt Case 0 bright = 0xff Case 1 bright = 0x2a Case 2 bright = 0x24 Case 3 bright = 0x1e Case 4 bright = 0x18 Case 5 bright = 0x12 Case 6 bright = 0x0c Case 7 bright = 0x06 Case 8 bright = 0x00 EndSelect
If RA4 = 0 And mode = 0 Then ticker = ticker + 1 If ticker > 100 Then ticker = 0 mode = 1 While RA4 = 0 Wend Endif Endif
If mode > 0 And mode < 8 Then If RA4 = 0 Then menu_timer = 0 mode = mode + 1 While RA4 = 0 Wend Call clear() Endif
menu_timer = menu_timer + 1 If menu_timer > 28000 Then mode = 0 menu_timer = 0 Endif Endif
If RA5 = 0 And mode = 0 Then tickerg = tickerg + 1 If tickerg > 100 Then mode = 10
Call menu(gsel)
While RA5 = 0 Wend Endif Else tickerg = 0 Endif
If mode >= 10 And RA3 = 0 Then Call clear() mode = 0 Endif
Select Case mode Case 1 If RA0 = 0 Then menu_timer = 0 year = year + 1 If year > 99 Then year = 0 Call calc_bst(year) old_year = year While RA0 = 0 Wend Call clear() Endif
If RA2 = 0 Then menu_timer = 0 year = year - 1 If year > 99 Then year = 99 Call calc_bst(year) old_year = year While RA2 = 0 Wend Call clear() Endif Case 2 If RA0 = 0 Then menu_timer = 0 month = month + 1 If month > 12 Then month = 1 Call maxdate() While RA0 = 0 Wend Call clear() Endif
If RA2 = 0 Then menu_timer = 0 month = month - 1 If month < 1 Then month = 12 Call maxdate() While RA2 = 0 Wend Call clear() Endif Case 3 If RA0 = 0 Then menu_timer = 0 Call maxdate() date = date + 1 If date > datemax Then date = 1 While RA0 = 0 Wend Call clear() Endif
If RA2 = 0 Then menu_timer = 0 Call maxdate() date = date - 1 If date < 1 Then date = datemax While RA2 = 0 Wend Call clear() Endif Case 4 If RA0 = 0 Then menu_timer = 0 hour = hour + 1 If hour > 24 Then hour = 0 While RA0 = 0 Wend Call clear() Endif
If RA2 = 0 Then menu_timer = 0 hour = hour - 1 If hour > 23 Then hour = 23 While RA2 = 0 Wend Call clear() Endif Case 5 If RA0 = 0 Then menu_timer = 0 minute = minute + 1 If minute > 59 Then minute = 0 While RA0 = 0 Wend Call clear() Endif
If RA2 = 0 Then menu_timer = 0 minute = minute - 1 If minute > 59 Then minute = 59 While RA2 = 0 Wend Call clear() Endif Case 6 mode = 0 Call put_time() Call clear() Case 10 If RA0 = 0 Then menu_timer = 0 gsel = gsel - 1 If gsel < 1 Then gsel = 1 Call menu(gsel) While RA0 = 0 Wend Endif
If RA2 = 0 Then menu_timer = 0 gsel = gsel + 1 If gsel > 4 Then gsel = 4 Call menu(gsel) While RA2 = 0 Wend Endif
If RA5 = 0 Then temp = 8 + gsel * 8 Call text(78, temp, "Selected", 0) WaitMs 500 Select Case gsel Case 1 'Asteroids mode = 11 Call asteroids() Case 2 'Lunar Lander mode = 11 Call lunar() Case 3 'Invaders mode = 11 Call invaders() Case 4 'PONG mode = 11 Call pong() EndSelect
While RA5 = 0 Wend Endif EndSelect
If hour = 0 And minute = 0 And second = 0 And flash = 0 Then Call clear()
'####### Flash LED for end of minute ######## If second = 0 And mode = 0 And once = 0 Then alarm = 1 WaitMs 250 alarm = 0 once = 1 Endif
If second <> 0 And mode = 0 Then alarm = 0 once = 0 Endif
If mode > 0 And mode < 8 Then alarm = fl
If mode = 0 And hour = 0 And minute = 0 And second = 0 And fl = 0 Then Call clear()
'################################################################## flash = flash + 1 Select Case flash Case 0, 64, 128, 192 fl = 0 Case 32, 96, 160, 224 fl = 1 EndSelect
loop2:
Goto loop
'############################### End ################################ END End
Proc randomize() Call get_time() rand.LB = second Xor TMR0L rand.HB = minute Xor PCL rand.3B = hour Xor second rand.4B = date Xor second End Proc
Function rnd() As Single Dim x As Single Dim temp As Byte Dim tmp As Bit loop1:
If x < 0.0078 Then Goto loop1 If x = 1 Then Goto loop1
rnd = x
End Function
'###################### LINE ######################################
Proc line(x1 As Word, y1 As Word, x2 As Word, y2 As Word, gamma As Bit)
Dim twodxaccumulatorerror As Word Dim twodyaccumulatorerror As Word Dim xinc As Word Dim yinc As Word Dim dx As Word Dim dy As Word Dim twodx As Word Dim twody As Word Dim tempx As Word Dim tempy As Word Dim currentx As Word Dim currenty As Word
dx = x2 - x1 dy = y2 - y1 'temp x y here tempx = dx tempy = dy dx = abs(dx) 'ABS makes negative numbers positive..ie -42 becomes +42 dy = abs(dy)
twodx = dx * 2 twody = dy * 2
If tempx > 32768 Then twodx = neg(twodx) Endif
If tempy > 32768 Then twody = neg(twody) Endif
dx = tempx dy = tempy
currentx = x1 currenty = y1
xinc = 1 yinc = 1
If dx > 32768 Then '>32768 mean minus number xinc = 65535 'equivalent to -1 dx = neg(dx) twodx = neg(twodx) Endif
If dy > 32768 Then '>32768 mean minus number yinc = 65535 'equivalent to -1 dy = neg(dy) twody = neg(twody) Endif
Call plot(x1, y1, gamma)
If dx <> 0 Or dy <> 0 Then If dy <= dx Then twodxaccumulatorerror = 0 While currentx <> x2 currentx = currentx + xinc
If twody > 32768 Then twodxaccumulatorerror = twodxaccumulatorerror - twody Else twodxaccumulatorerror = twodxaccumulatorerror + twody Endif
If twodxaccumulatorerror > dx And twodxaccumulatorerror < 32768 Then currenty = currenty + yinc twodxaccumulatorerror = twodxaccumulatorerror - twodx Endif Call plot(currentx, currenty, gamma) Wend Else twodyaccumulatorerror = 0 While currenty <> y2 currenty = currenty + yinc
If twodx > 32768 Then twodyaccumulatorerror = twodyaccumulatorerror - twodx Else twodyaccumulatorerror = twodyaccumulatorerror + twodx Endif
If twodyaccumulatorerror > dy And twodyaccumulatorerror < 32768 Then currentx = currentx + xinc twodyaccumulatorerror = twodyaccumulatorerror - twody Endif Call plot(currentx, currenty, gamma) Wend Endif Endif
End Proc
'############################# Lunar Lander ########################### Proc lunar() Call clear() Call screen(0) Dim str As String Dim ship_angle As Single Dim ship_vx As Single Dim ship_vy As Single Dim offsetx As Single Dim offsety As Single Dim base As Byte Dim dummyx As Single Dim dummyy As Single Dim c1 As Single Dim s1 As Single Dim tempx As Byte Dim tempy As Byte Dim score As Long Dim hscore As Long Dim lives As Byte Dim fuel As Word Dim set As Bit Dim cnt As Byte Dim x As Byte Dim dx As Byte Dim ship_px(3) As Single Dim ship_py(3) As Single
For x = 128 To 35 Step -1 Call text(x, 10, "Lunar ", 1) WaitMs 5 Next x
For x = 128 To 30 Step -1 Call text(x, 30, "Lander ", 1) WaitMs 5 Next x
WaitMs 2000
Call countdown()
score = 0 lives = 5 alarm = 0
loop2:
fuel = 60000 Dim moonx(50) As Word Dim moony(50) As Byte
If set = 1 Then set = 0 Call circle(dummyx, dummyy, 2, 0) Endif
Wend
Call clear() mode = 0
End Proc
'############################# Invaders ############################ Proc invaders() Call randomize() Dim str As String Dim loop_cnt As Byte Dim speed As Byte Dim basex As Word Dim x As Word Dim y As Word Dim temp As Byte Dim cnt As Byte Dim dir As Single Dim lives As Byte Dim lp As Bit Dim bulletx As Byte Dim bullety As Single Dim bullet_f As Bit Dim dir_cng As Bit Dim mshipx As Single Dim mship_start As Bit 'Dim mship_dir As Single Dim score As Long Dim hscore As Long Dim done_once As Bit Dim detect As Bit Dim dumpx As Byte Dim dumpy As Byte Dim inv_cnt As Byte Dim dummy As Single Dim temp_mship As Single Dim bomb As Byte Dim bombgo As Bit Dim bombx As Byte Dim bomby As Byte Dim invader(18) As Word Dim inv_exist(18) As Byte Dim y1(18) As Byte Dim mship(18) As Byte Dim base(18) As Byte
'Intro Call clear() str = "Space " For x = 128 To 35 Step -1 Call text(x, 15, str, 1) WaitMs 5 Next x
str = "Invaders " For x = 128 To 20 Step -1 Call text(x, 35, str, 1) WaitMs 5 Next x
WaitMs 2000
Call countdown()
'Data for Base For x = 0 To 17 base(x) = LookUp(0, 15, 31, 31, 31, 31, 31, 127, 255, 127, 31, 31, 31, 31, 31, 15, 0), x Next x
'Data for mother ship For x = 0 To 18 mship(x) = LookUp(0, 4, 12, 30, 55, 62, 124, 116, 126, 126, 116, 124, 62, 55, 30, 12, 4, 0), x Next x
For x = 0 To 17 'If x = 0 Then inv_exist(x) = 1 'Endif Next x
'Setup invaders positions For y = 0 To 2 For x = 16 To 98 Step 16 invader(cnt) = x y1(cnt) = y cnt = cnt + 1 Next x Next y
Call clear()
speed = 36
'Draw Blocks bombgo = 0
For x = 18 To 128 Step 30 y = x - 7 temp = x + 7 For dummy = y To temp Call line(dummy, 55, dummy, 49, 1) Next dummy Next x
While RA4 = 1 str = "Start Loop" If dummy < 0.4 Then mship_start = 0
If loop_cnt = speed Then loop_cnt = 0
dummy = 1 + rnd() * 128
If dummy > 25 Then mship_start = 1
'Blank Invaders
inv_cnt = 0
For x = 0 To 17 Call draw_inv(invader(x), y1(x), 0, 0) If inv_exist(x) = 1 Then inv_cnt = inv_cnt + 1 Next x
'Move Inveder
For x = 0 To 17 If inv_exist(x) = 1 Then invader(x) = invader(x) + dir If invader(x) > 114 Or invader(x) < 1 Then dir_cng = 1
bomb = 100 * rnd()
If bomb = 3 And bombgo = 0 Then bombgo = 1 bombx = invader(x) + 5 bomby = 8 + (8 * y1(x)) Endif
Endif Next x
If dir_cng = 1 Then dir_cng = 0 For x = 0 To 17 If inv_exist(x) = 1 Then y1(x) = y1(x) + 1
If y1(x) > 6 Then 'Invaders invaded Game over lives = lives - 1 WaitMs 1000 Goto loop1 Endif Endif Next x
If dir > 0 Then dir = -2 Else dir = 2 Endif Endif
'Draw invader
Select Case lp Case 0 For x = 0 To 17 If inv_exist(x) = 1 Then Call draw_inv(invader(x), y1(x), 0, 1) Endif Next x Case 1 For x = 0 To 17 If inv_exist(x) = 1 Then Call draw_inv(invader(x), y1(x), 1, 1) Endif Next x EndSelect
Toggle lp
Endif
If bombgo = 1 Then bomby = bomby + 1 Call line(bombx, bomby, bombx, bomby + 5, 1) Endif
If RA1 = 0 Then basex = basex + 8 If basex > 903 Then basex = 903 Endif
If RA3 = 0 Then basex = basex - 8 If basex > 2048 Then basex = 7 Endif
'Fire bullet If RA5 = 0 And bullet_f = 0 Then bullet_f = 1 Endif
If bullet_f = 1 Then
If done_once = 0 Then bulletx = (basex + 68) / 8 done_once = 1 Endif
bullety = bullety - 2
'Crash detection here detect = pget(bulletx, bullety)
If detect = 1 Then 'Hit something detect = 0 y = bullety - 1 Call line(bulletx, bullety, bulletx, y, 0)
If bullety < 9 And mship_start = 1 Then 'check to see if mother ship y = mshipx / 8 'Call text(0, 16, #bulletx + " " + #y + " ", 0) y = abs(y - bulletx) If y < 10 Then 'Hit Mother ship y = 5 + (mshipx / 8) score = score + 1500 Call text(y, 0, "1500", 0) WaitMs 1500 Call text(0, 0, " ", 0) Endif mshipx = 0 - 16 mship_start = 0 Endif
For x = 0 To 17 dumpx = abs(invader(x) + 6 - bulletx) dumpy = y1(x) * 8 dumpy = abs(dumpy - bullety)
If dumpx < 8 And dumpy < 8 Then inv_exist(x) = 0 score = score + 100 Endif Next x
bullety = -6 bullet_f = 0 done_once = 0
Endif
Call circle(bulletx, bullety, 1, 1)
If bullety < -5 Then bullety = 58 bullet_f = 0 done_once = 0 Endif
Endif
'Draw mother ship If y1(0) > 0 And mship_start = 1 Then cnt = 0 y = mshipx + 128 For temp_mship = mshipx To y Step 8 If temp_mship >= 0 Then Call right(temp_mship, mship(cnt)) Endif cnt = cnt + 1 Next temp_mship
mshipx = mshipx + 8 'Off screen so Reset If mshipx > 1023 Then mshipx = 0 - 16 mship_start = 0 Endif Endif
WaitMs 10
'Erase bomb if exists If bombgo = 1 Then
temp.0 = pget(bombx, bomby + 6)
If temp.0 = 1 And bomby > 55 Then 'Hit base temp = abs(bombx - (basex / 8)) 'Call text(0, 20, #bombx + " " + #basex, 0) If temp < 15 Then 'Base hit lives = lives - 1
'Data for Base Exploded For x = 0 To 17 base(x) = LookUp(0, 128, 64, 32, 16, 8, 4, 2, 255, 255, 2, 4, 8, 16, 32, 64, 128, 0), x Next x
y = basex + 136 cnt = 0 'Draw New Exploded Base For x = basex To y Step 8 Call right(x, base(cnt)) cnt = cnt + 1 Next x
WaitMs 1000
'Data for Base For x = 0 To 17 base(x) = LookUp(0, 15, 31, 31, 31, 31, 31, 127, 255, 127, 31, 31, 31, 31, 31, 15, 0), x Next x
Goto loop1 Endif
Endif
Call line(bombx, bomby, bombx, bomby + 5, 0)
If bomby > 63 Then bombgo = 0 'bomby = 0 Endif Endif
'Erase bullet If bullet_f = 1 Then Call circle(bulletx, bullety, 1, 0) Endif
If inv_cnt = 0 Then Goto loop1
speed = inv_cnt * 2
loop_cnt = loop_cnt + 1
Wend
mode = 0 Call clear()
End Proc '###############################################################
Proc draw_inv(x As Word, y As Byte, tp As Bit, gamma As Bit) 'x = 0 to 127 'y= 0 to 7 Dim x1 As Word Dim x2 As Word Dim y1 As Word Dim cnt As Byte
If y > 7 Then Exit cnt = 0 x2 = x * 8 x2 = x2 + y y1 = x2 + 96
If gamma = 1 Then Select Case tp Case 0 For x1 = x2 To y1 Step 8 Call right(x1, invader1(cnt)) cnt = cnt + 1 Next x1 Case 1 For x1 = x2 To y1 Step 8 Call right(x1, invader2(cnt)) cnt = cnt + 1 Next x1 EndSelect Else For x1 = x2 To y1 Step 8 Call right(x1, 0) Next x1 Endif End Proc
Function pget(x As Byte, y As Byte) As Bit If x > 128 Or y > 64 Then Exit
Dim x1 As Word Dim y1 As Byte Dim y2 As Byte Dim temp As Byte
x1 = x * 8 y1 = 7 - y Mod 8 y2 = y / 8 x1 = x1 + y2 temp = read_data(x1)
Proc asteroids() Dim str As String Dim x As Byte Dim offsetx As Single Dim offsety As Single Dim rock_cnt As Byte Dim tempx As Single Dim tempy As Single Dim c1 As Single Dim s1 As Single Dim ship_angle As Single Dim ship_vx As Single Dim ship_vy As Single Dim score As Long Dim hscore As Long Dim lives As Byte Dim dummyx As Single Dim dummyy As Single Dim set As Bit ship_angle = 1.57079632 offsetx = 64 offsety = 32
Dim bulletx As Single Dim bullety As Single Dim bulletvx As Single Dim bulletvy As Single Dim bullet_e As Bit Dim bullet_once As Bit Dim ship_px(3) As Single Dim ship_py(3) As Single Dim rock(4) As Byte Dim rock_x(4) As Single Dim rock_y(4) As Single Dim rock_vx(4) As Single Dim rock_vy(4) As Single
bullet_once = 0 bullet_e = 0
Call randomize()
score = 0 lives = 9 'Intro Call clear() str = "Asteroids" For x = 128 To 17 Step -1 Call text(x, 25, str, 1) WaitMs 10 Next x
WaitMs 3000
Call countdown()
loop7:
Call clear()
'Call countdown()
loop6:
Call clear()
For x = 0 To 3
rock(x) = 4
loop4: rock_x(x) = 127 * rnd() If rock_x(x) > 127 Or rock_x(x) < 1 Then Goto loop4
loop5: rock_y(x) = 65 * rnd() If rock_y(x) > 64 Or rock_x(x) < 1 Then Goto loop5
loop2: rock_vx(x) = 10 * rnd() 'Velocity rock x If rock_vx(x) > 3 Or rock_vx(x) < 1 Then Goto loop2 If rand.24 = 1 Then rock_vx(x) = 0 - rock_vx(x)
loop3: rock_vy(x) = 10 * rnd() 'velocity rock y If rock_vy(x) > 3 Or rock_vy(x) < 1 Then Goto loop3 If rand.15 = 1 Then rock_vy(x) = 0 - rock_vy(x)
'Erase jet If set = 1 Then set = 0 Call circle(dummyx, dummyy, 2, 0) Endif
'Erase Rocks
For x = 0 To 3 If rock(x) > 0 Then Call circle(rock_x(x), rock_y(x), rock(x), 0) Endif Next x
'delete bullet If bullet_e = 1 Then Call circle(bulletx, bullety, 1, 0) Endif
'Detect edge of screen and flip to other side rock_cnt = 0 For x = 0 To 3 If rock(x) > 0 Then rock_cnt = rock_cnt + 1 If rock(x) > 0 Then rock_x(x) = rock_x(x) + rock_vx(x) If rock_x(x) < -4 Then rock_x(x) = 132 If rock_x(x) > 132 Then rock_x(x) = -4 rock_y(x) = rock_y(x) + rock_vy(x) If rock_y(x) < -4 Then rock_y(x) = 68 If rock_y(x) > 68 Then rock_y(x) = -4 Endif Next x
If offsetx > 137 Then offsetx = -10 If offsetx < -11 Then offsetx = 130 If offsety > 74 Then offsety = -10 If offsety < -10 Then offsety = 74
If bulletx > 129 Or bulletx < -2 Then bullet_e = 0 bullet_once = 0 Endif
If bullety > 66 Or bullety < -2 Then bullet_e = 0 bullet_once = 0 Endif
If rock_cnt = 0 Then WaitMs 100 Goto loop6 Endif
Wend
end_loop: Call clear() mode = 0
End Proc
'############################# PONG ############################### Proc pong() Call randomize() Call clear() Dim paddle As Byte Dim x As Byte Dim ballx As Byte Dim bally As Byte Dim ball_fire As Byte Dim ballx_dif As Single Dim bally_dif As Single Dim score As Long Dim hscore As Long Dim temp As Byte 'Dim temp1 As Byte Dim lives As Byte Dim brick(16) As Byte Dim brick_cnt As Byte
For x = 128 To 35 Step -1 Call text(x, 21, "PONG ", 2) WaitMs 5 Next x
WaitMs 2000
Call countdown()
loop4:
score = 0 lives = 20
loop1:
Call clear()
'draw wall For x = 0 To 15 brick(x) = 1 If x < 8 Then Call text(0, x * 8, Chr(0x7f), 0) Endif If x > 7 Then temp = 8 * (x - 8) Call text(6, temp, Chr(0x7f), 0) Call line(0, temp, 15, temp, 0) Endif Next x
bally_dif = 100 * rnd() If bally_dif > 5 Or bally_dif < 1 Then Goto loop
While RA4 = 1
If RA0 = 0 Then paddle = paddle - 1 If paddle = 255 Then paddle = 0 Endif
If RA2 = 0 Then paddle = paddle + 1 If paddle >= 52 Then paddle = 52 Endif
'draw paddle
Call line(123, paddle - 1, 127, paddle - 1, 0) For x = 123 To 127 Call line(x, paddle, x, paddle + 10, 1) Next x Call line(123, paddle + 11, 127, paddle + 11, 0)
'Fire Ball If RA5 = 0 And ball_fire = 0 Then ball_fire = 1 ballx_dif = 255 Endif
If ball_fire = 1 Then
If RA0 = 0 And ballx = 120 Then bally_dif = 255 Endif
If RA2 = 0 And ballx = 120 Then bally_dif = 1 Endif
If bally < 3 Then loop2: temp = 100 * rnd() If temp > 4 Or temp < 1 Then Goto loop2 bally_dif = temp Endif
If bally > 60 Then loop3: temp = 100 * rnd() If temp > 4 Or temp < 1 Then Goto loop3 bally_dif = 0 - temp Endif
bally = bally + bally_dif
If ballx < 5 Then ballx_dif = 1 Endif
If ballx > 140 Then ball_fire = 0 ballx_dif = 0 lives = lives - 1 Endif
ballx = ballx + ballx_dif
'detect if close to paddle If ballx > 119 And ballx < 123 Then temp = (bally) - paddle If temp < 11 Then ballx_dif = 255 Endif
'detect bricks temp.0 = pget(ballx - 4, bally)
If temp.0 = 1 And ballx < 15 Then 'Hit something 'determine which brick temp = bally / 8 If ballx > 6 Then brick(temp + 8) = 0 score = score + 500 Endif
If ballx < 9 Then brick(temp) = 0 score = score + 500 Endif
'Redraw wall brick_cnt = 0 For x = 0 To 15 If x < 8 Then If brick(x) = 1 Then Call text(0, x * 8, Chr(0x7f), 0) Else Call text(0, x * 8, " ", 0) Endif Endif If x > 7 Then temp = 8 * (x - 8) If brick(x) = 1 Then Call text(6, temp, Chr(0x7f), 0) Else Call text(6, temp, " ", 0) Endif
Call line(0, temp, 15, temp, 0) Endif If brick(x) = 1 Then brick_cnt = brick_cnt + 1 Next x If brick_cnt = 0 Then alarm = 1 WaitMs 2000 alarm = 0 Goto loop1 Endif ballx_dif = 1 Endif Else ballx = 120 bally = paddle + 5 Endif
If lives = 0 Then Call text(15, 17, "Game Over", 1)
'Scores here Call text(30, 32, "Score " + #score, 0)
Proc text(x As Byte, y As Byte, str As String, size As Byte) Dim x1 As Byte Dim x2 As Byte Dim x3 As Byte Call size(size) Call command(0x21) Call data_w(x) Call data_w(0) Call data_w(y) Call command(0x20) x2 = Len(str) For x1 = 1 To x2 x3 = Asc(MidStr(str, x1, 1)) Call data_w(x3) If size > 1 Then WaitUs 20 Next x1 End Proc
If year > 0x99 Then year = 0x20 If year = 0 Then year = 0x20 If month > 0x12 Or month < 0x01 Then month = 0x01 If date > 0x31 Or date < 0x01 Then date = 0x01 If hour > 0x23 Then mode = 4 Endif
second = bcd2bin(second) minute = bcd2bin(minute) hour = bcd2bin(hour) day = bcd2bin(day) date = bcd2bin(date) month = bcd2bin(month) year = bcd2bin(year) Call calc_day() End Proc
Proc put_time() second = bin2bcd(second) minute = bin2bcd(minute) hour = bin2bcd(hour) day = bin2bcd(day) date = bin2bcd(date) month = bin2bcd(month) year = bin2bcd(year)
I2CWrite sda, scl, 0xd0, 0, second I2CWrite sda, scl, 0xd0, 1, minute I2CWrite sda, scl, 0xd0, 2, hour I2CWrite sda, scl, 0xd0, 3, day I2CWrite sda, scl, 0xd0, 4, date I2CWrite sda, scl, 0xd0, 5, month I2CWrite sda, scl, 0xd0, 6, year End Proc
Proc display_time(x As Byte, y As Byte)
Dim temp As Byte Dim length As Byte 'Dim dummy As Single
str = ""
If mode = 0 Then Call get_time()
If old_year <> year Then Call calc_bst(year) old_year = year Endif
If mode > 0 Then second = 0
If mode = 4 Then If fl = 0 Then If hour < 10 Then str = " " + #hour + ":" Else str = #hour + ":" Endif Else str = " :" Endif Else If hour < 10 Then str = " " + #hour + ":" Else str = #hour + ":" Endif Endif
If mode = 5 Then If fl = 0 Then If minute < 10 Then str = str + "0" + #minute + ":" Else str = str + #minute + ":" Endif Else str = str + " :" Endif Else If minute < 10 Then str = str + "0" + #minute + ":" Else str = str + #minute + ":" Endif Endif
If second < 10 Then str = str + "0" + #second Else str = str + #second Endif
Call text(x + 20, y, str, 1)
'########### Day of Week ############
Call calc_day()
Select Case day Case 1 str = "Sunday" Case 2 str = "Monday" Case 3 str = "Tuesday" Case 4 str = "Wednesday" Case 5 str = "Thursday" Case 6 str = "Friday" Case 7 str = "Saturday" EndSelect
'Call text(x, y + 16, str, 0)
'############ Date ##########
If mode = 3 Then If fl = 0 Then If date < 10 Then str = str + " " + #date Else str = str + " " + #date Endif Else str = str + " " Endif Else If date < 10 Then str = str + " " + #date Else str = str + " " + #date Endif Endif
'################ change clock for BST ##############
If bst = 1 And month = 10 And date = bst_oct And hour = 1 Then hour = 0 bst = 0 Call put_time() Endif
If bst = 0 And month = 3 And date = bst_march And hour = 0 Then hour = 1 bst = 1 Call put_time() Endif
End Proc
Proc calc_bst(yr As Word) yr = yr + 2000 'got true year Dim temp As Word Dim temp1 As Byte Dim temp_month As Byte Dim temp_date As Byte
temp = 100 * (31 - (5 * yr / 4 + 4) Mod 7)
temp1 = temp Mod 100 If temp1 > 0 Then temp = temp + 100 - temp1 bst_march = temp / 100 Else bst_march = temp / 100 Endif
temp = 100 * (31 - (5 * yr / 4 + 1) Mod 7)
temp1 = temp Mod 100 If temp1 > 0 Then temp = temp + 100 - temp1 bst_oct = temp / 100 Else bst_oct = temp / 100 Endif
temp_month = month 'bcd2bin(month) temp_date = date 'bcd2bin(date)
Select Case temp_month Case 1, 2, 11, 12 bst = 0 Case 4, 5, 6, 7, 8, 9 bst = 1 EndSelect
If temp_month = 3 Then If temp_date > bst_march Then bst = 1 If temp_date < bst_march Then bst = 0 Endif
If temp_month = 10 Then If temp_date > bst_oct Then bst = 0 If temp_date < bst_oct Then bst = 1 Endif
If temp_month = 3 Then If temp_date >= bst_march Then If hour = 0 And bst = 0 Then hour = 1 bst = 1 Call put_time() Endif Endif Endif
If temp_month = 10 Then If temp_date >= bst_oct Then If hour = 1 And bst = 1 Then hour = 0 bst = 0 Call put_time() Endif Endif Endif
End Proc
Proc clear() Call command(0x06) WaitMs 1 'Allow time for screen to clear End Proc
Proc size(x As Byte) Call command(0x22) Select Case x Case 0 Call data_w(0) Call data_w(0) Case 1 Call data_w(1) Call data_w(1) Case 2 Call data_w(2) Call data_w(2) Case 3 Call data_w(3) Call data_w(3) EndSelect End Proc
Proc calc_day() Dim temp As Word Dim temp_year As Byte Dim temp_month As Byte Dim temp_date As Byte Dim mt As Byte Dim ly As Bit temp_year = year temp_month = month temp_date = date temp = temp_year Mod 4 If temp = 0 Then ly = 1 Else ly = 0 temp = temp_year / 4 Select Case temp_month Case 1 If ly = 1 Then mt = 6 Else mt = 0 Endif Case 2 If ly = 1 Then mt = 2 Else mt = 3 Endif Case 3, 4, 5, 6, 7, 8, 9, 10, 11, 12 mt = LookUp(0, 0, 0, 3, 6, 1, 4, 6, 2, 5, 0, 3, 5), temp_month EndSelect Dim res As Word res = 6 + temp_year + temp + mt + temp_date temp = res res = res / 7 res = res * 7 day = 1 + (temp - res) End Proc
Function bin2bcd(var As Byte) As Byte Dim temp As Byte Dim temp1 As Byte If var > 99 Then Exit temp = var Mod 10 temp1 = var / 10 Mod 10 temp1 = ShiftLeft(temp1, 4) bin2bcd = temp Or temp1 End Function
Function bcd2bin(var As Byte) As Byte Dim temp As Byte Dim temp1 As Byte temp = var And 0xf0 temp = ShiftRight(temp, 4) temp = temp * 10 temp1 = var And 0x0f bcd2bin = temp + temp1 End Function
Proc maxdate() Dim temp As Byte Dim ly As Bit temp = (year) Mod 4 If temp = 0 Then ly = 1 Else ly = 0 temp = (month) If ly = 1 Then datemax = LookUp(0, 31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31), temp Else datemax = LookUp(0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31), temp Endif End Proc
Proc command(x As Byte) PORTB = x cs = 1 cd = 1 gt = 1 cs = 0 we = 0 we = 1 cs = 1 End Proc
Proc data_w(x As Byte) PORTB = x cd = 0 gt = 1 cs = 1 cs = 0 we = 0 we = 1 cs = 1 End Proc
Function read_data(addy As Word) As Byte Dim x1 As Byte Call command(0x0e) Call data_w(addy.LB) Call command(0x0f) Call data_w(addy.HB) Call command(0x09) TRISB = 0xff cd = 0 cs = 0 gt = 0 gt = 1 cs = 1 cs = 0 'Dummy Read gt = 0 gt = 1 cs = 1 cs = 0 gt = 0 x1 = PORTB gt = 1 cs = 1 TRISB = 0x00 read_data = x1 End Function
Proc right(x As Word, temp As Byte) Call command(0x0e) 'set address low byte Call data_w(x.LB) Call command(0x0f) 'Set address high byte Call data_w(x.HB) Call command(0x08) 'Put data Call data_w(temp) End Proc
Proc screen(x As Bit) Select Case x Case 0 Call command(0x01) Case 1 Call command(0x02) EndSelect End Proc
Proc countdown() Call clear() Dim x As Byte For x = 5 To 1 Step -1 Call text(53, 20, #x, 2) WaitMs 500 Next x End Proc
Proc menu(x As Byte) Dim temp As Byte temp = 8 + x * 8 Call clear() Call text(50, 0, "Games", 0) Call line(50, 8, 78, 8, 1) Call line(50, 9, 78, 9, 1) Call text(1, 16, "Asteroids", 0) Call text(1, 24, "Lunar Lander", 0) Call text(1, 32, "Invaders", 0) Call text(1, 40, "Pong", 0) Call text(78, temp, "<", 0) WaitMs 100 End Proc '_____ Stuff here to talk to the display ________
Proc plot(x As Byte, y As Byte, gamma As Bit)
If x > 255 Or y > 63 Then Exit
Dim x1 As Word Dim y1 As Byte Dim y2 As Byte Dim y3 As Byte Dim temp As Byte
x1 = x * 8 y1 = 7 - y Mod 8 y3.y1 = 1 y2 = y / 8 x1 = x1 + y2
Call command(0x0e) 'set address 0 Call data_w(x1.LB) Call command(0x0f) Call data_w(x1.HB) temp = read_data(x1) 'data_read = temp Select Case gamma Case 1 temp = temp Or y3 Case 0 y3 = Not y3 temp = temp And y3 EndSelect
Call right(x1, temp)
End Proc
'########################################################################################################### 'Bresenhams Circle drawing routine courtesy of John Kennedy (again).. :)
Proc circle(cx As Word, cy As Word, rad As Word, gamma As Bit) If rad = 0 Then Exit 'Variables Dim x As Word Dim y As Word Dim xchange As Word Dim ychange As Word Dim raderror As Word Dim tempx As Word Dim tempy As Word Dim temp123 As Word x = rad y = 0 xchange = 1 - (2 * rad) 'produces negative number but no fear... ychange = 1 raderror = 0
While x >= y
tempx = cx + x tempy = cy + y Call plot(tempx, tempy, gamma) tempx = cx - x tempy = cy + y Call plot(tempx, tempy, gamma) tempx = cx - x tempy = cy - y Call plot(tempx, tempy, gamma) tempx = cx + x tempy = cy - y Call plot(tempx, tempy, gamma) tempx = cx + y tempy = cy + x Call plot(tempx, tempy, gamma) tempx = cx - y tempy = cy + x Call plot(tempx, tempy, gamma) tempx = cx - y tempy = cy - x Call plot(tempx, tempy, gamma) tempx = cx + y tempy = cy - x Call plot(tempx, tempy, gamma)
y = y + 1 raderror = raderror + ychange ychange = ychange + 2
temp123 = 2 * raderror + xchange
If temp123 > 0 And temp123 < 32768 Then x = x - 1 raderror = raderror + xchange xchange = xchange + 2 Endif Wend End Proc
'########################################################################################################### '____ Other essential stuff to make this all work _____ Function neg(arg1 As Word) As Word neg = 65535 - arg1 + 1 End Function
Function abs(arg1 As Word) As Word If arg1 > 32768 Then arg1 = 65535 - arg1 + 1 Endif abs = arg1 End Function
