xelem: Tcl/Tk script to display the periodic table 
Author Message
 xelem: Tcl/Tk script to display the periodic table

Hello,

In the spirit of showing how Tcl/Tk beats writing straight X code, I
wrote a program to display a periodic table of elements.  I wrote this
as my first "large" Tcl code, so I invite comments of the
cognoscienti.

The X code (called xpt) was recently posted to comp.sources.x and it
required two articles; I estimate its size to be around 100kB of C
code. The Tcl version is slightly over 23 kB, while including the
following features:

      - customizability via a ~/.xelemrc file that can be as simple as

                set Fe(atomic mass) <some better value than I have>
                set Fe(color) steel-blue

        or as complicated as a code adding new menu entries to calculate
        specific properties of chemical compounds, for instance

      - plotting of atomic properties vs the atomic number, complete with
        zooming. Note: this feature uses the xygraph widget that can be found on
        the archive sites. If this widget is not compiled in, the program will still
        run under standard wish executable.

      - menu entry for mailing the local maintainer (if for instance
        the physical values are screwed up)

Greetings to all


                        Reactor Division (bldg. 235), E111
                        National Institute of Standards and Technology
                        Gaithersburg, MD 20899,      USA

                        (301) 975 6249 tel
                        (301) 921 9847 fax

------------cut here and don't forget to edit the signature at the end -----------------
#!/usr/local/bin/wishx -f
# Program: periodic table display
# Written by Przemek Klosowski (C) 1993 (released under GNU licence)

# customization section:
#   list of fonts, regularized
set Font(LargeRoman) *times-medium-r-normal--*-240-*
#   mail with comments will be sent to this person

#   show this value in the initial window
set ShowThisValue {atomic number}

proc DoAbout {} {
        global XELEMversion
        popMessage .about About \
        "This is a periodic table display written by Przemek Klosowski\
                    (version $XELEMversion)"

Quote:
}

# procedure to show window .
proc ShowWindow {args} {# xf ignore me 7

  global PeriodicTable Titles ShowThisValue ElementCell maintainer

  # Window manager configurations
  wm positionfrom . user
  wm sizefrom . ""
  wm maxsize . 1024 864
  wm minsize .  300 250
  wm title . {Periodic table of elements}
  wm iconname . {Xelem}

  frame .titlebar    -borderwidth {2} -geometry {300x23} -relief {raised}
  frame .mendelejew  -borderwidth {2} -geometry {300x30} -relief {raised}
  frame .status      -borderwidth {2} -geometry {300x23}

  pack append . \
    .titlebar {top frame center fillx} \
    .mendelejew {top frame center padx 30 pady 20} \
    .status {top frame center fillx}

  set tp .titlebar.file
  menubutton $tp  -menu $tp.m -text File
  menu $tp.m
  $tp.m add command -label "About.." -command {DoAbout }
  $tp.m add command -label "Mail $maintainer" -command Mail
  $tp.m add separator
  $tp.m add command -label "Quit" -command {destroy .}

  set to .titlebar.opt
  menubutton $to  -menu $to.m -text Options
  menu $to.m
  $to.m add command -label Show -command "$to.m.s post 50 50"
  menu $to.m.s
  foreach a $Titles {
    $to.m.s add radiobutton -label $a -variable ShowThisValue \
                            -command "Relabel; $to.m.s unpost"
  }
  $to.m add command -label Plot -command "$to.m.p post 50 50"
  if {![string compare {} [info command xygraph]]} {
        $to.m entryconfigure 2 -command {
             popMessage .argh Sorry "Can't plot: xygraph widget not linked in"}
  }
  menu $to.m.p
  foreach a $Titles {
    $to.m.p add radiobutton -label $a \
                            -command  "Plot \{$a\}; $to.m.p unpost"

  }

  pack append .titlebar $tp left $to left

  pack append .status   [label .status.l] left
  for {set i 1} { $i<=9 } { incr i 1} {
        pack append .mendelejew [frame .row$i -relief raised] top
        for {set j 0} { $j<18 } { incr j 1} {
            set elem [string trim [string range $PeriodicTable($i) [expr $j*3] [expr $j*3+1]]]
            set ec .row$i.f$j
            if {$elem != ""} {
                global $elem
                set ElementCell($elem) $ec
                pack append [frame  $ec   -relief sunken -borderwidth 1] \
                            [button $ec.b -text $elem -width 2\
                                          -borderwidth 1 \
                                          -command "ShowElem $elem"] top \
                            [label  $ec.l -width 5 \
                                          -anchor w ]  top
                pack append .row$i  $ec {left fill}
            } {
                pack append [frame  $ec] \
                            [label  $ec.l -width 5] top
                pack append .row$i  $ec {left  fill}
            }
        }      
  }
  Relabel

  .row1.f1.b configure -background grey
  .row3.f2.l configure -text 3B
  .row3.f3.l configure -text 4B
  .row3.f4.l configure -text 5B
  .row3.f5.l configure -text 6B
  .row3.f6.l configure -text 7B
  .row3.f7.l configure -text <-
  .row3.f8.l configure -text 8
  .row3.f9.l configure -text ->
  .row3.f10.l configure -text 1B
  .row3.f11.l configure -text 2B
  .row1.f12.l configure -text 3A
  .row1.f13.l configure -text 4A
  .row1.f14.l configure -text 5A
  .row1.f15.l configure -text 6A
  .row1.f16.l configure -text 7A

Quote:
}

