Traffic Light - V1.9

%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

%V1.9
%       - Colors of turned off lights are now dimmer versions of "on" status
%       - Reintroduced main loop
%       - Added more features to KBInput

%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

var chars : array char of boolean
var ch : string (1)


%%%%%%%%%%%%%%%%%%%%%%%%%%%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, 112, 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, 114, 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, 120, 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, 112, 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, 114, 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, 120, 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, 112, 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, 114, 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, 120, 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, 112, 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, 114, 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, 120, 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
procedure getKey
    var ch : string (1)
    getch (ch)
end getKey
process KBinput
    loop
        getKey
        if ch = "a" then
            put "meme"
        end if
    end loop
end KBinput

process KBM ()
    fork KBinput ()
    fork mouseDraw ()
end KBM



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

%Main loop
loop
    var input : string
    put "Input: " ..
    get input
    if input = "start" then
        loop
            fork KBM
            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
end loop



%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%Saif K. and Aaron G. @ 2016%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%