See [Design patterns in Tcl].

Started by [Peter Lewerin] (2003-08-17).

IANAPG (I am not a patterns guru), so I use the example code from http://www.dofactory.com/Patterns/Patterns.aspx as a base for my implementations.

'''Chain-of-responsibility:''' "Avoid coupling the sender of a request to its receiver by giving more than one object a chance to handle the request. Chain the receiving objects and pass the request along the chain until an object handles it."

 package require snit
 
 snit::type handler {
 	option -handleIf
 	variable condition false
 	onconfigure -handleIf value {set condition $value}
 
 	option -handleBy 
 	variable consequent {}
 	onconfigure -handleBy value {set consequent $value}
 	
 	option -elseReportTo
 	variable alternative {}
 	onconfigure -elseReportTo value {
 		set alternative [concat $value handle \$request]
 	}
 	  
 	method handle request {
 		if $condition $consequent $alternative
 	}
 }

Example:
 
 proc main args {
 	handler Tom -handleIf {
 		$request >= 0 && $request < 10
 	} -handleBy {
 		puts "$self handled request $request"
 	} -elseReportTo Gus

 	handler Gus -handleIf {
 		$request >= 10 && $request < 20
 	} -handleBy {
 		puts "$self handled request $request"
 	} -elseReportTo Mary

 	handler Mary -handleIf {
 		$request >= 20 && $request < 30
 	} -handleBy {
 		puts "$self handled request $request"
 	}
 
 	foreach request [list 2 5 14 22 18 38 3 27 20] {
 		Tom handle $request
 	}
 }

----
'''Command:''' "Encapsulate a request as an object, thereby letting you parameterize clients with different requests, queue or log requests, and support undoable operations."

 package require snit
 
 snit::type command {
 	option -calculator
 	
 	variable state 0
 	
 	method execute {operator operand} {
 		set state [[$self cget -calculator] $operator $state $operand]
 		puts "Total = $state (following $operator $operand)"
 	}

 	method unexecute {operator operand} {
 		set state [[$self cget -calculator] inverse $operator $state $operand]
 		puts "Total = $state (following inverse $operator $operand)"
 	}
 }
 
 # receiver
 snit::type arithmeticCalculator {
 	method + {op1 op2} {$self operation + $op1 $op2}
 	
 	method - {op1 op2} {$self operation - $op1 $op2}
 	
 	method * {op1 op2} {$self operation * $op1 $op2}
 	
 	method / {op1 op2} {$self operation / $op1 $op2}
 	
 	method operation {operator op1 op2} {
 		expr [list $op1 $operator $op2]
 	}

 	method inverse {operator op1 op2} {
 		$self operation [string map {+ - - + * / / *} $operator] $op1 $op2
 	}
 }
 
 snit::type invoker {
 	variable commands
 	variable current 0
 	
 	method redo levels {
 		puts "---- Redo $levels levels"
 		for {set i 0} {$i < $levels} {incr i} {
 			if {$current < [llength $commands]} {
 				foreach {cmd opt opd} [lindex $commands $current] {
 					$cmd execute $opt $opd
 				}
 				incr current
 			}
 		}
 	}
 	
 	method undo levels {
 		puts "---- Undo $levels levels"
 		for {set i 0} {$i <= $levels} {incr i} {
 			if {$current >= 0} {
 				foreach {cmd opt opd} [lindex $commands [incr current -1]] {
 					$cmd unexecute $opt $opd
 				}
 			}
 		}
 	}
 	
 	method invoke {command operator operand} {
 		$command execute $operator $operand
 		lappend commands [list $command $operator $operand]
 		set current [llength $commands]
 		incr current
 	}
 }

Example:
 
 proc main args {
 	set cmd [command %AUTO% -calculator [arithmeticCalculator %AUTO%]]
 	invoker user

 	user invoke $cmd + 100
 	user invoke $cmd - 50
 	user invoke $cmd * 10
 	user invoke $cmd / 2
 	
 	user undo 4
 	user redo 3
 }

'''Iterator:''' "Provide a way to access the elements of an aggregate object sequentially without exposing its underlying representation."

 package require snit

 snit::type stringIterator {
 	method new {varname} {
	  	set i [iterator %AUTO% -variable $varname -firstCommand {
	  		string index $%N [set %C 0]
	  	} -nextCommand {
	  		string index $%N $%C
	  	} -donePredicate {
	  		expr {$%C >= [string length $%N]}
	  	} -currentReader {
	  		string index $%N $%I
	  	} -currentWriter {
	  		set %N [string replace $%N $%I $%I $%V]
	  	}]
 	}
 }
 
 snit::type iterator {
 	option -variable
 	variable varname
 	onconfigure -variable value {set varname $value}

 	option -firstCommand
 	option -nextCommand
 	option -donePredicate
 	option -currentReader
 	option -currentWriter
 	
 	variable current
 	
 	method first {} {
 		set cmd [$self cget -firstCommand]
 		lappend mappings %C [varname current] %N $varname
 		set cmd [string map $mappings $cmd]
 		eval $cmd
 	}
 	
 	method next {} {
 		set cmd [$self cget -nextCommand]
 		lappend mappings %C [varname current] %N $varname
 		set cmd [string map $mappings $cmd]
 		incr current
 		eval $cmd
 	}
 	
 	method isDone {} {
 		set cmd [$self cget -donePredicate]
 		lappend mappings %C [varname current] %N $varname
 		set cmd [string map $mappings $cmd]
 		eval $cmd
 	}
 	
 	method currentItem {{value {}}} {
 		if {$value eq {}} {
 			set cmd [$self cget -currentReader]
 		} else {
 			set cmd [$self cget -currentWriter]
 		}
 		lappend mappings %N $varname %I current %V value
 		set cmd [string map $mappings $cmd]
 		eval $cmd
 	}
 } 

Example:
 
 proc main args {
 	set ::a {Hello World}
 	stringIterator si
 	set i [si new ::a]
 	for {$i first} {![$i isDone]} {$i next} {
 		puts [$i currentItem]
 	}
 }