PageRenderTime 55ms CodeModel.GetById 21ms RepoModel.GetById 1ms app.codeStats 0ms

/tags/rel-1-3-15/SWIG/Examples/GIFPlot/Tcl/mandel/mandel.tcl

#
TCL | 171 lines | 131 code | 33 blank | 7 comment | 17 complexity | f24db0e378b64ae79824a43ddbcd4567 MD5 | raw file
Possible License(s): LGPL-2.1, Cube, GPL-3.0, 0BSD, GPL-2.0
  1. catch { load ./gifplot.so }
  2. catch { load ./gifplot.dll } ; # Windows
  3. source display.tcl
  4. set tcl_precision 17
  5. set f [FrameBuffer -args 400 400]
  6. set cmap [ColorMap -args cmap]
  7. set p2 [Plot2D -args $f -3 -2 1 2]
  8. set xmin -3
  9. set xmax 1
  10. set ymin -2.0
  11. set ymax 2.0
  12. set tolerance 240
  13. set filename mandel.gif
  14. # Make a plot from the above parms
  15. proc make_plot {} {
  16. global p2 cmap tolerance
  17. global xmin ymin xmax ymax filename
  18. $p2 setrange $xmin $ymin $xmax $ymax
  19. $p2 start
  20. . config -cursor watch
  21. update
  22. mandel $p2 $tolerance
  23. . config -cursor arrow
  24. [$p2 cget -frame] writeGIF $cmap $filename
  25. display_image $filename $p2 set_zoom
  26. }
  27. # Take some screen coordinates and set global min and max values
  28. proc set_zoom {p2 mxmin mymin mxmax mymax x1 y1 x2 y2} {
  29. global xmin ymin xmax ymax
  30. set frame [$p2 cget -frame]
  31. set width [$frame cget -width]
  32. set height [$frame cget -height]
  33. if {$x1 < 0} {set x1 0}
  34. if {$x1 > ($width)} {set x1 $width}
  35. if {$x2 < 0} {set x2 0}
  36. if {$x2 > ($width)} {set x2 $width}
  37. if {$x1 < $x2} {set ixmin $x1; set ixmax $x2} {set ixmin $x2; set ixmax $x1}
  38. if {$y1 < 0} {set y1 0}
  39. if {$y1 > ($height)} {set y1 $height}
  40. if {$y2 < 0} {set y2 0}
  41. if {$y2 > ($height)} {set y2 $height}
  42. if {$y1 < $y2} {set iymin $y1; set iymax $y2} {set iymin $y2; set iymax $y1}
  43. # Now determine new min and max values based on screen location
  44. set xmin [expr {$mxmin + ($mxmax-$mxmin)*($ixmin)/($width)}]
  45. set xmax [expr {$mxmin + ($mxmax-$mxmin)*($ixmax)/($width)}]
  46. set ymin [expr {$mymin + ($mymax-$mymin)*(($height)-($iymax))/($height)}]
  47. set ymax [expr {$mymin + ($mymax-$mymin)*(($height)-($iymin))/($height)}]
  48. catch {make_plot}
  49. }
  50. # Box drag constrained to a square
  51. proc BoxDrag { w x y} {
  52. global box
  53. catch {$w delete $box(last)}
  54. set x1 [lrange $box(anchor) 0 0]
  55. set y1 [lrange $box(anchor) 1 1]
  56. set dx [expr {$x - $x1}]
  57. set dy [expr {$y - $y1}]
  58. if {abs($dy) > abs($dx)} {set dx $dy}
  59. set newx [expr {$x1 + $dx}]
  60. set newy [expr {$y1 + $dx}]
  61. set box(last) [eval {$w create rect} $box(anchor) {$newx $newy -tag box -outline white}]
  62. }
  63. proc BoxFinish {w x y p2 mxmin mymin mxmax mymax func } {
  64. global box
  65. set start $box(anchor)
  66. set x1 [lrange $box(anchor) 0 0]
  67. set y1 [lrange $box(anchor) 1 1]
  68. set dx [expr {$x - $x1}]
  69. set dy [expr {$y - $y1}]
  70. if {($dx == 0) || ($dy == 0)} {
  71. catch {$w delete $box(last)}
  72. return
  73. }
  74. if {abs($dy) > abs($dx)} {set dx $dy}
  75. set newx [expr {$x1 + $dx}]
  76. set newy [expr {$y1 + $dx}]
  77. $w config -cursor watch
  78. update
  79. # Call the handler function
  80. $func $p2 $mxmin $mymin $mxmax $mymax $x1 $y1 $newx $newy
  81. catch {$w delete $box(last)}
  82. $w config -cursor arrow
  83. }
  84. # Create a few frames
  85. wm title . Mandelbrot
  86. frame .title -relief groove -borderwidth 1
  87. label .title.name -text "Mandelbrot Set"
  88. button .title.quit -text "Quit" -command "exit"
  89. button .title.about -text "About" -command "about"
  90. pack .title.name -side left
  91. pack .title.quit .title.about -side right
  92. frame .func -relief groove -borderwidth 1
  93. frame .func.xrange
  94. label .func.xrange.xrlabel -text "X range" -width 12
  95. entry .func.xrange.xmin -textvar xmin -width 8
  96. label .func.xrange.xtolabel -text "to"
  97. entry .func.xrange.xmax -textvar xmax -width 8
  98. pack .func.xrange.xrlabel .func.xrange.xmin .func.xrange.xtolabel .func.xrange.xmax -side left
  99. frame .func.yrange
  100. label .func.yrange.yrlabel -text "Y range" -width 12
  101. entry .func.yrange.ymin -textvar ymin -width 8
  102. label .func.yrange.ytolabel -text "to"
  103. entry .func.yrange.ymax -textvar ymax -width 8
  104. pack .func.yrange.yrlabel .func.yrange.ymin .func.yrange.ytolabel .func.yrange.ymax -side left
  105. frame .func.npoints
  106. label .func.npoints.label -text "Tolerance " -width 12
  107. entry .func.npoints.npoints -textvar tolerance -width 8
  108. scale .func.npoints.scale -from 0 -to 2500 -variable tolerance -orient horizontal -showvalue false \
  109. -sliderlength 13 -bigincrement 10 -resolution 10
  110. pack .func.npoints.label .func.npoints.npoints .func.npoints.scale -side left
  111. pack .func.xrange .func.yrange .func.npoints -side top -fill x
  112. # Filename dialog
  113. frame .save -relief groove -borderwidth 1
  114. frame .save.file
  115. label .save.file.label -text "Save as" -width 12
  116. entry .save.file.filename -textvar filename -width 20
  117. pack .save.file.label .save.file.filename -side left
  118. pack .save.file -side left -fill x
  119. button .save.go -text "Plot" -command "make_plot"
  120. pack .save.go -side right
  121. bind .save.file.filename <Return> {make_plot}
  122. pack .title .func .save -side top -fill both
  123. proc about { } {
  124. toplevel .about -width 350
  125. message .about.m -text "\
  126. Mandelbrot Set\n\n\
  127. Copyright (c) 1997\n\
  128. Dave Beazley\n\
  129. University of Utah\n\n\
  130. Creates a plot of the Mandelbrot set. Any displayed image can be zoomed by clicking and \
  131. dragging. Although the main calculation is written in C, it may take awhile for each \
  132. image to be calculated (be patient). Image quality can be improved at the expense of speed \
  133. by increasing the tolerance value.\n"
  134. button .about.okay -text "Ok" -command {destroy .about}
  135. pack .about.m .about.okay -side top
  136. focus .about.okay
  137. }
  138. make_plot