source: trunk/gui/scripts/heightmapviewer.tcl @ 1313

Last change on this file since 1313 was 1313, checked in by gah, 15 years ago

Add camera positioning
File size: 44.6 KB
Line 
1
2# ----------------------------------------------------------------------
3#  COMPONENT: heightmapviewer - 3D volume rendering
4#
5#  This widget performs volume rendering on 3D scalar/vector datasets.
6#  It connects to the Nanovis server running on a rendering farm,
7#  transmits data, and displays the results.
8# ======================================================================
9#  AUTHOR:  Michael McLennan, Purdue University
10#  Copyright (c) 2004-2005  Purdue Research Foundation
11#
12#  See the file "license.terms" for information on usage and
13#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
14# ======================================================================
15
16package require Itk
17package require BLT
18package require Img
19
20option add *HeightmapViewer.width 4i widgetDefault
21option add *HeightmapViewer.height 4i widgetDefault
22option add *HeightmapViewer.foreground black widgetDefault
23option add *HeightmapViewer.controlBackground gray widgetDefault
24option add *HeightmapViewer.controlDarkBackground #999999 widgetDefault
25option add *HeightmapViewer.plotBackground black widgetDefault
26option add *HeightmapViewer.plotForeground white widgetDefault
27option add *HeightmapViewer.plotOutline white widgetDefault
28option add *HeightmapViewer.font \
29    -*-helvetica-medium-r-normal-*-12-* widgetDefault
30
31# must use this name -- plugs into Rappture::resources::load
32proc HeightmapViewer_init_resources {} {
33    Rappture::resources::register \
34        nanovis_server Rappture::HeightmapViewer::SetServerList
35}
36
37itcl::class Rappture::HeightmapViewer {
38    inherit Rappture::VisViewer
39
40    itk_option define -plotforeground plotForeground Foreground ""
41    itk_option define -plotbackground plotBackground Background ""
42    itk_option define -plotoutline plotOutline PlotOutline ""
43
44    constructor { hostlist args } {
45        Rappture::VisViewer::constructor $hostlist
46    } {
47        # defined below
48    }
49    destructor {
50        # defined below
51    }
52
53    public proc SetServerList { namelist } {
54        Rappture::VisViewer::SetServerList "nanovis" $namelist
55    }
56    public method add {dataobj {settings ""}}
57    public method get {args}
58    public method delete {args}
59    public method scale {args}
60    public method download {option args}
61    public method parameters {title args} {
62        # do nothing
63    }
64    public method drawer {what who}
65    public method camera {option args}
66    protected method Connect {}
67    protected method Disconnect {}
68
69    protected method _send {string}
70    protected method _send_dataobjs {}
71    protected method ReceiveImage {option size}
72    private method _ReceiveLegend {tf vmin vmax size}
73    private method _BuildSettingsDrawer {}
74    private method _BuildCameraDrawer {}
75    private method _PanCamera {}
76    protected method _receive_echo {channel {data ""}}
77
78    protected method _rebuild {}
79    protected method _zoom {option}
80    protected method _pan {option x y}
81    protected method _rotate {option x y}
82
83    protected method _state {comp}
84    protected method _fixSettings {what {value ""}}
85    protected method _getTransfuncData {dataobj comp}
86
87
88    private variable outbuf_       ;# buffer for outgoing commands
89
90    private variable dlist_ ""     ;# list of data objects
91    private variable obj2style_    ;# maps dataobj => style settings
92    private variable obj2ovride_   ;# maps dataobj => style override
93    private variable obj2id_       ;# maps dataobj => heightmap ID in server
94    private variable id2obj_       ;# maps heightmap ID => dataobj in server
95    private variable sendobjs_ ""  ;# list of data objs to send to server
96    private variable receiveIds_   ;# list of data responses from the server
97    private variable click_        ;# info used for _rotate operations
98    private variable limits_       ;# autoscale min/max for all axes
99    private variable view_         ;# view params for 3D view
100    private common settings_      ;# Array used for checkbuttons and radiobuttons
101    private variable initialized_
102}
103
104itk::usual HeightmapViewer {
105    keep -background -foreground -cursor -font
106    keep -plotbackground -plotforeground
107}
108
109# ----------------------------------------------------------------------
110# CONSTRUCTOR
111# ----------------------------------------------------------------------
112itcl::body Rappture::HeightmapViewer::constructor {hostlist args} {
113    # Draw legend event
114    $_dispatcher register !legend
115    $_dispatcher dispatch $this !legend \
116        "[itcl::code $this _fixSettings legend]; list"
117    # Send dataobjs event
118    $_dispatcher register !send_dataobjs
119    $_dispatcher dispatch $this !send_dataobjs \
120        "[itcl::code $this _send_dataobjs]; list"
121    # Rebuild event
122    $_dispatcher register !rebuild
123    $_dispatcher dispatch $this !rebuild "[itcl::code $this _rebuild]; list"
124
125    set outbuf_ ""
126
127    #
128    # Populate parser with commands handle incoming requests
129    #
130    $_parser alias image [itcl::code $this ReceiveImage]
131    $_parser alias legend [itcl::code $this _ReceiveLegend]
132
133    # Initialize the view to some default parameters.
134    array set view_ {
135        theta   45
136        phi     45
137        psi     0
138        zoom    1.0
139        pan-x   0
140        pan-y   0
141    }
142    set obj2id_(count) 0
143
144    itk_component add zoom {
145        frame $itk_component(controls).zoom
146    } {
147        usual
148        rename -background -controlbackground controlBackground Background
149    }
150    pack $itk_component(zoom) -side top
151
152    itk_component add reset {
153        button $itk_component(zoom).reset \
154            -borderwidth 1 -padx 1 -pady 1 \
155            -image [Rappture::icon reset-view] \
156            -command [itcl::code $this _zoom reset]
157    } {
158        usual
159        ignore -borderwidth
160        rename -highlightbackground -controlbackground controlBackground Background
161    }
162    pack $itk_component(reset) -side top -padx 2 -pady { 2 0 }
163    Rappture::Tooltip::for $itk_component(reset) "Reset the view to the default zoom level"
164
165    itk_component add zoomin {
166        button $itk_component(zoom).zin \
167            -borderwidth 1 -padx 1 -pady 1 \
168            -image [Rappture::icon zoom-in] \
169            -command [itcl::code $this _zoom in]
170    } {
171        usual
172        ignore -borderwidth
173        rename -highlightbackground -controlbackground controlBackground Background
174    }
175    pack $itk_component(zoomin) -side top -padx 2 -pady { 2 0 }
176    Rappture::Tooltip::for $itk_component(zoomin) "Zoom in"
177
178    itk_component add zoomout {
179        button $itk_component(zoom).zout \
180            -borderwidth 1 -padx 1 -pady 1 \
181            -image [Rappture::icon zoom-out] \
182            -command [itcl::code $this _zoom out]
183    } {
184        usual
185        ignore -borderwidth
186        rename -highlightbackground -controlbackground controlBackground Background
187    }
188    pack $itk_component(zoomout) -side top -padx 2 -pady { 2 0 }
189    Rappture::Tooltip::for $itk_component(zoomout) "Zoom out"
190
191    itk_component add settings_button {
192        label $itk_component(controls).settingsbutton \
193            -borderwidth 1 -padx 1 -pady 1 \
194            -relief "raised" -image [Rappture::icon wrench]
195    } {
196        usual
197        ignore -borderwidth
198        rename -highlightbackground -controlbackground controlBackground \
199            Background
200    }
201    pack $itk_component(settings_button) -padx 2 -pady { 0 2 } \
202        -ipadx 1 -ipady 1
203    Rappture::Tooltip::for $itk_component(settings_button) \
204        "Configure settings"
205    bind $itk_component(settings_button) <ButtonPress> \
206        [itcl::code $this drawer toggle settings]
207    pack $itk_component(settings_button) -side bottom \
208        -padx 2 -pady 2 -anchor e
209
210    itk_component add camera_button {
211        label $itk_component(controls).camerabutton \
212            -borderwidth 1 -padx 1 -pady 1 \
213            -relief "raised" -image [Rappture::icon camera]
214    } {
215        usual
216        ignore -borderwidth
217        rename -highlightbackground -controlbackground controlBackground \
218            Background
219    }
220    Rappture::Tooltip::for $itk_component(camera_button) \
221        "Camera settings"
222    bind $itk_component(camera_button) <ButtonPress> \
223        [itcl::code $this drawer toggle camera]
224    pack $itk_component(camera_button) -side bottom \
225        -padx 2 -pady { 0 2 } -ipadx 1 -ipady 1
226
227    _BuildSettingsDrawer
228    _BuildCameraDrawer
229
230    # Legend
231    set _image(legend) [image create photo]
232    itk_component add legend {
233        canvas $itk_component(area).legend -width 30 -highlightthickness 0
234    } {
235        usual
236        ignore -highlightthickness
237        rename -background -plotbackground plotBackground Background
238    }
239    pack $itk_component(legend) -side right -fill y
240    pack $itk_component(3dview) -side left -expand yes -fill both
241    bind $itk_component(legend) <Configure> \
242        [list $_dispatcher event -idle !legend]
243
244    # Bindings for rotation via mouse
245    bind $itk_component(3dview) <ButtonPress-1> \
246        [itcl::code $this _rotate click %x %y]
247    bind $itk_component(3dview) <B1-Motion> \
248        [itcl::code $this _rotate drag %x %y]
249    bind $itk_component(3dview) <ButtonRelease-1> \
250        [itcl::code $this _rotate release %x %y]
251    bind $itk_component(3dview) <Configure> \
252        [itcl::code $this _send "screen %w %h"]
253
254    # Bindings for panning via mouse
255    bind $itk_component(3dview) <ButtonPress-2> \
256        [itcl::code $this _pan click %x %y]
257    bind $itk_component(3dview) <B2-Motion> \
258        [itcl::code $this _pan drag %x %y]
259    bind $itk_component(3dview) <ButtonRelease-2> \
260        [itcl::code $this _pan release %x %y]
261
262    # Bindings for panning via keyboard
263    bind $itk_component(3dview) <KeyPress-Left> \
264        [itcl::code $this _pan set -10 0]
265    bind $itk_component(3dview) <KeyPress-Right> \
266        [itcl::code $this _pan set 10 0]
267    bind $itk_component(3dview) <KeyPress-Up> \
268        [itcl::code $this _pan set 0 -10]
269    bind $itk_component(3dview) <KeyPress-Down> \
270        [itcl::code $this _pan set 0 10]
271    bind $itk_component(3dview) <Shift-KeyPress-Left> \
272        [itcl::code $this _pan set -2 0]
273    bind $itk_component(3dview) <Shift-KeyPress-Right> \
274        [itcl::code $this _pan set 2 0]
275    bind $itk_component(3dview) <Shift-KeyPress-Up> \
276        [itcl::code $this _pan set 0 -2]
277    bind $itk_component(3dview) <Shift-KeyPress-Down> \
278        [itcl::code $this _pan set 0 2]
279
280    # Bindings for zoom via keyboard
281    bind $itk_component(3dview) <KeyPress-Prior> \
282        [itcl::code $this _zoom out]
283    bind $itk_component(3dview) <KeyPress-Next> \
284        [itcl::code $this _zoom in]
285
286    bind $itk_component(3dview) <Enter> "focus $itk_component(3dview)"
287
288    if {[string equal "x11" [tk windowingsystem]]} {
289        # Bindings for zoom via mouse
290        bind $itk_component(3dview) <4> [itcl::code $this _zoom out]
291        bind $itk_component(3dview) <5> [itcl::code $this _zoom in]
292    }
293
294    set _image(download) [image create photo]
295
296    eval itk_initialize $args
297
298    Connect
299}
300
301# ----------------------------------------------------------------------
302# DESTRUCTOR
303# ----------------------------------------------------------------------
304itcl::body Rappture::HeightmapViewer::destructor {} {
305    set sendobjs_ ""  ;# stop any send in progress
306    $_dispatcher cancel !rebuild
307    $_dispatcher cancel !send_dataobjs
308    image delete $_image(plot)
309    image delete $_image(legend)
310    image delete $_image(download)
311}
312
313# ----------------------------------------------------------------------
314# USAGE: add <dataobj> ?<settings>?
315#
316# Clients use this to add a data object to the plot.  The optional
317# <settings> are used to configure the plot.  Allowed settings are
318# -color, -brightness, -width, -linestyle, and -raise.
319# ----------------------------------------------------------------------
320itcl::body Rappture::HeightmapViewer::add {dataobj {settings ""}} {
321    array set params {
322        -color auto
323        -width 1
324        -linestyle solid
325        -brightness 0
326        -raise 0
327        -description ""
328        -param ""
329    }
330    foreach {opt val} $settings {
331        if {![info exists params($opt)]} {
332            error "bad setting \"$opt\": should be [join [lsort [array names params]] {, }]"
333        }
334        set params($opt) $val
335    }
336    if {$params(-color) == "auto" || $params(-color) == "autoreset"} {
337        # can't handle -autocolors yet
338        set params(-color) black
339    }
340    set location [$dataobj hints camera]
341    if { $location != "" } {
342        array set view_ $location
343    }
344    set pos [lsearch -exact $dataobj $dlist_]
345    if {$pos < 0} {
346        lappend dlist_ $dataobj
347        set obj2ovride_($dataobj-color) $params(-color)
348        set obj2ovride_($dataobj-width) $params(-width)
349        set obj2ovride_($dataobj-raise) $params(-raise)
350        $_dispatcher event -idle !rebuild
351    }
352}
353
354# ----------------------------------------------------------------------
355# USAGE: get ?-objects?
356# USAGE: get ?-image 3dview|legend?
357#
358# Clients use this to query the list of objects being plotted, in
359# order from bottom to top of this result.  The optional "-image"
360# flag can also request the internal images being shown.
361# ----------------------------------------------------------------------
362itcl::body Rappture::HeightmapViewer::get {args} {
363    if {[llength $args] == 0} {
364        set args "-objects"
365    }
366
367    set op [lindex $args 0]
368    switch -- $op {
369      -objects {
370        # put the dataobj list in order according to -raise options
371        set dlist $dlist_
372        foreach obj $dlist {
373            if { [info exists obj2ovride_($obj-raise)] &&
374                 $obj2ovride_($obj-raise)} {
375                set i [lsearch -exact $dlist $obj]
376                if {$i >= 0} {
377                    set dlist [lreplace $dlist $i $i]
378                    lappend dlist $obj
379                }
380            }
381        }
382        return $dlist
383      }
384      -image {
385        if {[llength $args] != 2} {
386            error "wrong # args: should be \"get -image 3dview|legend\""
387        }
388        switch -- [lindex $args end] {
389            3dview {
390                return $_image(plot)
391            }
392            legend {
393                return $_image(legend)
394            }
395            default {
396                error "bad image name \"[lindex $args end]\": should be 3dview or legend"
397            }
398        }
399      }
400      default {
401        error "bad option \"$op\": should be -objects or -image"
402      }
403    }
404}
405
406# ----------------------------------------------------------------------
407# USAGE: delete ?<dataobj1> <dataobj2> ...?
408#
409# Clients use this to delete a dataobj from the plot.  If no dataobjs
410# are specified, then all dataobjs are deleted.
411# ----------------------------------------------------------------------
412itcl::body Rappture::HeightmapViewer::delete {args} {
413    if {[llength $args] == 0} {
414        set args $dlist_
415    }
416
417    # delete all specified dataobjs
418    set changed 0
419    foreach dataobj $args {
420        set pos [lsearch -exact $dlist_ $dataobj]
421        if {$pos >= 0} {
422            set dlist_ [lreplace $dlist_ $pos $pos]
423            foreach key [array names obj2ovride_ $dataobj-*] {
424                unset obj2ovride_($key)
425            }
426            set changed 1
427        }
428    }
429
430    # if anything changed, then rebuild the plot
431    if {$changed} {
432        $_dispatcher event -idle !rebuild
433    }
434}
435
436# ----------------------------------------------------------------------
437# USAGE: scale ?<data1> <data2> ...?
438#
439# Sets the default limits for the overall plot according to the
440# limits of the data for all of the given <data> objects.  This
441# accounts for all objects--even those not showing on the screen.
442# Because of this, the limits are appropriate for all objects as
443# the user scans through data in the ResultSet viewer.
444# ----------------------------------------------------------------------
445itcl::body Rappture::HeightmapViewer::scale {args} {
446    foreach val {xmin xmax ymin ymax zmin zmax vmin vmax} {
447        set limits_($val) ""
448    }
449    foreach obj $args {
450        foreach axis {x y z v} {
451            foreach {min max} [$obj limits $axis] break
452            if {"" != $min && "" != $max} {
453                if {"" == $limits_(${axis}min)} {
454                    set limits_(${axis}min) $min
455                    set limits_(${axis}max) $max
456                } else {
457                    if {$min < $limits_(${axis}min)} {
458                        set limits_(${axis}min) $min
459                    }
460                    if {$max > $limits_(${axis}max)} {
461                        set limits_(${axis}max) $max
462                    }
463                }
464                set limits_(${axis}range) [expr {$max - $min}]
465            }
466        }
467    }
468}
469
470# ----------------------------------------------------------------------
471# USAGE: download coming
472# USAGE: download controls <downloadCommand>
473# USAGE: download now
474#
475# Clients use this method to create a downloadable representation
476# of the plot.  Returns a list of the form {ext string}, where
477# "ext" is the file extension (indicating the type of data) and
478# "string" is the data itself.
479# ----------------------------------------------------------------------
480itcl::body Rappture::HeightmapViewer::download {option args} {
481    switch $option {
482        coming {
483            if {[catch {
484                blt::winop snap $itk_component(area) $_image(download)
485            }]} {
486                $_image(download) configure -width 1 -height 1
487                $_image(download) put #000000
488            }
489        }
490        controls {
491            # no controls for this download yet
492            return ""
493        }
494        now {
495            #
496            # Hack alert!  Need data in binary format,
497            # so we'll save to a file and read it back.
498            #
499            set tmpfile /tmp/image[pid].jpg
500            $_image(download) write $tmpfile -format jpeg
501            set fid [open $tmpfile r]
502            fconfigure $fid -encoding binary -translation binary
503            set bytes [read $fid]
504            close $fid
505            file delete -force $tmpfile
506
507            return [list .jpg $bytes]
508        }
509        default {
510            error "bad option \"$option\": should be coming, controls, now"
511        }
512    }
513}
514
515# ----------------------------------------------------------------------
516# USAGE: Connect ?<host:port>,<host:port>...?
517#
518# Clients use this method to establish a connection to a new
519# server, or to reestablish a connection to the previous server.
520# Any existing connection is automatically closed.
521# ----------------------------------------------------------------------
522itcl::body Rappture::HeightmapViewer::Connect {} {
523    Disconnect
524    set _hosts [GetServerList "nanovis"]
525    if { "" == $_hosts } {
526        return 0
527    }
528    set result [VisViewer::Connect $_hosts]
529    return $result
530}
531
532# ----------------------------------------------------------------------
533# USAGE: Disconnect
534#
535# Clients use this method to disconnect from the current rendering
536# server.
537# ----------------------------------------------------------------------
538itcl::body Rappture::HeightmapViewer::Disconnect {} {
539    VisViewer::Disconnect
540
541    set outbuf_ ""
542    # disconnected -- no more data sitting on server
543    catch {unset obj2id_}
544    array unset id2obj_
545    set obj2id_(count) 0
546    set id2obj_(cound) 0
547    set sendobjs_ ""
548}
549
550#
551# _send
552#
553#       Send commands off to the rendering server.  If we're currently
554#       sending data objects to the server, buffer the commands to be
555#       sent later.
556#
557itcl::body Rappture::HeightmapViewer::_send {string} {
558    if {[llength $sendobjs_] > 0} {
559        append outbuf_ $string "\n"
560    } else {
561        if {[SendBytes $string]} {
562            foreach line [split $string \n] {
563                SendEcho >>line $line
564            }
565        }
566    }
567}
568
569# ----------------------------------------------------------------------
570# USAGE: _send_dataobjs
571#
572# Used internally to send a series of volume objects off to the
573# server.  Sends each object, a little at a time, with updates in
574# between so the interface doesn't lock up.
575# ----------------------------------------------------------------------
576itcl::body Rappture::HeightmapViewer::_send_dataobjs {} {
577    blt::busy hold $itk_component(hull); update idletasks
578
579    # Reset the overall limits
580    if { $sendobjs_ != "" } {
581        set limits_(vmin) ""
582        set limits_(vmax) ""
583    }
584    foreach dataobj $sendobjs_ {
585        foreach comp [$dataobj components] {
586            set data [$dataobj blob $comp]
587
588            foreach { vmin vmax }  [$dataobj limits v] break
589            if { $limits_(vmin) == "" || $vmin < $limits_(vmin) } {
590                set limits_(vmin) $vmin
591            }
592            if { $limits_(vmax) == "" || $vmax > $limits_(vmax) } {
593                set limits_(vmax) $vmax
594            }
595
596            # tell the engine to expect some data
597            set nbytes [string length $data]
598            if { ![SendBytes "heightmap data follows $nbytes"] } {
599                return
600
601            }
602            if { ![SendBytes $data] } {
603                return
604            }
605            set id $obj2id_(count)
606            incr obj2id_(count)
607            set id2obj_($id) [list $dataobj $comp]
608            set obj2id_($dataobj-$comp) $id
609            set receiveIds_($id) 1
610
611            #
612            # Determine the transfer function needed for this volume
613            # and make sure that it's defined on the server.
614            #
615            foreach {sname cmap wmap} [_getTransfuncData $dataobj $comp] break
616            set cmdstr [list "transfunc" "define" $sname $cmap $wmap]
617            if {![SendBytes $cmdstr]} {
618                return
619            }
620            set obj2style_($dataobj-$comp) $sname
621        }
622    }
623    set sendobjs_ ""
624    blt::busy release $itk_component(hull)
625
626    # activate the proper volume
627    set first [lindex [get] 0]
628    if {"" != $first} {
629        set axis [$first hints updir]
630        if {"" != $axis} {
631            _send "up $axis"
632        }
633    }
634
635    foreach key [array names obj2id_ *-*] {
636        set state [string match $first-* $key]
637        _send "heightmap data visible $state $obj2id_($key)"
638        if {[info exists obj2style_($key)]} {
639            _send "heightmap transfunc $obj2style_($key) $obj2id_($key)"
640        }
641    }
642
643    # if there are any commands in the buffer, send them now that we're done
644    SendBytes $outbuf_
645    set outbuf_ ""
646
647    $_dispatcher event -idle !legend
648}
649
650# ----------------------------------------------------------------------
651# USAGE: ReceiveImage -bytes <size>
652#
653# Invoked automatically whenever the "image" command comes in from
654# the rendering server.  Indicates that binary image data with the
655# specified <size> will follow.
656# ----------------------------------------------------------------------
657itcl::body Rappture::HeightmapViewer::ReceiveImage {option size} {
658    if {[IsConnected]} {
659        set bytes [ReceiveBytes $size]
660        $_image(plot) configure -data $bytes
661        ReceiveEcho <<line "<read $size bytes for [image width $_image(plot)]x[image height $_image(plot)] image>"
662    }
663}
664
665# ----------------------------------------------------------------------
666# USAGE: _ReceiveLegend <tf> <vmin> <vmax> <size>
667#
668# Invoked automatically whenever the "legend" command comes in from
669# the rendering server.  Indicates that binary image data with the
670# specified <size> will follow.
671# ----------------------------------------------------------------------
672itcl::body Rappture::HeightmapViewer::_ReceiveLegend {tf vmin vmax size} {
673    if { [IsConnected] } {
674        set bytes [ReceiveBytes $size]
675        ReceiveEcho <<line "<read $size bytes for [image width $_image(legend)]x[image height $_image(legend)] legend>"
676        if 1 {
677        set src [image create photo -data $bytes]
678        blt::winop image rotate $src $_image(legend) 90
679        set dst $_image(legend)
680        } else {
681        $_image(legend) configure -data $bytes
682        }
683        set c $itk_component(legend)
684        set w [winfo width $c]
685        set h [winfo height $c]
686        set lineht [expr [font metrics $itk_option(-font) -linespace] + 4]
687        if {"" == [$c find withtag transfunc]} {
688            $c create image 0 [expr $lineht] -anchor ne \
689                 -image $_image(legend) -tags transfunc
690            $c create text 10 [expr {$h-8}] -anchor se \
691                 -fill $itk_option(-plotforeground) -tags vmin
692            $c create text [expr {$w-10}] [expr {$h-8}] -anchor ne \
693                 -fill $itk_option(-plotforeground) -tags vmax
694        }
695        $c coords transfunc [expr $w - 5] [expr $lineht]
696        $c itemconfigure vmin -text $vmin
697        $c itemconfigure vmax -text $vmax
698        $c coords vmax [expr $w - 5] 2
699        $c coords vmin [expr $w - 5] [expr $h - 2]
700    }
701}
702
703# ----------------------------------------------------------------------
704# USAGE: _rebuild
705#
706# Called automatically whenever something changes that affects the
707# data in the widget.  Clears any existing data and rebuilds the
708# widget to display new data.
709# ----------------------------------------------------------------------
710itcl::body Rappture::HeightmapViewer::_rebuild {} {
711    # in the midst of sending data? then bail out
712    if {[llength $sendobjs_] > 0} {
713        return
714    }
715    # Find any new data that needs to be sent to the server.  Queue this up on
716    # the sendobjs_ list, and send it out a little at a time.  Do this first,
717    # before we rebuild the rest.
718    foreach dataobj [get] {
719        set comp [lindex [$dataobj components] 0]
720        if {![info exists obj2id_($dataobj-$comp)]} {
721            set i [lsearch -exact $sendobjs_ $dataobj]
722            if {$i < 0} {
723                lappend sendobjs_ $dataobj
724            }
725        }
726    }
727    if {[llength $sendobjs_] > 0} {
728        # Send off new data objects
729        $_dispatcher event -idle !send_dataobjs
730    } else {
731        # Nothing to send -- activate the proper volume
732        set first [lindex [get] 0]
733        if {"" != $first} {
734            set axis [$first hints updir]
735            if {"" != $axis} {
736                _send "up $axis"
737            }
738        }
739        foreach key [array names obj2id_ *-*] {
740            set state [string match $first-* $key]
741            _send "heightmap data visible $state $obj2id_($key)"
742            if {[info exists obj2style_($key)]} {
743                _send "heightmap transfunc $obj2style_($key) $obj2id_($key)"
744            }
745        }
746        $_dispatcher event -idle !legend
747    }
748
749    # Reset the screen size. 
750    set w [winfo width $itk_component(3dview)]
751    set h [winfo height $itk_component(3dview)]
752    _send "screen $w $h"
753
754    # Reset the camera and other view parameters
755    set xyz [Euler2XYZ $view_(theta) $view_(phi) $view_(psi)]
756    _send "camera angle $xyz"
757    _PanCamera
758    _send "camera zoom $view_(zoom)"
759
760     if {"" == $itk_option(-plotoutline)} {
761         _send "grid linecolor [Color2RGB $itk_option(-plotoutline)]"
762     }
763    set settings_($this-theta) $view_(theta)
764    set settings_($this-phi) $view_(phi)
765    set settings_($this-psi) $view_(psi)
766    set settings_($this-pan-x) $view_(pan-x)
767    set settings_($this-pan-y) $view_(pan-y)
768    set settings_($this-zoom) $view_(zoom)
769
770    _fixSettings wireframe
771    _fixSettings grid
772    _fixSettings axes
773    _fixSettings contourlines
774}
775
776# ----------------------------------------------------------------------
777# USAGE: _zoom in
778# USAGE: _zoom out
779# USAGE: _zoom reset
780#
781# Called automatically when the user clicks on one of the zoom
782# controls for this widget.  Changes the zoom for the current view.
783# ----------------------------------------------------------------------
784itcl::body Rappture::HeightmapViewer::_zoom {option} {
785    switch -- $option {
786        "in" {
787            set view_(zoom) [expr {$view_(zoom)*1.25}]
788            set settings_($this-zoom) $view_(zoom)
789        }
790        "out" {
791            set view_(zoom) [expr {$view_(zoom)*0.8}]
792            set settings_($this-zoom) $view_(zoom)
793        }
794        "reset" {
795            array set view_ {
796                theta   45
797                phi     45
798                psi     0
799                zoom    1.0
800                pan-x   0
801                pan-y   0
802            }
803            set first [lindex [get] 0]
804            if { $first != "" } {
805                set location [$first hints camera]
806                if { $location != "" } {
807                    array set view_ $location
808                }
809            }
810            set xyz [Euler2XYZ $view_(theta) $view_(phi) $view_(psi)]
811            _send "camera angle $xyz"
812            _PanCamera
813            set settings_($this-theta) $view_(theta)
814            set settings_($this-phi) $view_(phi)
815            set settings_($this-psi) $view_(psi)
816            set settings_($this-pan-x) $view_(pan-x)
817            set settings_($this-pan-y) $view_(pan-y)
818            set settings_($this-zoom) $view_(zoom)
819        }
820    }
821    _send "camera zoom $view_(zoom)"
822}
823
824# ----------------------------------------------------------------------
825# USAGE: $this _pan click x y
826#        $this _pan drag x y
827#        $this _pan release x y
828#
829# Called automatically when the user clicks on one of the zoom
830# controls for this widget.  Changes the zoom for the current view.
831# ----------------------------------------------------------------------
832itcl::body Rappture::HeightmapViewer::_pan {option x y} {
833    # Experimental stuff
834    set w [winfo width $itk_component(3dview)]
835    set h [winfo height $itk_component(3dview)]
836    if { $option == "set" } {
837        set x [expr ($x / double($w)) * $limits_(xrange)]
838        set y [expr ($y / double($h)) * $limits_(yrange)]
839        set view_(pan-x) [expr $view_(pan-x) + $x]
840        set view_(pan-y) [expr $view_(pan-y) + $y]
841        _PanCamera
842        set settings_($this-pan-x) $view_(pan-x)
843        set settings_($this-pan-y) $view_(pan-y)
844        return
845    }
846    if { $option == "click" } {
847        set click_(x) $x
848        set click_(y) $y
849        $itk_component(3dview) configure -cursor hand1
850    }
851    if { $option == "drag" || $option == "release" } {
852        set dx [expr (($click_(x) - $x)/double($w)) * $limits_(xrange)]
853        set dy [expr (($click_(y) - $y)/double($h)) * $limits_(yrange)]
854        set click_(x) $x
855        set click_(y) $y
856        set view_(pan-x) [expr $view_(pan-x) - $dx]
857        set view_(pan-y) [expr $view_(pan-y) - $dy]
858        _PanCamera
859        set settings_($this-pan-x) $view_(pan-x)
860        set settings_($this-pan-y) $view_(pan-y)
861    }
862    if { $option == "release" } {
863        $itk_component(3dview) configure -cursor ""
864    }
865}
866
867itcl::body Rappture::HeightmapViewer::_PanCamera {} {
868    set x [expr ($view_(pan-x)) / $limits_(xrange)]
869    set y [expr ($view_(pan-y)) / $limits_(yrange)]
870    _send "camera pan $x $y"
871}
872
873# ----------------------------------------------------------------------
874# USAGE: _rotate click <x> <y>
875# USAGE: _rotate drag <x> <y>
876# USAGE: _rotate release <x> <y>
877#
878# Called automatically when the user clicks/drags/releases in the
879# plot area.  Moves the plot according to the user's actions.
880# ----------------------------------------------------------------------
881itcl::body Rappture::HeightmapViewer::_rotate {option x y} {
882    switch -- $option {
883        click {
884            $itk_component(3dview) configure -cursor fleur
885            array set click_ [subst {
886                x       $x
887                y       $y
888                theta   $view_(theta)
889                phi     $view_(phi)
890            }]
891        }
892        drag {
893            if {[array size click_] == 0} {
894                _rotate click $x $y
895            } else {
896                set w [winfo width $itk_component(3dview)]
897                set h [winfo height $itk_component(3dview)]
898                if {$w <= 0 || $h <= 0} {
899                    return
900                }
901
902                if {[catch {
903                    # this fails sometimes for no apparent reason
904                    set dx [expr {double($x-$click_(x))/$w}]
905                    set dy [expr {double($y-$click_(y))/$h}]
906                }] != 0 } {
907                    return
908                }
909
910                #
911                # Rotate the camera in 3D
912                #
913                if {$view_(psi) > 90 || $view_(psi) < -90} {
914                    # when psi is flipped around, theta moves backwards
915                    set dy [expr {-$dy}]
916                }
917                set theta [expr {$view_(theta) - $dy*180}]
918                while {$theta < 0} { set theta [expr {$theta+180}] }
919                while {$theta > 180} { set theta [expr {$theta-180}] }
920
921                if {abs($theta) >= 30 && abs($theta) <= 160} {
922                    set phi [expr {$view_(phi) - $dx*360}]
923                    while {$phi < 0} { set phi [expr {$phi+360}] }
924                    while {$phi > 360} { set phi [expr {$phi-360}] }
925                    set psi $view_(psi)
926                } else {
927                    set phi $view_(phi)
928                    set psi [expr {$view_(psi) - $dx*360}]
929                    while {$psi < -180} { set psi [expr {$psi+360}] }
930                    while {$psi > 180} { set psi [expr {$psi-360}] }
931                }
932
933                set view_(theta)        $theta
934                set view_(phi)          $phi
935                set view_(psi)          $psi
936                set xyz [Euler2XYZ $view_(theta) $view_(phi) $view_(psi)]
937                set settings_($this-theta) $view_(theta)
938                set settings_($this-phi) $view_(phi)
939                set settings_($this-psi) $view_(psi)
940                _send "camera angle $xyz"
941                set click_(x) $x
942                set click_(y) $y
943            }
944        }
945        release {
946            _rotate drag $x $y
947            $itk_component(3dview) configure -cursor ""
948            catch {unset click_}
949        }
950        default {
951            error "bad option \"$option\": should be click, drag, release"
952        }
953    }
954}
955
956# ----------------------------------------------------------------------
957# USAGE: _state <component>
958#
959# Used internally to determine the state of a toggle button.
960# The <component> is the itk component name of the button.
961# Returns on/off for the state of the button.
962# ----------------------------------------------------------------------
963itcl::body Rappture::HeightmapViewer::_state {comp} {
964    if {[$itk_component($comp) cget -relief] == "sunken"} {
965        return "on"
966    }
967    return "off"
968}
969
970# ----------------------------------------------------------------------
971# USAGE: _fixSettings <what> ?<value>?
972#
973# Used internally to update rendering settings whenever parameters
974# change in the popup settings panel.  Sends the new settings off
975# to the back end.
976# ----------------------------------------------------------------------
977itcl::body Rappture::HeightmapViewer::_fixSettings { what {value ""} } {
978    switch -- $what {
979        "legend" {
980            if { $settings_($this-legend) } {
981                pack $itk_component(legend) -side right -fill y
982            } else {
983                pack forget $itk_component(legend)
984            }
985            set lineht [expr [font metrics $itk_option(-font) -linespace] + 4]
986            set w [expr {[winfo height $itk_component(legend)] - 2*$lineht}]
987            set h [expr {[winfo width $itk_component(legend)] - 16}]
988            set imap ""
989            set dataobj [lindex [get] 0]
990            if {"" != $dataobj} {
991                set comp [lindex [$dataobj components] 0]
992                if {[info exists obj2id_($dataobj-$comp)]} {
993                    set imap $obj2id_($dataobj-$comp)
994                }
995            }
996            if {$w > 0 && $h > 0 && "" != $imap} {
997                _send "heightmap legend $imap $w $h"
998            } else {
999                $itk_component(legend) delete all
1000            }
1001        }
1002        "grid" {
1003            if { [IsConnected] } {
1004                _send "grid visible $settings_($this-grid)"
1005            }
1006        }
1007        "axes" {
1008            if { [IsConnected] } {
1009                _send "axis visible $settings_($this-axes)"
1010            }
1011        }
1012        "wireframe" {
1013            if { [IsConnected] } {
1014                _send "heightmap polygon $settings_($this-wireframe)"
1015            }
1016        }
1017        "contourlines" {
1018            if {[IsConnected]} {
1019                set dataobj [lindex [get] 0]
1020                if {"" != $dataobj} {
1021                    set comp [lindex [$dataobj components] 0]
1022                    if {[info exists obj2id_($dataobj-$comp)]} {
1023                        set i $obj2id_($dataobj-$comp)
1024                        set bool $settings_($this-contourlines)
1025                        _send "heightmap linecontour visible $bool $i"
1026                    }
1027                }
1028            }
1029        }
1030        default {
1031            error "don't know how to fix $what: should be grid, axes, contourlines, or legend"
1032        }
1033    }
1034}
1035
1036# ----------------------------------------------------------------------
1037# USAGE: _getTransfuncData <dataobj> <comp>
1038#
1039# Used internally to compute the colormap and alpha map used to define
1040# a transfer function for the specified component in a data object.
1041# Returns: name {v r g b ...} {v w ...}
1042# ----------------------------------------------------------------------
1043itcl::body Rappture::HeightmapViewer::_getTransfuncData {dataobj comp} {
1044    array set style {
1045        -color rainbow
1046        -levels 6
1047        -opacity 0.5
1048    }
1049    array set style [lindex [$dataobj components -style $comp] 0]
1050    set sname "$style(-color):$style(-levels):$style(-opacity)"
1051
1052    if {$style(-color) == "rainbow"} {
1053        set style(-color) "white:yellow:green:cyan:blue:magenta"
1054    }
1055    set clist [split $style(-color) :]
1056    set color white
1057    set cmap "0.0 [Color2RGB $color] "
1058    set range [expr $limits_(vmax) - $limits_(vmin)]
1059    for {set i 0} {$i < [llength $clist]} {incr i} {
1060        set xval [expr {double($i+1)/([llength $clist]+1)}]
1061        set color [lindex $clist $i]
1062        append cmap "$xval [Color2RGB $color] "
1063    }
1064    append cmap "1.0 [Color2RGB $color] "
1065
1066    set opacity $style(-opacity)
1067    set levels $style(-levels)
1068    set wmap {}
1069    if {[string is int $levels]} {
1070        lappend wmap 0.0 0.0
1071        set delta [expr {0.125/($levels+1)}]
1072        for {set i 1} {$i <= $levels} {incr i} {
1073            # add spikes in the middle
1074            set xval [expr {double($i)/($levels+1)}]
1075            lappend wmap [expr {$xval-$delta-0.01}] 0.0
1076            lappend wmap [expr {$xval-$delta}] $opacity
1077            lappend wmap [expr {$xval+$delta}] $opacity
1078            lappend wmap [expr {$xval+$delta+0.01}] 0.0
1079        }
1080        lappend wmap 1.0 0.0
1081    } else {
1082        lappend wmap 0.0 0.0
1083        set delta 0.05
1084        foreach xval [split $levels ,] {
1085            lappend wmap [expr {$xval-$delta}] 0.0
1086            lappend $xval $opacity
1087            lappend [expr {$xval+$delta}] 0.0
1088        }
1089        lappend wmap 1.0 0.0
1090    }
1091    return [list $sname $cmap $wmap]
1092}
1093
1094# ----------------------------------------------------------------------
1095# CONFIGURATION OPTION: -plotbackground
1096# ----------------------------------------------------------------------
1097itcl::configbody Rappture::HeightmapViewer::plotbackground {
1098    foreach {r g b} [Color2RGB $itk_option(-plotbackground)] break
1099    #fix this!
1100    #_send "color background $r $g $b"
1101}
1102
1103# ----------------------------------------------------------------------
1104# CONFIGURATION OPTION: -plotforeground
1105# ----------------------------------------------------------------------
1106itcl::configbody Rappture::HeightmapViewer::plotforeground {
1107    foreach {r g b} [Color2RGB $itk_option(-plotforeground)] break
1108    #fix this!
1109    #_send "color background $r $g $b"
1110}
1111
1112# ----------------------------------------------------------------------
1113# CONFIGURATION OPTION: -plotoutline
1114# ----------------------------------------------------------------------
1115itcl::configbody Rappture::HeightmapViewer::plotoutline {
1116    if {[IsConnected]} {
1117        _send "grid linecolor [Color2RGB $itk_option(-plotoutline)]"
1118    }
1119}
1120
1121
1122
1123#  camera --
1124#
1125itcl::body Rappture::HeightmapViewer::camera {option args} {
1126    switch -- $option {
1127        "show" {
1128            puts [array get view_]
1129        }
1130        "set" {
1131            set who [lindex $args 0]
1132            set x $settings_($this-$who)
1133            set code [catch { string is double $x } result]
1134            if { $code != 0 || !$result } {
1135                set settings_($this-$who) $view_($who)
1136                return
1137            }
1138            switch -- $who {
1139                "pan-x" - "pan-y" {
1140                    set view_($who) $settings_($this-$who)
1141                    _PanCamera
1142                }
1143                "phi" - "theta" - "psi" {
1144                    set view_($who) $settings_($this-$who)
1145                    set xyz [Euler2XYZ $view_(theta) $view_(phi) $view_(psi)]
1146                    _send "camera angle $xyz"
1147                }
1148                "zoom" {
1149                    set view_($who) $settings_($this-$who)
1150                    _send "camera zoom $view_(zoom)"
1151                }
1152            }
1153        }
1154    }
1155}
1156
1157itcl::body Rappture::HeightmapViewer::_BuildSettingsDrawer {} {
1158
1159    itk_component add settings {
1160        Rappture::Scroller $itk_component(drawer).scrl \
1161            -xscrollmode auto -yscrollmode auto \
1162            -width 200 -height 100
1163    }
1164
1165    itk_component add settings_canvas {
1166        canvas $itk_component(settings).canvas -highlightthickness 0
1167    }
1168    $itk_component(settings) contents $itk_component(settings_canvas)
1169
1170    itk_component add settings_frame {
1171        frame $itk_component(settings_canvas).frame -bg white \
1172            -highlightthickness 0
1173    }
1174    $itk_component(settings_canvas) create window 0 0 \
1175        -anchor nw -window $itk_component(settings_frame)
1176    bind $itk_component(settings_frame) <Configure> \
1177        [itcl::code $this drawer resize settings]
1178
1179    set fg [option get $itk_component(hull) font Font]
1180
1181    set inner $itk_component(settings_frame)
1182
1183    foreach { key value } {
1184        grid            1
1185        axes            0
1186        contourlines    1
1187        wireframe       fill
1188        legend          1
1189    } {
1190        set settings_($this-$key) $value
1191    }
1192    set inner $itk_component(settings_frame)
1193    label $inner.title -text "View Settings" -font "Arial 10 bold"
1194    checkbutton $inner.grid \
1195        -text "grid" \
1196        -variable [itcl::scope settings_($this-grid)] \
1197        -command [itcl::code $this _fixSettings grid] \
1198        -font "Arial 9"
1199    checkbutton $inner.axes \
1200        -text "axes" \
1201        -variable ::Rappture::HeightmapViewer::settings_($this-axes) \
1202        -command [itcl::code $this _fixSettings axes] \
1203        -font "Arial 9"
1204    checkbutton $inner.contourlines \
1205        -text "contour lines" \
1206        -variable ::Rappture::HeightmapViewer::settings_($this-contourlines) \
1207        -command [itcl::code $this _fixSettings contourlines]\
1208        -font "Arial 9"
1209    checkbutton $inner.wireframe \
1210        -text "wireframe" \
1211        -onvalue "wireframe" -offvalue "fill" \
1212        -variable ::Rappture::HeightmapViewer::settings_($this-wireframe) \
1213        -command [itcl::code $this _fixSettings wireframe]\
1214        -font "Arial 9"
1215    checkbutton $inner.legend \
1216        -text "legend" \
1217        -variable ::Rappture::HeightmapViewer::settings_($this-legend) \
1218        -command [itcl::code $this _fixSettings legend]\
1219        -font "Arial 9"
1220
1221    blt::table $inner \
1222        0,0 $inner.title -anchor w -columnspan 2 \
1223        1,1 $inner.grid -anchor w  \
1224        2,1 $inner.axes -anchor w \
1225        3,1 $inner.contourlines -anchor w \
1226        4,1 $inner.wireframe -anchor w \
1227        5,1 $inner.legend -anchor w
1228
1229    blt::table configure $inner c0 -resize expand -width 2
1230    blt::table configure $inner c2 -resize expand
1231    blt::table configure $inner c1 -resize none
1232
1233}
1234
1235itcl::body Rappture::HeightmapViewer::_BuildCameraDrawer {} {
1236
1237    itk_component add camera {
1238        Rappture::Scroller $itk_component(drawer).camerascrl \
1239            -xscrollmode auto -yscrollmode auto \
1240            -highlightthickness 0
1241    }
1242
1243    itk_component add camera_canvas {
1244        canvas $itk_component(camera).canvas -highlightthickness 0
1245    } {
1246        ignore -highlightthickness
1247    }
1248    $itk_component(camera) contents $itk_component(camera_canvas)
1249
1250    itk_component add camera_frame {
1251        frame $itk_component(camera_canvas).frame \
1252            -highlightthickness 0
1253    }
1254    $itk_component(camera_canvas) create window 0 0 \
1255        -anchor nw -window $itk_component(camera_frame)
1256    bind $itk_component(camera_frame) <Configure> \
1257        [itcl::code $this drawer resize camera]
1258
1259    set inner $itk_component(camera_frame)
1260
1261    label $inner.title -text "Camera Settings" -font "Arial 10 bold"
1262
1263    set labels { phi theta psi pan-x pan-y zoom }
1264    blt::table $inner \
1265        0,0 $inner.title -anchor w  -columnspan 4
1266    set row 1
1267    foreach tag $labels {
1268        label $inner.${tag}label -text $tag -font "Arial 9"
1269        entry $inner.${tag} -font "Arial 9"  -bg white \
1270            -textvariable [itcl::scope settings_($this-$tag)]
1271        bind $inner.${tag} <KeyPress-Return> \
1272            [itcl::code $this camera set ${tag}]
1273        blt::table $inner \
1274            $row,1 $inner.${tag}label -anchor e \
1275            $row,2 $inner.${tag} -anchor w
1276        incr row
1277    }
1278    bind $inner.title <Shift-ButtonPress> \
1279        [itcl::code $this camera show]
1280    blt::table configure $inner c0 -resize expand -width 4
1281    blt::table configure $inner c1 c2 -resize none
1282    blt::table configure $inner c3 -resize expand
1283
1284}
1285
1286itcl::body Rappture::HeightmapViewer::drawer { what who } {
1287    switch -- ${what} {
1288        "activate" {
1289            $itk_component(drawer) add $itk_component($who) -sticky nsew
1290            after idle [list focus $itk_component($who)]
1291            if { ![info exists initialized_($who)] } {
1292                set w [winfo width $itk_component(drawer)]
1293                set x [expr $w - 120]
1294                $itk_component(drawer) sash place 0 $x 0
1295                set initialized_($who) 1
1296            }
1297            $itk_component(${who}_button) configure -relief sunken
1298        }
1299        "deactivate" {
1300            $itk_component(drawer) forget $itk_component($who)
1301            $itk_component(${who}_button) configure -relief raised
1302        }
1303        "toggle" {
1304            set slaves [$itk_component(drawer) panes]
1305            if { [lsearch $slaves $itk_component($who)] >= 0 } {
1306                drawer deactivate $who
1307            } else {
1308                drawer activate $who
1309            }
1310        }
1311        "resize" {
1312            set bbox [$itk_component(${who}_canvas) bbox all]
1313            set wid [winfo width $itk_component(${who}_frame)]
1314            $itk_component(${who}_canvas) configure -width $wid \
1315                -scrollregion $bbox -yscrollincrement 0.1i
1316        }
1317    }
1318}
1319
Note: See TracBrowser for help on using the repository browser.