Open Mash Cross Reference
mash/tcl/mb/mb-pres.tcl

   # mb-pres.tcl --
   #
   #       Saving and loading of MediaBoard presentations
   #
   # Copyright (c) 1997-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.
  #
  #   @(#) $Header: /usr/mash/src/repository/mash/mash-1/tcl/mb/mb-pres.tcl,v 1.8 2002/02/03 04:27:17 lim Exp $
  
  
  # An item in a mb presentation
  Class MBPresItem
  
  MBPresItem instproc init {coord prop} {
          $self set coord_ $coord
          $self set prop_ $prop
  }
  
  #
  # A page in a mb presentation
  #   all it does right now is to save a marker and create a new page
  Class MBPresItem/page -superclass MBPresItem
  
  MBPresItem/page proc save {file canv item} {
          puts $file {{page {} {}}}
  }
  
  MBPresItem/page instproc init {coord prop} {
          $self next $coord $prop
  }
  
  MBPresItem/page instproc create {mgr sender pageidv} {
          upvar $pageidv pageid
          set pagemgr [$mgr page_manger]
          set pageid [$pagemgr create_new_page]
          $pagemgr switch_page_later $pageid
  }
  
  # An text item in a mb presentation
  Class MBPresItem/text -superclass MBPresItem
  
  MBPresItem/text instproc init {coord prop} {
          $self next $coord $prop
  }
  
  MBPresItem/text proc save {file canv id} {
          lappend result [$canv type $id]
          lappend result [$canv coords $id]
          set props {}
          lappend props "-text"
          lappend props [$canv itemcget $id -text]
          # fonts are tricky due to the scaling effects
          # the way we are doing it is will not work if the scale is one 1
          set font [$canv itemcget $id -font]
          set family [font actual $font -family]
          set size [font actual $font -size]
          if {$family=="Arial"} {
                  set family "helvetica"
          }
          set pixelsize [expr {int(($size*[tk scaling])+0.5)*10}]
          lappend props "-font"
          lappend props "-*-$family-bold-r-normal--*-$pixelsize-*-*-*-*-*-*"
          set color [$canv itemcget $id -fill]
          lappend props "-fill"
          lappend props "$color"
          lappend result $props
          puts $file [list $result]
  }
  
  MBPresItem/text instproc create {mgr sender pageidv} {
          upvar $pageidv pageid
          $self instvar prop_ coord_
          set index [lsearch -exact $prop_ "-text"]
          puts "text index is $index"
          incr index
          set text [lindex $prop_ $index]
         if {$text=={}} {
                 return
         }
         incr index -1
         set props [lreplace $prop_ $index [expr {$index + 1}]]
         set currText [eval $sender -page $pageid create_item text \
                         $coord_ $props]
         puts "currText:$currText"
         set canvas [$mgr page_manager current_canvas]
         puts "text: $text"
         for {set i 0} {$i < [string length $text]} {incr i} {
                 set char [string index $text $i]
                 set textLast [$sender -page $pageid insert $currText $i $char]
                 # puts "$sender -page $pageid insert $currText $i $char"
                 # puts "textLast is $textLast"
         }
         puts "c:$currText l:$textLast"
         $sender -page $pageid create_item group text \
                         $currText $textLast
 }
 
 # A line item in a mb presentation
 Class MBPresItem/line -superclass MBPresItem
 
 MBPresItem/line instproc init {coord prop} {
 }
 
 MBPresItem/line proc save {file canv item} {
 
 }
 
 
 # Simple class to do a presentation, all it understand is text and pages
 Class MBPres
 
 #
 # filename is the file name the presentation is associated with
 #
 MBPres instproc init {mgr filename} {
         $self set mgr_ $mgr
         puts "mbpres: $filename"
         $self instvar f_
         catch {file remove $filename}
         set failed [catch {open $filename "r"} f_]
         if {$failed} {
                 error "cannot open $filename"
         }
         $self read
         $self set index_ 0
 }
 
 # clean up
 MBPres instproc destroy {} {
         close [$self set $f_]
 }
 
 # reads the whole file
 # FIXME: we should be able to read in line by line
 MBPres instproc read {} {
         $self instvar lines_ len_ f_
         set lines_ [read $f_]
         set len_ [llength $lines_]
 }
 
 # parses a line and update the variables
 MBPres instproc parse_line {index typevar coordvar propvar} {
         $self instvar lines_
         upvar $typevar type $coordvar coord $propvar prop
         set line [lindex $lines_ $index]
         set type [lindex $line 0]
         set coord [lindex $line 1]
         set prop [lindex $line 2]
 }
 
 # executes the line indexed by <u>index</u>
 MBPres instproc exe {index pageidv} {
         upvar $pageidv pageid
         $self instvar index_
         set type {}
         set coord {}
         set prop {}
         $self parse_line $index type coord prop
         puts "parse: $type $coord $prop"
         if {$type!={}} {
                 set item [new MBPresItem/$type $coord $prop]
         } else {
                 return
         }
         $self instvar mgr_
         $item create $mgr_ [$mgr_ sender] pageid
         delete $item
 }
 
 #
 # executes the next line and put it into the pageid in the contents
 # of <u>pageidv</u>
 #
 # side_effects: pgidvar might be updated (if the command is a page)
 #
 # if nopage is 1 functions returns (with value 2)
 #     when a <i>page</i> command is encountered
 # otherwise it returns 1 when the execution is successful
 #     or 0 if it is the end of file
 MBPres instproc exe_next {pageidv nopage} {
         upvar $pageidv pageid
         $self instvar index_ len_ lines_
         puts "$index_ , $len_"
         if {$index_ <= $len_} {
                 if {$nopage && [lindex [lindex $lines_ $index_] 0]=="page"} {
                         puts "exe_next returning 2"
                         return 2
                 }
                 $self exe $index_ pageid
                 incr index_
                 return 1
         } else {
                 return 0
         }
 }
 
 # create a new page and load items in it
 MBPres instproc load_next_page {} {
         $self instvar mgr_
         set pageid [[$mgr_ page_manager] current_page]
         set ok [$self exe_next pageid 0]
         puts "$ok"
         while {$ok==1} {
                 set ok [$self exe_next pageid 1]
         }
 }
 
 #
 # loads a whole file (regardless of how many pages there are)
 #
 MBPres instproc load {} {
         $self instvar mgr_
         set pageid [[$mgr_ page_manager] current_page]
         set ok [$self exe_next pageid 0]
         while $ok {
                 set ok [$self exe_next pageid 0]
         }
         $self instvar f_
         close $f_
 }
 
 #
 # Append the state of the canvas onto filename
 #
 MBPres proc save_canvas {canv filename} {
         if [catch {open $filename "a+"} f] {
                 error "cannot save to $filename"
         }
         set elements [$canv find withtag all]
         MBPresItem/page save $f $canv {}
         foreach elt $elements {
                 set result {}
                 set tags [$canv  gettags $elt]
                 if {-1 != [lsearch -exact $tags ignore]} {
                         continue
                 }
                 MBPresItem/[$canv type $elt] save $f $canv $elt
         }
         close $f
 }