proc Relabel {} {
 global ElementCell ShowThisValue
 foreach elem [array names ElementCell] {
   global $elem
   $ElementCell($elem).l configure -text [set ${elem}($ShowThisValue)]
 }
 .status.l configure -text "Displaying $ShowThisValue"

Quote:
}

proc Plot {what} {
  global ElementCell

  catch "destroy .p"
  toplevel   .p
  wm title   .p "Plot of $what"
  wm minsize .p 700 200
  pack append .p [xygraph .p.g -title "Plot of $what" \
                                -xlabel Element\
                                -ylabel $what ] {top fill} \
                 [frame .p.f] top
  pack append .p.f [button .p.f.cancel  -text Cancel \
                                        -command "destroy .p" ] {left fillx}
  set xcoord {atomic number}
  foreach elem [array names ElementCell] {
        global $elem
        set x [set ${elem}($xcoord)]
        set y [set ${elem}($what)]
        set invalidx [catch "expr $x"]
        set invalidy [catch "expr $y"]
        if {$invalidx || $invalidy}    { continue  }
        lappend xl $x
        lappend yl $y
  }
  .p.g insert line -xdata $xl -ydata $yl -symbol circle

  bind .p.g <ButtonPress-1> {
    get.anchor %W %x %y ; %W config -cursor {crosshair red black}
  }

  bind .p.g <ButtonPress-2> {
    catch "%W delete outline" msg
    %W config -xmin {} -ymin {} -xmax {} -ymax {}
  }

Quote:
}

proc get.coords { w sx sy xVar yVar } {
  # w   widget
  # sx  screen x position
  # sy  screen y position

  scan [$w locate $sx $sy ] "%s %s" x y
  scan [$w limits ] "%s %s %s %s" xmin xmax ymin ymax
  if { $x > $xmax } { set x $xmax }
  if { $x < $xmin } { set x $xmin }
  if { $y > $ymax } { set y $ymax }
  if { $y < $ymin } { set y $ymin }
  global $xVar $yVar
  set $xVar $x
  set $yVar $y

Quote:
}

proc get.anchor { w sx sy } {
  # w   widget
  # sx  screen x position
  # sy  screen y position

  global x1 y1 x2 y2
  set x2 "" ; set y2 ""
  get.coords $w $sx $sy x1 y1
  bind $w <B1-Motion> { scan.xy %W %x %y }
  bind $w <ButtonRelease-1> { zoom.xy %W %x %y }

Quote:
}

proc box { w x1 y1 x2 y2 } {
  $w newtag t1 $x1 $y1 \
        -text [format "(%.4g, %.4g)" $x1 $y1] \
        -fg red -bg grey \
        -font *new*century*140*
  $w newtag t2 $x2 $y2 \
        -text [format "(%.4g, %.4g)" $x2 $y2] \
        -fg red -bg grey \
        -font *new*century*140*
  $w insert outline \
        -xydata { $x1 $y1 $x1 $y2 $x1 $y1 $x2 $y1 $x2 $y1 $x2 $y2
                 $x1 $y2 $x2 $y2 } \
        -symbol dotted -color red -label {} -showretrace true
Quote:
}

proc scan.xy { w sx sy } {
  # w   widget
  # sx  screen x position
  # sy  screen y position

  global x1 y1 x2 y2
  get.coords $w $sx $sy x2 y2
  if { $x1 > $x2 } {
     box $w $x2 $y2 $x1 $y1
     if { $y1 > $y2 } {
       $w config -cursor { bottom_left_corner red black }
     } else {
       $w config -cursor { top_left_corner red black }
     }
  } else {
     box $w $x1 $y1 $x2 $y2
     if { $y1 > $y2 } {
       $w config -cursor { bottom_right_corner red black }
     } else {
       $w config -cursor { top_right_corner red black }
     }
  }

Quote:
}

