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 -reportTo
method handle request {}
}
snit::type director {
delegate method * to base
delegate option * to base
variable base
method handle request {
if {$request >= 0 && $request < 10} {
puts "$self handled request $request"
} elseif {[$self cget -reportTo] ne {}} {
[$self cget -reportTo] handle $request
}
}
constructor args {
set base [handler %AUTO%]
$self configurelist $args
}
}
snit::type vicePresident {
delegate method * to base
delegate option * to base
variable base
method handle request {
if {$request >= 10 && $request < 20} {
puts "$self handled request $request"
} elseif {[$self cget -reportTo] ne {}} {
[$self cget -reportTo] handle $request
}
}
constructor args {
set base [handler %AUTO%]
$self configurelist $args
}
}
snit::type president {
delegate method * to base
delegate option * to base
variable base
method handle request {
if {$request >= 20 && $request < 30} {
puts "$self handled request $request"
} elseif {[$self cget -reportTo] ne {}} {
[$self cget -reportTo] handle $request
}
}
constructor args {
set base [handler %AUTO%]
$self configurelist $args
}
}Example:
proc main args {
president Mary
vicePresident Gus -reportTo Mary
director Tom -reportTo Gus
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: "Given a language, define a representation for its grammar along with an interpreter that uses the representation to interpret sentences in the language."
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]
}
}Mediator: "Define an object that encapsulates how a set of objects interact. Mediator promotes loose coupling by keeping objects from referring to each other explicitly, and it lets you vary their interaction independently."
package require snit
snit::type chatroom {
variable participants
method register participant {
set participants([$participant cget -name]) $participant
$participant configure -chatroom $self
}
method send {from whom what} {
if {[info exists participants($whom)]} {
set recipient $participants($whom)
$recipient receive $from $what
}
}
}
snit::type participant {
option -name
option -chatroom
method send {whom what} {
[$self cget -chatroom] send [$self cget -name] $whom $what
}
method receive {from what} {
return "$from to [$self cget -name]: '$what'"
}
}
snit::type beatleParticipant {
delegate option * to base
delegate method send to base
variable base
method receive {from what} {
puts "To a Beatle: [$base receive $from $what]"
}
constructor args {
set base [participant %AUTO%]
$self configurelist $args
}
}
snit::type nonBeatleParticipant {
delegate option * to base
delegate method send to base
variable base
method receive {from what} {
puts "To a Non-Beatle: [$base receive $from $what]"
}
constructor args {
set base [participant %AUTO%]
$self configurelist $args
}
}Example:
proc main args {
# Create chatroom
chatroom c
# Create 'chatters' and register them
set George [beatleParticipant %AUTO% -name George]
set Paul [beatleParticipant %AUTO% -name Paul]
set Ringo [beatleParticipant %AUTO% -name Ringo]
set John [beatleParticipant %AUTO% -name John]
set Yoko [nonBeatleParticipant %AUTO% -name Yoko]
c register $George
c register $Paul
c register $Ringo
c register $John
c register $Yoko
# Chatting participants
$Yoko send "John" "Hi John!"
$Paul send "Ringo" "All you need is love"
$Ringo send "George" "My sweet Lord"
$Paul send "John" "Can't buy me love"
$John send "Yoko" "My sweet love"
}Memento: "Without violating encapsulation, capture and externalize an object's internal state so that the object can be restored to this state later."
package require snit
# originator
snit::type salesProspect {
option -name
option -phone
option -budget
method show {} {
puts "\nSales prospect ---- "
puts "Name: [$self cget -name]"
puts "Phone: [$self cget -phone]"
puts "Budget: [$self cget -budget]"
}
method createMemento {} {
set m [prospectMemory %AUTO% -state [array get options]]
}
method restoreMemento {memento} {
array set options [$memento cget -state]
}
}
# memento
snit::type prospectMemory {
option -state
}Example:
proc main args {
salesProspect s
s configurelist {
-name "Noel van Halen"
-phone "(412) 256-0990"
-budget 25000.0
}
s show
set m [s createMemento]
s configurelist {
-name "Leo Welch"
-phone "(310) 209-7111"
-budget 1000000.0
}
s show
s restoreMemento $m
s show
}Observer: "Define a one-to-many dependency between objects so that when one object changes state, all its dependents are notified and updated automatically."
package require snit
snit::type investor {
option -name
method update stock {
puts -nonewline "Investor [$self cget -name] notified of "
puts -nonewline "[$stock cget -symbol]'s change to "
puts [format "%.2f" [$stock cget -price]]
}
}
snit::type stock {
option -symbol
option -price
onconfigure -price value {
set options(-price) $value
$self notify
}
variable investors {}
method attach investor {lappend investors $investor}
method detach investor {
set i [lsearch $investors $investor]
if {$i >= 0} {
set investors [lreplace $investors $i $i]
}
}
method notify {} {
foreach investor $investors {
$investor update $self
}
}
}
snit::type IBM {
delegate method * to base
delegate option * to base
variable base
constructor args {
set base [stock %AUTO%]
$self configurelist $args
}
}Example:
proc main args {
investor s -name Sorros
investor b -name Berkshire
IBM ibm -symbol IBM -price 120.00
ibm attach s
ibm attach b
foreach p {120.10 121.00 120.50 120.75} {
ibm configure -price $p
}
}State: "Allow an object to alter its behavior when its internal state changes. The object will appear to change its class."
package require snit
snit::type state {
option -account
option -balance
onconfigure -balance value {
set options(-balance) $value
if {[set acct [$self cget -account]] ne {}} {
[$acct cget -state] checkStateChange
}
}
method deposit amount {}
method withdraw amount {}
method payInterest {} {}
method checkStateChange {} {}
typemethod copy {newstate oldstate} {
$newstate configure -balance [$oldstate cget -balance]
$newstate configure -account [$oldstate cget -account]
}
}
snit::type redState {
delegate method * to base
delegate option * to base
variable upperLimit 0.0
variable serviceFee 15.00
variable base
method deposit amount {
$self configure -balance [expr [$self cget -balance] + $amount - $serviceFee]
}
method checkStateChange {} {
if {[$self cget -balance] > $upperLimit} {
[$self cget -account] configure -state [silverState ::%AUTO%]
}
}
constructor args {
set base [state %AUTO%]
$self configurelist $args
}
}
snit::type silverState {
delegate method * to base
delegate option * to base
variable interest 0.0
variable lowerLimit 0.0
variable upperLimit 1000.0
variable base
method deposit amount {
$self configure -balance [expr [$self cget -balance] + $amount]
}
method withdraw amount {
$self configure -balance [expr [$self cget -balance] - $amount]
}
method payInterest {} {
$self configure -balance [expr [$self cget -balance] * (1 + $interest)]
}
method checkStateChange {} {
set balance [$self cget -balance]
set acct [$self cget -account]
if {$balance > $upperLimit} {
$acct configure -state [goldState ::%AUTO%]
} elseif {$balance < $lowerLimit} {
$acct configure -state [redState ::%AUTO%]
}
}
constructor args {
set base [state %AUTO%]
$self configurelist $args
}
}
snit::type goldState {
delegate method * to base
delegate option * to base
variable interest 0.05
variable lowerLimit 1000.0
variable base
method deposit amount {
$self configure -balance [expr [$self cget -balance] + $amount]
}
method withdraw amount {
$self configure -balance [expr [$self cget -balance] - $amount]
}
method payInterest {} {
$self configure -balance [expr [$self cget -balance] * (1 + $interest)]
}
method checkStateChange {} {
set balance [$self cget -balance]
set acct [$self cget -account]
if {$balance < $lowerLimit} {
$acct configure -state [silverState ::%AUTO%]
} elseif {$balance < 0.0} {
$acct configure -state [redState ::%AUTO%]
}
}
constructor args {
set base [state %AUTO%]
$self configurelist $args
}
}
snit::type account {
option -owner
option -state
onconfigure -state newstate {
set oldstate $options(-state)
set options(-state) $newstate
if {$oldstate ne {}} {
::state copy $newstate $oldstate
}
}
method balance {} {
[$self cget -state] cget -balance
}
method deposit amount {
[$self cget -state] deposit $amount
puts [format "Deposited %.2f --- " $amount]
puts [format "Balance = %.2f" [$self balance]]
puts [format "Status = %s" [$self cget -state]]
puts {}
}
method withdraw amount {
[$self cget -state] withdraw $amount
puts [format "Withdrew %.2f --- " $amount]
puts [format "Balance = %.2f" [$self balance]]
puts [format "Status = %s" [$self cget -state]]
puts {}
}
method payInterest {} {
[$self cget -state] payInterest
puts "Interest Paid --- "
puts [format "Balance = %.2f" [$self balance]]
puts [format "Status = %s" [$self cget -state]]
puts {}
}
constructor args {
$self configure -state [silverState ::%AUTO% -balance 0.0 -account $self]
}
}Example:
proc main args {
account account -owner "Molly Brown"
account deposit 500.0
account deposit 300.0
account deposit 550.0
account payInterest
account withdraw 2000.00
account withdraw 1100.00
}