stoplight.pm

SMC takes a state machine stored in a .sm file and generates a State pattern in twelve programming l

            $cv->itemconfigure($self->{_west_light}->{GREEN}, -fill => 'white');
            $cv->itemconfigure($self->{_east_light}->{YELLOW}, -fill => 'yellow');
            $cv->itemconfigure($self->{_west_light}->{YELLOW}, -fill => 'yellow');
        }
    }
    elsif ($direction eq 'NSLIGHT') {
        if    ($color eq 'red') {
            $cv->itemconfigure($self->{_north_light}->{YELLOW}, -fill => 'white');
            $cv->itemconfigure($self->{_south_light}->{YELLOW}, -fill => 'white');
            $cv->itemconfigure($self->{_north_light}->{RED}, -fill => 'red');
            $cv->itemconfigure($self->{_south_light}->{RED}, -fill => 'red');
        }
        elsif ($color eq 'green') {
            $cv->itemconfigure($self->{_north_light}->{RED}, -fill => 'white');
            $cv->itemconfigure($self->{_south_light}->{RED}, -fill => 'white');
            $cv->itemconfigure($self->{_north_light}->{GREEN}, -fill => 'green');
            $cv->itemconfigure($self->{_south_light}->{GREEN}, -fill => 'green');
        }
        elsif ($color  eq 'yellow') {
            $cv->itemconfigure($self->{_north_light}->{GREEN}, -fill => 'white');
            $cv->itemconfigure($self->{_south_light}->{GREEN}, -fill => 'white');
            $cv->itemconfigure($self->{_north_light}->{YELLOW}, -fill => 'yellow');
            $cv->itemconfigure($self->{_south_light}->{YELLOW}, -fill => 'yellow');
        }
    }
}

sub SetTimer {
    my $self = shift;
    my ($timer) = @_;
    $self->{_timerID} = $self->{_canvas}->after($self->{_timeouts}->{$timer},
        sub { $self->Timeout(); }
    );
}

sub StopTimer {
    my $self = shift;
    if ($self->{_timerID} >= 0) {
        $self->{_canvas}->after('cancel', $self->{_timerID});
        $self->{_timerID} = -1;
    }
}

sub Timeout {
    my $self = shift;
    $self->{_timerID} = -1;
    $self->{_fsm}->Timeout();
}

sub ResetLights {
    my $self = shift;
    my $cv = $self->{_canvas};

    $cv->itemconfigure($self->{_east_light}->{YELLOW}, -fill => 'white');
    $cv->itemconfigure($self->{_west_light}->{YELLOW}, -fill => 'white');
    $cv->itemconfigure($self->{_east_light}->{RED}, -fill => 'white');
    $cv->itemconfigure($self->{_west_light}->{RED}, -fill => 'white');
    $cv->itemconfigure($self->{_east_light}->{GREEN}, -fill => 'white');
    $cv->itemconfigure($self->{_west_light}->{GREEN}, -fill => 'white');

    $cv->itemconfigure($self->{_north_light}->{YELLOW}, -fill => 'white');
    $cv->itemconfigure($self->{_south_light}->{YELLOW}, -fill => 'white');
    $cv->itemconfigure($self->{_north_light}->{RED}, -fill => 'white');
    $cv->itemconfigure($self->{_south_light}->{RED}, -fill => 'white');
    $cv->itemconfigure($self->{_north_light}->{GREEN}, -fill => 'white');
    $cv->itemconfigure($self->{_south_light}->{GREEN}, -fill => 'white');
}

# InformVehicles --
#
#   Tell the vehicles that were waiting on the green light
#   that they can go now.
#
# Arguments:
#   direction   Which light turned green.

sub InformVehicles {
    my $self = shift;
    my ($direction) = @_;
    if    ($direction eq 'north') {
        foreach my $vehicle (@{$self->{_northVehicleList}}) {
            $vehicle->lightGreen();
        }
        $self->{_northVehicleList} = [];
    }
    elsif ($direction eq 'south') {
        foreach my $vehicle (@{$self->{_southVehicleList}}) {
            $vehicle->lightGreen();
        }
        $self->{_southVehicleList} = [];
    }
    elsif ($direction eq 'east') {
        foreach my $vehicle (@{$self->{_eastVehicleList}}) {
            $vehicle->lightGreen();
        }
        $self->{_eastVehicleList} = [];
    }
    elsif ($direction eq 'west') {
        foreach my $vehicle (@{$self->{_westVehicleList}}) {
            $vehicle->lightGreen();
        }
        $self->{_westVehicleList} = [];
    }
}

