stoplight.tcl

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

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

        public method TurnLight {direction color} {
            switch -exact -- $direction {
                EWLIGHT {
                    switch -exact -- $color {
                        RED {
                            $_canvas itemconfigure $_east_light(YELLOW) -fill white;
                            $_canvas itemconfigure $_west_light(YELLOW) -fill white;
                            $_canvas itemconfigure $_east_light(RED) -fill red;
                            $_canvas itemconfigure $_west_light(RED) -fill red;
                        }
                        GREEN {
                            $_canvas itemconfigure $_east_light(RED) -fill white;
                            $_canvas itemconfigure $_west_light(RED) -fill white;
                            $_canvas itemconfigure $_east_light(GREEN) -fill green;
                            $_canvas itemconfigure $_west_light(GREEN) -fill green;
                        }
                        YELLOW {
                            $_canvas itemconfigure $_east_light(GREEN) -fill white;
                            $_canvas itemconfigure $_west_light(GREEN) -fill white;
                            $_canvas itemconfigure $_east_light(YELLOW) -fill yellow;
                            $_canvas itemconfigure $_west_light(YELLOW) -fill yellow;
                        }
                    }
                }
                NSLIGHT {
                    switch -exact -- $color {
                        RED {
                            $_canvas itemconfigure $_north_light(YELLOW) -fill white;
                            $_canvas itemconfigure $_south_light(YELLOW) -fill white;
                            $_canvas itemconfigure $_north_light(RED) -fill red;
                            $_canvas itemconfigure $_south_light(RED) -fill red;
                        }
                        GREEN {
                            $_canvas itemconfigure $_north_light(RED) -fill white;
                            $_canvas itemconfigure $_south_light(RED) -fill white;
                            $_canvas itemconfigure $_north_light(GREEN) -fill green;
                            $_canvas itemconfigure $_south_light(GREEN) -fill green;
                        }
                        YELLOW {
                            $_canvas itemconfigure $_north_light(GREEN) -fill white;
                            $_canvas itemconfigure $_south_light(GREEN) -fill white;
                            $_canvas itemconfigure $_north_light(YELLOW) -fill yellow;
                            $_canvas itemconfigure $_south_light(YELLOW) -fill yellow;
                        }
                    }
                }
            }
        }

        public method SetTimer {timer} {
            set _timerID [after $_timeouts($timer) [list $this Timeout]];
            return -code ok;
        }

        public method StopTimer {} {
            if {$_timerID >= 0} {
                after cancel $_timerID;
                set _timerID -1;
            }

            return -code ok;
        }

        public method Timeout {} {
            set _timerID -1;
            $_fsm Timeout;

            return -code ok;
        }

        public method ResetLights {} {
            $_canvas itemconfigure $_east_light(YELLOW) -fill white;
            $_canvas itemconfigure $_west_light(YELLOW) -fill white;
            $_canvas itemconfigure $_east_light(RED) -fill white;
            $_canvas itemconfigure $_west_light(RED) -fill white;
            $_canvas itemconfigure $_east_light(GREEN) -fill white;
            $_canvas itemconfigure $_west_light(GREEN) -fill white;

            $_canvas itemconfigure $_north_light(YELLOW) -fill white;
            $_canvas itemconfigure $_south_light(YELLOW) -fill white;
            $_canvas itemconfigure $_north_light(RED) -fill white;
            $_canvas itemconfigure $_south_light(RED) -fill white;
            $_canvas itemconfigure $_north_light(GREEN) -fill white;
            $_canvas itemconfigure $_south_light(GREEN) -fill white;

            return -code ok;
        }

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

	public method InformVehicles {direction} {
            switch -exact -- $direction {
                north {
                    foreach Vehicle $_northVehicleList {
                        catch "$Vehicle lightGreen";
                    }
                    set _northVehicleList {};
                }
                south {
                    foreach Vehicle $_southVehicleList {
                        catch "$Vehicle lightGreen";
                    }
                    set _southVehicleList {};
                }
                east {
                    foreach Vehicle $_eastVehicleList {
                        catch "$Vehicle lightGreen";
                    }
                    set _eastVehicleList {};
                }
                west {
                    foreach Vehicle $_westVehicleList {
                        catch "$Vehicle lightGreen";
                    }
                    set _westVehicleList {};
                }
            }

            return -code ok;
	}

        private method DrawRoads {} {
            # 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.
            set XLength [expr [expr [getRoadLengthX] / 2] - \
                    [expr $_roadWidth / 2]];
            set YLength [expr [expr [getRoadLengthY] / 2] - \
                    [expr $_roadWidth / 2]];
            
            # Calculate the major coordinates.
            set X1 0;
            set Y1 0;
            set X2 $XLength;
            set Y2 $YLength;
            set X3 [expr [$_canvas cget -width] / 2];
            set Y3 [expr [$_canvas cget -height] / 2];
            set X4 [expr [$_canvas cget -width] - $XLength];
            set Y4 [expr [$_canvas cget -height] - $YLength];
            set X5 [$_canvas cget -width];
            set Y5 [$_canvas cget -height];
            
            # Put green lawns around the road.
            $_canvas create rect $X1 $Y1 $X2 $Y2 -outline "" -fill green;
            $_canvas create rect $X1 $Y4 $X2 $Y5 -outline "" -fill green;
            $_canvas create rect $X4 $Y4 $X5 $Y5 -outline "" -fill green;
            $_canvas create rect $X4 $Y1 $X5 $Y2 -outline "" -fill green;

            # Draw four connected lines where each drawing uses three
            # coordinates.
            $_canvas create line $X1 $Y2 $X2 $Y2 $X2 $Y1;
            $_canvas create line $X4 $Y1 $X4 $Y2 $X5 $Y2;
            $_canvas create line $X1 $Y4 $X2 $Y4 $X2 $Y5;
            $_canvas create line $X4 $Y5 $X4 $Y4 $X5 $Y4;
            
            # Now draw the lane markings.
            $_canvas create line $X1 $Y3 $X2 $Y3;
            $_canvas create line $X3 $Y1 $X3 $Y2;
            $_canvas create line $X4 $Y3 $X5 $Y3;
            $_canvas create line $X3 $Y4 $X3 $Y5;

            return -code ok;
        }

        private method DrawLights {} {
            # 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.
            set X1 [expr [expr [$_canvas cget -width] / 2] - \
                    [expr $_lightWidth / 2] - $_lightHeight];
            set Y1 [expr [expr [$_canvas cget -height] / 2] - \
                    [expr $_lightWidth / 2] - $_lightHeight];
            set X2 [expr $X1 + $_lightHeight];
            set Y2 [expr $Y1 + $_lightHeight];
            set X3 [expr $X2 + $_lightWidth];
            set Y3 [expr $Y2 + $_lightWidth];
            set X4 [expr $X3 + $_lightHeight];
            set Y4 [expr $Y3 + $_lightHeight];
            
            # Draw the four stop lights boxes.
            $_canvas create rect $X2 $Y1 $X3 $Y2 -outline black -fill black -width 1;
            $_canvas create rect $X1 $Y2 $X2 $Y3 -outline black -fill black -width 1;
            $_canvas create rect $X2 $Y3 $X3 $Y4 -outline black -fill black -width 1;
            $_canvas create rect $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
            set _north_light(RED) \
                    [$_canvas create oval [expr $X2 + $_lightSpace] \
                    [expr $Y1 + $_lightSpace] \
                    [expr $X3 - $_lightSpace] \
                    [expr $Y1 + \
                    $_lightSpace + \
                    $_lightDiameter] \
                    -outline black -fill white];
            set _north_light(YELLOW) \
                    [$_canvas create oval [expr $X2 + $_lightSpace] \
                    [expr $Y1 + \
                    [expr $_lightSpace * 2] + \
                    $_lightDiameter] \
                    [expr $X3 - $_lightSpace] \
                    [expr $Y1 + \
                    [expr $_lightSpace * 2] + \
                    [expr $_lightDiameter * 2]] \
                    -outline black -fill white];
            set _north_light(GREEN) \
                    [$_canvas create oval [expr $X2 + $_lightSpace] \
                    [expr $Y1 + \
                    [expr $_lightSpace * 3] + \
                    [expr $_lightDiameter * 2]] \
                    [expr $X3 - $_lightSpace] \
                    [expr $Y1 + \
                    [expr $_lightSpace * 3] + \
                    [expr $_lightDiameter * 3]] \
                    -outline black -fill white];
            
            set _west_light(RED) \
                    [$_canvas create oval [expr $X1 + $_lightSpace] \
                    [expr $Y2 + $_lightSpace] \
                    [expr $X1 + \
                    $_lightSpace + \
                    $_lightDiameter] \
                    [expr $Y3 - $_lightSpace] \
                    -outline black -fill white];
            set _west_light(YELLOW) \
                    [$_canvas create oval [expr $X1 + \
                    [expr $_lightSpace * 2] + \
                    $_lightDiameter] \
                    [expr $Y2 + $_lightSpace] \
                    [expr $X1 + \
                    [expr $_lightSpace * 2] + \
                    [expr $_lightDiameter * 2]] \
                    [expr $Y3 - $_lightSpace] \
                    -outline black -fill white];
            set _west_light(GREEN) \
                    [$_canvas create oval [expr $X1 + \
                    [expr $_lightSpace * 3] + \
                    [expr $_lightDiameter * 2]] \
                    [expr $Y2 + $_lightSpace] \
                    [expr $X1 + \
                    [expr $_lightSpace * 3] + \
                    [expr $_lightDiameter * 3]] \
                    [expr $Y3 - $_lightSpace] \
                    -outline black -fill white];
            
            set _south_light(GREEN) \
                    [$_canvas create oval [expr $X2 + $_lightSpace] \
                    [expr $Y3 + $_lightSpace] \
                    [expr $X3 - $_lightSpace] \
                    [expr $Y3 + \
                    $_lightSpace + \
                    $_lightDiameter] \
                    -outline black -fill white];
            set _south_light(YELLOW) \
                    [$_canvas create oval [expr $X2 + $_lightSpace] \
                    [expr $Y3 + \
                    [expr $_lightSpace * 2] + \
                    $_lightDiameter] \
                    [expr $X3 - $_lightSpace] \
                    [expr $Y3 + \
                    [expr $_lightSpace * 2] + \
                    [expr $_lightDiameter * 2]] \
                    -outline black -fill white];
            set _south_light(RED) \
                    [$_canvas create oval [expr $X2 + $_lightSpace] \
                    [expr $Y3 + \
                    [expr $_lightSpace * 3] + \
                    [expr $_lightDiameter * 2]] \
                    [expr $X3 - $_lightSpace] \
                    [expr $Y3 + \
                    [expr $_lightSpace * 3] + \
                    [expr $_lightDiameter * 3]] \
                    -outline black -fill white];
            
            set _east_light(GREEN) \
                    [$_canvas create oval [expr $X3 + $_lightSpace] \
                    [expr $Y2 + $_lightSpace] \
                    [expr $X3 + \
                    $_lightSpace + \
                    $_lightDiameter] \
                    [expr $Y3 - $_lightSpace] \
                    -outline black -fill white];
            set _east_light(YELLOW) \
                    [$_canvas create oval [expr $X3 + \
                    [expr $_lightSpace * 2] + \
                    $_lightDiameter] \
                    [expr $Y2 + $_lightSpace] \
                    [expr $X3 + \
                    [expr $_lightSpace * 2] + \
                    [expr $_lightDiameter * 2]] \
                    [expr $Y3 - $_lightSpace] \
                    -outline black -fill white];
            set _east_light(RED) \
                    [$_canvas create oval [expr $X3 + \
                    [expr $_lightSpace * 3] + \
                    [expr $_lightDiameter * 2]] \
                    [expr $Y2 + $_lightSpace] \
                    [expr $X3 + \
                    [expr $_lightSpace * 3] + \
                    [expr $_lightDiameter * 3]] \
                    [expr $Y3 - $_lightSpace] \
                    -outline black -fill white];
        }
    }
}