(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP")

(FILECREATED "22-Jan-88 22:39:09" {QV}<NOTECARDS>1.3LNEXT>RHTPATCH306.;2
 5862   

      changes to%:  (VARS RHTPATCH306COMS)
                    (FNS SKETCH.VIEWER.SCALE SKETCH.VIEWER.GRID NC.MakeExternalSketchCopy)

      previous date%: "22-Jan-88 22:37:58" {QV}<NOTECARDS>1.3LNEXT>RHTPATCH306.;1)


(* "
Copyright (c) 1988 by Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT RHTPATCH306COMS)

(RPAQQ RHTPATCH306COMS
 ((DECLARE%: DONTCOPY (PROPS (RHTPATCH306 MAKEFILE-ENVIRONMENT)
                                                   (RHTPATCH306 FILETYPE)))
                        [DECLARE%: FIRST (P (NC.LoadFileFromDirectories 'NCSKETCHCARD]
                        

(* ;;; "Fixes problem with sketch cards in document cards. ")


                        
          
          (* ;; "New stuff for LYRICSKETCHPATCHES.")


                        (FNS SKETCH.VIEWER.SCALE SKETCH.VIEWER.GRID)
                        [DECLARE%: DONTCOPY EVAL@COMPILE (P (OR (RECLOOK 'SKETCH)
                                                                (LOADVARS 'SKETCH 'SKETCH))
                                                            (OR (RECLOOK 'SKETCHIMAGEOBJ)
                                                                (LOADVARS 'SKETCHIMAGEOBJ
                                                                       'SKETCHOBJ]
                        
          
          (* ;; "Changes to NCSKETCHCARD")


                        (FNS NC.MakeExternalSketchCopy)))
(DECLARE%: DONTCOPY 

(PUTPROPS RHTPATCH306 MAKEFILE-ENVIRONMENT
 (:PACKAGE "INTERLISP" :READTABLE "INTERLISP"))

(PUTPROPS RHTPATCH306 FILETYPE
 :TCOMPL)
)
(DECLARE%: FIRST 
(NC.LoadFileFromDirectories 'NCSKETCHCARD)
)



(* ;;; "Fixes problem with sketch cards in document cards. ")





(* ;; "New stuff for LYRICSKETCHPATCHES.")


(DEFINEQ

(SKETCH.VIEWER.SCALE

  [LAMBDA (VIEWER NEWSCALE)
                                  (* rrb "21-Apr-87 12:25")

                                                             (* returns and optionally sets the 

                                                             scale of a viewer.)

    (COND
       [(IMAGEOBJP VIEWER)                                   (* it is a sketch image object)

        (PROG [(SKINFO (LISTP (IMAGEOBJPROP VIEWER 'OBJECTDATUM]
              (COND
                 [(type?
 SKETCH (fetch
 (SKETCHIMAGEOBJ SKIO.SKETCH) of
 SKINFO))
                  (RETURN (PROG1 (fetch
 (SKETCHIMAGEOBJ SKIO.SCALE) of
 SKINFO)
                                 (COND
                                    (NEWSCALE (COND
                                                 ((SK.INSURE.SCALE NEWSCALE)
                                                  (replace
 (SKETCHIMAGEOBJ SKIO.SCALE) of
 SKINFO
                                                     with
 NEWSCALE))
                                                 (T (\ILLEGAL.ARG NEWSCALE]
                 (T (ERROR "not a sketch image object" VIEWER]
       [(WINDOWP VIEWER)
        (PROG1 (WINDOWPROP VIEWER 'SCALE)
               (COND
                  (NEWSCALE (COND
                               ((SK.INSURE.SCALE NEWSCALE)
                                (WINDOWPROP VIEWER 'SCALE NEWSCALE)
                                (SK.UPDATE.AFTER.SCALE.CHANGE VIEWER]
       (T (\ILLEGAL.ARG VIEWER])

(SKETCH.VIEWER.GRID

  [LAMBDA (VIEWER NEWGRID)
                                   (* rrb "21-Apr-87 12:27")

          
          (* returns and optionally sets the grid size of a sketch.

          VIEWER can be a viewer or a sketch image object.)


    (COND
       [(IMAGEOBJP VIEWER)                                   (* it is a sketch image object)

        (PROG [(SKINFO (LISTP (IMAGEOBJPROP VIEWER 'OBJECTDATUM]
              (COND
                 [(type?
 SKETCH (fetch
 (SKETCHIMAGEOBJ SKIO.SKETCH) of
 SKINFO))
                  (RETURN (PROG1 (fetch
 (SKETCHIMAGEOBJ SKIO.GRID) of
 SKINFO)
                                 (COND
                                    (NEWGRID (COND
                                                ((NUMBERP NEWGRID)
                                                 (replace
 (SKETCHIMAGEOBJ SKIO.GRID) of
 SKINFO
                                                    with
 NEWGRID))
                                                (T (\ILLEGAL.ARG NEWGRID]
                 (T (ERROR "not a sketch image object" VIEWER]
       ((WINDOWP VIEWER)
        (SK.GRIDFACTOR VIEWER NEWGRID))
       (T (\ILLEGAL.ARG VIEWER])
)
(DECLARE%: DONTCOPY EVAL@COMPILE 
(OR (RECLOOK 'SKETCH)
    (LOADVARS 'SKETCH 'SKETCH))
(OR (RECLOOK 'SKETCHIMAGEOBJ)
    (LOADVARS 'SKETCHIMAGEOBJ 'SKETCHOBJ))
)



(* ;; "Changes to NCSKETCHCARD")


(DEFINEQ

(NC.MakeExternalSketchCopy

  [LAMBDA (SketchViewerOrImageObj)
                           (* ; "Edited 22-Jan-88 22:32 by Trigg")


(* ;;; "Make a copy of the sketch smashing any link icons.")

          
          (* ;; "rht 4/22/87: Now installs proper grid, scale and region viewed in the copy.  Now returns a sketch imageobj.")

          
          (* ;; "rht 1/22/88: Changed call of SKETCH.REGION.VIEWED to SKETCH.REGION.OF.SKETCH.")


    (LET ((SketchCopy (SKETCH.ADD.ELEMENT NIL NIL)))
         (SKETCH.COPY.ELEMENTS (SKETCH.ELEMENTS.OF.SKETCH (INSURE.SKETCH SketchViewerOrImageObj))
                SketchCopy)
         (NC.ExternalizeLinkIconsInSketch SketchCopy)
         (MAKE.IMAGE.OBJECT.OF.SKETCH SketchCopy (SKETCH.REGION.OF.SKETCH SketchViewerOrImageObj)
                (SKETCH.VIEWER.SCALE
 SketchViewerOrImageObj)
                (SKETCH.VIEWER.GRID
 SketchViewerOrImageObj])
)
(PUTPROPS RHTPATCH306 COPYRIGHT ("Xerox Corporation" 1988))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (1912 4641 (SKETCH.VIEWER.SCALE 1922 . 3435) (SKETCH.VIEWER.GRID 3437 . 4639)) (4846 
5779 (NC.MakeExternalSketchCopy 4856 . 5777)))))
STOP