sub DrawRoads {
    my $self = shift;
    my $cv = $self->{_canvas};
    # The roads are drawn as follows:
    #
    #        (x2,y1)   (x4,y1)
    #             |  |  |
    #             |     |
    #             |  |  |
    # (x1,y2)     |     |       (x5,y2)
    # ------------+  |  +------------
    #         (x2,y2) (x4,y2)
    # - - - - - -        - - - - - -
    #         (x2,y4) (x4,y4)   (x5,y4)
    # ------------+     +------------
    # (x1,y4)     |  |  |
    #             |     |
    #             |  |  |
    #             |     |
    #        (x2,y5) |(x4,y5)

    # Calculate the line segment's length.
    my $XLength = ($self->getRoadLengthX() / 2) - $self->{_roadWidth} / 2;
    my $YLength = ($self->getRoadLengthY() / 2) - $self->{_roadWidth} / 2;

    # Calculate the major coordinates.
    my $X1 = 0;
    my $Y1 = 0;
    my $X2 = $XLength;
    my $Y2 = $YLength;
    my $X3 = $cv->cget(-width) / 2;
    my $Y3 = $cv->cget(-height) / 2;
    my $X4 = $cv->cget(-width) - $XLength;
    my $Y4 = $cv->cget(-height) - $YLength;
    my $X5 = $cv->cget(-width);
    my $Y5 = $cv->cget(-height);

    # Put green lawns around the road.
    $cv->createRectangle($X1, $Y1, $X2, $Y2,
        -outline => "",
        -fill => 'green',
    );
    $cv->createRectangle($X1, $Y4, $X2, $Y5,
        -outline => "",
        -fill => 'green',
    );
    $cv->createRectangle($X4, $Y4, $X5, $Y5,
        -outline => "",
        -fill => 'green',
    );
    $cv->createRectangle($X4, $Y1, $X5, $Y2,
        -outline => "",
        -fill => 'green',
    );

    # Draw four connected lines where each drawing uses three
    # coordinates.
    $cv->createLine($X1, $Y2, $X2, $Y2, $X2, $Y1);
    $cv->createLine($X4, $Y1, $X4, $Y2, $X5, $Y2);
    $cv->createLine($X1, $Y4, $X2, $Y4, $X2, $Y5);
    $cv->createLine($X4, $Y5, $X4, $Y4, $X5, $Y4);

    # Now draw the lane markings.
    $cv->createLine($X1, $Y3, $X2, $Y3);
    $cv->createLine($X3, $Y1, $X3, $Y2);
    $cv->createLine($X4, $Y3, $X5, $Y3);
    $cv->createLine($X3, $Y4, $X3, $Y5);
}