proc zoom.xy { w sx sy } {
  # w   widget
  # sx  screen x position
  # sy  screen y position

  global x1 y1 x2 y2
  # Go back to original bindings
  bind $w <ButtonPress-1> { get.anchor %W %x %y }
  catch "$w untag t1" msg
  catch "$w untag t2" msg
  bind $w <B1-Motion> {}
  if { $x2 == "" } then {
     catch "$w delete outline" msg
     $w config -xmin {} -ymin {} -xmax {} -ymax {}
     return
  }
  if { $x1 > $x2 } {
     $w config -xmin $x2 -xmax $x1
  } else {
     if { $x1 < $x2 } {
        $w config -xmin $x1 -xmax $x2
     }
  }
  if { $y1 > $y2 } {
     $w config -ymin $y2 -ymax $y1
  } else {
     if { $y1 < $y2 } {
        $w config -ymin $y1 -ymax $y2
     }
  }
  $w config -cursor crosshair

Quote:
}

proc Mail {} {
 toplevel .m
 wm title .m {Mail your comments}
 pack append .m [text .m.t] top \
                [frame .m.f] top
 pack append .m.f [button .m.f.send   -text Send   -command SendMail] left \
                  [button .m.f.cancel -text Cancel -command "destroy .m" ] left
Quote:
}

proc SendMail {} {
 global maintainer
 set file [open "|mail -s About_Xelem... $maintainer" w]
 puts $file [.m.t get 1.0 end]
 close $file
 destroy .m

Quote:
}

proc ShowElem {elemName} {
        global Titles $elemName Font

        set wname .el$elemName
        toplevel $wname
        wm title $wname $elemName
        wm iconname $wname $elemName

        foreach item [array names $elemName] {
          set element($item) [set ${elemName}($item)]
        }

        pack append [frame $wname.1] \
          [DoField $wname.1 nm {name} ""] {left} \
          [DoField $wname.1 z  {atomic number} Z] {left padx 20 fill}\
          [DoField $wname.1 a  {atomic mass} A] {right}

        pack append [frame $wname.2] \
          [DoField $wname.2 rho {density [g/ccm]}] left\
          [DoField $wname.2 av  {atomic volume}  ] right

        pack append [frame $wname.3] \
          [DoField $wname.3 ar {atomic radius [A]}  ] left \
          [DoField $wname.3 cr {covalent radius [A]}] right

        pack append [frame $wname.4] \
          [DoField $wname.4 ar {melting pt [K]}  ] left \
          [DoField $wname.4 cr {boiling pt [K]}] right

        pack append [frame $wname.5 -relief raised -border 1] \
          [DoField $wname.5 s {structure} "" ] left \
          [DoField $wname.5 a
...

read more »



Thu, 08 Feb 1996 10:20:51 GMT  
 xelem: Tcl/Tk script to display the periodic table
Didn't you forget the icon_bitmap????

error reading bitmap file "/usr/local/lib/bitmaps/xelem.xbm"
    while executing

    (procedure "ShowWindow" line 12)
    invoked from within
"ShowWindow"
    (file "./xelem" line 528)
    invoked from within
"source ./xelem"

/Peppar



Thu, 08 Feb 1996 19:22:32 GMT  
 xelem: Tcl/Tk script to display the periodic table

   Didn't you forget the icon_bitmap????
           error reading bitmap file "/usr/local/lib/bitmaps/xelem.xbm"

I did! sorry about that; I enclose my lousy bitmap, but I am afraid it is nothing
to be proud of. Better bitmaps would be appreciated.

 Alternatively one could change the line:


to
        if [file readable /usr/local/lib/bitmaps/xelem.xbm] {

        }

--

                        Reactor Division (bldg. 235), E111
                        National Institute of Standards and Technology
                        Gaithersburg, MD 20899,      USA

                        (301) 975 6249 tel
                        (301) 921 9847 fax



Fri, 09 Feb 1996 23:25:38 GMT  
 
 [ 4 post ] 

 Relevant Pages 

1. Periodic Table script

2. Tcl script exec'd from VMS tcl script doesn't display puts o/p

3. Can _One_ Tcl/Tk script run _Two_ displays?

4. tcl/tk-scripts, Apache & tcl/tk-plugin

5. tcl/tk 8.0 problem with Windows app that calls tcl/tk script

6. The Periodic Table Puzzle

7. Running a TK script using wish80.exe within a tcl script

8. Need example of working tcl/tk script used as cgi-bin script

9. Periodic script execution

10. problems running tk-script with tcl/tk 8.3.3

11. tk script to display image array

12. Tk 8.0: Focus problems with multi-X-display script

 

 
Powered by phpBB® Forum Software