stoplight.tcl

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):
#
# Stoplight --
#
#  When a timer goes off, change the light's color as per the
#  state machine.
#
# RCS ID
# $Id: stoplight.tcl,v 1.7 2008/02/04 12:38:37 fperrad Exp $
#
# CHANGE LOG
# $Log: stoplight.tcl,v $
# Revision 1.7  2008/02/04 12:38:37  fperrad
# fix filename case on linux
#
# Revision 1.6  2005/05/28 18:02:56  cwrapp
# Updated Tcl examples, removed EX6.
#
# Revision 1.0  2003/12/14 20:30:35  charlesr
# Initial revision
#

package require statemap;

source ./stoplight_sm.tcl;

namespace eval tcl_ex4 {
    class Stoplight {
    # Member data.
        private variable _fsm;

	# Store here how long each light is supposed to last.
	private variable _timeouts;

        # Store the Tcl timer ID here.
        private variable _timerID;

        private variable _canvas;
        private variable _east_light;
        private variable _west_light;
        private variable _north_light;
        private variable _south_light;

        private variable _roadWidth 38;
        private variable _lightDiameter 6;
        private variable _lightSpace 2;
        private variable _lightWidth;
        private variable _lightHeight;

	# List of vehicles waiting for the light to turn green
        # in a given direction.
	private variable _northVehicleList;
	private variable _southVehicleList;
	private variable _eastVehicleList;
        private variable _westVehicleList;

    # Member functions.
        constructor {canvas} {
            set _fsm [::tcl_ex4::StoplightContext #auto $this];

            set _canvas $canvas;
            
            # Set the light height and width.
            set _lightWidth \
                    [expr $_lightDiameter + [expr $_lightSpace * 2]];
            set _lightHeight \
                    [expr [expr $_lightDiameter * 3] + \
                    [expr $_lightSpace * 4]];
            
            set _northVehicleList {};
            set _southVehicleList {};
            set _eastVehicleList {};
            set _westVehicleList {};

            # Create the stoplight GUI. Draw the roads.
            DrawRoads;
            
            # Draw the stoplights.
            DrawLights;

            # Set each light timer.
            array set _timeouts \
                    [list NSGreenTimer 7000 \
                    EWGreenTimer 5000 \
                    YellowTimer 2000];

            set _timerID -1;

            # DEBUG
            # Uncomment the following line so that
            # FSM debug output may be seen.
            # $_fsm setDebugFlag 1;
        }

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

	public method getRoadLengthX {} {
            return -code ok [$_canvas cget -width];
	}

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

	public method getRoadLengthY {} {
            return -code ok [$_canvas cget -height];
	}

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

	public method getRoadWidth {} {
            return -code ok $_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.

	public method getLight {direction} {
            set Retcode ok;

            # The direction represents which way the vehicle
            # is facing. This is the opposite direction in which
            # the light is facing.
            switch -exact -- $direction {
                north {
                    set RedLight [$_canvas itemcget $_south_light(RED) -fill];
                    set YellowLight [$_canvas itemcget $_south_light(YELLOW) -fill];
                    set GreenLight [$_canvas itemcget $_south_light(GREEN) -fill];
                }
                south {
                    set RedLight [$_canvas itemcget $_north_light(RED) -fill];
                    set YellowLight [$_canvas itemcget $_north_light(YELLOW) -fill];
                    set GreenLight [$_canvas itemcget $_north_light(GREEN) -fill];
                }
                east {
                    set RedLight [$_canvas itemcget $_west_light(RED) -fill];
                    set YellowLight [$_canvas itemcget $_west_light(YELLOW) -fill];
                    set GreenLight [$_canvas itemcget $_west_light(GREEN) -fill];
                }
                west {
                    set RedLight [$_canvas itemcget $_east_light(RED) -fill];
                    set YellowLight [$_canvas itemcget $_east_light(YELLOW) -fill];
                    set GreenLight [$_canvas itemcget $_east_light(GREEN) -fill];
                }
                default {
                    set Retcode error;
                    set Retval "Stoplight::getLight: \"$direction\" is an invalid direction.";
                }
            }

            if {[string compare $Retcode "ok"] == 0} {
                if {[string compare $RedLight "red"] == 0} {
                    set Retval red;
                } elseif {[string compare $YellowLight "yellow"] == 0} {
                    set Retval yellow;
                } else {
                    set Retval green;
                }
            }

            return -code $Retcode $Retval;
	}

	# 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.
	#
	# Results:
	#   ok

	public method registerVehicle {vehicle direction} {
            switch -exact -- $direction {
                north {
                    lappend _northVehicleList $vehicle;
                }
                south {
                    lappend _southVehicleList $vehicle;
                }
                east {
                    lappend _eastVehicleList $vehicle;
                }
                west {
                    lappend _westVehicleList $vehicle;
                }
            }

            return -code ok;
	}

        # 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.

        public method getQueueSize {direction} {
            switch -exact -- $direction {
                north {
                    set Retval [llength $_northVehicleList];
                }
                south {
                    set Retval [llength $_southVehicleList];
                }
                east {
                    set Retval [llength $_eastVehicleList];
                }
                west {
                    set Retval [llength $_westVehicleList];
                }
            }

            return -code ok $Retval;
        }

        # 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.
        #
        # Results:
        #   ok

        public method setLightTimer {light time} {
            set _timeouts($light) [expr $time * 1000];

            return -code ok;
        }

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

        public method start {} {
            $_fsm Start;
            return -code ok;
        }

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

        public method pause {} {
            $_fsm Pause;
            return -code ok;
        }

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

        public method continue {} {
            $_fsm Continue;
            return -code ok;
        }

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

        public method stop {} {
            $_fsm Stop;
            return -code ok;
        }