Open Mash Cross Reference
mash/tcl/atobj/anm-view.tcl

   # anm-view.tcl --
   #
   #       FIXME: This file needs a description here.
   #
   # Copyright (c) 1993-2002 The Regents of the University of California.
   # All rights reserved.
   #
   # Redistribution and use in source and binary forms, with or without
   # modification, are permitted provided that the following conditions are met:
  #
  # A. Redistributions of source code must retain the above copyright notice,
  #    this list of conditions and the following disclaimer.
  # B. Redistributions in binary form must reproduce the above copyright notice,
  #    this list of conditions and the following disclaimer in the documentation
  #    and/or other materials provided with the distribution.
  # C. Neither the names of the copyright holders nor the names of its
  #    contributors may be used to endorse or promote products derived from this
  #    software without specific prior written permission.
  #
  # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
  # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  # ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR
  # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
  # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
  # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
  # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
  # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  
  
  #  The AnmView class in charge of displaying animation objects.
  #
  Class AnmView
  
  AnmView instproc init {{pathname {}}} {
          $self instvar aseq_ wgt_ tools_ pathname_ objectIds_
          $self instvar staticIds_ wpath_ fpath_
  
          # null pathname means we generate one on the fly
          if {$pathname==""} {
                  set pathname .ato_$self
          }
          set pathname_ $pathname
  #        DbgOut "creating $pathname_"
  
          toplevel $pathname_
          set fpath_ [frame $pathname.af -relief ridge]
          pack $fpath_ -fill both -side top -expand 1
  
          set wpath_ $fpath_.dwgt
          set wgt_ [new DrawBoardWidget $wpath_]
          pack $wpath_ -fill both -side top -expand 1
          $wgt_ attach_painter $self
  
          # tkwait visibility $wgtpath
          #    update idletasks
          wm withdraw $pathname
          wm deiconify $pathname
          wm geometry $pathname 500x400
  
          set objectIds_ ""
          set staticIds_ ""
  #        DbgOut end init [winfo exists $wgtpath]
  }
  
  AnmView instproc destroy {} {
          $self instvar datasrc_ pathname_
          delete $datasrc_
          destroy $pathname_
  }
  
  AnmView instproc path {} {
          return [$self set pathname_]
  }
  
  AnmView instproc wpath {} {
          return [$self set wpath_]
  }
  
  AnmView instproc fpath {} {
          return [$self set fpath_]
  }
  
  AnmView instproc attach_session {session} {
          set session_ $session
  }
  
  # Note: AnmView takes responsibilities to destroy datasrc
  AnmView instproc attach_datasrc {datasrc} {
          $self instvar datasrc_ mintime_ maxtime_
          set datasrc_ $datasrc
  }
  
  # tells all the non-static animation objects that the current time is t
  #    they should remove themselves if they are no longer active
  AnmView instproc update {t} {
          $self instvar objects_
          if [array exists objects_] {
                 foreach elt [array names objects_] {
                         $objects_($elt) update $t
                 }
         }
 }
 
 AnmView instproc refresh {t} {
         [$self set wgt_] refresh
 #        DbgOut refresh $t
 #        update idletasks
 }
 
 AnmView instproc draw {} {
         $self instvar objects_ damage_ objectIds_ staticIds_ datasrc_
         $self next
         set now [$datasrc_ now]
 #        DbgOut draw $now $staticIds_ $objectIds_
 
         if ![array exists objects_] { return }
         # DbgVar objectIds_ staticIds_
         foreach elt $staticIds_ {
                 $objects_($elt) draw $now
         }
         foreach elt $objectIds_ {
                 $objects_($elt) draw $now
         }
 
         return
 }
 
 AnmView instproc setFontByIdx {index font color} {
         $self instvar fonts_ nextFontId_ wgt_
 
         if ![info exists nextFontId_] {
                 set nextFontId_ 0
         }
         $wgt_ set_font $nextFontId_ $font $color
         set fonts_($font,$color) $nextFontId_
         incr nextFontId_
 }
 
 # computes the bounding bbox of all the objects
 AnmView instproc bbox {} {
         $self instvar objects_ bbox_
         if [info exists bbox_] {
                 return $bbox_
         }
         set bbox {0 0 0 0}
         foreach elt [array names objects_] {
                 eval $objects_($elt) merge bbox
         }
         DbgOut "bbox:$bbox"
         return $bbox
 }
 
 AnmView instproc setBBox {bbox} {
         $self set bbox_ $bbox
 }
 
 AnmView instproc resize {} {
         [$self set wgt_] resize
 }
 
 # returns the lowest id of objects that are currently active
 AnmView instproc oldestEId {} {
         $self instvar objectIds_ objects_
         if {"$objectIds_"==""} return ""
         return [lindex $objectIds_ 0]
 }
 
 # returns the lowest id of objects that are currently active
 AnmView instproc newestEId {} {
         $self instvar objectIds_ objects_ maxId_
         if {"$objectIds_"==""} return ""
         return [lindex $objectIds_ end]
 }
 
 # this procedure is optimized for inserting mostly from the back
 proc insertSorted {vl item} {
         upvar $vl l
         for {set i [expr [llength $l] - 1]} {$i>=0} {incr i -1} {
                 if {[lindex $l $i] < $item} {
                         break
                 }
         }
         incr i
         set l [linsert $l $i $item]
 }
 
 # REVIEW: make sure we don't put 2 elements into 1 slot!
 AnmView instproc insert_AnmObj {obj} {
         $self instvar objects_ wgt_ objectIds_ staticIds_
 #        DbgOut "insertANM $obj [$obj info class]"
 
         set id [$obj eId]
         if [info exists objects_($id)] {
                 DbgOut skipping duplicate object id $id
                 return
         }
         set objects_($id) $obj
         $obj set_drawboard $self $wgt_
 
         if {![$obj isStatic]} {
                 insertSorted objectIds_ $id
         } else {
                 insertSorted staticIds_ $id
         }
 }
 
 AnmView instproc remove {id} {
         $self instvar objects_ objectIds_
         $self next
 
 #        DbgOut remove_AnmObj $id now [[$self set datasrc_] now] \
 #                      s-e  [$objects_($id) set sT_] [$objects_($id) set eT_]
 
         if ![info exists objects_($id)] {
                 DbgOut "[$self info class] remove: non-existent object"
                 return
         }
         # DbgOut "Deleting pkt: $objects_($id)"
 
         # could be a static object or non-static
         set ix [lsearch -exact $objectIds_ $id]
         set ix1 -1
         if {$ix >= 0} {
                 set objectIds_ [lreplace $objectIds_ $ix $ix]
         } else {
                 DbgOut "removing static object"
                 set ix1 [lsearch -exact $staticIds_ $id]
                 DbgAssert [expr $ix1 >= 0]
                 set staticIds_ [lreplace $staticIds_ $ix1 $ix1]
         }
         DbgAssert [expr $ix >= 0 || $ix1 >= 0]
 #        DbgOut "objectIds_: $objectIds_"
 
         # NOTE: we have to remove it AFTER, otherwise there would be
         #       an instant we there is an objectIds_ without an objects_!
         # REVIEW: the above condition might no longer be neccessary
         delete $objects_($id)
         unset objects_($id)
 }