Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- %Program that draws a street and works traffic lights
- %V1.0:
- % -Ready to work
- %to do:
- % - fix bug where car shadows still appear
- %V1.1:
- % - Fixed a bug where car shadows appear after 2-3 cycles
- %to do:
- % - Fix random speed-ups
- % - Add crosswalk for better visuals
- %V1.2:
- % - Added crosswalk (drawn automatically)
- %V1.3:
- % - Changed crosswalk to two separate procedures
- % - Added feature to cars that redraw the crosswalk after passing over
- % - Fixed bug where horizontal car wouldn't start
- %to do:
- % - Search for new features to add by testing
- % - Add more cars
- %V1.4:
- % - Added input to be taken before starting the program
- %V1.5:
- % - Takes input from mouse
- % - Fillcolor varible, fills a drawn shape with a color
- % - KBinput added
- %V1.6:
- % - Cleaned up loop to check when light is green, prolongs working state
- %to do:
- % -Fix bug where cars stop increasingly closer to the intersection
- %V1.7
- % - Fixed bug where cars will go onto the intersection when stopping
- % - Fixed Redcar reset to not draw a greybox over the entire lane and cover the blue car for a period of time
- %V1.8
- % - Tried to change a few things to fix car speeding problem
- %SCREEN SET UP%
- View.Set ("graphics:vga,offscreenonly")
- View.Set ("graphics: 1000;1000")
- %SCREEN SET UP%
- %VARIABLES%
- var statusI : string
- var RstatusI : string := "off"
- var YstatusI : string := "off"
- var GstatusI : string := "off"
- var statusII : string
- var RstatusII : string := "off"
- var YstatusII : string := "off"
- var GstatusII : string := "off"
- var debug : int := 0 %DEBUG VARIABLE%
- var commands : string := "tl: test lights, cls: clear text, rtn: begin routine"
- var xI : int := 10
- var xI2 : int := 85
- var yI : int := 360
- var yI2 : int := 390
- var xII : int := 360
- var xII2 : int := 390
- var yII : int := 790
- var yII2 : int := 715
- var speed : int := 4
- var fillcolor : int := 72
- %%%%%%%%%%%%%%%%%%%%%%%%%%%PROCEDURES%%%%%%%%%%%%%%%%%%%%%%%%%%%
- procedure drawStreet %Draw the street
- %Background
- drawbox (0, 0, 800, 800, black)
- drawfill (10, 10, green, black)
- %Horizontal Lines
- drawline (0, 350, 350, 350, black)
- drawline (0, 450, 350, 450, black)
- drawline (450, 350, 800, 350, black)
- drawline (450, 450, 800, 450, black)
- %Vertical Lines
- drawline (350, 800, 350, 450, black)
- drawline (350, 0, 350, 350, black)
- drawline (450, 800, 450, 450, black)
- drawline (450, 0, 450, 350, black)
- %MIDDLE WHITE
- drawfillbox (350, 350, 450, 450, white)
- drawfill (400, 400, grey, black) %pavement
- %Street Lines
- Draw.DashedLine (400, 800, 400, 0, drawDash, yellow)
- Draw.DashedLine (0, 400, 800, 400, drawDash, yellow)
- drawfillbox (350, 350, 450, 450, grey)
- end drawStreet
- procedure drawCrosswalk %Automatically draw crosswalks
- for iV : 355 .. 445 by 5 %For loop to draw vertical crosswalks
- drawline (iV, 465, iV, 450, white)
- drawline (iV, 350, iV, 335, white)
- end for
- end drawCrosswalk
- procedure drawHwalk
- for decreasing iH : 445 .. 355 by 5 %For loop to automatically draw horizontal crosswalk lines
- drawline (335, iH, 350, iH, white)
- drawline (450, iH, 465, iH, white)
- end for
- end drawHwalk
- procedure drawLights %Procedure to draw ovals for lights that can take input to fill
- %%%%SET I%%%%
- drawbox (310, 460, 340, 530, black) %FRAME
- drawfill (316, 461, yellow, black) %FRAME
- %TOP%
- drawoval (325, 515, 10, 10, black)
- if RstatusI = "on" then
- drawfill (325, 515, 12, black)
- elsif RstatusI = "off" then
- drawfill (325, 515, white, black)
- end if
- drawoval (325, 495, 10, 10, black)
- if YstatusI = "on" then
- drawfill (325, 495, 43, black)
- elsif YstatusI = "off" then
- drawfill (325, 495, white, black)
- end if
- drawoval (325, 475, 10, 10, black)
- if GstatusI = "on" then
- drawfill (325, 475, 10, black)
- elsif GstatusI = "off" then
- drawfill (325, 475, white, black)
- end if
- %BOTTOM%
- drawbox (460, 270, 490, 340, black) %FRAME
- drawfill (461, 271, yellow, black) %FRAME
- drawoval (475, 325, 10, 10, black)
- if RstatusI = "on" then
- drawfill (475, 325, 12, black)
- elsif RstatusI = "off" then
- drawfill (475, 325, white, black)
- end if
- drawoval (475, 305, 10, 10, black)
- if YstatusI = "on" then
- drawfill (475, 305, 43, black)
- elsif YstatusI = "off" then
- drawfill (475, 305, white, black)
- end if
- drawoval (475, 285, 10, 10, black)
- if GstatusI = "on" then
- drawfill (475, 285, 10, black)
- elsif GstatusI = "off" then
- drawfill (475, 285, white, black)
- end if
- %%%%SET II%%%%
- %LEFT%
- drawbox (270, 310, 340, 340, black)
- drawfill (271, 311, yellow, black)
- drawoval (325, 325, 10, 10, black)
- if RstatusII = "on" then
- drawfill (325, 325, 12, black)
- elsif RstatusII = "off" then
- drawfill (325, 325, white, black)
- end if
- drawoval (305, 325, 10, 10, black)
- if YstatusII = "on" then
- drawfill (305, 325, 43, black)
- elsif YstatusII = "off" then
- drawfill (305, 325, white, black)
- end if
- drawoval (285, 325, 10, 10, black)
- if GstatusII = "on" then
- drawfill (285, 325, 10, black)
- elsif GstatusII = "off" then
- drawfill (285, 325, white, black)
- end if
- %RIGHT
- drawbox (460, 460, 530, 490, black)
- drawfill (461, 461, yellow, black)
- drawoval (475, 475, 10, 10, black)
- if RstatusII = "on" then
- drawfill (475, 475, 12, black)
- elsif RstatusII = "off" then
- drawfill (475, 475, white, black)
- end if
- drawoval (495, 475, 10, 10, black)
- if YstatusII = "on" then
- drawfill (495, 475, 43, black)
- elsif YstatusII = "off" then
- drawfill (495, 475, white, black)
- end if
- drawoval (515, 475, 10, 10, black)
- if GstatusII = "on" then
- drawfill (515, 475, 10, black)
- elsif GstatusII = "off" then
- drawfill (515, 475, white, black)
- end if
- end drawLights
- procedure runLightsI %procedure to understand input/set status (I)
- %if statement for section I lights
- if statusI = "green" then
- RstatusI := "off"
- YstatusI := "off"
- GstatusI := "on"
- elsif statusI = "yellow" then
- RstatusI := "off"
- YstatusI := "on"
- GstatusI := "off"
- elsif statusI = "red" then
- RstatusI := "on"
- YstatusI := "off"
- GstatusI := "off"
- elsif statusI = "off" then
- RstatusI := "off"
- YstatusI := "off"
- GstatusI := "off"
- end if
- end runLightsI
- procedure runLightsII %procedure to understand input/set status (II)
- %if statement for section II lights
- if statusII = "green" then
- RstatusII := "off"
- YstatusII := "off"
- GstatusII := "on"
- elsif statusII = "yellow" then
- RstatusII := "off"
- YstatusII := "on"
- GstatusII := "off"
- elsif statusII = "red" then
- RstatusII := "on"
- YstatusII := "off"
- GstatusII := "off"
- elsif statusII = "off" then
- RstatusII := "off"
- YstatusII := "off"
- GstatusII := "off"
- end if
- end runLightsII
- procedure runLights %Calls the other two procedures (GENIUS)
- runLightsI
- runLightsII
- end runLights
- procedure updateLights %Calls two more procedures
- runLights
- drawLights
- end updateLights
- procedure cleartext %Procedure to clear text
- cls
- delay (500)
- drawStreet
- drawLights
- end cleartext
- process Hcar () %The horizontal car
- loop
- drawfillbox ((xI - 10), yI, (xI2 - 4), yI2, grey) %Removes the previous drawn shape
- drawfillbox (xI, yI, xI2, yI2, blue)
- xI := xI + speed
- xI2 := xI2 + speed
- if xI2 <335 and xI2 >320 then %When the car is near the end of the intersection
- if statusII = "red" or statusII = "yellow" then
- loop
- delay (10)
- drawHwalk
- exit when statusII = "green" %exit when green
- end loop
- end if
- end if
- if xI2 >= 800 then
- drawfillbox (1, 355, 799, 395, grey)
- drawHwalk
- xI := 10
- xI2 := 85
- yI := 360
- yI2 := 390
- delay (50)
- end if
- %View.UpdateArea (0, 350, 800, 450)
- delay (50)
- %drawfillbox (1, 355, 799, 395, white) (OLD VERSION)
- drawHwalk
- speed:= 4
- end loop
- end Hcar
- process Vcar () %The vertical car
- loop
- drawfillbox (xII, (yII + 10), xII2, (yII2 + 4), grey)
- drawfillbox (xII, yII, xII2, yII2, red)
- yII := yII - speed
- yII2 := yII2 - speed
- if yII2 > 465 and yII2 < 480 then %When the car is near the end of the intersection
- if statusI = "red" or statusI = "yellow" then
- loop
- delay (10)
- exit when statusI = "green" %exit when green
- end loop
- end if
- end if
- if yII2 <= 0 then
- drawfillbox (351, 1, 390, 349, grey)
- drawfillbox(351,451,390,799,grey)
- drawCrosswalk
- xII := 360
- xII2 := 390
- yII := 790
- yII2 := 715
- delay (50)
- end if
- %View.UpdateArea (350, 0, 450, 800)
- delay (50)
- %drawfillbox (351, 1, 390, 799, white) (OLD VERSION)
- drawCrosswalk
- speed := 4
- end loop
- end Vcar
- process drawCars ()
- fork Hcar ()
- fork Vcar ()
- end drawCars
- procedure beginRoutine %Procedure to begin the routine
- %Start with green/red lights
- statusI := "green"
- statusII := "red"
- updateLights
- delay (5000) %Delay 5 seconds
- %Turn first light to yellow before turning to red
- statusI := "yellow"
- statusII := "red"
- updateLights
- delay (1000) %Delay 4 seconds
- %Turn first light fully red then wait before turning II green
- statusI := "red"
- statusII := "red"
- updateLights
- delay (2000) %Delay 3 seconds
- %Reversal of initial state
- statusI := "red"
- statusII := "green"
- updateLights
- delay (5000) %Delay 5 seconds
- %Begin turning II to red
- statusI := "red"
- statusII := "yellow"
- updateLights
- delay (1000) %Delay 4 seconds
- %Turn both red to get ready for the next loop
- statusI := "red"
- statusII := "red"
- updateLights
- delay (2000) %Delay 3 seconds
- end beginRoutine
- procedure debugP %Procedure to debug/test the program
- var input : string
- put "Input: " ..
- get input
- %IF STATEMENT FOR CLS
- if input = "cls" then
- cleartext %Reset status of lights
- statusI := "off"
- statusII := "off"
- drawLights
- runLights
- drawLights
- %IF STATEMENT FOR TL
- elsif input = "tl" then
- var IorII : string %Find out if user wants to test set I or set II
- put "I or II: " ..
- get IorII
- if IorII = "I" then
- put "color: " ..
- get statusI
- drawLights
- runLightsI
- elsif IorII = "II" then
- put "color: " ..
- get statusII
- drawLights
- runLightsII
- end if
- %IF STATEMENT FOR HELP
- elsif input = "help" then
- put commands
- elsif input = "rtn" then
- cls
- cls
- beginRoutine
- else
- put "command not recognised"
- cleartext
- end if
- end debugP
- process mouseDraw ()
- Mouse.ButtonChoose("multibutton")
- var mx, my, b : int
- var x, y, x1, y1 : int := 0
- loop
- mousewhere (mx, my, b)
- if b = 1 then
- x1 := mx
- y1 := my
- drawline (x, y, x1, y1, black)
- elsif b = 100 then
- drawfill(mx,my,fillcolor,black)
- end if
- x := mx
- y := my
- end loop
- end mouseDraw
- process KBinput
- var chars : array char of boolean
- Input.KeyDown(chars)
- if chars ('e') then
- cls
- delay(500)
- cls
- end if
- end KBinput
- %%%%%%%%%%%%%%%%%%%%%%%%%%%PROCEDURES%%%%%%%%%%%%%%%%%%%%%%%%%%%
- %Main loop
- var input: string
- put "Input: ".. get input
- if input = "start" then
- loop
- fork mouseDraw()
- fork KBinput()
- delay (500)
- drawStreet
- drawHwalk
- drawCrosswalk
- drawLights
- if debug = 1 then
- debugP
- end if
- fork drawCars ()
- View.Update
- beginRoutine
- end loop
- else put "Not recognised. Type start to begin..."
- end if
- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%
- %Saif K. and Aaron G. @ 2016%
- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement