home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 5 / Skunkware 5.iso / tls / tls074c.sunsparc.Z / tls074c.sunsparc / lib / vtcl / examples / short.tcl < prev   
Encoding:
Text File  |  1995-07-20  |  2.4 KB  |  77 lines
  1. #!/bin/vtcl
  2. # ---------------------------------------------------------------------
  3. # Copyright 1994 by SCO, Inc.
  4. # Permission to use, copy, modify, distribute, and sell this software
  5. # and its documentation for any purpose is hereby granted without fee,
  6. # provided that the above copyright notice appear in all copies and that
  7. # both that copyright  notice  and  this  permission  notice  appear  in
  8. # supporting documentation, and that the name  of  SCO  not  be used  in
  9. # advertising or publicity pertaining  to distribution of  the  software
  10. # without   specific,   written  prior   permission.    SCO   makes   no
  11. # representations  about  the  suitability  of  this  software  for  any
  12. # purpose.  It is provided "as is" without express or implied warranty.
  13. # ---------------------------------------------------------------------
  14.  
  15. # Demo        : short.tcl
  16. # Description    : Silly demo of how to use point help a la the
  17. #          -shortHelpCallback option.
  18. #  
  19.  
  20. # Close connection and exit Vtcl interpreter.
  21. proc CloseCB { cbs } {
  22.     VtClose; exit 0
  23. }
  24.  
  25. # We need to deal with case when vtcl is not in a standard place
  26. if { [ catch { set pixDir $env(VTCL_HOME)/pixmaps } errorMsg ] != 0 } {
  27.     # VTCL_HOME is not set; assume standard place
  28.     set pixDir /lib/vtcl/pixmaps
  29. } 
  30.  
  31. set pixList  [list check.px dir.px file.px newicon.px odir.px exec.px]
  32. set origExpressionsList [list oops! umph! uh-oh! "on no!" phooey! whoa! bummer!]
  33. set expressionsList $origExpressionsList  
  34.  
  35. proc SwitchPixMapCB {cbs} {
  36.     global pixList expressionsList origExpressionsList oopsLbl pixDir
  37.     set newPix [lvarpop pixList]
  38.     set widget [keylget cbs widget] 
  39.     VtSetValues $widget -pixmap $pixDir/$newPix
  40.     lvarpush pixList $newPix len
  41.     if { [llength $expressionsList] != 0 } {
  42.         VtSetValues $oopsLbl -label [lvarpop expressionsList]
  43.     } else {
  44.         # re-load
  45.         set expressionsList $origExpressionsList  
  46.     }
  47. }
  48.  
  49. set app [VtOpen joe]
  50. set mainForm [VtFormDialog $app.mainForm \
  51.     -title "Short Stuff" \
  52.     -ok \
  53.     -okCallback CloseCB \
  54.     ]
  55.  
  56. set lbl [VtLabel $mainForm.lbl \
  57.     -label "Put your mouse over\nan elusive pixmap!" \
  58.     ]
  59. set rowCol [VtRowColumn $mainForm.rowcol \
  60.     -topSide $lbl \
  61.     -numColumns 3 \
  62.     -vertical \
  63.     ]
  64. foreach item $pixList {
  65.     set itemName [lindex [split $item . ] 0 ]
  66.     VtLabel $rowCol.$itemName \
  67.         -pixmap $pixDir/$item  \
  68.         -shortHelpCallback SwitchPixMapCB 
  69. }
  70. set oopsLbl [VtLabel $mainForm.oops \
  71.     -topSide $rowCol \
  72.     -label "    " \
  73.     -xmArgs "background white" \
  74.     ]
  75. VtShow $mainForm
  76. VtMainLoop
  77.