Traffic Lights V1.1

%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


%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

%%%%%%%%%%%%%%%%%%%%%%%%%%%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 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 - 5), yI2, grey) %Removes the previous drawn shape
        drawfillbox (xI, yI, xI2, yI2, blue)
        xI += 4
        xI2 += 4

        if xI2 >= 330 and xI2 <= 370 then  %When the car is near the end of the intersection
            if statusII = "red" or statusII = "yellow" then
                loop
                    delay (50)
                    if statusII = "red" or statusII = "yellow" then
                        delay (50)
                    exit when statusII = "green"
                    end if
                end loop
            end if
        end if
        if xI2 >= 800 then
            drawfillbox (1, 355, 799, 395, grey)
            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)
    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 -= 4
        yII2 -= 4

        if yII2 <= 470 and yII2 >= 430 then %When the car is near the end of the intersection
            if statusI = "red" or statusI = "yellow" then
                loop
                    delay (50)
                    if statusI = "red" or statusI = "yellow" then
                        delay (50)
                    exit when statusI = "green"
                    end if
                end loop
            end if
        end if
        if yII2 <= 0 then
            drawfillbox (351, 1, 390, 799, grey)
            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)
    end loop
end Vcar


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




%%%%%%%%%%%%%%%%%%%%%%%%%%%PROCEDURES%%%%%%%%%%%%%%%%%%%%%%%%%%%

%Main loop
loop
    drawStreet
    drawLights

    if debug = 1 then
        debugP
    end if

    fork Hcar ()
    fork Vcar ()
    View.Update
    beginRoutine

end loop