Advertisement
Mesaif

Traffic Lights V1.3

May 13th, 2016
73
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 11.57 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.  
  26.  
  27. %SCREEN SET UP%
  28. View.Set ("graphics:vga,offscreenonly")
  29. View.Set ("graphics: 1000;1000")
  30. %SCREEN SET UP%
  31.  
  32. %VARIABLES%
  33. var statusI : string
  34. var RstatusI : string := "off"
  35. var YstatusI : string := "off"
  36. var GstatusI : string := "off"
  37.  
  38. var statusII : string
  39. var RstatusII : string := "off"
  40. var YstatusII : string := "off"
  41. var GstatusII : string := "off"
  42.  
  43. var debug : int := 0 %DEBUG VARIABLE%
  44.  
  45. var commands : string := "tl: test lights, cls: clear text, rtn: begin routine"
  46.  
  47. var xI : int := 10
  48. var xI2 : int := 85
  49. var yI : int := 360
  50. var yI2 : int := 390
  51.  
  52. var xII : int := 360
  53. var xII2 : int := 390
  54. var yII : int := 790
  55. var yII2 : int := 715
  56.  
  57. %%%%%%%%%%%%%%%%%%%%%%%%%%%PROCEDURES%%%%%%%%%%%%%%%%%%%%%%%%%%%
  58.  
  59.  
  60.  
  61. procedure drawStreet %Draw the street
  62.  
  63. %Background
  64. drawbox (0, 0, 800, 800, black)
  65. drawfill (10, 10, green, black)
  66. %Horizontal Lines
  67. drawline (0, 350, 350, 350, black)
  68. drawline (0, 450, 350, 450, black)
  69.  
  70. drawline (450, 350, 800, 350, black)
  71. drawline (450, 450, 800, 450, black)
  72.  
  73.  
  74. %Vertical Lines
  75. drawline (350, 800, 350, 450, black)
  76. drawline (350, 0, 350, 350, black)
  77.  
  78. drawline (450, 800, 450, 450, black)
  79. drawline (450, 0, 450, 350, black)
  80.  
  81. %MIDDLE WHITE
  82. drawfillbox (350, 350, 450, 450, white)
  83. drawfill (400, 400, grey, black) %pavement
  84.  
  85. %Street Lines
  86. Draw.DashedLine (400, 800, 400, 0, drawDash, yellow)
  87. Draw.DashedLine (0, 400, 800, 400, drawDash, yellow)
  88.  
  89.  
  90.  
  91.  
  92. drawfillbox (350, 350, 450, 450, grey)
  93.  
  94. end drawStreet
  95. procedure drawCrosswalk %Automatically draw crosswalks
  96.  
  97.  
  98.  
  99. for iV : 355 .. 445 by 5 %For loop to draw vertical crosswalks
  100. drawline (iV, 465, iV, 450, white)
  101. drawline (iV, 350, iV, 335, white)
  102. end for
  103.  
  104. end drawCrosswalk
  105. procedure drawHwalk
  106. for decreasing iH : 445 .. 355 by 5 %For loop to automatically draw horizontal crosswalk lines
  107. drawline (335, iH, 350, iH, white)
  108. drawline (450, iH, 465, iH, white)
  109. end for
  110. end drawHwalk
  111.  
  112. procedure drawLights %Procedure to draw ovals for lights that can take input to fill
  113.  
  114. %%%%SET I%%%%
  115.  
  116. drawbox (310, 460, 340, 530, black) %FRAME
  117. drawfill (316, 461, yellow, black) %FRAME
  118.  
  119. %TOP%
  120. drawoval (325, 515, 10, 10, black)
  121. if RstatusI = "on" then
  122. drawfill (325, 515, 12, black)
  123. elsif RstatusI = "off" then
  124. drawfill (325, 515, white, black)
  125. end if
  126.  
  127. drawoval (325, 495, 10, 10, black)
  128. if YstatusI = "on" then
  129. drawfill (325, 495, 43, black)
  130. elsif YstatusI = "off" then
  131. drawfill (325, 495, white, black)
  132. end if
  133.  
  134. drawoval (325, 475, 10, 10, black)
  135. if GstatusI = "on" then
  136. drawfill (325, 475, 10, black)
  137. elsif GstatusI = "off" then
  138. drawfill (325, 475, white, black)
  139. end if
  140.  
  141. %BOTTOM%
  142. drawbox (460, 270, 490, 340, black) %FRAME
  143. drawfill (461, 271, yellow, black) %FRAME
  144.  
  145. drawoval (475, 325, 10, 10, black)
  146. if RstatusI = "on" then
  147. drawfill (475, 325, 12, black)
  148. elsif RstatusI = "off" then
  149. drawfill (475, 325, white, black)
  150. end if
  151.  
  152. drawoval (475, 305, 10, 10, black)
  153. if YstatusI = "on" then
  154. drawfill (475, 305, 43, black)
  155. elsif YstatusI = "off" then
  156. drawfill (475, 305, white, black)
  157. end if
  158.  
  159. drawoval (475, 285, 10, 10, black)
  160. if GstatusI = "on" then
  161. drawfill (475, 285, 10, black)
  162. elsif GstatusI = "off" then
  163. drawfill (475, 285, white, black)
  164. end if
  165.  
  166. %%%%SET II%%%%
  167. %LEFT%
  168. drawbox (270, 310, 340, 340, black)
  169. drawfill (271, 311, yellow, black)
  170.  
  171. drawoval (325, 325, 10, 10, black)
  172. if RstatusII = "on" then
  173. drawfill (325, 325, 12, black)
  174. elsif RstatusII = "off" then
  175. drawfill (325, 325, white, black)
  176. end if
  177.  
  178. drawoval (305, 325, 10, 10, black)
  179. if YstatusII = "on" then
  180. drawfill (305, 325, 43, black)
  181. elsif YstatusII = "off" then
  182. drawfill (305, 325, white, black)
  183. end if
  184.  
  185. drawoval (285, 325, 10, 10, black)
  186. if GstatusII = "on" then
  187. drawfill (285, 325, 10, black)
  188. elsif GstatusII = "off" then
  189. drawfill (285, 325, white, black)
  190. end if
  191.  
  192. %RIGHT
  193.  
  194. drawbox (460, 460, 530, 490, black)
  195. drawfill (461, 461, yellow, black)
  196.  
  197. drawoval (475, 475, 10, 10, black)
  198. if RstatusII = "on" then
  199. drawfill (475, 475, 12, black)
  200. elsif RstatusII = "off" then
  201. drawfill (475, 475, white, black)
  202. end if
  203.  
  204. drawoval (495, 475, 10, 10, black)
  205. if YstatusII = "on" then
  206. drawfill (495, 475, 43, black)
  207. elsif YstatusII = "off" then
  208. drawfill (495, 475, white, black)
  209. end if
  210.  
  211. drawoval (515, 475, 10, 10, black)
  212. if GstatusII = "on" then
  213. drawfill (515, 475, 10, black)
  214. elsif GstatusII = "off" then
  215. drawfill (515, 475, white, black)
  216. end if
  217.  
  218. end drawLights
  219.  
  220. procedure runLightsI %procedure to understand input/set status (I)
  221.  
  222.  
  223. %if statement for section I lights
  224. if statusI = "green" then
  225. RstatusI := "off"
  226. YstatusI := "off"
  227. GstatusI := "on"
  228.  
  229. elsif statusI = "yellow" then
  230. RstatusI := "off"
  231. YstatusI := "on"
  232. GstatusI := "off"
  233.  
  234. elsif statusI = "red" then
  235. RstatusI := "on"
  236. YstatusI := "off"
  237. GstatusI := "off"
  238.  
  239. elsif statusI = "off" then
  240. RstatusI := "off"
  241. YstatusI := "off"
  242. GstatusI := "off"
  243.  
  244. end if
  245.  
  246. end runLightsI
  247. procedure runLightsII %procedure to understand input/set status (II)
  248.  
  249.  
  250. %if statement for section II lights
  251. if statusII = "green" then
  252. RstatusII := "off"
  253. YstatusII := "off"
  254. GstatusII := "on"
  255.  
  256. elsif statusII = "yellow" then
  257. RstatusII := "off"
  258. YstatusII := "on"
  259. GstatusII := "off"
  260.  
  261. elsif statusII = "red" then
  262. RstatusII := "on"
  263. YstatusII := "off"
  264. GstatusII := "off"
  265.  
  266. elsif statusII = "off" then
  267. RstatusII := "off"
  268. YstatusII := "off"
  269. GstatusII := "off"
  270.  
  271. end if
  272.  
  273. end runLightsII
  274.  
  275. procedure runLights %Calls the other two procedures (GENIUS)
  276. runLightsI
  277. runLightsII
  278. end runLights
  279.  
  280. procedure updateLights %Calls two more procedures
  281. runLights
  282. drawLights
  283. end updateLights
  284.  
  285. procedure cleartext %Procedure to clear text
  286. cls
  287. delay (500)
  288. drawStreet
  289. drawLights
  290. end cleartext
  291.  
  292. process Hcar () %The horizontal car
  293. loop
  294. drawfillbox ((xI - 10), yI, (xI2 - 4), yI2, grey) %Removes the previous drawn shape
  295. drawfillbox (xI, yI, xI2, yI2, blue)
  296. xI += 4
  297. xI2 += 4
  298.  
  299. if xI2 >= 330 and xI2 <= 370 then %When the car is near the end of the intersection
  300. if statusII = "red" or statusII = "yellow" then
  301. loop
  302. delay (50)
  303. if statusII = "red" or statusII = "yellow" then
  304. delay (50)
  305. exit when statusII = "green"
  306. end if
  307. end loop
  308. end if
  309. end if
  310. if xI2 >= 800 then
  311. drawfillbox (1, 355, 799, 395, grey)
  312. drawHwalk
  313. xI := 10
  314. xI2 := 85
  315. yI := 360
  316. yI2 := 390
  317. delay (50)
  318.  
  319. end if
  320.  
  321.  
  322. %View.UpdateArea (0, 350, 800, 450)
  323. delay (50)
  324. %drawfillbox (1, 355, 799, 395, white) (OLD VERSION)
  325. drawHwalk
  326. end loop
  327. end Hcar
  328.  
  329. process Vcar () %The vertical car
  330. loop
  331.  
  332. drawfillbox (xII, (yII + 10), xII2, (yII2 + 4), grey)
  333. drawfillbox (xII, yII, xII2, yII2, red)
  334. yII -= 4
  335. yII2 -= 4
  336.  
  337.  
  338. if yII2 <= 470 and yII2 >= 430 then %When the car is near the end of the intersection
  339. if statusI = "red" or statusI = "yellow" then
  340. loop
  341. delay (50)
  342. if statusI = "red" or statusI = "yellow" then
  343. delay (50)
  344. exit when statusI = "green"
  345. end if
  346. end loop
  347. end if
  348. end if
  349. if yII2 <= 0 then
  350. drawfillbox (351, 1, 390, 799, grey)
  351. drawCrosswalk
  352. xII := 360
  353. xII2 := 390
  354. yII := 790
  355. yII2 := 715
  356. delay (50)
  357. end if
  358. %View.UpdateArea (350, 0, 450, 800)
  359. delay (50)
  360. %drawfillbox (351, 1, 390, 799, white) (OLD VERSION)
  361. drawCrosswalk
  362. end loop
  363. end Vcar
  364.  
  365. process drawCars()
  366. fork Hcar()
  367. fork Vcar()
  368. end drawCars
  369.  
  370. procedure beginRoutine %Procedure to begin the routine
  371.  
  372. %Start with green/red lights
  373. statusI := "green"
  374. statusII := "red"
  375. updateLights
  376.  
  377.  
  378. delay (5000) %Delay 5 seconds
  379.  
  380. %Turn first light to yellow before turning to red
  381. statusI := "yellow"
  382. statusII := "red"
  383. updateLights
  384.  
  385.  
  386. delay (1000) %Delay 4 seconds
  387.  
  388. %Turn first light fully red then wait before turning II green
  389. statusI := "red"
  390. statusII := "red"
  391. updateLights
  392.  
  393. delay (2000) %Delay 3 seconds
  394.  
  395. %Reversal of initial state
  396. statusI := "red"
  397. statusII := "green"
  398. updateLights
  399.  
  400. delay (5000) %Delay 5 seconds
  401.  
  402. %Begin turning II to red
  403. statusI := "red"
  404. statusII := "yellow"
  405. updateLights
  406.  
  407. delay (1000) %Delay 4 seconds
  408.  
  409. %Turn both red to get ready for the next loop
  410. statusI := "red"
  411. statusII := "red"
  412. updateLights
  413.  
  414. delay (2000) %Delay 3 seconds
  415.  
  416. end beginRoutine
  417.  
  418.  
  419. procedure debugP %Procedure to debug/test the program
  420.  
  421. var input : string
  422. put "Input: " ..
  423. get input
  424.  
  425. %IF STATEMENT FOR CLS
  426. if input = "cls" then
  427.  
  428. cleartext %Reset status of lights
  429. statusI := "off"
  430. statusII := "off"
  431. drawLights
  432. runLights
  433. drawLights
  434.  
  435. %IF STATEMENT FOR TL
  436. elsif input = "tl" then
  437.  
  438. var IorII : string %Find out if user wants to test set I or set II
  439. put "I or II: " ..
  440. get IorII
  441. if IorII = "I" then
  442.  
  443. put "color: " ..
  444. get statusI
  445. drawLights
  446. runLightsI
  447. elsif IorII = "II" then
  448. put "color: " ..
  449. get statusII
  450. drawLights
  451. runLightsII
  452. end if
  453.  
  454. %IF STATEMENT FOR HELP
  455. elsif input = "help" then
  456. put commands
  457.  
  458. elsif input = "rtn" then
  459. cls
  460. cls
  461.  
  462. beginRoutine
  463.  
  464. else
  465. put "command not recognised"
  466. cleartext
  467.  
  468. end if
  469. end debugP
  470.  
  471.  
  472.  
  473.  
  474. %%%%%%%%%%%%%%%%%%%%%%%%%%%PROCEDURES%%%%%%%%%%%%%%%%%%%%%%%%%%%
  475.  
  476. %Main loop
  477. loop
  478. drawStreet
  479. drawHwalk
  480. drawCrosswalk
  481. drawLights
  482.  
  483. if debug = 1 then
  484. debugP
  485. end if
  486.  
  487. fork drawCars()
  488. View.Update
  489. beginRoutine
  490.  
  491. end loop
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement