stoplight.pm

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

#
# The contents of this file are subject to the Mozilla Public
# License Version 1.1 (the "License"); you may not use this file
# except in compliance with the License. You may obtain a copy of
# the License at http://www.mozilla.org/MPL/
#
# Software distributed under the License is distributed on an "AS
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
# implied. See the License for the specific language governing
# rights and limitations under the License.
#
# The Original Code is State Machine Compiler (SMC).
#
# The Initial Developer of the Original Code is Charles W. Rapp.
# Portions created by Charles W. Rapp are
# Copyright (C) 2000 - 2003 Charles W. Rapp.
# All Rights Reserved.
#
# Contributor(s):
#       Port to Perl by Francois Perrad, [e-mail]
#
# Stoplight --
#
#  When a timer goes off, change the light's color as per the
#  state machine.
#
# RCS ID
# $Id: Stoplight.pm,v 1.2 2008/02/04 12:40:28 fperrad Exp $
#
# CHANGE LOG
# $Log: Stoplight.pm,v $
# Revision 1.2  2008/02/04 12:40:28  fperrad
# some Perl Best Practices
#
# Revision 1.1  2005/06/16 18:04:15  fperrad
# Added Perl examples 1 - 4 and 7.
#
#

use strict;
use warnings;

use Stoplight_sm;

package Stoplight;

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my ($canvas) = @_;
    my $self = {
            _canvas => $canvas,
    };
    bless($self, $class);
    # Create the stop light's state machine.
    $self->{_fsm} = new smc_ex4::Stoplight_sm($self);

    $self->{_east_light} = {};
    $self->{_west_light} = {};
    $self->{_north_light} = {};
    $self->{_south_light} = {};
    $self->{_roadWidth} = 38;
    $self->{_lightDiameter} = 6;
    $self->{_lightSpace} = 2;

    # Set the light height and width.
    $self->{_lightWidth} = $self->{_lightDiameter} + $self->{_lightSpace} * 2;
    $self->{_lightHeight} = $self->{_lightDiameter} * 3 + $self->{_lightSpace} * 4;

    $self->{_northVehicleList} = [];
    $self->{_southVehicleList} = [];
    $self->{_eastVehicleList} = [];
    $self->{_westVehicleList} = [];

    # Create the stoplight GUI. Draw the roads.
    $self->DrawRoads();

    # Draw the stoplights.
    $self->DrawLights();

    # Set each light timer.
    $self->{_timeouts} = {
            NSGreenTimer => 7000,
            EWGreenTimer => 5000,
            YellowTimer => 2000,
    };

    $self->{_timerID} = -1;

    # Uncomment to see debug output.
    #$self->{_fsm}->setDebugFlag(1);

    return $self;
}

# getRoadLengthX --
#
#   Return the road's length in X direction.
#
# Arguments:
#   None.
#
# Results:
#   Pixel length of road in X direction.

sub getRoadLengthX {
    my $self = shift;
    return $self->{_canvas}->cget(-width);
}

# getRoadLengthY --
#
#   Return the road's length in Y direction in pixels.
#
# Arguments:
#   None.
#
# Results:
#   Pixel length of road in Y direction.

sub getRoadLengthY {
    my $self = shift;
    return $self->{_canvas}->cget(-height);
}

# getRoadWidth --
#
#   Return road's width in pixels.
#
# Arguments:
#   None.
#
# Results:
#   Road's width in pixels.

sub getRoadWidth {
    my $self = shift;
    return $self->{_roadWidth};
}

# getLight --
#
#   Return a specified stop lights color.
#
# Arguments:
#   direction   Must be either north, south east or west.
#
# Results:
#   Returns the color for that direction.

sub getLight {
    my $self = shift;
    my ($direction) = @_;
    my $cv = $self->{_canvas};

    my ($RedLight, $YellowLight, $GreenLight);
    # The direction represents which way the vehicle
    # is facing. This is the opposite direction in which
    # the light is facing.
    if    ($direction eq 'north') {
        $RedLight = $cv->itemcget($self->{_south_light}->{RED}, -fill);
        $YellowLight = $cv->itemcget($self->{_south_light}->{YELLOW}, -fill);
        $GreenLight = $cv->itemcget($self->{_south_light}->{GREEN}, -fill);
    }
    elsif ($direction eq 'south') {
        $RedLight = $cv->itemcget($self->{_north_light}->{RED}, -fill);
        $YellowLight = $cv->itemcget($self->{_north_light}->{YELLOW}, -fill);
        $GreenLight = $cv->itemcget($self->{_north_light}->{GREEN}, -fill);
    }
    elsif ($direction eq 'east') {
        $RedLight = $cv->itemcget($self->{_west_light}->{RED}, -fill);
        $YellowLight = $cv->itemcget($self->{_west_light}->{YELLOW}, -fill);
        $GreenLight = $cv->itemcget($self->{_west_light}->{GREEN}, -fill);
    }
    elsif ($direction eq 'west') {
        $RedLight = $cv->itemcget($self->{_east_light}->{RED}, -fill);
        $YellowLight = $cv->itemcget($self->{_east_light}->{YELLOW}, -fill);
        $GreenLight = $cv->itemcget($self->{_east_light}->{GREEN}, -fill);
    }

    if    ($RedLight eq 'red') {
        return 'red';
    }
    elsif ($YellowLight eq 'yellow') {
        return 'yellow';
    }
    else {
        return 'green';
    }
}

# registerVehicle --
#
#   A vehicle is waiting for this light to turn green.
#   Add it to the list. When the light turns green,
#   the vehicle will be told about it.
#
# Arguments:
#   vehicle    A vehicle object name.
#   direction  The direction the vehicle is moving.

sub registerVehicle {
    my $self = shift;
    my ($vehicle, $direction) = @_;
    if    ($direction eq 'north') {
        push @{$self->{_northVehicleList}}, $vehicle;
    }
    elsif ($direction eq 'south') {
        push @{$self->{_southVehicleList}}, $vehicle;
    }
    elsif ($direction eq 'east') {
        push @{$self->{_eastVehicleList}}, $vehicle;
    }
    elsif ($direction eq 'west') {
        push @{$self->{_westVehicleList}}, $vehicle;
    }
}

# getQueueSize --
#
#   Return the number of vehicles waiting on a red in
#   a particular direction.
#
# Arguments:
#   direction   The direction the vehicle is moving.
#
# Results:
#   The size of the red light queue for that direction.

sub getQueueSize {
    my $self = shift;
    my ($direction) = @_;
    if    ($direction eq 'north') {
        return scalar @{$self->{_northVehicleList}};
    }
    elsif ($direction eq 'south') {
        return scalar @{$self->{_southVehicleList}};
    }
    elsif ($direction eq 'east') {
        return scalar @{$self->{_eastVehicleList}};
    }
    elsif ($direction eq 'west') {
        return scalar @{$self->{_westVehicleList}};
    }
}

# setLightTimer --
#
#   Set a particular light's timer. The value is given in
#   seconds, so convert to milliseconds.
#
# Arguments:
#   light    NSGreenTimer, EWGreenTimer or YellowTimer.
#   time     Light time in seconds.

sub setLightTimer {
    my $self = shift;
    my ($light, $time) = @_;
    $self->{_timeouts}->{$light} = $time * 1000;
}

# start --
#
#   Start the demo running.
#
# Arguments:
#   None.

sub Start {
    my $self = shift;
    $self->{_fsm}->Start();
}

# pause --
#
#   Pause this demo.
#
# Arguments:
#   None.

sub Pause {
    my $self = shift;
    $self->{_fsm}->Pause();
}

# continue --
#
#   Continue this demo.
#
# Arguments:
#   None.

sub Continue {
    my $self = shift;
    $self->{_fsm}->Continue();
}

# stop --
#
#   Stop this demo.
#
# Arguments:
#   None.

sub Stop {
    my $self = shift;
    $self->{_fsm}->Stop();
}

# State Machine Actions.
#
# The following methods are called by the state machine..

sub TurnLight {
    my $self = shift;
    my ($direction, $color) = @_;
    my $cv = $self->{_canvas};
    if      ($direction eq 'EWLIGHT') {
        if    ($color eq 'red') {
            $cv->itemconfigure($self->{_east_light}->{YELLOW}, -fill => 'white');
            $cv->itemconfigure($self->{_west_light}->{YELLOW}, -fill => 'white');
            $cv->itemconfigure($self->{_east_light}->{RED}, -fill => 'red');
            $cv->itemconfigure($self->{_west_light}->{RED}, -fill => 'red');
        }
        elsif ($color eq 'green') {
            $cv->itemconfigure($self->{_east_light}->{RED}, -fill => 'white');
            $cv->itemconfigure($self->{_west_light}->{RED}, -fill => 'white');
            $cv->itemconfigure($self->{_east_light}->{GREEN}, -fill => 'green');
            $cv->itemconfigure($self->{_west_light}->{GREEN}, -fill => 'green');
        }
        elsif ($color  eq 'yellow') {
            $cv->itemconfigure($self->{_east_light}->{GREEN}, -fill => 'white');