(FILECREATED "15-Oct-85 14:25:59" {PHYLUM}<PAPERWORKS>SKETCH.;184 381992
changes to: (VARS SKETCHCOMS)
previous date: "14-Oct-85 18:10:10" {PHYLUM}<PAPERWORKS>SKETCH.;183)
(* Copyright (c) 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT SKETCHCOMS)
(RPAQQ SKETCHCOMS [[DECLARE: FIRST DOCOPY DONTEVAL@LOAD
(P (PROG ((NOTECARDSFLG (GETPROP (QUOTE NOTECARDS)
(QUOTE FILEDATES)))
(SKETCHFLG (AND (BOUNDP (QUOTE ALL.SKETCHES))
ALL.SKETCHES))
TEDITFLG)
(* current knows about SKETCH TEDIT and NOTECARDS. Everyone
else loses.)
[MAP.PROCESSES (FUNCTION (LAMBDA (PROC PROCNAME PROCFORM)
(AND (EQ (CAR PROCFORM)
(QUOTE \TEDIT2))
(SETQ TEDITFLG T]
(COND ((AND (BOUNDP (QUOTE ALL.SKETCHES))
(OR SKETCHFLG NOTECARDSFLG TEDITFLG))
(ERROR (CONCAT "Please close" (COND (SKETCHFLG
" all open Sketch windows,")
(T ""))
(COND (NOTECARDSFLG
(CONCAT (COND (SKETCHFLG " and")
(T ""))
" any open notefiles,"))
(T ""))
(COND (TEDITFLG (CONCAT
(COND ((OR SKETCHFLG
NOTECARDSFLG)
" and")
(T ""))
" any TEDIT windows that have sketches in them,"))
(T ""))
" then type 'RETURN'.
To abort loading the new version of Sketch, type '↑'."]
(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
[PROG ((NOTECARDSFLG (GETPROP (QUOTE NOTECARDS)
(QUOTE FILEDATES)))
(SKETCHFLG (AND (BOUNDP (QUOTE ALL.SKETCHES))
ALL.SKETCHES))
TEDITFLG)
(* current knows about SKETCH TEDIT and NOTECARDS. Everyone else loses.)
[MAP.PROCESSES (FUNCTION (LAMBDA (PROC PROCNAME PROCFORM)
(AND (EQ (CAR PROCFORM)
(QUOTE \TEDIT2))
(SETQ TEDITFLG T]
(COND ((AND (BOUNDP (QUOTE ALL.SKETCHES))
(OR SKETCHFLG NOTECARDSFLG TEDITFLG))
(ERROR (CONCAT "Please close" (COND (SKETCHFLG " all open Sketch windows,")
(T ""))
(COND (NOTECARDSFLG (CONCAT (COND (SKETCHFLG " and")
(T ""))
" any open notefiles,"))
(T ""))
(COND (TEDITFLG (CONCAT (COND ((OR SKETCHFLG NOTECARDSFLG)
" and")
(T ""))
" any TEDIT windows that have sketches in them,"))
(T ""))
" then type 'RETURN'.
To abort loading the new version of Sketch, type '↑'."]
)
(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 "10-Oct-85 13:59")
(* 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))
(LESSP (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 SKW HOTSPOTCACHE)
(until (MOUSESTATE (NOT UP)))
(COND
((INSIDEP INTERIOR (LASTMOUSEX SKW)
(LASTMOUSEY SKW)))
(T (* first press was outside of the window, don't select
anything.)
(SK.TAKE.MARKS.DOWN SKW HOTSPOTCACHE)
(RETURN)))
SELECTLP
(COND
((MOUSESTATE UP)
(GO SHIFTDOWNLP))) (* this label provides an entry for the code that tests
if the shift key is down.)
SELAFTERTEST
(SETQ NEWY (LASTMOUSEY SKW))
(SETQ NEWX (LASTMOUSEX SKW))
[COND
[(NOT MOUSEINSIDE?)
(* mouse is outside, don't do anything other than wait for it to come back in. If the user has let up all buttons,
the branch to SELECTEXIT will have been taken.)
(COND
((INSIDEP INTERIOR NEWX NEWY)
(SETQ MOUSEINSIDE? T) (* restore the saved selected items.)
(for ELT in SELPTS do (SK.ADD.PT.SELECTION ELT SKW]
((NOT (INSIDEP INTERIOR NEWX NEWY)) (* mouse just went outside, remove selections but save
them in case mouse comes back in.)
(SETQ MOUSEINSIDE? NIL)
(SETQ SELPTS (WINDOWPROP SKW (QUOTE SKETCH.SELECTIONS)))
(for ELT in SELPTS do (SK.REMOVE.PT.SELECTION ELT SKW)))
[(NEQ PREVMOUSEBUTTONS LASTMOUSEBUTTONS) (* another button has gone down, mark this as the
origin of a new box to sweep.)
(SETQ PREVMOUSEBUTTONS LASTMOUSEBUTTONS)
(SETQ ORIGX (LASTMOUSEX SKW))
(SETQ ORIGY (LASTMOUSEY SKW)) (* add or delete the element that the button press
occurred on if any.)
(AND (SETQ NOW (IN.SKETCH.ELT? HOTSPOTCACHE (create POSITION
XCOORD ← NEWX
YCOORD ← NEWY)
T))
(COND
((LASTMOUSESTATE (ONLY LEFT)) (* add selection.)
(SK.ADD.PT.SELECTION NOW SKW))
((LASTMOUSESTATE RIGHT) (* remove selection.)
(SK.REMOVE.PT.SELECTION NOW SKW]
([AND (OR (NEQ NEWX OLDX)
(NEQ NEWY OLDY))
(SETQ SELPTS (SK.CONTROL.POINTS.IN.REGION HOTSPOTCACHE (MIN ORIGX NEWX)
(MIN ORIGY NEWY)
(MAX ORIGX NEWX)
(MAX ORIGY NEWY]
(* add or delete any with in the swept out area.)
(COND
((LASTMOUSESTATE (ONLY LEFT)) (* left only selects.)
(for SELPT in SELPTS do (SK.ADD.PT.SELECTION SELPT SKW)))
((LASTMOUSESTATE RIGHT) (* right cause deselect.)
(for SELPT in SELPTS do (SK.REMOVE.PT.SELECTION SELPT SKW]
(SETQ OLDX NEWX)
(SETQ OLDY NEWY)
(GO SELECTLP)
SHIFTDOWNLP
(COND
((MOUSESTATE (NOT UP)) (* button went down again, initialize the button state
and click position.)
(SETQ PREVMOUSEBUTTONS NIL)
(GO SELAFTERTEST))
((.SHIFTKEYDOWNP.)
[COND
[(NOT MOUSEINSIDE?) (* mouse is outside: if it comes back in, mark the
selections.)
(COND
((INSIDEP INTERIOR (LASTMOUSEX SKW)
(LASTMOUSEY SKW))
(SETQ MOUSEINSIDE? T) (* restore the saved selected items.)
(for ELT in SELPTS do (SK.ADD.PT.SELECTION ELT SKW]
((NOT (INSIDEP INTERIOR (LASTMOUSEX SKW)
(LASTMOUSEY SKW))) (* mouse just went outside, remove marks but keep
selections)
(SETQ MOUSEINSIDE? NIL)
(SETQ SELPTS (WINDOWPROP SKW (QUOTE SKETCH.SELECTIONS)))
(for ELT in SELPTS do (SK.REMOVE.PT.SELECTION ELT SKW]
(GO SHIFTDOWNLP)))
(SETQ SELPTS (WINDOWPROP SKW (QUOTE SKETCH.SELECTIONS)))
(for SEL in SELPTS do (SK.REMOVE.PT.SELECTION SEL SKW))
(SK.TAKE.MARKS.DOWN SKW HOTSPOTCACHE)
(RETURN SELPTS])
(SK.CONTROL.POINTS.IN.REGION
[LAMBDA (HOTSPOTCACHE LEFT BOTTOM RIGHT TOP) (* rrb " 6-May-85 16:22")
(* * returns a list of the control points that are within LOCALREGION)
(PROG ((RLEFT (DIFFERENCE LEFT SK.POINT.WIDTH))
(RBOTTOM (DIFFERENCE BOTTOM SK.POINT.WIDTH))
(RRIGHT (PLUS RIGHT SK.POINT.WIDTH))
(RTOP (PLUS TOP SK.POINT.WIDTH))
ELTS)
[for YBUCKET in HOTSPOTCACHE when (ILEQ (CAR YBUCKET)
RTOP)
do (COND
((ILESSP (CAR YBUCKET)
RBOTTOM) (* stop when Y gets too small.)
(RETURN)))
(for XBUCKET in (CDR YBUCKET) when (ILEQ (CAR XBUCKET)
RRIGHT)
do (COND
((ILESSP (CAR XBUCKET)
RLEFT) (* stop when X gets too small.)
(RETURN))) (* collect the points if there are any elements cached
there.)
(AND (CDR XBUCKET)
(SETQ ELTS (SK.ADD.POINT ELTS (CAR XBUCKET)
(CAR YBUCKET]
(RETURN ELTS])
(SK.ADD.PT.SELECTION
[LAMBDA (PT WINDOW MARKBM) (* rrb " 9-May-85 10:18")
(* adds an item to the selection list of WINDOW.)
(COND
([NOT (MEMBER PT (WINDOWPROP WINDOW (QUOTE SKETCH.SELECTIONS]
(MARKPOINT PT WINDOW MARKBM)
(WINDOWADDPROP WINDOW (QUOTE SKETCH.SELECTIONS)
PT])
(SK.REMOVE.PT.SELECTION
[LAMBDA (PT WINDOW MARKBM) (* rrb " 9-May-85 10:22")
(* removes an item from the selection list of WINDOW.)
(COND
((MEMBER PT (WINDOWPROP WINDOW (QUOTE SKETCH.SELECTIONS)))
(MARKPOINT PT WINDOW MARKBM) (* used to call WINDOWDELPROP but it has a bug that it
only removes EQ things.)
(WINDOWPROP WINDOW (QUOTE SKETCH.SELECTIONS)
(REMOVE PT (WINDOWPROP WINDOW (QUOTE SKETCH.SELECTIONS])
(SK.ADD.POINT
[LAMBDA (PTLST X Y) (* rrb " 6-May-85 16:22")
(* add the point X Y to PTLST unless it is already a
member.)
(COND
((for PT in PTLST thereis (AND (EQ (fetch (POSITION XCOORD) of PT)
X)
(EQ (fetch (POSITION YCOORD) of PT)
Y)))
PTLST)
(T (CONS (CREATE POSITION
XCOORD ← X
YCOORD ← Y)
PTLST])
(SK.ELTS.CONTAINING.PTS
[LAMBDA (PTLST SKW) (* rrb " 4-May-85 15:38")
(* returns the list of elements that have any points on
PTLST.)
(bind (HOTSPOTCACHE ←(SK.HOTSPOT.CACHE SKW))
ELTS for POS in PTLST do (SETQ ELTS (UNION (SK.ELTS.FROM.HOTSPOT POS HOTSPOTCACHE)
ELTS))
finally (* reverse them so the first selected pt has its
element first.)
(RETURN (REVERSE ELTS])
(SK.HOTSPOTS.NOT.ON.LIST
[LAMBDA (PTLST ELTS) (* rrb "19-Jul-85 13:18")
(* returns a list of the hot spots on any of ELTS that
aren't on PTLST.)
(bind OTHERHOTSPOTS for ELT in ELTS do [for HOTSPOT in (fetch (SCREENELT HOTSPOTS) of ELT)
do (OR (MEMBER HOTSPOT PTLST)
(MEMBER HOTSPOT OTHERHOTSPOTS)
(SETQ OTHERHOTSPOTS (CONS HOTSPOT OTHERHOTSPOTS]
finally (RETURN OTHERHOTSPOTS])
)
(DECLARE: EVAL@COMPILE
[PUTPROPS .SHIFTKEYDOWNP. MACRO (NIL (OR (KEYDOWNP (QUOTE LSHIFT))
(KEYDOWNP (QUOTE RSHIFT]
)
(DEFINEQ
(SK.SET.MOVE.MODE
[LAMBDA (SKW NEWMODE) (* rrb " 2-Jun-85 12:52")
(* * reads a value of move command mode and makes it the default)
(PROG [(LOCALNEWMODE (OR NEWMODE (READMOVEMODE]
(RETURN (AND LOCALNEWMODE (replace (SKETCHCONTEXT SKETCHMOVEMODE)
of (WINDOWPROP SKW (QUOTE SKETCHCONTEXT))
with (SELECTQ NEWMODE
((POINTS ELEMENTS)
NEWMODE)
NIL])
(SK.SET.MOVE.MODE.POINTS
[LAMBDA (SKW) (* rrb " 2-Jun-85 12:47")
(* sets the default to move mode to points.)
(SK.SET.MOVE.MODE SKW (QUOTE POINTS])
(SK.SET.MOVE.MODE.ELEMENTS
[LAMBDA (SKW) (* rrb " 2-Jun-85 12:48")
(* sets the default to move mode to elements)
(SK.SET.MOVE.MODE SKW (QUOTE ELEMENTS])
(SK.SET.MOVE.MODE.COMBINED
[LAMBDA (SKW) (* rrb " 2-Jun-85 12:49")
(* sets the default to move mode to combined move.)
(SK.SET.MOVE.MODE SKW (QUOTE COMBINED])
(READMOVEMODE
[LAMBDA (MENUTITLE) (* rrb " 2-Jun-85 12:46")
(* interacts to get whether move mode should be points,
elements or both.)
(MENU (create MENU
TITLE ←(OR MENUTITLE "Top level MOVE command should apply to?")
ITEMS ←(QUOTE ((Points (QUOTE POINTS)
"Top level MOVE command will be the same as MOVE POINTS command.")
(Elements (QUOTE ELEMENTS)
"Top level MOVE command will be the same as MOVE ELEMENTS command.")
(Combined (QUOTE COMBINED)
"MOVE command will move points if a single point is clicked; elements otherwise")))
CENTERFLG ← T])
)
(* stuff for supporting the GROUP sketch element.)
(DEFINEQ
(SK.GROUP.ELTS
[LAMBDA (W) (* rrb "11-Jan-85 11:16")
(* lets the user select a collection elements and
groups them.)
(EVAL.AS.PROCESS (LIST (QUOTE SK.SEL.AND.GROUP)
W])
(SK.SEL.AND.GROUP
[LAMBDA (W) (* rrb "11-Jan-85 11:17")
(* lets the user select elements and groups them.)
(SK.GROUP.ELEMENTS (SK.SELECT.MULTIPLE.ITEMS W T)
W])
(SK.GROUP.ELEMENTS
[LAMBDA (SCRELTS SKW) (* rrb "20-Mar-85 12:18")
(* groups the collection of elements SCRELTS.
Does this by creating a group element, adding it and
deleting the individual elements.)
(AND SCRELTS (PROG (GELTS GROUPELT GROUPREGION (SCALE (WINDOW.SCALE SKW)))
(SETQ GROUPREGION (SK.GLOBAL.REGION.OF.ELEMENTS SCRELTS SCALE))
(SETQ GELTS (for SCRELT in SCRELTS collect (fetch (SCREENELT GLOBALPART)
of SCRELT)))
(COND
([OR (NULL GELTS)
(AND (NULL (CDR GELTS))
(EQ (fetch (GLOBALPART GTYPE) of (CAR GELTS))
(QUOTE GROUP] (* if there is only one element which is already a
group, don't group it again.)
(RETURN NIL)))
[SETQ GROUPELT (create GLOBALPART
INDIVIDUALGLOBALPART ←(create GROUP
GROUPREGION ← GROUPREGION
LISTOFGLOBALELTS ← GELTS
GROUPCONTROLPOINT ←(
MAP.GLOBAL.PT.ONTO.GRID
(REGION.CENTER
GROUPREGION)
SKW]
(* use same scales as a box would.)
(BOX.SET.SCALES GROUPREGION GROUPELT)
(* do grouping.)
(SK.DO.GROUP GROUPELT GELTS SKW) (* record it on the history list.)
(SK.ADD.HISTEVENT (QUOTE GROUP)
(LIST GROUPELT GELTS)
SKW])
(SK.UNGROUP.ELT
[LAMBDA (W) (* rrb "11-Jan-85 16:02")
(* lets the user select a collection elements and
groups them.)
(EVAL.AS.PROCESS (LIST (QUOTE SK.SEL.AND.UNGROUP)
W])
(SK.SEL.AND.UNGROUP
[LAMBDA (W) (* rrb "11-Jan-85 15:45")
(* lets the user select elements and groups them.)
(SK.UNGROUP.ELEMENT (SK.SELECT.MULTIPLE.ITEMS W T)
W])
(SK.UNGROUP.ELEMENT
[LAMBDA (SCRELTS SKW) (* rrb "30-Jul-85 15:41")
(* ungroups the first group element in SCRELTS.)
(PROG ([GROUPELT (for ELT in SCRELTS when (EQ (fetch (SCREENELT GTYPE) of ELT)
(QUOTE GROUP))
do (RETURN (fetch (SCREENELT GLOBALPART) of ELT]
GELTS)
(OR GROUPELT (RETURN))
(SK.DO.UNGROUP GROUPELT (SETQ GELTS (fetch (GROUP LISTOFGLOBALELTS)
of (fetch (GLOBALPART INDIVIDUALGLOBALPART)
of GROUPELT)))
SKW)
(SK.ADD.HISTEVENT (QUOTE UNGROUP)
(LIST GROUPELT GELTS)
SKW])
(SK.GLOBAL.REGION.OF.ELEMENTS
[LAMBDA (SCRELTS SCALE) (* rrb "18-Feb-85 17:31")
(* returns the global region occuppied by a list of
local elements.)
(PROG (GROUPREGION)
[for SCRELT in SCRELTS do (SETQ GROUPREGION (COND
(GROUPREGION (* first time because UNIONREGIONS doesn't handle NIL)
(UNIONREGIONS GROUPREGION (SK.ITEM.REGION SCRELT)
))
(T (SK.ITEM.REGION SCRELT]
(RETURN (UNSCALE.REGION GROUPREGION SCALE])
(SK.GLOBAL.REGION.OF.SKETCH
[LAMBDA (SKETCH SKW) (* rrb "31-May-85 11:30")
(* returns the global region of a sketch. For now uses SKW to map into local elements and determines the region from
these. Later, after Jam, there needs to be a way of calculating the region of an element from the global part and
this should use that entry.)
(PROG ((SCALE (WINDOW.SCALE SKW)))
(RETURN (SK.GLOBAL.REGION.OF.ELEMENTS (for SKELT in (fetch (SKETCH SKETCHELTS)
of SKETCH)
collect (SK.LOCAL.FROM.GLOBAL SKELT SKW SCALE))
SCALE])
(SK.FLASHREGION
[LAMBDA (REGION WINDOW TEXTURE) (* rrb "30-Jul-85 15:47")
(* flashes a region)
(DSPFILL REGION TEXTURE (QUOTE INVERT)
WINDOW)
(DISMISS 400)
(DSPFILL REGION TEXTURE (QUOTE INVERT)
WINDOW])
)
(DEFINEQ
(INIT.GROUP.ELEMENT
[LAMBDA NIL (* rrb "11-Jul-85 14:13")
(* initializes the text box element.)
(COND
((NOT (SKETCH.ELEMENT.TYPEP (QUOTE GROUP)))
(CREATE.SKETCH.ELEMENT.TYPE (QUOTE GROUP)
NIL "groups a collection of elements as a single element."
(FUNCTION GROUP.DRAWFN)
(FUNCTION GROUP.EXPANDFN)
(QUOTE OBSOLETE)
(FUNCTION SK.ELEMENTS.CHANGEFN)
(FUNCTION TEXTBOX.INPUTFN)
(FUNCTION GROUP.INSIDEFN)
(FUNCTION GROUP.REGIONFN)
(FUNCTION GROUP.TRANSLATEFN)
NIL
(FUNCTION GROUP.READCHANGEFN)
(FUNCTION GROUP.TRANSFORMFN)
NIL])
(GROUP.DRAWFN
[LAMBDA (GROUPELT WINDOW REGION OPERATION) (* rrb "11-Jan-85 15:58")
(* draws a group element.)
(for ELT in (fetch (LOCALGROUP LOCALELEMENTS) of (fetch (SCREENELT LOCALPART) of GROUPELT))
do (APPLY* (SK.DRAWFN (fetch (SCREENELT GTYPE) of ELT))
ELT WINDOW REGION OPERATION])
(GROUP.EXPANDFN
[LAMBDA (GROUPELT SCALE STREAM) (* rrb "29-Jan-85 14:50")
(* creates a local group screen element from a global
group element)
(PROG ((GROUPINDVELT (fetch (GLOBALPART INDIVIDUALGLOBALPART) of GROUPELT))
LOCALREGION)
(SETQ LOCALREGION (SCALE.REGION (fetch (GROUP GROUPREGION) of GROUPINDVELT)
SCALE)) (* put the position in the center.)
(RETURN (create SCREENELT
LOCALPART ←(create LOCALGROUP
GROUPPOSITION ←(SK.SCALE.POSITION.INTO.VIEWER
(fetch (GROUP GROUPCONTROLPOINT) of GROUPINDVELT)
SCALE)
LOCALGROUPREGION ← LOCALREGION
LOCALELEMENTS ←(for ELEMENT in (fetch (GROUP
LISTOFGLOBALELTS)
of GROUPINDVELT)
collect (SK.LOCAL.FROM.GLOBAL ELEMENT
STREAM
SCALE)))
GLOBALPART ← GROUPELT])
(GROUP.INSIDEFN
[LAMBDA (GROUPELT WREG) (* rrb "10-Jan-85 10:37")
(* determines if the global group element GROUPELT is
inside of WREG.)
(REGIONSINTERSECTP (fetch (GROUP GROUPREGION) of (fetch (GLOBALPART INDIVIDUALGLOBALPART)
of GROUPELT))
WREG])
(GROUP.REGIONFN
[LAMBDA (GROUPSCRELT) (* rrb "10-Jan-85 10:35")
(* returns the region occuppied by a group)
(fetch (LOCALGROUP LOCALGROUPREGION) of (fetch (SCREENELT LOCALPART) of GROUPSCRELT])
(GROUP.TRANSLATEFN
[LAMBDA (SKELT DELTAPOS) (* rrb "28-Apr-85 18:43")
(* * returns a group element which has been translated by DELTAPOS)
(PROG ((GGROUPELT (fetch (GLOBALPART INDIVIDUALGLOBALPART) of SKELT))
NEWREG)
(SETQ NEWREG (REL.MOVE.REGION (fetch (GROUP GROUPREGION) of GGROUPELT)
(fetch (POSITION XCOORD) of DELTAPOS)
(fetch (POSITION YCOORD) of DELTAPOS)))
(* makes a copy of the common global part because it
includes the scales which may change for one of the
instances.)
(RETURN (create GLOBALPART
COMMONGLOBALPART ←(APPEND (fetch (GLOBALPART COMMONGLOBALPART)
of SKELT))
INDIVIDUALGLOBALPART ←(create GROUP
GROUPREGION ← NEWREG
LISTOFGLOBALELTS ←(for SUBELT
in (fetch (GROUP
LISTOFGLOBALELTS)
of GGROUPELT)
collect (
SK.TRANSLATE.GLOBALPART SUBELT DELTAPOS T))
GROUPCONTROLPOINT ←(PTPLUS
(fetch (GROUP GROUPCONTROLPOINT)
of GGROUPELT)
DELTAPOS])
(GROUP.TRANSFORMFN
[LAMBDA (GELT TRANSFORMFN TRANSFORMDATA SCALEFACTOR) (* rrb " 2-Jun-85 13:10")
(* * returns a group element which has been transformed by TRANSFORMFN)
(COND
[(EQ TRANSFORMFN (FUNCTION SK.PUT.ON.GRID)) (* if putting things on a grid, move only the control
point.)
(PROG ((GGROUPELT (fetch (GLOBALPART INDIVIDUALGLOBALPART) of GELT))
NOWPOS)
(SETQ NOWPOS (fetch (GROUP GROUPCONTROLPOINT) of GGROUPELT))
(RETURN (GROUP.TRANSLATEFN GELT (PTDIFFERENCE (SK.TRANSFORM.POINT NOWPOS TRANSFORMFN
TRANSFORMDATA)
NOWPOS]
(T (PROG ((GGROUPELT (fetch (GLOBALPART INDIVIDUALGLOBALPART) of GELT))
NEWREG)
(* this transforms the old region to get the new one. This is not as good as recalculating the new one from the
transformed elements. The latter is hard because the region function only works on local elements and here we have
only global ones.)
(SETQ NEWREG (SK.TRANSFORM.REGION (fetch (GROUP GROUPREGION) of GGROUPELT)
TRANSFORMFN TRANSFORMDATA))
(* the control point could also profitably be put on a grid point but no other elements points are so done and it
would be hard.)
(RETURN (BOX.SET.SCALES NEWREG (create GLOBALPART
COMMONGLOBALPART ←(fetch (GLOBALPART
COMMONGLOBALPART)
of GELT)
INDIVIDUALGLOBALPART ←(create
GROUP
GROUPREGION ← NEWREG
LISTOFGLOBALELTS ←(for SUBELT
in (fetch (GROUP
LISTOFGLOBALELTS)
of GGROUPELT)
collect (
SK.TRANSFORM.ELEMENT SUBELT TRANSFORMFN TRANSFORMDATA SCALEFACTOR))
GROUPCONTROLPOINT ←(SK.TRANSFORM.POINT
(fetch (GROUP GROUPCONTROLPOINT)
of GGROUPELT)
TRANSFORMFN TRANSFORMDATA])
(GROUP.READCHANGEFN
[LAMBDA (SKW SCRNELTS) (* rrb "18-Jul-85 10:42")
(* reads how the user wants to change a textbox.)
(PROG (ASPECT HOW)
(SETQ HOW (SELECTQ (SETQ ASPECT (MENU (create MENU
TITLE ← "Change which part?"
ITEMS ←[APPEND
(COND
[(SKETCHINCOLORP)
(QUOTE (("Brush color" (QUOTE
BRUSHCOLOR)
"changes the color of any lines or text in the group.")
("Filling color" (QUOTE
FILLINGCOLOR)
"changes the filling color of any boxes or text boxes in the group."]
(T NIL))
(QUOTE ((Arrowheads (QUOTE ARROW)
"allows changing of arrow head charactistics.")
(Shape (QUOTE SHAPE)
"changes the shape of the brush")
(Size (QUOTE SIZE)
"changes the size of the lines")
(Dashing (QUOTE DASHING)
"changes the dashing property of the elements with lines.")
(Text (QUOTE TEXT)
"allows changing the properties of the text."]
CENTERFLG ← T)))
(TEXT (CADR (TEXT.READCHANGEFN SKW SCRNELTS T)))
(SIZE (READSIZECHANGE "Change size how?"))
(SHAPE (READBRUSHSHAPE))
(ARROW (READ.ARROW.CHANGE))
(DASHING (READ.DASHING.CHANGE))
(BRUSHCOLOR (READ.COLOR.CHANGE "Change line color how?"))
(FILLINGCOLOR (READ.COLOR.CHANGE "Change filling color how?" T))
NIL))
(RETURN (AND HOW (LIST ASPECT HOW])
)
(DEFINEQ
(REGION.CENTER
[LAMBDA (REGION) (* rrb "11-Jan-85 18:22")
(* returns the center of a region)
(create POSITION
XCOORD ←(PLUS (fetch (REGION LEFT) of REGION)
(QUOTIENT (fetch (REGION WIDTH) of REGION)
2))
YCOORD ←(PLUS (fetch (REGION BOTTOM) of REGION)
(QUOTIENT (fetch (REGION HEIGHT) of REGION)
2])
(REMOVE.LAST
[LAMBDA (LST) (* removes the last element from a list.)
(COND
((NULL (CDR LST))
NIL)
(T (for TAIL on LST when (NULL (CDDR TAIL))
do (RPLACD TAIL NIL)
(RETURN LST])
)
[DECLARE: EVAL@COMPILE
(TYPERECORD GROUP (GROUPREGION LISTOFGLOBALELTS GROUPCONTROLPOINT))
(RECORD LOCALGROUP ((GROUPPOSITION)
LOCALGROUPREGION LOCALELEMENTS))
]
(* history and undo stuff for groups)
(DEFINEQ
(SK.DO.GROUP
[LAMBDA (GROUPELT GELTS SKW) (* rrb "30-Jul-85 16:23")
(* does a group event. Used to undo UNGROUP too.)
(PROG (LOCALELT)
(for GELT in GELTS do (SK.DELETE.ELEMENT1 GELT SKW T))
(SETQ LOCALELT (SK.ADD.ELEMENT GROUPELT SKW T T))
(* flash the grouped area to let user know something
happened.)
(SK.FLASHREGION (fetch (LOCALGROUP LOCALGROUPREGION) of (fetch (SCREENELT LOCALPART)
of LOCALELT))
SKW GRAYSHADE)
(RETURN LOCALELT])
(SK.DO.UNGROUP
[LAMBDA (GROUPELT GELTS SKW) (* rrb "30-Jul-85 16:22")
(* does a ungroup event. Used to undo GROUP too.)
(SK.DELETE.ELEMENT1 GROUPELT SKW T)
(for GELT in GELTS do (SK.ADD.ELEMENT GELT SKW T T))
(SK.FLASHREGION (SCALE.REGION (fetch (GROUP GROUPREGION) of (fetch (GLOBALPART
INDIVIDUALGLOBALPART)
of GROUPELT))
(WINDOW.SCALE SKW))
SKW GRAYSHADE)
GROUPELT])
(SK.GROUP.UNDO
[LAMBDA (EVENTARGS SKW) (* rrb "11-Jan-85 15:21")
(* undoes a group event)
(SK.DO.UNGROUP (CAR EVENTARGS)
(CADR EVENTARGS)
SKW])
(SK.UNGROUP.UNDO
[LAMBDA (EVENTARGS SKW) (* rrb "11-Jan-85 15:21")
(* undoes a ungroup event)
(SK.DO.GROUP (CAR EVENTARGS)
(CADR EVENTARGS)
SKW])
)
(PUTPROPS GROUP EVENTFNS (SK.GROUP.UNDO SK.TYPE.OF.FIRST.ARG SK.UNGROUP.UNDO))
(PUTPROPS UNGROUP EVENTFNS (SK.UNGROUP.UNDO SK.TYPE.OF.FIRST.ARG SK.GROUP.UNDO))
(* fns to implement transformations on the elements)
(DEFINEQ
(SK.SEL.AND.TRANSFORM
[LAMBDA (W TRANSFORMFN TRANSFORMDATA) (* rrb "21-Feb-85 10:07")
(* lets the user select some elements and moves all of
their control points onto the grid.)
(SK.TRANSFORM.ELEMENTS (SK.SELECT.MULTIPLE.ITEMS W T)
TRANSFORMFN TRANSFORMDATA W])
(SK.TRANSFORM.ELEMENTS
[LAMBDA (SCRELTS TRANSFORMFN TRANSFORMDATA SKW) (* rrb "26-Apr-85 09:08")
(* changes SCRELTS to the elements that have had each of their control points transformed by transformfn.
TRANSFORMDATA is arbitrary data that is passed to tranformfn.)
(PROG (NEWGLOBALS)
(* computes the scale factor inherent in the transformation so that it doesn't have to be done on every element that
might need it. It major use is in scaling brush sizes.)
(SETQ NEWGLOBALS (MAPCOLLECTSKETCHSPECS SCRELTS (FUNCTION SK.TRANSFORM.ITEM)
TRANSFORMFN TRANSFORMDATA (
SK.TRANSFORM.SCALE.FACTOR TRANSFORMFN
TRANSFORMDATA)
SKW)) (* make a history entry.)
(SK.ADD.HISTEVENT (QUOTE MOVE)
(for NEWG in NEWGLOBALS as OLDG in SCRELTS when NEWG
collect (LIST (fetch (SCREENELT GLOBALPART) of OLDG)
NEWG))
SKW)
(RETURN NEWGLOBALS])
(SK.TRANSFORM.ITEM
[LAMBDA (SELELT TRANSFORMFN TRANSFORMDATA SCALEFACTOR W) (* rrb "26-Apr-85 09:09")
(* SELELT is a sketch element that was selected for a
transformation operation.)
(PROG (NEWGLOBAL OLDGLOBAL)
(COND
((SETQ NEWGLOBAL (SK.TRANSFORM.ELEMENT (SETQ OLDGLOBAL (fetch (SCREENELT GLOBALPART)
of SELELT))
TRANSFORMFN TRANSFORMDATA SCALEFACTOR))
(SK.UPDATE.ELEMENT OLDGLOBAL NEWGLOBAL W T)
(RETURN NEWGLOBAL])
(SK.TRANSFORM.ELEMENT
[LAMBDA (GELT TRANSFORMFN TRANSFORMDATA SCALEFACTOR) (* rrb "26-Apr-85 09:14")
(* returns a copy of the global element that has had each of its control points transformed by transformfn.
TRANSFORMDATA is arbitrary data that is passed to tranformfn.)
(APPLY* (SK.TRANSFORMFN (fetch (GLOBALPART GTYPE) of GELT))
GELT TRANSFORMFN TRANSFORMDATA SCALEFACTOR])
(SK.TRANSFORM.POINT
[LAMBDA (PT TRANSFORMFN TRANSFORMDATA) (* applies a transformation function to a position and
returns the transformed point.)
(APPLY* TRANSFORMFN PT TRANSFORMDATA])
(SK.TRANSFORM.POINT.LIST
[LAMBDA (PTLST TRANSFORMFN TRANSFORMDATA) (* transforms a list of points)
(for PT in PTLST collect (SK.TRANSFORM.POINT PT TRANSFORMFN TRANSFORMDATA])
(SK.TRANSFORM.REGION
[LAMBDA (REG TRANSFORMFN TRANSFORMDATA) (* rrb "31-May-85 10:42")
(* applies a transformation function to a region and
returns the transformed region)
(PROG (LOWERLEFT UPPERRIGHT)
(* transform the font by changing the scale according to how much the width of the box around the first line of text
changes from the transformation.)
(SETQ LOWERLEFT (SK.TRANSFORM.POINT (create POSITION
XCOORD ←(fetch (REGION LEFT) of REG)
YCOORD ←(fetch (REGION BOTTOM) of REG))
TRANSFORMFN TRANSFORMDATA))
(SETQ UPPERRIGHT (SK.TRANSFORM.POINT (create POSITION
XCOORD ←(fetch (REGION PRIGHT) of REG)
YCOORD ←(fetch (REGION PTOP) of REG))
TRANSFORMFN TRANSFORMDATA))
(* transformation may have changed the relative
positions of the upper right and lower left.)
(RETURN (CREATEREGION (MIN (fetch (POSITION XCOORD) of LOWERLEFT)
(fetch (POSITION XCOORD) of UPPERRIGHT))
(MIN (fetch (POSITION YCOORD) of LOWERLEFT)
(fetch (POSITION YCOORD) of UPPERRIGHT))
(ABS (DIFFERENCE (fetch (POSITION XCOORD) of UPPERRIGHT)
(fetch (POSITION XCOORD) of LOWERLEFT)))
(ABS (DIFFERENCE (fetch (POSITION YCOORD) of UPPERRIGHT)
(fetch (POSITION YCOORD) of LOWERLEFT])
(SK.PUT.ELTS.ON.GRID
[LAMBDA (W) (* rrb " 7-Feb-85 12:03")
(* lets the user select some elements and moves all of
their control points onto the grid.)
(EVAL.AS.PROCESS (LIST (FUNCTION SK.SEL.AND.TRANSFORM)
(KWOTE W)
(KWOTE (FUNCTION SK.PUT.ON.GRID))
(KWOTE (SK.GRIDFACTOR W])
(SK.TRANSFORM.GLOBAL.ELEMENTS
[LAMBDA (SCRELTS TRANSFORMFN TRANSFORMDATA) (* rrb "29-Apr-85 12:57")
(* returns a copy of the global elements that have had each of its control points transformed by transformfn.
TRANSFORMDATA is arbitrary data that is passed to tranformfn.)
(MAPGLOBALSKETCHSPECS SCRELTS (FUNCTION SK.TRANSFORM.ELEMENT)
TRANSFORMFN TRANSFORMDATA (SK.TRANSFORM.SCALE.FACTOR TRANSFORMFN
TRANSFORMDATA])
(GLOBALELEMENTP
[LAMBDA (ELT?) (* rrb "19-Feb-85 17:00")
(* * returns ELT? if it is a global sketch element.)
(AND (SKETCH.ELEMENT.NAMEP (fetch (GLOBALPART GTYPE) of ELT?))
ELT?])
(SK.TRANSFORM.SCALE.FACTOR
[LAMBDA (TRANSFORMFN TRANSFORMDATA) (* rrb "29-Apr-85 12:09")
(* calculates scaling factor based on the transform of points. Since the transform is arbitrary in x and y scaling,
this can't really do the right thing so it computes the area a unit square would have after transformation and uses
that.)
(COND
((EQ TRANSFORMFN (FUNCTION SK.PUT.ON.GRID)) (* test for specially in case grid is larger than unit.
Don't change the scale.)
1.0)
(T (PROG ((ORG (SK.TRANSFORM.POINT (CONSTANT (create POSITION
XCOORD ← 0
YCOORD ← 0))
TRANSFORMFN TRANSFORMDATA))
(YUNIT (SK.TRANSFORM.POINT (CONSTANT (create POSITION
XCOORD ← 0
YCOORD ← 1))
TRANSFORMFN TRANSFORMDATA))
(XUNIT (SK.TRANSFORM.POINT (CONSTANT (create POSITION
XCOORD ← 1
YCOORD ← 0))
TRANSFORMFN TRANSFORMDATA)))
(RETURN (SQRT (TIMES (DISTANCEBETWEEN YUNIT ORG)
(DISTANCEBETWEEN XUNIT ORG])
(SK.TRANSFORM.BRUSH
[LAMBDA (BRUSH SCALEFACTOR) (* rrb "26-Apr-85 09:34")
(* returns a brush scaled from size ORGSCALE to
NEWSCALE.)
(create BRUSH using BRUSH BRUSHSIZE ←(TIMES (fetch (BRUSH BRUSHSIZE) of BRUSH)
SCALEFACTOR])
(SK.TRANSFORM.ARROWHEADS
[LAMBDA (ARROWHEADS SCALEFACTOR) (* rrb "26-Sep-85 12:17")
(* returns a arrowhead specification scaled by
SCALEFACTOR)
(AND ARROWHEADS (LIST (AND (CAR ARROWHEADS)
(create ARROWHEAD
using (CAR ARROWHEADS)
ARROWLENGTH ← (TIMES (fetch (ARROWHEAD ARROWLENGTH)
of (CAR ARROWHEADS))
SCALEFACTOR)))
(AND (CADR ARROWHEADS)
(create ARROWHEAD
using (CADR ARROWHEADS)
ARROWLENGTH ← (TIMES (fetch (ARROWHEAD ARROWLENGTH)
of (CADR ARROWHEADS))
SCALEFACTOR)))
(CADDR ARROWHEADS])
(SCALE.BRUSH
[LAMBDA (BRUSH ORGSCALE NEWSCALE) (* rrb "29-Apr-85 11:53")
(* returns a brush scaled from size ORGSCALE to NEWSCALE. It will returns a size of 0 only if given a size of 0 This
is so that brushes that scale down always show up.)
(PROG ((BRUSHSIZE (FQUOTIENT (FTIMES (fetch (BRUSH BRUSHSIZE) of BRUSH)
ORGSCALE)
NEWSCALE)))
(RETURN (create BRUSH using BRUSH BRUSHSIZE ←(COND
((ZEROP BRUSHSIZE)
0)
(T (IMAX 1 (FIXR BRUSHSIZE])
)
(DEFINEQ
(TWO.PT.TRANSFORMATION.INPUTFN
[LAMBDA (WINDOW) (* rrb "19-Jul-85 10:35")
(* reads four points from the user and returns the two
point transformation that maps the first two into the
second two.)
(PROG ((SCALE (WINDOW.SCALE WINDOW))
FIRSTPT SECONDPT THIRDPT FOURTHPT FIRSTLOCALPT SECONDLOCALPT THIRDLOCALPT FOURTHLOCALPT)
(STATUSPRINT WINDOW "
" "Indicate the first point to move.")
(COND
((SETQ FIRSTPT (SK.GETGLOBALPOSITION WINDOW))
(SK.MARK.POSITION (SETQ FIRSTLOCALPT (SCALE.POSITION FIRSTPT SCALE))
WINDOW FIRSTPTMARK))
(T (CLOSEPROMPTWINDOW WINDOW)
(RETURN NIL)))
(STATUSPRINT WINDOW "
" "Indicate the second point to move.")
(COND
((SETQ SECONDPT (SK.GETGLOBALPOSITION WINDOW))
(SK.MARK.POSITION (SETQ SECONDLOCALPT (SCALE.POSITION SECONDPT SCALE))
WINDOW SECONDPTMARK))
(T (* erase first pt on way out)
(SK.MARK.POSITION FIRSTLOCALPT WINDOW FIRSTPTMARK)
(CLOSEPROMPTWINDOW WINDOW)
(RETURN NIL)))
(STATUSPRINT WINDOW "
" "Indicate the new position of the first point.")
(COND
((SETQ THIRDPT (SK.GETGLOBALPOSITION WINDOW))
(SK.MARK.POSITION (SETQ THIRDLOCALPT (SCALE.POSITION THIRDPT SCALE))
WINDOW NEWFIRSTPTMARK))
(T (* erase first and second pts on way out)
(SK.MARK.POSITION FIRSTLOCALPT WINDOW FIRSTPTMARK)
(SK.MARK.POSITION SECONDLOCALPT WINDOW SECONDPTMARK)
(CLOSEPROMPTWINDOW WINDOW)
(RETURN NIL)))
(STATUSPRINT WINDOW "
" "Indicate the new position of the second point.")
(SETQ FOURTHPT (SK.GETGLOBALPOSITION WINDOW))
(CLOSEPROMPTWINDOW WINDOW) (* erase the point marks.)
(SK.MARK.POSITION FIRSTLOCALPT WINDOW FIRSTPTMARK)
(SK.MARK.POSITION SECONDLOCALPT WINDOW SECONDPTMARK)
(SK.MARK.POSITION THIRDLOCALPT WINDOW NEWFIRSTPTMARK)
(OR FOURTHPT (RETURN NIL)) (* keep the coefficients of the two necessary
equations.)
(RETURN (SK.COMPUTE.TWO.PT.TRANSFORMATION FIRSTPT SECONDPT THIRDPT FOURTHPT])
(SK.TWO.PT.TRANSFORM.ELTS
[LAMBDA (W) (* rrb "21-Apr-85 16:00")
(* lets the user select some elements and specify a two
point transformation and applies the transformation to
all of the points.)
(EVAL.AS.PROCESS (LIST (FUNCTION SK.SEL.AND.TWO.PT.TRANSFORM)
(KWOTE W])
(SK.SEL.AND.TWO.PT.TRANSFORM
[LAMBDA (W) (* rrb "28-Apr-85 16:06")
(* lets the user select some elements and specify a two
point transformation and applies the transformation to
all of the points.)
(PROG NIL
(SK.TRANSFORM.ELEMENTS (OR (SK.SELECT.MULTIPLE.ITEMS W T)
(RETURN))
(FUNCTION SK.APPLY.AFFINE.TRANSFORM)
(OR (TWO.PT.TRANSFORMATION.INPUTFN W)
(RETURN))
W])
(SK.APPLY.AFFINE.TRANSFORM
[LAMBDA (GPOSITION AFFINETRANS) (* rrb "28-Apr-85 16:05")
(* * applies a tranformation to the point. AFFINETRANS is an instance of AFFINETRANSFORMATION)
(create POSITION
XCOORD ←(PLUS (TIMES (fetch Ax of AFFINETRANS)
(fetch (POSITION XCOORD) of GPOSITION))
(TIMES (fetch By of AFFINETRANS)
(fetch (POSITION YCOORD) of GPOSITION))
(fetch C of AFFINETRANS))
YCOORD ←(PLUS (TIMES (fetch Dx of AFFINETRANS)
(fetch (POSITION XCOORD) of GPOSITION))
(TIMES (fetch Ey of AFFINETRANS)
(fetch (POSITION YCOORD) of GPOSITION))
(fetch F of AFFINETRANS])
(SK.COMPUTE.TWO.PT.TRANSFORMATION
[LAMBDA (P1 P2 Q1 Q2) (* rrb "14-Oct-85 18:09")
(* computes the AFFINETRANSFORMATION necessary to take
P1 into Q1 and P2 into Q2.)
(PROG ((PX1 (fetch (POSITION XCOORD) of P1))
(PY1 (fetch (POSITION YCOORD) of P1))
(PX2 (fetch (POSITION XCOORD) of P2))
(PY2 (fetch (POSITION YCOORD) of P2))
(QX1 (fetch (POSITION XCOORD) of Q1))
(QY1 (fetch (POSITION YCOORD) of Q1))
(QX2 (fetch (POSITION XCOORD) of Q2))
(QY2 (fetch (POSITION YCOORD) of Q2))
(MATRIX2 (CREATE3BY3))
(SCRATCHMATRIX)
MATRIX1 PDELTAX PDELTAY QDELTAX QDELTAY PLEN QLEN LENRATIO)
(* compute the transformation that translates P1 to the origin, rotates it until P has the same angle as Q, scales
it until P has the same length as Q then translates the new P1 to Q1.)
(SETQ PDELTAX (DIFFERENCE PX2 PX1))
(SETQ PDELTAY (DIFFERENCE PY2 PY1))
(SETQ QDELTAX (DIFFERENCE QX2 QX1))
(SETQ QDELTAY (DIFFERENCE QY2 QY1)) (* compute the length of segments P and Q.)
[SETQ PLEN (SQRT (PLUS (TIMES PDELTAX PDELTAX)
(TIMES PDELTAY PDELTAY]
(COND
((ZEROP PLEN)
(STATUSPRINT WINDOW "
" "The two source points can not be the same.")
(RETURN)))
[SETQ QLEN (SQRT (PLUS (TIMES QDELTAX QDELTAX)
(TIMES QDELTAY QDELTAY]
(COND
((ZEROP QLEN)
(STATUSPRINT WINDOW "The two destination points can not be the same.")
(RETURN)))
(* ratio is done to map P onto Q because the scaling is done after the rotation. It could be done first if the
mapping were done from Q onto P.)
(SETQ LENRATIO (QUOTIENT QLEN PLEN)) (* translate P1 to origin.)
(* use MATRIX1 and MATRIX2 to swap the running result back and forth since matrix multiplication routines don't
allow the result to be stored in one of the arguments.)
(SETQ MATRIX1 (TRANSLATE3BY3 (MINUS PX1)
(MINUS PY1)))
(* Scale to make P the same length as Q.)
(MATMULT333 MATRIX1 (SCALE3BY3 LENRATIO LENRATIO SCRATCHMATRIX)
MATRIX2) (* rotate it so that the slope of P is the same as Q.)
(MATMULT333 MATRIX2 (ROTATE3BY3 (DIFFERENCE (SK.COMPUTE.SLOPE PDELTAX PDELTAY)
(SK.COMPUTE.SLOPE QDELTAX QDELTAY))
SCRATCHMATRIX NIL)
MATRIX1) (* translate the origin pt to Q1.
This is complicated because Q1 needs to be translated,
rotated and scaled into new coordinates.)
(MATMULT333 MATRIX1 (TRANSLATE3BY3 QX1 QY1 SCRATCHMATRIX)
MATRIX2) (* return only the coefficients that make a
difference.)
(RETURN (create AFFINETRANSFORMATION
Ax ←(AREF MATRIX2 0 0)
By ←(AREF MATRIX2 1 0)
C ←(AREF MATRIX2 2 0)
Dx ←(AREF MATRIX2 0 1)
Ey ←(AREF MATRIX2 1 1)
F ←(AREF MATRIX2 2 1])
(SK.COMPUTE.SLOPE
[LAMBDA (DELTAX DELTAY) (* rrb "31-May-85 10:09")
(* computes the angle of a line from the delta X and
Y.)
(COND
((ZEROP DELTAX)
(COND
((GREATERP DELTAY 0)
90.0)
(T -90.0)))
(T (PLUS (COND
((GREATERP DELTAX 0)
0.0)
(T
(* if the line is sloping to the left, add 180 to it. This is done because we need to make sure that P1 gets mapped
into Q1.)
180.0))
(ARCTAN (FQUOTIENT DELTAY DELTAX])
(SK.THREE.PT.TRANSFORM.ELTS
[LAMBDA (W) (* rrb "28-Apr-85 16:55")
(* lets the user select some elements and specify a
three point transformation and applies the
transformation to all of the points.)
(EVAL.AS.PROCESS (LIST (FUNCTION SK.SEL.AND.THREE.PT.TRANSFORM)
(KWOTE W])
(SK.COMPUTE.THREE.PT.TRANSFORMATION
[LAMBDA (P1 P2 P3 Q1 Q2 Q3 ERRORFLG) (* rrb " 8-May-85 18:10")
(* computes the AFFINETRANSFORMATION necessary to take
P1 into Q1, P2 into Q2 and P3 into Q3.)
(PROG ((PX1 (fetch (POSITION XCOORD) of P1))
(PY1 (fetch (POSITION YCOORD) of P1))
(PX2 (fetch (POSITION XCOORD) of P2))
(PY2 (fetch (POSITION YCOORD) of P2))
(PX3 (fetch (POSITION XCOORD) of P3))
(PY3 (fetch (POSITION YCOORD) of P3))
(QX1 (fetch (POSITION XCOORD) of Q1))
(QY1 (fetch (POSITION YCOORD) of Q1))
(QX2 (fetch (POSITION XCOORD) of Q2))
(QY2 (fetch (POSITION YCOORD) of Q2))
(QX3 (fetch (POSITION XCOORD) of Q3))
(QY3 (fetch (POSITION YCOORD) of Q3))
DELTAPY12 DELTAPX12 DELTAPY23 A&DBOTTOM AX BY C DX EY F)
(* this is the computation dictated by solving the six equations of the form QX1 = aPX1 + bPY1 + c for a, b, c, d,
e, and f.)
(* save some subexpressions that are reused.)
(SETQ DELTAPX12 (FDIFFERENCE PX1 PX2))
(SETQ DELTAPY23 (FDIFFERENCE PY2 PY3))
[COND
((ZEROP (SETQ DELTAPY12 (FDIFFERENCE PY1 PY2)))
(* need to divide by this number and it is zero)
(COND
(ERRORFLG (* this is the second attempt, all points must be
horizontal)
(STATUSPRINT WINDOW "
"
"All three source points cannot be in the same line.
If you meant this, you should use the TWO PT TRANSFORM.")
(RETURN))
(T (* try switching two points)
(RETURN (SK.COMPUTE.THREE.PT.TRANSFORMATION P2 P3 P1 Q2 Q3 Q1 T]
[COND
([ZEROP (SETQ A&DBOTTOM (FDIFFERENCE (FDIFFERENCE PX2 PX3)
(FTIMES (FQUOTIENT DELTAPX12 DELTAPY12)
DELTAPY23]
(* need to divide by this number and it is zero)
(COND
(ERRORFLG (* this is the second attempt, maybe all points are
collinear, in any case, can't continue.)
(STATUSPRINT WINDOW "
"
"All three source points cannot be in the same line.
If you meant this, you should use the TWO PT TRANSFORM.")
(RETURN))
(T (* try switching two points)
(RETURN (SK.COMPUTE.THREE.PT.TRANSFORMATION P2 P3 P1 Q2 Q3 Q1 T]
(SETQ AX (FQUOTIENT (FDIFFERENCE (FDIFFERENCE QX2 QX3)
(FQUOTIENT (FTIMES (FDIFFERENCE QX1 QX2)
DELTAPY23)
DELTAPY12))
A&DBOTTOM))
(SETQ DX (FQUOTIENT (FDIFFERENCE (FDIFFERENCE QY2 QY3)
(FQUOTIENT (FTIMES (FDIFFERENCE QY1 QY2)
DELTAPY23)
DELTAPY12))
A&DBOTTOM))
(SETQ BY (FQUOTIENT (FDIFFERENCE (FDIFFERENCE QX1 QX2)
(FTIMES AX DELTAPX12))
DELTAPY12))
(SETQ EY (FQUOTIENT (FDIFFERENCE (FDIFFERENCE QY1 QY2)
(FTIMES DX DELTAPX12))
DELTAPY12))
[SETQ C (FDIFFERENCE QX1 (FPLUS (FTIMES AX PX1)
(FTIMES BY PY1]
[SETQ F (FDIFFERENCE QY1 (FPLUS (FTIMES DX PX1)
(FTIMES EY PY1]
(RETURN (create AFFINETRANSFORMATION
Ax ← AX
By ← BY
C ← C
Dx ← DX
Ey ← EY
F ← F])
(SK.SEL.AND.THREE.PT.TRANSFORM
[LAMBDA (W) (* rrb "28-Apr-85 16:38")
(* lets the user select some elements and specify a
three point transformation and applies the
transformation to all of the points.)
(PROG NIL
(SK.TRANSFORM.ELEMENTS (OR (SK.SELECT.MULTIPLE.ITEMS W T)
(RETURN))
(FUNCTION SK.APPLY.AFFINE.TRANSFORM)
(OR (THREE.PT.TRANSFORMATION.INPUTFN W)
(RETURN))
W])
(THREE.PT.TRANSFORMATION.INPUTFN
[LAMBDA (WINDOW) (* rrb "28-Apr-85 16:53")
(* reads six points from the user and returns the
affine transformation that maps the first three into
the second three)
(PROG ((SCALE (WINDOW.SCALE WINDOW))
FIRSTPT SECONDPT THIRDPT FOURTHPT FIFTHPT SIXTHPT FIRSTLOCALPT SECONDLOCALPT THIRDLOCALPT
FOURTHLOCALPT FIFTHLOCALPT)
(STATUSPRINT WINDOW "
" "Indicate the first point to move.")
(COND
((SETQ FIRSTPT (SK.GETGLOBALPOSITION WINDOW))
(SK.MARK.POSITION (SETQ FIRSTLOCALPT (SCALE.POSITION FIRSTPT SCALE))
WINDOW FIRSTPTMARK))
(T (CLOSEPROMPTWINDOW WINDOW)
(RETURN NIL)))
(STATUSPRINT WINDOW "
" "Indicate the second point to move.")
(COND
((SETQ SECONDPT (SK.GETGLOBALPOSITION WINDOW))
(SK.MARK.POSITION (SETQ SECONDLOCALPT (SCALE.POSITION SECONDPT SCALE))
WINDOW SECONDPTMARK))
(T (* erase first pt on way out)
(SK.MARK.POSITION FIRSTLOCALPT WINDOW FIRSTPTMARK)
(CLOSEPROMPTWINDOW WINDOW)
(RETURN NIL)))
(STATUSPRINT WINDOW "
" "Indicate the third point to move.")
(COND
((SETQ THIRDPT (SK.GETGLOBALPOSITION WINDOW))
(SK.MARK.POSITION (SETQ THIRDLOCALPT (SCALE.POSITION THIRDPT SCALE))
WINDOW THIRDPTMARK))
(T (* erase first and second pts on way out)
(SK.MARK.POSITION FIRSTLOCALPT WINDOW FIRSTPTMARK)
(SK.MARK.POSITION SECONDLOCALPT WINDOW SECONDPTMARK)
(CLOSEPROMPTWINDOW WINDOW)
(RETURN NIL)))
(STATUSPRINT WINDOW "
" "Indicate the new position of the first point.")
(COND
((SETQ FOURTHPT (SK.GETGLOBALPOSITION WINDOW))
(SK.MARK.POSITION (SETQ FOURTHLOCALPT (SCALE.POSITION FOURTHPT SCALE))
WINDOW NEWFIRSTPTMARK))
(T (* erase first second and third pts on way out)
(SK.MARK.POSITION FIRSTLOCALPT WINDOW FIRSTPTMARK)
(SK.MARK.POSITION SECONDLOCALPT WINDOW SECONDPTMARK)
(SK.MARK.POSITION THIRDLOCALPT WINDOW THIRDPTMARK)
(CLOSEPROMPTWINDOW WINDOW)
(RETURN NIL)))
(STATUSPRINT WINDOW "
" "Indicate the new position of the second point.")
(COND
((SETQ FIFTHPT (SK.GETGLOBALPOSITION WINDOW))
(SK.MARK.POSITION (SETQ FIFTHLOCALPT (SCALE.POSITION FIFTHPT SCALE))
WINDOW NEWSECONDPTMARK))
(T (* erase first second and third pts on way out)
(SK.MARK.POSITION FIRSTLOCALPT WINDOW FIRSTPTMARK)
(SK.MARK.POSITION SECONDLOCALPT WINDOW SECONDPTMARK)
(SK.MARK.POSITION THIRDLOCALPT WINDOW THIRDPTMARK)
(SK.MARK.POSITION FOURTHLOCALPT WINDOW NEWFIRSTPTMARK)
(CLOSEPROMPTWINDOW WINDOW)
(RETURN NIL)))
(STATUSPRINT WINDOW "
" "Indicate the new position of the third point.")
(SETQ SIXTHPT (SK.GETGLOBALPOSITION WINDOW))
(CLOSEPROMPTWINDOW WINDOW) (* erase the point marks.)
(SK.MARK.POSITION FIRSTLOCALPT WINDOW FIRSTPTMARK)
(SK.MARK.POSITION SECONDLOCALPT WINDOW SECONDPTMARK)
(SK.MARK.POSITION THIRDLOCALPT WINDOW THIRDPTMARK)
(SK.MARK.POSITION FOURTHLOCALPT WINDOW NEWFIRSTPTMARK)
(SK.MARK.POSITION FIFTHLOCALPT WINDOW NEWSECONDPTMARK)
(OR SIXTHPT (RETURN NIL)) (* keep the coefficients of the two necessary
equations.)
(RETURN (SK.COMPUTE.THREE.PT.TRANSFORMATION FIRSTPT SECONDPT THIRDPT FOURTHPT FIFTHPT
SIXTHPT])
)
(DEFINEQ
(SK.COPY.AND.TWO.PT.TRANSFORM.ELTS
[LAMBDA (W) (* rrb " 8-May-85 17:24")
(* lets the user select some elements and specify a two
point transformation and applies the transformation to
all of the points.)
(EVAL.AS.PROCESS (LIST (FUNCTION SK.SEL.COPY.AND.TWO.PT.TRANSFORM)
(KWOTE W])
(SK.SEL.COPY.AND.TWO.PT.TRANSFORM
[LAMBDA (W) (* rrb " 8-May-85 17:24")
(* lets the user select some elements and specify a two
point transformation and applies the transformation to
all copies of the points.)
(PROG NIL
(SK.COPY.AND.TRANSFORM.ELEMENTS (OR (SK.SELECT.MULTIPLE.ITEMS W T)
(RETURN))
(FUNCTION SK.APPLY.AFFINE.TRANSFORM)
(OR (TWO.PT.TRANSFORMATION.INPUTFN W)
(RETURN))
W])
(SK.COPY.AND.THREE.PT.TRANSFORM.ELTS
[LAMBDA (W) (* rrb " 8-May-85 17:34")
(* lets the user select some elements and specify a
three point transformation and applies the
transformation to copies of the elements)
(EVAL.AS.PROCESS (LIST (FUNCTION SK.SEL.COPY.AND.THREE.PT.TRANSFORM)
(KWOTE W])
(SK.SEL.COPY.AND.THREE.PT.TRANSFORM
[LAMBDA (W) (* rrb " 8-May-85 17:26")
(* lets the user select some elements and specify a
three point transformation and applies the
transformation to copies of the elements)
(PROG NIL
(SK.COPY.AND.TRANSFORM.ELEMENTS (OR (SK.SELECT.MULTIPLE.ITEMS W T)
(RETURN))
(FUNCTION SK.APPLY.AFFINE.TRANSFORM)
(OR (THREE.PT.TRANSFORMATION.INPUTFN W)
(RETURN))
W])
(SK.COPY.AND.TRANSFORM.ELEMENTS
[LAMBDA (SCRELTS TRANSFORMFN TRANSFORMDATA SKW) (* rrb " 8-May-85 17:08")
(* changes copies of SCRELTS to the elements that have had each of their control points transformed by transformfn.
TRANSFORMDATA is arbitrary data that is passed to tranformfn.)
(PROG (NEWGLOBALS)
(* computes the scale factor inherent in the transformation so that it doesn't have to be done on every element that
might need it. It major use is in scaling brush sizes.)
(SETQ NEWGLOBALS (MAPCOLLECTSKETCHSPECS SCRELTS (FUNCTION SK.COPY.AND.TRANSFORM.ITEM)
TRANSFORMFN TRANSFORMDATA (
SK.TRANSFORM.SCALE.FACTOR TRANSFORMFN
TRANSFORMDATA)
SKW)) (* make a history entry.)
(SK.ADD.HISTEVENT (QUOTE COPY)
NEWGLOBALS SKW)
(RETURN NEWGLOBALS])
(SK.COPY.AND.TRANSFORM.ITEM
[LAMBDA (SELELT TRANSFORMFN TRANSFORMDATA SCALEFACTOR W) (* rrb " 8-May-85 17:02")
(* SELELT is a sketch element that was selected for a
copy and transformation operation.)
(PROG (NEWGLOBAL)
(COND
((SETQ NEWGLOBAL (SK.TRANSFORM.ELEMENT (fetch (SCREENELT GLOBALPART) of SELELT)
TRANSFORMFN TRANSFORMDATA SCALEFACTOR))
(SK.ADD.ELEMENT NEWGLOBAL W)
(RETURN NEWGLOBAL])
)
(DECLARE: DONTCOPY
[DECLARE: EVAL@COMPILE
(RECORD AFFINETRANSFORMATION (Ax By C Dx Ey F))
]
)
(READVARS FIRSTPTMARK SECONDPTMARK THIRDPTMARK NEWFIRSTPTMARK NEWSECONDPTMARK)
({(READBITMAP)(25 25
"AOCNB@@@"
"AA@HF@@@"
"AA@HB@@@"
"AN@HB@@@"
"A@@HB@@@"
"A@@HB@@@"
"A@@HOH@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@H@@@@"
"@@@H@@@@"
"@@@H@@@@"
"@@GO@@@@"
"@@@H@@@@"
"@@@H@@@@"
"@@@H@@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@@@@@@")} {(READBITMAP)(25 25
"AOCNG@@@"
"AA@HHH@@"
"AA@HAH@@"
"AN@HG@@@"
"A@@HL@@@"
"A@@HH@@@"
"A@@HOH@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@H@@@@"
"@@@H@@@@"
"@@@H@@@@"
"@@GO@@@@"
"@@@H@@@@"
"@@@H@@@@"
"@@@H@@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@@@@@@")} {(READBITMAP)(25 25
"AOCNG@@@"
"AA@HHH@@"
"AA@HAH@@"
"AN@HF@@@"
"A@@HAH@@"
"A@@HHH@@"
"A@@HG@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@H@@@@"
"@@@H@@@@"
"@@@H@@@@"
"@@GO@@@@"
"@@@H@@@@"
"@@@H@@@@"
"@@@H@@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@@@@@@")} {(READBITMAP)(25 25
"AAGJB@@@"
"AIDBJ@@@"
"AEDBJ@@@"
"AEGBJ@@@"
"ACDBJ@@@"
"ACDBJ@@@"
"AAGID@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@H@@@@"
"@@@H@@@@"
"@@@H@@@@"
"@@GO@@@@"
"@@@H@@@@"
"@@@H@@@@"
"@@@H@@@@"
"@@@@@@@@"
"@@@@@@@@"
"AOCNB@@@"
"AA@HF@@@"
"AA@HB@@@"
"AN@HB@@@"
"A@@HB@@@"
"A@@HB@@@"
"A@@HOH@@")} {(READBITMAP)(25 25
"AAGJB@@@"
"AIDBJ@@@"
"AEDBJ@@@"
"AEGBJ@@@"
"ACDBJ@@@"
"ACDBJ@@@"
"AAGID@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@H@@@@"
"@@@H@@@@"
"@@@H@@@@"
"@@GO@@@@"
"@@@H@@@@"
"@@@H@@@@"
"@@@H@@@@"
"@@@@@@@@"
"@@@@@@@@"
"AOCNCH@@"
"AA@HDD@@"
"AA@H@D@@"
"AN@HAH@@"
"A@@HF@@@"
"A@@HD@@@"
"A@@HGL@@")})
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS FIRSTPTMARK SECONDPTMARK THIRDPTMARK NEWFIRSTPTMARK NEWSECONDPTMARK)
)
(COND ((EQ MAKESYSNAME (QUOTE INTERMEZZO))
(FILESLOAD MATRIXUSE))
(T (FILESLOAD MATMULT)))
(* programmer interface entries)
(DEFINEQ
(SKETCH.ELEMENTS.OF.SKETCH
[LAMBDA (SKETCH) (* rrb " 2-Aug-85 16:21")
(* Returns the list of elements that are in SKETCH. SKETCH can be either a SKETCH structure, a sketch window
(sometimes called a viewer) or a SKETCH stream (obtained via (OPENIMAGESTREAM (QUOTE name) (QUOTE SKETCH)). If
SKETCH is not a sketch, a sketch window or a sketch stream, it returns NIL. This can be used with sketch streams to
determine the elements created by a call to a display function or series of functions by looking at the list
differences; new elements are always added at the end.))
(fetch (SKETCH SKETCHELTS) of (INSURE.SKETCH SKETCH T])
(SKETCH.LIST.OF.ELEMENTS
[LAMBDA (SKETCH PREDICATE INSIDEGROUPSFLG) (* rrb "14-Aug-85 16:26")
(* Returns a list of the sketch elements in SKETCH that satisfy PREDICATE. If INSIDEGROUPSFLG is T, elements that
are members of a group will be considered too. Otherwise only top level objects are considered.
Note: PREDICATE will be applied to GROUP elements even when INSIDEGROUPSFLG is T.)
(* FOR NOW, IGNORE INSIDEGROUPSFLG)
(for ELT in (SKETCH.ELEMENTS.OF.SKETCH SKETCH) when (APPLY* PREDICATE ELT) collect ELT])
(SKETCH.ADD.ELEMENT
[LAMBDA (ELEMENT SKETCH NODISPLAYFLG) (* rrb "14-Aug-85 17:05")
(* Adds an element to a sketch. If NODISPLAYFLG is NIL, any windows currently displaying SKETCH will be updated to
reflect ELEMENT's addition. If NODISPLAYFLG is T, the displays won't be updated.)
(PROG ((SKSTRUC (INSURE.SKETCH SKETCH)))
(OR (GLOBALELEMENTP ELEMENT)
(ERROR ELEMENT "is not a sketch element.")) (* add the element to the sketch.)
(ADD.ELEMENT.TO.SKETCH ELEMENT SKSTRUC) (* propagate to the viewers.)
(for SKW in (ALL.SKETCH.VIEWERS SKSTRUC) when (ELT.INSIDE.SKETCHWP ELEMENT SKW)
do (SKETCH.ADD.AND.DISPLAY1 ELEMENT SKW NODISPLAYFLG))
(RETURN T])
(SKETCH.DELETE.ELEMENT
[LAMBDA (ELEMENT SKETCH INSIDEGROUPSFLG NODISPLAYFLG) (* rrb "14-Aug-85 16:20")
(* Deletes an element from a sketch. If INSIDEGROUPSFLG is T, the element will be deleted even if it is inside a
group. Otherwise it will be deleted only if it is on the top level. If NODISPLAYFLG is NIL, any windows currently
displaying SKETCH will be updated to reflect ELEMENT's deletion. If NODISPLAYFLG is T, the displays won't be
updated. It returns ELEMENT if ELEMENT was deleted.)
(PROG ((SKSTRUC (INSURE.SKETCH SKETCH))
LOCALELT OLDGELT) (* delete the element to the sketch.)
(COND
((EQ T (SETQ OLDGELT (REMOVE.ELEMENT.FROM.SKETCH ELEMENT SKSTRUC INSIDEGROUPSFLG)))
(* element deleted was top level.)
)
(OLDGELT (* element deleted was part of a group.)
(printout PROMPTWINDOW T "member of group deleted but group not redrawn."))
(T (RETURN NIL))) (* propagate to the viewers.)
(for SKW in (ALL.SKETCH.VIEWERS SKSTRUC) when (SETQ LOCALELT (SK.LOCAL.ELT.FROM.GLOBALPART
ELEMENT SKW))
do (SK.ERASE.AND.DELETE.ITEM LOCALELT SKW NODISPLAYFLG))
(SK.CHECK.WHENDELETEDFN ELEMENT SKETCH)
(RETURN OLDGELT])
(DELFROMGROUPELT
[LAMBDA (ELTTODEL GROUPELT) (* rrb " 2-Aug-85 17:03")
(* if ELTTODEL is a member of GROUPELT, this deletes
it.)
(AND (EQ (fetch (GLOBALPART GTYPE) of GROUPELT)
(QUOTE GROUP))
(PROG ((INDVGROUPELT (fetch (GLOBALPART INDIVIDUALGLOBALPART) of GROUPELT))
SUBELTS)
(SETQ SUBELTS (fetch (GROUP LISTOFGLOBALELTS) of INDVGROUPELT))
(COND
((MEMBER ELTTODEL SUBELTS)
(replace (GROUP LISTOFGLOBALELTS) of INDVGROUPELT with (REMOVE ELTTODEL SUBELTS))
(RETURN T))
(T (RETURN (for ELT in SUBELTS thereis (DELFROMGROUPELT ELTTODEL ELT])
(SKETCH.ELEMENT.TYPE
[LAMBDA (ELEMENT) (* rrb "14-Aug-85 16:35")
(* returns the type of a global sketch element)
(fetch (GLOBALPART GTYPE) of ELEMENT])
(SKETCH.ELEMENT.CHANGED
[LAMBDA (SKETCH ELEMENT SKETCHWINDOW) (* rrb " 5-Sep-85 10:56")
(* If ELEMENT is an element of SKETCH, its local part is recalculated. This is normally used to notify sketch that
an image object element has changed. Note: this replaces the element with another one.)
(PROG ((SKETCH (INSURE.SKETCH SKETCH))
OLDREG)
(OR (GLOBALELEMENTP ELEMENT)
(ERROR ELEMENT " is not a sketch element.")) (* note that the sketch has changed.)
(SK.MARK.DIRTY SKETCH)
(SETQ OLDREG (fetch (SKIMAGEOBJ SKIMOBJ.GLOBALREGION) of (fetch (GLOBALPART
INDIVIDUALGLOBALPART)
of ELEMENT)))
(SK.UPDATE.GLOBAL.IMAGE.OBJECT.ELEMENT ELEMENT) (* do the window that the interaction occurred in
first.)
(AND SKETCHWINDOW (SK.ELEMENT.CHANGED1 ELEMENT OLDREG SKETCHWINDOW))
(* propagate to other windows.)
(for SKW in (ALL.SKETCH.VIEWERS SKETCH) when (NEQ SKW SKETCHWINDOW)
do (SK.ELEMENT.CHANGED1 ELEMENT OLDREG SKW))
(RETURN ELEMENT])
(SK.ELEMENT.CHANGED1
[LAMBDA (SKIMAGEOBJELT OLDREGION SKETCHW) (* rrb "21-Aug-85 15:54")
(* updates the display of an image object element in a
window.)
(PROG (LOCALELT)
(COND
((SETQ LOCALELT (SK.LOCAL.ELT.FROM.GLOBALPART SKIMAGEOBJELT SKETCHW))
(COND
((EQ (SKETCH.ELEMENT.TYPE SKIMAGEOBJELT)
(QUOTE SKIMAGEOBJ))
(SK.DELETE.ITEM LOCALELT SKETCHW)
(DSPFILL OLDREGION WHITESHADE (QUOTE REPLACE)
SKETCHW)
(RETURN (SKETCH.ADD.AND.DISPLAY1 SKIMAGEOBJELT SKETCHW])
(SK.UPDATE.GLOBAL.IMAGE.OBJECT.ELEMENT
[LAMBDA (SKIMOBJELT) (* rrb "21-Aug-85 16:05")
(* updates the fields to reflect changes in the size of
the image object.)
(PROG ((INDVSKIMOBJELT (fetch (GLOBALPART INDIVIDUALGLOBALPART) of SKIMOBJELT))
IMOBJSIZE REGION SCALE)
(SETQ IMOBJSIZE (IMAGEBOXSIZE (fetch (SKIMAGEOBJ SKIMAGEOBJ) of INDVSKIMOBJELT)))
(SETQ REGION (fetch (SKIMAGEOBJ SKIMOBJ.GLOBALREGION) of INDVSKIMOBJELT))
(SETQ SCALE (fetch (SKIMAGEOBJ SKIMOBJ.ORIGSCALE) of INDVSKIMOBJELT))
(replace (SKIMAGEOBJ SKIMOBJ.GLOBALREGION) of INDVSKIMOBJELT
with (CREATEREGION (fetch (REGION LEFT) of REGION)
(fetch (REGION BOTTOM) of REGION)
(TIMES (fetch (IMAGEBOX XSIZE) of IMOBJSIZE)
SCALE)
(TIMES (fetch (IMAGEBOX YSIZE) of IMOBJSIZE)
SCALE)))
(replace (SKIMAGEOBJ SKIMOBJ.OFFSETPOS) of INDVSKIMOBJELT
with (create POSITION
XCOORD ←(fetch (IMAGEBOX XKERN) of IMOBJSIZE)
YCOORD ←(fetch (IMAGEBOX YDESC) of IMOBJSIZE)))
(RETURN SKIMOBJELT])
)
(* utility routines for sketch windows.)
(DEFINEQ
(INSURE.SKETCH
[LAMBDA (SK NOERRORFLG) (* rrb "31-Aug-85 18:48")
(* returns the SKETCH structure from a window, sketch
stream, or a structure.)
(COND
((type? SKETCH SK)
SK)
[(WINDOWP SK)
(COND
((WINDOWPROP SK (QUOTE SKETCH)))
(T (AND (NULL NOERRORFLG)
(ERROR SK "doesn't have a SKETCH property."]
[(IMAGESTREAMTYPEP SK (QUOTE SKETCH)) (* this is a sketch stream)
(COND
((WINDOWPROP (\SKSTRM.WINDOW.FROM.STREAM SK)
(QUOTE SKETCH)))
(T (AND (NULL NOERRORFLG)
(ERROR "sketch stream window doesn't have SKETCH property" SK]
((AND (LITATOM (CAR SK))
(for ELT in (CDR SK) always (GLOBALELEMENTP ELT)))
(* old form, probably written out by notecards, update
to new form.)
(PROG (X)
(SETQ X (SKIO.UPDATE.FROM.OLD.FORM SK)) (* smash sketch so this won't have to happen every
time.)
(RPLACA SK (CAR X))
(RPLACD SK (CDR X))
(RETURN X)))
((NULL NOERRORFLG)
(ERROR SK "not a SKETCH"])
(LOCALSPECS.FROM.VIEWER
[LAMBDA (SKW) (* rrb "12-May-85 16:46")
(* returns the sketch specification displayed in the
window SKW.)
(CDAR (WINDOWPROP SKW (QUOTE SKETCHSPECS])
(SK.LOCAL.ELT.FROM.GLOBALPART
[LAMBDA (GLOBALPART SKW) (* rrb "18-MAR-83 13:09")
(* returns the local element from SKW that has global
part GLOBALPART -
NIL if there isn't one.)
(for ELT in (LOCALSPECS.FROM.VIEWER SKW) when (EQ (fetch (SCREENELT GLOBALPART) of ELT)
GLOBALPART)
do (RETURN ELT])
(SKETCH.FROM.VIEWER
[LAMBDA (SKETCHW) (* returns the sketch that the window views.)
(WINDOWPROP SKETCHW (QUOTE SKETCH])
(INSPECT.SKETCH
[LAMBDA (SKW) (* rrb "18-Apr-84 14:44")
(* calls the inspector on the sketch specs of a sketch
window.)
(PROG ((SPECS (LOCALSPECS.FROM.VIEWER SKW)))
(COND
(SPECS (INSPECT/TOP/LEVEL/LIST SPECS])
)
(DEFINEQ
(MAPSKETCHSPECS
[LAMBDA (SKSPECS SPECFN DATUM DATUM2 DATUM3) (* rrb "10-Sep-84 14:58")
(* walks through a sketch specification list and
applies SPECFN to each of the individual elements.)
(AND SKSPECS (COND
((SCREENELEMENTP SKSPECS)
(APPLY* SPECFN SKSPECS DATUM DATUM2 DATUM3))
((LISTP SKSPECS)
(for FIGSPEC in SKSPECS do (MAPSKETCHSPECS FIGSPEC SPECFN DATUM DATUM2 DATUM3)))
(T (ERROR "unknown figure specification" SKSPECS])
(MAPCOLLECTSKETCHSPECS
[LAMBDA (SKSPECS SPECFN DATUM DATUM2 DATUM3 DATUM4) (* rrb "26-Apr-85 09:29")
(* walks through a sketch specification list and
applies SPECFN to each of the individual
(elements returning a list of the results.))
(AND SKSPECS (COND
((SCREENELEMENTP SKSPECS)
(APPLY* SPECFN SKSPECS DATUM DATUM2 DATUM3 DATUM4))
((LISTP SKSPECS)
(for FIGSPEC in SKSPECS collect (MAPCOLLECTSKETCHSPECS FIGSPEC SPECFN DATUM DATUM2
DATUM3 DATUM4)))
(T (ERROR "unknown figure specification" SKSPECS])
(MAPSKETCHSPECSUNTIL
[LAMBDA (SKETCHSPECS SPECFN DATUM DATUM2) (* rrb " 4-AUG-83 15:22")
(* walks through a sketch specification list and
applies SPECFN to each of the individual elements.)
(AND SKETCHSPECS (COND
((SKETCH.ELEMENT.NAMEP (fetch (SCREENELT GTYPE) of SKETCHSPECS))
(APPLY* SPECFN SKETCHSPECS DATUM DATUM2))
((LISTP SKETCHSPECS)
(for FIGSPEC in SKETCHSPECS bind VALUE when (SETQ VALUE (MAPSKETCHSPECSUNTIL FIGSPEC
SPECFN
DATUM
DATUM2))
do (RETURN VALUE)))
(T (ERROR "unknown figure specification" SKETCHSPECS])
(MAPGLOBALSKETCHSPECS
[LAMBDA (SKSPECS SPECFN DATUM DATUM2 DATUM3) (* rrb "19-Feb-85 17:52")
(* walks through a list of global sketch elements and
applies SPECFN to each of the individual elements.)
(AND SKSPECS (COND
((GLOBALELEMENTP SKSPECS)
(APPLY* SPECFN SKSPECS DATUM DATUM2 DATUM3))
((LISTP SKSPECS)
(for FIGSPEC in SKSPECS collect (MAPGLOBALSKETCHSPECS FIGSPEC SPECFN DATUM DATUM2 DATUM3)
))
(T (ERROR "unknown global sketch element" SKSPECS])
(MAPGLOBALSKETCHELEMENTS
[LAMBDA (SKSPECS SPECFN DATUM DATUM2 DATUM3) (* rrb "24-Apr-85 15:02")
(* walks through a list of global sketch elements and applies SPECFN to each of the individual elements.
Differes from MAPGLOBALSKETCHSPECS in that it know about and gets inside of GROUP elements.)
(AND SKSPECS (COND
[(GLOBALELEMENTP SKSPECS)
(COND
((EQ (fetch (GLOBALPART GTYPE) of SKSPECS)
(QUOTE GROUP)) (* map function down the individual elements.)
(MAPGLOBALSKETCHELEMENTS (fetch (GROUP LISTOFGLOBALELTS) of (fetch (GLOBALPART
INDIVIDUALGLOBALPART)
of SKSPECS))
SPECFN DATUM DATUM2 DATUM3))
(T (APPLY* SPECFN SKSPECS DATUM DATUM2 DATUM3]
((LISTP SKSPECS)
(for FIGSPEC in SKSPECS collect (MAPGLOBALSKETCHELEMENTS FIGSPEC SPECFN DATUM DATUM2
DATUM3)))
(T (ERROR "unknown global sketch element" SKSPECS])
(GETSKELEMENTPROP
[LAMBDA (ELEMENT PROPERTY) (* gets the property from a sketch element.)
(LISTGET (fetch (GLOBALPART SKELEMENTPROPLIST) of ELEMENT)
PROPERTY])
(PUTSKELEMENTPROP
[LAMBDA (ELEMENT PROPERTY VALUE) (* rrb "25-Apr-85 11:23")
(* puts the property from a sketch element.)
(PROG ((PLIST (fetch (GLOBALPART SKELEMENTPROPLIST) of ELEMENT)))
(RETURN (COND
(PLIST (replace (GLOBALPART SKELEMENTPROPLIST) of ELEMENT
with (LISTPUT (fetch (GLOBALPART SKELEMENTPROPLIST) of ELEMENT)
PROPERTY VALUE)))
(T (replace (GLOBALPART SKELEMENTPROPLIST) of ELEMENT with (LIST PROPERTY VALUE])
)
(* functions for marking)
(DEFINEQ
(SK.SHOWMARKS
[LAMBDA (W HOTSPOTCACHE) (* rrb "29-Jan-85 18:04")
(* marks all of the hot spots of sketch elements in a
figure window.)
(bind Y for BUCKET in HOTSPOTCACHE
do (SETQ Y (CAR BUCKET))
(for XBUCKET in (CDR BUCKET)
do (* there may be old buckets that don't contain any
elements.)
(AND (CDR XBUCKET)
(SK.MARK.HOTSPOT (CAR XBUCKET)
Y W SK.LOCATEMARK])
(MARKPOINT
[LAMBDA (PT WINDOW MARK) (* rrb "12-May-85 18:50")
(* marks a point in a window with a mark.
The mark should be a bitmap.)
(OR MARK (SETQ MARK SK.SELECTEDMARK))
(PROG ((MARKWIDTH (BITMAPWIDTH MARK)))
(RETURN (BITBLT MARK 0 0 WINDOW (IDIFFERENCE (fetch (POSITION XCOORD) of PT)
(LRSH MARKWIDTH 1))
(IDIFFERENCE (fetch (POSITION YCOORD) of PT)
(LRSH (fetch (BITMAP BITMAPHEIGHT) of MARK)
1))
MARKWIDTH MARKWIDTH (QUOTE INPUT)
(QUOTE INVERT])
(SK.MARKHOTSPOTS
[LAMBDA (SKETCHELT W MARK) (* rrb "12-May-85 18:59")
(* marks the hotspots of a sketch element that are not
already selected)
(PROG [(HOTSPOTCACHE (SK.HOTSPOT.CACHE W))
(SELECTEDELTS (WINDOWPROP W (QUOTE SKETCH.SELECTIONS]
(for PTTAIL on (fetch (LOCALPART HOTSPOTS) of (fetch (SCREENELT LOCALPART) of SKETCHELT))
unless (OR (MEMBER (CAR PTTAIL)
(CDR PTTAIL))
(for ELTSOFPT in (SK.ELTS.FROM.HOTSPOT (CAR PTTAIL)
HOTSPOTCACHE)
thereis (MEMB ELTSOFPT SELECTEDELTS)))
do (* mark points that aren't also hotspots of an already
selected element or duplicate hot spots of this
element.)
(MARKPOINT (CAR PTTAIL)
W MARK])
(SK.MARK.SELECTION
[LAMBDA (ELT SKW MARKBM) (* rrb " 9-May-85 10:42")
(* marks or unmarks a selection.)
(COND
((POSITIONP ELT) (* handle positions {points} specially.)
(MARKPOINT ELT SKW MARKBM))
(T (SK.MARKHOTSPOTS ELT SKW MARKBM])
)
(READVARS POINTMARK SPOTMARKER)
({(READBITMAP)(7 7
"HB@@"
"DD@@"
"BH@@"
"A@@@"
"BH@@"
"DD@@"
"HB@@")} {(READBITMAP)(17 18
"@@@@@@@@"
"@@@@@@@@"
"@@L@@@@@"
"@@L@@@@@"
"@@L@@@@@"
"@@L@@@@@"
"@@@@@@@@"
"ANMN@@@@"
"ANMN@@@@"
"@@@@@@@@"
"@@L@@@@@"
"@@L@@@@@"
"@@L@@@@@"
"@@L@@@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@@@@@@")})
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS POINTMARK SPOTMARKER)
)
(RPAQ POINTREADINGCURSOR (CURSORCREATE (READBITMAP) 7 7))
(16 16
"@@@@"
"@GL@"
"ALG@"
"C@AH"
"F@@L"
"D@@D"
"L@@F"
"H@@B"
"HA@B"
"H@@B"
"L@@F"
"D@@D"
"F@@L"
"C@AH"
"ALG@"
"@GL@")
(* hit detection functions.)
(DEFINEQ
(SK.SELECT.ITEM
[LAMBDA (WINDOW ITEMFLG SELITEMS) (* rrb "31-Jul-85 09:45")
(* selects allows the user to select one of the sketch elements from the sketch WINDOW. If ITEMFLG is non-NIL, it
returns the item selected, otherwise it returns the position. If SELITEMS is given it is used as the items to be
marked and selected from. Keeps control and probably shouldn't)
(PROG (HOTSPOTCACHE NOW PREVIOUS OLDPOS)
(COND
(SELITEMS (* create a cache for the items to select from)
(SETQ HOTSPOTCACHE (SK.ADD.HOTSPOTS.TO.CACHE SELITEMS NIL)))
((LOCALSPECS.FROM.VIEWER WINDOW)
(SETQ HOTSPOTCACHE (SK.HOTSPOT.CACHE WINDOW)))
(T (* no items, don't do anything.)
(RETURN)))
(TOTOPW WINDOW)
(SK.SHOWMARKS WINDOW HOTSPOTCACHE)
(until (MOUSESTATE (NOT UP)))
(COND
((NOT (LASTMOUSESTATE (OR LEFT MIDDLE))) (* for now not interested in anything besides left and
middle.)
(SK.SHOWMARKS WINDOW HOTSPOTCACHE)
(RETURN))) (* note current item selection.)
(SETQ NOW (IN.SKETCH.ELT? HOTSPOTCACHE (SETQ OLDPOS (CURSORPOSITION NIL WINDOW))
(NULL ITEMFLG)))
FLIP (* turn off old selection.)
(SK.DESELECT.ELT PREVIOUS WINDOW)
(SK.SELECT.ELT (SETQ PREVIOUS NOW)
WINDOW)
LP (* wait for a button up or move out of region)
(COND
((NOT (MOUSESTATE (OR LEFT MIDDLE))) (* button up, selected item if one)
(SK.DESELECT.ELT PREVIOUS WINDOW)
(SK.SHOWMARKS WINDOW HOTSPOTCACHE)
(RETURN PREVIOUS))
([EQUAL PREVIOUS (SETQ NOW (IN.SKETCH.ELT? HOTSPOTCACHE (CURSORPOSITION NIL WINDOW OLDPOS)
(NULL ITEMFLG]
(GO LP))
(T (GO FLIP])
(IN.SKETCH.ELT?
[LAMBDA (CACHE POS PTFLG) (* rrb "21-Feb-85 13:47")
(* returns the first element that POS is on.)
(PROG ((Y (fetch (POSITION YCOORD) of POS))
(X (fetch (POSITION XCOORD) of POS))
(BESTMEASURE 1000)
PTLEFT PTRIGHT PTTOP PTBOTTOM BESTELT BESTX BESTY YDIF THISDIF)
(SETQ PTLEFT (DIFFERENCE X SK.POINT.WIDTH))
(SETQ PTRIGHT (PLUS X SK.POINT.WIDTH))
(SETQ PTBOTTOM (DIFFERENCE Y SK.POINT.WIDTH))
(SETQ PTTOP (PLUS Y SK.POINT.WIDTH))
[for YBUCKET in CACHE when (ILEQ (CAR YBUCKET)
PTTOP)
do (COND
((ILESSP (CAR YBUCKET)
PTBOTTOM) (* stop when Y gets too small.)
(RETURN)))
(SETQ YDIF (ABS (DIFFERENCE (CAR YBUCKET)
Y)))
(for XBUCKET in (CDR YBUCKET) when (ILEQ (CAR XBUCKET)
PTRIGHT)
do (COND
((ILESSP (CAR XBUCKET)
PTLEFT) (* stop when X gets too small.)
(RETURN)))
(COND
((CDR XBUCKET) (* this bucket has entries)
[SETQ THISDIF (PLUS YDIF (ABS (DIFFERENCE (CAR XBUCKET)
X]
(COND
((ILESSP THISDIF BESTMEASURE)
(SETQ BESTMEASURE THISDIF)
(COND
(PTFLG (SETQ BESTX (CAR XBUCKET))
(SETQ BESTY (CAR YBUCKET)))
(T (SETQ BESTELT (CADR XBUCKET]
(RETURN (COND
(PTFLG (AND BESTX (create POSITION
XCOORD ← BESTX
YCOORD ← BESTY)))
(T BESTELT])
(SK.MARK.HOTSPOT
[LAMBDA (X Y WINDOW MARK) (* rrb "29-Jan-85 15:45")
(* marks a point in a window with a mark.
The mark should be a bitmap.)
(PROG ((MARKWIDTH (BITMAPWIDTH MARK))
HALFWIDTH)
(RETURN (BITBLT MARK 0 0 WINDOW (IDIFFERENCE X (SETQ HALFWIDTH (LRSH MARKWIDTH 1)))
(IDIFFERENCE Y HALFWIDTH)
MARKWIDTH MARKWIDTH (QUOTE INPUT)
(QUOTE INVERT])
(SK.MARK.POSITION
[LAMBDA (PT WINDOW MARKBITMAP) (* rrb "20-Apr-85 18:47")
(* marks a place on the sketch window WINDOW.)
(SK.MARK.HOTSPOT (fetch (POSITION XCOORD) of PT)
(fetch (POSITION YCOORD) of PT)
WINDOW MARKBITMAP])
(SK.SELECT.ELT
[LAMBDA (ELT FIGW MARKBM) (* rrb " 3-Oct-84 11:18")
(* selects an item from a figure window.)
(* for now just mark it.)
(AND ELT (SK.MARK.SELECTION ELT FIGW MARKBM])
(SK.DESELECT.ELT
[LAMBDA (ELT SKW MARKBM) (* rrb " 9-May-85 10:32")
(* turns off the selection marking of an item from a
figure window.)
(AND ELT (SK.MARK.SELECTION ELT SKW MARKBM])
)
(DECLARE: EVAL@COMPILE
(RPAQQ SK.POINT.WIDTH 4)
(CONSTANTS (SK.POINT.WIDTH 4))
)
(* fns to support caching of hotspots.)
(DEFINEQ
(SK.HOTSPOT.CACHE
[LAMBDA (SKW) (* rrb "29-Jan-85 14:23")
(* retrieve the hotspot cache associated with a sketch
window.)
(WINDOWPROP SKW (QUOTE HOTSPOT.CACHE])
(SK.SET.HOTSPOT.CACHE
[LAMBDA (SKW NEWCACHE) (* rrb "29-Jan-85 14:23")
(* stores the hotspot cache associated with a sketch
window.)
(WINDOWPROP SKW (QUOTE HOTSPOT.CACHE)
NEWCACHE])
(SK.CREATE.HOTSPOT.CACHE
[LAMBDA (SKW) (* rrb " 4-Feb-85 14:18")
(* creates the cache of hotspot locations for a sketch
window.)
(SK.SET.HOTSPOT.CACHE SKW (SK.ADD.HOTSPOTS.TO.CACHE (LOCALSPECS.FROM.VIEWER SKW)
NIL])
(SK.ELTS.FROM.HOTSPOT
[LAMBDA (POSITION CACHE) (* rrb "29-Jan-85 13:47")
(* returns a list of local elements that have POSITION
as one of their hotspots.)
(* a cache is an alist of alist with the top
descriminator being the Y value and the second one
being the X value.)
(PROG (TMP)
(RETURN (AND (SETQ TMP (SK.FIND.CACHE.BUCKET (fetch (POSITION YCOORD) of POSITION)
CACHE))
(SK.FIND.CACHE.BUCKET (fetch (POSITION XCOORD) of POSITION)
TMP])
(SK.ADD.HOTSPOTS.TO.CACHE
[LAMBDA (ELTS CACHE) (* rrb " 3-Feb-85 14:36")
(* adds a collection of hotspots to a cache.)
(for ELT in ELTS do (SETQ CACHE (SK.ADD.HOTSPOTS.TO.CACHE1 ELT CACHE)))
CACHE])
(SK.ADD.HOTSPOTS.TO.CACHE1
[LAMBDA (LOCALELT CACHE) (* rrb "29-Jan-85 14:55")
(* adds an elements hotspots to the cache.)
(for HOTSPOT in (fetch (SCREENELT HOTSPOTS) of LOCALELT) do (SETQ CACHE (SK.ADD.HOTSPOT.TO.CACHE
HOTSPOT LOCALELT CACHE)))
CACHE])
(SK.ADD.HOTSPOT.TO.CACHE
[LAMBDA (POSITION ELT CACHE) (* rrb "29-Jan-85 18:36")
(* adds a hotspot to a cache.)
(* a cache is an alist of alist with the top
descriminator being the Y value and the second one
being the X value.)
(PROG ((Y (fetch (POSITION YCOORD) of POSITION))
(X (fetch (POSITION XCOORD) of POSITION)))
(RETURN (COND
[(NULL CACHE)
(LIST (LIST Y (LIST X ELT]
((IGREATERP Y (CAAR CACHE)) (* this element goes first Splice it onto the front.)
(RPLACD CACHE (CONS (CAR CACHE)
(CDR CACHE)))
(RPLACA CACHE (LIST Y (LIST X ELT)))
CACHE)
((EQ (CAAR CACHE)
Y)
(SK.ADD.VALUE.TO.CACHE.BUCKET X ELT (CDAR CACHE))
CACHE)
(T [for TAIL on CACHE do [AND (CDR TAIL)
(COND
((EQ (CAADR TAIL)
Y)
(SK.ADD.VALUE.TO.CACHE.BUCKET X ELT
(CDADR TAIL))
(RETURN))
((IGREATERP Y (CAADR TAIL))
(RPLACD TAIL (CONS (LIST Y (LIST X ELT))
(CDR TAIL)))
(RETURN]
finally (NCONC1 CACHE (LIST Y (LIST X ELT]
CACHE])
(SK.REMOVE.HOTSPOTS.FROM.CACHE
[LAMBDA (ELTS CACHE) (* rrb "29-Jan-85 14:04")
(* removes a collection of hotspots from a cache.)
(for ELT in ELTS do (SETQ CACHE (SK.REMOVE.HOTSPOTS.FROM.CACHE1 ELT CACHE])
(SK.REMOVE.HOTSPOTS.FROM.CACHE1
[LAMBDA (LOCALELT CACHE) (* rrb "29-Jan-85 13:45")
(* removes an elements hotspots to the cache.)
(for HOTSPOT in (fetch (SCREENELT HOTSPOTS) of LOCALELT) do (SK.REMOVE.HOTSPOT.FROM.CACHE HOTSPOT
LOCALELT
CACHE])
(SK.REMOVE.HOTSPOT.FROM.CACHE
[LAMBDA (POSITION ELT CACHE) (* rrb "29-Jan-85 14:01")
(* removes a hotspot to a cache.)
(* a cache is an alist of alist with the top
descriminator being the Y value and the second one
being the X value.)
(SK.REMOVE.VALUE.FROM.CACHE.BUCKET (fetch (POSITION XCOORD) of POSITION)
ELT
(FASSOC (fetch (POSITION YCOORD) of POSITION)
CACHE])
(SK.REMOVE.VALUE.FROM.CACHE.BUCKET
[LAMBDA (VAL ELT BUCKET) (* rrb "29-Jan-85 14:45")
(* removes ELT from the list of elements stored on
BUCKET under the key VAL.)
(* leaves the x and y of the bucket because it seems easier than removing it and it may be used again in the case of
changing an element by deleting it then adding it again.)
(for TAIL on (FASSOC VAL (CDR BUCKET)) do (AND (CDR TAIL)
(COND
((EQ (CADR TAIL)
ELT)
(RPLACD TAIL (CDDR TAIL])
(SK.FIND.CACHE.BUCKET
[LAMBDA (VALUE CACHE) (* rrb "29-Jan-85 13:18")
(* internal function for searching the caching Alists. Returns the bucket if there is one; quits when a value is
larger than the one asked for.)
(for TAIL on CACHE do (COND
((EQ (CAAR TAIL)
VALUE)
(RETURN (CDAR TAIL)))
((IGREATERP VALUE (CAAR TAIL))
(RETURN NIL])
(SK.ADD.VALUE.TO.CACHE.BUCKET
[LAMBDA (VAL ELT ALIST) (* rrb "31-Jan-85 11:52")
(* adds ELT to the list of elements stored on ALIST
under the key VAL.)
(COND
((NULL ALIST) (* shouldn't ever happen.)
NIL)
((IGREATERP VAL (CAAR ALIST)) (* this element goes first Splice it onto the front.)
(RPLACD ALIST (CONS (CAR ALIST)
(CDR ALIST)))
(RPLACA ALIST (LIST VAL ELT)))
((EQ (CAAR ALIST)
VAL) (* add it to the end of the first list.)
(NCONC1 (CAR ALIST)
ELT))
(T (for TAIL on ALIST do [AND (CDR TAIL)
(COND
((EQ (CAADR TAIL)
VAL)
(NCONC1 (CADR TAIL)
ELT)
(RETURN ALIST))
((IGREATERP VAL (CAADR TAIL))
(RPLACD TAIL (CONS (LIST VAL ELT)
(CDR TAIL)))
(RETURN ALIST]
finally (NCONC1 ALIST (LIST VAL ELT])
)
(* multiple selection and copy select functions)
(DEFINEQ
(SK.ADD.SELECTION
[LAMBDA (ITEM/POS WINDOW MARKBM FIRSTFLG) (* rrb " 9-May-85 10:42")
(* adds an item to the selection list of WINDOW.)
(COND
([NOT (MEMBER ITEM/POS (WINDOWPROP WINDOW (QUOTE SKETCH.SELECTIONS]
(* must turning off the element's selection before adding it to the window selections because the display of the
selection check to see if the points are already selected in another element.)
(SK.SELECT.ELT ITEM/POS WINDOW MARKBM)
(WINDOWADDPROP WINDOW (QUOTE SKETCH.SELECTIONS)
ITEM/POS FIRSTFLG])
(SK.COPY.INSERTFN
[LAMBDA (IMAGEOBJ SKW) (* rrb " 9-Jul-85 12:33")
(* * the function that gets called to insert a copy-selection into a sketch window. Knows how to insert sketches,
everything else is text.)
(bind DATUM for IMOBJ inside IMAGEOBJ do (COND
((STRINGP IMOBJ)
(BKSYSBUF IMOBJ))
((EQ (fetch (IMAGEOBJ IMAGEOBJFNS) of IMOBJ)
SKETCHIMAGEFNS)
(* this is a sketch imageobj)
(SETQ DATUM (IMAGEOBJPROP IMOBJ (QUOTE OBJECTDATUM)))
(SK.INSERT.SKETCH SKW (fetch (SKETCHIMAGEOBJ
SKIO.SKETCH)
of DATUM)
(fetch (SKETCHIMAGEOBJ SKIO.REGION)
of DATUM)
(fetch (SKETCHIMAGEOBJ SKIO.SCALE)
of DATUM)))
(T (* insert the image object whatever it is)
(SK.INSERT.SKETCH SKW
[create SKETCH
SKETCHNAME ←(QUOTE
DUMMYNAME)
SKETCHELTS ←(LIST
(SETQ DATUM
(
SK.ELEMENT.FROM.IMAGEOBJ IMAGEOBJ SKW]
(fetch (SKIMAGEOBJ
SKIMOBJ.GLOBALREGION)
of (fetch (GLOBALPART
INDIVIDUALGLOBALPART)
of DATUM))
(WINDOW.SCALE SKW))
(COND
((AND (SETQ DATUM (IMAGEOBJPROP IMOBJ
(QUOTE
WHENINSERTEDFN)))
(NEQ DATUM (QUOTE NILL)))
(* call the image objects insertfn.)
(APPLY* DATUM IMOBJ SKW])
(SK.FIGUREIMAGE
[LAMBDA (SCRITEMS LIMITREGION REGIONOFINTEREST) (* rrb "31-Jul-85 10:20")
(* returns a bitmap which contains the image of the
elements on SCRITEMS. And a lower left corner.)
(RESETFORM (CURSOR WAITINGCURSOR)
(PROG (REGION DSPSTREAM BITMAP LEFT BOTTOM LIMITDIM)
(COND
((NULL SCRITEMS)
(RETURN)))
[COND
((SCREENELEMENTP SCRITEMS) (* single item case.)
(SETQ REGION (SK.ITEM.REGION SCRITEMS)))
(T (SETQ REGION (SK.ITEM.REGION (CAR SCRITEMS)))
(for SCITEM in (CDR SCRITEMS) do (SETQ REGION (UNIONREGIONS REGION
(SK.ITEM.REGION
SCITEM]
(* only some of the points are being moved, reduce the
region to those.)
(AND REGIONOFINTEREST (SETQ REGION (OR (INTERSECTREGIONS REGION REGIONOFINTEREST)
REGION)))
[COND
(LIMITREGION
(* limit the size of the bitmap. This is used by copy insert functions that do not know how big the thing coming in
is.)
(COND
((GREATERP (fetch (REGION WIDTH) of REGION)
(SETQ LIMITDIM (fetch (REGION WIDTH) of LIMITREGION))
) (* reduce the width picking out the middle of the
region)
(replace (REGION LEFT) of REGION
with (PLUS (fetch (REGION LEFT) of REGION)
(QUOTIENT (DIFFERENCE LIMITDIM
(fetch (REGION WIDTH)
of REGION))
2)))
(replace (REGION WIDTH) of REGION with LIMITDIM)))
(COND
((GREATERP (fetch (REGION HEIGHT) of REGION)
(SETQ LIMITDIM (fetch (REGION HEIGHT) of LIMITREGION)
)) (* reduce the height picking out the middle of the
region)
(replace (REGION BOTTOM) of REGION
with (PLUS (fetch (REGION BOTTOM) of REGION)
(QUOTIENT (DIFFERENCE LIMITDIM
(fetch (REGION HEIGHT)
of REGION))
2)))
(replace (REGION HEIGHT) of REGION with LIMITDIM]
(* ADD1 is used to convert the possibly floating region
coordinates into fixed.)
[SETQ DSPSTREAM (DSPCREATE (SETQ BITMAP (BITMAPCREATE
(ADD1 (fetch (REGION WIDTH) of REGION))
(ADD1 (fetch (REGION HEIGHT) of REGION]
(DSPXOFFSET [IMINUS (SETQ LEFT (FIXR (fetch (REGION LEFT) of REGION]
DSPSTREAM)
(DSPYOFFSET [IMINUS (SETQ BOTTOM (FIXR (fetch (REGION BOTTOM) of REGION]
DSPSTREAM) (* this is because the default clipping region is
smaller than the clipping region of the figure in
extreme cases.)
(DSPCLIPPINGREGION REGION DSPSTREAM)
(DSPOPERATION (QUOTE PAINT)
DSPSTREAM) (* to avoid carriage returns.)
(DSPRIGHTMARGIN (PLUS 100 (fetch (REGION RIGHT) of REGION))
DSPSTREAM)
(DRAW.LOCAL.SKETCH SCRITEMS DSPSTREAM REGION)
(RETURN (create SKFIGUREIMAGE
SKFIGURE.LOWERLEFT ←(create POSITION
XCOORD ← LEFT
YCOORD ← BOTTOM)
SKFIGURE.BITMAP ← BITMAP])
(SCREENELEMENTP
[LAMBDA (ELT?) (* rrb "10-Sep-84 14:56")
(* * returns ELT? if it is a screen element.)
(PROG (X)
(RETURN (AND (SETQ X (fetch (SCREENELT GLOBALPART) of ELT?))
(SKETCH.ELEMENT.NAMEP (fetch (GLOBALPART GTYPE) of X))
ELT?])
(SK.ITEM.REGION
[LAMBDA (SCRELT) (* rrb "24-Jan-85 17:46")
(* SCRELT is a sketch element This function returns the
region it occupies.)
(PROG [(REGIONFN (SK.REGIONFN (fetch (SCREENELT GTYPE) of SCRELT]
(RETURN (COND
((OR (NULL REGIONFN)
(EQ REGIONFN (QUOTE NILL)))
NIL)
((APPLY* REGIONFN SCRELT])
(SK.LOCAL.ITEMS.IN.REGION
[LAMBDA (HOTSPOTCACHE LEFT BOTTOM RIGHT TOP) (* rrb "31-Jan-85 11:38")
(* * returns a list of the LOCALITEMS that are within LOCALREGION)
(* changed to take a hotspot cache instead of a list of local items. OLD ARGS were (HOTSPOTCACHE LOCALREGION SCALE)
OLD CODE (PROG ((SKREGION (UNSCALE.REGION LOCALREGION SCALE))) (RETURN (for SCRELT in LOCALITEMS when
(SK.INSIDE.REGION (fetch (SCREENELT GLOBALPART) of SCRELT) SKREGION) collect SCRELT))))
(PROG ((RLEFT (DIFFERENCE LEFT SK.POINT.WIDTH))
(RBOTTOM (DIFFERENCE BOTTOM SK.POINT.WIDTH))
(RRIGHT (PLUS RIGHT SK.POINT.WIDTH))
(RTOP (PLUS TOP SK.POINT.WIDTH))
ELTS)
[for YBUCKET in HOTSPOTCACHE when (ILEQ (CAR YBUCKET)
RTOP)
do (COND
((ILESSP (CAR YBUCKET)
RBOTTOM) (* stop when Y gets too small.)
(RETURN)))
(for XBUCKET in (CDR YBUCKET) when (ILEQ (CAR XBUCKET)
RRIGHT)
do (COND
((ILESSP (CAR XBUCKET)
RLEFT) (* stop when X gets too small.)
(RETURN))) (* collect the elements.)
(SETQ ELTS (UNION (CDR XBUCKET)
ELTS]
(RETURN ELTS])
(SK.REGIONFN
[LAMBDA (ELEMENTTYPE) (* rrb " 5-Sep-84 16:06")
(* * access fn for getting the function that returns the region of an item from its type.)
(fetch (SKETCHTYPE REGIONFN) of (GETPROP ELEMENTTYPE (QUOTE SKETCHTYPE])
(SK.REMOVE.SELECTION
[LAMBDA (ITEM/POS WINDOW MARKBM) (* rrb " 9-May-85 10:31")
(* removes an item from the selection list of WINDOW.)
(COND
((MEMBER ITEM/POS (WINDOWPROP WINDOW (QUOTE SKETCH.SELECTIONS)))
(* must remove element from window selections before turning off its selection because the display of the selection
check to see if the points are still selected in another element.)
(WINDOWDELPROP WINDOW (QUOTE SKETCH.SELECTIONS)
ITEM/POS)
(SK.DESELECT.ELT ITEM/POS WINDOW MARKBM])
(SK.SELECT.MULTIPLE.ITEMS
[LAMBDA (WINDOW ITEMFLG SELITEMS) (* rrb "19-Jul-85 10:32")
(* * selects allows the user to select a group of the sketch elements from the sketch WINDOW.
If ITEMFLG is NIL, the user is allows to select control points as well as complete items and the returned value may
be the position of a control point. If SELITEMS is given it is used as the items to be marked and selected from.
Keeps control and probably shouldn't)
(* 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.
Also it keeps control as long as a shift key is down.)
(PROG ((INTERIOR (DSPCLIPPINGREGION NIL WINDOW))
SELECTABLEITEMS HOTSPOTCACHE TIMER NOW OLDX ORIGX NEWX NEWY OLDY ORIGY OUTOFFIRSTPICK
SELITEMS PREVMOUSEBUTTONS MOUSEINSIDE?)
(COND
(SELITEMS (SETQ SELECTABLEITEMS SELITEMS) (* create a cache for the items to select from)
(SETQ HOTSPOTCACHE (SK.ADD.HOTSPOTS.TO.CACHE SELITEMS NIL)))
((SETQ SELECTABLEITEMS (LOCALSPECS.FROM.VIEWER WINDOW))
(SETQ HOTSPOTCACHE (SK.HOTSPOT.CACHE WINDOW)))
(T (* no items, don't do anything.)
(RETURN)))
(TOTOPW WINDOW)
(SK.PUT.MARKS.UP WINDOW HOTSPOTCACHE)
(until (MOUSESTATE (NOT UP)))
(COND
((INSIDEP INTERIOR (LASTMOUSEX WINDOW)
(LASTMOUSEY WINDOW))
(SETQ MOUSEINSIDE? T))
(T (* first press was outside of the window, don't select
anything.)
(SK.TAKE.MARKS.DOWN WINDOW HOTSPOTCACHE)
(RETURN)))
SELECTLP
(COND
((MOUSESTATE UP)
(GO SELECTEXIT))) (* this label provides an entry for the code that tests
if the shift key is down.)
SELAFTERTEST
(SETQ NEWY (LASTMOUSEY WINDOW))
(SETQ NEWX (LASTMOUSEX WINDOW))
[COND
[(NOT MOUSEINSIDE?)
(* mouse is outside, don't do anything other than wait for it to come back in. If the user has let up all buttons,
the branch to SELECTEXIT will have been taken.)
(COND
((INSIDEP INTERIOR NEWX NEWY)
(SETQ MOUSEINSIDE? T) (* restore the saved selected items.)
(for ELT in SELITEMS do (SK.ADD.SELECTION ELT WINDOW]
((NOT (INSIDEP INTERIOR NEWX NEWY)) (* mouse just went outside, remove selections but save
them in case mouse comes back in.)
(SETQ MOUSEINSIDE? NIL)
(SETQ SELITEMS (WINDOWPROP WINDOW (QUOTE SKETCH.SELECTIONS)))
(for ELT in SELITEMS do (SK.REMOVE.SELECTION ELT WINDOW)))
[(NEQ PREVMOUSEBUTTONS LASTMOUSEBUTTONS) (* another button has gone down, mark this as the
origin of a new box to sweep.)
(SETQ PREVMOUSEBUTTONS LASTMOUSEBUTTONS)
(SETQ ORIGX (LASTMOUSEX WINDOW))
(SETQ ORIGY (LASTMOUSEY WINDOW))
[COND
((NULL ITEMFLG) (* clear any selections that are of single points.)
(for SEL in (WINDOWPROP WINDOW (QUOTE SKETCH.SELECTIONS)) when (POSITIONP SEL)
do (SK.REMOVE.SELECTION SEL WINDOW] (* add or delete the element that the button press
occurred on if any.)
(AND [SETQ NOW (IN.SKETCH.ELT? HOTSPOTCACHE (create POSITION
XCOORD ← NEWX
YCOORD ← NEWY)
(AND (NULL ITEMFLG)
(LASTMOUSESTATE (ONLY LEFT))
(NULL (WINDOWPROP WINDOW (QUOTE SKETCH.SELECTIONS]
(COND
((LASTMOUSESTATE (ONLY LEFT)) (* add selection.)
(SK.ADD.SELECTION NOW WINDOW))
((LASTMOUSESTATE RIGHT) (* remove selection.)
(SK.REMOVE.SELECTION NOW WINDOW]
((COND
(OUTOFFIRSTPICK (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 OUTOFFIRSTPICK T))) (* cursor has moved more than the minimum amount since
last noticed.)
(* add or delete any with in the swept out area.)
(COND
([AND (LASTMOUSESTATE (NOT UP))
(SETQ SELITEMS (SK.LOCAL.ITEMS.IN.REGION HOTSPOTCACHE (MIN ORIGX NEWX)
(MIN ORIGY NEWY)
(MAX ORIGX NEWX)
(MAX ORIGY NEWY]
(* if selecting multiple things, it must be whole
items. Update NOW to be an item if it isn't already.)
[COND
((POSITIONP NOW)
(SK.REMOVE.SELECTION NOW WINDOW) (* if selecting, add the whole element in.)
(AND (LASTMOUSESTATE (ONLY LEFT))
(SETQ NOW (IN.SKETCH.ELT? HOTSPOTCACHE NOW))
(SK.ADD.SELECTION NOW WINDOW]
(COND
((LASTMOUSESTATE (ONLY LEFT)) (* left only selects.)
(for SELITEM in SELITEMS do (SK.ADD.SELECTION SELITEM WINDOW)))
((LASTMOUSESTATE RIGHT) (* right cause deselect.)
(for SELITEM in SELITEMS do (SK.REMOVE.SELECTION SELITEM WINDOW]
(SETQ OLDX NEWX)
(SETQ OLDY NEWY)
(GO SELECTLP)
SELECTEXIT
(COND
(OUTOFFIRSTPICK (GO SHIFTDOWNLP))) (* wait for multiple clicks)
(SETQ TIMER (SETUPTIMER CLICKWAITTIME TIMER))
CLICKLP
(COND
[(AND (MOUSESTATE (NOT UP))
(ILESSP (IABS (IDIFFERENCE ORIGX (LASTMOUSEX WINDOW)))
SK.NO.MOVE.DISTANCE)
(ILESSP (IABS (IDIFFERENCE ORIGY (LASTMOUSEY WINDOW)))
SK.NO.MOVE.DISTANCE))
(AND (LASTMOUSESTATE (ONLY LEFT))
(COND
((POSITIONP NOW) (* thing selected is a point, select the whole item.)
(SK.REMOVE.SELECTION NOW WINDOW)
(SK.ADD.SELECTION (SETQ NOW (IN.SKETCH.ELT? HOTSPOTCACHE NOW))
WINDOW))
((SCREENELEMENTP NOW) (* thing now selected is an item, select all selectable
items keeping the first one selected on the front.)
(for SELITEM in (SETQ NOW (CONS NOW (REMOVE NOW SELECTABLEITEMS)))
do (SK.ADD.SELECTION SELITEM WINDOW]
((NOT (TIMEREXPIRED? TIMER))
(GO CLICKLP)))
SHIFTDOWNLP
(COND
((MOUSESTATE (NOT UP)) (* button went down again, initialize the button state
and click position.)
(SETQ PREVMOUSEBUTTONS NIL)
(SETQ OUTOFFIRSTPICK NIL)
(GO SELAFTERTEST))
((.SHIFTKEYDOWNP.) (* flip selection marks because if cursor is outside
when shift key is let up, nothing is selected.)
[COND
[(NOT MOUSEINSIDE?) (* mouse is outside: if it comes back in, mark the
selections.)
(COND
((INSIDEP INTERIOR (LASTMOUSEX WINDOW)
(LASTMOUSEY WINDOW))
(SETQ MOUSEINSIDE? T) (* restore the saved selected items.)
(for ELT in SELITEMS do (SK.ADD.SELECTION ELT WINDOW]
((NOT (INSIDEP INTERIOR (LASTMOUSEX WINDOW)
(LASTMOUSEY WINDOW))) (* mouse just went outside, remove marks but keep
selections)
(SETQ MOUSEINSIDE? NIL)
(SETQ SELITEMS (WINDOWPROP WINDOW (QUOTE SKETCH.SELECTIONS)))
(for ELT in SELITEMS do (SK.REMOVE.SELECTION ELT WINDOW]
(GO SHIFTDOWNLP)))
(SETQ SELITEMS (WINDOWPROP WINDOW (QUOTE SKETCH.SELECTIONS)))
(COND
(MOUSEINSIDE? (* unmark and remove the selected items from the window
property list.)
(for SEL in SELITEMS do (SK.REMOVE.SELECTION SEL WINDOW)))
(T (* they have already been unmarked, just remove them
from the window.)
(WINDOWPROP WINDOW (QUOTE SKETCH.SELECTIONS)
NIL)))
(SK.TAKE.MARKS.DOWN WINDOW HOTSPOTCACHE)
(RETURN SELITEMS])
(SK.PUT.MARKS.UP
[LAMBDA (SKETCHW HOTSPOTCACHE) (* rrb "29-Jan-85 17:40")
(* makes sure the selection points are up in a window.)
(COND
((NULL (WINDOWPROP SKETCHW (QUOTE MARKS.UP)))
(SK.SHOWMARKS SKETCHW HOTSPOTCACHE)
(WINDOWPROP SKETCHW (QUOTE MARKS.UP)
T])
(SK.TAKE.MARKS.DOWN
[LAMBDA (SKETCHW HOTSPOTCACHE) (* rrb "29-Jan-85 17:41")
(* makes sure the selection points are down in a
window.)
(COND
((WINDOWPROP SKETCHW (QUOTE MARKS.UP))
(SK.SHOWMARKS SKETCHW HOTSPOTCACHE)
(WINDOWPROP SKETCHW (QUOTE MARKS.UP)
NIL])
(SK.TRANSLATE.GLOBALPART
[LAMBDA (GLOBALELT DELTAPOS RETURNELTIFCANTFLG) (* rrb "12-Sep-84 11:37")
(* GLOBALELT is a sketch element that was selected for
a translate operation. DELTAPOS is the amount the item
is to be translated.)
(PROG ((TRANSLATEFN (SK.TRANSLATEFN (fetch (GLOBALPART GTYPE) of GLOBALELT)))
NEWGLOBAL OLDGLOBAL)
(RETURN (COND
((OR (NULL TRANSLATEFN)
(EQ TRANSLATEFN (QUOTE NILL))) (* if can't translate, return the same thing.
This is probably an error condition.)
GLOBALELT)
((APPLY* TRANSLATEFN GLOBALELT DELTAPOS))
(RETURNELTIFCANTFLG (* in the case of translating a whole sketch, need to
return something.)
GLOBALELT])
(SK.TRANSLATE.ITEM
[LAMBDA (SELELT GLOBALDELTAPOS W) (* rrb "21-Jan-85 18:35")
(* SELELT is a sketch element that was selected for a
translate operation. GLOBALDELTAPOS is the amount the
item is to be translated.)
(PROG (NEWGLOBAL OLDGLOBAL)
(COND
((SETQ NEWGLOBAL (SK.TRANSLATE.GLOBALPART (SETQ OLDGLOBAL (fetch (SCREENELT GLOBALPART)
of SELELT))
GLOBALDELTAPOS))
(SK.UPDATE.ELEMENT OLDGLOBAL NEWGLOBAL W T) (* don't include history for now.
(SK.ADD.HISTEVENT (QUOTE TRANSLATE)
(LIST OLDGLOBAL NEWGLOBAL) W))
(RETURN NEWGLOBAL])
(SK.TRANSLATEFN
[LAMBDA (ELEMENTTYPE) (* rrb " 4-Sep-84 17:01")
(fetch (SKETCHTYPE TRANSLATEFN) of (GETPROP ELEMENTTYPE (QUOTE SKETCHTYPE])
(TRANSLATE.SKETCH
[LAMBDA (SKETCH NEWXORG NEWYORG) (* rrb " 9-Jul-85 12:36")
(* * translates all the elements in a sketch to make the new {0, 0} be NEWXORG NEWYORG)
(PROG [(DELTAPOS (create POSITION
XCOORD ←(MINUS NEWXORG)
YCOORD ←(MINUS NEWYORG]
(RETURN (create SKETCH using SKETCH SKETCHELTS ←(for GELT in (fetch (SKETCH SKETCHELTS)
of SKETCH)
collect (SK.TRANSLATE.GLOBALPART GELT
DELTAPOS T])
)
(DECLARE: EVAL@COMPILE
(RPAQQ SK.NO.MOVE.DISTANCE 4)
(CONSTANTS (SK.NO.MOVE.DISTANCE 4))
)
(DECLARE: DONTCOPY
[DECLARE: EVAL@COMPILE
(RECORD SKFIGUREIMAGE (SKFIGURE.BITMAP SKFIGURE.LOWERLEFT))
]
)
(RPAQ? ALLOW.MULTIPLE.SELECTION.FLG T)
(* functions for determining what is inside of a window.)
(DEFINEQ
(ELT.INSIDE.SKETCHWP
[LAMBDA (GELT SKW) (* rrb " 8-APR-83 13:18")
(* determines if a global element is in the region of a
viewer)
(SK.INSIDE.REGION GELT (WINDOWPROP SKW (QUOTE REGION.VIEWED])
(SK.INSIDE.REGION
[LAMBDA (GELT REGION) (* rrb "31-Aug-84 10:15")
(* determines if the element GELT is inside of the
global region REGION)
(APPLY* (SK.INSIDEFN (fetch (GLOBALPART GTYPE) of GELT))
GELT REGION])
)
(* stuff for changing the input scale)
(DEFINEQ
(SK.INPUT.SCALE
[LAMBDA (SKW) (* rrb " 4-Sep-85 15:35")
(* returns the scale that input should be)
(PROG [(SK (WINDOWPROP SKW (QUOTE SKETCHCONTEXT]
(COND
((NULL SK)
(ERROR SKW "arg not sketch window")
(RETURN NIL)))
(RETURN (COND
((fetch (SKETCHCONTEXT SKETCHINPUTSCALE) of SK))
(T (* early form of sketch that doesn't have an input
scale.)
(SK.UPDATE.SKETCHCONTEXT SK)
(replace (SKETCHCONTEXT SKETCHINPUTSCALE) of SK with 1.0)
1.0])
(SK.UPDATE.SKETCHCONTEXT
[LAMBDA (SKETCHCONTEXT) (* rrb " 4-Sep-85 14:55")
(* updates an instance of a sketch context to have
enough fields.)
(PROG ((NEWSK (CREATE.DEFAULT.SKETCH.CONTEXT)))
[COND
((GREATERP (DIFFERENCE (LENGTH NEWSK)
(LENGTH SKETCHCONTEXT))
0) (* add fields to the sketch)
(NCONC SKETCHCONTEXT (NTH NEWSK (ADD1 (LENGTH SKETCHCONTEXT]
(RETURN SKETCHCONTEXT])
(SK.SET.INPUT.SCALE
[LAMBDA (W) (* rrb " 4-Sep-85 15:47")
(* sets the size of the (input scale))
(SK.SET.INPUT.SCALE.VALUE (RNUMBER (CONCAT "Input scale is now " (SK.INPUT.SCALE W)
". Enter new input scale. A larger scale will make new lines and text larger.")
NIL NIL NIL T T)
W])
(SK.SET.INPUT.SCALE.CURRENT
[LAMBDA (W) (* rrb " 4-Sep-85 15:41")
(* sets the size of the input scale to the scale of the
current window.)
(SK.SET.INPUT.SCALE.VALUE (WINDOW.SCALE W)
W])
(SK.SET.INPUT.SCALE.VALUE
[LAMBDA (NEWINPUTSCALE SKW) (* rrb " 4-Sep-85 15:39")
(* sets the input scale to NEWINPUTSCALE)
(AND (NUMBERP NEWINPUTSCALE)
(NOT (ZEROP NEWINPUTSCALE))
(replace (SKETCHCONTEXT SKETCHINPUTSCALE) of (WINDOWPROP SKW (QUOTE SKETCHCONTEXT))
with NEWINPUTSCALE])
)
(* functions for zooming)
(DEFINEQ
(SKETCHW.SCALE
[LAMBDA (WIN)
(WINDOWPROP WIN (QUOTE SCALE])
(SKETCH.ZOOM
[LAMBDA (SKW) (* rrb " 8-May-85 18:11")
(* changes the scale of the figure being looked at in a
window.)
(PROG (NEWREG)
(PROMPTPRINT
"Specify the part of this figure that will be seen after the zoom.
It can be either larger or smaller than the present window size.")
(SETQ NEWREG (GETWREGION SKW (FUNCTION SAME.ASPECT.RATIO)
SKW 4 4))
(CLRPROMPT)
(COND
((NULL (REGIONSINTERSECTP NEWREG (DSPCLIPPINGREGION NIL SKW)))
(* if it doesn't overlap this window, don't move.)
(STATUSPRINT SKW "Specified region was entirely outside the window. Not changed."))
(T (SKETCH.DO.ZOOM SKW NEWREG])
(SAME.ASPECT.RATIO
[LAMBDA (FIXPT MOVEPT WIN) (* rrb "29-MAR-83 11:13")
(* new region function that keeps the same aspect ratio
as a window.)
(COND
((NULL MOVEPT)
FIXPT)
(T (PROG ((REG (DSPCLIPPINGREGION NIL WIN))
(YMOVE (fetch (POSITION YCOORD) of MOVEPT))
(XFIX (fetch (POSITION XCOORD) of FIXPT))
(XMOVE (fetch (POSITION XCOORD) of MOVEPT))
(YFIX (fetch (POSITION YCOORD) of FIXPT))
WID) (* use height as the deciding point.)
[SETQ WID (ABS (QUOTIENT (ITIMES (fetch (REGION WIDTH) of REG)
(IDIFFERENCE YMOVE YFIX))
(fetch (REGION HEIGHT) of REG]
(RETURN (create POSITION
XCOORD ←(COND
((IGREATERP XFIX XMOVE)
(IDIFFERENCE XFIX WID))
(T (IPLUS XFIX WID)))
YCOORD ← YMOVE])
(SKETCH.DO.ZOOM
[LAMBDA (SKETCHW NEWREGION) (* rrb " 7-May-85 15:49")
(* moves the viewing region of a window to be over
NEWREGION which is in window coordinates.)
(PROG (NEWSCALE (OLDSCALE (WINDOW.SCALE SKETCHW))
(OLDREG (DSPCLIPPINGREGION NIL SKETCHW)))
(* scale on the basis of heights.)
[SETQ NEWSCALE (FTIMES OLDSCALE (FQUOTIENT (fetch (REGION HEIGHT) of NEWREGION)
(fetch (REGION HEIGHT) of OLDREG]
(WINDOWPROP SKETCHW (QUOTE SCALE)
NEWSCALE)
(ABSWXOFFSET (FIXR (FQUOTIENT (FTIMES (fetch (REGION LEFT) of NEWREGION)
OLDSCALE)
NEWSCALE))
SKETCHW)
(ABSWYOFFSET (FIXR (FQUOTIENT (FTIMES (fetch (REGION BOTTOM) of NEWREGION)
OLDSCALE)
NEWSCALE))
SKETCHW)
(SK.UPDATE.GRIDFACTOR SKETCHW OLDSCALE)
(SK.UPDATE.AFTER.SCALE.CHANGE SKETCHW])
(SKETCH.NEW.VIEW
[LAMBDA (SKW) (* rrb "23-Jan-85 13:56")
(* opens a new view onto the sketch viewed by SKW.)
(WINDOWPROP (SKETCHW.CREATE (SKETCH.FROM.VIEWER SKW)
NIL NIL NIL (WINDOW.SCALE SKW)
T
(SK.GRIDFACTOR SKW))
(QUOTE DONTQUERYCHANGES)
T])
(ZOOM.UPDATE.ELT
[LAMBDA (ELT SKW) (* rrb "29-Jan-85 14:40")
(* destructively updates the local part of an element
in response to a zoom or hardcopy command.)
(PROG ((CACHE (SK.HOTSPOT.CACHE SKW)))
(SK.REMOVE.HOTSPOTS.FROM.CACHE1 ELT CACHE)
(replace (SCREENELT LOCALPART) of ELT with (fetch (SCREENELT LOCALPART)
of (SK.LOCAL.FROM.GLOBAL (fetch (SCREENELT
GLOBALPART)
of ELT)
SKW)))
(SK.ADD.HOTSPOTS.TO.CACHE1 ELT CACHE)
(RETURN ELT])
(SK.UPDATE.AFTER.SCALE.CHANGE
[LAMBDA (SKETCHW STOPIFMOUSEDOWN) (* rrb " 5-Sep-85 11:20")
(* called to update the display and local elements
after a window has had a scale change.)
(* if STOPIFMOUSEDOWN is T, it displays some but stops
if the button left or middle button is still down and
returns STOPPED)
(PROG ([SKETCH (fetch (SKETCH SKETCHELTS) of (INSURE.SKETCH (SKETCH.FROM.VIEWER SKETCHW]
NEWREGION INNEW? LOCALELT) (* take down the caret.)
(SKED.CLEAR.SELECTION SKETCHW T)
(SK.UPDATE.REGION.VIEWED SKETCHW)
(SETQ NEWREGION (SK.REGION.VIEWED SKETCHW))
[for GELT in SKETCH
do (SETQ INNEW? (SK.INSIDE.REGION GELT NEWREGION))
(COND
[(SETQ LOCALELT (SK.LOCAL.ELT.FROM.GLOBALPART GELT SKETCHW))
(COND
(INNEW? (* is still in but must have its local adjusted to the
new scale.)
(ZOOM.UPDATE.ELT LOCALELT SKETCHW))
(T (* if it is not supposed to be in the new region,
remove it.)
(SK.DELETE.ITEM LOCALELT SKETCHW]
(INNEW? (* just came in)
(SK.ADD.ITEM GELT SKETCHW]
(DSPFILL NIL NIL (QUOTE REPLACE)
SKETCHW)
(SKETCHW.REPAINTFN SKETCHW NIL STOPIFMOUSEDOWN T])
(SKETCH.AUTOZOOM
[LAMBDA (SKW) (* rrb "19-Jul-85 14:54")
(* allows the user to pick a point and zooms to or from
that point according to the cursor.)
(RESETFORM (CURSOR AUTOZOOMCURSOR)
(PROG [SKETCHREG NEWSKETCHREG PTX PTY SCALE LFT BTM WID HGHT DISPLAYSTOPPED
(WINDOWREG (WINDOWPROP SKW (QUOTE REGION]
(STATUSPRINT SKW "left button zooms in; middle zooms out.")
(* zoom by a constant factor that keeps the point that
the cursor is on at the same location.)
[until (AND (MOUSESTATE (NOT UP))
(NOT (INSIDE? WINDOWREG LASTMOUSEX LASTMOUSEY))
(OR (NOT (EQ DISPLAYSTOPPED (QUOTE STOPPED)))
(PROGN (* last display didn't finish)
(SKETCH.GLOBAL.REGION.ZOOM SKW NEWSKETCHREG T)
T)))
do (COND
((LASTMOUSESTATE (OR LEFT MIDDLE))
[SETQ PTX (TIMES (LASTMOUSEX SKW)
(SETQ SCALE (WINDOW.SCALE SKW]
(SETQ PTY (TIMES (LASTMOUSEY SKW)
SCALE))
(SETQ SKETCHREG (SK.REGION.VIEWED SKW))
(SETQ LFT (fetch (REGION LEFT) of SKETCHREG))
(SETQ BTM (fetch (REGION BOTTOM) of SKETCHREG))
(SETQ WID (fetch (REGION WIDTH) of SKETCHREG))
(SETQ HGHT (fetch (REGION HEIGHT) of SKETCHREG))
(COND
([SETQ NEWSKETCHREG (COND
((LASTMOUSESTATE LEFT)
(* zoom in)
(CREATEREGION (FDIFFERENCE PTX (TIMES (DIFFERENCE PTX LFT)
AUTOZOOM.FACTOR))
(FDIFFERENCE PTY (TIMES AUTOZOOM.FACTOR
(DIFFERENCE PTY BTM)))
(TIMES WID AUTOZOOM.FACTOR)
(TIMES HGHT AUTOZOOM.FACTOR)))
((LASTMOUSESTATE MIDDLE)
(* zoom out)
(CREATEREGION (FDIFFERENCE PTX (QUOTIENT (DIFFERENCE PTX LFT)
AUTOZOOM.FACTOR))
(FDIFFERENCE PTY (QUOTIENT (DIFFERENCE PTY BTM)
AUTOZOOM.FACTOR))
(QUOTIENT WID AUTOZOOM.FACTOR)
(QUOTIENT HGHT AUTOZOOM.FACTOR]
(CURSOR (COND
((LASTMOUSESTATE LEFT)
ZOOMINCURSOR)
(T ZOOMOUTCURSOR)))
(SETQ DISPLAYSTOPPED (SKETCH.GLOBAL.REGION.ZOOM SKW NEWSKETCHREG T)
)
(CURSOR AUTOZOOMCURSOR]
(CLOSEPROMPTWINDOW SKW])
(SKETCH.GLOBAL.REGION.ZOOM
[LAMBDA (SKETCHW NEWREGION STOPIFMOUSEDOWN) (* rrb "10-Jul-85 10:31")
(* moves the viewing region of a window to be over
NEWREGION which is in sketch coordinates.)
(PROG (WIDTHSCALE HEIGHTSCALE (OLDSCALE (WINDOW.SCALE SKETCHW))
(WINDOWREG (DSPCLIPPINGREGION NIL SKETCHW)))
(* scale on the basis of which ever dimension make the
region fit.)
(SKED.CLEAR.SELECTION SKETCHW)
(COND
([GREATERP (SETQ HEIGHTSCALE (FQUOTIENT (fetch (REGION HEIGHT) of NEWREGION)
(fetch (REGION HEIGHT) of WINDOWREG)))
(SETQ WIDTHSCALE (FQUOTIENT (fetch (REGION WIDTH) of NEWREGION)
(fetch (REGION WIDTH) of WINDOWREG]
(* height is largest scale)
(WINDOWPROP SKETCHW (QUOTE SCALE)
HEIGHTSCALE)
(ABSWYOFFSET (FIXR (FQUOTIENT (fetch (REGION BOTTOM) of NEWREGION)
HEIGHTSCALE))
SKETCHW) (* center the extra width)
(ABSWXOFFSET (FIXR (FQUOTIENT (DIFFERENCE (fetch (REGION LEFT) of NEWREGION)
(QUOTIENT (DIFFERENCE
(TIMES (fetch (REGION WIDTH)
of WINDOWREG)
HEIGHTSCALE)
(fetch (REGION WIDTH)
of NEWREGION))
2))
HEIGHTSCALE))
SKETCHW))
(T (* width is largest scale)
(WINDOWPROP SKETCHW (QUOTE SCALE)
WIDTHSCALE)
(ABSWXOFFSET (FIXR (FQUOTIENT (fetch (REGION LEFT) of NEWREGION)
WIDTHSCALE))
SKETCHW) (* center the extra height)
(ABSWYOFFSET (FIXR (FQUOTIENT (DIFFERENCE (fetch (REGION BOTTOM) of NEWREGION)
(QUOTIENT (DIFFERENCE
(TIMES (fetch (REGION HEIGHT)
of WINDOWREG)
WIDTHSCALE)
(fetch (REGION HEIGHT)
of NEWREGION))
2))
WIDTHSCALE))
SKETCHW)))
(SK.UPDATE.GRIDFACTOR SKETCHW OLDSCALE)
(RETURN (SK.UPDATE.AFTER.SCALE.CHANGE SKETCHW STOPIFMOUSEDOWN])
)
(RPAQ? AUTOZOOM.FACTOR .8)
(RPAQ? AUTOZOOM.REPAINT.TIME 3000)
(READVARS AUTOZOOMCURSOR ZOOMINCURSOR ZOOMOUTCURSOR)
(({(READBITMAP)(16 16
"O@@O"
"N@@G"
"O@@O"
"KJEM"
"ANGH"
"@NG@"
"AOOH"
"@BD@"
"@BD@"
"COOH"
"@NG@"
"ANGH"
"KJEM"
"OB@O"
"N@@G"
"O@@O")} 7 . 8) ({(READBITMAP)(16 16
"OLCO"
"O@@O"
"O@@O"
"OHAO"
"ILCI"
"HNGA"
"@GN@"
"@BD@"
"@BD@"
"@GN@"
"HNGA"
"ILCI"
"OHAO"
"O@@O"
"O@@O"
"OLCO")} 7 . 8) ({(READBITMAP)(16 16
"L@@C"
"NBDG"
"GBDN"
"CNGL"
"ANGH"
"ANGH"
"GOON"
"@BD@"
"@BD@"
"GOON"
"ANGH"
"ANGH"
"CNGL"
"GBDN"
"NBDG"
"L@@C")} 7 . 8))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS AUTOZOOM.FACTOR AUTOZOOM.REPAINT.TIME ZOOMINCURSOR ZOOMOUTCURSOR)
)
(* fns for changing the view)
(DEFINEQ
(SKETCH.HOME
[LAMBDA (SKW) (* rrb " 7-May-85 12:43")
(* changes the scale of the figure being looked at in a
window.)
(PROG NIL
(WINDOWPROP SKW (QUOTE SCALE)
1.0)
(WXOFFSET (WXOFFSET NIL SKW)
SKW)
(WYOFFSET (WYOFFSET NIL SKW)
SKW)
(SK.UPDATE.AFTER.SCALE.CHANGE SKW])
(SK.FRAME.IT
[LAMBDA (SKW) (* rrb "31-May-85 11:32")
(* changes the region being viewed so that the entire
sketch just fits.)
(PROG ((SKETCH (INSURE.SKETCH SKW)))
(COND
((NULL (fetch (SKETCH SKETCHELTS) of SKETCH))
(STATUSPRINT SKW "There is nothing in this sketch."))
(T (SKETCH.GLOBAL.REGION.ZOOM SKW (SK.GLOBAL.REGION.OF.SKETCH SKETCH SKW])
(SK.MOVE.TO.VIEW
[LAMBDA (SKW VIEW) (* rrb "28-Jun-85 18:16")
(* restores a view by changing the position and scale
of the figure being looked at in a window.)
(PROG ((NEWSCALE (fetch (SKETCHVIEW VIEWSCALE) of VIEW))
(OLDSCALE (WINDOWPROP SKW (QUOTE SCALE)))
SKREGWIDTH SKREGHEIGHT)
(WINDOWPROP SKW (QUOTE SCALE)
NEWSCALE)
(WXOFFSET (WXOFFSET NIL SKW)
SKW)
(WXOFFSET (IMINUS (QUOTIENT (DIFFERENCE (fetch (SKETCHVIEW VIEWXPOSITION) of VIEW)
(TIMES (QUOTIENT (WINDOWPROP SKW (QUOTE WIDTH))
2)
NEWSCALE))
NEWSCALE))
SKW)
(WYOFFSET (WYOFFSET NIL SKW)
SKW)
(WYOFFSET (IMINUS (QUOTIENT (DIFFERENCE (fetch (SKETCHVIEW VIEWYPOSITION) of VIEW)
(TIMES (QUOTIENT (WINDOWPROP SKW (QUOTE HEIGHT))
2)
NEWSCALE))
NEWSCALE))
SKW)
(SK.UPDATE.GRIDFACTOR SKW OLDSCALE)
(SK.UPDATE.AFTER.SCALE.CHANGE SKW])
(SK.NAME.CURRENT.VIEW
[LAMBDA (SKW) (* rrb "28-Jun-85 18:16")
(* reads a name from the user and adds the current view
to the list of views)
(PROG [(SKETCH (INSURE.SKETCH SKW))
(NAME (MKATOM (PROMPT.GETINPUT SKW "Name for this view: "]
(COND
(NAME [PUTSKETCHPROP SKETCH (QUOTE VIEWS)
(APPEND (GETSKETCHPROP SKETCH (QUOTE VIEWS))
(CONS (create SKETCHVIEW
VIEWNAME ← NAME
VIEWSCALE ←(WINDOW.SCALE SKW)
VIEWPOSITION ←(REGION.CENTER (SK.REGION.VIEWED
SKW]
(STATUSPRINT SKW " ... done."])
(SK.RESTORE.VIEW
[LAMBDA (SKW) (* rrb " 7-May-85 14:09")
(* puts up a menu of the previously saved places in the
sketch and moves to the one selected.)
(PROG [(VIEW (MENU (CREATE MENU
ITEMS ←(CONS (QUOTE (Home (QUOTE HOME)
"returns to the origin at the original scale"))
(FOR SAVEDVIEW IN (GETSKETCHPROP (INSURE.SKETCH SKW)
(QUOTE VIEWS))
COLLECT (LIST (FETCH (SKETCHVIEW VIEWNAME)
OF SAVEDVIEW)
(KWOTE SAVEDVIEW)
"returns the view to this location.")))
TITLE ← "Which view?"
CENTERFLG ← T] (* treat home specially so the user will always have
one way back.)
(COND
((EQ VIEW (QUOTE HOME))
(SKETCH.HOME SKW))
(VIEW (SK.MOVE.TO.VIEW SKW VIEW])
(SK.FORGET.VIEW
[LAMBDA (SKW) (* rrb " 7-May-85 12:42")
(* puts up a menu of the previously saved places in the
sketch and lets the user select one to forget.)
(PROG ((SKETCH (INSURE.SKETCH SKW))
VIEWS ONETOFORGET)
(SETQ VIEWS (GETSKETCHPROP SKETCH (QUOTE VIEWS)))
(COND
((NULL VIEWS)
(STATUSPRINT SKW
"There are no saved views. They are created with the 'Save view' command.")
(RETURN)))
(SETQ ONETOFORGET (MENU (create MENU
ITEMS ←(for SAVEDVIEW in VIEWS
collect (LIST (fetch (SKETCHVIEW VIEWNAME)
of SAVEDVIEW)
(KWOTE SAVEDVIEW)
"removes this view."))
TITLE ← "Which view?"
CENTERFLG ← T)))
(COND
(ONETOFORGET (PUTSKETCHPROP SKETCH (QUOTE VIEWS)
(REMOVE ONETOFORGET VIEWS))
(STATUSPRINT SKW "View " (fetch (SKETCHVIEW VIEWNAME) of ONETOFORGET)
" forgotten."])
)
(DECLARE: DONTCOPY
[DECLARE: EVAL@COMPILE
(RECORD SKETCHVIEW (VIEWNAME VIEWSCALE VIEWPOSITION)
(RECORD VIEWPOSITION (VIEWXPOSITION . VIEWYPOSITION)))
]
)
(* grid stuff)
(DEFINEQ
(SK.SET.GRID
[LAMBDA (SKETCHW) (* rrb "25-Oct-84 12:40")
(* switches from grided to non-grided or vice versa.)
(COND
((WINDOWPROP SKETCHW (QUOTE USEGRID))
(SK.TURN.GRID.OFF SKETCHW))
(T (SK.TURN.GRID.ON SKETCHW])
(SK.DISPLAY.GRID
[LAMBDA (SKETCHW) (* rrb " 1-Feb-85 15:35")
(* displays the current grid.)
(COND
((WINDOWPROP SKETCHW (QUOTE USEGRID)))
(T (* grid was not being used, turn it on.)
(SK.TURN.GRID.ON SKETCHW T)))
(WINDOWPROP SKETCHW (QUOTE GRIDUP)
T)
(SK.DISPLAY.GRID.POINTS SKETCHW])
(SK.DISPLAY.GRID.POINTS
[LAMBDA (SKETCHW NEWFLG) (* rrb "16-Jan-85 10:09")
(SK.SHOW.GRID (SK.GRIDFACTOR SKETCHW)
SKETCHW NEWFLG])
(SK.REMOVE.GRID.POINTS
[LAMBDA (SKETCHW) (* rrb " 3-Feb-85 15:12")
(* removes the grid by calling redisplay with the
gridup property removed.)
(WINDOWPROP SKETCHW (QUOTE GRIDUP)
(PROG1 (WINDOWPROP SKETCHW (QUOTE GRIDUP)
NIL)
(REDISPLAYW SKETCHW])
(SK.TAKE.DOWN.GRID
[LAMBDA (SKETCHW) (* rrb "25-Oct-84 12:07")
(* takes down the grid if it is up.)
(COND
((WINDOWPROP SKETCHW (QUOTE GRIDUP)
NIL)
(SK.REMOVE.GRID.POINTS SKETCHW])
(SK.SHOW.GRID
[LAMBDA (GRID SKW NEWFLG) (* DECLARATIONS: FLOATING)
(* rrb " 3-Sep-85 16:02")
(* puts a grid of size GRID onto SKW.)
(PROG ((SCALE (WINDOW.SCALE SKW))
(REGION (SK.REGION.VIEWED SKW)))
(COND
((GREATERP 3.0 (FQUOTIENT GRID SCALE)) (* would be every point or so)
(AND NEWFLG (STATUSPRINT SKW (CONCAT "New" " grid has a position every "
(FQUOTIENT GRID SCALE)
" screen points.")))
NIL)
(T (* make a horizontal bitmap that has the X pattern then
blt it at the proper Y places.)
[PROG ((WREG (DSPCLIPPINGREGION NIL SKW))
HORIZPATTERN WWIDTH WLEFT GRIDLEFT SKREGLEFT SKREGLIMIT)
(SETQ WWIDTH (fetch (REGION WIDTH) of WREG))
(SETQ WLEFT (fetch (REGION LEFT) of WREG))
(SETQ HORIZPATTERN (BITMAPCREATE WWIDTH 1))
(SETQ GRIDLEFT (NEAREST.ON.GRID (SETQ SKREGLEFT (fetch (REGION LEFT)
of REGION))
GRID))
(* put limit calculation outside of the loop.)
(SETQ SKREGLIMIT (PLUS SKREGLEFT (fetch (REGION WIDTH) of REGION)))
(for X from GRIDLEFT to SKREGLIMIT by GRID
do (BITMAPBIT HORIZPATTERN (FIXR (FQUOTIENT (DIFFERENCE X SKREGLEFT)
SCALE))
0 1))
(SETQ SKREGLIMIT (PLUS (fetch (REGION BOTTOM) of REGION)
(fetch (REGION HEIGHT) of REGION)))
(for Y from (NEAREST.ON.GRID (fetch (REGION BOTTOM) of REGION)
GRID)
to SKREGLIMIT by GRID do (BITBLT HORIZPATTERN 0 0 SKW WLEFT
(FIXR (FQUOTIENT Y SCALE))
WWIDTH 1 (QUOTE INPUT)
(QUOTE PAINT]
(COND
((GREATERP (FQUOTIENT GRID SCALE)
(QUOTIENT (MIN (WINDOWPROP SKW (QUOTE HEIGHT))
(WINDOWPROP SKW (QUOTE WIDTH)))
3)) (* there aren't enough visible points so tell the user
how far apart they are.)
(STATUSPRINT SKW (CONCAT (COND
(NEWFLG "New")
(T "Current"))
" grid has a position every "
(FIXR (FQUOTIENT GRID SCALE))
" screen points."])
(SK.GRIDFACTOR
[LAMBDA (SKETCHW GRIDSIZE) (* rrb "25-Oct-84 12:34")
(* sets the grid factor of a window to GRIDSIZE. Returns the previous setting. The actual use of the grid is
determined by (QUOTE USEGRID) property.)
(COND
((NUMBERP GRIDSIZE)
(WINDOWPROP SKETCHW (QUOTE GRIDFACTOR)
GRIDSIZE))
(GRIDSIZE (\ILLEGAL.ARG GRIDSIZE)
(WINDOWPROP SKETCHW (QUOTE GRIDFACTOR)))
(T (WINDOWPROP SKETCHW (QUOTE GRIDFACTOR])
(SK.TURN.GRID.ON
[LAMBDA (SKETCHW QUIETFLG) (* rrb "25-Oct-84 12:04")
(* turns the grid on.)
(COND
((WINDOWPROP SKETCHW (QUOTE USEGRID)
T)
(OR QUIETFLG (STATUSPRINT SKETCHW "The grid was already in use."])
(SK.TURN.GRID.OFF
[LAMBDA (SKETCHW) (* rrb "25-Oct-84 12:03")
(* turns the grid off.)
(COND
((WINDOWPROP SKETCHW (QUOTE USEGRID)
NIL)
(SK.TAKE.DOWN.GRID SKETCHW))
(T (STATUSPRINT SKETCHW "The grid was not is use."])
(SK.MAKE.GRID.LARGER
[LAMBDA (SKETCHW) (* rrb "25-Oct-84 12:15")
(* makes the grid larger. If the grid is off, it turns
it on.)
(SK.CHANGE.GRID (FTIMES (SK.GRIDFACTOR SKETCHW)
2.0)
SKETCHW])
(SK.MAKE.GRID.SMALLER
[LAMBDA (SKETCHW) (* rrb "25-Oct-84 12:15")
(* makes the grid smaller. If the grid is off, it turns
it on.)
(SK.CHANGE.GRID (FTIMES (SK.GRIDFACTOR SKETCHW)
.5)
SKETCHW])
(SK.CHANGE.GRID
[LAMBDA (NEWGRID SKETCHW) (* rrb " 1-Feb-85 15:52")
(* changes the grid of a window.
Turns the grid on if it isn't already on.)
(SK.TURN.GRID.ON SKETCHW T)
(AND (WINDOWPROP SKETCHW (QUOTE GRIDUP))
(SK.REMOVE.GRID.POINTS SKETCHW))
(SK.GRIDFACTOR SKETCHW NEWGRID)
(AND (WINDOWPROP SKETCHW (QUOTE GRIDUP))
(SK.DISPLAY.GRID.POINTS SKETCHW T])
(GRID.FACTOR1
[LAMBDA (REALHEIGHT HEIGHTONSCREEN NPTS) (* rrb "19-Jun-84 17:26")
(* returns the greatest power of two such that
REALHEIGHT maps onto SCREENHEIGHT leaving at least NPTS
per grid.)
(LEASTPOWEROF2GT (FQUOTIENT (FTIMES NPTS REALHEIGHT)
HEIGHTONSCREEN])
(LEASTPOWEROF2GT
[LAMBDA (FLOATP) (* rrb "20-Jun-84 18:57")
(* returns the number which is the least power of two
that is greater than FLOATP.)
(PROG [(LOG2 (FQUOTIENT (LOG FLOATP)
(CONSTANT (LOG 2]
(RETURN (COND
[(FGREATERP LOG2 0.0)
(COND
((EQUAL LOG2 (FLOAT (FIX LOG2))) (* special case of exact hit.)
(EXPT 2.0 (FIX LOG2)))
(T (EXPT 2.0 (ADD1 (FIX LOG2]
(T (EXPT 2.0 (FIX LOG2])
(GREATESTPOWEROF2LT
[LAMBDA (FLOATP) (* rrb " 9-Jul-85 17:43")
(* returns the number which is the greatest power of
two that is less than FLOATP.)
(PROG [(LOG2 (FQUOTIENT (LOG FLOATP)
(CONSTANT (LOG 2]
(RETURN (COND
((FGREATERP LOG2 0.0)
(EXPT 2.0 (FIX LOG2)))
((EQUAL LOG2 (FLOAT (FIX LOG2))) (* special case of exact hit.)
(EXPT 2.0 (FIX LOG2)))
(T (EXPT 2.0 (SUB1 (FIX LOG2])
(SK.DEFAULT.GRIDFACTOR
[LAMBDA (SKETCHW) (* rrb "21-Jun-84 12:30")
(* returns the default grid factor for a window.
Starts at about a quarter inch.)
(GRID.FACTOR1 (fetch (REGION HEIGHT) of (SK.REGION.VIEWED SKETCHW))
(WINDOWPROP SKETCHW (QUOTE HEIGHT))
DEFAULTGRIDSIZE])
(SK.PUT.ON.GRID
[LAMBDA (GPOSITION GRID) (* rrb " 7-Feb-85 11:32")
(* returns the grid point that is closest to
GPOSITION.)
(create POSITION
XCOORD ←(NEAREST.ON.GRID (fetch (POSITION XCOORD) of GPOSITION)
GRID)
YCOORD ←(NEAREST.ON.GRID (fetch (POSITION YCOORD) of GPOSITION)
GRID])
(MAP.WINDOW.ONTO.GRID
[LAMBDA (X SCALE GRID) (* rrb "20-Jun-84 16:53")
(* maps from a window point onto the window point that
is closest to GRID.)
(FIXR (QUOTIENT (NEAREST.ON.GRID (TIMES X SCALE)
GRID)
SCALE])
(MAP.SCREEN.ONTO.GRID
[LAMBDA (X SCALE GRID WOFFSET) (* rrb "20-Jun-84 16:22")
(* maps a screen coordinate into the screen coordinate
that is closest to the grid of a window with offset
WOFFSET.)
(COND
((OR (NOT GRID)
(EQ GRID 0)
(EQP GRID 0.0))
X)
(T (IPLUS (MAP.WINDOW.ONTO.GRID (IDIFFERENCE X WOFFSET)
SCALE GRID)
WOFFSET])
(MAP.GLOBAL.PT.ONTO.GRID
[LAMBDA (PT SKW) (* rrb " 7-Feb-85 11:33")
(* If the grid is in use, maps from a point in global
coordinates into the closest grid point in global
coordinates.)
(COND
((WINDOWPROP SKW (QUOTE USEGRID))
(SK.PUT.ON.GRID PT (SK.GRIDFACTOR SKW)))
(T PT])
(MAP.GLOBAL.REGION.ONTO.GRID
[LAMBDA (GREGION SKW) (* rrb "25-Jan-85 10:50")
(* If the grid is in use, maps from a region in global
coordinates into the closest larger region in global
coordinates.)
(COND
[(WINDOWPROP SKW (QUOTE USEGRID))
(PROG ((GRID (SK.GRIDFACTOR SKW))
HALFGRID NEWLEFT NEWBOTTOM)
(SETQ HALFGRID (QUOTIENT GRID 2.0))
(RETURN (CREATEREGION (SETQ NEWLEFT (NEAREST.ON.GRID (DIFFERENCE (fetch (REGION LEFT)
of GREGION)
HALFGRID)
GRID))
(SETQ NEWBOTTOM (NEAREST.ON.GRID (DIFFERENCE (fetch (REGION
BOTTOM)
of GREGION)
HALFGRID)
GRID))
(DIFFERENCE (NEAREST.ON.GRID (PLUS (fetch (REGION RIGHT)
of GREGION)
HALFGRID)
GRID)
NEWLEFT)
(DIFFERENCE (NEAREST.ON.GRID (PLUS (fetch (REGION TOP)
of GREGION)
HALFGRID)
GRID)
NEWBOTTOM]
(T GREGION])
(MAP.WINDOW.POINT.ONTO.GLOBAL.GRID
[LAMBDA (PT SCALE GRID) (* rrb " 1-Feb-85 14:08")
(* maps from a point in window coordinates into the
closest grid point in global coordinates.)
(create POSITION
XCOORD ←(MAP.WINDOW.ONTO.GLOBAL.GRID (fetch (POSITION XCOORD) of PT)
SCALE GRID)
YCOORD ←(MAP.WINDOW.ONTO.GLOBAL.GRID (fetch (POSITION YCOORD) of PT)
SCALE GRID])
(MAP.WINDOW.ONTO.GLOBAL.GRID
[LAMBDA (X SCALE GRID) (* rrb " 1-Feb-85 14:08")
(* maps from a window point onto the window point that
is closest to GRID.)
(NEAREST.ON.GRID (TIMES X SCALE)
GRID])
(SK.UPDATE.GRIDFACTOR
[LAMBDA (SKW OLDSCALE) (* rrb " 1-Feb-85 17:35")
(* determines the size of the grid for the newly scaled
window.)
(PROG ((OLDGRID (SK.GRIDFACTOR SKW))
X)
(SK.GRIDFACTOR SKW (GRID.FACTOR1 (fetch (REGION HEIGHT) of (SK.REGION.VIEWED SKW))
(WINDOWPROP SKW (QUOTE HEIGHT))
(IMIN DEFAULTMAXGRIDSIZE (FQUOTIENT OLDGRID OLDSCALE])
(SK.MAP.FROM.WINDOW.TO.GLOBAL.GRID
[LAMBDA (POSITION SKETCHW) (* rrb " 1-Feb-85 14:41")
(* maps from a position in a window to the
corresponding global position taking into account the
grid if it is in use.)
(COND
((WINDOWPROP SKETCHW (QUOTE USEGRID))
(MAP.WINDOW.POINT.ONTO.GLOBAL.GRID POSITION (WINDOW.SCALE SKETCHW)
(SK.GRIDFACTOR SKETCHW)))
(T (UNSCALE.POSITION POSITION (WINDOW.SCALE SKETCHW])
(SK.MAP.INPUT.PT.TO.GLOBAL
[LAMBDA (POSSPEC SKETCHW) (* rrb " 3-Oct-85 17:57")
(* maps from a position ala GETSKWPOSITION in a window
to the corresponding global position
(POSITION is a list of (GRIDON? position)))
(AND POSSPEC (COND
((fetch (INPUTPT INPUT.ONGRID?) of POSSPEC)
(MAP.WINDOW.POINT.ONTO.GLOBAL.GRID (fetch (INPUTPT INPUT.POSITION) of POSSPEC)
(WINDOW.SCALE SKETCHW)
(SK.GRIDFACTOR SKETCHW)))
(T (* map the point onto a grid location that would have
the same screen position as the given point.)
(SK.MAP.FROM.WINDOW.TO.NEAREST.GRID (fetch (INPUTPT INPUT.POSITION) of POSSPEC)
(WINDOW.SCALE SKETCHW)
T])
(SK.MAP.FROM.WINDOW.TO.NEAREST.GRID
[LAMBDA (POSITION SCALE NOMOVEFLG) (* rrb " 3-Oct-85 14:16")
(* maps from a point in a window to the closest grid position in the global space that has a distance between the
points of less than 1.0)
(PROG [(GRID (COND
(NOMOVEFLG
(* if NOMOVEFLG is on, use a grid small enough that the mapping into and out of coordinate space will leave
POSITION unchanged. For most uses, this is too fine.)
(GREATESTPOWEROF2LT SCALE))
(T (LEASTPOWEROF2GT (TIMES SCALE 2]
(RETURN (create POSITION
XCOORD ←(NEAREST.ON.GRID (TIMES (fetch (POSITION XCOORD)
of POSITION)
SCALE)
GRID)
YCOORD ←(NEAREST.ON.GRID (TIMES (fetch (POSITION YCOORD)
of POSITION)
SCALE)
GRID])
)
(RPAQ? DEFAULTGRIDSIZE 8)
(RPAQ? DEFAULTMINGRIDSIZE 4)
(RPAQ? DEFAULTMAXGRIDSIZE 32)
(* sketch icon support)
(DEFINEQ
(SKETCH.TITLE
[LAMBDA (SKW) (* rrb " 3-Jan-85 12:17")
(* gets the title of the sketch being edited in SKW.)
(fetch (SKETCH SKETCHNAME) of (INSURE.SKETCH (SKETCH.FROM.VIEWER SKW])
(SK.SHRINK.ICONCREATE
[LAMBDA (W) (* rrb " 3-Jan-85 12:16")
(* Create the icon that represents this window.)
(PROG [(ICON (WINDOWPROP W (QUOTE ICON)))
(ICONTITLE (WINDOWPROP W (QUOTE SKETCH.ICON.TITLE]
(COND
((OR (AND ICONTITLE (EQUAL ICONTITLE (SKETCH.TITLE W)))
(AND (NOT ICONTITLE)
ICON)) (* we built this and the title is the same, or he has
already put an icon on this.
Do nothing)
NIL)
(ICON (* There's an existing icon window;
change the title in it)
(WINDOWPROP W (QUOTE SKETCH.ICON.TITLE)
(SETQ ICONTITLE (SKETCH.TITLE W)))
(ICONTITLE ICONTITLE NIL NIL ICON))
(T (* install a new icon)
(WINDOWPROP W (QUOTE SKETCH.ICON.TITLE)
(SETQ ICONTITLE (SKETCH.TITLE W)))
(WINDOWPROP W (QUOTE ICON)
(TITLEDICONW SKETCH.TITLED.ICON.TEMPLATE ICONTITLE TEDIT.ICON.FONT NIL T])
)
(READVARS SKETCH.TITLED.ICON.TEMPLATE)
(({(READBITMAP)(87 95
"AOOOOOOOOOOOOOOOOOOOOL@@"
"GOOOOOOOOOOOOOOOOOOOOL@@"
"OKMHOHNCHNCHNCHNCHNCHN@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"ONJJCLGALGALGALGALGALF@@"
"LOOOOOOOOOOOOOOOOOOOON@@"
"NKOJCLGALGALGALGALGALF@@"
"ONOOOOOOOOOOOOOOOOOOON@@"
"NJJOOOOOOOOOOOOOOOOOON@@"
"NNKNGALGALGALGALGALGAL@@"
"OJJNOCLOCLOCLOCLOCLOCN@@"
"NJJNFAHFAHFAHFAHFAHFAN@@"
"NNJN@@@@@@@@@@@@@@@@@N@@"
"OJJN@@@@@@@@@@@@@@@@@N@@"
"OJKN@@@@@@@@@@@@@@@@@N@@"
"NJKN@@@@@@@@@@@@@@@@@N@@"
"OKNN@@@@@@@@@@@@@@@@@N@@"
"OKJN@@@@@@@@@@@@@@@@@N@@"
"NJJN@@@@@@@@@@@@@@@@@N@@"
"NJNN@@@@@@@@@@@@@@@@@N@@"
"NKJN@@@@@@@@@@@@@@@@@N@@"
"NJJN@@@@@@@@@@@@@@@@@N@@"
"NNKN@@@@@@@@@@@@@@@@@N@@"
"NNKN@@@@@@@@@@@@@@@@@N@@"
"OJNN@@@@@@@@@@@@@@@@@N@@"
"NJNN@@@@@@@@@@@@@@@@@N@@"
"OJNN@@@@@@@@@@@@@@@@@N@@"
"OJJN@@@@@@@@@@@@@@@@@N@@"
"NNNN@@@@@@@@@@@@@@@@@N@@"
"NNNN@@@@@@@@@@@@@@@@@N@@"
"NJNN@@@@@@@@@@@@@@@@@N@@"
"NJKN@@@@@@@@@@@@@@@@@N@@"
"NJJN@@@@@@@@@@@@@@@@@N@@"
"L@@N@@@@@@@@@@@@@@@@@N@@"
"L@@N@@@@@@@@@@@@@@@@@N@@"
"L@BN@@@@@@@@@@@@@@@@@N@@"
"L@NN@@@@@@@@@@@@@@@@@N@@"
"LA@N@@@@@@@@@@@@@@@@@N@@"
"MM@N@@@@@@@@@@@@@@@@@N@@"
"LCBN@@@@@@@@@@@@@@@@@N@@"
"L@NN@@@@@@@@@@@@@@@@@N@@"
"L@BN@@@@@@@@@@@@@@@@@N@@"
"L@@N@@@@@@@@@@@@@@@@@N@@"
"L@@N@@@@@@@@@@@@@@@@@N@@"
"LB@N@@@@@@@@@@@@@@@@@N@@"
"LDDN@@@@@@@@@@@@@@@@@N@@"
"LDBN@@@@@@@@@@@@@@@@@N@@"
"LBBN@@@@@@@@@@@@@@@@@N@@"
"LALN@@@@@@@@@@@@@@@@@N@@"
"L@@N@@@@@@@@@@@@@@@@@N@@"
"L@@N@@@@@@@@@@@@@@@@@N@@"
"L@@N@@@@@@@@@@@@@@@@@N@@"
"LDDN@@@@@@@@@@@@@@@@@N@@"
"MLBN@@@@@@@@@@@@@@@@@N@@"
"LGBN@@@@@@@@@@@@@@@@@N@@"
"LDNN@@@@@@@@@@@@@@@@@N@@"
"L@@N@@@@@@@@@@@@@@@@@N@@"
"L@@N@@@@@@@@@@@@@@@@@N@@"
"L@@N@@@@@@@@@@@@@@@@@N@@"
"LC@N@@@@@@@@@@@@@@@@@N@@"
"LDHN@@@@@@@@@@@@@@@@@N@@"
"LDJN@@@@@@@@@@@@@@@@@N@@"
"LCJN@@@@@@@@@@@@@@@@@N@@"
"LABN@@@@@@@@@@@@@@@@@N@@"
"L@NN@@@@@@@@@@@@@@@@@N@@"
"L@@N@@@@@@@@@@@@@@@@@N@@"
"LD@N@@@@@@@@@@@@@@@@@N@@"
"LB@N@@@@@@@@@@@@@@@@@N@@"
"MBNN@@@@@@@@@@@@@@@@@N@@"
"MM@N@@@@@@@@@@@@@@@@@N@@"
"LCHN@@@@@@@@@@@@@@@@@N@@"
"L@FN@@@@@@@@@@@@@@@@@N@@"
"L@BN@@@@@@@@@@@@@@@@@N@@"
"L@@N@@@@@@@@@@@@@@@@@N@@"
"LH@N@@@@@@@@@@@@@@@@@N@@"
"M@@N@@@@@@@@@@@@@@@@@N@@"
"MAHN@@@@@@@@@@@@@@@@@N@@"
"MBDN@@@@@@@@@@@@@@@@@N@@"
"MBDN@@@@@@@@@@@@@@@@@N@@"
"LLDN@@@@@@@@@@@@@@@@@N@@"
"L@DN@@@@@@@@@@@@@@@@@N@@"
"L@DN@@@@@@@@@@@@@@@@@N@@"
"L@LN@@@@@@@@@@@@@@@@@N@@"
"L@@N@@@@@@@@@@@@@@@@@N@@"
"L@@N@@@@@@@@@@@@@@@@@N@@"
"NJJN@@@@@@@@@@@@@@@@@N@@"
"OJJN@@@@@@@@@@@@@@@@@N@@"
"NKKN@@@@@@@@@@@@@@@@@N@@"
"OJNN@@@@@@@@@@@@@@@@@N@@"
"CNNN@@@@@@@@@@@@@@@@@N@@"
"@OJN@@@@@@@@@@@@@@@@@N@@"
"@CNN@@@@@@@@@@@@@@@@@N@@"
"@@OOOOOOOOOOOOOOOOOOON@@"
"@@COOOOOOOOOOOOOOOOOON@@"
"@@@OOOOOOOOOOOOOOOOOON@@")} {(READBITMAP)(87 95
"AOOOOOOOOOOOOOOOOOOOOH@@"
"GOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"OOOOOOOOOOOOOOOOOOOOON@@"
"COOOOOOOOOOOOOOOOOOOON@@"
"@OOOOOOOOOOOOOOOOOOOON@@"
"@COOOOOOOOOOOOOOOOOOON@@"
"@@OOOOOOOOOOOOOOOOOOON@@"
"@@COOOOOOOOOOOOOOOOOON@@"
"@@@OOOOOOOOOOOOOOOOOON@@")} (16 4 64 77)))
(* history and undo stuff)
(DEFINEQ
(SK.ADD.HISTEVENT
[LAMBDA (EVENTTYPE EVENTARGS SKETCHW) (* rrb "11-Jan-85 18:04")
(* puts a history event on a sketch window.)
(* trim to a given length)
(PROG [(HISTLST (WINDOWPROP SKETCHW (QUOTE SKETCHHISTORY]
(WINDOWPROP SKETCHW (QUOTE SKETCHHISTORY)
(CONS (create SKHISTEVENT
EVENTTYPE ← EVENTTYPE
EVENTARGS ← EVENTARGS)
(COND
((GREATERP SKETCH.#.UNDO.ITEMS (LENGTH HISTLST))
(* there is room for one more)
HISTLST)
(T (REMOVE.LAST HISTLST])
(SK.SEL.AND.UNDO
[LAMBDA (SKW) (* rrb " 3-May-85 11:05")
(* gives the user a choice of past events to undo.)
(PROG [EVENT UNDOFN (HISTLST (WINDOWPROP SKW (QUOTE SKETCHHISTORY]
(COND
((NULL HISTLST)
(STATUSPRINT SKW "Nothing to undo.")
(RETURN)))
(COND
([SETQ EVENT (MENU (create MENU
ITEMS ←(for EVENT in HISTLST collect (LIST (SK.UNDO.NAME
EVENT)
EVENT))
WHENSELECTEDFN ←(FUNCTION CADR)
TITLE ← "Select event to undo"
WHENHELDFN ←(FUNCTION (LAMBDA (ITEM MENU BUTTON)
(PROMPTPRINT "Will undo this event."]
(COND
((fetch (SKHISTEVENT UNDONE?) of EVENT) (* can't undo already undone event.
They are included in the menu to provide session
continuity.)
(STATUSPRINT SKW "That event has already been undone.")
(RETURN NIL))
([NULL (SETQ UNDOFN (fetch (SKEVENTTYPE SKUNDOFN) of (SKEVENTTYPEFNS
(fetch (SKHISTEVENT EVENTTYPE)
of EVENT]
(STATUSPRINT SKW "Can't undo that event.")
(RETURN NIL)))
(COND
((APPLY* UNDOFN (fetch (SKHISTEVENT EVENTARGS) of EVENT)
SKW EVENT) (* only add to history list if something happened.)
(replace (SKHISTEVENT UNDONE?) of EVENT with T)
(SK.ADD.HISTEVENT (QUOTE UNDO)
EVENT SKW))
((NOT (EQ UNDOFN (QUOTE SK.UNDO.UNDO)))
(STATUSPRINT SKW "Element subsequently modified, can't undo"])
(SK.UNDO.LAST
[LAMBDA (SKW) (* rrb " 9-May-85 10:05")
(* undoes the first not yet undone history event.)
(PROG [EVENT UNDOFN (HISTLST (WINDOWPROP SKW (QUOTE SKETCHHISTORY]
(COND
((NULL HISTLST)
(STATUSPRINT SKW "Nothing to undo.")
(RETURN)))
(COND
[(SETQ EVENT (for HISTEVENT in HISTLST when [AND (NOT (EQ (fetch (SKHISTEVENT EVENTTYPE)
of HISTEVENT)
(QUOTE UNDO)))
(NOT (fetch (SKHISTEVENT UNDONE?)
of HISTEVENT))
(SETQ UNDOFN
(fetch (SKEVENTTYPE SKUNDOFN)
of (SKEVENTTYPEFNS
(fetch (SKHISTEVENT EVENTTYPE)
of HISTEVENT]
do (RETURN HISTEVENT)))
(COND
((APPLY* UNDOFN (fetch (SKHISTEVENT EVENTARGS) of EVENT)
SKW EVENT) (* only add to history list if something happened.)
(STATUSPRINT SKW (SK.UNDO.NAME EVENT)
" event undone.")
(replace (SKHISTEVENT UNDONE?) of EVENT with T)
(SK.ADD.HISTEVENT (QUOTE UNDO)
EVENT SKW))
((NOT (EQ UNDOFN (QUOTE SK.UNDO.UNDO)))
(STATUSPRINT SKW "Element subsequently modified, can't undo"]
(T (STATUSPRINT SKW "
" "All event have been undone. Use the '?UNDO' subcommand to undo an UNDO command."])
(SK.UNDO.NAME
[LAMBDA (HISTEVENT) (* rrb "17-Apr-84 11:27")
(* returns the menu label for HISTEVENT.)
(APPLY* (fetch (SKEVENTTYPE SKUNDONAMEFN) of (SKEVENTTYPEFNS (fetch (SKHISTEVENT EVENTTYPE)
of HISTEVENT)))
HISTEVENT])
(SKEVENTTYPEFNS
[LAMBDA (EVENTTYPE) (* rrb "17-Apr-84 11:02")
(* returns the list of type related functions
associated with EVENTTYPE.)
(GETPROP EVENTTYPE (QUOTE EVENTFNS])
(SK.TYPE.OF.FIRST.ARG
[LAMBDA (HISTEVENT NOMARKUNDOFLG) (* rrb " 4-Jun-85 13:46")
(* returns a name suitable for a menu label for an
history event by combining the event name with the type
of its arg.)
(PROG ((ARGS (fetch (SKHISTEVENT EVENTARGS) of HISTEVENT))
(TYPE (fetch (SKHISTEVENT EVENTTYPE) of HISTEVENT)))
(RETURN (CONCAT (COND
((AND (NULL NOMARKUNDOFLG)
(fetch (SKHISTEVENT UNDONE?) of HISTEVENT))
"*")
(T " "))
TYPE " " (COND
((CDR ARGS)
(QUOTE "a group"))
(T (SELECTQ TYPE
[(MOVE CHANGE)
(SK.LABEL.FROM.TYPE (fetch (GLOBALPART GTYPE)
of (CAAR ARGS]
(SK.LABEL.FROM.TYPE (fetch (GLOBALPART GTYPE)
of (CAR ARGS])
)
(DEFINEQ
(SK.DELETE.UNDO
[LAMBDA (EVENTARGS SKW) (* rrb "11-Sep-84 14:57")
(* undoes a delete event)
(PROG (CHANGED?)
[for GELT in EVENTARGS do (COND
((SK.ADD.ELEMENT GELT SKW)
(SETQ CHANGED? T]
(RETURN CHANGED?])
(SK.ADD.UNDO
[LAMBDA (EVENTARGS SKW) (* rrb "11-Sep-84 15:58")
(* undoes an add event)
(PROG (CHANGED?)
[for GELT in EVENTARGS do (COND
((SK.DELETE.ELEMENT1 GELT SKW)
(SETQ CHANGED? T]
(RETURN CHANGED?])
)
(DEFINEQ
(SK.CHANGE.UNDO
[LAMBDA (EVENTARGS SKW) (* rrb "11-Sep-84 15:57")
(* undoes a change event)
(* the args for a change event are the old {previous}
global part of the element and the new global part of
the element.)
(PROG (CHANGED?)
[for PAIR in EVENTARGS do (COND
((SK.UPDATE.ELEMENT (CADR PAIR)
(CAR PAIR)
SKW)
(SETQ CHANGED? T]
(RETURN CHANGED?])
(SK.CHANGE.REDO
[LAMBDA (EVENTARGS SKW) (* rrb "10-Sep-84 17:01")
(* redoes a change event)
(PROG (CHANGE)
(for PAIR in EVENTARGS do (AND (SK.UPDATE.ELEMENT (CAR PAIR)
(CADR PAIR)
SKW)
(SETQ CHANGE T)))
(OR CHANGE (STATUSPRINT SKW
"That sketch element has been changed by something else, can't redo."])
)
(DEFINEQ
(SK.UNDO.UNDO
[LAMBDA (UNDONEEVENT SKW THISEVENT) (* rrb "18-Apr-84 15:32")
(* undoes an UNDO event by calling the REDO fn of that
event type.)
(PROG (REDOFN)
(COND
([SETQ REDOFN (fetch (SKEVENTTYPE SKREDOFN) of (SKEVENTTYPEFNS (fetch (SKHISTEVENT
EVENTTYPE)
of UNDONEEVENT]
(APPLY* REDOFN (fetch (SKHISTEVENT EVENTARGS) of UNDONEEVENT)
SKW)
(replace (SKHISTEVENT UNDONE?) of UNDONEEVENT with NIL)
(* remove the undo event from the history list.)
(WINDOWDELPROP SKW (QUOTE SKETCHHISTORY)
THISEVENT))
(T (STATUSPRINT SKW "Can't undo that event.")))
(* always return NIL so the undoing of an undo event
won't be added as an event.)
(RETURN NIL])
(SK.UNDO.MENULABEL
[LAMBDA (UNDOEVENT) (* rrb "18-Sep-84 11:53")
(* returns a name suitable for a menu label for an UNDO history event by combining the event name with the type of
its arg.)
(CONCAT "undo" (SK.TYPE.OF.FIRST.ARG (fetch (SKHISTEVENT EVENTARGS) of UNDOEVENT)
T])
(SK.LABEL.FROM.TYPE
[LAMBDA (SKELEMENTTYPE) (* rrb " 4-Jun-85 13:40")
(* takes a type name and returns the label for it. These two are different because the names changed since the first
sketchs were made.)
(SELECTQ SKELEMENTTYPE
(WIRE (QUOTE LINE))
(OPENCURVE (QUOTE CURVE))
(CLOSEDWIRE (QUOTE POLYGON))
SKELEMENTTYPE])
)
(DECLARE: DONTCOPY
[DECLARE: EVAL@COMPILE
(RECORD SKHISTEVENT (EVENTTYPE EVENTARGS UNDONE?))
(RECORD SKEVENTTYPE (SKUNDOFN SKUNDONAMEFN SKREDOFN))
]
)
(RPAQ? SKETCH.#.UNDO.ITEMS 30)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS SKETCH.#.UNDO.ITEMS)
)
(PUTPROPS ADD EVENTFNS (SK.ADD.UNDO SK.TYPE.OF.FIRST.ARG SK.DELETE.UNDO))
(PUTPROPS DELETE EVENTFNS (SK.DELETE.UNDO SK.TYPE.OF.FIRST.ARG SK.ADD.UNDO))
(PUTPROPS CHANGE EVENTFNS (SK.CHANGE.UNDO SK.TYPE.OF.FIRST.ARG SK.CHANGE.REDO))
(PUTPROPS UNDO EVENTFNS (SK.UNDO.UNDO SK.UNDO.MENULABEL SHOULDNT))
(PUTPROPS MOVE EVENTFNS (SK.CHANGE.UNDO SK.TYPE.OF.FIRST.ARG SK.CHANGE.REDO))
(PUTPROPS COPY EVENTFNS (SK.ADD.UNDO SK.TYPE.OF.FIRST.ARG SK.DELETE.UNDO))
(* functions for hardcopying)
(DEFINEQ
(SKETCHW.HARDCOPYFN
[LAMBDA (SKETCHW OPENIMAGESTREAM) (* rrb " 3-Sep-85 15:45")
(* dumps the sketch onto OPENIMAGESTREAM.)
(* centers it within the DSPCLIPPINGREGION of
OPENIMAGESTREAM)
(PROG ((SKETCH (INSURE.SKETCH (SKETCH.FROM.VIEWER SKETCHW)))
(VIEWREGION (DSPCLIPPINGREGION NIL SKETCHW))
(PAGEREGION (DSPCLIPPINGREGION NIL OPENIMAGESTREAM))
(SKETCHREGION (SK.REGION.VIEWED SKETCHW))
(SCALE (WINDOW.SCALE SKETCHW))
SKETCHREGIONINPAGECOORDS PAGELEFTSPACE PAGEBOTTOMSPACE PAGETOSKETCHFACTOR SKETCHX)
(OR SKETCH (RETURN))
(SPAWN.MOUSE) (* PAGETOSKETCHFACTOR is the factor to multiply the
page coordinates by to get into sketch coordinates.)
(STATUSPRINT SKETCHW "Hardcopying ...")
(SETQ PAGETOSKETCHFACTOR (FQUOTIENT SCALE (DSPSCALE NIL OPENIMAGESTREAM)))
(SETQ SKETCHREGIONINPAGECOORDS (SCALE.REGION SKETCHREGION PAGETOSKETCHFACTOR))
(COND
((AND (IMAGESTREAMTYPEP OPENIMAGESTREAM (QUOTE INTERPRESS))
(GREATERP (fetch WIDTH of SKETCHREGIONINPAGECOORDS)
(fetch WIDTH of PAGEREGION))
(GREATERP (fetch WIDTH of SKETCHREGIONINPAGECOORDS)
(fetch HEIGHT of SKETCHREGIONINPAGECOORDS)))
(* Print in landscape mode)
(* only know the hack for interpress streams.)
(* Hack to coerce interpress stream into landscapemode)
(ROTATE.IP OPENIMAGESTREAM 90)
(CONCATT.IP OPENIMAGESTREAM)
(TRANSLATE.IP OPENIMAGESTREAM 0 -21590)
(CONCATT.IP OPENIMAGESTREAM)
(DSPCLIPPINGREGION (SETQ PAGEREGION (SK.SWITCH.REGION.X.AND.Y PAGEREGION))
OPENIMAGESTREAM) (* End HACK)
))
(SETQ PAGELEFTSPACE (QUOTIENT (DIFFERENCE (fetch (REGION WIDTH) of PAGEREGION)
(fetch (REGION WIDTH) of SKETCHREGIONINPAGECOORDS)
)
2))
(SETQ PAGEBOTTOMSPACE (QUOTIENT (DIFFERENCE (fetch (REGION HEIGHT) of PAGEREGION)
(fetch (REGION HEIGHT) of
SKETCHREGIONINPAGECOORDS))
2))
(* translate the sketch so that the lower left corner of the sketch region is at the lower left corner of the image
on the page.)
[SETQ SKETCHX (TRANSLATE.SKETCH SKETCH (MINUS (TIMES (DIFFERENCE
(SETQ PAGELEFTSPACE
(PLUS (fetch (REGION LEFT)
of PAGEREGION)
PAGELEFTSPACE))
(fetch (REGION LEFT) of
SKETCHREGIONINPAGECOORDS))
PAGETOSKETCHFACTOR))
(MINUS (TIMES (DIFFERENCE (SETQ PAGEBOTTOMSPACE
(PLUS (fetch (REGION BOTTOM)
of PAGEREGION)
PAGEBOTTOMSPACE))
(fetch (REGION BOTTOM)
of SKETCHREGIONINPAGECOORDS))
PAGETOSKETCHFACTOR]
(* calculate the local parts for the interpress
sketch.)
(SETQ SKETCHX (MAKE.LOCAL.SKETCH SKETCHX (CREATEREGION (TIMES PAGELEFTSPACE
PAGETOSKETCHFACTOR)
(TIMES PAGEBOTTOMSPACE
PAGETOSKETCHFACTOR)
(fetch (REGION WIDTH) of
SKETCHREGION)
(fetch (REGION HEIGHT) of
SKETCHREGION))
PAGETOSKETCHFACTOR OPENIMAGESTREAM T))
(DRAW.LOCAL.SKETCH SKETCHX OPENIMAGESTREAM (CREATEREGION PAGELEFTSPACE PAGEBOTTOMSPACE
(fetch (REGION WIDTH)
of SKETCHREGIONINPAGECOORDS)
(fetch (REGION HEIGHT)
of SKETCHREGIONINPAGECOORDS)))
(STATUSPRINT SKETCHW " done.")
(RETURN OPENIMAGESTREAM])
(\SK.LIST.PAGE.IMAGE
[LAMBDA (OPENIMAGESTREAM REGIONINSKETCH LOCALSKELTS PAGETOSKETCHFACTOR REGIONONPAGE
SKETCHTOWINDOWFACTOR) (* rrb " 9-Jul-85 12:37")
(* draws the image of a set of sketch elements on an
OPENIMAGESTREAM.)
(PROG ((SCALEDSKETCHREGION (SCALE.REGION REGIONINSKETCH SKETCHTOWINDOWFACTOR))
ELTSINREGION SKETCHX)
(COND
((SETQ ELTSINREGION (for LOCALSKELT in LOCALSKELTS when (REGIONSINTERSECTP
SCALEDSKETCHREGION
(SK.ITEM.REGION
LOCALSKELT))
collect (fetch (SCREENELT GLOBALPART) of LOCALSKELT)))
(* translate the sketch so that the right stuff appears
in the region on the page.)
[SETQ SKETCHX (TRANSLATE.SKETCH (create SKETCH
SKETCHELTS ← ELTSINREGION)
(DIFFERENCE (fetch (REGION LEFT) of REGIONINSKETCH)
(TIMES (fetch (REGION LEFT) of REGIONONPAGE)
PAGETOSKETCHFACTOR))
(DIFFERENCE (fetch (REGION BOTTOM) of REGIONINSKETCH)
(TIMES (fetch (REGION BOTTOM) of
REGIONONPAGE)
PAGETOSKETCHFACTOR]
(SETQ SKETCHX (MAKE.LOCAL.SKETCH SKETCHX (CREATEREGION 0 0 (fetch (REGION WIDTH)
of REGIONINSKETCH)
(fetch (REGION HEIGHT)
of REGIONINSKETCH))
PAGETOSKETCHFACTOR OPENIMAGESTREAM T))
(DRAW.LOCAL.SKETCH SKETCHX OPENIMAGESTREAM REGIONONPAGE])
(SK.LIST.IMAGE
[LAMBDA (SKETCHW FILE IMAGETYPE DONTLISTFLG) (* rrb " 3-Sep-85 15:48")
(* makes an image file from the sketch in a window even
if it takes more than one page.)
(PROG ((SKETCH (INSURE.SKETCH (SKETCH.FROM.VIEWER SKETCHW)))
(VIEWREGION (DSPCLIPPINGREGION NIL SKETCHW))
(SCALE (WINDOW.SCALE SKETCHW))
PAGEREGION OPENIMAGESTREAM PAGEOVERLAPMARGIN SKETCHREGION SKETCHLOCALELTS
SKETCHREGIONINPAGECOORDS LEFTSTART BOTTOMSTART RIGHTEND BOTTOMEND PAGETOSKETCHFACTOR
PAGEHEIGHTINSKETCHCOORDS PAGEWIDTHINSKETCHCOORDS)
(OR SKETCH (RETURN))
(SPAWN.MOUSE)
(STATUSPRINT SKETCHW "Hardcopying ... ")
(SETQ OPENIMAGESTREAM (OPENIMAGESTREAM FILE IMAGETYPE))
(SETQ PAGEREGION (DSPCLIPPINGREGION NIL OPENIMAGESTREAM))
(* calculate the local elements for all the sketch elements at this scale. This is done because the region testing
routines all work on local elements. The local elements will be made again for each page; wasteful but should
demonstrate the capability.)
(SETQ SKETCHLOCALELTS (for SKELT in (fetch (SKETCH SKETCHELTS) of SKETCH)
collect (SK.LOCAL.FROM.GLOBAL SKELT SKETCHW SCALE)))
(SETQ SKETCHREGION (SK.GLOBAL.REGION.OF.ELEMENTS SKETCHLOCALELTS SCALE))
(* PAGETOSKETCHFACTOR is the factor to multiply the
page coordinates by to get into sketch coordinates.)
(SETQ PAGETOSKETCHFACTOR (FQUOTIENT SCALE (DSPSCALE NIL OPENIMAGESTREAM)))
(SETQ SKETCHREGIONINPAGECOORDS (SCALE.REGION SKETCHREGION PAGETOSKETCHFACTOR))
(* should check here for wider than high and rotate it
or use landscape imagestream.)
[COND
((AND (ILESSP (fetch (REGION WIDTH) of SKETCHREGIONINPAGECOORDS)
(fetch (REGION WIDTH) of PAGEREGION))
(ILESSP (fetch (REGION HEIGHT) of SKETCHREGIONINPAGECOORDS)
(fetch (REGION HEIGHT) of PAGEREGION)))
(* whole image fits on one page, center it)
(SETQ LEFTSTART (QUOTIENT (DIFFERENCE (fetch (REGION WIDTH) of PAGEREGION)
(fetch (REGION WIDTH) of SKETCHREGIONINPAGECOORDS)
)
2))
(SETQ BOTTOMSTART (QUOTIENT (DIFFERENCE (fetch (REGION HEIGHT) of PAGEREGION)
(fetch (REGION HEIGHT) of
SKETCHREGIONINPAGECOORDS))
2))
(\SK.LIST.PAGE.IMAGE OPENIMAGESTREAM SKETCHREGION SKETCHLOCALELTS PAGETOSKETCHFACTOR
(CREATEREGION LEFTSTART BOTTOMSTART (fetch (REGION WIDTH)
of SKETCHREGIONINPAGECOORDS)
(fetch (REGION HEIGHT) of SKETCHREGIONINPAGECOORDS))
SCALE))
(T (* put sketch on multiple pages.
Might also try scaling it to fit.)
(* leave a half inch so that the pages can be taped
together.)
(SETQ PAGEOVERLAPMARGIN (TIMES 36 (DSPSCALE NIL OPENIMAGESTREAM)))
(SETQ PAGEREGION (CREATEREGION (fetch (REGION LEFT) of PAGEREGION)
(fetch (REGION BOTTOM) of PAGEREGION)
(DIFFERENCE (fetch (REGION WIDTH) of PAGEREGION)
PAGEOVERLAPMARGIN)
(DIFFERENCE (fetch (REGION HEIGHT) of PAGEREGION)
PAGEOVERLAPMARGIN)))
(SETQ PAGEWIDTHINSKETCHCOORDS (TIMES (fetch (REGION WIDTH) of PAGEREGION)
PAGETOSKETCHFACTOR))
(SETQ PAGEHEIGHTINSKETCHCOORDS (TIMES (fetch (REGION HEIGHT) of PAGEREGION)
PAGETOSKETCHFACTOR))
(* adjust sketch region to center the image within the multiple pages. This is mostly to cover the case of a wide
but not high image that extents across multiple pages.)
[COND
([NOT (ZEROP (SETQ LEFTSTART (REMAINDER (fetch (REGION WIDTH) of SKETCHREGION)
PAGEWIDTHINSKETCHCOORDS]
(* unless the sketch is right on a page boundary, leave
half the room in front.)
(SETQ LEFTSTART (QUOTIENT (DIFFERENCE PAGEWIDTHINSKETCHCOORDS LEFTSTART)
2]
(SETQ LEFTSTART (DIFFERENCE (fetch (REGION LEFT) of SKETCHREGION)
LEFTSTART))
[COND
([NOT (ZEROP (SETQ BOTTOMSTART (REMAINDER (fetch (REGION HEIGHT) of SKETCHREGION)
PAGEHEIGHTINSKETCHCOORDS]
(* unless the sketch is right on a page boundary, leave
half the room in front.)
(SETQ BOTTOMSTART (QUOTIENT (DIFFERENCE PAGEHEIGHTINSKETCHCOORDS BOTTOMSTART)
2]
(SETQ BOTTOMSTART (DIFFERENCE (PLUS (fetch (REGION TOP) of SKETCHREGION)
BOTTOMSTART)
PAGEHEIGHTINSKETCHCOORDS))
(SETQ BOTTOMEND (DIFFERENCE (fetch (REGION BOTTOM) of SKETCHREGION)
PAGEHEIGHTINSKETCHCOORDS))
(SETQ RIGHTEND (fetch (REGION RIGHT) of SKETCHREGION))
(STATUSPRINT SKETCHW (TIMES (IQUOTIENT (DIFFERENCE (PLUS RIGHTEND (SUB1
PAGEWIDTHINSKETCHCOORDS))
LEFTSTART)
PAGEWIDTHINSKETCHCOORDS)
(IQUOTIENT (DIFFERENCE (PLUS BOTTOMSTART (SUB1
PAGEHEIGHTINSKETCHCOORDS))
BOTTOMEND)
PAGEHEIGHTINSKETCHCOORDS))
" pgs...")
(bind (PGN ← 0) for PGBOTTOM from BOTTOMSTART to BOTTOMEND by (MINUS
PAGEHEIGHTINSKETCHCOORDS)
as PGROW from 1
do (* unless this is the first line of pages, put out new
page.)
(OR (EQ PGROW 1)
(DSPNEWPAGE OPENIMAGESTREAM))
(for PGLEFT from LEFTSTART to RIGHTEND by PAGEWIDTHINSKETCHCOORDS as PGCOL
from 1
do (* unless this is the first page on a line of pages,
put out new page.)
(OR (EQ PGCOL 1)
(DSPNEWPAGE OPENIMAGESTREAM))
(\SK.LIST.PAGE.IMAGE OPENIMAGESTREAM (CREATEREGION PGLEFT PGBOTTOM
PAGEWIDTHINSKETCHCOORDS
PAGEHEIGHTINSKETCHCOORDS)
SKETCHLOCALELTS PAGETOSKETCHFACTOR PAGEREGION SCALE)
(STATUSPRINT SKETCHW (SETQ PGN (ADD1 PGN))
",")
(* code to put out matrix numbers that I couldn't get to work. (COND ((IMAGESTREAMTYPEP OPENIMAGESTREAM
(QUOTE PRESS)) (* Press does better at the left edge so put numbers on the right.) (COND ((LESSP
(PLUS PGLEFT PAGEWIDTHINSKETCHCOORDS) (fetch (REGION RIGHT) of SKETCHREGION)) (* unless this is the last page, print
a page number in the area that is overlapped.) (* this should change back to the default font of the stream but I
don't know how to do that.) (MOVETO (fetch (REGION WIDTH) of PAGEREGION) (PLUS (fetch (REGION HEIGHT) of PAGEREGION)
(FONTPROP OPENIMAGESTREAM (QUOTE DESCENT))) OPENIMAGESTREAM) (printout OPENIMAGESTREAM PGROW ", " PGCOL))))
((NEQ PGCOL 1) (* Interpress and assumed all others look better at the right edge so put the number on the left.)
(* unless this is the first page, print a page number in the area that is overlapped.) (* this should change back to
the default font of the stream but I don't know how to do that.) (MOVETO 10 (FONTPROP OPENIMAGESTREAM
(QUOTE DESCENT)) OPENIMAGESTREAM) (printout OPENIMAGESTREAM PGROW ", " PGCOL))))
]
(SETQ LEFTSTART (CLOSEF OPENIMAGESTREAM))
(STATUSPRINT SKETCHW "...done.")
(RETURN LEFTSTART])
(SK.LIST.IMAGE.ON.FILE
[LAMBDA (SKETCHW) (* rrb "17-Jul-85 21:34")
(* makes a file suitable for the default printing host
of the current sketch. Pretty dumb about file names.)
(SK.LIST.IMAGE SKETCHW [PACKFILENAME (CONS (QUOTE EXTENSION)
(CONS (DEFAULTPRINTINGIMAGETYPE)
(UNPACKFILENAME
(OR (fetch (SKETCH SKETCHNAME)
of (INSURE.SKETCH (SKETCH.FROM.VIEWER
SKETCHW)))
(QUOTE Sketch]
(DEFAULTPRINTINGIMAGETYPE])
(SK.SET.HARDCOPY.MODE
[LAMBDA (SKETCHW IMAGETYPE) (* rrb "17-Apr-85 21:28")
(* * changes a sketch window to show things in hardcopy mode.)
(PROG [NOWTYPE (IMAGETYPEX (OR IMAGETYPE (PRINTERTYPE]
(RETURN (COND
((OR (NOT (IMAGESTREAMTYPEP SKETCHW (QUOTE HARDCOPY)))
(AND (SETQ NOWTYPE (HARDCOPYSTREAMTYPE SKETCHW))
(NEQ IMAGETYPEX NOWTYPE))) (* make the font of the stream be something that will
not cause MAKEHARDCOPYSTREAM to barf on.)
(* flip cursor because finding fonts can take a while.)
(RESETFORM (CURSOR WAITINGCURSOR)
(DSPFONT (DEFAULTFONT IMAGETYPE)
SKETCHW)
(MAKEHARDCOPYSTREAM SKETCHW IMAGETYPE)
(SK.UPDATE.AFTER.HARDCOPY SKETCHW)))
(T (* already in hardcopy mode.)
(STATUSPRINT SKETCHW "The display is already showing " IMAGETYPE
" output spacing."])
(SK.UNSET.HARDCOPY.MODE
[LAMBDA (SKETCHW) (* rrb "28-Jun-85 18:20")
(* * changes a sketch window to show things in normal display mode.)
(COND
((IMAGESTREAMTYPEP (GETSTREAM SKETCHW (QUOTE OUTPUT))
(QUOTE HARDCOPY))
(UNMAKEHARDCOPYSTREAM SKETCHW)
(SK.UPDATE.AFTER.HARDCOPY SKETCHW])
(SK.UPDATE.AFTER.HARDCOPY
[LAMBDA (SKETCHW) (* rrb "29-Jan-85 14:40")
(* * goes through a sketch window updating those elements that have changed as a result of a change in mode between
normal and hardcopy and redraws the screen.)
(MAPSKETCHSPECS (LOCALSPECS.FROM.VIEWER SKETCHW)
[FUNCTION (LAMBDA (SKELT SKW SCALE)
(COND
((MEMB (fetch (SCREENELT GTYPE) of SKELT)
(QUOTE (TEXT TEXTBOX)))
(ZOOM.UPDATE.ELT SKELT SKW]
SKETCHW
(SKETCHW.SCALE SKETCHW))
(REDISPLAYW SKETCHW])
(DEFAULTPRINTINGIMAGETYPE
[LAMBDA NIL (* rrb "20-Mar-85 12:45")
(* returns the image type of the default printer.)
(* code copied from OPENIMAGESTREAM)
(CAR (MKLIST (PRINTERPROP (PRINTERTYPE (OR (CAR (LISTP DEFAULTPRINTINGHOST))
DEFAULTPRINTINGHOST))
(QUOTE CANPRINT])
(SK.SWITCH.REGION.X.AND.Y
[LAMBDA (REGION) (* rrb " 3-Sep-85 14:50")
(* switchs the X and Y dimensions of a region.)
(CREATEREGION (fetch (REGION BOTTOM) of REGION)
(fetch (REGION LEFT) of REGION)
(fetch (REGION HEIGHT) of REGION)
(fetch (REGION WIDTH) of REGION])
)
(DECLARE: EVAL@COMPILE
(RPAQQ MICASPERPT 35.27778)
(RPAQQ IMICASPERPT 35)
(RPAQQ PTSPERMICA .02834646)
(CONSTANTS MICASPERPT IMICASPERPT PTSPERMICA)
)
(* functions for displaying the global coordinate space values.)
(DEFINEQ
(SHOW.GLOBAL.COORDS
[LAMBDA (XCOORD YCOORD W) (* rrb " 5-Jun-85 18:30")
(* converts to global coordinates and displays it in W)
(DSPRESET W)
(COND
((AND (EQP XCOORD (FIX XCOORD))
(EQP YCOORD (FIX YCOORD)))
(printout W .F6.0 XCOORD " x" " " T .F6.0 YCOORD " y" " "))
(T (printout W .F8.2 XCOORD " x" " " T .F8.2 YCOORD " y" " "])
(LOCATOR.CLOSEFN
[LAMBDA (GCOORDW) (* rrb " 7-May-85 09:41")
(* close function for a window that is keeping track of
the global coordinate system.
It breaks the link to itself.)
(DETACHWINDOW GCOORDW])
(SKETCHW.FROM.LOCATOR
[LAMBDA (GCOORDW) (* rrb " 7-May-85 09:40")
(* returns the active window if any that points to
GCOORDW)
(for W in (ACTIVEWINDOWS) when (MEMB GCOORDW (ATTACHEDWINDOWS W)) do (RETURN W])
(SKETCHW.UPDATE.LOCATORS
[LAMBDA (W) (* rrb " 7-May-85 10:06")
(* a cursor moved function for a sketch that shows the
coordinates cursor in global coordinates.)
(AND (INSIDEP (DSPCLIPPINGREGION NIL W)
(LASTMOUSEX W)
(LASTMOUSEY W))
(for LOCATOR in (ATTACHEDWINDOWS W) when (MEMB (FUNCTION LOCATOR.CLOSEFN)
(WINDOWPROP LOCATOR (QUOTE CLOSEFN)))
do (LOCATOR.UPDATE LOCATOR W])
(LOCATOR.UPDATE
[LAMBDA (LOCATORW SKW) (* rrb "22-May-85 11:09")
(* updates the position of the locator coordinates.)
(* there are three kinds of locators: real coordinate,
gridded real coordinates and latitude longitude,
although lat lon has been deimplemented.)
(SELECTQ (WINDOWPROP LOCATORW (QUOTE LOCATORTYPE))
(GLOBALCOORD (UPDATE.GLOBALCOORD.LOCATOR LOCATORW SKW))
(GLOBALGRIDDEDCOORD (UPDATE.GLOBAL.GRIDDED.COORD.LOCATOR LOCATORW SKW))
(LATLON (UPDATE.LATLON.LOCATOR LOCATORW SKW))
(SHOULDNT])
(UPDATE.GLOBAL.LOCATOR
[LAMBDA (SKETCHW) (* rrb "19-APR-83 14:19")
(* checks to see if the latitude longitude display
needs to be updated.)
(COND
([OR (AND (NEQ SKETCHW.LASTCURSORPTX (SETQ SKETCHW.LASTCURSORPTX (LASTMOUSEX SKETCHW)))
(SETQ SKETCHW.LASTCURSORPTY (LASTMOUSEY SKETCHW)))
(NEQ SKETCHW.LASTCURSORPTY (SETQ SKETCHW.LASTCURSORPTY (LASTMOUSEY SKETCHW]
(* call it if either point has changed.)
(SKETCHW.UPDATE.LOCATORS SKETCHW])
(UPDATE.GLOBALCOORD.LOCATOR
[LAMBDA (GCOORDW W) (* rrb " 6-NOV-83 11:46")
(* a cursor moved function for a map that shows the
coordinates cursor in global coordinates.)
(PROG (SCALE)
(OR GCOORDW (RETURN))
(OR (SETQ SCALE (WINDOW.SCALE W))
(RETURN))
(SHOW.GLOBAL.COORDS (UNSCALE (LASTMOUSEX W)
SCALE)
(UNSCALE (LASTMOUSEY W)
SCALE)
GCOORDW])
(ADD.GLOBAL.DISPLAY
[LAMBDA (SKW TYPE) (* rrb "28-Aug-85 11:10")
(* creates a locator which gives the coordinates of the
cursor in SKW in global coordinates.)
(PROG [(LOCATOR (CREATE.GLOBAL.DISPLAYER (FONTCREATE BOLDFONT)
(COND
((EQ TYPE (QUOTE GRID))
"cursor grid location")
(T "cursor location in sketch"]
(ATTACHWINDOW LOCATOR SKW (QUOTE BOTTOM)
(QUOTE RIGHT)
(QUOTE LOCALCLOSE))
[WINDOWPROP LOCATOR (QUOTE LOCATORTYPE)
(COND
((EQ TYPE (QUOTE GRID))
(QUOTE GLOBALGRIDDEDCOORD))
(T (QUOTE GLOBALCOORD]
(WINDOWPROP SKW (QUOTE CURSORMOVEDFN)
(FUNCTION SKETCHW.UPDATE.LOCATORS))
(RETURN LOCATOR])
(ADD.GLOBAL.GRIDDED.DISPLAY
[LAMBDA (SKW) (* adds a locator that shows the nearest grid
location.)
(ADD.GLOBAL.DISPLAY SKW (QUOTE GRID])
(CREATE.GLOBAL.DISPLAYER
[LAMBDA (FONT TITLE) (* rrb " 7-May-85 09:59")
(* creates a window for displaying latitude longitude.)
(PROG ((GCOORDW (CREATEW (CREATEREGION 0 0 (WIDTHIFWINDOW (STRINGWIDTH "11111111.1111 " FONT))
(HEIGHTIFWINDOW (ITIMES 2 (FONTPROP FONT (QUOTE HEIGHT)))
T))
(OR TITLE "Real Coordinates")
NIL T))) (* extra space on stringwidth is to allow for the fact
that printout translates into PRIN1 rather than PRIN3.)
(DSPFONT FONT GCOORDW)
(DSPRESET GCOORDW) (* reset its coordinates to the upper left)
(WINDOWPROP GCOORDW (QUOTE CLOSEFN)
(FUNCTION LOCATOR.CLOSEFN))
(RETURN GCOORDW])
(UPDATE.GLOBAL.GRIDDED.COORD.LOCATOR
[LAMBDA (GCOORDW W) (* rrb "22-May-85 11:32")
(* a cursor moved function for a map that shows the
coordinates cursor in global coordinates.)
(PROG (SCALE)
(OR GCOORDW (RETURN))
(OR (SETQ SCALE (WINDOW.SCALE W))
(RETURN))
(COND
[(WINDOWPROP W (QUOTE USEGRID))
(PROG ((GRID (SK.GRIDFACTOR W))
XGRID YGRID)
(SETQ YGRID (MAP.WINDOW.ONTO.GLOBAL.GRID (LASTMOUSEY W)
SCALE GRID))
(COND
([OR [NOT (EQP (SETQ XGRID (MAP.WINDOW.ONTO.GLOBAL.GRID (LASTMOUSEX W)
SCALE GRID))
(WINDOWPROP GCOORDW (QUOTE XCOORD]
(NOT (EQP YGRID (WINDOWPROP GCOORDW (QUOTE YCOORD]
(* only update if one of the values has changed. This is done here but not in the ungridded case because it is
handled by the cursor moved fn.)
(WINDOWPROP GCOORDW (QUOTE XCOORD)
XGRID)
(WINDOWPROP GCOORDW (QUOTE YCOORD)
YGRID)
(SHOW.GLOBAL.COORDS XGRID YGRID GCOORDW]
(T (SHOW.GLOBAL.COORDS (UNSCALE (LASTMOUSEX W)
SCALE)
(UNSCALE (LASTMOUSEY W)
SCALE)
GCOORDW])
)
(RPAQQ SKETCHW.LASTCURSORPTX 0)
(RPAQQ SKETCHW.LASTCURSORY 0)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS SKETCHW.LASTCURSORPTX SKETCHW.LASTCURSORPTY)
)
(* fns for reading in various values)
(DEFINEQ
(READBRUSHSHAPE
[LAMBDA NIL (* rrb "14-May-84 16:55")
(* reads a brush shape from the user.)
(MENU (create MENU
CENTERFLG ← T
TITLE ← "pick a shape"
ITEMS ←(QUOTE (ROUND SQUARE VERTICAL HORIZONTAL DIAGONAL])
)
(DEFINEQ
(SK.CHANGE.DASHING
[LAMBDA (ELTWITHLINE DASHING SKW) (* rrb "20-Aug-85 15:30")
(* changes the line dashing of ELTWITHLINE if it has
one)
(* knows about the various types of sketch elements and
shouldn't.)
(PROG (SIZE GLINELT TYPE NEWDASHING NOWDASHING NEWELT)
(COND
((MEMB (SETQ TYPE (fetch (GLOBALPART GTYPE) of ELTWITHLINE))
(QUOTE (WIRE BOX CLOSEDWIRE CLOSEDCURVE OPENCURVE CIRCLE ELLIPSE TEXTBOX ARC)))
(* only works for things of wire type.)
(SETQ GLINELT (fetch (GLOBALPART INDIVIDUALGLOBALPART) of ELTWITHLINE))
(* the dashing may be stored in different places for
the element types.)
[SETQ NEWDASHING (COND
((EQ DASHING (QUOTE NONE)) (* no dashing is marked with NIL)
NIL)
((DASHINGP DASHING))
(T (ERROR "illegal dashing" DASHING]
(SETQ NOWDASHING (SELECTQ TYPE
(WIRE (fetch (WIRE OPENWIREDASHING) of GLINELT))
(BOX (fetch (BOX BOXDASHING) of GLINELT))
(ARC (fetch (ARC ARCDASHING) of GLINELT))
(TEXTBOX (fetch (TEXTBOX TEXTBOXDASHING) of GLINELT))
(CLOSEDWIRE (fetch (CLOSEDWIRE CLOSEDWIREDASHING)
of GLINELT))
(CLOSEDCURVE (fetch (CLOSEDCURVE DASHING) of GLINELT))
(OPENCURVE (fetch (OPENCURVE DASHING) of GLINELT))
(CIRCLE (fetch (CIRCLE DASHING) of GLINELT))
(ELLIPSE (fetch (ELLIPSE DASHING) of GLINELT))
(SHOULDNT)))
(COND
((EQUAL NEWDASHING NOWDASHING) (* if dashing isn't changing, don't bother creating a
new one and repainting.)
(RETURN)))
(SETQ NEWELT (SELECTQ TYPE
(WIRE (create WIRE using GLINELT OPENWIREDASHING ← NEWDASHING))
(BOX (create BOX using GLINELT BOXDASHING ← NEWDASHING))
(ARC (create ARC using GLINELT ARCDASHING ← NEWDASHING))
(TEXTBOX (create TEXTBOX using GLINELT TEXTBOXDASHING ←
NEWDASHING))
(CLOSEDWIRE (create CLOSEDWIRE using GLINELT CLOSEDWIREDASHING ←
NEWDASHING))
(CLOSEDCURVE (create CLOSEDCURVE using GLINELT DASHING ←
NEWDASHING))
(OPENCURVE (create OPENCURVE using GLINELT DASHING ← NEWDASHING))
(CIRCLE (create CIRCLE using GLINELT DASHING ← NEWDASHING))
(ELLIPSE (create ELLIPSE using GLINELT DASHING ← NEWDASHING))
(SHOULDNT)))
(RETURN (create GLOBALPART
COMMONGLOBALPART ←(fetch (GLOBALPART COMMONGLOBALPART) of ELTWITHLINE)
INDIVIDUALGLOBALPART ← NEWELT])
(READ.AND.SAVE.NEW.DASHING
[LAMBDA NIL (* rrb "22-May-85 16:44")
(* reads a new dashing, confirms it with the user and
adds it to SK.DASHING.PATTERNS)
(PROG (DASHING BM)
LP (COND
((NULL (SETQ DASHING (READ.NEW.DASHING))) (* user aborted)
(RETURN NIL)))
(SETQ BM (SK.DASHING.LABEL DASHING))
CONFIRM
(SELECTQ (MENU (create MENU
ITEMS ←(LIST (LIST BM T "Will use this as the dashing pattern.")
(QUOTE (Yes T "Will accept this pattern."))
(QUOTE (No (QUOTE NO)
"Will ask you for another dashing pattern."))
)
CENTERFLG ← T
TITLE ← "Is this pattern OK?"))
(NO (GO LP))
(T (* add dashing to global list and return it.)
(SK.CACHE.DASHING DASHING BM)
(RETURN DASHING))
(PROGN (PROMPTPRINT
"Please select 'Yes' if this pattern is what you want; 'No' if it isn't.")
(GO CONFIRM])
(READ.NEW.DASHING
[LAMBDA NIL (* rrb "27-Aug-85 14:12")
(* reads a value of dashing from the user.)
(PROMPTPRINT
"You will be prompted for a series of numbers which specify the number of points ON and OFF.
Enter 0 to end the dashing pattern.
Enter 'Abort' to leave the dashing unchanged.")
(bind VAL DASHLST OFF? (ORIGPOS ←(create POSITION
XCOORD ← LASTMOUSEX
YCOORD ← LASTMOUSEY))
until (OR (EQ (SETQ VAL (RNUMBER (CONCAT "Enter the number of points " (COND
(OFF? (QUOTE OFF))
(T (QUOTE ON)))
". Enter 0 to end the dashing.")
ORIGPOS NIL NIL T))
0)
(NULL VAL))
do (SETQ DASHLST (CONS VAL DASHLST))
(SETQ OFF? (NOT OFF?))
finally (CLRPROMPT)
(RETURN (COND
((NULL VAL) (* abort selection)
NIL)
(T (REVERSE DASHLST])
(READ.DASHING.CHANGE
[LAMBDA NIL
(DECLARE (GLOBALVARS SK.DASHING.PATTERNS)) (* rrb "20-Aug-85 14:46")
(* gets a description of how to change the arrow heads
of a wire or curve.)
(PROG (DASHING)
(SELECTQ [SETQ DASHING (MENU (create MENU
CENTERFLG ← T
TITLE ← "New dashing pattern?"
ITEMS ←(APPEND (for DASHPAT in SK.DASHING.PATTERNS
collect (LIST (CAR DASHPAT)
(KWOTE (CADR DASHPAT))
"changes dashing to this pattern"))
(QUOTE (("other" (QUOTE OTHER)
"will prompt you for a new dashing pattern.")
("no dashing" (QUOTE NONE)
"removes dashing."]
(OTHER (RETURN (READ.AND.SAVE.NEW.DASHING)))
(RETURN DASHING])
(DASHINGP
[LAMBDA (DASHING) (* rrb " 3-May-85 14:51")
(* return DASHING if it is a legal DASHING)
(AND (LISTP DASHING)
(for X in DASHING always (NUMBERP X))
DASHING])
(SK.CACHE.DASHING
[LAMBDA (DASHING BITMAP) (* rrb " 3-May-85 14:33")
(* adds a dashing and its bitmap label to the global
cache.)
(OR (for DASH in SK.DASHING.PATTERNS when (EQUAL (CADR DASH)
DASHING)
do (RETURN T))
(COND
(SK.DASHING.PATTERNS (NCONC1 SK.DASHING.PATTERNS (LIST (COND
((BITMAPP BITMAP))
(T (SK.DASHING.LABEL DASHING)))
DASHING)))
(T (SETQ SK.DASHING.PATTERNS (LIST (LIST (COND
((BITMAPP BITMAP))
(T (SK.DASHING.LABEL DASHING)))
DASHING])
(SK.DASHING.LABEL
[LAMBDA (DASHING) (* rrb " 3-May-85 14:32")
(* creates a bitmap label which shows a dashing
pattern.)
(PROG (DS BM)
[SETQ DS (DSPCREATE (SETQ BM (BITMAPCREATE 50 1]
(DRAWLINE 0 0 50 0 1 NIL DS NIL DASHING)
(RETURN BM])
)
(DEFINEQ
(READ.FILLING.CHANGE
[LAMBDA NIL (* rrb " 8-Jun-85 12:17")
(* reads a shade for the filling texture.)
(PROG (FILLING)
(SELECTQ (SETQ FILLING (MENU (create MENU
CENTERFLG ← T
TITLE ← "New filling?"
ITEMS ←[APPEND (for FILLPAT in SK.FILLING.PATTERNS
collect (LIST (CAR FILLPAT)
(KWOTE (CADR FILLPAT))
"changes filling to this pattern"))
(QUOTE (("4x4 shade" (QUOTE 4X4)
"Allows creation of a 4 bits by 4 bits shade")
("16x16 shade" (QUOTE 16X16)
"Allows creation of a 16 bits by 16 bits shade")
("No filling" (QUOTE NONE)
"no filling will be used."]
MENUBORDERSIZE ← 1)))
(4X4 (RETURN (READ.AND.SAVE.NEW.FILLING)))
(16X16 (RETURN (READ.AND.SAVE.NEW.FILLING T)))
(RETURN FILLING])
(SK.CACHE.FILLING
[LAMBDA (FILLING) (* rrb " 8-Jun-85 14:58")
(* adds a dashing and its bitmap label to the global
cache.)
(OR (for FILL in SK.FILLING.PATTERNS when (EQUAL (CADR FILL)
FILLING)
do (RETURN T))
(COND
(SK.FILLING.PATTERNS (NCONC1 SK.FILLING.PATTERNS (LIST (SK.FILLING.LABEL FILLING)
FILLING)))
(T (SETQ SK.FILLING.PATTERNS (LIST (LIST (SK.FILLING.LABEL FILLING)
FILLING)))
(QUOTE ADDED])
(READ.AND.SAVE.NEW.FILLING
[LAMBDA (16X16FLG) (* rrb " 8-Jun-85 14:58")
(* reads a new filling, confirms it with the user and
adds it to SK.FILLING.PATTERNS)
(PROG (FILLING)
(COND
([NULL (SETQ FILLING (EDITSHADE (COND
(16X16FLG (BITMAPCREATE 16 16]
(* user aborted)
(RETURN NIL)))
(SK.CACHE.FILLING FILLING)
(RETURN FILLING])
(SK.FILLING.LABEL
[LAMBDA (FILLING) (* rrb " 8-Jun-85 12:08")
(* creates a bitmap label which fills it with the
texture FILLING.)
(PROG [(BM (BITMAPCREATE (PLUS 8 (STRINGWIDTH "16x16 shade" MENUFONT))
(FONTPROP MENUFONT (QUOTE HEIGHT]
(BLTSHADE FILLING BM)
(RETURN BM])
)
(RPAQ? SK.DASHING.PATTERNS )
(RPAQ? SK.FILLING.PATTERNS )
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS SK.DASHING.PATTERNS SK.FILLING.PATTERNS)
)
(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)
(* fns for reading colors)
(DEFINEQ
(DISPLAYREADCOLORHLSLEVELS
[LAMBDA (HLS WIN) (* rrb "17-Jul-85 15:10")
(* displays a hue lightness saturation triple in the
color reading window.)
(PROG (LEVEL)
(DISPLAYREADCOLORLEVEL (SETQ LEVEL (HLSLEVEL HLS (QUOTE HUE)))
(LEVELFROMHLSVALUE (QUOTE HUE)
LEVEL)
HUEREGION WIN)
(DISPLAYREADCOLORLEVEL (SETQ LEVEL (HLSLEVEL HLS (QUOTE LIGHTNESS)))
(LEVELFROMHLSVALUE (QUOTE LIGHTNESS)
LEVEL)
LIGHTNESSREGION WIN)
(DISPLAYREADCOLORLEVEL (SETQ LEVEL (HLSLEVEL HLS (QUOTE SATURATION)))
(LEVELFROMHLSVALUE (QUOTE SATURATION)
LEVEL)
SATURATIONREGION WIN])
(DISPLAYREADCOLORLEVEL
[LAMBDA (PRINTLEVEL BARLEVEL REGION WINDOW) (* rrb "17-Jul-85 15:38")
(* displays the value of a primary color in a color bar
region.)
(COND
((FIXP PRINTLEVEL)
(MOVETO (DIFFERENCE (fetch LEFT of REGION)
4)
VALBTM WINDOW)
(PRIN1 PRINTLEVEL WINDOW) (* overstrike extra digits in case the old value was
larger.)
(PRIN1 " " WINDOW))
(T (* floating point values)
(MOVETO (DIFFERENCE (fetch LEFT of REGION)
10)
VALBTM WINDOW)
(printout WINDOW .F5.3 PRINTLEVEL)))
(FILLINREGION REGION BARLEVEL GRAYSHADE WINDOW])
(DRAWREADCOLORBOX
[LAMBDA (TITLELEFT TITLE WINDOW) (* rrb "17-Jul-85 14:20")
(* draws the box and title for a display bar for an rgb or hls quantity. Returns a dotted pair of the region the box
occuppied and the left most position printed in.)
(PROG (XPOS REGION)
(MOVETO TITLELEFT 4 WINDOW)
(SETQ XPOS (DSPXPOSITION NIL WINDOW))
(PRIN1 TITLE WINDOW)
(OUTLINEREGION (SETQ REGION (create REGION
LEFT ←(CENTEREDLEFT 10 XPOS (SETQ XPOS
(DSPXPOSITION NIL WINDOW)))
BOTTOM ←(PLUS 4 (FONTPROP WIN (QUOTE HEIGHT)))
WIDTH ← 10
HEIGHT ← 256))
2 NIL WINDOW)
(RETURN (CONS REGION XPOS])
(READ.CHANGE.COLOR
[LAMBDA (MSG) (* reads a color from the user and returns it)
BLACKCOLOR])
(READCOLOR1
[LAMBDA (MSG ALLOWNONEFLG) (* rrb "18-Jul-85 11:07")
(* lets the user select a color.)
(PROG ((WIN (CREATEW (MAKEWITHINREGION (CREATEREGION LASTMOUSEX LASTMOUSEY COLORMENUWIDTH
COLORMENUHEIGHT)
WHOLEDISPLAY)
(OR MSG "Enter a color: Left in rectangle sets level.")))
VAL REDREGION GREENREGION BLUEREGION HUEREGION LIGHTNESSREGION SATURATIONREGION)
[SETQ REDREGION (CAR (SETQ VAL (DRAWREADCOLORBOX 10 " RED " WIN]
[SETQ GREENREGION (CAR (SETQ VAL (DRAWREADCOLORBOX (IPLUS (CDR VAL)
5)
"GREEN" WIN]
[SETQ BLUEREGION (CAR (SETQ VAL (DRAWREADCOLORBOX (IPLUS (CDR VAL)
5)
" BLUE" WIN]
[SETQ HUEREGION (CAR (SETQ VAL (DRAWREADCOLORBOX (IPLUS (CDR VAL)
20)
" hue " WIN]
[SETQ LIGHTNESSREGION (CAR (SETQ VAL (DRAWREADCOLORBOX (CDR VAL)
" light " WIN]
[SETQ SATURATIONREGION (CAR (SETQ VAL (DRAWREADCOLORBOX (CDR VAL)
" sat " WIN]
(ADDMENU (create MENU
ITEMS ←[APPEND [COND
(ALLOWNONEFLG (QUOTE (("No color" (QUOTE NONE)
"specifies that no color should be used."]
(QUOTE ((OK (QUOTE OK)
"Returns the displayed color.")
(Abort (QUOTE ABORT)
"Aborts this operation."]
CENTERFLG ← T
MENUBORDERSIZE ← 1
WHENSELECTEDFN ←(FUNCTION READCOLORCOMMANDMENUSELECTEDFN))
WIN
(create POSITION
XCOORD ←(PLUS (CDR VAL)
10)
YCOORD ← 100))
(SETQ VAL (READCOLOR2 WIN))
(CLOSEW WIN)
(RETURN VAL])
(READCOLORCOMMANDMENUSELECTEDFN
[LAMBDA (ITEM MENU BUTTON) (* rrb "18-Jul-85 11:01")
(* when selected function for the menu that sits in the read color window. Puts the value OK or ABORT on the window
if selected.)
(WINDOWPROP (WFROMMENU MENU)
(QUOTE MENUCOMMAND)
(CADADR ITEM])
(READCOLOR2
[LAMBDA (WIN) (* rrb "31-Jul-85 09:53")
(* internal function to READCOLOR which polls mouse and
updates fields.)
(PROG ((VALBTM (IPLUS (fetch (REGION BOTTOM) of REDREGION)
264))
LEVEL LASTX LASTY HLS (REDLEVEL 0)
(BLUELEVEL 0)
(GREENLEVEL 0))
(PROGN (DISPLAYREADCOLORLEVEL REDLEVEL REDLEVEL REDREGION WIN)
(DISPLAYREADCOLORLEVEL GREENLEVEL GREENLEVEL GREENREGION WIN)
(DISPLAYREADCOLORLEVEL BLUELEVEL BLUELEVEL BLUEREGION WIN))
(DISPLAYREADCOLORHLSLEVELS (SETQ HLS (RGBTOHLS REDLEVEL GREENLEVEL BLUELEVEL))
WIN)
WAITLP (* check if menu command was pressed.)
(SELECTQ (WINDOWPROP WIN (QUOTE MENUCOMMAND))
(OK (RETURN (create RGB
RED ← REDLEVEL
GREEN ← GREENLEVEL
BLUE ← BLUELEVEL)))
(NONE (RETURN (QUOTE NONE)))
(ABORT (RETURN NIL))
NIL)
[COND
((MOUSESTATE LEFT)
(COND
[[SETQ COLOR (COND
((INSIDEP REDREGION (SETQ LASTX (LASTMOUSEX WIN))
(SETQ LASTY (LASTMOUSEY WIN)))
(QUOTE RED))
((INSIDEP GREENREGION LASTX LASTY)
(QUOTE GREEN))
((INSIDEP BLUEREGION LASTX LASTY)
(QUOTE BLUE]
(until (MOUSESTATE (NOT LEFT))
do (* as long as left is down, adjust the color.)
(COND
((NEQ [SETQ LEVEL (IMIN 255 (IMAX 0 (IDIFFERENCE (LASTMOUSEY WIN)
(fetch (REGION BOTTOM)
of REDREGION]
(SELECTQ COLOR
(RED REDLEVEL)
(GREEN GREENLEVEL)
BLUELEVEL)) (* see if color level has changed.)
(SELECTQ COLOR
(RED (DISPLAYREADCOLORLEVEL (SETQ REDLEVEL LEVEL)
REDLEVEL REDREGION WIN))
(GREEN (DISPLAYREADCOLORLEVEL (SETQ GREENLEVEL LEVEL)
GREENLEVEL GREENREGION WIN))
(DISPLAYREADCOLORLEVEL (SETQ BLUELEVEL LEVEL)
BLUELEVEL BLUEREGION WIN))
(DISPLAYREADCOLORHLSLEVELS (SETQ HLS (RGBTOHLS REDLEVEL GREENLEVEL
BLUELEVEL))
WIN]
([SETQ COLOR (COND
((INSIDEP HUEREGION (SETQ LASTX (LASTMOUSEX WIN))
(SETQ LASTY (LASTMOUSEY WIN)))
(QUOTE HUE))
((INSIDEP LIGHTNESSREGION LASTX LASTY)
(QUOTE LIGHTNESS))
((INSIDEP SATURATIONREGION LASTX LASTY)
(QUOTE SATURATION]
(until (MOUSESTATE (NOT LEFT))
do (* as long as red is down, adjust the color.)
(COND
((NOT (EQUAL [SETQ LEVEL (HLSVALUEFROMLEVEL
COLOR
(IMIN 255 (IMAX 0 (IDIFFERENCE (LASTMOUSEY WIN)
(fetch (REGION BOTTOM)
of REDREGION]
(HLSLEVEL HLS COLOR)))
(* see if color level has changed.)
(HLSLEVEL HLS COLOR LEVEL)
(SELECTQ COLOR
(HUE (DISPLAYREADCOLORLEVEL LEVEL (LEVELFROMHLSVALUE
(QUOTE HUE)
LEVEL)
HUEREGION WIN))
(LIGHTNESS (DISPLAYREADCOLORLEVEL LEVEL (LEVELFROMHLSVALUE
(QUOTE LIGHTNESS)
LEVEL)
LIGHTNESSREGION WIN))
(DISPLAYREADCOLORLEVEL LEVEL (LEVELFROMHLSVALUE (QUOTE
SATURATION)
LEVEL)
SATURATIONREGION WIN))
(* set the color levels of the current color and update
that display also.)
(SETQ LEVEL (HLSTORGB HLS))
(PROGN (DISPLAYREADCOLORLEVEL (SETQ REDLEVEL (CAR LEVEL))
REDLEVEL REDREGION WIN)
(DISPLAYREADCOLORLEVEL (SETQ GREENLEVEL (CADR LEVEL))
GREENLEVEL GREENREGION WIN)
(DISPLAYREADCOLORLEVEL (SETQ BLUELEVEL (CADDR LEVEL))
BLUELEVEL BLUEREGION WIN]
(BLOCK)
(GO WAITLP])
)
(DEFINEQ
(CREATE.CNS.MENU
[LAMBDA NIL (* rrb "17-Jul-85 21:14")
(* creates the CNS menu.)
(* Not fully implemented. Use STYLESHEET.WHENSELECTEDFN
to set items from level bars.)
(SETQ CNS.STYLE
(CREATE.STYLE (QUOTE ITEM.TITLES)
(QUOTE (Saturation Lightness Tint Hue))
(QUOTE ITEM.TITLE.FONT)
(QUOTE (TIMESROMAN 14 BOLD))
(QUOTE ITEMS)
[LIST (CREATE MENU
ITEMS ←(QUOTE (Grayish Moderate Strong Vivid)))
(CREATE MENU
ITEMS ←(QUOTE (Black ("Very Dark" (QUOTE VeryDark))
Dark Medium Light ("Very Light" (QUOTE
VeryLight))
White)))
(CREATE MENU
ITEMS ←(QUOTE (Orange Orangish Red Reddish Yellow Yellowish Green
Greenish Blue Bluish Purple Purplish Brown
Brownish)))
(CREATE MENU
ITEMS ←(QUOTE (Red Orange Yellow Green Blue Purple Brown]
(QUOTE SELECTION)
(QUOTE ("" "" "" ""))
(QUOTE NEED.NOT.FILL.IN)
T))
(STYLESHEET CNS.STYLE])
)
(RPAQQ COLORMENUHEIGHT 320)
(RPAQQ COLORMENUWIDTH 360)
(DECLARE: DOEVAL@COMPILE EVAL@LOAD DONTCOPY
(FILESLOAD (LOADCOMP)
LLCOLOR)
)
(DEFINEQ
(SCALE.POSITION.INTO.SKETCHW
[LAMBDA (POS SKETCHW) (* rrb "29-Jan-85 14:50")
(* scales a position into a sketch window using its
scale factor.)
(SK.SCALE.POSITION.INTO.VIEWER POS (WINDOW.SCALE SKETCHW])
(UNSCALE
[LAMBDA (COORD SCALE) (* unscales a coordinate)
(TIMES COORD SCALE])
(UNSCALE.REGION
[LAMBDA (REGION SCALE) (* rrb "15-AUG-83 17:31")
(* scales a region from a window region to the larger
coordinate space.)
(CREATEREGION (TIMES SCALE (fetch (REGION LEFT) of REGION))
(TIMES SCALE (fetch (REGION BOTTOM) of REGION))
(TIMES SCALE (fetch (REGION WIDTH) of REGION))
(TIMES SCALE (fetch (REGION HEIGHT) of REGION])
)
(* stuff for reading input positions)
(DEFINEQ
(SK.GETGLOBALPOSITION
[LAMBDA (W CURSOR NEWPOINTFLG) (* rrb "31-Jul-85 10:25")
(* gets a position from the user and returns the global
value of it.)
(SK.MAP.INPUT.PT.TO.GLOBAL (GETSKWPOSITION W CURSOR NEWPOINTFLG)
W])
(GETSKWPOSITION
[LAMBDA (W CURSOR NEWPOINTFLG) (* rrb "31-Jul-85 11:26")
(* provides a hook for the inputting of a point via mouse from the user. Left button {or middle for now} will return
a point that is on the grid or not according to the grid setting. Right will return the other.
Returns a instance of record INPUTPT)
(RESETFORM (CURSOR (OR CURSOR CROSSHAIRS))
(PROG ((USEGRID (WINDOWPROP W (QUOTE USEGRID)))
(GRID (SK.GRIDFACTOR W))
(SCALE (WINDOW.SCALE W))
(HOTSPOTCACHE (SK.HOTSPOT.CACHE W))
XSCREEN YSCREEN XGRID YGRID NEWX NEWY MOUSEDOWN ONGRID? NEARPOS)
(RETURN (until (COND
(MOUSEDOWN (MOUSESTATE UP))
((MOUSESTATE (OR LEFT MIDDLE RIGHT))
(COND
((NOT (INSIDEP W (LASTMOUSEX W)
(LASTMOUSEY W)))
(RETURN)))
(SETQ MOUSEDOWN T)
NIL))
do (SETQ NEWX (LASTMOUSEX W))
(SETQ NEWY (LASTMOUSEY W))
[COND
((OR (NEQ NEWX XSCREEN)
(NEQ NEWY YSCREEN))
(* cursor changed position check if grid pt moved.)
(SKETCHW.UPDATE.LOCATORS W)
(SETQ XSCREEN NEWX)
(SETQ YSCREEN NEWY)
[COND
((AND (NOT NEWPOINTFLG)
HOTSPOTCACHE
(LASTMOUSESTATE MIDDLE)
(SETQ NEARPOS (NEAREST.HOT.SPOT HOTSPOTCACHE NEWX NEWY)
)) (* on middle, pick the closest point)
(SETQ NEWX (fetch (POSITION XCOORD) of NEARPOS))
(SETQ NEWY (fetch (POSITION YCOORD) of NEARPOS))
(SETQ ONGRID? NIL))
((SETQ ONGRID? (COND
((LASTMOUSESTATE RIGHT)
(* if right is down, flip sense of using grid)
(NOT USEGRID))
(T (* otherwise use the grid if told to.)
USEGRID)))
(SETQ NEWX (MAP.WINDOW.ONTO.GRID NEWX SCALE GRID))
(SETQ NEWY (MAP.WINDOW.ONTO.GRID NEWY SCALE GRID]
(COND
((OR (NEQ XGRID NEWX)
(NEQ YGRID NEWY))
(* grid point has changed too.
Redraw point.)
(AND XGRID (SHOWSKETCHXY XGRID YGRID W))
(SHOWSKETCHXY (SETQ XGRID NEWX)
(SETQ YGRID NEWY)
W]
finally (RETURN (COND
(XGRID (SHOWSKETCHXY XGRID YGRID W)
(* if the cursor was outside the window when let up,
return NIL)
(AND (INSIDEP W (LASTMOUSEX W)
(LASTMOUSEY W))
(create INPUTPT
INPUT.ONGRID? ← ONGRID?
INPUT.POSITION ←(create
POSITION
XCOORD
← XGRID
YCOORD
← YGRID]
)
(NEAREST.HOT.SPOT
[LAMBDA (CACHE X Y) (* rrb "31-Jul-85 10:14")
(* returns the nearest hot spot to X Y)
(PROG ((BESTMEASURE 10000)
BESTX BESTY YDIF THISDIF)
[for YBUCKET in CACHE
do (SETQ YDIF (ABS (DIFFERENCE (CAR YBUCKET)
Y)))
(for XBUCKET in (CDR YBUCKET) do (COND
((CDR XBUCKET)
(* this bucket has entries)
(* use Manhattan distance for efficiency.)
[SETQ THISDIF (PLUS YDIF
(ABS (DIFFERENCE
(CAR XBUCKET)
X]
(COND
((ILESSP THISDIF BESTMEASURE)
(SETQ BESTMEASURE THISDIF)
(SETQ BESTX (CAR XBUCKET))
(SETQ BESTY (CAR YBUCKET]
(RETURN (AND BESTX (create POSITION
XCOORD ← BESTX
YCOORD ← BESTY])
(GETWREGION
[LAMBDA (W NEWREGIONFN NEWREGIONFNDATA MINWIDTH MINHEIGHT)
(* rrb " 7-May-85 09:26")
(* gets a region from a window)
(PROG ((REG (GETREGION MINWIDTH MINHEIGHT NIL NEWREGIONFN NEWREGIONFNDATA)))
(RETURN (CREATEREGION (IDIFFERENCE (fetch LEFT of REG)
(DSPXOFFSET NIL W))
(IDIFFERENCE (fetch BOTTOM of REG)
(DSPYOFFSET NIL W))
(fetch WIDTH of REG)
(fetch HEIGHT of REG])
(GET.BITMAP.POSITION
[LAMBDA (WINDOW BITMAP OPERATION MSG XOFFSET YOFFSET) (* rrb "11-Jul-85 11:00")
(* gets a position by tracking with a bitmap The spec returns is actually (ONGRID? position) so that caller can tell
whether it was placed on grid or not.)
(PROG (BUFFER.BITMAP WIDTH HEIGHT)
(SETQ WIDTH (BITMAPWIDTH BITMAP))
(SETQ HEIGHT (BITMAPHEIGHT BITMAP))
(SETQ BUFFER.BITMAP (BITMAPCREATE WIDTH HEIGHT))
(STATUSPRINT WINDOW "
" MSG)
(RETURN (SK.TRACK.BITMAP1 WINDOW BITMAP BUFFER.BITMAP WIDTH HEIGHT (OR OPERATION
(QUOTE PAINT))
XOFFSET YOFFSET])
(SK.TRACK.BITMAP1
[LAMBDA (W BITMAP BUFFER.BITMAP WIDTH HEIGHT OPERATION XOFFSET YOFFSET)
(* rrb "27-Sep-85 19:12")
(* tracks BITMAP until a button goes down and comes up. Returns a list of (ongrid? position) so that caller can know
whether the point chosen was on a grid or not.)
(* there is other code in BIGFONT that is probably
better for this.)
(PROG (DOWN LEFT BOTTOM NEW.LEFT NEW.BOTTOM GRID.LEFT GRID.BOTTOM ONGRID? NEARPOS
(DSP (WINDOWPROP W (QUOTE DSP)))
(USEGRID (WINDOWPROP W (QUOTE USEGRID)))
(GRID (SK.GRIDFACTOR W))
(SCALE (WINDOW.SCALE W))
(HOTSPOTCACHE (SK.HOTSPOT.CACHE W)))
(OR XOFFSET (SETQ XOFFSET 0))
(OR YOFFSET (SETQ YOFFSET 0))
(TOTOPW W)
(RETURN (until (AND DOWN (LASTMOUSESTATE UP))
do (GETMOUSESTATE)
(COND
((LASTMOUSESTATE (NOT UP))
(SETQ DOWN T)))
(SETQ NEW.LEFT (LASTMOUSEX DSP))
(SETQ NEW.BOTTOM (LASTMOUSEY DSP))
[COND
((OR (NEQ NEW.LEFT LEFT)
(NEQ NEW.BOTTOM BOTTOM)) (* cursor changed position check if grid pt moved.)
(SKETCHW.UPDATE.LOCATORS W)
(SETQ LEFT NEW.LEFT)
(SETQ BOTTOM NEW.BOTTOM)
[COND
((AND HOTSPOTCACHE (LASTMOUSESTATE MIDDLE)
(SETQ NEARPOS (NEAREST.HOT.SPOT HOTSPOTCACHE NEW.LEFT NEW.BOTTOM))
) (* on middle, pick the closest point)
(SETQ ONGRID? NIL)
(SETQ NEW.LEFT (fetch (POSITION XCOORD) of NEARPOS))
(SETQ NEW.BOTTOM (fetch (POSITION YCOORD) of NEARPOS)))
((SETQ ONGRID? (COND
((LASTMOUSESTATE RIGHT)
(* if right is down, flip sense of using grid)
(NOT USEGRID))
(T (* otherwise use the grid if told to.)
USEGRID)))
(SETQ NEW.LEFT (MAP.WINDOW.ONTO.GRID NEW.LEFT SCALE GRID))
(SETQ NEW.BOTTOM (MAP.WINDOW.ONTO.GRID NEW.BOTTOM SCALE GRID]
(COND
((OR (NEQ NEW.LEFT GRID.LEFT)
(NEQ NEW.BOTTOM GRID.BOTTOM))
(* grid location changed, move the text image.)
[COND
(GRID.LEFT (BITBLT BUFFER.BITMAP 0 0 W (IPLUS GRID.LEFT XOFFSET)
(IPLUS GRID.BOTTOM YOFFSET)
WIDTH HEIGHT (QUOTE INPUT)
(QUOTE REPLACE]
(SETQ GRID.LEFT NEW.LEFT)
(SETQ GRID.BOTTOM NEW.BOTTOM)
(BITBLT W (IPLUS GRID.LEFT XOFFSET)
(IPLUS GRID.BOTTOM YOFFSET)
BUFFER.BITMAP 0 0 NIL NIL (QUOTE INPUT)
(QUOTE REPLACE))
(BITBLT BITMAP 0 0 DSP (IPLUS GRID.LEFT XOFFSET)
(IPLUS GRID.BOTTOM YOFFSET)
WIDTH HEIGHT (QUOTE INPUT)
OPERATION]
finally (* restore screen)
(BITBLT BUFFER.BITMAP 0 0 W (IPLUS GRID.LEFT XOFFSET)
(IPLUS GRID.BOTTOM YOFFSET)
WIDTH HEIGHT (QUOTE INPUT)
(QUOTE REPLACE)) (* return the position if any part of the bitmap is
visible.)
(RETURN (AND (INTERSECTREGIONS (DSPCLIPPINGREGION NIL DSP)
(CREATEREGION (IPLUS LEFT XOFFSET)
(IPLUS BOTTOM YOFFSET)
WIDTH HEIGHT))
(create INPUTPT
INPUT.ONGRID? ← ONGRID?
INPUT.POSITION ←(create POSITION
XCOORD ← GRID.LEFT
YCOORD ← GRID.BOTTOM])
)
[DECLARE: EVAL@COMPILE
(RECORD INPUTPT (INPUT.ONGRID? INPUT.POSITION)
[TYPE? (AND (LISTP DATUM)
(OR (NULL (CAR DATUM))
(EQ (CAR DATUM)
T))
(LISTP (CDR DATUM))
(POSITIONP (CADR DATUM))
(NULL (CDDR DATUM])
]
(RPAQ? ALL.SKETCHES )
(RPAQ? INITIAL.SCALE 1.0)
(RPAQ? SKETCH.ELEMENT.TYPES )
(RPAQ? SKETCH.ELEMENT.TYPE.NAMES )
(RPAQ? DEFAULT.VISIBLE.SCALE.FACTOR 10.0)
(RPAQ? MINIMUM.VISIBLE.SCALE.FACTOR 4.0)
(RPAQ? ALLOWSKETCHPUTFLG T)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(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)
)
(READVARS SK.SELECTEDMARK SK.LOCATEMARK COPYSELECTIONMARK MOVESELECTIONMARK DELETESELECTIONMARK
OTHERCONTROLPOINTMARK)
({(READBITMAP)(7 7
"ON@@"
"ON@@"
"ON@@"
"ON@@"
"ON@@"
"ON@@"
"ON@@")} {(READBITMAP)(11 11
"OON@"
"OON@"
"L@F@"
"L@F@"
"L@F@"
"L@F@"
"L@F@"
"L@F@"
"L@F@"
"OON@"
"OON@")} {(READBITMAP)(11 11
"@@@@"
"EED@"
"BJH@"
"EED@"
"BJH@"
"EED@"
"BJH@"
"EED@"
"BJH@"
"EED@"
"@@@@")} {(READBITMAP)(19 19
"OL@@@@@@"
"N@@@@@@@"
"O@@@@@@@"
"KH@@@@@@"
"I@@@@@@@"
"H@@@@@@@"
"@CH@@@@@"
"@CL@@@@@"
"@CN@@@@@"
"@AO@@@@@"
"@@OH@@@@"
"@@GH@@@@"
"@@CH@@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@@@@@@")} {(READBITMAP)(13 13
"L@AH"
"H@@H"
"@@@@"
"AHL@"
"AML@"
"@OH@"
"@G@@"
"@OH@"
"AML@"
"AHL@"
"@@@@"
"H@@H"
"L@AH")} {(READBITMAP)(11 11
"@@@@"
"@D@@"
"BJH@"
"AE@@"
"BJH@"
"EED@"
"BJH@"
"AE@@"
"BJH@"
"@D@@"
"@@@@")})
(* accessing functions for the methods of a sketch type.)
(DEFINEQ
(SK.DRAWFN
[LAMBDA (ELEMENTTYPE) (* rrb "17-MAR-83 22:28")
(* goes from an element type name to its DRAWFN)
(fetch (SKETCHTYPE DRAWFN) of (GETPROP ELEMENTTYPE (QUOTE SKETCHTYPE])
(SK.TRANSFORMFN
[LAMBDA (ELEMENTTYPE) (* rrb " 7-Feb-85 12:08")
(* goes from an element type name to its TRANSFORMFN)
(fetch (SKETCHTYPE TRANSFORMFN) of (GETPROP ELEMENTTYPE (QUOTE SKETCHTYPE])
(SK.EXPANDFN
[LAMBDA (ELEMENTTYPE) (* goes from an element type name to its EXPANDFN)
(fetch (SKETCHTYPE EXPANDFN) of (GETPROP ELEMENTTYPE (QUOTE SKETCHTYPE])
(SK.INPUT
[LAMBDA (ELEMENTTYPE SKETCHW) (* rrb "11-MAR-83 09:54")
(* applies an element types input function to a
window.)
(APPLY* (fetch (SKETCHTYPE INPUTFN) of ELEMENTTYPE)
SKETCHW])
(SK.INSIDEFN
[LAMBDA (ELEMENTTYPE) (* rrb "30-MAR-83 11:54")
(* goes from an element type name to its inside
predicate)
(fetch (SKETCHTYPE INSIDEFN) of (GETPROP ELEMENTTYPE (QUOTE SKETCHTYPE])
(SK.UPDATEFN
[LAMBDA (ELEMENTTYPE) (* rrb "21-Dec-84 11:28")
(* goes from an element type name to its updatefn The update function is called when an element in a window has
changed. It will get args of the old local screen element, the new global element and the window.
If it can update the display more efficiently than erasing and redrawing, it should and return the new local sketch
element.)
(fetch (SKETCHTYPE UPDATEFN) of (GETPROP ELEMENTTYPE (QUOTE SKETCHTYPE])
)
(/DECLAREDATATYPE (QUOTE SKETCHTYPE)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER))
(QUOTE ((SKETCHTYPE 0 POINTER)
(SKETCHTYPE 2 POINTER)
(SKETCHTYPE 4 POINTER)
(SKETCHTYPE 6 POINTER)
(SKETCHTYPE 8 POINTER)
(SKETCHTYPE 10 POINTER)
(SKETCHTYPE 12 POINTER)
(SKETCHTYPE 14 POINTER)
(SKETCHTYPE 16 POINTER)
(SKETCHTYPE 18 POINTER)
(SKETCHTYPE 20 POINTER)
(SKETCHTYPE 22 POINTER)
(SKETCHTYPE 24 POINTER)
(SKETCHTYPE 26 POINTER)))
(QUOTE 28))
(DECLARE: DONTCOPY
[DECLARE: EVAL@COMPILE
(RECORD SCREENELT (LOCALPART . GLOBALPART)
(RECORD GLOBALPART (COMMONGLOBALPART INDIVIDUALGLOBALPART)
(RECORD INDIVIDUALGLOBALPART (GTYPE . GOTHERINFO))
(RECORD COMMONGLOBALPART (MINSCALE MAXSCALE SKANNOTATION)))
(RECORD LOCALPART (HOTSPOTS . OTHERLOCALINFO)))
(RECORD GLOBALPART (COMMONGLOBALPART INDIVIDUALGLOBALPART)
(RECORD INDIVIDUALGLOBALPART (GTYPE . RESTOFGLOBALPART))
(RECORD COMMONGLOBALPART (MINSCALE MAXSCALE SKELEMENTPROPLIST)))
(RECORD COMMONGLOBALPART (MINSCALE MAXSCALE SKANNOTATION))
(RECORD INDIVIDUALGLOBALPART (GTYPE . RESTOFGLOBALPART))
(RECORD LOCALPART (HOTSPOTS . OTHERLOCALINFO))
(RECORD SKETCH (ALLSKETCHPROPS . SKETCHTCELL)
(RECORD ALLSKETCHPROPS (SKETCHKEY SKETCHNAME . SKETCHPROPS)
SKETCHKEY ←(QUOTE SKETCH))
[RECORD SKETCHTCELL (SKETCHELTS)
(CREATE (CONS SKETCHELTS (LAST SKETCHELTS]
[TYPE? (AND (LISTP DATUM)
(LISTP (CAR DATUM))
(EQ (CAAR DATUM)
(QUOTE SKETCH])
(DATATYPE SKETCHTYPE (LABEL (* the label if it is non-NIL will be used in the
sketch menu.)
DOCSTR (* if put in the menu, this is the help string for its
item.)
DRAWFN EXPANDFN obsolete CHANGEFN INPUTFN INSIDEFN REGIONFN TRANSLATEFN
UPDATEFN READCHANGEFN TRANSFORMFN
(* fn to transform the control points of an element.
takes args Gelt Tranfn trandata.)
TRANSLATEPTSFN (* fn to move some but not all points of a screen
element. Takes args: LocalSelectedPts
GlobalDeltaToTranslate ScreenElt SketchWindow)
))
(RECORD SKETCHCONTEXT (SKETCHBRUSH SKETCHFONT SKETCHTEXTALIGNMENT SKETCHARROWHEAD SKETCHDASHING
SKETCHUSEARROWHEAD SKETCHTEXTBOXALIGNMENT SKETCHFILLING
SKETCHLINEMODE SKETCHARCDIRECTION SKETCHMOVEMODE
SKETCHINPUTSCALE))
]
(/DECLAREDATATYPE (QUOTE SKETCHTYPE)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER))
(QUOTE ((SKETCHTYPE 0 POINTER)
(SKETCHTYPE 2 POINTER)
(SKETCHTYPE 4 POINTER)
(SKETCHTYPE 6 POINTER)
(SKETCHTYPE 8 POINTER)
(SKETCHTYPE 10 POINTER)
(SKETCHTYPE 12 POINTER)
(SKETCHTYPE 14 POINTER)
(SKETCHTYPE 16 POINTER)
(SKETCHTYPE 18 POINTER)
(SKETCHTYPE 20 POINTER)
(SKETCHTYPE 22 POINTER)
(SKETCHTYPE 24 POINTER)
(SKETCHTYPE 26 POINTER)))
(QUOTE 28))
)
(ADDTOVAR BackgroundMenuCommands (Sketch (QUOTE (SKETCHW.CREATE NIL NIL (GETREGION)
NIL NIL T T))
"Opens a sketch window for use."))
(RPAQQ BackgroundMenu NIL)
(FILESLOAD SKETCHELEMENTS GRAPHZOOM SKETCHEDIT SKETCHOBJ TEDIT)
(INIT.GROUP.ELEMENT)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA SKETCH.CREATE STATUSPRINT)
)
(PUTPROPS SKETCH COPYRIGHT ("Xerox Corporation" 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (15157 73595 (DRAW.LOCAL.SKETCH 15167 . 15528) (SKETCHW.CREATE 15530 . 22516) (
SKETCHW.FIG.CHANGED 22518 . 22938) (SK.WINDOW.TITLE 22940 . 23349) (EDITSLIDE 23351 . 23742) (
EDITSKETCH 23744 . 24071) (SK.FIX.MENU 24073 . 25226) (SK.PUT.ON.FILE 25228 . 27286) (SK.GET.FROM.FILE
27288 . 31915) (SK.ADD.ELEMENTS.TO.SKETCH 31917 . 32210) (STATUSPRINT 32212 . 33360) (
CLEARPROMPTWINDOW 33362 . 33827) (CLOSEPROMPTWINDOW 33829 . 34220) (MYGETPROMPTWINDOW 34222 . 34864) (
PROMPT.GETINPUT 34866 . 35558) (SK.INSURE.HAS.MENU 35560 . 36210) (CREATE.SKETCHW.COMMANDMENU 36212 .
47246) (SKETCH.SET.A.DEFAULT 47248 . 50144) (SK.POPUP.SELECTIONFN 50146 . 50597) (GETSKETCHWREGION
50599 . 50810) (READ.FUNCTION 50812 . 51348) (READBRUSHSIZE 51350 . 51723) (READANGLE 51725 . 52164) (
READARCDIRECTION 52166 . 52865) (SK.ADD.ELEMENT 52867 . 54082) (SK.APPLY.MENU.COMMAND 54084 . 54994) (
SK.DELETE.ELEMENT1 54996 . 56418) (SK.MARK.DIRTY 56420 . 56804) (SK.MARK.UNDIRTY 56806 . 57205) (
SK.MENU.AND.RETURN.FIELD 57207 . 57790) (SK.SCALE.POSITION.INTO.VIEWER 57792 . 58291) (
SKETCH.SET.BRUSH.SHAPE 58293 . 58899) (SKETCH.SET.BRUSH.SIZE 58901 . 59336) (SKETCHW.CLOSEFN 59338 .
60817) (SKETCHW.OUTFN 60819 . 61120) (SKETCHW.REOPENFN 61122 . 61591) (MAKE.LOCAL.SKETCH 61593 . 62273
) (MAP.SKETCHSPEC.INTO.VIEWER 62275 . 63165) (SKETCHW.REPAINTFN 63167 . 64123) (SKETCHW.REPAINTFN1
64125 . 64963) (SK.DRAWFIGURE.IF 64965 . 65463) (SKETCHW.SCROLLFN 65465 . 68454) (SKETCHW.SELECTIONFN
68456 . 69193) (SK.UPDATE.EVENT.SELECTION 69195 . 70681) (LIGHTGRAYWINDOW 70683 . 70863) (
SK.ADD.SPACES 70865 . 71353) (SK.SKETCH.MENU 71355 . 71611) (SK.CHECK.WHENDELETEDFN 71613 . 72269) (
SK.APPLY.WHENDELETEDFN 72271 . 72993) (SK.RETURN.TTY 72995 . 73313) (SK.TAKE.TTY 73315 . 73593)) (
73647 80268 (SKETCH.CREATE 73657 . 74250) (GETSKETCHPROP 74252 . 76387) (PUTSKETCHPROP 76389 . 79464)
(CREATE.DEFAULT.SKETCH.CONTEXT 79466 . 80266)) (80426 93007 (SK.COPY.BUTTONEVENTFN 80436 . 88486) (
SK.BUTTONEVENT.MARK 88488 . 88897) (SK.BUILD.IMAGEOBJ 88899 . 91795) (SK.BUTTONEVENT.OVERP 91797 .
92339) (SK.BUTTONEVENT.SAME.KEYS 92341 . 93005)) (93236 102348 (SK.SEL.AND.CHANGE 93246 . 93574) (
SK.CHANGE.ELT 93576 . 93764) (SK.CHANGE.THING 93766 . 94717) (SK.CHANGEFN 94719 . 95166) (
SK.READCHANGEFN 95168 . 95607) (SK.DEFAULT.CHANGEFN 95609 . 97427) (CHANGEABLEFIELDITEMS 97429 . 98027
) (SK.SEL.AND.MAKE 98029 . 98446) (SK.APPLY.CHANGE.COMMAND 98448 . 99234) (SK.ELEMENTS.CHANGEFN 99236
. 100736) (SK.GROUP.CHANGEFN 100738 . 102346)) (102385 110779 (ADD.ELEMENT.TO.SKETCH 102395 . 102786)
(ADD.SKETCH.VIEWER 102788 . 103405) (REMOVE.SKETCH.VIEWER 103407 . 103940) (ALL.SKETCH.VIEWERS 103942
. 104217) (VIEWER.BUCKET 104219 . 104366) (ELT.INSIDE.REGION? 104368 . 104745) (ELT.INSIDE.SKWP
104747 . 105086) (SCALE.FROM.SKW 105088 . 105348) (SK.ADDELT.TO.WINDOW 105350 . 106205) (
SK.CALC.REGION.VIEWED 106207 . 106518) (SK.DRAWFIGURE 106520 . 107410) (SK.DRAWFIGURE1 107412 . 107728
) (SK.LOCAL.FROM.GLOBAL 107730 . 108404) (SK.REGION.VIEWED 108406 . 108731) (SK.UPDATE.REGION.VIEWED
108733 . 109076) (SKETCH.ADD.AND.DISPLAY 109078 . 109535) (SKETCH.ADD.AND.DISPLAY1 109537 . 110002) (
SK.ADD.ITEM 110004 . 110365) (SKETCHW.ADD.INSTANCE 110367 . 110777)) (110816 115690 (SK.SEL.AND.DELETE
110826 . 111130) (SK.ERASE.AND.DELETE.ITEM 111132 . 111481) (REMOVE.ELEMENT.FROM.SKETCH 111483 .
112428) (SK.DELETE.ELEMENT 112430 . 113278) (SK.ERASE.ELT 113280 . 113660) (SK.DELETE.ELT 113662 .
113963) (SK.DELETE.ITEM 113965 . 114372) (DELFROMTCONC 114374 . 115688)) (115725 122575 (SK.COPY.ELT
115735 . 116031) (SK.SEL.AND.COPY 116033 . 116333) (SK.COPY.ELEMENTS 116335 . 118737) (SK.COPY.ITEM
118739 . 119528) (SK.INSERT.SKETCH 119530 . 122573)) (122611 136674 (SK.MOVE.ELT 122621 . 122944) (
SK.MOVE.ELT.OR.PT 122946 . 123277) (SK.APPLY.DEFAULT.MOVE 123279 . 123778) (SK.SEL.AND.MOVE 123780 .
124232) (SK.MOVE.ELEMENTS 124234 . 129266) (SK.SHOW.FIG.FROM.INFO 129268 . 129586) (SK.MOVE.THING
129588 . 131098) (UPDATE.ELEMENT.IN.SKETCH 131100 . 132065) (SK.UPDATE.ELEMENT 132067 . 133443) (
SK.UPDATE.ELEMENTS 133445 . 133855) (SK.UPDATE.ELEMENT1 133857 . 136333) (SK.MOVE.ELEMENT.POINT 136335
. 136672)) (136733 153705 (SK.MOVE.POINTS 136743 . 137077) (SK.SEL.AND.MOVE.POINTS 137079 . 137370) (
SK.DO.MOVE.ELEMENT.POINTS 137372 . 142179) (SK.MOVE.ITEM.POINTS 142181 . 143793) (SK.TRANSLATEPTSFN
143795 . 144123) (SK.TRANSLATE.POINTS 144125 . 144500) (SK.SELECT.MULTIPLE.POINTS 144502 . 149653) (
SK.CONTROL.POINTS.IN.REGION 149655 . 150832) (SK.ADD.PT.SELECTION 150834 . 151267) (
SK.REMOVE.PT.SELECTION 151269 . 151886) (SK.ADD.POINT 151888 . 152445) (SK.ELTS.CONTAINING.PTS 152447
. 153086) (SK.HOTSPOTS.NOT.ON.LIST 153088 . 153703)) (153830 155999 (SK.SET.MOVE.MODE 153840 . 154362
) (SK.SET.MOVE.MODE.POINTS 154364 . 154643) (SK.SET.MOVE.MODE.ELEMENTS 154645 . 154929) (
SK.SET.MOVE.MODE.COMBINED 154931 . 155221) (READMOVEMODE 155223 . 155997)) (156059 161529 (
SK.GROUP.ELTS 156069 . 156398) (SK.SEL.AND.GROUP 156400 . 156703) (SK.GROUP.ELEMENTS 156705 . 158438)
(SK.UNGROUP.ELT 158440 . 158772) (SK.SEL.AND.UNGROUP 158774 . 159074) (SK.UNGROUP.ELEMENT 159076 .
159850) (SK.GLOBAL.REGION.OF.ELEMENTS 159852 . 160501) (SK.GLOBAL.REGION.OF.SKETCH 160503 . 161176) (
SK.FLASHREGION 161178 . 161527)) (161530 169775 (INIT.GROUP.ELEMENT 161540 . 162363) (GROUP.DRAWFN
162365 . 162802) (GROUP.EXPANDFN 162804 . 163885) (GROUP.INSIDEFN 163887 . 164301) (GROUP.REGIONFN
164303 . 164628) (GROUP.TRANSLATEFN 164630 . 165924) (GROUP.TRANSFORMFN 165926 . 167962) (
GROUP.READCHANGEFN 167964 . 169773)) (169776 170602 (REGION.CENTER 169786 . 170293) (REMOVE.LAST
170295 . 170600)) (170830 172717 (SK.DO.GROUP 170840 . 171577) (SK.DO.UNGROUP 171579 . 172155) (
SK.GROUP.UNDO 172157 . 172436) (SK.UNGROUP.UNDO 172438 . 172715)) (172949 181823 (SK.SEL.AND.TRANSFORM
172959 . 173351) (SK.TRANSFORM.ELEMENTS 173353 . 174430) (SK.TRANSFORM.ITEM 174432 . 175035) (
SK.TRANSFORM.ELEMENT 175037 . 175478) (SK.TRANSFORM.POINT 175480 . 175719) (SK.TRANSFORM.POINT.LIST
175721 . 175942) (SK.TRANSFORM.REGION 175944 . 177649) (SK.PUT.ELTS.ON.GRID 177651 . 178119) (
SK.TRANSFORM.GLOBAL.ELEMENTS 178121 . 178623) (GLOBALELEMENTP 178625 . 178897) (
SK.TRANSFORM.SCALE.FACTOR 178899 . 180063) (SK.TRANSFORM.BRUSH 180065 . 180443) (
SK.TRANSFORM.ARROWHEADS 180445 . 181233) (SCALE.BRUSH 181235 . 181821)) (181824 199439 (
TWO.PT.TRANSFORMATION.INPUTFN 181834 . 184412) (SK.TWO.PT.TRANSFORM.ELTS 184414 . 184862) (
SK.SEL.AND.TWO.PT.TRANSFORM 184864 . 185466) (SK.APPLY.AFFINE.TRANSFORM 185468 . 186268) (
SK.COMPUTE.TWO.PT.TRANSFORMATION 186270 . 189706) (SK.COMPUTE.SLOPE 189708 . 190354) (
SK.THREE.PT.TRANSFORM.ELTS 190356 . 190811) (SK.COMPUTE.THREE.PT.TRANSFORMATION 190813 . 194700) (
SK.SEL.AND.THREE.PT.TRANSFORM 194702 . 195311) (THREE.PT.TRANSFORMATION.INPUTFN 195313 . 199437)) (
199440 203168 (SK.COPY.AND.TWO.PT.TRANSFORM.ELTS 199450 . 199912) (SK.SEL.COPY.AND.TWO.PT.TRANSFORM
199914 . 200547) (SK.COPY.AND.THREE.PT.TRANSFORM.ELTS 200549 . 201022) (
SK.SEL.COPY.AND.THREE.PT.TRANSFORM 201024 . 201661) (SK.COPY.AND.TRANSFORM.ELEMENTS 201663 . 202603) (
SK.COPY.AND.TRANSFORM.ITEM 202605 . 203166)) (205103 213264 (SKETCH.ELEMENTS.OF.SKETCH 205113 . 205857
) (SKETCH.LIST.OF.ELEMENTS 205859 . 206520) (SKETCH.ADD.ELEMENT 206522 . 207359) (
SKETCH.DELETE.ELEMENT 207361 . 208871) (DELFROMGROUPELT 208873 . 209672) (SKETCH.ELEMENT.TYPE 209674
. 209953) (SKETCH.ELEMENT.CHANGED 209955 . 211236) (SK.ELEMENT.CHANGED1 211238 . 211910) (
SK.UPDATE.GLOBAL.IMAGE.OBJECT.ELEMENT 211912 . 213262)) (213314 216091 (INSURE.SKETCH 213324 . 214698)
(LOCALSPECS.FROM.VIEWER 214700 . 215025) (SK.LOCAL.ELT.FROM.GLOBALPART 215027 . 215522) (
SKETCH.FROM.VIEWER 215524 . 215706) (INSPECT.SKETCH 215708 . 216089)) (216092 220736 (MAPSKETCHSPECS
216102 . 216702) (MAPCOLLECTSKETCHSPECS 216704 . 217401) (MAPSKETCHSPECSUNTIL 217403 . 218170) (
MAPGLOBALSKETCHSPECS 218172 . 218800) (MAPGLOBALSKETCHELEMENTS 218802 . 219879) (GETSKELEMENTPROP
219881 . 220104) (PUTSKELEMENTPROP 220106 . 220734)) (220771 223573 (SK.SHOWMARKS 220781 . 221426) (
MARKPOINT 221428 . 222150) (SK.MARKHOTSPOTS 222152 . 223149) (SK.MARK.SELECTION 223151 . 223571)) (
224183 229865 (SK.SELECT.ITEM 224193 . 226416) (IN.SKETCH.ELT? 226418 . 228246) (SK.MARK.HOTSPOT
228248 . 228794) (SK.MARK.POSITION 228796 . 229167) (SK.SELECT.ELT 229169 . 229538) (SK.DESELECT.ELT
229540 . 229863)) (230002 237877 (SK.HOTSPOT.CACHE 230012 . 230321) (SK.SET.HOTSPOT.CACHE 230323 .
230646) (SK.CREATE.HOTSPOT.CACHE 230648 . 231023) (SK.ELTS.FROM.HOTSPOT 231025 . 231787) (
SK.ADD.HOTSPOTS.TO.CACHE 231789 . 232128) (SK.ADD.HOTSPOTS.TO.CACHE1 232130 . 232539) (
SK.ADD.HOTSPOT.TO.CACHE 232541 . 234078) (SK.REMOVE.HOTSPOTS.FROM.CACHE 234080 . 234421) (
SK.REMOVE.HOTSPOTS.FROM.CACHE1 234423 . 234833) (SK.REMOVE.HOTSPOT.FROM.CACHE 234835 . 235478) (
SK.REMOVE.VALUE.FROM.CACHE.BUCKET 235480 . 236174) (SK.FIND.CACHE.BUCKET 236176 . 236666) (
SK.ADD.VALUE.TO.CACHE.BUCKET 236668 . 237875)) (237935 259966 (SK.ADD.SELECTION 237945 . 238623) (
SK.COPY.INSERTFN 238625 . 240431) (SK.FIGUREIMAGE 240433 . 244154) (SCREENELEMENTP 244156 . 244530) (
SK.ITEM.REGION 244532 . 245043) (SK.LOCAL.ITEMS.IN.REGION 245045 . 246438) (SK.REGIONFN 246440 .
246748) (SK.REMOVE.SELECTION 246750 . 247413) (SK.SELECT.MULTIPLE.ITEMS 247415 . 256634) (
SK.PUT.MARKS.UP 256636 . 257043) (SK.TAKE.MARKS.DOWN 257045 . 257465) (SK.TRANSLATE.GLOBALPART 257467
. 258391) (SK.TRANSLATE.ITEM 258393 . 259187) (SK.TRANSLATEFN 259189 . 259395) (TRANSLATE.SKETCH
259397 . 259964)) (260288 261003 (ELT.INSIDE.SKETCHWP 260298 . 260636) (SK.INSIDE.REGION 260638 .
261001)) (261051 263708 (SK.INPUT.SCALE 261061 . 261815) (SK.UPDATE.SKETCHCONTEXT 261817 . 262457) (
SK.SET.INPUT.SCALE 262459 . 262920) (SK.SET.INPUT.SCALE.CURRENT 262922 . 263266) (
SK.SET.INPUT.SCALE.VALUE 263268 . 263706)) (263743 275115 (SKETCHW.SCALE 263753 . 263830) (SKETCH.ZOOM
263832 . 264746) (SAME.ASPECT.RATIO 264748 . 265804) (SKETCH.DO.ZOOM 265806 . 266963) (
SKETCH.NEW.VIEW 266965 . 267373) (ZOOM.UPDATE.ELT 267375 . 268087) (SK.UPDATE.AFTER.SCALE.CHANGE
268089 . 269762) (SKETCH.AUTOZOOM 269764 . 272580) (SKETCH.GLOBAL.REGION.ZOOM 272582 . 275113)) (
275824 281114 (SKETCH.HOME 275834 . 276332) (SK.FRAME.IT 276334 . 276881) (SK.MOVE.TO.VIEW 276883 .
278120) (SK.NAME.CURRENT.VIEW 278122 . 278897) (SK.RESTORE.VIEW 278899 . 279943) (SK.FORGET.VIEW
279945 . 281112)) (281310 297523 (SK.SET.GRID 281320 . 281685) (SK.DISPLAY.GRID 281687 . 282197) (
SK.DISPLAY.GRID.POINTS 282199 . 282388) (SK.REMOVE.GRID.POINTS 282390 . 282815) (SK.TAKE.DOWN.GRID
282817 . 283144) (SK.SHOW.GRID 283146 . 285780) (SK.GRIDFACTOR 285782 . 286327) (SK.TURN.GRID.ON
286329 . 286677) (SK.TURN.GRID.OFF 286679 . 287052) (SK.MAKE.GRID.LARGER 287054 . 287406) (
SK.MAKE.GRID.SMALLER 287408 . 287760) (SK.CHANGE.GRID 287762 . 288300) (GRID.FACTOR1 288302 . 288712)
(LEASTPOWEROF2GT 288714 . 289370) (GREATESTPOWEROF2LT 289372 . 290027) (SK.DEFAULT.GRIDFACTOR 290029
. 290467) (SK.PUT.ON.GRID 290469 . 290944) (MAP.WINDOW.ONTO.GRID 290946 . 291318) (
MAP.SCREEN.ONTO.GRID 291320 . 291852) (MAP.GLOBAL.PT.ONTO.GRID 291854 . 292316) (
MAP.GLOBAL.REGION.ONTO.GRID 292318 . 293568) (MAP.WINDOW.POINT.ONTO.GLOBAL.GRID 293570 . 294120) (
MAP.WINDOW.ONTO.GLOBAL.GRID 294122 . 294462) (SK.UPDATE.GRIDFACTOR 294464 . 295014) (
SK.MAP.FROM.WINDOW.TO.GLOBAL.GRID 295016 . 295616) (SK.MAP.INPUT.PT.TO.GLOBAL 295618 . 296562) (
SK.MAP.FROM.WINDOW.TO.NEAREST.GRID 296564 . 297521)) (297656 299259 (SKETCH.TITLE 297666 . 297984) (
SK.SHRINK.ICONCREATE 297986 . 299257)) (304527 310364 (SK.ADD.HISTEVENT 304537 . 305319) (
SK.SEL.AND.UNDO 305321 . 307117) (SK.UNDO.LAST 307119 . 308697) (SK.UNDO.NAME 308699 . 309079) (
SKEVENTTYPEFNS 309081 . 309396) (SK.TYPE.OF.FIRST.ARG 309398 . 310362)) (310365 311148 (SK.DELETE.UNDO
310375 . 310760) (SK.ADD.UNDO 310762 . 311146)) (311149 312336 (SK.CHANGE.UNDO 311159 . 311812) (
SK.CHANGE.REDO 311814 . 312334)) (312337 314236 (SK.UNDO.UNDO 312347 . 313422) (SK.UNDO.MENULABEL
313424 . 313799) (SK.LABEL.FROM.TYPE 313801 . 314234)) (315025 333146 (SKETCHW.HARDCOPYFN 315035 .
319338) (\SK.LIST.PAGE.IMAGE 319340 . 321051) (SK.LIST.IMAGE 321053 . 329363) (SK.LIST.IMAGE.ON.FILE
329365 . 330042) (SK.SET.HARDCOPY.MODE 330044 . 331162) (SK.UNSET.HARDCOPY.MODE 331164 . 331557) (
SK.UPDATE.AFTER.HARDCOPY 331559 . 332195) (DEFAULTPRINTINGIMAGETYPE 332197 . 332709) (
SK.SWITCH.REGION.X.AND.Y 332711 . 333144)) (333388 340854 (SHOW.GLOBAL.COORDS 333398 . 333900) (
LOCATOR.CLOSEFN 333902 . 334259) (SKETCHW.FROM.LOCATOR 334261 . 334636) (SKETCHW.UPDATE.LOCATORS
334638 . 335237) (LOCATOR.UPDATE 335239 . 336001) (UPDATE.GLOBAL.LOCATOR 336003 . 336702) (
UPDATE.GLOBALCOORD.LOCATOR 336704 . 337304) (ADD.GLOBAL.DISPLAY 337306 . 338234) (
ADD.GLOBAL.GRIDDED.DISPLAY 338236 . 338456) (CREATE.GLOBAL.DISPLAYER 338458 . 339405) (
UPDATE.GLOBAL.GRIDDED.COORD.LOCATOR 339407 . 340852)) (341067 341436 (READBRUSHSHAPE 341077 . 341434))
(341437 349272 (SK.CHANGE.DASHING 341447 . 344504) (READ.AND.SAVE.NEW.DASHING 344506 . 345701) (
READ.NEW.DASHING 345703 . 346775) (READ.DASHING.CHANGE 346777 . 347774) (DASHINGP 347776 . 348090) (
SK.CACHE.DASHING 348092 . 348837) (SK.DASHING.LABEL 348839 . 349270)) (349273 352164 (
READ.FILLING.CHANGE 349283 . 350420) (SK.CACHE.FILLING 350422 . 351073) (READ.AND.SAVE.NEW.FILLING
351075 . 351694) (SK.FILLING.LABEL 351696 . 352162)) (352521 361842 (DISPLAYREADCOLORHLSLEVELS 352531
. 353382) (DISPLAYREADCOLORLEVEL 353384 . 354230) (DRAWREADCOLORBOX 354232 . 355045) (
READ.CHANGE.COLOR 355047 . 355198) (READCOLOR1 355200 . 357137) (READCOLORCOMMANDMENUSELECTEDFN 357139
. 357508) (READCOLOR2 357510 . 361840)) (361843 363121 (CREATE.CNS.MENU 361853 . 363119)) (363269
364296 (SCALE.POSITION.INTO.SKETCHW 363279 . 363622) (UNSCALE 363624 . 363756) (UNSCALE.REGION 363758
. 364294)) (364343 374223 (SK.GETGLOBALPOSITION 364353 . 364711) (GETSKWPOSITION 364713 . 367909) (
NEAREST.HOT.SPOT 367911 . 369028) (GETWREGION 369030 . 369655) (GET.BITMAP.POSITION 369657 . 370370) (
SK.TRACK.BITMAP1 370372 . 374221)) (375981 378106 (SK.DRAWFN 375991 . 376301) (SK.TRANSFORMFN 376303
. 376628) (SK.EXPANDFN 376630 . 376855) (SK.INPUT 376857 . 377183) (SK.INSIDEFN 377185 . 377526) (
SK.UPDATEFN 377528 . 378104)))))
STOP