Advertisement
Mesaif

Traffic Lights V1.8

May 14th, 2016
105
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 13.17 KB | None | 0 0
  1. %Program that draws a street and works traffic lights
  2.  
  3. %V1.0:
  4. % -Ready to work
  5. %to do:
  6. % - fix bug where car shadows still appear
  7.  
  8. %V1.1:
  9. % - Fixed a bug where car shadows appear after 2-3 cycles
  10. %to do:
  11. % - Fix random speed-ups
  12. % - Add crosswalk for better visuals
  13.  
  14. %V1.2:
  15. % - Added crosswalk (drawn automatically)
  16.  
  17. %V1.3:
  18. % - Changed crosswalk to two separate procedures
  19. % - Added feature to cars that redraw the crosswalk after passing over
  20. % - Fixed bug where horizontal car wouldn't start
  21. %to do:
  22. % - Search for new features to add by testing
  23. % - Add more cars
  24.  
  25. %V1.4:
  26. % - Added input to be taken before starting the program
  27.  
  28. %V1.5:
  29. % - Takes input from mouse
  30. % - Fillcolor varible, fills a drawn shape with a color
  31. % - KBinput added
  32.  
  33. %V1.6:
  34. % - Cleaned up loop to check when light is green, prolongs working state
  35. %to do:
  36. % -Fix bug where cars stop increasingly closer to the intersection
  37.  
  38. %V1.7
  39. % - Fixed bug where cars will go onto the intersection when stopping
  40. % - Fixed Redcar reset to not draw a greybox over the entire lane and cover the blue car for a period of time
  41.  
  42. %V1.8
  43. % - Tried to change a few things to fix car speeding problem
  44.  
  45. %SCREEN SET UP%
  46. View.Set ("graphics:vga,offscreenonly")
  47. View.Set ("graphics: 1000;1000")
  48. %SCREEN SET UP%
  49.  
  50. %VARIABLES%
  51. var statusI : string
  52. var RstatusI : string := "off"
  53. var YstatusI : string := "off"
  54. var GstatusI : string := "off"
  55.  
  56. var statusII : string
  57. var RstatusII : string := "off"
  58. var YstatusII : string := "off"
  59. var GstatusII : string := "off"
  60.  
  61. var debug : int := 0 %DEBUG VARIABLE%
  62.  
  63. var commands : string := "tl: test lights, cls: clear text, rtn: begin routine"
  64.  
  65. var xI : int := 10
  66. var xI2 : int := 85
  67. var yI : int := 360
  68. var yI2 : int := 390
  69.  
  70. var xII : int := 360
  71. var xII2 : int := 390
  72. var yII : int := 790
  73. var yII2 : int := 715
  74.  
  75. var speed : int := 4
  76.  
  77. var fillcolor : int := 72
  78.  
  79. %%%%%%%%%%%%%%%%%%%%%%%%%%%PROCEDURES%%%%%%%%%%%%%%%%%%%%%%%%%%%
  80.  
  81.  
  82.  
  83. procedure drawStreet %Draw the street
  84.  
  85. %Background
  86. drawbox (0, 0, 800, 800, black)
  87. drawfill (10, 10, green, black)
  88. %Horizontal Lines
  89. drawline (0, 350, 350, 350, black)
  90. drawline (0, 450, 350, 450, black)
  91.  
  92. drawline (450, 350, 800, 350, black)
  93. drawline (450, 450, 800, 450, black)
  94.  
  95.  
  96. %Vertical Lines
  97. drawline (350, 800, 350, 450, black)
  98. drawline (350, 0, 350, 350, black)
  99.  
  100. drawline (450, 800, 450, 450, black)
  101. drawline (450, 0, 450, 350, black)
  102.  
  103. %MIDDLE WHITE
  104. drawfillbox (350, 350, 450, 450, white)
  105. drawfill (400, 400, grey, black) %pavement
  106.  
  107. %Street Lines
  108. Draw.DashedLine (400, 800, 400, 0, drawDash, yellow)
  109. Draw.DashedLine (0, 400, 800, 400, drawDash, yellow)
  110.  
  111.  
  112.  
  113.  
  114. drawfillbox (350, 350, 450, 450, grey)
  115.  
  116. end drawStreet
  117. procedure drawCrosswalk %Automatically draw crosswalks
  118.  
  119.  
  120.  
  121. for iV : 355 .. 445 by 5 %For loop to draw vertical crosswalks
  122. drawline (iV, 465, iV, 450, white)
  123. drawline (iV, 350, iV, 335, white)
  124. end for
  125.  
  126. end drawCrosswalk
  127. procedure drawHwalk
  128. for decreasing iH : 445 .. 355 by 5 %For loop to automatically draw horizontal crosswalk lines
  129. drawline (335, iH, 350, iH, white)
  130. drawline (450, iH, 465, iH, white)
  131. end for
  132. end drawHwalk
  133.  
  134. procedure drawLights %Procedure to draw ovals for lights that can take input to fill
  135.  
  136. %%%%SET I%%%%
  137.  
  138. drawbox (310, 460, 340, 530, black) %FRAME
  139. drawfill (316, 461, yellow, black) %FRAME
  140.  
  141. %TOP%
  142. drawoval (325, 515, 10, 10, black)
  143. if RstatusI = "on" then
  144. drawfill (325, 515, 12, black)
  145. elsif RstatusI = "off" then
  146. drawfill (325, 515, white, black)
  147. end if
  148.  
  149. drawoval (325, 495, 10, 10, black)
  150. if YstatusI = "on" then
  151. drawfill (325, 495, 43, black)
  152. elsif YstatusI = "off" then
  153. drawfill (325, 495, white, black)
  154. end if
  155.  
  156. drawoval (325, 475, 10, 10, black)
  157. if GstatusI = "on" then
  158. drawfill (325, 475, 10, black)
  159. elsif GstatusI = "off" then
  160. drawfill (325, 475, white, black)
  161. end if
  162.  
  163. %BOTTOM%
  164. drawbox (460, 270, 490, 340, black) %FRAME
  165. drawfill (461, 271, yellow, black) %FRAME
  166.  
  167. drawoval (475, 325, 10, 10, black)
  168. if RstatusI = "on" then
  169. drawfill (475, 325, 12, black)
  170. elsif RstatusI = "off" then
  171. drawfill (475, 325, white, black)
  172. end if
  173.  
  174. drawoval (475, 305, 10, 10, black)
  175. if YstatusI = "on" then
  176. drawfill (475, 305, 43, black)
  177. elsif YstatusI = "off" then
  178. drawfill (475, 305, white, black)
  179. end if
  180.  
  181. drawoval (475, 285, 10, 10, black)
  182. if GstatusI = "on" then
  183. drawfill (475, 285, 10, black)
  184. elsif GstatusI = "off" then
  185. drawfill (475, 285, white, black)
  186. end if
  187.  
  188. %%%%SET II%%%%
  189. %LEFT%
  190. drawbox (270, 310, 340, 340, black)
  191. drawfill (271, 311, yellow, black)
  192.  
  193. drawoval (325, 325, 10, 10, black)
  194. if RstatusII = "on" then
  195. drawfill (325, 325, 12, black)
  196. elsif RstatusII = "off" then
  197. drawfill (325, 325, white, black)
  198. end if
  199.  
  200. drawoval (305, 325, 10, 10, black)
  201. if YstatusII = "on" then
  202. drawfill (305, 325, 43, black)
  203. elsif YstatusII = "off" then
  204. drawfill (305, 325, white, black)
  205. end if
  206.  
  207. drawoval (285, 325, 10, 10, black)
  208. if GstatusII = "on" then
  209. drawfill (285, 325, 10, black)
  210. elsif GstatusII = "off" then
  211. drawfill (285, 325, white, black)
  212. end if
  213.  
  214. %RIGHT
  215.  
  216. drawbox (460, 460, 530, 490, black)
  217. drawfill (461, 461, yellow, black)
  218.  
  219. drawoval (475, 475, 10, 10, black)
  220. if RstatusII = "on" then
  221. drawfill (475, 475, 12, black)
  222. elsif RstatusII = "off" then
  223. drawfill (475, 475, white, black)
  224. end if
  225.  
  226. drawoval (495, 475, 10, 10, black)
  227. if YstatusII = "on" then
  228. drawfill (495, 475, 43, black)
  229. elsif YstatusII = "off" then
  230. drawfill (495, 475, white, black)
  231. end if
  232.  
  233. drawoval (515, 475, 10, 10, black)
  234. if GstatusII = "on" then
  235. drawfill (515, 475, 10, black)
  236. elsif GstatusII = "off" then
  237. drawfill (515, 475, white, black)
  238. end if
  239.  
  240. end drawLights
  241.  
  242. procedure runLightsI %procedure to understand input/set status (I)
  243.  
  244.  
  245. %if statement for section I lights
  246. if statusI = "green" then
  247. RstatusI := "off"
  248. YstatusI := "off"
  249. GstatusI := "on"
  250.  
  251. elsif statusI = "yellow" then
  252. RstatusI := "off"
  253. YstatusI := "on"
  254. GstatusI := "off"
  255.  
  256. elsif statusI = "red" then
  257. RstatusI := "on"
  258. YstatusI := "off"
  259. GstatusI := "off"
  260.  
  261. elsif statusI = "off" then
  262. RstatusI := "off"
  263. YstatusI := "off"
  264. GstatusI := "off"
  265.  
  266. end if
  267.  
  268. end runLightsI
  269. procedure runLightsII %procedure to understand input/set status (II)
  270.  
  271.  
  272. %if statement for section II lights
  273. if statusII = "green" then
  274. RstatusII := "off"
  275. YstatusII := "off"
  276. GstatusII := "on"
  277.  
  278. elsif statusII = "yellow" then
  279. RstatusII := "off"
  280. YstatusII := "on"
  281. GstatusII := "off"
  282.  
  283. elsif statusII = "red" then
  284. RstatusII := "on"
  285. YstatusII := "off"
  286. GstatusII := "off"
  287.  
  288. elsif statusII = "off" then
  289. RstatusII := "off"
  290. YstatusII := "off"
  291. GstatusII := "off"
  292.  
  293. end if
  294.  
  295. end runLightsII
  296.  
  297. procedure runLights %Calls the other two procedures (GENIUS)
  298. runLightsI
  299. runLightsII
  300. end runLights
  301.  
  302. procedure updateLights %Calls two more procedures
  303. runLights
  304. drawLights
  305. end updateLights
  306.  
  307. procedure cleartext %Procedure to clear text
  308. cls
  309. delay (500)
  310. drawStreet
  311. drawLights
  312. end cleartext
  313.  
  314. process Hcar () %The horizontal car
  315. loop
  316. drawfillbox ((xI - 10), yI, (xI2 - 4), yI2, grey) %Removes the previous drawn shape
  317. drawfillbox (xI, yI, xI2, yI2, blue)
  318. xI := xI + speed
  319. xI2 := xI2 + speed
  320.  
  321. if xI2 <335 and xI2 >320 then %When the car is near the end of the intersection
  322. if statusII = "red" or statusII = "yellow" then
  323. loop
  324. delay (10)
  325. drawHwalk
  326. exit when statusII = "green" %exit when green
  327. end loop
  328. end if
  329. end if
  330. if xI2 >= 800 then
  331. drawfillbox (1, 355, 799, 395, grey)
  332. drawHwalk
  333. xI := 10
  334. xI2 := 85
  335. yI := 360
  336. yI2 := 390
  337. delay (50)
  338.  
  339. end if
  340.  
  341.  
  342. %View.UpdateArea (0, 350, 800, 450)
  343. delay (50)
  344. %drawfillbox (1, 355, 799, 395, white) (OLD VERSION)
  345. drawHwalk
  346. speed:= 4
  347. end loop
  348. end Hcar
  349.  
  350. process Vcar () %The vertical car
  351. loop
  352.  
  353. drawfillbox (xII, (yII + 10), xII2, (yII2 + 4), grey)
  354. drawfillbox (xII, yII, xII2, yII2, red)
  355. yII := yII - speed
  356. yII2 := yII2 - speed
  357.  
  358.  
  359. if yII2 > 465 and yII2 < 480 then %When the car is near the end of the intersection
  360. if statusI = "red" or statusI = "yellow" then
  361. loop
  362. delay (10)
  363. exit when statusI = "green" %exit when green
  364. end loop
  365. end if
  366. end if
  367. if yII2 <= 0 then
  368. drawfillbox (351, 1, 390, 349, grey)
  369. drawfillbox(351,451,390,799,grey)
  370. drawCrosswalk
  371. xII := 360
  372. xII2 := 390
  373. yII := 790
  374. yII2 := 715
  375. delay (50)
  376. end if
  377. %View.UpdateArea (350, 0, 450, 800)
  378. delay (50)
  379. %drawfillbox (351, 1, 390, 799, white) (OLD VERSION)
  380. drawCrosswalk
  381. speed := 4
  382. end loop
  383. end Vcar
  384.  
  385. process drawCars ()
  386. fork Hcar ()
  387. fork Vcar ()
  388. end drawCars
  389.  
  390. procedure beginRoutine %Procedure to begin the routine
  391.  
  392. %Start with green/red lights
  393. statusI := "green"
  394. statusII := "red"
  395. updateLights
  396.  
  397.  
  398. delay (5000) %Delay 5 seconds
  399.  
  400. %Turn first light to yellow before turning to red
  401. statusI := "yellow"
  402. statusII := "red"
  403. updateLights
  404.  
  405.  
  406. delay (1000) %Delay 4 seconds
  407.  
  408. %Turn first light fully red then wait before turning II green
  409. statusI := "red"
  410. statusII := "red"
  411. updateLights
  412.  
  413. delay (2000) %Delay 3 seconds
  414.  
  415. %Reversal of initial state
  416. statusI := "red"
  417. statusII := "green"
  418. updateLights
  419.  
  420. delay (5000) %Delay 5 seconds
  421.  
  422. %Begin turning II to red
  423. statusI := "red"
  424. statusII := "yellow"
  425. updateLights
  426.  
  427. delay (1000) %Delay 4 seconds
  428.  
  429. %Turn both red to get ready for the next loop
  430. statusI := "red"
  431. statusII := "red"
  432. updateLights
  433.  
  434. delay (2000) %Delay 3 seconds
  435.  
  436. end beginRoutine
  437.  
  438.  
  439. procedure debugP %Procedure to debug/test the program
  440.  
  441. var input : string
  442. put "Input: " ..
  443. get input
  444.  
  445. %IF STATEMENT FOR CLS
  446. if input = "cls" then
  447.  
  448. cleartext %Reset status of lights
  449. statusI := "off"
  450. statusII := "off"
  451. drawLights
  452. runLights
  453. drawLights
  454.  
  455. %IF STATEMENT FOR TL
  456. elsif input = "tl" then
  457.  
  458. var IorII : string %Find out if user wants to test set I or set II
  459. put "I or II: " ..
  460. get IorII
  461. if IorII = "I" then
  462.  
  463. put "color: " ..
  464. get statusI
  465. drawLights
  466. runLightsI
  467. elsif IorII = "II" then
  468. put "color: " ..
  469. get statusII
  470. drawLights
  471. runLightsII
  472. end if
  473.  
  474. %IF STATEMENT FOR HELP
  475. elsif input = "help" then
  476. put commands
  477.  
  478. elsif input = "rtn" then
  479. cls
  480. cls
  481.  
  482. beginRoutine
  483.  
  484. else
  485. put "command not recognised"
  486. cleartext
  487.  
  488. end if
  489. end debugP
  490.  
  491. process mouseDraw ()
  492. Mouse.ButtonChoose("multibutton")
  493.  
  494. var mx, my, b : int
  495. var x, y, x1, y1 : int := 0
  496. loop
  497. mousewhere (mx, my, b)
  498. if b = 1 then
  499. x1 := mx
  500. y1 := my
  501. drawline (x, y, x1, y1, black)
  502. elsif b = 100 then
  503. drawfill(mx,my,fillcolor,black)
  504. end if
  505. x := mx
  506. y := my
  507.  
  508. end loop
  509. end mouseDraw
  510.  
  511. process KBinput
  512. var chars : array char of boolean
  513. Input.KeyDown(chars)
  514. if chars ('e') then
  515. cls
  516. delay(500)
  517. cls
  518. end if
  519. end KBinput
  520.  
  521.  
  522.  
  523.  
  524. %%%%%%%%%%%%%%%%%%%%%%%%%%%PROCEDURES%%%%%%%%%%%%%%%%%%%%%%%%%%%
  525.  
  526. %Main loop
  527. var input: string
  528. put "Input: ".. get input
  529. if input = "start" then
  530. loop
  531. fork mouseDraw()
  532. fork KBinput()
  533. delay (500)
  534. drawStreet
  535. drawHwalk
  536. drawCrosswalk
  537. drawLights
  538.  
  539. if debug = 1 then
  540. debugP
  541. end if
  542. fork drawCars ()
  543. View.Update
  544. beginRoutine
  545. end loop
  546. else put "Not recognised. Type start to begin..."
  547. end if
  548.  
  549.  
  550.  
  551.  
  552. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  553. %Saif K. and Aaron G. @ 2016%
  554. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement