See also [Design patterns in Tcl], [Incr Tcl Design Patterns].

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:
   invoker:   knows how to schedule command activation, possibly with mechanisms like undo, logging, or priority.
   actor:   knows how to perform the actions specified by the commands.
   command:   contains one action-actor binding.
}
======
 
 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
 }
======

if 0 {
----
'''Iterator:'''

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

''Implementation notes:'' The object is wrapped in a class that provides methods for finding the first element, finding the next element, dereferencing the current element, and a predicate for determining if all elements have been traversed.
}
 
======
 package require snit

 snit::type stringIterator {
         option -variable
         
         variable varname
         variable current 0
         
         method first {} {
                string index [set [$self cget -variable]] [set current 0]
         }
         
         method next {} {
                string index [set [$self cget -variable]] [incr current]
         }
         
         method isDone {} {
                expr {$current >= [string length [set [$self cget -variable]]]}
         }
         
         method currentItem {{value {}}} {
                 set varname [$self cget -variable]
                 if {$value eq {}} {
                          string index [set $varname] $current
                 } else {
                          set $varname [string replace [set $varname] $current $current $value]
                 }
         }
 }
 
 # Usage example:
 
 proc main args {
         set ::a {Hello World}
         set i [stringIterator %AUTO% -variable ::a]
         for {$i first} {![$i isDone]} {$i next} {
                 puts [$i currentItem]
         }
 }
======

if 0 {

----
'''Mediator:'''

''Description:'' 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 mediator {
         variable colleagues
         
         method register {name class} {
                 set object [set colleagues($name) [$class %AUTO% -name $name]]
                 $object configure -mediator $self
                 return $object
         }
         
         method send {from whom what} {
                 if {[info exists colleagues($whom)]} {
                         $colleagues($whom) receive $from $what
                 }
         }
 }

 snit::type beatleParticipant {
         option -name
         option -mediator
         
         method send {whom what} {
                 [$self cget -mediator] send [$self cget -name] $whom $what
         }
         
         method receive {from what} {
                 puts "To a Beatle: $from to [$self cget -name]: '$what'"
         }
 } 
 
 snit::type nonBeatleParticipant {
         option -name
         option -mediator
         
         method send {whom what} {
                 [$self cget -mediator] send [$self cget -name] $whom $what
         }
         
         method receive {from what} {
                 puts "To a Non-Beatle: $from to [$self cget -name]: '$what'"
         }
 } 
 
 # Usage example:
 
 proc main args {
         # Create chatroom
         mediator c
         
         # Create 'chatters' and register them
         set George [c register George beatleParticipant]
         set Paul   [c register Paul   beatleParticipant]
         set Ringo  [c register Ringo  beatleParticipant]
         set John   [c register John   beatleParticipant]
         set Yoko   [c register Yoko   nonBeatleParticipant]
         
         # 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"
 }
======

if 0 {
----
'''Memento:'''

''Description:'' Without violating encapsulation, capture and externalize an object's internal state so that the object can be restored to this state later.

''Implementation notes:'' The state of a snit is stored in the options array and in the instance variables.  Saving/restoring the options trivial, as shown below.  Saving/restoring instance variables requires devising some packing/unpacking scheme.
}
======
 
 package require snit

 # originator 
 snit::type salesProspect {
         option -name
         option -phone
         option -budget
         
        variable currency \$
        
         method show {} {
                 puts "\nSales prospect ---- "
                 puts "Name: [$self cget -name]" 
                 puts "Phone: [$self cget -phone]" 
                 puts "Budget: $currency[$self cget -budget]" 
        }

        method euro {} {set currency \u20AC}
         
         method createMemento {} {
                array set variables [list currency $currency]
                 set m [prospectMemory %AUTO% -state [list [array get options] [array get variables]]]
         }
         
         method restoreMemento {memento} {
                foreach {optionList variableList} [$memento cget -state] break
                 array set options $optionList
                 foreach {name val} $variableList {
                        set $name $val
                }
         }
 }
 
 # memento
 snit::type prospectMemory {
         option -state
 }

 # Usage 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 euro
          s show
         
         s restoreMemento $m
         s show
 }
======

if 0 {
----
'''Observer:'''

''Description:'' Define a one-to-many dependency between objects so that when one object changes state, all its dependents are notified and updated automatically.

''Implementation notes:'' 
}
======

 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
         }
 }

 # ''Usage 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])
   * Delegate the relevant methods to a component called "state".
   * Initialize the "state" instance variable to the initial state object.
   * When the state changes, assign a different state object to "state".
}
======
 
 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
 }
======


if 0 {
----
'''Strategy:'''

''Description:''  Define a family of algorithms, encapsulate each one, and make them interchangeable. Strategy lets the algorithm vary independently from clients that use it.

''Implementation notes:'' 

}

======
 package require snit

 snit::type warlord {
         option -strategy

        method hearBirdSing {} {
                if {[$self cget -strategy] ne {}} {
                        [$self cget -strategy] do
                } else {
                        puts ...
                }
        }
 }

 snit::type nobunaga {
         method do {} {
                puts "If the bird does not sing, I shall wring its neck."
        }
 }
 
 snit::type hideyoshi {
         method do {} {
                puts "I shall try to teach the bird to sing."
        }
 }
 
 snit::type ieyasu {
         method do {} {
                puts "I shall wait for the bird to sing."
        }
 }
 
 # ''Usage example:''

 proc main args {
         # the warlord Rikyu wants to hear the bird sing, but it won't.
        warlord Rikyu
        Rikyu hearBirdSing

        # which great leader from history will Rikyu borrow a strategy from?
        Rikyu configure -strategy [hideyoshi %AUTO%]
        Rikyu hearBirdSing
 }
======

----
'''Function objects:'''

''See:'' [Snit Lambda]

<<categories>> Design | Snit