'''UPDATED May 20, 2004'''

[GPS]: This page serves to demonstrate the design behind the [Smalltick] Tk widgets.

For years I've thought about widgets with inheritance for Tcl/Tk.  A couple of weeks ago the ideas hit me, and I realized I might be able to bring these ideas to fruition.

3 Smalltick Button widgets that have inherited from the Widget, Container, and Button classes:
[http://www.xmission.com/~georgeps/Smalltick/Smalltick-2.6-a.png]

This time demonstrating a color change and the method set.border.relief:
[http://www.xmission.com/~georgeps/Smalltick/Smalltick-2.6-b.png]
----
The relevent code from the top down to produce the images above is:
 proc main {} {
  set mw [Widget [new.object]]
  $mw set {window-path .}
 
  set b [Button [new.object] $mw]
  $b -column 0 -row 0 -sticky news -map
  $b -text [list "Hello World"]
 
  set bell [Button [new.object] $mw]
  $bell \
   -text [list "Press me to make some noise!"] \
   -command [list {puts "\a\a"}]
  $bell -column 1 -row 1 -sticky news -map
  
  set col [Button [new.object] $mw]
  $col \
   -text [list "Press me to select a color."] \
   -command [list {$self -bg [tk_chooseColor]}]
  $col -column 0 -row 2 -sticky news -map
 }
''' see pwq: below for comment'''
----
[GPS]: When I discussed my project in the Tcl'ers Chat [DKF] and others were critical of the idea of using inheritance with widgets.   I've found it hasn't been a problem.

Here is the entire Button class:
 proc Button {b p} {
  Container $b $p
 
  $b set {button-text ""}
 
  $b set [list button-font [gui.create.font "Helvetica 14"]]
  $b set [list button-gc [gui.create.gc [$b get wid]]]
  $b set {button-text ""}
  $b set {button-draw-is-pending 0}
  $b set {command ""}
 
  $b : -command c {
   $self ?set [list command $c]
  }
 
  $b : -text t {
   $self ?set [list button-text $t]
   $self calculate.button.text.size
 
   gui.request.geometry \
    [$self get window-path] \
    [expr {[$self get button-text-width] + 6}] \
    [expr {[$self get button-text-height] + 4}]
 
   $self draw.button.when.idle
  }
 
  $b : button.press.event {} {
   $self set.border.relief pressed
   $self draw.button.when.idle
  }
 
  $b : button.release.event {x y} {
   $self set.border.relief normal
   $self draw.button.when.idle
   eval [$self get command]
  }
 
  $b : calculate.button.text.size {} {
   $self set [list button-text-height \
    [lindex [gui.get.font.metrics [$self get button-font]] end]]
 
   $self set [list button-text-width \
    [gui.measure.string [$self get button-font] [$self get button-text]]]
  }
 
  $b : draw.button {} {
   gui.draw.text \
    [$self get wid] \
    [$self get button-gc] \
    [$self get button-font] \
    3 \
    [$self get button-text-height] \
    [$self get button-text]
   
   $self set {button-draw-is-pending 0}
  }
 
  $b : draw.button.when.idle {} {
   if {[$self get button-draw-is-pending]} return
   $self set {button-draw-is-pending 1}
   after idle [list $self draw.button]
  }
 
  bind Button$b <Expose> [list $b draw.button.when.idle]
  bind Button$b <Configure> [list $b draw.button.when.idle]
  bind Button$b <ButtonPress-1> [list $b button.press.event]
  bind Button$b <ButtonRelease-1> [list $b button.release.event {%x %y}]
 
  bindtags [$b get window-path] [linsert [bindtags [$b get window-path]] end Button$b]
 
  $b calculate.button.text.size
  $b draw.button.when.idle
  
  return $b
 }
----
I've made some changes to the Container class and now it looks like this (in 2.6):
 proc Container {c p} {
  Widget $c
 
  $c set [list window-path \
   [set w [gui.get.unique.window.path [$p get window-path]]]]
 
  set wid [gui.get.window.id [gui.create.window $w]]
 
  $c set [list wid $wid]
 
  #These 3 sets of commands are very alike.  
  #I can't think of the best way to factor them yet.
  $c set [list bg-gc [gui.create.gc $wid]]
  $c set [list bg-color [gui.create.color gray70]]
  gui.set.gc.color [$c get bg-gc] [$c get bg-color]
 
  $c set [list bd-light-gc [gui.create.gc $wid]]
  $c set [list bd-light-color [gui.create.color gray90]]
  gui.set.gc.color [$c get bd-light-gc] [$c get bd-light-color]
 
  $c set [list bd-dark-gc [gui.create.gc $wid]]
  $c set [list bd-dark-color [gui.create.color gray30]]
  gui.set.gc.color [$c get bd-dark-gc] [$c get bd-dark-color]
 
  $c set [list copy-gc [gui.create.gc $wid]]
 
 
  $c set {container-draw-is-pending 0}
  $c set {container-pixmap-width 0}
  $c set {container-pixmap-height 0}
  $c set {container-pixmap 0}
 
  $c set {request-width 100}
  $c set {request-height 100}
 
  $c : -bg color {
   gui.destroy.color [$self get bg-color]
   $self set [list bg-color [gui.create.color $color]]
   gui.set.gc.color [$self get bg-gc] [$self get bg-color]
   $self draw.container.when.idle
  }
 
  $c : -height h {
   $self set [list request-height $h]
   $self request.geometry
  }
 
  $c : -width w {
   $self set [list request-width $w]
   $self request.geometry
  }
 
  $c : build.container.pixmap.if.needed {w h} {
   if {[$self get container-pixmap-width] == $w \
    && [$self get container-pixmap-height] == $h} {
    return 0
   }
   if {0 != [$self get container-pixmap]} {
    gui.destroy.pixmap [$self get container-pixmap]
   }
   $self set [list container-pixmap \
    [gui.create.pixmap [$self get window-path] $w $h]]
   return 1
  }
 
  $c : copy.container.pixmap.to.window {w h} {
   gui.copy.area \
    [$self get copy-gc] \
    [$self get container-pixmap] \
    [$self get wid] \
    0 0 $w $h 0 0
  }
 
  $c : draw.container {} {
   set w [winfo width [$self get window-path]]
   set h [winfo height [$self get window-path]]
 
   if {![$self build.container.pixmap.if.needed [list $w $h]]} {
    $self copy.container.pixmap.to.window [list $w $h]
   }
   gui.draw.rectangle \
    [$self get container-pixmap] \
    [$self get bg-gc] \
    0 0 \
    [winfo width [$self get window-path]] \
    [winfo height [$self get window-path]]
   $self draw.container.border [list [$self get container-pixmap] $w $h]
   $self set {container-draw-is-pending 0}
   $self copy.container.pixmap.to.window [list $w $h]
  }
 
  $c : draw.container.border {pix w h} {
   gui.draw.line \
    $pix \
    [$self get bd-light-gc] \
    0 0 0 $h
   gui.draw.line \
    $pix \
    [$self get bd-light-gc] \
    0 0 $w 0
   gui.draw.line \
    $pix \
    [$self get bd-dark-gc] \
    [expr {$w - 1}] 0 [expr {$w - 1}] $h
   gui.draw.line \
    $pix \
    [$self get bd-dark-gc] \
    0 [expr {$h - 1}] $w [expr {$h - 1}]
  }
 
  $c : draw.container.when.idle {} {
   if {[$self get container-draw-is-pending]} return
   $self set {container-draw-is-pending 1}
   after idle [list $self draw.container]
  }
 
  $c : request.geometry {} {
   gui.request.geometry \
    [$self get window-path] \
    [$self get request-width] \
    [$self get request-height]
  }
 
  $c : set.border.relief type {
   if {"pressed" eq $type} {
    gui.set.gc.color [$self get bd-light-gc] [$self get bd-dark-color]
    gui.set.gc.color [$self get bd-dark-gc] [$self get bd-light-color]
   } else {
    gui.set.gc.color [$self get bd-light-gc] [$self get bd-light-color]
    gui.set.gc.color [$self get bd-dark-gc] [$self get bd-dark-color]
   }
   $self draw.container.when.idle
  }
 
  bind Container$w <Configure> [list $c draw.container.when.idle]
  bind Container$w <Expose> [list $c draw.container.when.idle]
  bindtags $w [list $w Container$w all]
  $c request.geometry
  $c draw.container
 
  return $c
 }
----
You may wonder: why is this cool?  To me it's cool because the widgets are mostly written in Tcl.  The various gui.* commands you see used above are provided by a simple C extension I wrote.  That said, there is work left to do.  A method of invoking a recursive destroy of a widget with proper cleanup is needed.
----
[PWQ] ''21 May 2004'', heres the equivalent in straight tcl.
   grid [button .b1 -text {Hello World}] -column 0 -row 0 -sticky news
   grid [button .b2 -text {...Noise} -col ....
   grid [buttin .b3 -text {...Colour} -col .... -command {.b3 configure -bg [tk_chooseColor]} 
Three lines instead of 15. Even if we used $win to make it more generic, it would still be shorter, and easier to write, an more importantly we can change the grid to pack or even rearange the widgets quite simply.

My question, ''were are the examples that show that OO style is more productive than proceedual programming?''


----
[Category GUI] | [Category Widget]