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.
if 0 {
Chain-of-responsibility:
Description: 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.
Implementation notes: Uses a linked list of snit objects, each having a handle method, a -command option and a -next option. The handle method evaluates the code in the -command option together with any arguments given. If the result is the empty string, it asks the next object in the chain to handle it. }
package require snit
snit::type handler {
option -next list
option -command
method handle args {
if {[eval [$self cget -command] $self $args] eq {}} {
eval [$self cget -next] handle $args
}
}
}# Usage example:
proc director {self request} {
if {$request >= 0 && $request < 10} {
puts "$self handled request $request"
}
}
proc vicePresident {self request} {
if {$request >= 10 && $request < 20} {
puts "$self handled request $request"
}
}
proc president {self request} {
if {$request >= 20 && $request < 30} {
puts "$self handled request $request"
}
}
proc main args {
handler Mary -command president
handler Gus -command vicePresident -next Mary
handler Tom -command director -next Gus
foreach request [list 2 5 14 22 18 38 3 27 20] {
Tom handle $request
}
}if 0 {
Command:
Description: Encapsulate a request as an object, thereby letting you parameterize clients with different requests, queue or log requests, and support undoable operations.
Implementation notes: This pattern requires interaction between at least three objects:
}
package require snit
snit::type command {
option -actor
option -action
method execute {} {
[$self cget -actor] action [$self cget -action]
}
}
snit::type actor {
variable state 0
method action action {
set state [eval expr $state $action]
}
}
snit::type invoker {
option -actor
variable commands
variable current 0
method redo levels {
for {set i 0} {$i < $levels} {incr i} {
if {$current < [llength $commands]} {
set cmd [lindex $commands $current 0]
set total [$cmd execute]
puts "Total = $total (following [$cmd cget -action])"
incr current
}
}
}
method undo levels {
for {set i 0} {$i <= $levels} {incr i} {
if {$current > 0} {
set cmd [lindex $commands [incr current -1] 1]
set total [$cmd execute]
puts "Total = $total (following [$cmd cget -action])"
}
}
}
method compute args {
set cmd1 [command %AUTO% -actor [$self cget -actor] -action $args]
set cmd2 [command %AUTO% -actor [$self cget -actor] \
-action [string map {+ - - + * / / *} $args]]
lappend commands [list $cmd1 $cmd2]
$self redo 1
}
}# Usage example:
proc main args {
invoker user -actor [actor %AUTO%]
user compute + 100
user compute - 50
user compute * 10
user compute / 2
puts "---- Undo 4 levels"
user undo 4
puts "---- Redo 3 levels"
user redo 3
}Interpreter: "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
}
}if 0 {
State:
Description: Allow an object to alter its behavior when its internal state changes. The object will appear to change its class.
Implementation notes: (as suggested by WHD)
}
package require snit
snit::type redState {
option -account
option -balance
onconfigure -balance value {
set options(-balance) $value
if {[set acct [$self cget -account]] ne {}} {
if {[$self cget -balance] > $upperLimit} {
[$self cget -account] alter silverState
}
}
}
variable upperLimit 0.0
variable serviceFee 15.00
method deposit amount {
$self configure -balance [expr [$self cget -balance] + $amount - $serviceFee]
}
method withdraw amount {
puts "No funds available to withdraw!"
}
method payInterest {} {}
}
snit::type silverState {
option -account
option -balance
onconfigure -balance value {
set options(-balance) $value
if {[set acct [$self cget -account]] ne {}} {
set balance $value
if {$balance > $upperLimit} {
$acct alter goldState
} elseif {$balance < $lowerLimit} {
$acct alter redState
}
}
}
variable interest 0.0
variable lowerLimit 0.0
variable upperLimit 1000.0
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)]
}
}
snit::type goldState {
option -account
option -balance
onconfigure -balance value {
set options(-balance) $value
if {[set acct [$self cget -account]] ne {}} {
set balance $value
if {$balance < 0.0} {
$acct alter redState
} elseif {$balance < $lowerLimit} {
$acct alter silverState
}
}
}
variable interest 0.05
variable lowerLimit 1000.0
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)]
}
}
snit::type account {
option -owner
delegate method * to state
delegate option * to state
variable state
method balance {} {
$state cget -balance
}
method deposit amount {
$state deposit $amount
puts [format "Deposited %.2f --- " $amount]
puts [format "Balance = %.2f" [$self balance]]
puts [format "Status = %s" $state]
puts {}
}
method withdraw amount {
$state withdraw $amount
puts [format "Withdrew %.2f --- " $amount]
puts [format "Balance = %.2f" [$self balance]]
puts [format "Status = %s" $state]
puts {}
}
method payInterest {} {
$state payInterest
puts "Interest Paid --- "
puts [format "Balance = %.2f" [$self balance]]
puts [format "Status = %s" $state]
puts {}
}
method alter t {
set state [$t ::%AUTO% -balance [$state cget -balance] -account [$state cget -account]]
}
constructor args {
set state [silverState ::%AUTO% -balance 0.0 -account $self]
$self configurelist $args
}
}# Usage 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
}