(FILECREATED "30-Jun-87 09:25:18" {PHYLUM}<PAPERWORKS>SKETCHWHENCOPIEDPATCH.;2 12142
changes to: (VARS SKETCHWHENCOPIEDPATCHCOMS)
previous date: "24-Jun-87 15:16:40" {PHYLUM}<PAPERWORKS>SKETCHWHENCOPIEDPATCH.;1)
(* Copyright (c) 1987 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT SKETCHWHENCOPIEDPATCHCOMS)
(RPAQQ SKETCHWHENCOPIEDPATCHCOMS ((FNS SK.COPY.INSERTFN ADD.ELEMENT.TO.SKETCH SK.COPY.ITEM
\SKETCH.COPY.ELEMENT SK.BUILD.IMAGEOBJ COPY.IMAGE.OBJECT
SK.COPY.IMAGEOBJ)))
(DEFINEQ
(SK.COPY.INSERTFN
[LAMBDA (IMAGEOBJ SKW) (* rrb "23-Jun-87 13:25")
(* * the function that gets called to insert a copy-selection into a sketch window. Knows how to insert sketches,
everything else is text.)
(PROG (IMAGEOBJYET SELECTION EXTENDSELECTION) (* bind the selection so that if the user has to place
an image obj, it is restored before the characters are
unBYSYSBUFed)
[bind DATUM for IMOBJ inside IMAGEOBJ
do (COND
((STRINGP IMOBJ)
(BKSYSBUF IMOBJ))
((EQ (fetch (IMAGEOBJ IMAGEOBJFNS) of IMOBJ)
SKETCHIMAGEFNS) (* this is a sketch imageobj)
[COND
((NULL IMAGEOBJYET) (* save SELECTION and EXTENDSELECTION so they can be
restored)
(SETQ IMAGEOBJYET T)
(SETQ SELECTION (WINDOWPROP SKW (QUOTE SELECTION)))
(SETQ EXTENDSELECTION (WINDOWPROP SKW (QUOTE EXTENDSELECTION]
(SETQ DATUM (IMAGEOBJPROP IMOBJ (QUOTE OBJECTDATUM)))
(OR (SK.INSERT.SKETCH SKW (fetch (SKETCHIMAGEOBJ SKIO.SKETCH)
of DATUM)
(fetch (SKETCHIMAGEOBJ SKIO.REGION) of DATUM)
(fetch (SKETCHIMAGEOBJ SKIO.SCALE) of DATUM))
(RETURN)))
(T (* insert the image object whatever it is)
[COND
((NULL IMAGEOBJYET) (* save SELECTION and EXTENDSELECTION so they can be
restored)
(SETQ IMAGEOBJYET T)
(SETQ SELECTION (WINDOWPROP SKW (QUOTE SELECTION)))
(SETQ EXTENDSELECTION (WINDOWPROP SKW (QUOTE EXTENDSELECTION]
(* if the user placed it outside, just return)
(OR (SK.INSERT.SKETCH SKW [SKETCH.CREATE (QUOTE DUMMYNAME)
(QUOTE ELEMENTS)
(LIST (SETQ DATUM
(
SK.ELEMENT.FROM.IMAGEOBJ
IMOBJ SKW]
(fetch (SKIMAGEOBJ SKIMOBJ.GLOBALREGION)
of (fetch (GLOBALPART INDIVIDUALGLOBALPART)
of DATUM))
(VIEWER.SCALE SKW))
(RETURN]
(COND
(IMAGEOBJYET (* restore the selection)
(WINDOWPROP SKW (QUOTE SELECTION)
SELECTION)
(WINDOWPROP SKW (QUOTE EXTENDSELECTION)
EXTENDSELECTION)
(SKED.SELECTION.FEEDBACK SKW])
(ADD.ELEMENT.TO.SKETCH
[LAMBDA (GELT SKETCH) (* rrb "23-Jun-87 13:29")
(* changes the global sketch)
(PROG [(REALSKETCH (INSURE.SKETCH SKETCH))
(ELTPRI (\GETSKETCHELEMENTPROP1 GELT (QUOTE PRI]
[COND
((EQ (fetch (GLOBALPART GTYPE) of GELT)
(QUOTE SKIMAGEOBJ)) (* call the wheninsertedfn for this imageobj if there
is one.)
(PROG ((IMOBJ (fetch (SKIMAGEOBJ SKIMAGEOBJ) of (fetch (GLOBALPART
INDIVIDUALGLOBALPART)
of GELT)))
DATUM)
(COND
((AND (SETQ DATUM (IMAGEOBJPROP IMOBJ (QUOTE WHENINSERTEDFN)))
(NEQ DATUM (QUOTE NILL)))
(* call the image objects insertfn.)
(APPLY* DATUM IMOBJ (SK.VIEWER.FROM.SKETCH.ARG SKETCH)
NIL SKETCH)))
(RETURN]
(COND
((NULL ELTPRI) (* give the element a priority and put it at the end)
(SK.SET.ELEMENT.PRIORITY GELT (SK.POP.NEXT.PRIORITY REALSKETCH))
(TCONC (fetch (SKETCH SKETCHTCELL) of REALSKETCH)
GELT))
(T (SK.ADD.PRIORITY.ELEMENT.TO.SKETCH SKETCH GELT ELTPRI)))
(SK.MARK.DIRTY REALSKETCH])
(SK.COPY.ITEM
[LAMBDA (SELELT GLOBALDELTAPOS W) (* rrb "24-Jun-87 15:12")
(* SELELT is a sketch element that was selected for a copy operation. GLOBALDELTAPOS is the amount the new item is
to be offset from the old.)
(PROG ((OLDGLOBAL (fetch (SCREENELT GLOBALPART) of SELELT)))
[COND
((EQ (fetch (GLOBALPART GTYPE) of OLDGLOBAL)
(QUOTE SKIMAGEOBJ)) (* copying an image obj. Don't call its when copied
fn. was changed to call the WHENINSERTEDFN instead
when it acutally gets inserted.)
(SETQ OLDGLOBAL (SK.COPY.IMAGEOBJ OLDGLOBAL W]
(RETURN (SK.TRANSLATE.GLOBALPART OLDGLOBAL GLOBALDELTAPOS])
(\SKETCH.COPY.ELEMENT
[LAMBDA (GLOBALELEMENT GLOBALDELTAPOS W) (* rrb "24-Jun-87 15:05")
(* SELELT is a sketch element that was selected for a copy operation. GLOBALDELTAPOS is the amount the new item is
to be offset from the old.)
(COND
((EQ (fetch (GLOBALPART GTYPE) of GLOBALELEMENT)
(QUOTE SKIMAGEOBJ)) (* copying an image obj. Calls its when copied fn.)
(SK.TRANSLATE.GLOBALPART (SK.COPY.IMAGEOBJ GLOBALELEMENT W)
GLOBALDELTAPOS))
(T (SK.TRANSLATE.GLOBALPART GLOBALELEMENT GLOBALDELTAPOS])
(SK.BUILD.IMAGEOBJ
[LAMBDA (SCRELTS SKW CHARSONLYFLG) (* rrb "29-Jun-87 14:22")
(* builds an imageobj from the list of screen
elements.)
(COND
[CHARSONLYFLG (* return only the text characters.)
(PROG ((TEXTELTS
(bind GELT for LOCALSKELT in SCRELTS
join (SELECTQ
(fetch (GLOBALPART GTYPE) of (SETQ GELT (fetch (SCREENELT
GLOBALPART)
of LOCALSKELT)))
(TEXT (LIST (LIST (fetch (TEXT LOCATIONLATLON)
of (SETQ GELT (fetch (GLOBALPART
INDIVIDUALGLOBALPART)
of GELT)))
GELT)))
(TEXTBOX (LIST (LIST (SK.TEXTBOX.TEXT.POSITION
(SETQ GELT (fetch (GLOBALPART
INDIVIDUALGLOBALPART)
of GELT)))
GELT)))
(SKIMAGEOBJ (* grab the imageobj too.)
(LIST (LIST
(create POSITION
XCOORD ←[fetch (REGION LEFT)
of
(fetch (SKIMAGEOBJ
SKIMOBJ.GLOBALREGION)
of
(SETQ GELT
(fetch
(GLOBALPART
INDIVIDUALGLOBALPART)
of GELT]
YCOORD ←(fetch (REGION BOTTOM)
of (fetch (SKIMAGEOBJ
SKIMOBJ.GLOBALREGION)
of GELT)))
GELT)))
NIL)))
CHARSLST) (* sort according to top from the left.)
[SORT TEXTELTS (FUNCTION (LAMBDA (A B)
(COND
[(GREATERP (fetch (POSITION YCOORD) of (SETQ A (CAR A)))
(fetch (POSITION YCOORD) of (SETQ B (CAR B]
((EQUAL (fetch (POSITION YCOORD) of A)
(fetch (POSITION YCOORD) of B))
(LESSP (fetch (POSITION XCOORD) of A)
(fetch (POSITION XCOORD) of B]
(RETURN (COND
((EQUAL [CAR (LAST (SETQ CHARSLST
(for TEXTELT in TEXTELTS
join
(* collect relevant parts.)
(COND
[(EQ (QUOTE SKIMAGEOBJ)
(fetch (INDIVIDUALGLOBALPART
GTYPE)
of (CADR TEXTELT)))
(* copy image object so that copyfn is called. This also copies the part of the image object that are sketch
relevent unnecessarily but it keeps copyfn call in one place.)
(LIST (COPY.IMAGE.OBJECT
(fetch (SKIMAGEOBJ
SKIMAGEOBJ)
of (CADR TEXTELT]
(T (SK.ADD.SPACES (fetch
(TEXT
LISTOFCHARACTERS)
of
(CADR TEXTELT]
"
") (* strip off the trailing EOL that was added.)
(BUTLAST CHARSLST))
(T CHARSLST]
(T
(* return an image object. The sketch is translated to bring its lower left coordinate to 0,0 so that when it is
put in a document it is in a canonical place. Maybe don't need to do this anymore.)
(SKETCH.IMAGEOBJ [create SKETCH
using (INSURE.SKETCH SKW)
SKETCHNAME ← NIL SKETCHELTS ←(SK.SORT.GELTS.BY.PRIORITY
(bind GELT for LOCALSKELT in SCRELTS
collect (COND
((EQ (fetch (GLOBALPART GTYPE)
of (SETQ GELT
(fetch (SCREENELT
GLOBALPART)
of LOCALSKELT)))
(QUOTE SKIMAGEOBJ))
(* apply copy fn)
(SK.COPY.IMAGEOBJ GELT))
(T (COPY GELT]
(SK.GLOBAL.REGION.OF.LOCAL.ELEMENTS SCRELTS (VIEWER.SCALE SKW))
(VIEWER.SCALE SKW)
(SK.GRIDFACTOR SKW])
(COPY.IMAGE.OBJECT
[LAMBDA (IMAGEOBJ) (* rrb "29-Jun-87 14:22")
(* copies an image object calling its copyfn if
possible.)
(PROG (FN)
(RETURN (COND
((AND (SETQ FN (IMAGEOBJPROP IMAGEOBJ (QUOTE COPYFN)))
(NEQ FN (QUOTE NILL)))
(APPLY* FN IMAGEOBJ))
(T (COPY IMAGEOBJ])
(SK.COPY.IMAGEOBJ
[LAMBDA (GELT WINDOW CALLWHENCOPIEDFN) (* rrb "29-Jun-87 14:22")
(* * makes a copy of a image object sketch element. Has to call the image objects copyfn. Calls its its
WHENCOPIEDFN if CALLWHENCOPIEDFN is not NIL This is normally NIL because the WHENINSERTEDFN is used instead.)
(PROG ((INDVGELT (fetch (GLOBALPART INDIVIDUALGLOBALPART) of GELT))
IMAGEOBJ FN NEWSKELT)
[SETQ NEWSKELT (create GLOBALPART
INDIVIDUALGLOBALPART ←[create SKIMAGEOBJ
using INDVGELT SKIMAGEOBJ ←(
COPY.IMAGE.OBJECT
(SETQ IMAGEOBJ
(fetch (SKIMAGEOBJ
SKIMAGEOBJ)
of INDVGELT]
COMMONGLOBALPART ←(COPY (fetch (GLOBALPART
COMMONGLOBALPART)
of GELT]
(COND
((AND CALLWHENCOPIEDFN (SETQ FN (IMAGEOBJPROP IMAGEOBJ (QUOTE WHENCOPIEDFN)))
(NEQ FN (QUOTE NILL))) (* documentation calls for passing text streams as
well but there aren't any.)
(APPLY* FN IMAGEOBJ WINDOW)))
(RETURN NEWSKELT])
)
(PUTPROPS SKETCHWHENCOPIEDPATCH COPYRIGHT ("Xerox Corporation" 1987))
(DECLARE: DONTCOPY
(FILEMAP (NIL (534 12050 (SK.COPY.INSERTFN 544 . 3199) (ADD.ELEMENT.TO.SKETCH 3201 . 4650) (
SK.COPY.ITEM 4652 . 5437) (\SKETCH.COPY.ELEMENT 5439 . 6078) (SK.BUILD.IMAGEOBJ 6080 . 10357) (
COPY.IMAGE.OBJECT 10359 . 10826) (SK.COPY.IMAGEOBJ 10828 . 12048)))))
STOP