(FILECREATED " 9-Oct-85 10:03:45" {PHYLUM}<PAPERWORKS>SKETCH.;178 380439
changes to: (FNS SK.COMPUTE.TWO.PT.TRANSFORMATION)
(VARS FIRSTPTMARK SECONDPTMARK THIRDPTMARK NEWFIRSTPTMARK NEWSECONDPTMARK
POINTMARK SPOTMARKER AUTOZOOMCURSOR ZOOMINCURSOR ZOOMOUTCURSOR
SKETCH.TITLED.ICON.TEMPLATE)
(RECORDS AFFINETRANSFORMATION SKFIGUREIMAGE SKETCHVIEW SKHISTEVENT SKEVENTTYPE)
previous date: " 8-Oct-85 15:05:06" {PHYLUM}<PAPERWORKS>SKETCH.;177)
(* Copyright (c) 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT SKETCHCOMS)
(RPAQQ SKETCHCOMS [[DECLARE: FIRST DOCOPY DONTEVAL@LOAD (P (COND ((GETD (QUOTE SKETCHW.CREATE))
(PRINT
"There is already a version of SKETCH in this SYSOUT.
If you want to use a newer version, you must start with a new SYSOUT."
T)
(ERROR!]
(FNS DRAW.LOCAL.SKETCH SKETCHW.CREATE SKETCHW.FIG.CHANGED SK.WINDOW.TITLE EDITSLIDE
EDITSKETCH SK.FIX.MENU SK.PUT.ON.FILE SK.GET.FROM.FILE SK.ADD.ELEMENTS.TO.SKETCH
STATUSPRINT CLEARPROMPTWINDOW CLOSEPROMPTWINDOW MYGETPROMPTWINDOW PROMPT.GETINPUT
SK.INSURE.HAS.MENU CREATE.SKETCHW.COMMANDMENU SKETCH.SET.A.DEFAULT SK.POPUP.SELECTIONFN
GETSKETCHWREGION READ.FUNCTION READBRUSHSIZE READANGLE READARCDIRECTION SK.ADD.ELEMENT
SK.APPLY.MENU.COMMAND SK.DELETE.ELEMENT1 SK.MARK.DIRTY SK.MARK.UNDIRTY
SK.MENU.AND.RETURN.FIELD SK.SCALE.POSITION.INTO.VIEWER SKETCH.SET.BRUSH.SHAPE
SKETCH.SET.BRUSH.SIZE SKETCHW.CLOSEFN SKETCHW.OUTFN SKETCHW.REOPENFN MAKE.LOCAL.SKETCH
MAP.SKETCHSPEC.INTO.VIEWER SKETCHW.REPAINTFN SKETCHW.REPAINTFN1 SK.DRAWFIGURE.IF
SKETCHW.SCROLLFN SKETCHW.SELECTIONFN SK.UPDATE.EVENT.SELECTION LIGHTGRAYWINDOW
SK.ADD.SPACES SK.SKETCH.MENU SK.CHECK.WHENDELETEDFN SK.APPLY.WHENDELETEDFN SK.RETURN.TTY
SK.TAKE.TTY)
(COMS (* fns for dealing with sketch structures)
(FNS SKETCH.CREATE GETSKETCHPROP PUTSKETCHPROP CREATE.DEFAULT.SKETCH.CONTEXT)
(PROP ARGNAMES SKETCH.CREATE))
(COMS (* fns for implementing copy and delete functions under keyboard control.)
(FNS SK.COPY.BUTTONEVENTFN SK.BUTTONEVENT.MARK SK.BUILD.IMAGEOBJ SK.BUTTONEVENT.OVERP
SK.BUTTONEVENT.SAME.KEYS)
(MACROS .DELETEKEYDOWNP. .MOVEKEYDOWNP.))
(* functions for changing elements.)
(FNS SK.SEL.AND.CHANGE SK.CHANGE.ELT SK.CHANGE.THING SK.CHANGEFN SK.READCHANGEFN
SK.DEFAULT.CHANGEFN CHANGEABLEFIELDITEMS SK.SEL.AND.MAKE SK.APPLY.CHANGE.COMMAND
SK.ELEMENTS.CHANGEFN SK.GROUP.CHANGEFN)
(* fns for adding elements)
(FNS ADD.ELEMENT.TO.SKETCH ADD.SKETCH.VIEWER REMOVE.SKETCH.VIEWER ALL.SKETCH.VIEWERS
VIEWER.BUCKET ELT.INSIDE.REGION? ELT.INSIDE.SKWP SCALE.FROM.SKW SK.ADDELT.TO.WINDOW
SK.CALC.REGION.VIEWED SK.DRAWFIGURE SK.DRAWFIGURE1 SK.LOCAL.FROM.GLOBAL SK.REGION.VIEWED
SK.UPDATE.REGION.VIEWED SKETCH.ADD.AND.DISPLAY SKETCH.ADD.AND.DISPLAY1 SK.ADD.ITEM
SKETCHW.ADD.INSTANCE)
(* fns for deleting things)
(FNS SK.SEL.AND.DELETE SK.ERASE.AND.DELETE.ITEM REMOVE.ELEMENT.FROM.SKETCH SK.DELETE.ELEMENT
SK.ERASE.ELT SK.DELETE.ELT SK.DELETE.ITEM DELFROMTCONC)
(* fns for copying stuff)
(FNS SK.COPY.ELT SK.SEL.AND.COPY SK.COPY.ELEMENTS SK.COPY.ITEM SK.INSERT.SKETCH)
(COMS (* fns for moving things.)
(FNS SK.MOVE.ELT SK.MOVE.ELT.OR.PT SK.APPLY.DEFAULT.MOVE SK.SEL.AND.MOVE
SK.MOVE.ELEMENTS SK.SHOW.FIG.FROM.INFO SK.MOVE.THING UPDATE.ELEMENT.IN.SKETCH
SK.UPDATE.ELEMENT SK.UPDATE.ELEMENTS SK.UPDATE.ELEMENT1 SK.MOVE.ELEMENT.POINT)
(* fns for moving points or a collection of pts.)
(FNS SK.MOVE.POINTS SK.SEL.AND.MOVE.POINTS SK.DO.MOVE.ELEMENT.POINTS
SK.MOVE.ITEM.POINTS SK.TRANSLATEPTSFN SK.TRANSLATE.POINTS
SK.SELECT.MULTIPLE.POINTS SK.CONTROL.POINTS.IN.REGION SK.ADD.PT.SELECTION
SK.REMOVE.PT.SELECTION SK.ADD.POINT SK.ELTS.CONTAINING.PTS SK.HOTSPOTS.NOT.ON.LIST)
(MACROS .SHIFTKEYDOWNP.)
(FNS SK.SET.MOVE.MODE SK.SET.MOVE.MODE.POINTS SK.SET.MOVE.MODE.ELEMENTS
SK.SET.MOVE.MODE.COMBINED READMOVEMODE))
(COMS (* stuff for supporting the GROUP sketch element.)
(FNS SK.GROUP.ELTS SK.SEL.AND.GROUP SK.GROUP.ELEMENTS SK.UNGROUP.ELT SK.SEL.AND.UNGROUP
SK.UNGROUP.ELEMENT SK.GLOBAL.REGION.OF.ELEMENTS SK.GLOBAL.REGION.OF.SKETCH
SK.FLASHREGION)
(FNS INIT.GROUP.ELEMENT GROUP.DRAWFN GROUP.EXPANDFN GROUP.INSIDEFN GROUP.REGIONFN
GROUP.TRANSLATEFN GROUP.TRANSFORMFN GROUP.READCHANGEFN)
(FNS REGION.CENTER REMOVE.LAST)
(RECORDS GROUP LOCALGROUP)
(COMS (* history and undo stuff for groups)
(FNS SK.DO.GROUP SK.DO.UNGROUP SK.GROUP.UNDO SK.UNGROUP.UNDO)
(IFPROP EVENTFNS GROUP UNGROUP)))
[COMS (* fns to implement transformations on the elements)
(FNS SK.SEL.AND.TRANSFORM SK.TRANSFORM.ELEMENTS SK.TRANSFORM.ITEM SK.TRANSFORM.ELEMENT
SK.TRANSFORM.POINT SK.TRANSFORM.POINT.LIST SK.TRANSFORM.REGION SK.PUT.ELTS.ON.GRID
SK.TRANSFORM.GLOBAL.ELEMENTS GLOBALELEMENTP SK.TRANSFORM.SCALE.FACTOR
SK.TRANSFORM.BRUSH SK.TRANSFORM.ARROWHEADS SCALE.BRUSH)
(FNS TWO.PT.TRANSFORMATION.INPUTFN SK.TWO.PT.TRANSFORM.ELTS SK.SEL.AND.TWO.PT.TRANSFORM
SK.APPLY.AFFINE.TRANSFORM SK.COMPUTE.TWO.PT.TRANSFORMATION SK.COMPUTE.SLOPE
SK.THREE.PT.TRANSFORM.ELTS SK.COMPUTE.THREE.PT.TRANSFORMATION
SK.SEL.AND.THREE.PT.TRANSFORM THREE.PT.TRANSFORMATION.INPUTFN)
(FNS SK.COPY.AND.TWO.PT.TRANSFORM.ELTS SK.SEL.COPY.AND.TWO.PT.TRANSFORM
SK.COPY.AND.THREE.PT.TRANSFORM.ELTS SK.SEL.COPY.AND.THREE.PT.TRANSFORM
SK.COPY.AND.TRANSFORM.ELEMENTS SK.COPY.AND.TRANSFORM.ITEM)
(DECLARE: DONTCOPY (RECORDS AFFINETRANSFORMATION))
(UGLYVARS FIRSTPTMARK SECONDPTMARK THIRDPTMARK NEWFIRSTPTMARK NEWSECONDPTMARK)
(GLOBALVARS FIRSTPTMARK SECONDPTMARK THIRDPTMARK NEWFIRSTPTMARK NEWSECONDPTMARK)
(P (COND ((EQ MAKESYSNAME (QUOTE INTERMEZZO))
(FILESLOAD MATRIXUSE))
(T (FILESLOAD MATMULT]
(COMS (* programmer interface entries)
(FNS SKETCH.ELEMENTS.OF.SKETCH SKETCH.LIST.OF.ELEMENTS SKETCH.ADD.ELEMENT
SKETCH.DELETE.ELEMENT DELFROMGROUPELT SKETCH.ELEMENT.TYPE SKETCH.ELEMENT.CHANGED
SK.ELEMENT.CHANGED1 SK.UPDATE.GLOBAL.IMAGE.OBJECT.ELEMENT))
(* utility routines for sketch windows.)
(FNS INSURE.SKETCH LOCALSPECS.FROM.VIEWER SK.LOCAL.ELT.FROM.GLOBALPART SKETCH.FROM.VIEWER
INSPECT.SKETCH)
(FNS MAPSKETCHSPECS MAPCOLLECTSKETCHSPECS MAPSKETCHSPECSUNTIL MAPGLOBALSKETCHSPECS
MAPGLOBALSKETCHELEMENTS GETSKELEMENTPROP PUTSKELEMENTPROP)
(COMS (* functions for marking)
(FNS SK.SHOWMARKS MARKPOINT SK.MARKHOTSPOTS SK.MARK.SELECTION)
(UGLYVARS POINTMARK SPOTMARKER)
(GLOBALVARS POINTMARK SPOTMARKER)
(CURSORS POINTREADINGCURSOR)
(* hit detection functions.)
(FNS SK.SELECT.ITEM IN.SKETCH.ELT? SK.MARK.HOTSPOT SK.MARK.POSITION SK.SELECT.ELT
SK.DESELECT.ELT)
(CONSTANTS (SK.POINT.WIDTH 4))
(* fns to support caching of hotspots.)
(FNS SK.HOTSPOT.CACHE SK.SET.HOTSPOT.CACHE SK.CREATE.HOTSPOT.CACHE SK.ELTS.FROM.HOTSPOT
SK.ADD.HOTSPOTS.TO.CACHE SK.ADD.HOTSPOTS.TO.CACHE1 SK.ADD.HOTSPOT.TO.CACHE
SK.REMOVE.HOTSPOTS.FROM.CACHE SK.REMOVE.HOTSPOTS.FROM.CACHE1
SK.REMOVE.HOTSPOT.FROM.CACHE SK.REMOVE.VALUE.FROM.CACHE.BUCKET
SK.FIND.CACHE.BUCKET SK.ADD.VALUE.TO.CACHE.BUCKET))
(COMS (* multiple selection and copy select functions)
(FNS SK.ADD.SELECTION SK.COPY.INSERTFN SK.FIGUREIMAGE SCREENELEMENTP SK.ITEM.REGION
SK.LOCAL.ITEMS.IN.REGION SK.REGIONFN SK.REMOVE.SELECTION SK.SELECT.MULTIPLE.ITEMS
SK.PUT.MARKS.UP SK.TAKE.MARKS.DOWN SK.TRANSLATE.GLOBALPART SK.TRANSLATE.ITEM
SK.TRANSLATEFN TRANSLATE.SKETCH)
(CONSTANTS (SK.NO.MOVE.DISTANCE 4))
(DECLARE: DONTCOPY (RECORDS SKFIGUREIMAGE)))
(INITVARS (ALLOW.MULTIPLE.SELECTION.FLG T))
(* functions for determining what is inside of a window.)
(FNS ELT.INSIDE.SKETCHWP SK.INSIDE.REGION)
(COMS (* stuff for changing the input scale)
(FNS SK.INPUT.SCALE SK.UPDATE.SKETCHCONTEXT SK.SET.INPUT.SCALE
SK.SET.INPUT.SCALE.CURRENT SK.SET.INPUT.SCALE.VALUE))
(COMS (* functions for zooming)
(FNS SKETCHW.SCALE SKETCH.ZOOM SAME.ASPECT.RATIO SKETCH.DO.ZOOM SKETCH.NEW.VIEW
ZOOM.UPDATE.ELT SK.UPDATE.AFTER.SCALE.CHANGE SKETCH.AUTOZOOM
SKETCH.GLOBAL.REGION.ZOOM)
(INITVARS (AUTOZOOM.FACTOR .8)
(AUTOZOOM.REPAINT.TIME 3000))
(UGLYVARS AUTOZOOMCURSOR ZOOMINCURSOR ZOOMOUTCURSOR)
(GLOBALVARS AUTOZOOM.FACTOR AUTOZOOM.REPAINT.TIME ZOOMINCURSOR ZOOMOUTCURSOR))
(COMS (* fns for changing the view)
(FNS SKETCH.HOME SK.FRAME.IT SK.MOVE.TO.VIEW SK.NAME.CURRENT.VIEW SK.RESTORE.VIEW
SK.FORGET.VIEW)
(DECLARE: DONTCOPY (RECORDS SKETCHVIEW)))
(COMS (* grid stuff)
(FNS SK.SET.GRID SK.DISPLAY.GRID SK.DISPLAY.GRID.POINTS SK.REMOVE.GRID.POINTS
SK.TAKE.DOWN.GRID SK.SHOW.GRID SK.GRIDFACTOR SK.TURN.GRID.ON SK.TURN.GRID.OFF
SK.MAKE.GRID.LARGER SK.MAKE.GRID.SMALLER SK.CHANGE.GRID GRID.FACTOR1
LEASTPOWEROF2GT GREATESTPOWEROF2LT SK.DEFAULT.GRIDFACTOR SK.PUT.ON.GRID
MAP.WINDOW.ONTO.GRID MAP.SCREEN.ONTO.GRID MAP.GLOBAL.PT.ONTO.GRID
MAP.GLOBAL.REGION.ONTO.GRID MAP.WINDOW.POINT.ONTO.GLOBAL.GRID
MAP.WINDOW.ONTO.GLOBAL.GRID SK.UPDATE.GRIDFACTOR SK.MAP.FROM.WINDOW.TO.GLOBAL.GRID
SK.MAP.INPUT.PT.TO.GLOBAL SK.MAP.FROM.WINDOW.TO.NEAREST.GRID)
(INITVARS (DEFAULTGRIDSIZE 8)
(DEFAULTMINGRIDSIZE 4)
(DEFAULTMAXGRIDSIZE 32)))
(COMS (* sketch icon support)
(FNS SKETCH.TITLE SK.SHRINK.ICONCREATE)
(UGLYVARS SKETCH.TITLED.ICON.TEMPLATE))
(COMS (* history and undo stuff)
(FNS SK.ADD.HISTEVENT SK.SEL.AND.UNDO SK.UNDO.LAST SK.UNDO.NAME SKEVENTTYPEFNS
SK.TYPE.OF.FIRST.ARG)
(FNS SK.DELETE.UNDO SK.ADD.UNDO)
(FNS SK.CHANGE.UNDO SK.CHANGE.REDO)
(FNS SK.UNDO.UNDO SK.UNDO.MENULABEL SK.LABEL.FROM.TYPE)
(DECLARE: DONTCOPY (RECORDS SKHISTEVENT SKEVENTTYPE))
(INITVARS (SKETCH.#.UNDO.ITEMS 30))
(GLOBALVARS SKETCH.#.UNDO.ITEMS)
(IFPROP EVENTFNS ADD DELETE CHANGE UNDO MOVE COPY ZOOM ANNOTATE LINK))
(COMS (* functions for hardcopying)
(FNS SKETCHW.HARDCOPYFN \SK.LIST.PAGE.IMAGE SK.LIST.IMAGE SK.LIST.IMAGE.ON.FILE
SK.SET.HARDCOPY.MODE SK.UNSET.HARDCOPY.MODE SK.UPDATE.AFTER.HARDCOPY
DEFAULTPRINTINGIMAGETYPE SK.SWITCH.REGION.X.AND.Y)
(CONSTANTS MICASPERPT IMICASPERPT PTSPERMICA))
(COMS (* functions for displaying the global coordinate space values.)
(FNS SHOW.GLOBAL.COORDS LOCATOR.CLOSEFN SKETCHW.FROM.LOCATOR SKETCHW.UPDATE.LOCATORS
LOCATOR.UPDATE UPDATE.GLOBAL.LOCATOR UPDATE.GLOBALCOORD.LOCATOR ADD.GLOBAL.DISPLAY
ADD.GLOBAL.GRIDDED.DISPLAY CREATE.GLOBAL.DISPLAYER
UPDATE.GLOBAL.GRIDDED.COORD.LOCATOR)
(VARS (SKETCHW.LASTCURSORPTX 0)
(SKETCHW.LASTCURSORY 0))
(GLOBALVARS SKETCHW.LASTCURSORPTX SKETCHW.LASTCURSORPTY))
(COMS (* fns for reading in various values)
(FNS READBRUSHSHAPE)
(FNS SK.CHANGE.DASHING READ.AND.SAVE.NEW.DASHING READ.NEW.DASHING READ.DASHING.CHANGE
DASHINGP SK.CACHE.DASHING SK.DASHING.LABEL)
(FNS READ.FILLING.CHANGE SK.CACHE.FILLING READ.AND.SAVE.NEW.FILLING SK.FILLING.LABEL)
(INITVARS (SK.DASHING.PATTERNS)
(SK.FILLING.PATTERNS))
(GLOBALVARS SK.DASHING.PATTERNS SK.FILLING.PATTERNS)
(P (SK.CACHE.DASHING (QUOTE (2 4)))
(SK.CACHE.DASHING (QUOTE (6 3 1 3)))
(SK.CACHE.FILLING BLACKSHADE)
(SK.CACHE.FILLING GRAYSHADE)
(SK.CACHE.FILLING HIGHLIGHTSHADE)))
(COMS (* fns for reading colors)
(FNS DISPLAYREADCOLORHLSLEVELS DISPLAYREADCOLORLEVEL DRAWREADCOLORBOX READ.CHANGE.COLOR
READCOLOR1 READCOLORCOMMANDMENUSELECTEDFN READCOLOR2)
(FNS CREATE.CNS.MENU)
(VARS COLORMENUHEIGHT COLORMENUWIDTH)
(DECLARE: DOEVAL@COMPILE EVAL@LOAD DONTCOPY (FILES (LOADCOMP)
LLCOLOR)))
(FNS SCALE.POSITION.INTO.SKETCHW UNSCALE UNSCALE.REGION)
(COMS (* stuff for reading input positions)
(FNS SK.GETGLOBALPOSITION GETSKWPOSITION NEAREST.HOT.SPOT GETWREGION
GET.BITMAP.POSITION SK.TRACK.BITMAP1)
(RECORDS INPUTPT))
(INITVARS (ALL.SKETCHES)
(INITIAL.SCALE 1.0)
(SKETCH.ELEMENT.TYPES)
(SKETCH.ELEMENT.TYPE.NAMES)
(DEFAULT.VISIBLE.SCALE.FACTOR 10.0)
(MINIMUM.VISIBLE.SCALE.FACTOR 4.0)
(ALLOWSKETCHPUTFLG T))
(GLOBALVARS ALL.SKETCHES INITIAL.SCALE DEFAULT.VISIBLE.SCALE.FACTOR
MINIMUM.VISIBLE.SCALE.FACTOR SKETCH.ELEMENT.TYPES SKETCH.ELEMENT.TYPE.NAMES
SK.SELECTEDMARK SK.LOCATEMARK COPYSELECTIONMARK MOVESELECTIONMARK
DELETESELECTIONMARK)
(UGLYVARS SK.SELECTEDMARK SK.LOCATEMARK COPYSELECTIONMARK MOVESELECTIONMARK
DELETESELECTIONMARK OTHERCONTROLPOINTMARK)
(* accessing functions for the methods of a sketch type.)
(FNS SK.DRAWFN SK.TRANSFORMFN SK.EXPANDFN SK.INPUT SK.INSIDEFN SK.UPDATEFN)
(INITRECORDS SKETCHTYPE)
(DECLARE: DONTCOPY (RECORDS SCREENELT GLOBALPART COMMONGLOBALPART INDIVIDUALGLOBALPART
LOCALPART SKETCH SKETCHTYPE SKETCHCONTEXT))
(ADDVARS (BackgroundMenuCommands (Sketch (QUOTE (SKETCHW.CREATE NIL NIL (GETREGION)
NIL NIL T T))
"Opens a sketch window for use.")))
(VARS (BackgroundMenu))
(FILES SKETCHELEMENTS GRAPHZOOM SKETCHEDIT SKETCHOBJ TEDIT)
(P (INIT.GROUP.ELEMENT))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA SKETCH.CREATE
STATUSPRINT])
(DECLARE: FIRST DOCOPY DONTEVAL@LOAD
(COND ((GETD (QUOTE SKETCHW.CREATE))
(PRINT
"There is already a version of SKETCH in this SYSOUT.
If you want to use a newer version, you must start with a new SYSOUT."
T)
(ERROR!)))
)
(DEFINEQ
(DRAW.LOCAL.SKETCH
[LAMBDA (LOCALSPECS STREAM STREAMREGION SCALE) (* rrb " 8-May-85 09:34")
(* * draws the local specs on a stream)
(MAPSKETCHSPECS LOCALSPECS (FUNCTION SK.DRAWFIGURE)
STREAM STREAMREGION (OR (NUMBERP SCALE)
(AND (WINDOWP STREAM)
(WINDOW.SCALE STREAM])
(SKETCHW.CREATE
[LAMBDA (SKETCH SKETCHREGION SCREENREGION TITLE INITIALSCALE BRINGUPMENU INITIALGRID)
(* rrb "29-Aug-85 11:10")
(* creates a sketch window and returns it.)
(PROG (W SCALE SKPROC SKETCHSTRUCTURE)
[SETQ SKETCHSTRUCTURE (COND
((NULL SKETCH)
(SKETCH.CREATE NIL))
[(LITATOM SKETCH) (* save the sketch on its name for use by EDITSLIDE.)
(OR (GETPROP SKETCH (QUOTE SKETCH))
(PUTPROP SKETCH (QUOTE SKETCH)
(SKETCH.CREATE SKETCH]
((type? SKETCH SKETCH)
SKETCH)
((type? IMAGEOBJ SKETCH) (* pull things out of the image object.)
(SETQ SKPROC (IMAGEOBJPROP SKETCH (QUOTE OBJECTDATUM)))
(OR (REGIONP SKETCHREGION)
(SETQ SKETCHREGION (fetch (SKETCHIMAGEOBJ SKIO.REGION) of SKPROC)))
(OR (NUMBERP INITIALSCALE)
(SETQ INITIALSCALE (fetch (SKETCHIMAGEOBJ SKIO.SCALE) of SKPROC)))
(OR (NUMBERP INITIALGRID)
(SETQ INITIALGRID (fetch (SKETCHIMAGEOBJ SKIO.GRID) of SKPROC)))
(fetch (SKETCHIMAGEOBJ SKIO.SKETCH) of SKPROC))
((AND (LITATOM (CAR SKETCH))
(for ELT in (CDR SKETCH) always (GLOBALELEMENTP ELT)))
(* old form, probably written out by notecards, update
to new form.)
(PROG (X)
(SETQ X (SKIO.UPDATE.FROM.OLD.FORM SKETCH))
(* smash sketch so this won't have to happen every
time.)
(RPLACA SKETCH (CAR X))
(RPLACD SKETCH (CDR X))
(RETURN X)))
(T (\ILLEGAL.ARG SKETCH]
[SETQ W (COND
((WINDOWP SCREENREGION)
(WINDOWPROP SCREENREGION (QUOTE TITLE)
(OR TITLE (SK.WINDOW.TITLE SKETCHSTRUCTURE)))
SCREENREGION)
(T (CREATEW (COND
((REGIONP SCREENREGION))
(T (CREATEREGION LASTMOUSEX LASTMOUSEY 10 10)))
(OR TITLE (SK.WINDOW.TITLE SKETCHSTRUCTURE))
NIL T]
(AND BRINGUPMENU (SK.FIX.MENU W T BRINGUPMENU))
(COND
((OR (REGIONP SCREENREGION)
(WINDOWP SCREENREGION)) (* user gave a region, don't interact)
NIL)
(T (* let prompting for reshape show room for both menu
and window.)
(SHAPEW W)))
(* set the right margin so that text will never run into it. This can be removed when character positions are kept
in points so \DSPPRINTCHAR doesn't have to look at the right margin.)
(DSPRIGHTMARGIN 64000 W)
(WINDOWPROP W (QUOTE SKETCH)
SKETCHSTRUCTURE)
[WINDOWPROP W (QUOTE SCALE)
(SETQ SCALE (COND
((NUMBERP INITIALSCALE))
[(REGIONP SKETCHREGION) (* determine the scale and offsets so that the given
region of the sketch fits into the given window.)
(FQUOTIENT (fetch (REGION HEIGHT) of SKETCHREGION)
(fetch (REGION HEIGHT) of (DSPCLIPPINGREGION NIL W]
((NULL SKETCHREGION)
INITIAL.SCALE)
(T (\ILLEGAL.ARG SKETCHREGION] (* check to make sure a context exists on the sketch
because before July 1985 it didn't exist.)
[WINDOWPROP W (QUOTE SKETCHCONTEXT)
(OR (GETSKETCHPROP SKETCHSTRUCTURE (QUOTE SKETCHCONTEXT))
(PUTSKETCHPROP SKETCHSTRUCTURE (QUOTE SKETCHCONTEXT)
(CREATE.DEFAULT.SKETCH.CONTEXT]
(COND
((REGIONP SKETCHREGION) (* if given a region, translate to it.)
(WXOFFSET (IMINUS (FIX (QUOTIENT (fetch (REGION LEFT) of SKETCHREGION)
SCALE)))
W)
(WYOFFSET (IMINUS (FIX (QUOTIENT (fetch (REGION BOTTOM) of SKETCHREGION)
SCALE)))
W)))
(SK.UPDATE.REGION.VIEWED W) (* calculate the sketch region being viewed before
mapping the sketch into it.)
(MAP.SKETCHSPEC.INTO.VIEWER SKETCHSTRUCTURE W)
(SK.CREATE.HOTSPOT.CACHE W)
[WINDOWPROP W (QUOTE GRIDFACTOR)
(COND
((NUMBERP INITIALGRID)
(LEASTPOWEROF2GT INITIALGRID))
(T (SK.DEFAULT.GRIDFACTOR W]
(WINDOWPROP W (QUOTE USEGRID)
(COND
(INITIALGRID T)))
(WINDOWPROP W (QUOTE BUTTONEVENTFN)
(FUNCTION WB.BUTTON.HANDLER))
(WINDOWPROP W (QUOTE COPYBUTTONEVENTFN)
(FUNCTION SK.COPY.BUTTONEVENTFN))
(WINDOWPROP W (QUOTE COPYINSERTFN)
(FUNCTION SK.COPY.INSERTFN))
(WINDOWPROP W (QUOTE RIGHTBUTTONFN)
(FUNCTION WB.BUTTON.HANDLER))
(WINDOWPROP W (QUOTE CURSOROUTFN)
(FUNCTION SKETCHW.OUTFN))
(WINDOWPROP W (QUOTE REPAINTFN)
(FUNCTION SKETCHW.REPAINTFN))
(WINDOWADDPROP W (QUOTE RESHAPEFN)
(FUNCTION RESHAPEBYREPAINTFN))
(WINDOWADDPROP W (QUOTE RESHAPEFN)
(FUNCTION SKETCHW.FIG.CHANGED))
(WINDOWADDPROP W (QUOTE RESHAPEFN)
(FUNCTION SK.UPDATE.REGION.VIEWED))
(WINDOWADDPROP W (QUOTE SHRINKFN)
(FUNCTION SK.SHRINK.ICONCREATE))
(WINDOWADDPROP W (QUOTE SHRINKFN)
(FUNCTION SK.RETURN.TTY))
(WINDOWADDPROP W (QUOTE EXPANDFN)
(FUNCTION SK.TAKE.TTY))
(WINDOWPROP W (QUOTE SCROLLFN)
(FUNCTION SKETCHW.SCROLLFN))
(WINDOWPROP W (QUOTE HARDCOPYFN)
(FUNCTION SKETCHW.HARDCOPYFN)) (* I'm not sure why this ever gets called but it did
once so to be sure, turn it off.)
(WINDOWPROP W (QUOTE PAGEFULLFN)
(FUNCTION NILL))
[WINDOWPROP W (QUOTE PROCESS)
(SETQ SKPROC (ADD.PROCESS (LIST (FUNCTION WB.EDITOR)
(KWOTE W))
(QUOTE RESTARTABLE)
T
(QUOTE TTYENTRYFN)
(QUOTE SK.TTYENTRYFN)
(QUOTE TTYEXITFN)
(QUOTE SK.TTYEXITFN]
(WINDOWPROP W (QUOTE SCROLLEXTENTUSE)
T)
(WINDOWADDPROP W (QUOTE CLOSEFN)
(FUNCTION SKETCHW.CLOSEFN)
T)
(OPENW W)
(ADD.SKETCH.VIEWER SKETCHSTRUCTURE W)
(SKETCHW.REPAINTFN W)
(RETURN W])
(SKETCHW.FIG.CHANGED
[LAMBDA (W) (* rrb "29-Nov-84 17:59")
(* W is a sketch window that is being reshaped.
Mark this fact in case it came out of a document.)
(OR (WINDOWPROP W (QUOTE SKETCHCHANGED))
(WINDOWPROP W (QUOTE SKETCHCHANGED)
(QUOTE OLD])
(SK.WINDOW.TITLE
[LAMBDA (SKETCH) (* rrb " 7-May-85 14:00")
(* returns the window title of a window onto a sketch.)
(COND
((fetch (SKETCH SKETCHNAME) of SKETCH)
(CONCAT "Viewer onto " (fetch (SKETCH SKETCHNAME) of SKETCH)))
(T "Viewer onto a sketch"])
(EDITSLIDE
[LAMBDA (SLIDENAME) (* rrb "25-Oct-84 11:23")
(* creates a sketch in a window the size of a screen.)
(SKETCHW.CREATE (SETQ SLIDENAME (OR SLIDENAME (GENSYM "SLIDE")))
NIL
(GETBOXREGION 612 792)
NIL NIL T 16.0)
SLIDENAME])
(EDITSKETCH
[LAMBDA (SLIDENAME) (* rrb "14-Nov-84 17:15")
(* edits a named sketch)
(SKETCHW.CREATE (SETQ SLIDENAME (OR SLIDENAME (GENSYM "SLIDE")))
NIL NIL NIL NIL T 16.0)
SLIDENAME])
(SK.FIX.MENU
[LAMBDA (SKETCHW DONTOPENFLG MENU?) (* rrb "24-Jan-85 11:21")
(* attached the sketchops menu to the window.)
(PROG (MENUW)
[COND
((type? MENU MENU?) (* put the given menu as the fixed one and establish
the standard one as the SKETCHPOPUPMENU)
(SETQ MENUW (MENUWINDOW MENU? T))
(WINDOWPROP SKETCHW (QUOTE SKETCHFIXEDMENU)
MENUW)
(SK.INSURE.HAS.MENU SKETCHW T))
(T (SETQ MENUW (SK.INSURE.HAS.MENU SKETCHW]
(WINDOWPROP MENUW (QUOTE MINSIZE)
(CONS [BITMAPWIDTH (UPDATE/MENU/IMAGE (CAR (WINDOWPROP MENUW (QUOTE MENU]
20))
(COND
((NOT (MEMB MENUW (ATTACHEDWINDOWS SKETCHW)))
(ATTACHWINDOW MENUW SKETCHW (QUOTE RIGHT)
(QUOTE TOP)
(QUOTE LOCALCLOSE))
(WINDOWADDPROP MENUW (QUOTE CLOSEFN)
(FUNCTION DETACHWINDOW))
(OR DONTOPENFLG (OPENW MENUW])
(SK.PUT.ON.FILE
[LAMBDA (SKETCHW) (* rrb "12-May-85 19:05")
(* saves a sketch on a Tedit file.)
(* also changes the name of the sketch to be the same
as the name of the file.)
(PROG ((SKETCH (INSURE.SKETCH (SKETCH.FROM.VIEWER SKETCHW)))
NOWNAME NEWNAME TEXTSTREAM)
(SETQ NOWNAME (fetch (SKETCH SKETCHNAME) of SKETCH))
(OR [SETQ NEWNAME (MKATOM (PROMPT.GETINPUT SKETCHW "File to PUT to: " (COND
((STRPOS " " NOWNAME)
(* don't put up dummy names that contain spaces)
NIL)
(T NOWNAME]
(RETURN NIL))
[COND
((NEQ NOWNAME NEWNAME) (* change the name of the sketch to be the same as the
file name.)
(replace (SKETCH SKETCHNAME) of SKETCH with NEWNAME)
(* change the titles of the viewers onto this sketch.)
(for SKW in (ALL.SKETCH.VIEWERS SKETCH) do (WINDOWPROP SKW (QUOTE TITLE)
(CONCAT "Viewer onto " NEWNAME]
(* make a text stream with nothing in it except the
sketch.)
[SETQ TEXTSTREAM (OPENTEXTSTREAM "" NIL NIL NIL (LIST (QUOTE PUTFN)
(WINDOWPROP SKETCHW (QUOTE
TEDIT.PUTFN))
(QUOTE PROMPTWINDOW)
(GETPROMPTWINDOW SKETCHW]
(TEDIT.INSERT.OBJECT (SKETCHIMAGEOBJ.FROM.VIEWER SKETCHW)
TEXTSTREAM 1)
(TEDIT.PUT TEXTSTREAM NEWNAME)
(AND (OPENP NEWNAME)
(CLOSEF NEWNAME))
(SK.MARK.UNDIRTY SKETCH)
(RETURN NEWNAME])
(SK.GET.FROM.FILE
[LAMBDA (SKETCHW) (* rrb "19-Jul-85 09:17")
(* saves a sketch on a file.)
(* also changes the name of the sketch to be the same
as the name of the file.)
(PROG ((SKETCH (SKETCH.FROM.VIEWER SKETCHW))
NOWNAME NEWNAME TEXTSTREAM IMAGEOBJ DIRTYSTATUS)
(SETQ NOWNAME (fetch (SKETCH SKETCHNAME) of SKETCH))
(SETQ NEWNAME (MKATOM (PROMPT.GETINPUT SKETCHW "File to GET: ")))
(COND
((MEMB NEWNAME (QUOTE (NIL %])))
(CLOSEPROMPTWINDOW SKETCHW)
(RETURN)))
(STATUSPRINT SKETCHW " ...")
[SETQ TEXTSTREAM (OPENTEXTSTREAM NEWNAME NIL NIL NIL (LIST (QUOTE PROMPTWINDOW)
(GETPROMPTWINDOW SKETCHW]
(SETQ IMAGEOBJ (BIN TEXTSTREAM))
(AND (OPENP NEWNAME)
(CLOSEF NEWNAME))
(COND
((NOT (IMAGEOBJP IMAGEOBJ))
(STATUSPRINT SKETCHW NEWNAME " is not a sketch file.")
(RETURN NIL)))
(PROG [(OBJ (IMAGEOBJPROP IMAGEOBJ (QUOTE OBJECTDATUM]
(PROG ((SKREG (fetch (SKETCHIMAGEOBJ SKIO.REGION) of OBJ))
(SCALE (fetch (SKETCHIMAGEOBJ SKIO.SCALE) of OBJ))
(READSKETCH (fetch (SKETCHIMAGEOBJ SKIO.SKETCH) of OBJ))
DEFAULTS) (* for now just stick all the elements in.)
(COND
((NOT (type? SKETCH READSKETCH))
(STATUSPRINT SKETCHW NEWNAME " is not a sketch file.")
(RETURN)))
[COND
((NEQ NOWNAME NEWNAME) (* change the name of the sketch to be the same as the
file name.)
(replace (SKETCH SKETCHNAME) of SKETCH with NEWNAME)
(* change the name of the sketch to be the same as the
file name.)
(for SKW in (ALL.SKETCH.VIEWERS SKETCH) do (WINDOWPROP SKW (QUOTE TITLE)
(SK.WINDOW.TITLE
SKETCH]
(COND
((fetch (SKETCH SKETCHELTS) of SKETCH)
(* note whether there were any elements of the sketch
before the GET. If there were, the sketch should be
left marked dirty.)
(SETQ DIRTYSTATUS T))
(T (PUTSKETCHPROP SKETCH (QUOTE SKETCHCONTEXT)
DEFAULTS)))
[COND
((SETQ DEFAULTS (GETSKETCHPROP READSKETCH (QUOTE SKETCHCONTEXT)))
(* determine whether to replace the current context
with the one stored with the sketch.)
(AND (COND
([AND (fetch (SKETCH SKETCHELTS) of SKETCH)
(NOT (EQUAL DEFAULTS (GETSKETCHPROP SKETCH (QUOTE
SKETCHCONTEXT]
(* if there are existing elements, ask whether to
replace)
(MENU (create MENU
ITEMS ←(QUOTE ((Yes T
"Will use the defaults of the retrieved sketch.")
(No NIL
"Will not change the defaults.")))
CENTERFLG ← T
TITLE ←
"Use the defaults from the retrieved sketch?"
MENUCOLUMNS ← 2)))
(T T))
(PUTSKETCHPROP SKETCH (QUOTE SKETCHCONTEXT)
DEFAULTS]
(SK.ADD.ELEMENTS.TO.SKETCH (fetch (SKETCH SKETCHELTS) of READSKETCH)
SKETCHW) (* copy properties from the read sketch.)
[for SKPROP in (fetch (SKETCH SKETCHPROPS) of READSKETCH) by (CDDR SKPROP)
do (SELECTQ SKPROP
(SKETCHCONTEXT NIL)
[VIEWS (PUTSKETCHPROP SKETCH (QUOTE VIEWS)
(UNION (GETSKETCHPROP READSKETCH
(QUOTE VIEWS))
(GETSKETCHPROP SKETCH (QUOTE VIEWS]
(PUTSKETCHPROP SKETCH SKPROP (GETSKETCHPROP READSKETCH SKPROP]
(SK.CHANGE.GRID (fetch (SKETCHIMAGEOBJ SKIO.GRID) of OBJ)
SKETCHW)
(COND
((NULL DIRTYSTATUS) (* if sketch was empty before, mark it as not needing
to be dumped.)
(SK.MARK.UNDIRTY SKETCH)))
(STATUSPRINT SKETCHW " done."])
(SK.ADD.ELEMENTS.TO.SKETCH
[LAMBDA (ELTS SKW) (* rrb "28-Nov-84 11:12")
(* adds a group of elements to a sketch)
(for ELT in ELTS do (SK.ADD.ELEMENT ELT SKW])
(STATUSPRINT
[LAMBDA NEXPS (* rrb "26-Jun-84 09:42")
(* prints a list of expressions in the status window associated with another window. If the first arg is a window or
a process, its prompt window is used. Otherwise, the global prompt window is used.)
(OR (EQ NEXPS 0)
(PROG (WIN (BEG 1))
(COND
((WINDOWP (ARG NEXPS 1))
(SETQ BEG 2)
(SETQ WIN (MYGETPROMPTWINDOW (ARG NEXPS 1)
2)))
[(PROCESSP (ARG NEXPS 1))
(SETQ BEG 2)
(COND
([AND (HASTTYWINDOWP (ARG NEXPS 1))
(SETQ WIN (OPENWP (PROCESS.TTY (ARG NEXPS 1]
(SETQ WIN (GETPROMPTWINDOW WIN)))
(T (SETQ WIN PROMPTWINDOW]
((EQ (ARG NEXPS 1)
T)
(SETQ BEG 2)
(SETQ WIN (TTYDISPLAYSTREAM)))
[(HASTTYWINDOWP (THIS.PROCESS))
(SETQ WIN (GETPROMPTWINDOW (TTYDISPLAYSTREAM]
(T (SETQ WIN PROMPTWINDOW)))
(for X from BEG to NEXPS do (PRIN1 (ARG NEXPS X)
WIN])
(CLEARPROMPTWINDOW
[LAMBDA (W) (* rrb "28-Nov-84 11:20")
(* clears the prompt window of a window.
IF W is NIL, clears the global one.)
(COND
[(WINDOWP W)
(PROG (PWIN)
(AND (SETQ PWIN (GETPROMPTWINDOW W NIL NIL T))
(OPENWP PWIN)
(CLEARW PWIN]
(T (CLRPROMPT])
(CLOSEPROMPTWINDOW
[LAMBDA (WINDOW) (* rrb "28-Nov-84 14:26")
(* clears and closes the prompt window for a window.)
(PROG [(PROMPTW (OPENWP (GETPROMPTWINDOW WINDOW NIL NIL T]
(COND
(PROMPTW (CLEARW PROMPTW)
(CLOSEW PROMPTW])
(MYGETPROMPTWINDOW
[LAMBDA (MAINW NLINES FONT DONTCREATE) (* rrb "28-Aug-85 11:10")
(* a version of GETPROMPTWINDOW that is locally
closable.)
(PROG ((PROMPTW (GETPROMPTWINDOW (ARG NEXPS 1)
2
(OR FONT (DEFAULTFONT (QUOTE DISPLAY)))
DONTCREATE)))
[COND
(PROMPTW (* make it locally closeable)
(WINDOWADDPROP PROMPTW (QUOTE CLOSEFN)
(FUNCTION DETACHWINDOW]
(RETURN PROMPTW])
(PROMPT.GETINPUT
[LAMBDA (WINDOW PROMPTSTRING DEFAULTSTRING DELIMITER.LIST)
(* rrb "23-May-84 14:39")
(* Ask for input (file names, &c) perhaps with a
default.)
(PROG (PROMPTWIN)
(COND
(WINDOW (SETQ PROMPTWIN (GETPROMPTWINDOW WINDOW))
(FRESHLINE PROMPTWIN))
((SETQ PROMPTWIN PROMPTWINDOW)
(CLEARW PROMPTWIN)))
(RETURN (PROMPTFORWORD PROMPTSTRING DEFAULTSTRING NIL PROMPTWIN NIL NIL
(OR DELIMITER.LIST (CHARCODE (EOL LF TAB ESCAPE)))
NIL])
(SK.INSURE.HAS.MENU
[LAMBDA (SKETCHW POPUPFLG INCLUDEFIXITEMFLG) (* rrb "12-Sep-85 14:29")
(* makes sure a sketch window has a menu.)
(COND
[(WINDOWPROP SKETCHW (COND
(POPUPFLG (QUOTE SKETCHPOPUPMENU))
(T (QUOTE SKETCHFIXEDMENU]
(T (PROG ((OPMENUW (MENUWINDOW (CREATE.SKETCHW.COMMANDMENU NIL INCLUDEFIXITEMFLG)
T)))
(WINDOWPROP SKETCHW (COND
(POPUPFLG (QUOTE SKETCHPOPUPMENU))
(T (QUOTE SKETCHFIXEDMENU)))
OPMENUW)
(RETURN OPMENUW])
(CREATE.SKETCHW.COMMANDMENU
[LAMBDA (MENUTITLE ADDFIXITEM ELEMENTTYPES) (* rrb " 4-Sep-85 15:41")
(* returns the control menu for a figure window.)
(create MENU
ITEMS ←[APPEND (QUOTE ((Delete SK.DELETE.ELT
"Deletes one or more elements from the sketch.")))
[QUOTE ((Move SK.APPLY.DEFAULT.MOVE
"Moves a control point, or one or more elements."
(SUBITEMS (Move% point SK.MOVE.ELEMENT.POINT
"Moves one of the control points.")
("Move points" SK.MOVE.POINTS
"Moves a collection of control points.")
("Move elements" SK.MOVE.ELT
"Moves one or more elements of the sketch.")
("Move onto grid" SK.PUT.ELTS.ON.GRID
"Moves control points to nearest grid point.")
("Two pt transform" SK.TWO.PT.TRANSFORM.ELTS
"Moves one or more sketch elements with a two point transformation.")
("Three pt transform" SK.THREE.PT.TRANSFORM.ELTS
"Moves one or more sketch elements with a three point transformation.")
("Set MOVE command mode" SK.SET.MOVE.MODE
"changes whether the MOVE command applies to points or elements."
(SUBITEMS (Points
SK.SET.MOVE.MODE.POINTS
"Top level MOVE command will be the same as MOVE POINTS command.")
(Elements
SK.SET.MOVE.MODE.ELEMENTS
"Top level MOVE command will be the same as MOVE ELEMENTS command.")
(Combined
SK.SET.MOVE.MODE.COMBINED
"MOVE command will move points if a single point is clicked; elements otherwise"]
[QUOTE ((Copy SK.COPY.ELT "Copies a piece of the sketch."
(SUBITEMS ("Copy elements" SK.COPY.ELT
"copies one or more elements of the sketch.")
("Copy w/2 pt trans"
SK.COPY.AND.TWO.PT.TRANSFORM.ELTS
"Copies one or more sketch elements with a two point transformation.")
("Copy w/3 pt trans"
SK.COPY.AND.THREE.PT.TRANSFORM.ELTS
"Copies one or more sketch elements with a three point transformation."]
(QUOTE ((Change SK.CHANGE.ELT "Changes a property of a piece.")))
[AND (GETD (QUOTE SK.SEL.AND.SHOW.ANNOTE))
(QUOTE ((Annotate SK.SEL.AND.SHOW.ANNOTE
"Manipulates the annotations from a selected element."
(SUBITEMS (Add% Annotation SK.SEL.AND.ADD.ANNOTE
"Adds an annotation to an element.")
(Delete% Annotation
SK.SEL.AND.DELETE.ANNOTE
"Deletes the annotation from an element.")
(Show% Annotation SK.SEL.AND.SHOW.ANNOTE
"Shows the annotation of an element."]
(for ELEMENT in (OR ELEMENTTYPES SKETCH.ELEMENT.TYPE.NAMES)
when [fetch (SKETCHTYPE LABEL) of (SETQ ELEMENT (GETPROP ELEMENT
(QUOTE
SKETCHTYPE]
collect (* add the sketch elements that have a label.)
(LIST (fetch (SKETCHTYPE LABEL) of ELEMENT)
ELEMENT
(fetch (SKETCHTYPE DOCSTR) of ELEMENT)))
[AND (GETD (QUOTE SK.SEL.AND.SHOW.ANNOTE))
(QUOTE ((Link SK.ADD.ANNOTATION "Adds an annotation object."]
[AND (GETD (QUOTE GROUP.DRAWFN))
(QUOTE ((Group SK.GROUP.ELTS
"groups a collection of elements into a single unit."]
[AND (GETD (QUOTE GROUP.DRAWFN))
(QUOTE ((UnGroup SK.UNGROUP.ELT
"replaces a group element by its constituents."]
[QUOTE ((Undo SK.UNDO.LAST
"undoes the previous event. Or the latest one that hasn't been undone."
(SUBITEMS (?Undo SK.SEL.AND.UNDO
"allows selection of an event to undo.")
(Undo SK.UNDO.LAST
"undoes the previous event. Or the latest one that hasn't been undone."]
[QUOTE ((Defaults SKETCH.SET.A.DEFAULT
"Changes one of the default characteristics."
(SUBITEMS (Line SKETCH.SET.BRUSH.SIZE
"Sets the characteristics of the default brush."
(SUBITEMS (Size SKETCH.SET.BRUSH.SIZE
"Sets the size of the default brush")
(Shape SKETCH.SET.BRUSH.SHAPE
"Sets the shape of the default brush")
(Add% arrowhead
SK.SET.LINE.ARROWHEAD
"Sets the arrowhead characteristics of new lines.")
("Mouse line specs"
SK.SET.LINE.LENGTH.MODE
"Sets whether the lines drawn with the middle mouse button connect to each other.")))
(Arrowhead SK.SET.ARROWHEAD.LENGTH
"Sets the characteristics of the default arrowhead."
(SUBITEMS (Size
SK.SET.ARROWHEAD.LENGTH)
(Angle
SK.SET.ARROWHEAD.ANGLE)
(Type
SK.SET.ARROWHEAD.TYPE)))
(Text SK.SET.TEXT.SIZE
"Sets the size of newly added text."
(SUBITEMS ("Font size" SK.SET.TEXT.SIZE
"Sets the size of newly added text.")
("Font family"
SK.SET.TEXT.FONT
"Sets the font family of newly added text.")
("Horizontal justification"
SK.SET.TEXT.HORIZ.ALIGN
"Sets the horizontal justification mode of new text.")
("Vertical justification"
SK.SET.TEXT.VERT.ALIGN
"Sets the vertical justification of new text.")
("Bold and/or italic"
SK.SET.TEXT.LOOKS
"Sets the bold and italic look of new text.")))
(Text% Box SK.SET.TEXTBOX.HORIZ.ALIGN
"Sets the alignment of text within new text boxes."
(SUBITEMS (
"Horizontal justification" SK.SET.TEXTBOX.HORIZ.ALIGN
"Sets the horizontal alignment of text within new text boxes.")
("Vertical justification"
SK.SET.TEXTBOX.VERT.ALIGN
"Sets the vertical alignment of text within new text boxes.")))
(Arc SK.SET.ARC.DIRECTION
"Sets the direction arcs go around their circle."
(SUBITEMS ("Clockwise"
SK.SET.ARC.DIRECTION.CW
"Makes new arcs go around in the clockwise direction")
("Counterclockwise"
SK.SET.ARC.DIRECTION.CCW
"Makes new arcs go around in the counterclockwise direction")))
("Input scale" SK.SET.INPUT.SCALE
"Sets the scale for newly added lines and text."
(SUBITEMS (
"Read new input scale" SK.SET.INPUT.SCALE "Reads a new input scale.")
(
"Make input scale current" SK.SET.INPUT.SCALE.CURRENT
"makes the input scale be the scale of the current view."]
[QUOTE ((Grid SK.SET.GRID
"Flips between using the grid and not using the grid."
(SUBITEMS (Turn% grid% ON SK.TURN.GRID.ON
"turns on a grid. Only pts on the grid can be selected.")
(Turn% grid% OFF SK.TURN.GRID.OFF
"turns off the grid. Any point can be selected.")
(LARGER% Grid SK.MAKE.GRID.LARGER
"doubles the distance between the grid points.")
(smaller% Grid SK.MAKE.GRID.SMALLER
"halves the distance between the grid points.")
("Display grid" SK.DISPLAY.GRID
"XORs a point at each grid point. If grid is visible, this will erase it.")
("Remove grid display" SK.TAKE.DOWN.GRID
"XORs a point at each grid point. If grid is visible, this will erase it."]
[QUOTE (("Move view" SKETCH.ZOOM
"makes a new region the part of the sketch visible."
(SUBITEMS ("Move view" SKETCH.ZOOM
"changes the scale of the display.")
(AutoZoom SKETCH.AUTOZOOM
"changes the scale around a selected point.")
(Home SKETCH.HOME
"returns to the origin at the original scale")
("Fit it" SK.FRAME.IT
"moves so that the entire sketch just fits in the window")
("Restore view" SK.RESTORE.VIEW
"Moves to a previously saved view."
(SUBITEMS ("Restore view"
SK.RESTORE.VIEW
"Moves to a previously saved view.")
("Save view"
SK.NAME.CURRENT.VIEW
"saves the current view (position and scale) of the sketch for easy return.")
("Forget view"
SK.FORGET.VIEW
"Deletes a previously saved view.")))
("Coord window" ADD.GLOBAL.DISPLAY
"creates a window that shows the cursor in global coordinates."
(SUBITEMS ("Coord window"
ADD.GLOBAL.DISPLAY
"creates a window that shows the cursor position in global coordinates.")
(
"Grid coord window" ADD.GLOBAL.GRIDDED.DISPLAY
"creates a window that shows the grid position nearest the cursor in global coordinates.")))
(New% window SKETCH.NEW.VIEW
"opens another viewer onto this sketch"]
[QUOTE ((HardCopy HARDCOPYIMAGEW
"sends a copy of the current window contents on the default printer."
(SUBITEMS ("To a file" HARDCOPYIMAGEW.TOFILE
"Puts image on a file; prompts for filename and format")
("To a printer" HARDCOPYIMAGEW.TOPRINTER
"Sends image to a printer of your choosing")
("Whole sketch" SK.LIST.IMAGE
"Sends the image of the whole sketch at the current scale to the printer."
(SUBITEMS ("To a file"
SK.LIST.IMAGE.ON.FILE
"Sends the image of the whole sketch at the current scale on a file.")
("To a printer"
SK.LIST.IMAGE
"Sends the image of the whole sketch at the current scale to the printer.")))
(Hardcopy% Display SK.SET.HARDCOPY.MODE
"Makes the display correspond to the hardcopy image on the default printer.")
(Normal% Display SK.UNSET.HARDCOPY.MODE
"Changes the display to use display fonts."]
[AND ALLOWSKETCHPUTFLG (QUOTE ((Put SK.PUT.ON.FILE
"saves this sketch on a file"]
[AND ALLOWSKETCHPUTFLG (QUOTE ((Get SK.GET.FROM.FILE
"gets a sketch from a file."]
[AND ADDFIXITEM (QUOTE ((Fix% Menu SK.FIX.MENU
"leaves up the menu of sketch operations."]
(AND (EQUAL (USERNAME)
"BURTON.PA")
(QUOTE ((inspect INSPECT.SKETCH
"Calls the Inspector on the figure data structures."]
CENTERFLG ← T
WHENSELECTEDFN ←(FUNCTION SKETCHW.SELECTIONFN)
MENUFONT ←(FONTNAMELIST (FONTCREATE BOLDFONT))
TITLE ← MENUTITLE
ITEMHEIGHT ←(MAX (FONTPROP (FONTCREATE BOLDFONT)
(QUOTE HEIGHT))
(PLUS 1 (BITMAPHEIGHT (fetch (SKETCHTYPE LABEL)
of (GETPROP (QUOTE ARC)
(QUOTE SKETCHTYPE])
(SKETCH.SET.A.DEFAULT
[LAMBDA (SKW) (* rrb " 4-Sep-85 15:41")
(* allows the user to set a default)
(MENU (create MENU
ITEMS ←[QUOTE ((Line SKETCH.SET.BRUSH.SIZE
"Sets the characteristics of the default brush."
(SUBITEMS (Size SKETCH.SET.BRUSH.SIZE
"Sets the size of the default brush")
(Shape SKETCH.SET.BRUSH.SHAPE
"Sets the shape of the default brush")
(Add% arrowhead SK.SET.LINE.ARROWHEAD
"Sets the arrowhead characteristics of new lines.")
("Mouse line specs" SK.SET.LINE.LENGTH.MODE
"Sets whether the lines drawn with the middle mouse button connect to each other.")))
(Arrowhead SK.SET.ARROWHEAD.LENGTH
"Sets the characteristics of the default arrowhead."
(SUBITEMS (Size SK.SET.ARROWHEAD.LENGTH)
(Angle SK.SET.ARROWHEAD.ANGLE)
(Type SK.SET.ARROWHEAD.TYPE)))
(Text SK.SET.TEXT.SIZE "Sets the size of newly added text."
(SUBITEMS ("Font size" SK.SET.TEXT.SIZE
"Sets the size of newly added text.")
("Font family" SK.SET.TEXT.FONT
"Sets the font family of newly added text.")
("Horizontal justification" SK.SET.TEXT.HORIZ.ALIGN
"Sets the horizontal justification mode of new text.")
("Vertical justification" SK.SET.TEXT.VERT.ALIGN
"Sets the vertical justification of new text.")
("Bold and/or italic" SK.SET.TEXT.LOOKS
"Sets the bold and italic look of new text.")))
(Text% Box SK.SET.TEXTBOX.HORIZ.ALIGN
"Sets the alignment of text within new text boxes."
(SUBITEMS ("Horizontal justification"
SK.SET.TEXTBOX.HORIZ.ALIGN
"Sets the horizontal alignment of text within new text boxes.")
("Vertical justification"
SK.SET.TEXTBOX.VERT.ALIGN
"Sets the vertical alignment of text within new text boxes.")))
(Arc SK.SET.ARC.DIRECTION
"Sets the direction arcs go around their circle."
(SUBITEMS ("Clockwise" SK.SET.ARC.DIRECTION.CW
"Makes new arcs go around in the clockwise direction")
("Counterclockwise" SK.SET.ARC.DIRECTION.CCW
"Makes new arcs go around in the counterclockwise direction")))
("Input scale" SK.SET.INPUT.SCALE
"Sets the scale for newly added lines and text."
(SUBITEMS ("Read new input scale" SK.SET.INPUT.SCALE
"Reads a new input scale.")
("Make input scale current"
SK.SET.INPUT.SCALE.CURRENT
"makes the input scale be the scale of the current view."]
CENTERFLG ← T
WHENSELECTEDFN ←(FUNCTION SK.POPUP.SELECTIONFN)
MENUFONT ←(FONTNAMELIST (FONTCREATE BOLDFONT])
(SK.POPUP.SELECTIONFN
[LAMBDA (ITEM MENU) (* rrb " 3-Sep-85 14:27")
(* * calls the function appropriate for the item selected from the command menu associated with a figure window.)
(* uses SKW freely from enclosing call to MENU.)
(CLOSEPROMPTWINDOW SKW)
(SK.APPLY.MENU.COMMAND (CADR ITEM)
SKW])
(GETSKETCHWREGION
[LAMBDA (SKETCHWINDOW) (* Feuerman "27-Feb-84 10:04")
(UNSCALE.REGION (GETWREGION SKETCHWINDOW)
(SKETCHW.SCALE SKETCHWINDOW])
(READ.FUNCTION
[LAMBDA (PRMPT W) (* rrb "11-May-84 15:41")
(PROG ((PROMPTWIN (GETPROMPTWINDOW W 3))
OLDTTYDS LST)
(SETQ OLDTTYDS (TTYDISPLAYSTREAM PROMPTWIN))
(COND
(PRMPT (printout PROMPTWIN PRMPT T ">> "))) (* grab the tty.)
(TTY.PROCESS NIL)
(SETQ LST (CONS (READ T)
(READLINE)))
(CLOSEW (TTYDISPLAYSTREAM OLDTTYDS))
(RETURN (CAR LST])
(READBRUSHSIZE
[LAMBDA (NOWSIZE) (* rrb " 3-Sep-85 16:14")
(PROG ((N (RNUMBER (COND
(NOWSIZE (CONCAT "Current size is " NOWSIZE ". Enter new brush size."))
(T "Enter new brush size."))
NIL NIL NIL T T)))
(RETURN (COND
((EQUAL N 0)
NIL)
(T N])
(READANGLE
[LAMBDA NIL (* rrb "31-May-85 15:41")
(* interacts to get whether a line size should be
increased or decreased.)
(PROG ((NEWVALUE (RNUMBER "Enter arc angle in degrees." NIL NIL NIL T)))
(RETURN (COND
((EQ NEWVALUE 0)
NIL)
(T NEWVALUE])
(READARCDIRECTION
[LAMBDA (MENUTITLE) (* rrb "31-May-85 17:25")
(* interacts to get whether an arc should go clockwise
or counterclockwise)
(MENU (create MENU
TITLE ←(OR MENUTITLE "Which way should the arc go?")
ITEMS ←(QUOTE (("Clockwise" (QUOTE CLOCKWISE)
"The arc will be drawn clockwise from the first point to the second point.")
("Counterclockwise" (QUOTE COUNTERCLOCKWISE)
"The arc will be drawn counterclockwise from the first point to the second point.")))
CENTERFLG ← T])
(SK.ADD.ELEMENT
[LAMBDA (GELT SKETCHW DONTCLEARCURSOR GROUPFLG) (* rrb "30-Jul-85 16:10")
(* adds a new element to a sketch window and handles
propagation to all other figure windows)
(COND
(GELT (PROG ((SKETCH (SKETCH.FROM.VIEWER SKETCHW))
ADDEDELT) (* take down the caret.)
(OR DONTCLEARCURSOR (SKED.CLEAR.SELECTION SKETCHW))
(* add the element to the sketch.)
(ADD.ELEMENT.TO.SKETCH GELT SKETCH) (* do the window that the interaction occurred in
first.)
(SETQ ADDEDELT (SKETCH.ADD.AND.DISPLAY1 GELT SKETCHW (SCALE.FROM.SKW SKETCHW)
GROUPFLG))
(* propagate to other windows.)
(for SKW in (ALL.SKETCH.VIEWERS SKETCH) when (AND (NEQ SKW SKETCHW)
(ELT.INSIDE.SKETCHWP GELT SKW))
do (SKETCH.ADD.AND.DISPLAY1 GELT SKW GROUPFLG))
(RETURN ADDEDELT])
(SK.APPLY.MENU.COMMAND
[LAMBDA (COMMAND SKETCHW) (* rrb " 3-Jan-85 13:17")
(* calls the function appropriate for the item selected
from the command menu associated with a figure window.)
(* This is a separate function so it can be called by
both pop up and fixed menu operations.)
(COND
((NULL COMMAND)
NIL)
((type? SKETCHTYPE COMMAND) (* if the selected item is an element type, add an
instance.)
(SKETCHW.ADD.INSTANCE COMMAND SKETCHW))
[(LISTP COMMAND) (* EVAL it)
(EVAL (APPEND COMMAND (CONS (KWOTE SKETCHW]
(T (APPLY* COMMAND SKETCHW])
(SK.DELETE.ELEMENT1
[LAMBDA (OLDGELT SKETCHW GROUPFLG) (* rrb "30-Jul-85 15:38")
(* deletes an element to a sketch window and handles
propagation to all other figure windows)
(* GROUPFLG indicates that this is part of a group
operation and hence display and image object deleted
fns don't need to be called.)
(PROG ((SKETCH (SKETCH.FROM.VIEWER SKETCHW))
LOCALELT) (* delete the element to the sketch.)
(OR (REMOVE.ELEMENT.FROM.SKETCH OLDGELT SKETCH)
(RETURN NIL)) (* do the window that the interaction occurred in
first.)
(SK.ERASE.AND.DELETE.ITEM (SK.LOCAL.ELT.FROM.GLOBALPART OLDGELT SKETCHW)
SKETCHW GROUPFLG) (* propagate to other windows.)
(for SKW in (ALL.SKETCH.VIEWERS SKETCH) when (AND (NEQ SKW SKETCHW)
(SETQ LOCALELT (
SK.LOCAL.ELT.FROM.GLOBALPART OLDGELT
SKW)))
do (SK.ERASE.AND.DELETE.ITEM LOCALELT SKW GROUPFLG))
(OR GROUPFLG (SK.CHECK.WHENDELETEDFN OLDGELT SKETCHW))
(RETURN OLDGELT])
(SK.MARK.DIRTY
[LAMBDA (SKETCH) (* rrb "27-Nov-84 12:28")
(* marks a sketch as having been changed.
Puts a flag on its viewers.)
(for SKW in (ALL.SKETCH.VIEWERS SKETCH) do (WINDOWPROP SKW (QUOTE SKETCHCHANGED)
T])
(SK.MARK.UNDIRTY
[LAMBDA (SKETCH) (* rrb "29-Nov-84 18:03")
(* marks a sketch as having been changed.
Puts a flag on its viewers.)
(for SKW in (ALL.SKETCH.VIEWERS SKETCH) do (WINDOWPROP SKW (QUOTE SKETCHCHANGED)
(QUOTE OLD])
(SK.MENU.AND.RETURN.FIELD
[LAMBDA (ELEMENTTYPE) (* rrb "11-May-84 16:03")
(* returns a field list of the field to be changed.)
(PROG ((ITEMS (CHANGEABLEFIELDITEMS ELEMENTTYPE)))
(RETURN (COND
((NULL ITEMS)
NIL)
[(NULL (CDR ITEMS))
(EVAL (CADR (CAR ITEMS]
(T (MENU (create MENU
ITEMS ← ITEMS
CENTERFLG ← T
TITLE ← "Choose which property to change"])
(SK.SCALE.POSITION.INTO.VIEWER
[LAMBDA (POS SCALE) (* rrb "29-Jan-85 14:51")
(* scales a position into window coordinates from
global coordinates.)
(create POSITION
XCOORD ←(FIXR (QUOTIENT (fetch (POSITION XCOORD) of POS)
SCALE))
YCOORD ←(FIXR (QUOTIENT (fetch (POSITION YCOORD) of POS)
SCALE])
(SKETCH.SET.BRUSH.SHAPE
[LAMBDA (W) (* rrb "11-Dec-84 15:31")
(* Sets the shape of the current brush)
(PROG [(NEWSHAPE (PAINTW.READBRUSHSHAPE))
(NOWBRUSH (fetch (SKETCHCONTEXT SKETCHBRUSH) of (WINDOWPROP W (QUOTE SKETCHCONTEXT]
(RETURN (AND NEWSHAPE (replace (SKETCHCONTEXT SKETCHBRUSH) of (WINDOWPROP W (QUOTE
SKETCHCONTEXT))
with (create BRUSH using NOWBRUSH BRUSHSHAPE ← NEWSHAPE])
(SKETCH.SET.BRUSH.SIZE
[LAMBDA (W) (* rrb "12-Jan-85 10:13")
(* sets the size of the current brush)
(SK.SET.DEFAULT.BRUSH.SIZE [READBRUSHSIZE (fetch (BRUSH BRUSHSIZE)
of (fetch (SKETCHCONTEXT SKETCHBRUSH)
of (WINDOWPROP W (QUOTE SKETCHCONTEXT]
W])
(SKETCHW.CLOSEFN
[LAMBDA (SKW) (* rrb "25-Jun-85 12:52")
(* close function for a viewer.
Removes itself from the list of viewers.)
(PROG NIL
[COND
[(WINDOWPROP SKW (QUOTE DOCUMENTINFO)) (* this window came from a tedit document.)
(COND
((WINDOWPROP SKW (QUOTE SKETCHCHANGED))
(COND
((EQ (UPDATE.IMAGE.IN.DOCUMENT SKW)
(QUOTE DON'T))
(RETURN (QUOTE DON'T]
((AND (NOT (WINDOWPROP SKW (QUOTE DONTQUERYCHANGES)))
(EQ (WINDOWPROP SKW (QUOTE SKETCHCHANGED))
T)) (* ask if user really wants to close)
(STATUSPRINT SKW "
")
(COND
((MOUSECONFIRM "unsaved changes ... press LEFT to close anyway" T (GETPROMPTWINDOW
SKW)) (* close the prompt window which MOUSECONFIRM brought
up.)
(CLOSEPROMPTWINDOW SKW))
(T (RETURN (QUOTE DON'T]
(REMOVE.SKETCH.VIEWER (WINDOWPROP SKW (QUOTE SKETCH))
SKW) (* kill the process that supports the typing.)
(DEL.PROCESS (WINDOWPROP SKW (QUOTE PROCESS)
NIL))
(WINDOWADDPROP SKW (QUOTE OPENFN)
(QUOTE SKETCHW.REOPENFN])
(SKETCHW.OUTFN
[LAMBDA (SKW) (* rrb "24-Jan-85 10:06")
(* the cursor is leaving the window, updates any
structures that may be spread out for efficiency.)
NIL])
(SKETCHW.REOPENFN
[LAMBDA (SKW) (* rrb " 7-Feb-84 11:31")
(* reopenfn for viewers. Adds it back onto the list of
global viewers.)
(ADD.SKETCH.VIEWER (WINDOWPROP SKW (QUOTE SKETCH))
SKW)
(WINDOWPROP SKW (QUOTE PROCESS)
(ADD.PROCESS (LIST (FUNCTION WB.EDITOR)
(KWOTE SKW])
(MAKE.LOCAL.SKETCH
[LAMBDA (SKETCH SKETCHREGION SCALE STREAM EVERYTHINGFLG) (* rrb "22-Apr-85 16:45")
(* * calculate the local parts for the region of the sketch at a given scale. EVERYTHINGFLG provides a way to
override the inside check. This is necessary because the inside check works on local elements.
When the inside check is change to work on global elements, this can be removed.)
(for SKELT in (fetch (SKETCH SKETCHELTS) of (INSURE.SKETCH SKETCH))
when (OR EVERYTHINGFLG (SK.INSIDE.REGION SKELT SKETCHREGION)) collect (SK.LOCAL.FROM.GLOBAL
SKELT STREAM SCALE])
(MAP.SKETCHSPEC.INTO.VIEWER
[LAMBDA (SKETCH SKW) (* rrb "12-May-85 17:02")
(* creates the local parts of a sketch and puts it onto
the viewer.)
(PROG ((SKREGION (WINDOWPROP SKW (QUOTE REGION.VIEWED)))
SPECS) (* local specs are kept as a TCONC cell so that
additions to the end are fast.)
(RETURN (WINDOWPROP SKW (QUOTE SKETCHSPECS)
(CONS [SETQ SPECS (CONS (fetch (SKETCH SKETCHNAME) of SKETCH)
(for SKELT in (fetch (SKETCH SKETCHELTS)
of SKETCH)
when (SK.INSIDE.REGION SKELT SKREGION)
collect (SK.LOCAL.FROM.GLOBAL SKELT SKW]
(LAST SPECS])
(SKETCHW.REPAINTFN
[LAMBDA (W REG STOPIFMOUSEDOWN NEWGRIDFLG) (* rrb " 3-Sep-85 16:01")
(* redisplays the sketch in a window)
(* for now ignore the region.)
(* if STOPIFMOUSEDOWN is T, it displays some but stops
if the button left or middle button is still down and
returns STOPPED)
(DSPOPERATION (QUOTE PAINT)
W)
(DSPRIGHTMARGIN 65000 W) (* I don't know exactly how scrolling ever gets turned
on but it has.)
(DSPSCROLL (QUOTE OFF)
W)
(PROG1 (SKETCHW.REPAINTFN1 W REG (AND STOPIFMOUSEDOWN (SETUPTIMER AUTOZOOM.REPAINT.TIME))
NEWGRIDFLG)
(SKED.SELECTION.FEEDBACK W])
(SKETCHW.REPAINTFN1
[LAMBDA (SKW REGION TIMER NEWGRIDFLG) (* rrb " 3-Sep-85 16:00")
(* Draws all of the local elements in the sketch window SKW. internal function to SKETCHW.REPAINTFN This entry is
provided so that SK.DRAWFIGURE.IF can RETFROM it if the timer has expired and a button is down.)
(MAPSKETCHSPECS (LOCALSPECS.FROM.VIEWER SKW)
(COND
(TIMER (* call a version of SK.DRAWFIGURE that checks the
time.)
(FUNCTION SK.DRAWFIGURE.IF))
(T (FUNCTION SK.DRAWFIGURE)))
SKW REGION (WINDOW.SCALE SKW))
(COND
((WINDOWPROP SKW (QUOTE GRIDUP)) (* if grid is up, redisplay it)
(SK.DISPLAY.GRID.POINTS SKW NEWGRIDFLG])
(SK.DRAWFIGURE.IF
[LAMBDA (SCREENELT STREAM REGION SCALE) (* rrb "22-Jan-85 11:34")
(* draws an element of a sketch in a window. If the free variable TIMER has expired and a button is down, it
RETFROMs the repainting function.)
(PROG1 (SK.DRAWFIGURE SCREENELT STREAM REGION SCALE)
(AND TIMER (MOUSESTATE (OR LEFT MIDDLE))
(TIMEREXPIRED? TIMER)
(RETFROM (QUOTE SKETCHW.REPAINTFN1)
(QUOTE STOPPED])
(SKETCHW.SCROLLFN
[LAMBDA (SKW XDELTA YDELTA CONTINUOUSFLG) (* rrb "29-Aug-85 19:13")
(* scroll function for a sketch window. It must check to see which elements need to get added and deleted from the
ones currently viewed as a result of the scrolling. Also if an element gets added, the clipping region must be
expanded because part of the display of the object may be in the already visible part of the window.)
(PROG ([SKETCH (fetch (SKETCH SKETCHELTS) of (INSURE.SKETCH (SKETCH.FROM.VIEWER SKW]
(NOWREG (DSPCLIPPINGREGION NIL SKW))
NEWREGION NEWLOCALREGION INNEW? NEWONES LOCALELT SCALE)
(* clear the caret.)
(SKED.CLEAR.SELECTION SKW)
[COND
(CONTINUOUSFLG (* set XDELTA and YDELTA for continuous scrolling)
[COND
((AND XDELTA (NEQ XDELTA 0))
(COND
((IGREATERP XDELTA 0)
(SETQ XDELTA 12))
(T (SETQ XDELTA -12]
(COND
((AND YDELTA (NEQ YDELTA 0))
(COND
((IGREATERP YDELTA 0)
(SETQ YDELTA 12))
(T (SETQ YDELTA -12]
[SETQ NEWREGION (UNSCALE.REGION (SETQ NEWLOCALREGION (CREATEREGION
(DIFFERENCE (fetch (REGION LEFT) of NOWREG)
(COND
(XDELTA)
(0)))
(DIFFERENCE (fetch (REGION BOTTOM) of NOWREG)
(COND
(YDELTA)
(0)))
(fetch (REGION WIDTH) of NOWREG)
(fetch (REGION HEIGHT) of NOWREG)))
(SETQ SCALE (WINDOW.SCALE SKW]
(* update the current image to contain the things that
will be there after the scroll, then scroll.)
[for GELT in SKETCH
do (SETQ INNEW? (SK.INSIDE.REGION GELT NEWREGION))
(COND
[(SETQ LOCALELT (SK.LOCAL.ELT.FROM.GLOBALPART GELT SKW))
(* if it is not supposed to be in the new region,
remove it.)
(OR INNEW? (COND
((REGIONSINTERSECTP NEWLOCALREGION (SK.ITEM.REGION LOCALELT))
(* part of image may overlap the part of sketch that is
still showing)
(SK.ERASE.AND.DELETE.ITEM LOCALELT SKW))
(T (SK.DELETE.ITEM LOCALELT SKW]
(INNEW? (* just came in)
(SETQ NEWONES (CONS GELT NEWONES]
(SCROLLBYREPAINTFN SKW XDELTA YDELTA)
(SKETCHW.FIG.CHANGED SKW)
(SK.UPDATE.REGION.VIEWED SKW)
(for GELT in NEWONES do (SKETCH.ADD.AND.DISPLAY1 GELT SKW SCALE])
(SKETCHW.SELECTIONFN
[LAMBDA (ITEM MENU) (* rrb "24-Jan-85 10:15")
(* calls the function appropriate for the item selected
from the command menu associated with a figure window.)
(PROG ((SKW (WINDOWPROP (WFROMMENU MENU)
(QUOTE MAINWINDOW)))
PROMPTW) (* clear the prompt window if there is one.)
(CLOSEPROMPTWINDOW SKW) (* reset the line being drawn if there is one.)
(RESET.LINE.BEING.INPUT SKW)
(RETURN (SK.APPLY.MENU.COMMAND (CADR ITEM)
SKW])
(SK.UPDATE.EVENT.SELECTION
[LAMBDA (HOTSPOTCACHE X1 Y1 X2 Y2 SCALE WINDOW COPYMODE DELETEMODE)
(* rrb "31-Jan-85 11:35")
(* * internal function to SK.COPY.BUTTONEVENTFN that determines the elements within the given bounds and selects or
deselects them.)
(PROG (SELITEMS)
(RETURN (COND
((LASTMOUSESTATE UP) (* don't do anything with button up.)
NIL)
((SETQ SELITEMS (SK.LOCAL.ITEMS.IN.REGION HOTSPOTCACHE (MIN X1 X2)
(MIN Y1 Y2)
(MAX X1 X2)
(MAX Y1 Y2)))
(* OLD CODE (SETQ SELITEMS (SK.LOCAL.ITEMS.IN.REGION
HOTSPOTCACHE (REGION.FROM.COORDINATES X1 Y1 X2 Y2)
SCALE)))
(COND
[(LASTMOUSESTATE (OR (ONLY LEFT)
(ONLY MIDDLE)))
(* left or middle only selects.)
(for SELITEM in SELITEMS do (SK.ADD.SELECTION SELITEM WINDOW
(SK.BUTTONEVENT.MARK COPYMODE
DELETEMODE]
(T (* anything but left only should cause deselect.)
(for SELITEM in SELITEMS do (SK.REMOVE.SELECTION SELITEM WINDOW
(SK.BUTTONEVENT.MARK
COPYMODE DELETEMODE])
(LIGHTGRAYWINDOW
[LAMBDA (WINDOW) (* rrb "28-Jun-84 10:27")
(DSPFILL NIL 1 (QUOTE INVERT)
WINDOW)
WINDOW])
(SK.ADD.SPACES
[LAMBDA (STRLST) (* rrb "19-Jul-85 15:11")
(* adds eols between the elements of STRLST)
(for STR in STRLST join (COND
((EQUAL STR "")
NIL)
((EQ (NTHCHARCODE STR -1)
(CHARCODE EOL)) (* if it already ends in CR, don't add one.)
(LIST STR))
(T (LIST STR "
"])
(SK.SKETCH.MENU
[LAMBDA (SKW) (* rrb "12-Sep-85 11:50")
(* brings up the normal sketch command menu.)
(SK.MIDDLE.TITLEFN SKW T])
(SK.CHECK.WHENDELETEDFN
[LAMBDA (GELT SKETCHW) (* rrb "30-Jul-85 15:35")
(* check to see if a when deleted function needs to be
applied and applies it.)
(SELECTQ (fetch (GLOBALPART GTYPE) of GELT)
(SKIMAGEOBJ (* deleting an image object apply WHENDELETEDFN)
(SK.APPLY.WHENDELETEDFN GELT SKETCHW))
(GROUP (for GELT in (fetch (GROUP LISTOFGLOBALELTS) of GELT) do (SK.CHECK.WHENDELETEDFN
GELT SKETCHW)))
NIL])
(SK.APPLY.WHENDELETEDFN
[LAMBDA (GELT SKETCHW) (* rrb "30-Jul-85 15:35")
(* applies the when deleted function for an image
object.)
(PROG (IMAGEOBJ FN)
(COND
((AND (SETQ FN (IMAGEOBJPROP (SETQ IMAGEOBJ (fetch (SKIMAGEOBJ SKIMAGEOBJ)
of (fetch (GLOBALPART INDIVIDUALGLOBALPART)
of GELT)))
(QUOTE WHENDELETEDFN)))
(NEQ FN (QUOTE NILL))) (* documentation calls for passing text streams as well
but there aren't any.)
(APPLY* FN IMAGEOBJ SKETCHW])
(SK.RETURN.TTY
[LAMBDA (W) (* rrb "29-Aug-85 11:09")
(* gives up the tty when the window is shrunken.)
(AND (TTY.PROCESSP (WINDOWPROP W (QUOTE PROCESS)))
(TTY.PROCESS T])
(SK.TAKE.TTY
[LAMBDA (W) (* rrb "29-Aug-85 11:10")
(* takes the tty when the window is expanded)
(TTY.PROCESS (WINDOWPROP W (QUOTE PROCESS])
)
(* fns for dealing with sketch structures)
(DEFINEQ
(SKETCH.CREATE
[LAMBDA ARGS (* rrb "12-Jul-85 17:12")
(PROG [(SKETCH (create SKETCH
SKETCHNAME ←(AND (GREATERP ARGS 0)
(ARG ARGS 1]
(PUTSKETCHPROP SKETCH (QUOTE SKETCHCONTEXT)
(CREATE.DEFAULT.SKETCH.CONTEXT)) (* pick out the props that are context,)
[COND
((GREATERP ARGS 1)
(for I from 2 to ARGS by 2 do (PUTSKETCHPROP SKETCH (ARG ARGS I)
(ARG ARGS (ADD1 I]
(RETURN SKETCH])
(GETSKETCHPROP
[LAMBDA (SKETCH PROPERTY) (* rrb "12-Jul-85 17:33")
(* retrieves the property of a sketch)
(PROG [(SKETCHCONTEXT (LISTGET (fetch (SKETCH SKETCHPROPS) of SKETCH)
(QUOTE SKETCHCONTEXT]
(RETURN (SELECTQ PROPERTY
(BRUSH (fetch (SKETCHCONTEXT SKETCHBRUSH) of SKETCHCONTEXT))
(SHAPE (fetch (BRUSH BRUSHSHAPE) of (fetch (SKETCHCONTEXT SKETCHBRUSH)
of SKETCHCONTEXT)))
(SIZE (fetch (BRUSH BRUSHSIZE) of (fetch (SKETCHCONTEXT SKETCHBRUSH)
of SKETCHCONTEXT)))
(COLOR (fetch (BRUSH BRUSHCOLOR) of (fetch (SKETCHCONTEXT SKETCHBRUSH)
of SKETCHCONTEXT)))
(FONT (fetch (SKETCHCONTEXT SKETCHFONT) of SKETCHCONTEXT))
(TEXTALIGNMENT (fetch (SKETCHCONTEXT SKETCHTEXTALIGNMENT) of SKETCHCONTEXT)
)
(ARROWHEAD (fetch (SKETCHCONTEXT SKETCHARROWHEAD) of SKETCHCONTEXT))
(DASHING (fetch (SKETCHCONTEXT SKETCHDASHING) of SKETCHCONTEXT))
(USEARROWHEAD (fetch (SKETCHCONTEXT SKETCHUSEARROWHEAD) of SKETCHCONTEXT))
(TEXTBOXALIGNMENT (fetch (SKETCHCONTEXT SKETCHTEXTBOXALIGNMENT)
of SKETCHCONTEXT))
(TEXTURE (fetch (SKFILLING FILLING.COLOR) of (fetch (SKETCHCONTEXT
SKETCHFILLING)
of SKETCHCONTEXT)))
((FILLINGCOLOR BACKCOLOR)
(fetch (SKFILLING FILLING.TEXTURE) of (fetch (SKETCHCONTEXT
SKETCHFILLING)
of SKETCHCONTEXT)))
(LINEMODE (fetch (SKETCHCONTEXT SKETCHLINEMODE) of SKETCHCONTEXT))
(ARCDIRECTION (fetch (SKETCHCONTEXT SKETCHARCDIRECTION) of SKETCHCONTEXT))
(MOVEMODE (fetch (SKETCHCONTEXT SKETCHMOVEMODE) of SKETCHCONTEXT))
(ELEMENTS (fetch (SKETCH SKETCHELTS) of SKETCH))
(NAME (fetch (SKETCH SKETCHNAME) of SKETCH))
(LISTGET (fetch (SKETCH SKETCHPROPS) of SKETCH)
PROPERTY])
(PUTSKETCHPROP
[LAMBDA (SKETCH PROPERTY VALUE) (* rrb "12-Jul-85 17:23")
(* stores a property on a sketch Returns VALUE.
Knows about the form of a sketch and does value
checking (or should.))
(PROG [(PLIST (fetch (SKETCH SKETCHPROPS) of SKETCH))
(SKETCHCONTEXT (LISTGET (fetch (SKETCH SKETCHPROPS) of SKETCH)
(QUOTE SKETCHCONTEXT]
[SELECTQ PROPERTY
(BRUSH (replace (SKETCHCONTEXT SKETCHBRUSH) of SKETCHCONTEXT with VALUE))
(SHAPE (replace (SKETCHCONTEXT SKETCHBRUSH) of SKETCHCONTEXT
with (create BRUSH using (fetch (SKETCHCONTEXT SKETCHBRUSH)
of SKETCHCONTEXT)
BRUSHSHAPE ← VALUE)))
(SIZE (replace (SKETCHCONTEXT SKETCHBRUSH) of SKETCHCONTEXT
with (create BRUSH using (fetch (SKETCHCONTEXT SKETCHBRUSH) of
SKETCHCONTEXT)
BRUSHSIZE ← VALUE)))
(COLOR (replace (SKETCHCONTEXT SKETCHBRUSH) of SKETCHCONTEXT
with (create BRUSH using (fetch (SKETCHCONTEXT SKETCHBRUSH)
of SKETCHCONTEXT)
BRUSHCOLOR ← VALUE)))
(FONT (replace (SKETCHCONTEXT SKETCHFONT) of SKETCHCONTEXT with VALUE))
(TEXTALIGNMENT (replace (SKETCHCONTEXT SKETCHTEXTALIGNMENT) of SKETCHCONTEXT
with VALUE))
(ARROWHEAD (replace (SKETCHCONTEXT SKETCHARROWHEAD) of SKETCHCONTEXT with VALUE))
(DASHING (replace (SKETCHCONTEXT SKETCHDASHING) of SKETCHCONTEXT with VALUE))
(USEARROWHEAD (replace (SKETCHCONTEXT SKETCHUSEARROWHEAD) of SKETCHCONTEXT
with VALUE))
(TEXTBOXALIGNMENT (replace (SKETCHCONTEXT SKETCHTEXTBOXALIGNMENT) of SKETCHCONTEXT
with VALUE))
(TEXTURE (replace (SKETCHCONTEXT SKETCHFILLING) of SKETCHCONTEXT
with (create SKFILLING using (fetch (SKETCHCONTEXT SKETCHFILLING)
of SKETCHCONTEXT)
FILLING.TEXTURE ← VALUE)))
((BACKCOLOR FILLINGCOLOR)
(replace (SKETCHCONTEXT SKETCHFILLING) of SKETCHCONTEXT
with (create SKFILLING using (fetch (SKETCHCONTEXT SKETCHFILLING)
of SKETCHCONTEXT)
FILLING.COLOR ← VALUE)))
(LINEMODE (replace (SKETCHCONTEXT SKETCHLINEMODE) of SKETCHCONTEXT with VALUE))
(ARCDIRECTION (replace (SKETCHCONTEXT SKETCHARCDIRECTION) of SKETCHCONTEXT
with VALUE))
(MOVEMODE (replace (SKETCHCONTEXT SKETCHMOVEMODE) of SKETCHCONTEXT with VALUE))
(ELEMENTS (replace (SKETCH SKETCHELTS) of SKETCH with VALUE))
(NAME (replace (SKETCH SKETCHNAME) of SKETCH with VALUE))
(COND
(PLIST (LISTPUT PLIST PROPERTY VALUE))
(T (replace (SKETCH SKETCHPROPS) of SKETCH with (LIST PROPERTY VALUE]
(RETURN VALUE])
(CREATE.DEFAULT.SKETCH.CONTEXT
[LAMBDA NIL (* rrb " 4-Sep-85 14:39")
(* returns a default sketch context)
(create SKETCHCONTEXT
SKETCHBRUSH ← SK.DEFAULT.BRUSH
SKETCHFONT ←[OR SK.DEFAULT.FONT (SK.FONT.LIST (DEFAULTFONT (QUOTE DISPLAY]
SKETCHTEXTALIGNMENT ← SK.DEFAULT.TEXT.ALIGNMENT
SKETCHARROWHEAD ← SK.DEFAULT.ARROWHEAD
SKETCHDASHING ← SK.DEFAULT.DASHING
SKETCHUSEARROWHEAD ← NIL
SKETCHTEXTBOXALIGNMENT ← SK.DEFAULT.TEXTBOX.ALIGNMENT
SKETCHFILLING ←(create SKFILLING
FILLING.TEXTURE ← SK.DEFAULT.TEXTURE
FILLING.COLOR ← SK.DEFAULT.BACKCOLOR)
SKETCHLINEMODE ← T
SKETCHINPUTSCALE ← 1.0])
)
(PUTPROPS SKETCH.CREATE ARGNAMES (NIL (NAME . DEFAULTS&VALUES) . U))
(* fns for implementing copy and delete functions under keyboard control.)
(DEFINEQ
(SK.COPY.BUTTONEVENTFN
[LAMBDA (WINDOW) (* rrb "14-Jun-85 13:38")
(* * handles the button event when a copy key and/or the delete is held down. allows the user to select a group of
the sketch elements from the sketch WINDOW. This is very similar to SK.SELECT.MULTIPLE.ITEMS)
(* the selection protocol is left to add, right to delete. Multiple clicking in the same place upscales for both
select and deselect. Sweeping will select or deselect all of the items in the swept out area.)
(COND
([AND (TTY.PROCESSP (WINDOWPROP WINDOW (QUOTE PROCESS)))
(OR (.MOVEKEYDOWNP.)
(AND (.COPYKEYDOWNP.)
(.DELETEKEYDOWNP.] (* this is going to be a move command.)
(SELECTQ (fetch (SKETCHCONTEXT SKETCHMOVEMODE) of (WINDOWPROP WINDOW (QUOTE SKETCHCONTEXT)))
(POINTS (SK.SEL.AND.MOVE.POINTS WINDOW))
(SK.SEL.AND.MOVE WINDOW)))
((LASTMOUSESTATE (NOT UP))
(PROG ((COPYMODE (OR (.COPYKEYDOWNP.)
(.MOVEKEYDOWNP.)))
[DELETEMODE (AND (TTY.PROCESSP (WINDOWPROP WINDOW (QUOTE PROCESS)))
(OR (.DELETEKEYDOWNP.)
(.MOVEKEYDOWNP.]
(HOTSPOTCACHE (SK.HOTSPOT.CACHE WINDOW))
(SCALE (WINDOW.SCALE WINDOW))
OLDX ORIGX NEWX NEWY OLDY ORIGY MOVEDMUCHFLG SELITEMS RETURNVAL PREVMOUSEBUTTONS NOW
MIDDLEONLYFLG)
(COND
((OR (NULL HOTSPOTCACHE)
(NOT (OR COPYMODE DELETEMODE))) (* no items or keys aren't still down, don't do
anything.)
(RETURN)))
(TOTOPW WINDOW)
(SK.PUT.MARKS.UP WINDOW HOTSPOTCACHE)
[STATUSPRINT WINDOW "
" "Select elements to " (COND
[COPYMODE (COND
(DELETEMODE (QUOTE MOVE))
(T (QUOTE COPY]
(DELETEMODE (QUOTE DELETE] (* no selections have been made at this point.)
STARTOVERLP
(GETMOUSESTATE)
(COND
((AND (LASTMOUSESTATE UP)
(SK.BUTTONEVENT.OVERP COPYMODE DELETEMODE))
(SK.TAKE.MARKS.DOWN WINDOW HOTSPOTCACHE)
(RETURN))) (* MIDDLEONLYFLG is used to note case of picking
characters out of a sketch.)
(SETQ MIDDLEONLYFLG (LASTMOUSESTATE (ONLY MIDDLE)))
SELECTLP
(GETMOUSESTATE)
(COND
((SK.BUTTONEVENT.OVERP COPYMODE DELETEMODE)
(* user let up copy key. Put sketch into input buffer.)
(SETQ RETURNVAL (WINDOWPROP WINDOW (QUOTE SKETCH.SELECTIONS)))
(GO EXIT))
([AND (LASTMOUSESTATE (NOT UP))
(OR (NOT (INSIDEP (WINDOWPROP WINDOW (QUOTE REGION))
LASTMOUSEX LASTMOUSEY))
(NOT (SK.BUTTONEVENT.SAME.KEYS COPYMODE DELETEMODE]
(* if a button is down, and either the keystate is different from entry or the cursor is out of the window, stop
this event.)
(SETQ RETURNVAL NIL)
(GO EXIT))) (* cursor is still inside or buttons are up, leave
sketch selected.)
(SETQ NEWY (LASTMOUSEY WINDOW))
(SETQ NEWX (LASTMOUSEX WINDOW))
(COND
((NEQ PREVMOUSEBUTTONS LASTMOUSEBUTTONS) (* a button has gone up or down, mark this as the
origin of a new box to sweep.)
(SETQ ORIGX NEWX)
(SETQ ORIGY NEWY)
(COND
[(AND (EQ PREVMOUSEBUTTONS 0)
(NULL MOVEDMUCHFLG)
NOW) (* user double clicked and an element was selected.)
(SETQ NOW)
(COND
[[OR (AND (LASTMOUSESTATE (ONLY LEFT))
(NOT (SETQ MIDDLEONLYFLG)))
(AND MIDDLEONLYFLG (LASTMOUSESTATE (ONLY MIDDLE]
(* select the whole document.)
(for SELITEM in (LOCALSPECS.FROM.VIEWER WINDOW)
do (SK.ADD.SELECTION SELITEM WINDOW (SK.BUTTONEVENT.MARK COPYMODE
DELETEMODE]
(T (* thing selected is a the whole sketch, clear
everything and start over.)
(for SELITEM in (LOCALSPECS.FROM.VIEWER WINDOW)
do (SK.REMOVE.SELECTION SELITEM WINDOW (SK.BUTTONEVENT.MARK COPYMODE
DELETEMODE)))
(* set PREVMOUSEBUTTONS to cause reinitialization.)
(SETQ PREVMOUSEBUTTONS)
(GO STARTOVERLP]
[(LASTMOUSESTATE (NOT UP))
(* add or delete the element if any that the point is in. This uses a different method which takes into account the
size of the selection knots which the area sweep doesn't.)
(COND
((SETQ NOW (IN.SKETCH.ELT? HOTSPOTCACHE
(create POSITION
XCOORD ← NEWX
YCOORD ← NEWY)))
(COND
([OR (AND (LASTMOUSESTATE (ONLY LEFT))
(NOT (SETQ MIDDLEONLYFLG)))
(AND MIDDLEONLYFLG (LASTMOUSESTATE (ONLY MIDDLE]
(* left or middle selects.)
(SK.ADD.SELECTION NOW WINDOW (SK.BUTTONEVENT.MARK COPYMODE DELETEMODE)))
((LASTMOUSESTATE RIGHT) (* right cause deselect.)
(SK.REMOVE.SELECTION NOW WINDOW (SK.BUTTONEVENT.MARK COPYMODE
DELETEMODE]
(T (SETQ MOVEDMUCHFLG)))
(SETQ PREVMOUSEBUTTONS LASTMOUSEBUTTONS))
((COND
(MOVEDMUCHFLG (OR (NEQ OLDX NEWX)
(NEQ OLDY NEWY)))
((OR (IGREATERP (IABS (IDIFFERENCE ORIGX NEWX))
SK.NO.MOVE.DISTANCE)
(IGREATERP (IABS (IDIFFERENCE ORIGY NEWY))
SK.NO.MOVE.DISTANCE)) (* make the first pick move further so that it is
easier to multiple click.)
(SETQ MOVEDMUCHFLG T))) (* cursor has moved more than the minimum amount since
last noticed.)
(* add or delete any with in the swept out area.)
(SK.UPDATE.EVENT.SELECTION HOTSPOTCACHE ORIGX ORIGY NEWX NEWY SCALE WINDOW COPYMODE
DELETEMODE)))
(SETQ OLDX NEWX)
(SETQ OLDY NEWY)
(GO SELECTLP)
EXIT (* clear the selections from the window.)
(for SEL in (WINDOWPROP WINDOW (QUOTE SKETCH.SELECTIONS))
do (SK.REMOVE.SELECTION SEL WINDOW (SK.BUTTONEVENT.MARK COPYMODE DELETEMODE)))
(SK.TAKE.MARKS.DOWN WINDOW HOTSPOTCACHE)
(CLOSEPROMPTWINDOW WINDOW) (* if middle was the only button used to select, return
only the text characters.)
(RETURN (AND RETURNVAL (COND
[(TTY.PROCESSP (WINDOWPROP WINDOW (QUOTE PROCESS)))
(* the results will be going to this same window)
(COND
((AND COPYMODE DELETEMODE)
(* move the elements)
(SK.MOVE.ELEMENTS RETURNVAL WINDOW))
[COPYMODE (* copy them)
(COND
(MIDDLEONLYFLG
(* if middle only, just get the characters.)
(COPYINSERT (SK.BUILD.IMAGEOBJ RETURNVAL
WINDOW T)))
(T (SK.COPY.ELEMENTS RETURNVAL WINDOW]
(DELETEMODE (* delete them)
(SK.DELETE.ELEMENT RETURNVAL WINDOW]
(T (COPYINSERT (SK.BUILD.IMAGEOBJ RETURNVAL WINDOW MIDDLEONLYFLG])
(SK.BUTTONEVENT.MARK
[LAMBDA (COPYFLG DELETEFLG) (* rrb "29-Dec-84 19:02")
(* returns the mark that should be put on the points
when they are selected.)
(COND
(DELETEFLG (COND
(COPYFLG MOVESELECTIONMARK)
(T DELETESELECTIONMARK)))
(T COPYSELECTIONMARK])
(SK.BUILD.IMAGEOBJ
[LAMBDA (SCRELTS SKW CHARSONLYFLG) (* rrb "19-Jul-85 15:25")
(* 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)))
NIL] (* 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))
(GREATERP (fetch (POSITION XCOORD) of A)
(fetch (POSITION XCOORD) of B]
(RETURN (BUTLAST (for TEXTELT in TEXTELTS
join (SK.ADD.SPACES (fetch (TEXT LISTOFCHARACTERS)
of (CADR TEXTELT]
(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 ←(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.ELEMENTS SCRELTS (WINDOW.SCALE SKW))
(WINDOW.SCALE SKW)
(SK.GRIDFACTOR SKW])
(SK.BUTTONEVENT.OVERP
[LAMBDA (COPYMODE DELETEMODE) (* rrb " 1-Feb-85 18:39")
(* determines if this button event is over by looking at the keys that are held down. COPYMODE and DELETEMODE
indicate the keystate at the entry point.)
(COND
[DELETEMODE (AND (NOT (OR (.DELETEKEYDOWNP.)
(.MOVEKEYDOWNP.)))
(OR (NULL COPYMODE)
(NULL (OR (.COPYKEYDOWNP.)
(.MOVEKEYDOWNP.]
(COPYMODE (NULL (.COPYKEYDOWNP.])
(SK.BUTTONEVENT.SAME.KEYS
[LAMBDA (COPYMODE DELETEMODE) (* rrb " 1-Feb-85 18:39")
(* determines if the same keys are held down now as were held down at the start. If not, the event will be stopped.
COPYMODE and DELETEMODE indicate the keystate at the entry point.)
(COND
[DELETEMODE (AND (OR (.DELETEKEYDOWNP.)
(.MOVEKEYDOWNP.))
(EQ COPYMODE (OR (.COPYKEYDOWNP.)
(.MOVEKEYDOWNP.]
(COPYMODE (* if we are not in delete mode, ignore the state of
the delete key.)
(.COPYKEYDOWNP.])
)
(DECLARE: EVAL@COMPILE
[PUTPROPS .DELETEKEYDOWNP. MACRO (NIL (OR (KEYDOWNP (QUOTE CTRL))
(KEYDOWNP (QUOTE DELETE]
[PUTPROPS .MOVEKEYDOWNP. MACRO (NIL (KEYDOWNP (QUOTE MOVE]
)
(* functions for changing elements.)
(DEFINEQ
(SK.SEL.AND.CHANGE
[LAMBDA (W) (* rrb "29-Dec-84 18:10")
(* allows the user to select some elements and changes
them.)
(SK.CHANGE.THING (SK.SELECT.MULTIPLE.ITEMS W T)
W])
(SK.CHANGE.ELT
[LAMBDA (W) (* edited: " 1-Feb-84 08:46")
(EVAL.AS.PROCESS (LIST (QUOTE SK.SEL.AND.CHANGE)
W])
(SK.CHANGE.THING
[LAMBDA (ELTSTOCHANGE W) (* rrb " 6-Jan-85 19:23")
(* ELTSTOCHANGE is a sketch element that was selected
for a CHANGE operation.)
(* Change according to the first one on the list)
(PROG (FIRSTTYPE READCHANGEFN) (* find the first thing that has a change function.)
(OR (for ELT in ELTSTOCHANGE when (AND [SETQ READCHANGEFN (SK.READCHANGEFN
(SETQ FIRSTTYPE (fetch (SCREENELT GTYPE)
of ELT]
(NEQ READCHANGEFN (QUOTE NILL)))
do (RETURN T))
(RETURN))
(RETURN (SK.APPLY.CHANGE.COMMAND (SK.CHANGEFN FIRSTTYPE)
(APPLY* READCHANGEFN W ELTSTOCHANGE)
ELTSTOCHANGE W])
(SK.CHANGEFN
[LAMBDA (ELEMENTTYPE) (* rrb "21-Jun-85 17:10")
(* returns the changefn for an element.
The only one that isnt SK.ELEMENTS.CHANGEFN is image
objects.)
(OR (fetch (SKETCHTYPE CHANGEFN) of (GETPROP ELEMENTTYPE (QUOTE SKETCHTYPE)))
(FUNCTION SK.DEFAULT.CHANGEFN])
(SK.READCHANGEFN
[LAMBDA (ELEMENTTYPE) (* rrb " 6-Jan-85 18:29")
(* used to be (OR & (FUNCTION SK.DEFAULT.CHANGEFN)) If this really isn't necessary, clean out SK.DEFAULT.CHANGEFN
and all the things only it calls. If it is necessary, update it to include a readchangefn.)
(fetch (SKETCHTYPE READCHANGEFN) of (GETPROP ELEMENTTYPE (QUOTE SKETCHTYPE])
(SK.DEFAULT.CHANGEFN
[LAMBDA (SCRNELT W FIELD) (* rrb "14-May-84 15:57")
(PROG ([FIELD (OR FIELD (SK.MENU.AND.RETURN.FIELD (fetch (SCREENELT GTYPE) of SCRNELT]
(INDVELT (fetch (SCREENELT INDIVIDUALGLOBALPART) of SCRNELT))
(NOSETVALUE "str")
CURRENTVAL NEWPROPVALUE FIELDNAME)
(COND
((NULL FIELD)
(STATUSPRINT W "That element doesn't have any changeable parts.")
(RETURN NIL)))
(SETQ CURRENTVAL (RECORDACCESS (SETQ FIELDNAME (COND
((LISTP FIELD)
(CAR FIELD))
(T FIELD)))
INDVELT
(RECLOOK (fetch (SCREENELT GTYPE) of SCRNELT))
(QUOTE FETCH)))
[COND
((LISTP FIELD) (* cadr is queryfunction which can do special input and
return value checking.)
(SETQ NEWPROPVALUE (APPLY* (CADR FIELD)
SCRNELT FIELD W NOSETVALUE)))
(T (* have NIL returned be no change.)
(SETQ NEWPROPVALUE (OR (READ.FUNCTION [CONCAT
"Enter new "
(MKSTRING FIELD)
" value. Current value is "
(MKSTRING (RECORDACCESS
FIELD INDVELT
(RECLOOK (fetch (SCREENELT GTYPE)
of SCRNELT))
(QUOTE FETCH]
W)
NOSETVALUE]
(OR (EQ NEWPROPVALUE NOSETVALUE)
(RECORDACCESS FIELDNAME INDVELT (RECLOOK (fetch (SCREENELT GTYPE) of SCRNELT))
(QUOTE REPLACE)
(EVAL NEWPROPVALUE)))
(RETURN (fetch (SCREENELT GLOBALPART) of SCRNELT])
(CHANGEABLEFIELDITEMS
[LAMBDA (ELEMENTTYPE) (* rrb "11-May-84 15:49")
(* returns the list of fields that element type allows to change. Each field should be of the form
(FIELDNAMELABEL (QUOTE (FIELDNAME QUERYFN)) "helpstring") -
QUERYFN should be a function of four args: the screen element being changed, the "field" returned from this
function, the window the sketch is being displayed in, and a value to be returned if no change should be made.)
(GETPROP ELEMENTTYPE (QUOTE CHANGEABLEFIELDITEMS])
(SK.SEL.AND.MAKE
[LAMBDA (CHANGECOMMAND W) (* rrb " 6-Jan-85 19:23")
(* lets the user select elements and applies the given
change command to them.)
(SK.APPLY.CHANGE.COMMAND (FUNCTION SK.ELEMENTS.CHANGEFN)
CHANGECOMMAND
(SK.SELECT.MULTIPLE.ITEMS W)
W])
(SK.APPLY.CHANGE.COMMAND
[LAMBDA (CHANGEFN COMMAND SCRELTS SKW) (* rrb " 6-Jan-85 19:23")
(* applies a change command to the relevant elements in
SCRELTS.)
(AND COMMAND (PROG (NEWGLOBALS CHANGES)
(COND
((SETQ NEWGLOBALS (APPLY* CHANGEFN SCRELTS SKW COMMAND))
(SK.UPDATE.ELEMENTS (SETQ CHANGES
(for NEWG in NEWGLOBALS as OLDG in SCRELTS
when NEWG collect (LIST (fetch (SCREENELT
GLOBALPART)
of OLDG)
NEWG)))
SKW)
(SK.ADD.HISTEVENT (QUOTE CHANGE)
CHANGES SKW)
(RETURN NEWGLOBALS])
(SK.ELEMENTS.CHANGEFN
[LAMBDA (SCRELTS SKW HOW) (* rrb " 9-Aug-85 16:45")
(* changefn for many of the sketch elements.
Maybe could be made the only changefn.)
(PROG (CHANGEASPECTFN (CHANGEHOW (CADR HOW)))
(OR (SETQ CHANGEASPECTFN (SELECTQ (CAR HOW)
(SIZE (FUNCTION SK.CHANGE.BRUSH.SIZE))
(SHAPE (FUNCTION SK.CHANGE.BRUSH.SHAPE))
(ARROW (FUNCTION SK.CHANGE.ARROWHEAD))
(FILLING (FUNCTION SK.CHANGE.FILLING))
(DASHING (FUNCTION SK.CHANGE.DASHING))
(ANGLE (FUNCTION SK.CHANGE.ANGLE))
(DIRECTION (FUNCTION SK.CHANGE.ARC.DIRECTION))
((TEXT NEWFONT SETSIZE SAME FAMILY&SIZE)
(SETQ CHANGEHOW HOW)
(FUNCTION SK.CHANGE.TEXT))
(BRUSHCOLOR (FUNCTION SK.CHANGE.BRUSH.COLOR))
(FILLINGCOLOR (FUNCTION SK.CHANGE.FILLING.COLOR))
NIL))
(RETURN))
(RETURN (bind GELT for SCRELT in SCRELTS
collect (SETQ GELT (fetch (SCREENELT GLOBALPART) of SCRELT))
(COND
((EQ (fetch (GLOBALPART GTYPE) of GELT)
(QUOTE GROUP)) (* handle a group by propagating it)
(SK.GROUP.CHANGEFN GELT CHANGEASPECTFN CHANGEHOW SKW))
(T (APPLY* CHANGEASPECTFN GELT CHANGEHOW SKW])
(SK.GROUP.CHANGEFN
[LAMBDA (GROUPELT CHANGEASPECTFN CHANGEHOW SKW) (* rrb "11-Jul-85 15:10")
(* maps a change function through all the elements of a
group and returns a new element if it takes on any of
them.)
(PROG ((OLDSUBELTS (fetch (GROUP LISTOFGLOBALELTS) of (fetch (GLOBALPART INDIVIDUALGLOBALPART)
of GROUPELT)))
NEWSUBELTS NEWELT CHANGEDFLG)
[SETQ NEWSUBELTS (for SUBELT in OLDSUBELTS collect (COND
([SETQ NEWELT
(COND
((EQ (fetch (GLOBALPART GTYPE)
of SUBELT)
(QUOTE GROUP))
(* handle a group by propagating it)
(SK.GROUP.CHANGEFN SUBELT
CHANGEASPECTFN
CHANGEHOW SKW)
)
(T (APPLY* CHANGEASPECTFN SUBELT
CHANGEHOW SKW]
(SETQ CHANGEDFLG T)
NEWELT]
(OR CHANGEDFLG (RETURN))
(SETQ NEWELT (for OLDSUBELT in OLDSUBELTS as NEWSUBELT in NEWSUBELTS
collect (OR NEWSUBELT OLDSUBELT)))
(RETURN (create GLOBALPART
COMMONGLOBALPART ←(fetch (GLOBALPART COMMONGLOBALPART) of GROUPELT)
INDIVIDUALGLOBALPART ←(create GROUP using (fetch (GLOBALPART
INDIVIDUALGLOBALPART)
of GROUPELT)
LISTOFGLOBALELTS ← NEWELT])
)
(* fns for adding elements)
(DEFINEQ
(ADD.ELEMENT.TO.SKETCH
[LAMBDA (GELT SKETCH) (* rrb "12-May-85 18:17")
(* changes the global sketch)
(PROG ((REALSKETCH (INSURE.SKETCH SKETCH)))
(TCONC (fetch (SKETCH SKETCHTCELL) of REALSKETCH)
GELT)
(SK.MARK.DIRTY REALSKETCH])
(ADD.SKETCH.VIEWER
[LAMBDA (SKETCH VIEWER) (* rrb " 8-APR-83 17:56")
(* adds VIEWER as a viewer of SKETCH.)
(PROG (VIEWERS)
(COND
((SETQ VIEWERS (ALL.SKETCH.VIEWERS SKETCH)) (* already has at least one viewer)
(OR (FMEMB VIEWER VIEWERS)
(NCONC1 VIEWERS VIEWER)))
(T (* doesn't have any viewers yet.)
(SETQ ALL.SKETCHES (CONS (LIST SKETCH VIEWER)
ALL.SKETCHES])
(REMOVE.SKETCH.VIEWER
[LAMBDA (SKETCH VIEWER) (* rrb "26-Apr-85 16:56")
(* removes VIEWER as a viewer of SKETCH.)
(PROG (VIEWERS)
(COND
((SETQ VIEWERS (VIEWER.BUCKET SKETCH)) (* remove it from the list.)
(COND
((NULL (CDR (DREMOVE VIEWER VIEWERS))) (* deleted the last viewer.)
(SETQ ALL.SKETCHES (REMOVE VIEWERS ALL.SKETCHES])
(ALL.SKETCH.VIEWERS
[LAMBDA (SKETCH) (* rrb " 8-APR-83 14:20")
(* returns the list of all active viewers of a sketch)
(CDR (VIEWER.BUCKET SKETCH])
(VIEWER.BUCKET
[LAMBDA (SKETCH) (* rrb " 8-APR-83 14:20")
(FASSOC SKETCH ALL.SKETCHES])
(ELT.INSIDE.REGION?
[LAMBDA (GLOBALPART WORLDREG) (* rrb " 4-AUG-83 14:51")
(* determines if any part of an element is inside the
region WORLDREG)
(APPLY* (SK.INSIDEFN (fetch (GLOBALPART GTYPE) of GLOBALPART))
GLOBALPART WORLDREG])
(ELT.INSIDE.SKWP
[LAMBDA (GLOBALPART SKETCHW) (* rrb "14-MAR-83 10:38")
(* determines if a global element is in the world
region of a map window.)
(ELT.INSIDE.REGION? GLOBALPART (SK.REGION.VIEWED SKETCHW])
(SCALE.FROM.SKW
[LAMBDA (WINDOW) (* rrb "11-MAR-83 11:52")
(* gets the scale of a sketch window.)
(WINDOWPROP WINDOW (QUOTE SCALE])
(SK.ADDELT.TO.WINDOW
[LAMBDA (PELT SKETCHW) (* rrb "12-May-85 16:47")
(* adds a picture element to a sketch window.
Returns the element that was added.)
(COND
(PELT (TCONC (WINDOWPROP SKETCHW (QUOTE SKETCHSPECS))
PELT)
[PROG ((CACHE (SK.HOTSPOT.CACHE SKETCHW)))
(COND
(CACHE (* if there is a cache, adding an element will change
it)
(SK.ADD.HOTSPOTS.TO.CACHE1 PELT CACHE))
(T (* if this is the first, must set the window property
too.)
(SK.SET.HOTSPOT.CACHE SKETCHW (SK.ADD.HOTSPOTS.TO.CACHE1 PELT CACHE]
PELT])
(SK.CALC.REGION.VIEWED
[LAMBDA (WINDOW SCALE) (* rrb "29-APR-83 08:37")
(* returns the region of the sketch visible in window.)
(UNSCALE.REGION (DSPCLIPPINGREGION NIL WINDOW)
SCALE])
(SK.DRAWFIGURE
[LAMBDA (SCREENELT STREAM REGION SCALE) (* rrb "30-Aug-84 14:31")
(* draws an element of a sketch in a window. Makes sure the scale of the current drawing is with in the limits of
the element. Returns SCREENELT)
(PROG (GLOBALPART)
[COND
([AND (NUMBERP SCALE)
(OR [LESSP SCALE (fetch (COMMONGLOBALPART MINSCALE) of (SETQ GLOBALPART
(fetch (SCREENELT
COMMONGLOBALPART)
of SCREENELT]
(GREATERP SCALE (fetch (COMMONGLOBALPART MAXSCALE) of GLOBALPART]
(* scale is out of bounds, don't draw it.)
NIL)
(T (SK.DRAWFIGURE1 SCREENELT STREAM (OR REGION (DSPCLIPPINGREGION NIL STREAM]
(RETURN SCREENELT])
(SK.DRAWFIGURE1
[LAMBDA (ELT SKW REGION) (* rrb "14-Sep-84 16:59")
(* displays a sketch element in a window)
(APPLY* (SK.DRAWFN (fetch (SCREENELT GTYPE) of ELT))
ELT SKW REGION])
(SK.LOCAL.FROM.GLOBAL
[LAMBDA (GELT SKSTREAM SCALE) (* rrb "18-Jan-85 16:58")
(* returns the element instance of the global element
GELT expanded into the window SKW.)
(* SKSTREAM can be deleted from call once TEXT.EXPANDFN
no longer needs to distinquish INTERPRESS stream from
windows.)
(APPLY* (SK.EXPANDFN (fetch (GLOBALPART GTYPE) of GELT))
GELT
(OR (NUMBERP SCALE)
(SKETCHW.SCALE SKSTREAM))
SKSTREAM])
(SK.REGION.VIEWED
[LAMBDA (SKETCHW) (* rrb "11-MAR-83 12:53")
(* returns the region in sketch coordinates of the area
visible in SKETCHW.)
(WINDOWPROP SKETCHW (QUOTE REGION.VIEWED])
(SK.UPDATE.REGION.VIEWED
[LAMBDA (SKW) (* rrb " 6-NOV-83 11:46")
(* updates the REGION.VIEWED property of a window.)
(WINDOWPROP SKW (QUOTE REGION.VIEWED)
(SK.CALC.REGION.VIEWED SKW (WINDOW.SCALE SKW])
(SKETCH.ADD.AND.DISPLAY
[LAMBDA (GELT SKETCHW DONTCLEARCURSOR) (* rrb "14-Nov-84 17:12")
(* adds a new element to a sketch window and handles
propagation to all other figure windows)
(COND
(GELT (SK.ADD.HISTEVENT (QUOTE ADD)
(LIST GELT)
SKETCHW)
(SK.ADD.ELEMENT GELT SKETCHW DONTCLEARCURSOR])
(SKETCH.ADD.AND.DISPLAY1
[LAMBDA (GELT SKETCHW SCALE NODISPLAYFLG) (* rrb "30-Jul-85 15:39")
(* displays a sketch element and adds it to the
window.)
(COND
(GELT (COND
(NODISPLAYFLG (SK.ADD.ITEM GELT SKETCHW))
(T (SK.DRAWFIGURE (SK.ADD.ITEM GELT SKETCHW)
SKETCHW NIL (OR SCALE (WINDOW.SCALE SKETCHW])
(SK.ADD.ITEM
[LAMBDA (GELT SKETCHW) (* rrb "10-APR-83 13:38")
(* adds a global element to a window.
Returns the local element that was actually added.)
(SK.ADDELT.TO.WINDOW (SK.LOCAL.FROM.GLOBAL GELT SKETCHW)
SKETCHW])
(SKETCHW.ADD.INSTANCE
[LAMBDA (TYPE SKW) (* rrb "14-Nov-84 17:08")
(* reads an instance of type TYPE from the user and
displays it in SKW.)
(PROG ((ELT (SK.INPUT TYPE SKW)))
(AND ELT (SKETCH.ADD.AND.DISPLAY ELT SKW))
(RETURN ELT])
)
(* fns for deleting things)
(DEFINEQ
(SK.SEL.AND.DELETE
[LAMBDA (W) (* rrb "29-Dec-84 18:12")
(* lets the user select elements and deletes them)
(SK.DELETE.ELEMENT (SK.SELECT.MULTIPLE.ITEMS W T)
W])
(SK.ERASE.AND.DELETE.ITEM
[LAMBDA (SELELT SKW NODISPLAYFLG) (* rrb "30-Jul-85 15:36")
(* removes a sketch element from a viewer.)
(COND
(SELELT (OR NODISPLAYFLG (SK.ERASE.ELT SELELT SKW))
(SK.DELETE.ITEM SELELT SKW])
(REMOVE.ELEMENT.FROM.SKETCH
[LAMBDA (GELT SKETCH INSIDEGROUPFLG) (* rrb "14-Aug-85 16:20")
(* changes the global sketch Returns the element or the group element containing the element if the element was
found in the sketch. If INSIDEGROUPFLG is T, it will go inside of groups.)
(PROG ((SKETCHDATA (INSURE.SKETCH SKETCH)))
(COND
((MEMB GELT (fetch (SKETCH SKETCHELTS) of SKETCHDATA))
(DELFROMTCONC (fetch (SKETCH SKETCHTCELL) of SKETCHDATA)
GELT)
(SK.MARK.DIRTY SKETCH)
(RETURN T))
[INSIDEGROUPFLG (RETURN (for ELT on (fetch (SKETCH SKETCHELTS) of SKETCHDATA)
do (* look inside groups)
(COND
((DELFROMGROUPELT GELT ELT)
(SK.MARK.DIRTY SKETCH)
(RETURN ELT]
(T (RETURN NIL])
(SK.DELETE.ELEMENT
[LAMBDA (ELTSTODEL SKETCHW) (* rrb " 7-Jan-85 19:23")
(* deletes a list of element to a sketch window and
handles propagation to all other figure windows)
(PROG (OLDGELTS) (* ELTSTODEL is a list of screen elements to delete.)
(OR ELTSTODEL (RETURN))
(SKED.CLEAR.SELECTION SKETCHW)
(SK.ADD.HISTEVENT (QUOTE DELETE)
(SETQ OLDGELTS (for SCRELT in ELTSTODEL collect (fetch (SCREENELT
GLOBALPART)
of SCRELT)))
SKETCHW)
(for GELT in OLDGELTS do (SK.DELETE.ELEMENT1 GELT SKETCHW))
(RETURN OLDGELTS])
(SK.ERASE.ELT
[LAMBDA (ELT WINDOW REGION) (* rrb "28-Jun-84 08:21")
(* erases a sketch element)
(DSPOPERATION (QUOTE ERASE)
WINDOW)
(SK.DRAWFIGURE ELT WINDOW REGION (SCALE.FROM.SKW WINDOW))
(DSPOPERATION (QUOTE PAINT)
WINDOW])
(SK.DELETE.ELT
[LAMBDA (W) (* rrb "18-MAR-83 13:16")
(* lets the user select an element and deletes it.)
(EVAL.AS.PROCESS (LIST (QUOTE SK.SEL.AND.DELETE)
W])
(SK.DELETE.ITEM
[LAMBDA (ELT SKETCHW) (* rrb "12-May-85 18:10")
(* deletes an element from a window)
(COND
(ELT (DELFROMTCONC (WINDOWPROP SKETCHW (QUOTE SKETCHSPECS))
ELT)
(SK.REMOVE.HOTSPOTS.FROM.CACHE1 ELT (SK.HOTSPOT.CACHE SKETCHW))
ELT])
(DELFROMTCONC
[LAMBDA (TCONCCELL ELEMENT) (* rrb "31-May-85 10:12")
(* deletes an element from a TCONC cell list.)
[COND
[(EQUAL ELEMENT (CAAR TCONCCELL)) (* first element)
(COND
((EQLENGTH (CAR TCONCCELL)
1) (* only one element)
(RPLACA TCONCCELL NIL)
(RPLACD TCONCCELL NIL))
(T (* remove first element.)
(RPLACA TCONCCELL (CDAR TCONCCELL]
((EQUAL ELEMENT (CADR TCONCCELL)) (* elt to delete is the last one on the list, do
special case.)
(for TAIL on (CAR TCONCCELL) when (EQ (CDR TAIL)
(CDR TCONCCELL))
do (* update the TCONC last entry)
(RPLACD TCONCCELL TAIL) (* remove the last element)
(RPLACD TAIL NIL)
(RETURN)))
(T (for TAIL on (CAR TCONCCELL) when (EQ ELEMENT (CADR TAIL))
do (RPLACD TAIL (CDDR TAIL))
(RETURN]
TCONCCELL])
)
(* fns for copying stuff)
(DEFINEQ
(SK.COPY.ELT
[LAMBDA (W) (* rrb "12-Sep-84 13:23")
(* lets the user select an element and copies it.)
(EVAL.AS.PROCESS (LIST (QUOTE SK.SEL.AND.COPY)
W])
(SK.SEL.AND.COPY
[LAMBDA (W) (* rrb "29-Dec-84 18:18")
(* lets the user select elements and copies them.)
(SK.COPY.ELEMENTS (SK.SELECT.MULTIPLE.ITEMS W T)
W])
(SK.COPY.ELEMENTS
[LAMBDA (SCRELTS SKW) (* rrb "19-Jul-85 13:10")
(* create a bitmap of the thing being moved and get its
new position. Then translate all the pieces.)
(AND SCRELTS (PROG ((FIGINFO (SK.FIGUREIMAGE SCRELTS (DSPCLIPPINGREGION NIL SKW)))
[FIRSTHOTSPOT (CAR (fetch (SCREENELT HOTSPOTS) of (CAR SCRELTS]
LOWLFT NEWPOS DELTAPOS NEWELTS)
(SETQ LOWLFT (fetch (SKFIGUREIMAGE SKFIGURE.LOWERLEFT) of FIGINFO))
(* move the image by the first hotspot of the first
element chosen. This will align the image on the grid
correctly.)
(COND
([SETQ NEWPOS (fetch (INPUTPT INPUT.POSITION)
of (GET.BITMAP.POSITION SKW (fetch (SKFIGUREIMAGE
SKFIGURE.BITMAP)
of FIGINFO)
(QUOTE PAINT)
"move the figure into place and press the left button."
(FIXR (DIFFERENCE
(fetch (POSITION XCOORD)
of LOWLFT)
(fetch (POSITION XCOORD)
of FIRSTHOTSPOT)))
(FIXR (DIFFERENCE
(fetch (POSITION YCOORD)
of LOWLFT)
(fetch (POSITION YCOORD)
of FIRSTHOTSPOT]
(CLRPROMPT))
(T (STATUSPRINT SKW "Position was outside the window. Copy not placed.")
(RETURN NIL)))
(SETQ NEWELTS (MAPCOLLECTSKETCHSPECS SCRELTS (FUNCTION SK.COPY.ITEM)
(SK.MAP.FROM.WINDOW.TO.NEAREST.GRID
(create POSITION
XCOORD ←(DIFFERENCE
(fetch (POSITION XCOORD)
of NEWPOS)
(fetch (POSITION XCOORD)
of FIRSTHOTSPOT))
YCOORD ←(DIFFERENCE
(fetch (POSITION YCOORD)
of NEWPOS)
(fetch (POSITION YCOORD)
of FIRSTHOTSPOT)))
(WINDOW.SCALE SKW))
SKW))
(* add new elements to history list.)
(SK.ADD.HISTEVENT (QUOTE COPY)
NEWELTS SKW])
(SK.COPY.ITEM
[LAMBDA (SELELT GLOBALDELTAPOS W) (* rrb " 8-May-85 17:23")
(* 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 (NEWGLOBAL (OLDGLOBAL (fetch (SCREENELT GLOBALPART) of SELELT)))
[COND
((EQ (fetch (GLOBALPART GTYPE) of OLDGLOBAL)
(QUOTE SKIMAGEOBJ)) (* copying an image obj. Calls its when copied fn.)
(SETQ OLDGLOBAL (SK.COPY.IMAGEOBJ OLDGLOBAL W T]
(COND
((SETQ NEWGLOBAL (SK.TRANSLATE.GLOBALPART OLDGLOBAL GLOBALDELTAPOS))
(SK.ADD.ELEMENT NEWGLOBAL W)
(RETURN NEWGLOBAL])
(SK.INSERT.SKETCH
[LAMBDA (W SKETCH REGION SCALE) (* rrb "19-Jul-85 13:11")
(* * inserts the sketch SKETCH into the sketch window W. Called by the copy insert function for sketch windows.)
(AND SKETCH (PROG (LOCALSCRELTS FIGINFO FIRSTHOTSPOT LOWLFT NEWPOS WINDOWSCALE NEWELTS)
(* map inserted elements into new coordinate space.)
[COND
([NOT (EQUAL SCALE (SETQ WINDOWSCALE (WINDOW.SCALE W]
(* change the scale of the sketch and the region.)
[SETQ SKETCH (create SKETCH using SKETCH SKETCHELTS ←(
SK.TRANSFORM.GLOBAL.ELEMENTS
(fetch (SKETCH SKETCHELTS)
of SKETCH)
(FUNCTION SCALE.POSITION)
(QUOTIENT SCALE WINDOWSCALE]
(SETQ REGION (SCALE.REGION REGION (QUOTIENT SCALE WINDOWSCALE]
(OR (SETQ LOCALSCRELTS (MAKE.LOCAL.SKETCH SKETCH REGION WINDOWSCALE W T))
(RETURN))
(SETQ FIGINFO (SK.FIGUREIMAGE LOCALSCRELTS REGION))
[SETQ FIRSTHOTSPOT (CAR (fetch (SCREENELT HOTSPOTS) of (CAR LOCALSCRELTS]
(SETQ LOWLFT (fetch (SKFIGUREIMAGE SKFIGURE.LOWERLEFT) of FIGINFO))
(* move the image by the first hotspot of the first
element chosen. This will align the image on the grid
correctly.)
(COND
([SETQ NEWPOS (fetch (INPUTPT INPUT.POSITION)
of (GET.BITMAP.POSITION W (fetch (SKFIGUREIMAGE
SKFIGURE.BITMAP)
of FIGINFO)
(QUOTE PAINT)
"move the figure into place and press the left button."
(IDIFFERENCE (fetch (POSITION XCOORD)
of LOWLFT)
(fetch (POSITION XCOORD)
of FIRSTHOTSPOT))
(IDIFFERENCE (fetch (POSITION YCOORD)
of LOWLFT)
(fetch (POSITION YCOORD)
of FIRSTHOTSPOT]
(CLRPROMPT))
(T (STATUSPRINT W "
" "Position was outside the window. Copy not placed.")
(RETURN NIL)))
(SETQ NEWELTS (MAPCOLLECTSKETCHSPECS LOCALSCRELTS (FUNCTION SK.COPY.ITEM)
(SK.MAP.FROM.WINDOW.TO.NEAREST.GRID
(create POSITION
XCOORD ←(IDIFFERENCE
(fetch (POSITION XCOORD)
of NEWPOS)
(fetch (POSITION XCOORD)
of FIRSTHOTSPOT))
YCOORD ←(IDIFFERENCE
(fetch (POSITION YCOORD)
of NEWPOS)
(fetch (POSITION YCOORD)
of FIRSTHOTSPOT)))
WINDOWSCALE)
W))
(SK.ADD.HISTEVENT (QUOTE COPY)
NEWELTS W])
)
(* fns for moving things.)
(DEFINEQ
(SK.MOVE.ELT
[LAMBDA (W) (* rrb "20-Feb-85 20:17")
(* lets the user select one or more elements and move
them.)
(EVAL.AS.PROCESS (LIST (QUOTE SK.SEL.AND.MOVE)
W])
(SK.MOVE.ELT.OR.PT
[LAMBDA (W) (* rrb "20-Feb-85 20:27")
(* lets the user select one or more elements and move
them.)
(EVAL.AS.PROCESS (LIST (QUOTE SK.SEL.AND.MOVE)
W T])
(SK.APPLY.DEFAULT.MOVE
[LAMBDA (W) (* rrb " 2-Jun-85 12:52")
(* applies the default move mode which can be either
points, elements or both.)
(SELECTQ (fetch (SKETCHCONTEXT SKETCHMOVEMODE) of (WINDOWPROP W (QUOTE SKETCHCONTEXT)))
(POINTS (SK.MOVE.POINTS W))
(ELEMENTS (SK.MOVE.ELT W))
(SK.MOVE.ELT.OR.PT W])
(SK.SEL.AND.MOVE
[LAMBDA (W PTFLG) (* rrb "20-Feb-85 20:27")
(* lets the user select either a control point or one
or more elements and move them.)
(SK.MOVE.ELEMENTS [COND
((EQ PTFLG (QUOTE ONLY))
(SK.SELECT.ITEM W NIL))
(T (SK.SELECT.MULTIPLE.ITEMS W (NULL PTFLG]
W])
(SK.MOVE.ELEMENTS
[LAMBDA (SCRELTS SKW) (* rrb " 3-Oct-85 14:16")
(SKED.CLEAR.SELECTION SKW)
(COND
((NULL SCRELTS))
[[OR (POSITIONP SCRELTS)
(AND (NULL (CDR SCRELTS))
(POSITIONP (CAR SCRELTS))
(SETQ SCRELTS (CAR SCRELTS] (* user selected a point, move just that point.)
(PROG ((SKETCHELT (IN.SKETCH.ELT? (SK.HOTSPOT.CACHE SKW)
SCRELTS))
OTHERHOTSPOTS NEWPOS)
(RETURN (COND
((NULL SKETCHELT)
NIL)
([NULL (SETQ OTHERHOTSPOTS (REMOVE SCRELTS (fetch (SCREENELT
HOTSPOTS)
of SKETCHELT]
(* only one control point, move it with the move
element function.)
(SK.MOVE.ELEMENTS (LIST SKETCHELT)
SKW))
(T (for PT in OTHERHOTSPOTS do (MARKPOINT PT SKW
OTHERCONTROLPOINTMARK))
(CURSORPOSITION SCRELTS SKW)
(SETQ NEWPOS (GETSKWPOSITION SKW))
(for PT in OTHERHOTSPOTS do (MARKPOINT PT SKW
OTHERCONTROLPOINTMARK))
(SK.MOVE.THING SCRELTS NEWPOS SKETCHELT SKW]
(T (* create a bitmap of the thing being moved and get
its new position. Then translate all the pieces.)
(PROG ((FIGINFO (SK.FIGUREIMAGE SCRELTS (DSPCLIPPINGREGION NIL SKW)))
[FIRSTHOTSPOT (CAR (fetch (SCREENELT HOTSPOTS) of (CAR SCRELTS]
NEWPOS LOWLFT IMAGEPOSX IMAGEPOSY IMAGEBM DELTAPOS NEWGLOBALS CHANGES)
(SETQ IMAGEBM (fetch (SKFIGUREIMAGE SKFIGURE.BITMAP) of FIGINFO))
(SETQ LOWLFT (fetch (SKFIGUREIMAGE SKFIGURE.LOWERLEFT) of FIGINFO))
(* move the image by the first hotspot of the first
element chosen. This will align the image on the grid
correctly.)
(SETQ IMAGEPOSX (fetch (POSITION XCOORD) of LOWLFT))
(SETQ IMAGEPOSY (fetch (POSITION YCOORD) of LOWLFT))
(* put the cursor on the hot spot)
(CURSORPOSITION FIRSTHOTSPOT SKW)
(COND
([NULL (ERSETQ (PROGN (SK.SHOW.FIG.FROM.INFO IMAGEBM IMAGEPOSX IMAGEPOSY
(QUOTE ERASE)
SKW)
(SETQ NEWPOS
(fetch (INPUTPT INPUT.POSITION)
of (GET.BITMAP.POSITION
SKW IMAGEBM (QUOTE PAINT)
"Move image to its new position."
(IDIFFERENCE IMAGEPOSX
(fetch (POSITION XCOORD)
of FIRSTHOTSPOT))
(IDIFFERENCE IMAGEPOSY
(fetch (POSITION YCOORD)
of FIRSTHOTSPOT]
(* error happened, repaint the image.)
(SK.SHOW.FIG.FROM.INFO IMAGEBM IMAGEPOSX IMAGEPOSY (QUOTE PAINT)
SKW)
(CLOSEPROMPTWINDOW SKW)
(ERROR!))
((NULL NEWPOS)
(SK.SHOW.FIG.FROM.INFO IMAGEBM IMAGEPOSX IMAGEPOSY (QUOTE PAINT)
SKW)
(STATUSPRINT SKW "Position was outside the window, copy not placed.")
(RETURN NIL))) (* GET.BITMAP.POSITION returns the position that the
cursor was in which is the position of the first
hotspot.)
[SETQ DELTAPOS (create POSITION
XCOORD ←(IDIFFERENCE (fetch (POSITION XCOORD)
of NEWPOS)
(fetch (POSITION XCOORD)
of FIRSTHOTSPOT))
YCOORD ←(IDIFFERENCE (fetch (POSITION YCOORD)
of NEWPOS)
(fetch (POSITION YCOORD)
of FIRSTHOTSPOT]
(SETQ NEWGLOBALS (MAPCOLLECTSKETCHSPECS SCRELTS (FUNCTION SK.TRANSLATE.ITEM)
(SK.MAP.FROM.WINDOW.TO.NEAREST.GRID
DELTAPOS
(WINDOW.SCALE SKW))
SKW))
(* redraw the image in case any of it was erased by
the calls to SK.TRANSLATE.ITEM)
(SK.SHOW.FIG.FROM.INFO IMAGEBM (IPLUS IMAGEPOSX (fetch (POSITION XCOORD)
of DELTAPOS))
(IPLUS IMAGEPOSY (fetch (POSITION YCOORD)
of DELTAPOS))
(QUOTE PAINT)
SKW)
(SK.ADD.HISTEVENT (QUOTE MOVE)
(for NEWG in NEWGLOBALS as OLDG in SCRELTS when NEWG
collect (LIST (fetch (SCREENELT GLOBALPART)
of OLDG)
NEWG))
SKW)
(CLOSEPROMPTWINDOW SKW])
(SK.SHOW.FIG.FROM.INFO
[LAMBDA (IMAGEBM XOFFSET YOFFSET OPERATION WINDOW) (* rrb "14-Nov-84 14:20")
(* puts a bitmap onto the sketch window.)
(BITBLT IMAGEBM 0 0 WINDOW XOFFSET YOFFSET NIL NIL (QUOTE INPUT)
OPERATION])
(SK.MOVE.THING
[LAMBDA (SELPOS NEWPOSSPEC SKETCHELT W) (* rrb "11-Jul-85 14:40")
(* moves the selected point to the new position.)
(AND NEWPOSSPEC SKETCHELT (PROG (OLDGLOBAL NEWGLOBAL GDELTAPOS)
(* calculate the delta that the selected point moves.)
(SETQ GDELTAPOS (SK.MAP.FROM.WINDOW.TO.NEAREST.GRID
(create POSITION
XCOORD ←(IDIFFERENCE (fetch (POSITION XCOORD)
of (fetch (INPUTPT
INPUT.POSITION)
of NEWPOSSPEC))
(fetch (POSITION XCOORD)
of SELPOS))
YCOORD ←(IDIFFERENCE (fetch (POSITION YCOORD)
of (fetch (INPUTPT
INPUT.POSITION)
of NEWPOSSPEC))
(fetch (POSITION YCOORD)
of SELPOS)))
(WINDOW.SCALE SKW)))
(SETQ NEWGLOBAL (SK.TRANSLATE.POINTS (LIST SELPOS)
GDELTAPOS SKETCHELT W))
(* moving a piece of an element.)
(SK.UPDATE.ELEMENT (SETQ OLDGLOBAL (fetch (SCREENELT GLOBALPART)
of SKETCHELT))
NEWGLOBAL W)
(SK.ADD.HISTEVENT (QUOTE MOVE)
(LIST (LIST OLDGLOBAL NEWGLOBAL))
W)
(RETURN NEWGLOBAL])
(UPDATE.ELEMENT.IN.SKETCH
[LAMBDA (OLDGELT NEWGELT SKETCH SKW UNDOFLG) (* rrb "21-Jun-85 16:51")
(* changes the global sketch)
(* returns NIL if the old global sketch element is not
found in SKETCH. This can happen if things are undone
out of order.)
(PROG ((SKETCHSTRUCTURE (INSURE.SKETCH SKETCH))) (* if old and new are the same, the change was done
destructively; otherwise clobber the new one in.)
(RETURN (COND
((OR (EQ OLDGELT NEWGELT)
(for GELTTAIL on (fetch (SKETCH SKETCHELTS) of SKETCHSTRUCTURE)
when (EQ (CAR GELTTAIL)
OLDGELT)
do (RPLACA GELTTAIL NEWGELT)
(RETURN T)))
(SK.MARK.DIRTY SKETCH)
T])
(SK.UPDATE.ELEMENT
[LAMBDA (OLDGLOBAL NEWGLOBAL SKETCHW REDRAWIFSAMEFLG) (* rrb "21-Jun-85 16:47")
(* replaces an old element with a new one. The global part of the old one may be the same as the new global part.
This also handles propagation to other windows that have the same figure displayed.)
(PROG ((SKETCH (SKETCH.FROM.VIEWER SKETCHW))
UPDATEDELT) (* update the element in the sketch first.
If this returns NIL, the element was not found in the
sketch.)
(OR (UPDATE.ELEMENT.IN.SKETCH OLDGLOBAL NEWGLOBAL SKETCH SKETCHW)
(RETURN NIL)) (* do the window that the interaction occurred in
first.)
(SETQ UPDATEDELT (SK.UPDATE.ELEMENT1 OLDGLOBAL NEWGLOBAL SKETCHW REDRAWIFSAMEFLG))
(* propagate to other windows.)
(for SKW in (ALL.SKETCH.VIEWERS SKETCH) when (NEQ SKW SKETCHW)
do (* the position may have changed which means that it
may have moved in or out of a viewer.)
(SK.UPDATE.ELEMENT1 OLDGLOBAL NEWGLOBAL SKW REDRAWIFSAMEFLG))
(RETURN UPDATEDELT])
(SK.UPDATE.ELEMENTS
[LAMBDA (OLDNEWPAIRS WINDOW) (* rrb "10-Sep-84 17:01")
(* replaces the global parts of a list of old-new pairs
and handles updating the screen.)
(for PAIR in OLDNEWPAIRS do (SK.UPDATE.ELEMENT (CAR PAIR)
(CADR PAIR)
WINDOW])
(SK.UPDATE.ELEMENT1
[LAMBDA (OLDGELT NEWGELT SKETCHW REDRAWIFSAME) (* rrb "19-Aug-85 16:42")
(* determines what action is needed wrt the viewer SKETCHW when the element OLDGELT is updated to NEWGELT.
This works only in the given window.)
(PROG (LOCALELT UPDATEFN NEWLOCAL)
[COND
((SETQ LOCALELT (SK.LOCAL.ELT.FROM.GLOBALPART OLDGELT SKETCHW))
(COND
((EQ (SKETCH.ELEMENT.TYPE OLDGELT)
(QUOTE SKIMAGEOBJ)) (* handle imageobject case specially because changes
are often in internal structure)
(SK.DELETE.ITEM LOCALELT SKETCHW)
(* erase the old image region because often the internal parts of the image object have been clobbered making it
impossible to erase by redrawing)
(DSPFILL (fetch (LOCALSKIMAGEOBJ SKIMOBJLOCALREGION) of (fetch (SCREENELT LOCALPART)
of LOCALELT))
WHITESHADE
(QUOTE REPLACE)
SKETCHW)
(RETURN (SKETCH.ADD.AND.DISPLAY1 NEWGELT SKETCHW)))
[(EQUAL OLDGELT NEWGELT)
(* replacing something by something else that is identical. Check here because add will not add something that is
already there and updatefn may call add first.)
(COND
(REDRAWIFSAME
(* this entry is used from the WB.BUTTON.HANDLER and deals with image objects which we have no control over whether
they give us something new or not.)
(SK.ERASE.AND.DELETE.ITEM LOCALELT SKETCHW))
(T (SK.DELETE.ITEM LOCALELT SKETCHW)
(RETURN (SK.ADD.ITEM NEWGELT SKETCHW]
((AND (SETQ UPDATEFN (SK.UPDATEFN (fetch (GLOBALPART GTYPE) of NEWGELT)))
(SETQ NEWLOCAL (APPLY* UPDATEFN LOCALELT NEWGELT SKETCHW)))
(* if the old one is visible and the element has an updatefn, use it to update the display. Then delete the old one.
The updatefn should have added the new one.)
(SK.DELETE.ITEM LOCALELT SKETCHW)
(RETURN NEWLOCAL))
(T (* if this type doesn't have a updatefn or it returned
NIL, do the erase and redraw method.)
(SK.ERASE.AND.DELETE.ITEM LOCALELT SKETCHW]
(RETURN (COND
((ELT.INSIDE.SKWP NEWGELT SKETCHW)
(SKETCH.ADD.AND.DISPLAY1 NEWGELT SKETCHW])
(SK.MOVE.ELEMENT.POINT
[LAMBDA (W) (* rrb "20-Feb-85 20:27")
(* lets the user select an element and move it.)
(EVAL.AS.PROCESS (LIST (QUOTE SK.SEL.AND.MOVE)
W
(QUOTE (QUOTE ONLY])
)
(* fns for moving points or a collection of pts.)
(DEFINEQ
(SK.MOVE.POINTS
[LAMBDA (W) (* rrb " 3-May-85 17:35")
(* lets the user select a collection of points and move
them.)
(EVAL.AS.PROCESS (LIST (QUOTE SK.SEL.AND.MOVE.POINTS)
W])
(SK.SEL.AND.MOVE.POINTS
[LAMBDA (W) (* rrb " 3-May-85 18:21")
(* * lets the user select a collection of control point and moves them.)
(SK.DO.MOVE.ELEMENT.POINTS (SK.SELECT.MULTIPLE.POINTS W)
W])
(SK.DO.MOVE.ELEMENT.POINTS
[LAMBDA (SCRPTS SKW) (* rrb "19-Jul-85 13:20")
(* moves a collection of points)
(SKED.CLEAR.SELECTION SKW)
(AND SCRPTS (PROG ((SCRELTS (SK.ELTS.CONTAINING.PTS SCRPTS SKW))
NONMOVEDHOTSPOTS ONEPTELTS FIGINFO FIRSTHOTSPOT NEWPOS LOWLFT IMAGEPOSX
IMAGEPOSY IMAGEBM DELTAPOS NEWGLOBALS CHANGES)
(* create a bitmap of all of the elements that have any point being moved and get its new position.
Use only the region that contains the points. points plus a boarder to catch the lines of a box as large as the
region.)
(SETQ NONMOVEDHOTSPOTS (SK.HOTSPOTS.NOT.ON.LIST SCRPTS SCRELTS))
[SETQ ONEPTELTS (SUBSET SCRELTS (FUNCTION (LAMBDA (ELT)
(EQ (LENGTH (fetch (LOCALPART HOTSPOTS)
of (fetch (SCREENELT LOCALPART)
of ELT)))
1]
(SETQ FIGINFO (SK.FIGUREIMAGE SCRELTS NIL
(INCREASEREGION
(COND
[ONEPTELTS
(* include the regions of any elements that only have one control point. This picks up text and groups whose image
is much larger than the point.)
(UNIONREGIONS (
REGION.CONTAINING.PTS SCRPTS)
(
SK.GLOBAL.REGION.OF.ELEMENTS ONEPTELTS (WINDOW.SCALE SKW]
(T (REGION.CONTAINING.PTS SCRPTS)))
4)))
(SETQ FIRSTHOTSPOT (CAR SCRPTS))
(SETQ LOWLFT (fetch (SKFIGUREIMAGE SKFIGURE.LOWERLEFT) of FIGINFO))
(SETQ IMAGEBM (fetch (SKFIGUREIMAGE SKFIGURE.BITMAP) of FIGINFO))
(* move the image by the first hotspot of the first
element chosen. This will align the image on the grid
correctly.)
(SETQ IMAGEPOSX (fetch (POSITION XCOORD) of LOWLFT))
(SETQ IMAGEPOSY (fetch (POSITION YCOORD) of LOWLFT))
(* put the cursor on the hot spot)
(CURSORPOSITION FIRSTHOTSPOT SKW)
(COND
([NULL (ERSETQ (PROGN (SK.SHOW.FIG.FROM.INFO IMAGEBM IMAGEPOSX IMAGEPOSY
(QUOTE ERASE)
SKW)
(for PT in NONMOVEDHOTSPOTS
do (MARKPOINT PT SKW OTHERCONTROLPOINTMARK))
(SETQ NEWPOS (fetch (INPUTPT INPUT.POSITION)
of (GET.BITMAP.POSITION
SKW IMAGEBM (QUOTE PAINT)
"Move image to its new position."
(IDIFFERENCE IMAGEPOSX
(fetch (POSITION
XCOORD)
of FIRSTHOTSPOT))
(IDIFFERENCE IMAGEPOSY
(fetch (POSITION
YCOORD)
of FIRSTHOTSPOT]
(* error happened, repaint the image.)
(SK.SHOW.FIG.FROM.INFO IMAGEBM IMAGEPOSX IMAGEPOSY (QUOTE PAINT)
SKW)
(for PT in NONMOVEDHOTSPOTS do (MARKPOINT PT SKW OTHERCONTROLPOINTMARK))
(CLOSEPROMPTWINDOW SKW)
(ERROR!))
((NULL NEWPOS)
(SK.SHOW.FIG.FROM.INFO IMAGEBM IMAGEPOSX IMAGEPOSY (QUOTE PAINT)
SKW)
(for PT in NONMOVEDHOTSPOTS do (MARKPOINT PT SKW OTHERCONTROLPOINTMARK))
(STATUSPRINT SKW "Position was outside the window, copy not placed.")
(RETURN NIL))) (* GET.BITMAP.POSITION returns the position that the
cursor was in which is the position of the first
hotspot.)
(for PT in NONMOVEDHOTSPOTS do (MARKPOINT PT SKW OTHERCONTROLPOINTMARK))
[SETQ DELTAPOS (create POSITION
XCOORD ←(IDIFFERENCE (fetch (POSITION XCOORD)
of NEWPOS)
(fetch (POSITION XCOORD)
of FIRSTHOTSPOT))
YCOORD ←(IDIFFERENCE (fetch (POSITION YCOORD)
of NEWPOS)
(fetch (POSITION YCOORD)
of FIRSTHOTSPOT]
(SETQ NEWGLOBALS (MAPCOLLECTSKETCHSPECS SCRELTS (FUNCTION SK.MOVE.ITEM.POINTS)
(SK.MAP.FROM.WINDOW.TO.NEAREST.GRID
DELTAPOS
(WINDOW.SCALE SKW))
SKW SCRPTS))
(SK.ADD.HISTEVENT (QUOTE MOVE)
(for NEWG in NEWGLOBALS as OLDG in SCRELTS when NEWG
collect (LIST (fetch (SCREENELT GLOBALPART) of OLDG)
NEWG))
SKW)
(CLOSEPROMPTWINDOW SKW])
(SK.MOVE.ITEM.POINTS
[LAMBDA (SELELT GLOBALDELTAPOS W LOCALPTS) (* rrb "11-Jul-85 13:44")
(* SELELT is a sketch element at least one of whose points was selected for a translate operation.
GLOBALDELTAPOS is the amount the item is to be translated. LOCALPTS is the list of points that was selected.
This function moves any of those that belong to SELELT and return the new global. If all of SELELT points are on
LOCALPTS this is a SK.TRANSLATE.ITEM.)
(PROG ((ELTHOTSPOTS (fetch (LOCALPART HOTSPOTS) of (fetch (SCREENELT LOCALPART) of SELELT)))
MOVEDPTS NEWGLOBAL OLDGLOBAL NEWSCREENELT) (* this shouldn't happen but don't cause an error if it
does.)
(OR (SETQ MOVEDPTS (INTERSECTION ELTHOTSPOTS LOCALPTS))
(RETURN))
(* map the difference point onto a grid location that would have the same screen distance but will leave things on a
power of two.)
(SETQ OLDGLOBAL (fetch (SCREENELT GLOBALPART) of SELELT))
(COND
((EQ (LENGTH MOVEDPTS)
(LENGTH ELTHOTSPOTS)) (* all of its hot spots have been moved, just translate
it)
(OR (SETQ NEWGLOBAL (SK.TRANSLATE.GLOBALPART OLDGLOBAL GLOBALDELTAPOS W))
(RETURN NIL)))
((SETQ NEWGLOBAL (SK.TRANSLATE.POINTS MOVEDPTS GLOBALDELTAPOS SELELT W)))
(T (RETURN NIL)))
(SK.UPDATE.ELEMENT OLDGLOBAL NEWGLOBAL W T)
(RETURN NEWGLOBAL])
(SK.TRANSLATEPTSFN
[LAMBDA (ELEMENTTYPE) (* rrb " 5-May-85 16:25")
(* goes from an element type name to its EXPANDFN)
(fetch (SKETCHTYPE TRANSLATEPTSFN) of (GETPROP ELEMENTTYPE (QUOTE SKETCHTYPE])
(SK.TRANSLATE.POINTS
[LAMBDA (SELPTS GLOBALDELTA SKETCHELT W) (* rrb " 5-May-85 18:51")
(* moves the selected points by a global amount.)
(AND SKETCHELT (APPLY* (SK.TRANSLATEPTSFN (fetch (SCREENELT GTYPE) of SKETCHELT))
SKETCHELT SELPTS GLOBALDELTA W])
(SK.SELECT.MULTIPLE.POINTS
[LAMBDA (SKW) (* rrb "19-Jul-85 10:31")
(* * allows the user to select a collection of control points.)
(PROG ((INTERIOR (DSPCLIPPINGREGION NIL SKW))
SELECTABLEITEMS HOTSPOTCACHE NOW OLDX ORIGX NEWX NEWY OLDY ORIGY SELPTS PREVMOUSEBUTTONS
MOUSEINSIDE?)
(COND
((SETQ SELECTABLEITEMS (LOCALSPECS.FROM.VIEWER SKW))
(SETQ HOTSPOTCACHE (SK.HOTSPOT.CACHE SKW)))
(T (* no items, don't do anything.)
(RETURN)))
(TOTOPW SKW)
(SK.PUT.MARKS.UP S