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

   # mb-gs.tcl --
   #
   #       FIXME: This file needs a description here.
   #
   # 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-gs.tcl,v 1.8 2002/02/03 04:27:17 lim Exp $
  
  
  import GPSinterp
  
  #
  # customized interpreter to work with MBPSProcessor
  #
  Class MBPSInterp -superclass GPSinterp
  
  MBPSInterp instproc init pswin {
      $self instvar orient_ pswin_ path_ width_ height_
  
      $self next $pswin
      set width_ 0
      set height_ 0
  
      $pswin_ Init $self
  }
  
  #$MBPSInterp instproc destroy {} {
  #    DbgOut "in MBPSInterp instproc destroy"
  #    $self next
  #}
  
  MBPSInterp instproc get_pixmap {args} {
      $self instvar pswin_
      return [eval $pswin_ get_pixmap $args]
  }
  
  MBPSInterp instproc pixmap-id {} {
       $self instvar pswin_
       return [expr [$pswin_ pixmap-id]]
  }
  
  MBPSInterp instproc width {} {
      $self instvar width_
      return $width_
  }
  
  MBPSInterp instproc height {} {
      $self instvar height_
      return $height_
  }
  
  MBPSInterp instproc set-bbox {bbox} {
      $self instvar bbox_
      set bbox_ $bbox
  }
  
  MBPSInterp instproc resize {width height} {
      $self instvar path_ width_ height_ pipe_
      if {$width_!=$width || $height_!=$height} {
          $self kill
          set width_ $width
          set height_ $height
      }
      $self fork
  }
  
  # customized PostscriptWindow that calls MBPSInterp to
  # get the pixmaps (does not do the displaying)
  
  MBPSProcessor superclass PostscriptWindow
  
  MBPSProcessor instproc Init {interp} {
      $self instvar busy_ waiting_ curr_file_ curr_pm_ busy_ gs_
      set gs_ $interp
      set busy_ 0
     set waiting_ ""
 }
 
 MBPSProcessor instproc pixmap-id {} {
     $self instvar pixmap_id_
     DbgOut "returning tcl bitmap"
     return $pixmap_id_
 }
 
 DSC_Parser instproc get_bbox {file} {
     seek $file 0 start
     set contents [read $file 4096]
     set found [regexp "%%BoundingBox: (\[(\]atend\[)\]|\[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]*)" $contents dummy bbox]
     if {$found == 0} {
         DbgOut "Cannot find bounding box"
         return ""
     }
     if {[string compare "(atend)" $bbox] == 0} {
         seek $file "-4096" end
         set contents [read $file 4096]
         set found [regexp "%%BoundingBox: (\[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]*)" $contents dummy bbox]
         if {$found == 0} {
             DbgOut "Cannot find bbox at end"
             return ""
         }
     }
     DbgOut "bbox of ps: $bbox"
     seek $file 0 start
     return $bbox
 }
 
 MBPSProcessor instproc get_next_req { } {
     $self instvar waiting_ file_ pixmap_id_ pmSize_ busy_ gs_
 
     if {$busy_ == 1} {
         return
     }
     if {[llength $waiting_] <= 0} {
         return
     }
     set currPS [lindex $waiting_ 0]
     set waiting_ [lrange $waiting_ 1 end]
 
     set busy_ 1
     set file_ [lindex $currPS 0]
     set pixmap_id_ [lindex $currPS 1]
     $self set_pixmap $pixmap_id_
     set pmSize_ [lrange $currPS 2 3]
 
     set psFile [open $file_ r]
 
     set psp [new DSC_Parser]
     $psp set-file $psFile
     set bbox [$psp get_bbox $psFile]
     $gs_ set-bbox $bbox
     eval $gs_ resize $pmSize_
 
     set npage [$psp set npage_]
     set tmpFile /tmp/mbps.[pid].ps
     set f [open $tmpFile w]
     $psp dump 1 $f
     close $f
     DbgOut "calling render-file $tmpFile"
     $gs_ render-file $tmpFile
 }
 
 MBPSProcessor instproc get_pixmap {pixmap_id width height filename } {
     $self instvar waiting_ file_ pixmap_id_ busy_
 
 #    set pixmap_id [eval $self create_pixmap $width $height]
     lappend waiting_ [list $filename $pixmap_id $width $height]
     DbgOut "busy=$busy_, \$waiting_=$waiting_"
 
     $self get_next_req
 
     return $pixmap_id
 }
 
 MBPSProcessor instproc recv-page w {
     # force a redraw
     # $self damage
     $self instvar mwin_ path_ busy_ pixmap_id_ pmSize_
 #    set mwin_ $w
     #FIXME our widget doesn't support tk configuration
     [winfo parent $path_] configure -cursor ""
     DbgOut "\n\n ------- recv-page called --------- "
 
         #update
     set busy_ 0
     $self get_next_req
 }
 
 MBPSProcessor instproc recv-done w {
     # force a redraw
     # $self damage
     DbgOut "\n\n ------- recv-done called --------- \n\n"
 }
 
 MBPSProcessor instproc destroy {} {
     DbgOut "in MBPSInterp instproc destroy"
     $self next
 }