Advertisement
Mesaif

Traffic Lights V1.2

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