sub DrawLights {
    my $self = shift;
    my $cv = $self->{_canvas};
    # The lights are drawns as follows:
    #
    #  y1          +---+
    #              | o |green
    #              | o |yellow
    #              | o |red
    #  y2  +-------+---+-------+
    #      | o o o |   | o o o |
    #  y3  +-------+---+-------+
    #              | o |red
    #              | o |yellow
    #              | o |green
    #  y4          +---+
    #
    #    x1       x2   x3     x4
    # Store each light as a separate element in a table.

    # Figure out the coordinates for the stoplights.
    my $X1 = $cv->cget(-width) / 2 - $self->{_lightWidth} / 2 - $self->{_lightHeight};
    my $Y1 = $cv->cget(-height) / 2 - $self->{_lightWidth} / 2 - $self->{_lightHeight};
    my $X2 = $X1 + $self->{_lightHeight};
    my $Y2 = $Y1 + $self->{_lightHeight};
    my $X3 = $X2 + $self->{_lightWidth};
    my $Y3 = $Y2 + $self->{_lightWidth};
    my $X4 = $X3 + $self->{_lightHeight};
    my $Y4 = $Y3 + $self->{_lightHeight};

    # Draw the four stop lights boxes.
    $cv->createRectangle($X2, $Y1, $X3, $Y2,
            -outline => 'black',
            -fill => 'black',
            -width => 1,
    );
    $cv->createRectangle($X1, $Y2, $X2, $Y3,
            -outline => 'black',
            -fill => 'black',
            -width => 1,
    );
    $cv->createRectangle($X2, $Y3, $X3, $Y4,
            -outline => 'black',
            -fill => 'black',
            -width => 1,
    );
    $cv->createRectangle($X3, $Y2, $X4, $Y3,
            -outline => 'black',
            -fill => 'black',
            -width => 1,
    );

    # Draw the lights within the stoplights. Save the
    # canvas items into an array because they will be
    # referenced later. Because there are two lights
    $self->{_north_light}->{RED} = $cv->createOval(
            $X2 + $self->{_lightSpace},
            $Y1 + $self->{_lightSpace},
            $X3 - $self->{_lightSpace},
            $Y1 + $self->{_lightSpace} + $self->{_lightDiameter},
            -outline => 'black',
            -fill => 'white'
    );
    $self->{_north_light}->{YELLOW} = $cv->createOval(
            $X2 + $self->{_lightSpace},
            $Y1 + $self->{_lightSpace} * 2 + $self->{_lightDiameter},
            $X3 - $self->{_lightSpace},
            $Y1 + $self->{_lightSpace} * 2 + $self->{_lightDiameter} * 2,
            -outline => 'black',
            -fill => 'white'
    );
    $self->{_north_light}->{GREEN} = $cv->createOval(
            $X2 + $self->{_lightSpace},
            $Y1 + $self->{_lightSpace} * 3 + $self->{_lightDiameter} * 2,
            $X3 - $self->{_lightSpace},
            $Y1 + $self->{_lightSpace} * 3 + $self->{_lightDiameter} * 3,
            -outline => 'black',
            -fill => 'white'
    );

    $self->{_west_light}->{RED} = $cv->createOval(
            $X1 + $self->{_lightSpace},
            $Y2 + $self->{_lightSpace},
            $X1 + $self->{_lightSpace} + $self->{_lightDiameter},
            $Y3 - $self->{_lightSpace},
            -outline => 'black',
            -fill => 'white'
    );
    $self->{_west_light}->{YELLOW} = $cv->createOval(
            $X1 + $self->{_lightSpace} * 2 + $self->{_lightDiameter},
            $Y2 + $self->{_lightSpace},
            $X1 + $self->{_lightSpace} * 2 + $self->{_lightDiameter} * 2,
            $Y3 - $self->{_lightSpace},
            -outline => 'black',
            -fill => 'white'
    );
    $self->{_west_light}->{GREEN} = $cv->createOval(
            $X1 + $self->{_lightSpace} * 3 + $self->{_lightDiameter} * 2,
            $Y2 + $self->{_lightSpace},
            $X1 + $self->{_lightSpace} * 3 + $self->{_lightDiameter} * 3,
            $Y3 - $self->{_lightSpace},
            -outline => 'black',
            -fill => 'white'
    );

    $self->{_south_light}->{GREEN} = $cv->createOval(
            $X2 + $self->{_lightSpace},
            $Y3 + $self->{_lightSpace},
            $X3 - $self->{_lightSpace},
            $Y3 + $self->{_lightSpace} + $self->{_lightDiameter},
            -outline => 'black',
            -fill => 'white'
    );
    $self->{_south_light}->{YELLOW} = $cv->createOval(
            $X2 + $self->{_lightSpace},
            $Y3 + $self->{_lightSpace} * 2 + $self->{_lightDiameter},
            $X3 - $self->{_lightSpace},
            $Y3 + $self->{_lightSpace} * 2 + $self->{_lightDiameter} * 2,
            -outline => 'black',
            -fill => 'white'
    );
    $self->{_south_light}->{RED} = $cv->createOval(
            $X2 + $self->{_lightSpace},
            $Y3 + $self->{_lightSpace} * 3 + $self->{_lightDiameter} * 2,
            $X3 - $self->{_lightSpace},
            $Y3 + $self->{_lightSpace} * 3 + $self->{_lightDiameter} * 3,
            -outline => 'black',
            -fill => 'white'
    );

    $self->{_east_light}->{GREEN} = $cv->createOval(
            $X3 + $self->{_lightSpace},
            $Y2 + $self->{_lightSpace},
            $X3 + $self->{_lightSpace} + $self->{_lightDiameter},
            $Y3 - $self->{_lightSpace},
            -outline => 'black',
            -fill => 'white'
    );
    $self->{_east_light}->{YELLOW} = $cv->createOval(
            $X3 + $self->{_lightSpace} * 2 + $self->{_lightDiameter},
            $Y2 + $self->{_lightSpace},
            $X3 + $self->{_lightSpace} * 2 + $self->{_lightDiameter} * 2,
            $Y3 - $self->{_lightSpace},
            -outline => 'black',
            -fill => 'white'
    );
    $self->{_east_light}->{RED} = $cv->createOval(
            $X3 + $self->{_lightSpace} * 3 + $self->{_lightDiameter} * 2,
            $Y2 + $self->{_lightSpace},
            $X3 + $self->{_lightSpace} * 3 + $self->{_lightDiameter} * 3,
            $Y3 - $self->{_lightSpace},
            -outline => 'black',
            -fill => 'white'
    );
}

1;