1############################################################################# 2# Author: # 3# ------ # 4# Anton Kokalj Email: Tone.Kokalj@ijs.si # 5# Department of Physical and Organic Chemistry Phone: x 386 1 477 3523 # 6# Jozef Stefan Institute Fax: x 386 1 477 3811 # 7# Jamova 39, SI-1000 Ljubljana # 8# SLOVENIA # 9# # 10# Source: $XCRYSDEN_TOPDIR/Tcl/FS_Main.tcl 11# ------ # 12# Copyright (c) 1996-2003 by Anton Kokalj # 13############################################################################# 14 15# 16# this proc is called withinh FS_Main. Its purpuse is the display of 17# all merged FS bands. 18# 19proc FS_Multi {nb {spin {}}} { 20 global fs xcMisc system 21 22 set i [expr [lindex $fs($spin,bandlist) end] + 1] 23 24 $nb insert $i multiband -text "Merged Bands" \ 25 -createcmd [list FS_RenderMultiSurface $fs($spin,bandlist) $spin] 26 27 # 28 # page container frame 29 # 30 set f [$nb getframe multiband] 31 set togl $f.togl$i 32 33 # 34 # toolbox frame 35 # 36 set ft [frame $f.container -relief raised -bd 1] 37 pack $ft -side top -expand 0 -fill x -padx 0m -pady 0m 38 FS_Toolbox $ft $togl $spin $i multiband 39 set fs($spin,$i,show_toolbox_frame) 1 40 set fs($spin,$i,toolbox_frame) $ft 41 set fs($spin,$i,toolbox_frame_pack) [pack info $ft] 42 set fs($spin,$i,toolbox_frame_packbefore) $togl 43 44 set fs($spin,$i,antialias) 0 45 set fs($spin,$i,depthcuing) 0 46 47 # 48 # Togl 49 # 50 global toglOpt 51 52 set fs($spin,$i,togl) [togl $togl \ 53 -ident $togl \ 54 -rgba $toglOpt(rgba) \ 55 -redsize $toglOpt(redsize) \ 56 -greensize $toglOpt(greensize) \ 57 -bluesize $toglOpt(bluesize) \ 58 -double $toglOpt(double) \ 59 -depth $toglOpt(depth) \ 60 -depthsize $toglOpt(depthsize) \ 61 -accum $toglOpt(accum) \ 62 -accumredsize $toglOpt(accumredsize) \ 63 -accumgreensize $toglOpt(accumgreensize) \ 64 -accumbluesize $toglOpt(accumbluesize) \ 65 -accumalphasize $toglOpt(accumalphasize) \ 66 -alpha $toglOpt(alpha) \ 67 -alphasize $toglOpt(alphasize) \ 68 -stencil $toglOpt(stencil) \ 69 -stencilsize $toglOpt(stencilsize) \ 70 -auxbuffers $toglOpt(auxbuffers) \ 71 -overlay $toglOpt(overlay) \ 72 -stereo $toglOpt(stereo) \ 73 -time $toglOpt(time) \ 74 -create togl_create \ 75 -display togl_display \ 76 -reshape togl_reshape \ 77 -destroy togl_destroy \ 78 -timer togl_timer ] 79 80 pack $togl -fill both -expand 1 81 82 # take care of togl's background 83 FS_UserBackground $togl 84 85 bind $fs($spin,$i,togl) <B1-Motion> { xc_B1motion %W %x %y } 86 bind $fs($spin,$i,togl) <B2-Motion> { xc_B2motion %W %x %y } 87 bind $fs($spin,$i,togl) <B1-ButtonRelease> { xc_Brelease %W B1; MouseZoomBrelease %W } 88 bind $fs($spin,$i,togl) <B2-ButtonRelease> { xc_Brelease %W B2 } 89 bind $fs($spin,$i,togl) <Button-3> [list FS_PopupMenu %W %X %Y $i $spin multiband] 90 bind $fs($spin,$i,togl) <Shift-B1-Motion> { MouseZoom %W %X %Y } 91 bind $fs($spin,$i,togl) <Shift-B1-ButtonRelease> { MouseZoomBrelease %W } 92 bind $fs($spin,$i,togl) <Button-4> { MouseWheelZoom %W +} 93 bind $fs($spin,$i,togl) <Button-5> { MouseWheelZoom %W -} 94 95 96 # ------------------------------------------------------------------------ 97 # DISPLAY-FUNCTION 98 # ------------------------------------------------------------------------ 99 cry_dispfuncmultiFS $fs($spin,$i,togl) -togllist $fs($spin,togllist) 100} 101 102 103proc FS_RenderMultiSurface {bandlist {spin {}}} { 104 global fs 105 106 foreach i $bandlist { 107 if { ! [info exist fs($spin,$i,rendered)] } { 108 set fs($spin,$i,rendered) 1 109 110 FS:cry_surf $i $spin 111 # next lines are a hack-around a "display-bug" to force the display 112 set w [lindex [$fs($spin,$i,togl) config -width] end] 113 $fs($spin,$i,togl) config -width $w 114 $fs($spin,$i,togl) render 115 $fs($spin,$i,togl) swapbuffers 116 update 117 } 118 } 119} 120