PageRenderTime 43ms CodeModel.GetById 17ms RepoModel.GetById 0ms app.codeStats 0ms

/trunk/Examples/tcl/variables/runme.tcl

#
TCL | 76 lines | 59 code | 14 blank | 3 comment | 0 complexity | f39854b5a1bd24c62769480857ee6357 MD5 | raw file
Possible License(s): LGPL-2.1, Cube, GPL-3.0, 0BSD, GPL-2.0
  1. # file: runme.tcl
  2. catch { load ./example[info sharedlibextension] example}
  3. # Try to set the values of some global variables
  4. set ivar 42
  5. set svar -31000
  6. set lvar 65537
  7. set uivar 123456
  8. set usvar 61000
  9. set ulvar 654321
  10. set scvar -13
  11. set ucvar 251
  12. set cvar "S"
  13. set fvar 3.14159
  14. set dvar 2.1828
  15. set strvar "Hello World"
  16. set iptrvar [new_int 37]
  17. set ptptr [new_Point 37 42]
  18. set name "Bill"
  19. # Now print out the values of the variables
  20. puts "Variables (values printed from Tcl)"
  21. puts "ivar = $ivar"
  22. puts "svar = $svar"
  23. puts "lvar = $lvar"
  24. puts "uivar = $uivar"
  25. puts "usvar = $usvar"
  26. puts "ulvar = $ulvar"
  27. puts "scvar = $scvar"
  28. puts "ucvar = $ucvar"
  29. puts "fvar = $fvar"
  30. puts "dvar = $dvar"
  31. puts "cvar = $cvar"
  32. puts "strvar = $strvar"
  33. puts "cstrvar = $cstrvar"
  34. puts "iptrvar = $iptrvar"
  35. puts "name = $name"
  36. puts "ptptr = $ptptr [Point_print $ptptr]"
  37. puts "pt = $pt [Point_print $pt]"
  38. puts "\nVariables (values printed from C)"
  39. print_vars
  40. puts "\nNow I'm going to try and modify some read only variables";
  41. puts " Tring to set 'path'";
  42. if { [catch {
  43. set path "Whoa!"
  44. puts "Hey, what's going on?!?! This shouldn't work"
  45. }]} {
  46. puts "Good."
  47. }
  48. puts " Trying to set 'status'";
  49. if { [catch {
  50. set status 0
  51. puts "Hey, what's going on?!?! This shouldn't work"
  52. }]} {
  53. puts "Good."
  54. }
  55. puts "\nI'm going to try and update a structure variable.\n"
  56. set pt $ptptr
  57. puts "The new value is"
  58. pt_print
  59. puts "You should see the value [Point_print $ptptr]"