(FILECREATED "11-Dec-85 11:51:29" {PHYLUM}<PAPERWORKS>SKETCH.;218 440786
changes to: (FNS SK.BUILD.CACHE SKETCH.RESET SK.MOVE.ELEMENTS SKETCHW.CREATE
SK.COPY.BUTTONEVENTFN SK.SEL.AND.CHANGE SK.SEL.AND.MAKE SK.SEL.AND.DELETE
SK.SEL.AND.DELETE.KNOT SK.SEL.AND.COPY SK.SEL.AND.MOVE
SK.SELECT.MULTIPLE.POINTS SK.SEL.AND.GROUP SK.GROUP.ELEMENTS
SK.SEL.AND.UNGROUP SK.UNGROUP.ELEMENT SK.GROUP.UNDO SK.UNGROUP.UNDO
SK.SEL.AND.TRANSFORM SK.SEL.AND.TWO.PT.TRANSFORM
SK.SEL.AND.THREE.PT.TRANSFORM SK.SEL.COPY.AND.TWO.PT.TRANSFORM
SK.SEL.COPY.AND.THREE.PT.TRANSFORM SK.SELECT.ITEM SK.SELECT.MULTIPLE.ITEMS
SK.TYPE.OF.FIRST.ARG SK.HOTSPOT.CACHE.FOR.OPERATION SKETCH.SET.A.DEFAULT
GROUP.DRAWFN GROUP.EXPANDFN GROUP.REGIONFN SK.DO.GROUP SK.UPDATE.ELEMENT1
SK.DELETE.ELEMENT SKETCH.ADD.ELEMENT SK.CHECK.WHENEDITEDFN SK.CHECK.PREEDITFN
READ.POINT.TO.ADD SK.CHECK.WHENPOINTDELETEDFN)
(VARS SKETCHCOMS)
(PROPS (GROUP EVENTFNS)
(UNGROUP EVENTFNS))
(RECORDS LOCALGROUP)
previous date: " 5-Dec-85 18:23:25" {PHYLUM}<PAPERWORKS>SKETCH.;210)
(* 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 SKETCH.TEST)
(FNS DRAW.LOCAL.SKETCH SKETCHW.CREATE SKETCH.RESET 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 SKETCH.SET.A.DEFAULT
SK.POPUP.SELECTIONFN GETSKETCHWREGION READ.FUNCTION READBRUSHSIZE READANGLE
READARCDIRECTION SK.ADD.ELEMENT SK.ADD.ELEMENTS SK.CHECK.WHENADDEDFN
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 SK.UPDATE.EVENT.SELECTION LIGHTGRAYWINDOW SK.ADD.SPACES SK.SKETCH.MENU
SK.CHECK.IMAGEOBJ.WHENDELETEDFN SK.APPLY.IMAGEOBJ.WHENDELETEDFN SK.RETURN.TTY
SK.TAKE.TTY)
(COMS (* fns for dealing with the menu)
(FNS SKETCH.COMMANDMENU SKETCH.COMMANDMENU.ITEMS CREATE.SKETCHW.COMMANDMENU
SKETCHW.SELECTIONFN))
(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 READ.POINT.TO.ADD GLOBAL.KNOT.FROM.LOCAL SK.ADD.KNOT.TO.ELEMENT
SK.GROUP.CHANGEFN)
(* fns for adding elements)
[COMS (* 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 SKETCH.REGION.VIEWED SKETCH.VIEW.FROM.NAME
SK.UPDATE.REGION.VIEWED SKETCH.ADD.AND.DISPLAY SKETCH.ADD.AND.DISPLAY1 SK.ADD.ITEM
SKETCHW.ADD.INSTANCE)
(* put in for backward compatibility. Can be pulled out 6/1/86 rrb.)
(P (MOVD? (QUOTE SKETCH.REGION.VIEWED)
(QUOTE SK.REGION.VIEWED]
(* fns for deleting things)
(FNS SK.SEL.AND.DELETE SK.ERASE.AND.DELETE.ITEM REMOVE.ELEMENT.FROM.SKETCH SK.DELETE.ELEMENT
SK.DELETE.KNOT SK.SEL.AND.DELETE.KNOT SK.DELETE.ELEMENT.KNOT SK.CHECK.WHENDELETEDFN
SK.CHECK.PREEDITFN SK.CHECK.WHENEDITEDFN SK.CHECK.WHENPOINTDELETEDFN 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.GLOBAL.FROM.LOCAL.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 SKETCH.MOVE.ELEMENTS SK.TRANSLATE.ELEMENT
SK.MAKE.ELEMENT.MOVE.ARG SK.MAKE.ELEMENTS.MOVE.ARG
SK.MAKE.POINTS.AND.ELEMENTS.MOVE.ARG 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 SKETCH.CREATE.GROUP SK.CREATE.GROUP1 SK.UPDATE.GROUP.AFTER.CHANGE SK.GROUP.ELTS
SK.SEL.AND.GROUP SK.GROUP.ELEMENTS SK.UNGROUP.ELT SK.SEL.AND.UNGROUP
SK.UNGROUP.ELEMENT SK.GLOBAL.REGION.OF.LOCAL.ELEMENTS
SK.GLOBAL.REGION.OF.GLOBAL.ELEMENTS SKETCH.REGION.OF.SKETCH SK.FLASHREGION)
(FNS INIT.GROUP.ELEMENT GROUP.DRAWFN GROUP.EXPANDFN GROUP.INSIDEFN GROUP.REGIONFN
GROUP.GLOBALREGIONFN 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)
(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.HOTSPOT.CACHE.FOR.OPERATION SK.BUILD.CACHE
SK.ELEMENT.PROTECTED? SK.HAS.SOME.HOTSPOTS 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.ELEMENT.GLOBAL.REGION SK.LOCAL.ITEMS.IN.REGION SK.REGIONFN SK.GLOBAL.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 (* stuff for setting feedback amount)
(FNS SK.SET.FEEDBACK.MODE SK.SET.FEEDBACK.POINT SK.SET.FEEDBACK.VERBOSE
SK.SET.FEEDBACK.ALWAYS)
(VARS (SKETCH.VERBOSE.FEEDBACK T))
(GLOBALVARS SKETCH.VERBOSE.FEEDBACK))
(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 SKETCH.ADD.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 SKETCH.TRACK.ELEMENTS
SK.READ.POINT.WITH.FEEDBACK NEAREST.HOT.SPOT GETWREGION GET.BITMAP.POSITION
SK.TRACK.BITMAP1)
(RECORDS INPUTPT))
(INITVARS (ALL.SKETCHES)
(INITIAL.SCALE 1.0)
(DEFAULT.VISIBLE.SCALE.FACTOR 10.0)
(MINIMUM.VISIBLE.SCALE.FACTOR 4.0))
(VARS (SKETCH.ELEMENT.TYPES)
(SKETCH.ELEMENT.TYPE.NAMES))
(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 SKETCHBMELT TEDIT)
(DECLARE: DOEVAL@COMPILE EVAL@LOAD DONTCOPY (FILES (LOADCOMP)
SKETCHELEMENTS SKETCHOBJ SKETCHEDIT))
(P (INIT.GROUP.ELEMENT))
(COMS (* version checking stuff)
(CONSTANTS (SKETCH.VERSION 3))
(FNS SK.CHECK.SKETCH.VERSION SK.INSURE.RECORD.LENGTH SK.INSURE.HAS.LENGTH
SK.SET.RECORD.LENGTHS)
(MACROS SK.SET.RECORD.LENGTHS.MACRO)
(GLOBALVARS SKETCH.RECORD.LENGTHS)
(P (SK.SET.RECORD.LENGTHS)))
(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
(SKETCH.TEST
[LAMBDA NIL (* rrb " 1-Nov-85 14:57")
(* test the programmer's interface a little.)
(PROG (SKELTS SK SKELT)
[SETQ SKELTS (LIST [PROG1 (SETQ SKELT (SKETCH.CREATE.BITMAP
(CAR SKETCH.TITLED.ICON.TEMPLATE)
(QUOTE (0 . 0))
1.0))
(PUTSKETCHELEMENTPROP SKELT (QUOTE ACTIVEREGION)
(CREATEREGION
0 0 (BITMAPWIDTH (CAR
SKETCH.TITLED.ICON.TEMPLATE))
(BITMAPHEIGHT (CAR
SKETCH.TITLED.ICON.TEMPLATE]
(SKETCH.CREATE.TEXT (QUOTE ("this is a two line"
"piece of text"))
(QUOTE (0 . 100))
(QUOTE (MODERN 12 BOLD))
NIL NIL 1.0)
(SKETCH.CREATE.TEXTBOX
"text box
with carriage returns in it but only after text box."
(QUOTE (75 75 100 50))
NIL
(QUOTE (LEFT TOP))
3
(QUOTE (4 4))
GRAYSHADE NIL 1.0)
(SKETCH.CREATE.BOX (QUOTE (75 0 20 20)))
(SKETCH.CREATE.WIRE (QUOTE ((75 . 75)
(60 . 100)
(75 . 200)))
2 NIL (QUOTE (NIL T))
1.0)
(SKETCH.CREATE.CLOSED.WIRE (QUOTE ((75 . 75)
(100 . 60)
(200 . 75)))
2 NIL 15 1.0)
(SKETCH.CREATE.OPEN.CURVE (QUOTE ((50 . 200)
(60 . 100)
(75 . 200)))
2 NIL (QUOTE (NIL T))
1.0)
(SKETCH.CREATE.CLOSED.CURVE (QUOTE ((200 . 50)
(100 . 60)
(200 . 75)))
2 NIL 15 1.0)
(SKETCH.CREATE.CIRCLE (QUOTE (150 . 150))
(QUOTE (175 . 175))
5
(QUOTE (1 1))
NIL 1.0)
(SKETCH.CREATE.ELLIPSE (QUOTE (150 . 150))
(QUOTE (170 . 150))
(QUOTE (150 . 160))
2 NIL NIL 1.0)
(SKETCH.CREATE.ARC (QUOTE (150 . 150))
(QUOTE (185 . 185))
(QUOTE (150 . 185))
1
(QUOTE (2 2))
(QUOTE (T T))
NIL 1.0)
(SKETCH.CREATE.GROUP [LIST [SKETCH.CREATE.WIRE
(QUOTE ((200 . 200)
(240 . 200]
[SKETCH.CREATE.WIRE
(QUOTE ((200 . 200)
(200 . 240]
[SKETCH.CREATE.WIRE
(QUOTE ((240 . 200)
(240 . 240]
(SKETCH.CREATE.WIRE
(QUOTE ((240 . 240)
(200 . 240]
(QUOTE (220 . 200]
(SETQ SK (SKETCH.ADD.ELEMENT NIL NIL))
(for ELT in SKELTS do (SKETCH.ADD.ELEMENT ELT SK))
[PUTSKETCHPROP SK (QUOTE WHENADDEDFN)
(FUNCTION (LAMBDA (X)
(X)
(PRINT "When added called." PROMPTWINDOW]
[PUTSKETCHPROP SK (QUOTE WHENDELETEDFN)
(FUNCTION (LAMBDA (X)
(X)
(PRINT "When deleted called." PROMPTWINDOW]
[PUTSKETCHPROP SK (QUOTE WHENCHANGEDFN)
(FUNCTION (LAMBDA (X)
(X)
(PRINT "When changed called." PROMPTWINDOW]
[PUTSKETCHPROP SK (QUOTE PREMOVEFN)
(FUNCTION (LAMBDA (X)
(X)
(PRINT "Premove called." PROMPTWINDOW]
[PUTSKETCHPROP SK (QUOTE WHENMOVEDFN)
(FUNCTION (LAMBDA (X)
(X)
(PRINT "When moved called." PROMPTWINDOW]
[PUTSKETCHPROP SK (QUOTE PRECOPYFN)
(FUNCTION (LAMBDA (X)
(X)
(PRINT "Pre Copy called." PROMPTWINDOW]
[PUTSKETCHPROP SK (QUOTE WHENCOPIEDFN)
(FUNCTION (LAMBDA (X)
(X)
(PRINT "When copied called." PROMPTWINDOW]
[PUTSKETCHPROP SK (QUOTE WHENGROUPED)
(FUNCTION (LAMBDA (X)
(X)
(PRINT "When grouped called." PROMPTWINDOW]
[PUTSKETCHPROP SK (QUOTE WHENUNGROUPED)
(FUNCTION (LAMBDA (X)
(X)
(PRINT "When ungrouped called." PROMPTWINDOW]
[PUTSKETCHPROP SK (QUOTE WHENDEFAULTSETFN)
(FUNCTION (LAMBDA (X)
(X)
(PRINT "When default set fn." PROMPTWINDOW]
[PUTSKETCHPROP SK (QUOTE BUTTONEVENTINFN)
(FUNCTION (LAMBDA (X)
(X)
(PRINT "When button event in fn called." PROMPTWINDOW]
(SKETCHW.CREATE SK NIL (QUOTE (200 200 300 300))
"test SKETCH" NIL T])
)
(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 "11-Dec-85 10:56")
(* creates a sketch window and returns it.)
(PROG (W SCALE SKPROC SKETCHSTRUCTURE)
[SETQ SKETCHSTRUCTURE (SK.CHECK.SKETCH.VERSION (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)
(AND TITLE (WINDOWPROP SCREENREGION (QUOTE TITLE)
TITLE))
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])
(SKETCH.RESET
[LAMBDA (SKETCH) (* rrb "11-Dec-85 11:24")
(* resets a sketch structure and all of the viewers
onto it.)
(PROG ((SKSTRUC (INSURE.SKETCH SKETCH))) (* delete all sketch elements)
(replace (SKETCH SKETCHTCELL) of SKSTRUC with (CONS))
(for VIEWER in (ALL.SKETCH.VIEWERS SKSTRUC)
do (SKED.CLEAR.SELECTION VIEWER)
(DSPRESET VIEWER)
(WINDOWPROP VIEWER (QUOTE SCALE)
INITIAL.SCALE)
(SK.UPDATE.REGION.VIEWED VIEWER)
(MAP.SKETCHSPEC.INTO.VIEWER SKSTRUC VIEWER)
(SK.CREATE.HOTSPOT.CACHE VIEWER)
(WINDOWPROP VIEWER (QUOTE GRIDFACTOR)
(SK.DEFAULT.GRIDFACTOR VIEWER))
(WINDOWPROP VIEWER (QUOTE USEGRID)
NIL)
(WINDOWPROP VIEWER (QUOTE SKETCHHISTORY)
NIL)
(WINDOWPROP VIEWER (QUOTE SKETCHCHANGED)
NIL])
(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 "20-Nov-85 10:26")
(* clears and closes the prompt window for a window.)
(PROG [(PROMPTW (OPENWP (GETPROMPTWINDOW WINDOW NIL NIL T]
(COND
(PROMPTW (CLEARW PROMPTW)
(DETACHWINDOW 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 "17-Oct-85 10:50")
(* 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)
T)))
(WINDOWPROP SKETCHW (COND
(POPUPFLG (QUOTE SKETCHPOPUPMENU))
(T (QUOTE SKETCHFIXEDMENU)))
OPMENUW)
(RETURN OPMENUW])
(SKETCH.SET.A.DEFAULT
[LAMBDA (SKW) (* rrb "10-Dec-85 14:57")
(* allows the user to set a default)
(\CURSOR.IN.MIDDLE.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.")))
(Feedback SK.SET.FEEDBACK.MODE
"Controls the amount of feedback when adding new curves, circles, etc."
(SUBITEMS ("Points only"
SK.SET.FEEDBACK.POINT
"Only the control points will be shown when entering elements.")
("Fast figures"
SK.SET.FEEDBACK.VERBOSE
"Wires, circles and ellipses are shown while they are being entered.")
("All figures"
SK.SET.FEEDBACK.ALWAYS
"Most elements are shown while they are being entered.
This will be slow for arcs and curves."]
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 " 6-Nov-85 09:53")
(* interacts to get whether an arc should go clockwise
or counterclockwise)
(\CURSOR.IN.MIDDLE.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 "19-Oct-85 17:33")
(* adds a new element to a sketch window and handles
propagation to all other figure windows)
(COND
(GELT (PROG ((GELTTOADD (SK.CHECK.WHENADDEDFN SKETCHW GELT))
(SKETCH (SKETCH.FROM.VIEWER SKETCHW))
ADDEDELT) (* take down the caret.)
(OR GELTTOADD (RETURN))
(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.ADD.ELEMENTS
[LAMBDA (ELEMENTS SKW) (* adds a list of global elements to a viewer but
doesn't make an entry on the history list.)
(for ELT in ELEMENTS do (SK.ADD.ELEMENT ELT SKW])
(SK.CHECK.WHENADDEDFN
[LAMBDA (VIEWER GELT) (* rrb "19-Oct-85 17:36")
(* checks if the sketch has a when added fn and if so, calls it and interprets the result. Returns a list of the
elements that should be deleted.)
(PROG ((SKETCH (INSURE.SKETCH VIEWER))
ADDFN RESULT)
(COND
([NULL (SETQ ADDFN (GETSKETCHPROP SKETCH (QUOTE WHENADDEDFN]
(RETURN GELT)))
(SETQ RESULT (APPLY* ADDFN VIEWER GELT))
(COND
((EQ RESULT (QUOTE DON'T))
(RETURN NIL))
((GLOBALELEMENTP RESULT)
(RETURN RESULT))
(T (RETURN GELT])
(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 "19-Oct-85 17:09")
(* 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.IMAGEOBJ.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 "12-Nov-85 10:46")
(* close function for a viewer.
Removes itself from the list of viewers.)
(PROG (PROCINFO)
[COND
[(SETQ PROCINFO (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]
(COND
([OR (TTY.PROCESSP (THIS.PROCESS))
(TTY.PROCESSP (WINDOWPROP SKW (QUOTE PROCESS]
(* if this process or the sketch process has the tty,
give it back to the Tedit that this window came from.)
(AND [PROCESSP (SETQ PROCINFO (WINDOWPROP (fetch (SKETCHDOCUMENTINFO
FROMTEDITWINDOW)
of PROCINFO)
(QUOTE PROCESS]
(TTY.PROCESS PROCINFO]
((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])
(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.IMAGEOBJ.WHENDELETEDFN
[LAMBDA (GELT SKETCHW) (* rrb "19-Oct-85 17:10")
(* 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.IMAGEOBJ.WHENDELETEDFN GELT SKETCHW))
(GROUP (for GELT in (fetch (GROUP LISTOFGLOBALELTS) of GELT)
do (SK.CHECK.IMAGEOBJ.WHENDELETEDFN GELT SKETCHW)))
NIL])
(SK.APPLY.IMAGEOBJ.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 the menu)
(DEFINEQ
(SKETCH.COMMANDMENU
[LAMBDA (ITEMS TITLE) (* rrb "17-Oct-85 10:38")
(create MENU
ITEMS ← ITEMS
CENTERFLG ← T
WHENSELECTEDFN ←(FUNCTION SKETCHW.SELECTIONFN)
MENUFONT ←(FONTNAMELIST (FONTCREATE BOLDFONT))
TITLE ← TITLE])
(SKETCH.COMMANDMENU.ITEMS
[LAMBDA (ADDFIXITEM ELEMENTTYPES) (* rrb "19-Nov-85 13:25")
(* returns a list of the items that are in the sketch
command menu.)
(APPEND [QUOTE ((Delete SK.DELETE.ELT "Deletes one or more elements from the sketch."
(SUBITEMS ("Delete element(s)" SK.DELETE.ELT
"Deletes one or more elements from the sketch.")
("Delete point" SK.DELETE.KNOT
"Deletes a control point from a wire or curve."]
[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 (COND
((EQ ELEMENTTYPES T)
SKETCH.ELEMENT.TYPE.NAMES)
(T ELEMENTTYPES))
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.")))
(Feedback SK.SET.FEEDBACK.MODE
"Controls the amount of feedback when adding new curves, circles, etc."
(SUBITEMS ("Points only" SK.SET.FEEDBACK.POINT
"Only the control points will be shown when entering elements.")
("Fast figures"
SK.SET.FEEDBACK.VERBOSE
"Wires, circles and ellipses are shown while they are being entered.")
("All figures" SK.SET.FEEDBACK.ALWAYS
"Most elements are shown while they are being entered.
This will be slow for arcs and curves."]
[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."]
(QUOTE ((Put SK.PUT.ON.FILE "saves this sketch on a file")))
(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."])
(CREATE.SKETCHW.COMMANDMENU
[LAMBDA (MENUTITLE ADDFIXITEM ELEMENTTYPES) (* rrb "17-Oct-85 10:50")
(* returns the control menu for a figure window.)
(SKETCH.COMMANDMENU (SKETCH.COMMANDMENU.ITEMS ADDFIXITEM ELEMENTTYPES)
MENUTITLE])
(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])
)
(* fns for dealing with sketch structures)
(DEFINEQ
(SKETCH.CREATE
[LAMBDA ARGS (* rrb " 6-Nov-85 11:16")
(PROG [(SKETCH (create SKETCH
SKETCHNAME ←(AND (GREATERP ARGS 0)
(ARG ARGS 1]
(PUTSKETCHPROP SKETCH (QUOTE SKETCHCONTEXT)
(CREATE.DEFAULT.SKETCH.CONTEXT))
(PUTSKETCHPROP SKETCH (QUOTE VERSION)
SKETCH.VERSION) (* 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 " 5-Nov-85 15:35")
(* retrieves the property of a sketch)
(PROG ((SKETCH (INSURE.SKETCH SKETCH))
SKETCHCONTEXT)
(SETQ 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 " 4-Dec-85 21:26")
(* stores a property on a sketch Returns VALUE.
Knows about the form of a sketch and does value
checking (or should.))
(PROG ((SKETCH (INSURE.SKETCH SKETCH))
SKETCHCONTEXT PLIST)
(SETQ PLIST (fetch (SKETCH SKETCHPROPS) of SKETCH))
(SETQ 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 SKETCHTCELL) of SKETCH
with (CONS VALUE (LAST 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 " 1-Nov-85 09:52")
(* 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 ←(create ARROWHEAD
ARROWTYPE ← SK.DEFAULT.ARROW.TYPE
ARROWANGLE ← SK.DEFAULT.ARROW.ANGLE
ARROWLENGTH ← SK.DEFAULT.ARROW.LENGTH)
SKETCHDASHING ← SK.DEFAULT.DASHING
SKETCHUSEARROWHEAD ← NIL
SKETCHTEXTBOXALIGNMENT ← SK.DEFAULT.TEXTBOX.ALIGNMENT
SKETCHFILLING ←(SK.CREATE.DEFAULT.FILLING)
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 "10-Dec-85 16:41")
(* * 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
(SCALE (WINDOW.SCALE WINDOW))
OLDX ORIGX NEWX NEWY OLDY ORIGY MOVEDMUCHFLG SELITEMS RETURNVAL PREVMOUSEBUTTONS NOW
MIDDLEONLYFLG OPERATION)
[SETQ OPERATION (COND
[COPYMODE (COND
[(TTY.PROCESSP (WINDOWPROP WINDOW (QUOTE PROCESS)))
(* this is not a copy select operation)
(COND
(DELETEMODE (QUOTE MOVE))
(T (QUOTE COPY]
(T (QUOTE COPYSELECT]
(DELETEMODE (QUOTE DELETE))
(T (* keys aren't still down.)
(RETURN] (* create the cache for the elements that allow the
current operation.)
(SETQ HOTSPOTCACHE (SK.HOTSPOT.CACHE.FOR.OPERATION WINDOW OPERATION))
(COND
((NOT (SK.HAS.SOME.HOTSPOTS HOTSPOTCACHE))
(* no items 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 "18-Oct-85 10:13")
(* 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.LOCAL.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 "10-Dec-85 17:07")
(* allows the user to select some elements and changes
them.)
(SK.CHANGE.THING (SK.SELECT.MULTIPLE.ITEMS W T NIL (QUOTE CHANGE))
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 "10-Dec-85 17:08")
(* 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 NIL NIL (QUOTE CHANGE))
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 "20-Nov-85 11:02")
(* changefn for many sketch elements.)
(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))
[ADDPOINT
(* handle this specially because it only works on the
first element.)
(RETURN (LIST (
SK.ADD.KNOT.TO.ELEMENT
(CAR SCRELTS)
CHANGEHOW]
(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])
(READ.POINT.TO.ADD
[LAMBDA (SCRELT SKVIEWER) (* rrb " 6-Dec-85 10:15")
(* asks where a point should be added and where it
should be. Return a list (AfterPt NewPt))
(PROG (AFTERPT NEWPT)
(STATUSPRINT SKVIEWER "Select the point that the new point should follow.")
(OR (SETQ AFTERPT (SK.SELECT.ITEM SKVIEWER NIL (LIST SCRELT)))
(PROGN (CLOSEPROMPTWINDOW SKVIEWER)
(RETURN)))
(STATUSPRINT SKVIEWER "Indicate where the new point should be.")
(SETQ NEWPT (GETSKWPOSITION SKVIEWER POINTREADINGCURSOR))
(CLOSEPROMPTWINDOW SKVIEWER)
(AND NEWPT (RETURN (LIST (GLOBAL.KNOT.FROM.LOCAL AFTERPT SCRELT)
(SK.MAP.INPUT.PT.TO.GLOBAL NEWPT SKVIEWER])
(GLOBAL.KNOT.FROM.LOCAL
[LAMBDA (LOCALKNOT SCRELT) (* rrb "20-Nov-85 11:05")
(* returns the global knot that corresponds to a local
one.)
(for LKNOT in (fetch (SCREENELT HOTSPOTS) of SCRELT) as GKNOT
in (GETSKETCHELEMENTPROP (fetch (SCREENELT GLOBALPART) of SCRELT)
(QUOTE DATA))
when (EQUAL LKNOT LOCALKNOT) do (RETURN GKNOT])
(SK.ADD.KNOT.TO.ELEMENT
[LAMBDA (ELTWITHKNOTS PTS SKW) (* rrb "20-Nov-85 11:06")
(* adds a point to a knot element.
The point (CADR PTS) is added after
(CAR PTS))
(SK.CHANGE.ELEMENT.KNOTS (fetch (SCREENELT GLOBALPART) of ELTWITHKNOTS)
(for KNOT in (GETSKETCHELEMENTPROP (fetch (SCREENELT
GLOBALPART)
of ELTWITHKNOTS)
(QUOTE DATA))
join (COND
((EQUAL KNOT (CAR PTS))
(LIST KNOT (CADR PTS)))
(T (LIST KNOT])
(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)
(* 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 "25-Nov-85 17:46")
(* determines if a global element is in the world
region of a map window.)
(ELT.INSIDE.REGION? GLOBALPART (SKETCH.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 "26-Nov-85 15:50")
(* 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.)
(PROG ((SCRELT (APPLY* (SK.EXPANDFN (fetch (GLOBALPART GTYPE) of GELT))
GELT
(OR (NUMBERP SCALE)
(SKETCHW.SCALE SKSTREAM))
SKSTREAM))
ACTIVEREGION) (* do the ACTIVEREGION which is common to all
elements.)
[AND SCRELT (SETQ ACTIVEREGION (GETSKETCHELEMENTPROP GELT (QUOTE ACTIVEREGION)))
(replace (LOCALPART LOCALHOTREGION) of (fetch (SCREENELT LOCALPART)
of SCRELT)
with (SCALE.REGION ACTIVEREGION (OR (NUMBERP SCALE)
(SKETCHW.SCALE SKSTREAM]
(RETURN SCRELT])
(SKETCH.REGION.VIEWED
[LAMBDA (SKETCHW NEWREGION) (* rrb "25-Nov-85 17:57")
(* returns the region in sketch coordinates of the
area visible in SKETCHW.)
(PROG1 (WINDOWPROP SKETCHW (QUOTE REGION.VIEWED))
(COND
(NEWREGION (PROG (NEWVIEW)
(RETURN (COND
((REGIONP NEWREGION)
(SKETCH.GLOBAL.REGION.ZOOM SKETCHW NEWREGION))
((EQ NEWREGION (QUOTE HOME))
(SKETCH.HOME SKETCHW))
((SETQ NEWVIEW (SKETCH.VIEW.FROM.NAME NEWREGION
SKETCHW))
(SK.MOVE.TO.VIEW SKETCHW NEWVIEW))
(T (\ILLEGAL.ARG NEWREGION])
(SKETCH.VIEW.FROM.NAME
[LAMBDA (VIEWNAME SKETCHW) (* rrb "25-Nov-85 17:55")
(* returns the view structure for a view given its
name.)
(for SAVEDVIEW in (GETSKETCHPROP (INSURE.SKETCH SKETCHW)
(QUOTE VIEWS))
when (EQUAL VIEWNAME (fetch (SKETCHVIEW VIEWNAME) of SAVEDVIEW)) do (RETURN
SAVEDVIEW])
(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])
)
(* put in for backward compatibility. Can be pulled out 6/1/86 rrb.)
(MOVD? (QUOTE SKETCH.REGION.VIEWED)
(QUOTE SK.REGION.VIEWED))
(* fns for deleting things)
(DEFINEQ
(SK.SEL.AND.DELETE
[LAMBDA (W) (* rrb "10-Dec-85 17:08")
(* lets the user select elements and deletes them)
(SK.DELETE.ELEMENT (SK.SELECT.MULTIPLE.ITEMS W T NIL (QUOTE DELETE))
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 ELTSFORHISTORY) (* rrb " 9-Dec-85 11:47")
(* deletes a list of element to a sketch window and
handles propagation to all other figure windows)
(PROG (OLDGELTS)
(OR ELTSTODEL (RETURN))
(SETQ ELTSTODEL (SK.CHECK.WHENDELETEDFN SKETCHW ELTSTODEL))
(* ELTSTODEL is a list of screen elements to delete.)
(OR ELTSTODEL (RETURN))
(SKED.CLEAR.SELECTION SKETCHW)
(SETQ OLDGELTS (for SCRELT in ELTSTODEL collect (fetch (SCREENELT GLOBALPART)
of SCRELT)))
(OR (EQ ELTSFORHISTORY (QUOTE DON'T))
(SK.ADD.HISTEVENT (QUOTE DELETE)
(OR ELTSFORHISTORY OLDGELTS)
SKETCHW))
(for GELT in OLDGELTS do (SK.DELETE.ELEMENT1 GELT SKETCHW))
(RETURN OLDGELTS])
(SK.DELETE.KNOT
[LAMBDA (W) (* rrb "20-Nov-85 09:52")
(* lets the user select a knot in a curve or wire and
deletes it.)
(EVAL.AS.PROCESS (LIST (QUOTE SK.SEL.AND.DELETE.KNOT)
W])
(SK.SEL.AND.DELETE.KNOT
[LAMBDA (W) (* rrb "10-Dec-85 17:03")
(* lets the user select a knot and deletes it.)
(PROG [(KNOTELTS (SUBSET (LOCALSPECS.FROM.VIEWER W)
(FUNCTION (LAMBDA (SCRELT)
(AND (MEMB (fetch (SCREENELT GTYPE) of SCRELT)
(QUOTE (WIRE CLOSEDWIRE OPENCURVE CLOSEDCURVE)))
(NOT (SK.ELEMENT.PROTECTED? (fetch (SCREENELT
GTYPE)
of SCRELT)
(QUOTE CHANGE]
(COND
((NULL KNOTELTS)
(STATUSPRINT W "There are no curve or wire elements to delete points from.")
(RETURN)))
(SK.DELETE.ELEMENT.KNOT (SK.SELECT.ITEM W NIL KNOTELTS)
KNOTELTS W])
(SK.DELETE.ELEMENT.KNOT
[LAMBDA (LOCALKNOT SCRELTS SKW) (* rrb "20-Nov-85 11:02")
(* deletes a knot from a curve or wire element.)
(SKED.CLEAR.SELECTION SKW)
(COND
((NULL LOCALKNOT))
([OR (POSITIONP LOCALKNOT)
(AND (NULL (CDR LOCALKNOT))
(POSITIONP (CAR LOCALKNOT))
(SETQ LOCALKNOT (CAR LOCALKNOT]
(PROG ((SCREENELT (for SKELT in SCRELTS when (MEMBER LOCALKNOT (fetch
(SCREENELT HOTSPOTS)
of SKELT))
do (RETURN SKELT)))
LOCALKNOTS GLOBALKNOT GLOBALKNOTS NEWKNOTS NEWELT CHANGES)
(COND
((NULL SCREENELT)
(RETURN NIL)))
(SETQ GLOBALKNOT (for LKNOT in (SETQ LOCALKNOTS (fetch (SCREENELT HOTSPOTS)
of SCREENELT))
as GKNOT in (SETQ GLOBALKNOTS (GETSKETCHELEMENTPROP
(fetch (SCREENELT GLOBALPART)
of SCREENELT)
(QUOTE DATA)))
when (EQUAL LKNOT LOCALKNOT) do (RETURN GKNOT)))
(OR (SK.CHECK.WHENPOINTDELETEDFN SKW SCREENELT GLOBALKNOT)
(RETURN))
(RETURN (COND
[(SETQ NEWKNOTS (REMOVE GLOBALKNOT GLOBALKNOTS))
(* change the knots and update the element)
(COND
((SETQ NEWELT (SK.CHANGE.ELEMENT.KNOTS (fetch (SCREENELT
GLOBALPART)
of SCREENELT)
NEWKNOTS))
(* make history entry and update screen)
(SK.UPDATE.ELEMENTS (SETQ CHANGES
(CONS (LIST (fetch (SCREENELT
GLOBALPART)
of SCREENELT)
NEWELT)))
SKW)
(SK.ADD.HISTEVENT (QUOTE CHANGE)
CHANGES SKW]
(T (* delete the whole element.)
(SK.DELETE.ELEMENT (CONS SCREENELT)
SKW])
(SK.CHECK.WHENDELETEDFN
[LAMBDA (VIEWER SCRELTS) (* rrb "26-Nov-85 15:50")
(* checks if the sketch has a when deleted fn and if so, creates the list of global elements and interprets the
result. Returns a list of the elements that should be deleted.)
(PROG ((SKETCH (INSURE.SKETCH VIEWER))
RESULT DELETEFN GELTS)
(COND
([NULL (SETQ DELETEFN (GETSKETCHPROP SKETCH (QUOTE WHENDELETEDFN]
(RETURN SCRELTS)))
[SETQ RESULT (APPLY* DELETEFN VIEWER (SETQ GELTS (for ELT in SCRELTS
collect (fetch
(SCREENELT
GLOBALPART)
of ELT]
(COND
((EQ RESULT (QUOTE DON'T))
(RETURN NIL))
((LISTP RESULT)
(RETURN (for SCRELT in SCRELTS as GELT in GELTS when (MEMB GELT RESULT)
collect SCRELT)))
(T (RETURN SCRELTS])
(SK.CHECK.PREEDITFN
[LAMBDA (VIEWER OLDELT) (* rrb " 9-Dec-85 11:52")
(* checks if the sketch has a preedit fn and if so,
calls it)
(PROG ((SKETCH (INSURE.SKETCH VIEWER))
PREEDITFN)
(COND
([NULL (SETQ PREEDITFN (GETSKETCHPROP SKETCH (QUOTE PREEDITFN]
(RETURN T)))
(RETURN (NEQ (APPLY* PREEDITFN VIEWER OLDELT)
(QUOTE DON'T])
(SK.CHECK.WHENEDITEDFN
[LAMBDA (VIEWER OLDELT NEWELT) (* rrb " 9-Dec-85 16:10")
(* checks if the sketch has a preedit fn and if so,
calls it)
(PROG ((SKETCH (INSURE.SKETCH VIEWER))
PREEDITFN)
(COND
([NULL (SETQ PREEDITFN (GETSKETCHPROP SKETCH (QUOTE PREEDITFN]
(RETURN T)))
(RETURN (NEQ (APPLY* PREEDITFN VIEWER OLDELT)
(QUOTE DON'T])
(SK.CHECK.WHENPOINTDELETEDFN
[LAMBDA (VIEWER SCRELT CONTROLPOINT) (* rrb " 6-Dec-85 10:15")
(* checks if the sketch has a when point deleted fn and if so, calls it and interprets the result.
Returns NIL if the point should not be deleted.)
(PROG ((SKETCH (INSURE.SKETCH VIEWER))
RESULT DELETEFN)
(COND
([NULL (SETQ DELETEFN (GETSKETCHPROP SKETCH (QUOTE WHENPOINTDELETEDFN]
(RETURN SCRELT)))
(SETQ RESULT (APPLY* DELETEFN VIEWER (fetch (SCREENELT GLOBALPART) of SCRELT)
CONTROLPOINT))
(COND
((EQ RESULT (QUOTE DON'T))
(RETURN NIL))
(T (RETURN SCRELT])
(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 "10-Dec-85 17:08")
(* lets the user select elements and copies them.)
(SK.COPY.ELEMENTS (SK.SELECT.MULTIPLE.ITEMS W T NIL (QUOTE COPY))
W])
(SK.COPY.ELEMENTS
[LAMBDA (SCRELTS SKW) (* rrb " 6-Nov-85 11:34")
(* create a bitmap of the thing being moved and get
its new position. Then translate all the pieces.)
(AND SCRELTS (PROG (FIGINFO FIRSTHOTSPOT LOWLFT NEWPOS DELTAPOS NEWELTS COPYFN X SKETCH
COPYARGS) (* call PRECOPYFN.)
[AND (SETQ COPYFN (GETSKETCHPROP (SETQ SKETCH (INSURE.SKETCH
SKW))
(QUOTE PRECOPYFN)))
(SETQ NEWPOS (APPLY* COPYFN SKW (SETQ COPYARGS (
SK.GLOBAL.FROM.LOCAL.ELEMENTS
SCRELTS]
[COND
((EQ DELTAPOS (QUOTE DON'T))
(RETURN))
((POSITIONP DELTAPOS) (* value returned is the delta by which to move the
point. Set up new position)
NIL)
(T (* read new position from the user)
(SETQ FIGINFO (SK.FIGUREIMAGE SCRELTS (DSPCLIPPINGREGION NIL
SKW)))
(SETQ LOWLFT (fetch (SKFIGUREIMAGE SKFIGURE.LOWERLEFT)
of FIGINFO))
[SETQ FIRSTHOTSPOT (CAR (fetch (SCREENELT HOTSPOTS)
of (CAR SCRELTS]
(* move the image by the first hotspot of the first
element chosen. This will align the image on the grid
correctly.)
(COND
((SETQ NEWPOS (SK.MAP.INPUT.PT.TO.GLOBAL
[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]
SKW))
(CLRPROMPT))
(T (STATUSPRINT SKW
"Position was outside the window. Copy not placed.")
(RETURN NIL)))
(SETQ DELTAPOS (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]
(AND (SETQ COPYFN (GETSKETCHPROP (SETQ SKETCH (INSURE.SKETCH
SKW))
(QUOTE WHENCOPIEDFN)))
(SETQ X (APPLY* COPYFN SKW (OR COPYARGS (
SK.GLOBAL.FROM.LOCAL.ELEMENTS
SCRELTS))
DELTAPOS)))
(COND
((EQ X (QUOTE DON'T))
(RETURN))
((POSITIONP X) (* value returned is the position to put the copy.
Set up new position)
(SETQ DELTAPOS X)))
[SETQ NEWELTS (COND
((AND X (EVERY X (FUNCTION GLOBALELEMENTP)))
(* value returns was a list of new global elements.)
X)
(T (MAPCOLLECTSKETCHSPECS SCRELTS (FUNCTION SK.COPY.ITEM)
DELTAPOS SKW]
(* add new elements to history list.)
(SK.ADD.ELEMENTS NEWELTS SKW)
(SK.ADD.HISTEVENT (QUOTE COPY)
NEWELTS SKW])
(SK.GLOBAL.FROM.LOCAL.ELEMENTS
[LAMBDA (SCRELTS) (* returns the global elements from a list of screen
elements)
(FOR SCRELT IN SCRELTS COLLECT (FETCH (SCREENELT GLOBALPART) OF SCRELT])
(SK.COPY.ITEM
[LAMBDA (SELELT GLOBALDELTAPOS W) (* rrb " 6-Nov-85 11:05")
(* SELELT is a sketch element that was selected for a copy operation. GLOBALDELTAPOS is the amount the new item is
to be offset from the old.)
(PROG ((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]
(RETURN (SK.TRANSLATE.GLOBALPART OLDGLOBAL GLOBALDELTAPOS])
(SK.INSERT.SKETCH
[LAMBDA (W SKETCH REGION SCALE) (* rrb " 6-Nov-85 11:04")
(* * 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.ELEMENTS NEWELTS 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 "10-Dec-85 17:06")
(* 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 NIL (QUOTE MOVE)))
(T (SK.SELECT.MULTIPLE.ITEMS W (NULL PTFLG)
NIL
(QUOTE MOVE]
W])
(SK.MOVE.ELEMENTS
[LAMBDA (SCRELTS SKW) (* rrb "11-Dec-85 11:51")
(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 ((SKETCHELTS (SK.ELTS.FROM.HOTSPOT SCRELTS (SK.HOTSPOT.CACHE SKW)))
SKETCHELT OTHERHOTSPOTS NEWPOS MOVEFN GDELTAPOS X MOVEARGS SKETCH)
(COND
((NULL SKETCHELTS)
(RETURN NIL))
([NULL (SETQ SKETCHELT (for SCRELT in SKETCHELTS
when (NOT (SK.ELEMENT.PROTECTED?
(fetch (SCREENELT GLOBALPART)
of SCRELT)
(QUOTE MOVE)))
do (RETURN SCRELT]
(* only protected elements at this point, shouldn't
happen but don't cause an error.)
(RETURN NIL)))
[COND
([NULL (SETQ OTHERHOTSPOTS (REMOVE SCRELTS (fetch (SCREENELT HOTSPOTS)
of SKETCHELT]
(* only one control point, move it with the move
element function.)
(RETURN (SK.MOVE.ELEMENTS (LIST SKETCHELT)
SKW] (* call sketch premovefn if given.)
[AND (SETQ MOVEFN (GETSKETCHPROP (SETQ SKETCH (INSURE.SKETCH SKW))
(QUOTE PREMOVEFN)))
(SETQ GDELTAPOS (APPLY* MOVEFN SKW (SETQ MOVEARGS (
SK.MAKE.ELEMENT.MOVE.ARG SKETCHELT SCRELTS]
[COND
((EQ GDELTAPOS (QUOTE DON'T))
(RETURN))
((POSITIONP GDELTAPOS) (* value returned is the delta by which to move the
point. Set up new position)
NIL)
(T (* read new position from the user)
(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))
(* if user selected outside, don't move anything.)
(OR NEWPOS (RETURN NIL)) (* 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 NEWPOS))
(fetch (POSITION XCOORD) of SCRELTS))
YCOORD ←(IDIFFERENCE (fetch (POSITION YCOORD)
of (fetch (INPUTPT INPUT.POSITION)
of NEWPOS))
(fetch (POSITION YCOORD) of SCRELTS)))
(WINDOW.SCALE SKW]
(AND (SETQ MOVEFN (GETSKETCHPROP SKETCH (QUOTE MOVEFN)))
(SETQ X (APPLY* MOVEFN SKW (OR MOVEARGS (SK.MAKE.ELEMENT.MOVE.ARG
SKETCHELT SCRELTS))
GDELTAPOS)))
(COND
((EQ X (QUOTE DON'T))
(RETURN))
((POSITIONP X) (* value returned is the delta by which to move the
point. Set up new position)
(SETQ GDELTAPOS X)))
(RETURN (SK.MOVE.THING SKETCHELT SCRELTS GDELTAPOS SKW]
(T (* create a bitmap of the thing being moved and get
its new position. Then translate all the pieces.)
(PROG (FIGINFO FIRSTHOTSPOT NEWPOS LOWLFT IMAGEPOSX IMAGEPOSY IMAGEBM DELTAPOS CHANGES
MOVEFN X GDELTAPOS)
[AND (SETQ MOVEFN (GETSKETCHPROP (INSURE.SKETCH SKW)
(QUOTE PREMOVEFN)))
(SETQ GDELTAPOS (APPLY* MOVEFN SKW (SK.MAKE.ELEMENTS.MOVE.ARG SCRELTS]
[COND
((EQ GDELTAPOS (QUOTE DON'T))
(RETURN))
((POSITIONP GDELTAPOS) (* value returned is the delta by which to move the
point. Set up new position)
NIL)
(T (* read new position from the user)
(SETQ FIGINFO (SK.FIGUREIMAGE SCRELTS (DSPCLIPPINGREGION NIL SKW)))
[SETQ FIRSTHOTSPOT (CAR (fetch (SCREENELT HOTSPOTS) of (CAR SCRELTS]
(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.)
(* calculate the delta that the selected point moves.)
(SETQ GDELTAPOS (SK.MAP.FROM.WINDOW.TO.NEAREST.GRID
[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]
(WINDOW.SCALE SKW]
(SKETCH.MOVE.ELEMENTS (for ELT in SCRELTS collect (fetch (SCREENELT
GLOBALPART)
of ELT))
GDELTAPOS SKW T)
(* I started noticing cases where the image was a point off on some lines and where the texture alignment was off
so I removed this (COND ((AND DELTAPOS (NOT (POSITIONP X))) (* If the user was asked for a new position and the
movefn didn't change it, 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))))
(CLOSEPROMPTWINDOW SKW])
(SKETCH.MOVE.ELEMENTS
[LAMBDA (ELEMENTS DELTA SKETCHTOUPDATE ADDHISTORY?) (* rrb " 4-Dec-85 21:48")
(* moves the elements ELEMENTS by the amount of position DELTA (XCOORD gives x amount, YCOORD gives y delta) and
updates the viewers on SKETCHTOUPDATE if it is given.)
(PROG (X MOVEFN NEWGLOBALS SKETCH GDELTAPOS VIEWER)
(OR (POSITIONP DELTA)
(\ILLEGAL.ARG DELTA))
[AND SKETCHTOUPDATE (SETQ SKETCH (INSURE.SKETCH SKETCHTOUPDATE))
(SETQ VIEWER (OR (WINDOWP SKETCHTOUPDATE)
(CAR (ALL.SKETCH.VIEWERS SKETCH]
(COND
[[AND SKETCH (SETQ MOVEFN (GETSKETCHPROP SKETCH (QUOTE MOVEFN]
(* call the MOVEFN if any Pass the thing the user
passed in if you can't find a viewer.)
(COND
((EQ (SETQ X (APPLY* MOVEFN VIEWER (for ELT in ELEMENTS
collect (CONS T ELT))
DELTA))
(QUOTE DON'T))
(RETURN))
((POSITIONP X) (* value returned is the delta by which to move the
point. Set up new position)
(SETQ GDELTAPOS X))
(T (SETQ GDELTAPOS DELTA]
(T (SETQ GDELTAPOS DELTA)))
(SETQ NEWGLOBALS (MAPGLOBALSKETCHSPECS ELEMENTS (FUNCTION SK.TRANSLATE.ELEMENT)
GDELTAPOS VIEWER))
(AND ADDHISTORY? (SK.ADD.HISTEVENT (QUOTE MOVE)
(for NEWG in NEWGLOBALS as OLDG
in ELEMENTS when NEWG
collect (LIST OLDG NEWG))
VIEWER])
(SK.TRANSLATE.ELEMENT
[LAMBDA (GELT GLOBALDELTAPOS W) (* rrb " 4-Dec-85 19:58")
(* * GELT is a sketch element to be moved. GLOBALDELTAPOS is the amount the item is to be translated.)
(PROG (NEWGLOBAL)
(COND
((SETQ NEWGLOBAL (SK.TRANSLATE.GLOBALPART GELT GLOBALDELTAPOS))
(SK.UPDATE.ELEMENT GELT NEWGLOBAL W T)
(RETURN NEWGLOBAL])
(SK.MAKE.ELEMENT.MOVE.ARG
[LAMBDA (SCRELT SELPOS) (* rrb " 5-Nov-85 14:35")
(* makes an argument structure that is suitable to be passed to the sketch movefn. This is a list whose CAR is a
list of the numbers of the control points being moved and whose CDR is the global sketch element.)
(CONS (CONS (for I from 1 as PT in (fetch (SCREENELT HOTSPOTS) of SCRELT)
when (EQUAL PT SELPOS) do (RETURN I)))
(fetch (SCREENELT GLOBALPART) of SCRELT])
(SK.MAKE.ELEMENTS.MOVE.ARG
[LAMBDA (SCRELTS) (* rrb " 5-Nov-85 14:34")
(* makes an argument structure that is suitable to be passed to the sketch movefn. This is a list whose CAR is a
list of the numbers of the control points being moved which is in this case T and whose CDR is the global sketch
element.)
(CONS T (for SCRELT in SCRELTS collect (fetch (SCREENELT GLOBALPART) of SCRELT])
(SK.MAKE.POINTS.AND.ELEMENTS.MOVE.ARG
[LAMBDA (SCRELTS SELPTS) (* rrb " 5-Nov-85 15:14")
(* makes an argument structure that is suitable to be passed to the sketch movefn. This is a list of lists each of
whose CAR is a list of the numbers of the control points being moved and whose CDR is the global sketch element.)
(for SCRELT in SCRELTS collect (CONS [CONS (bind NOTALL for I from 1
as PT in (fetch (SCREENELT HOTSPOTS)
of SCRELT)
when (COND
((MEMBER PT SELPTS))
(T (SETQ NOTALL T)
NIL))
collect I finally
(OR NOTALL (RETURN
T]
(fetch (SCREENELT GLOBALPART) of SCRELT])
(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 (SKETCHELT LOCALPT GDELTAPOS SKW) (* rrb " 5-Nov-85 12:23")
(* moves a control point in a sketch element.)
(PROG (OLDGLOBAL NEWGLOBAL) (* calculate the delta that the selected point moves.)
(SETQ NEWGLOBAL (SK.TRANSLATE.POINTS (LIST LOCALPT)
GDELTAPOS SKETCHELT SKW))
(* moving a piece of an element.)
(SK.UPDATE.ELEMENT (SETQ OLDGLOBAL (fetch (SCREENELT GLOBALPART) of SKETCHELT))
NEWGLOBAL SKW)
(SK.ADD.HISTEVENT (QUOTE MOVE)
(LIST (LIST OLDGLOBAL NEWGLOBAL))
SKW)
(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 "10-Dec-85 11:00")
(* 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)))
[[AND (EQUAL OLDGELT NEWGELT)
(NOT (MEMB (fetch (GLOBALPART GTYPE) of OLDGELT)
(QUOTE (TEXT TEXTBOX]
(* text and textbox are special because interactive editing reuses the same element after the first character but
they need to use updatefns for speed.)
(* 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]
((NOT (MEMB NEWGELT (SKETCH.ELEMENTS.OF.SKETCH SKETCHW)))
(* this element isn't a member of this sketch, quit)
(RETURN)))
(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 "17-Oct-85 11:11")
(* * 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 " 5-Nov-85 15:30")
(* 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 MOVEFN X MOVEARGS SKETCH GDELTAPOS)
[AND (SETQ MOVEFN (GETSKETCHPROP (SETQ SKETCH (INSURE.SKETCH SKW))
(QUOTE PREMOVEFN)))
(SETQ GDELTAPOS (APPLY* MOVEFN SKW (SETQ MOVEARGS (
SK.MAKE.POINTS.AND.ELEMENTS.MOVE.ARG
SCRELTS SCRPTS]
(COND
((EQ GDELTAPOS (QUOTE DON'T))
(RETURN))
((POSITIONP GDELTAPOS) (* value returned is the delta by which to move the
point. Set up new position)
NIL)
(T (* read new position from the user)
(* 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.LOCAL.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 GDELTAPOS (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)))
(WINDOW.SCALE SKW))) (* calculate the delta that the selected point moves.)
))
(AND (SETQ MOVEFN (GETSKETCHPROP SKETCH (QUOTE MOVEFN)))
(SETQ X (APPLY* MOVEFN SKW (OR MOVEARGS (SK.MAKE.ELEMENTS.MOVE.ARG
SCRELTS))
GDELTAPOS)))
(COND
((EQ X (QUOTE DON'T))
(RETURN))
((POSITIONP X) (* value returned is the delta by which to move the
point. Set up new position)
(SETQ GDELTAPOS X)))
(SETQ NEWGLOBALS (MAPCOLLECTSKETCHSPECS SCRELTS (FUNCTION
SK.MOVE.ITEM.POINTS)
GDELTAPOS 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 "10-Dec-85 16:41")
(* * 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
[(SK.HAS.SOME.HOTSPOTS (SETQ HOTSPOTCACHE (SK.HOTSPOT.CACHE.FOR.OPERATION
SKW
(QUOTE MOVE]
(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 " 6-Nov-85 09:54")
(* interacts to get whether move mode should be
points, elements or both.)
(\CURSOR.IN.MIDDLE.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
(SKETCH.CREATE.GROUP
[LAMBDA (LISTOFSKETCHELEMENTS CONTROLPOINT) (* rrb " 4-Dec-85 21:38")
(* creates a sketch group element.)
(SK.CREATE.GROUP1 LISTOFSKETCHELEMENTS (OR (POSITIONP CONTROLPOINT)
(REGION.CENTER (
SK.GLOBAL.REGION.OF.GLOBAL.ELEMENTS
LISTOFSKETCHELEMENTS])
(SK.CREATE.GROUP1
[LAMBDA (GELTS CONTROLPT) (* rrb " 4-Dec-85 21:38")
(* creates a group element.)
(SK.UPDATE.GROUP.AFTER.CHANGE (create GLOBALPART
INDIVIDUALGLOBALPART ←(create GROUP
LISTOFGLOBALELTS ←
GELTS
GROUPCONTROLPOINT ←
CONTROLPT])
(SK.UPDATE.GROUP.AFTER.CHANGE
[LAMBDA (GROUPELT) (* rrb " 4-Dec-85 21:38")
(* updates the dependent field of a group element
after a change.)
(PROG ((INDGROUPELT (fetch (GLOBALPART INDIVIDUALGLOBALPART) of GROUPELT))
GROUPREGION)
(SETQ GROUPREGION (SK.GLOBAL.REGION.OF.GLOBAL.ELEMENTS (fetch (GROUP
LISTOFGLOBALELTS)
of INDGROUPELT)))
(replace (GROUP GROUPREGION) of INDGROUPELT with GROUPREGION)
(* use same scales as a box would.)
(BOX.SET.SCALES GROUPREGION GROUPELT)
(RETURN GROUPELT])
(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 "10-Dec-85 17:08")
(* lets the user select elements and groups them.)
(SK.GROUP.ELEMENTS (SK.SELECT.MULTIPLE.ITEMS W T NIL (QUOTE GROUP))
W])
(SK.GROUP.ELEMENTS
[LAMBDA (SCRELTS SKW) (* rrb "10-Dec-85 17:23")
(* 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 GROUPFN X (SCALE (WINDOW.SCALE SKW)))
(* call the group fn if there is one.)
[AND (SETQ GROUPFN (GETSKETCHPROP (INSURE.SKETCH SKW)
(QUOTE WHENGROUPEDFN)))
(SETQ X (APPLY* GROUPFN SKW (SK.GLOBAL.FROM.LOCAL.ELEMENTS
SCRELTS]
(COND
((EQ X (QUOTE DON'T))
(RETURN)))
(SETQ GROUPREGION (SK.GLOBAL.REGION.OF.LOCAL.ELEMENTS SCRELTS SCALE))
(SETQ GELTS (for SCRELT in SCRELTS collect (fetch (SCREENELT
GLOBALPART)
of SCRELT)))
(SETQ GROUPELT (SKETCH.CREATE.GROUP GELTS (MAP.GLOBAL.PT.ONTO.GRID
(REGION.CENTER GROUPREGION)
SKW)))
(* do grouping.)
(SK.DO.GROUP GROUPELT GELTS SKW)
(* record it on the history list.)
(SK.ADD.HISTEVENT (QUOTE GROUP)
(LIST (LIST GROUPELT GELTS))
SKW)
(RETURN GROUPELT])
(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 "10-Dec-85 18:03")
(* lets the user select elements and groups them.)
(PROG NIL
(RETURN (SK.UNGROUP.ELEMENT
[SK.SELECT.MULTIPLE.ITEMS
W T (COND
[(SUBSET (LOCALSPECS.FROM.VIEWER W)
(FUNCTION (LAMBDA (SCRELT)
(AND (EQ (fetch (SCREENELT GTYPE) of SCRELT)
(QUOTE GROUP))
(NOT (SK.ELEMENT.PROTECTED?
(fetch (SCREENELT GLOBALPART)
of SCRELT)
(QUOTE UNGROUP]
(T (* no group elements)
(STATUSPRINT W "There are no grouped elements to ungroup.")
(RETURN]
W])
(SK.UNGROUP.ELEMENT
[LAMBDA (SCRELTS SKW) (* rrb "10-Dec-85 17:35")
(* ungroups the first group element in SCRELTS.)
(PROG ((GROUPELTS (for ELT in SCRELTS when (EQ (fetch (SCREENELT GTYPE) of ELT)
(QUOTE GROUP))
collect (fetch (SCREENELT GLOBALPART) of ELT)))
GELTS UNGROUPFN LSTOFSUBELTS)
(OR GROUPELTS (RETURN))
[SETQ LSTOFSUBELTS (for GROUPELT in GROUPELTS
collect (COND
((AND (SETQ UNGROUPFN (GETSKETCHPROP
(INSURE.SKETCH SKW)
(QUOTE WHENUNGROUPED)))
(EQ (APPLY* UNGROUPFN SKW GROUPELT)
(QUOTE DON'T)))
(* call the ungroup fn if there is one.)
NIL)
(T (SETQ GELTS (fetch (GROUP LISTOFGLOBALELTS)
of (fetch (GLOBALPART
INDIVIDUALGLOBALPART)
of GROUPELT)))
(SK.DO.UNGROUP GROUPELT GELTS SKW)
GELTS]
(SK.ADD.HISTEVENT (QUOTE UNGROUP)
(for GROUPELT in GROUPELTS as SUBELTS in LSTOFSUBELTS
when LSTOFSUBELTS collect (LIST GROUPELT SUBELTS))
SKW])
(SK.GLOBAL.REGION.OF.LOCAL.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.GLOBAL.ELEMENTS
[LAMBDA (GELTS) (* rrb "19-Oct-85 13:00")
(* returns the global region occuppied by a list of
global elements.)
(PROG (GROUPREGION)
[for GELT in GELTS do (SETQ GROUPREGION (COND
(GROUPREGION (* first time because UNIONREGIONS doesn't handle NIL)
(UNIONREGIONS GROUPREGION (
SK.ELEMENT.GLOBAL.REGION
GELT)))
(T (SK.ELEMENT.GLOBAL.REGION GELT]
(RETURN GROUPREGION])
(SKETCH.REGION.OF.SKETCH
[LAMBDA (SKETCH) (* rrb "23-Oct-85 11:17")
(* returns the global region of a sketch.)
(SK.GLOBAL.REGION.OF.GLOBAL.ELEMENTS (fetch (SKETCH SKETCHELTS) of (INSURE.SKETCH SKETCH])
(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 "18-Oct-85 17:15")
(* 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
(FUNCTION GROUP.GLOBALREGIONFN])
(GROUP.DRAWFN
[LAMBDA (GROUPELT WINDOW REGION OPERATION) (* rrb "10-Dec-85 12:38")
(* 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 "10-Dec-85 12:37")
(* 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-Dec-85 12:38")
(* returns the region occuppied by a group)
(fetch (LOCALGROUP LOCALGROUPREGION) of (fetch (SCREENELT LOCALPART) of GROUPSCRELT])
(GROUP.GLOBALREGIONFN
[LAMBDA (GGROUPELT) (* rrb "18-Oct-85 17:13")
(* returns the global region occupied by a global
group element.)
(fetch (GROUP GROUPREGION) of (fetch (GLOBALPART INDIVIDUALGLOBALPART) of GGROUPELT])
(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 " 6-Nov-85 09:56")
(* reads how the user wants to change a textbox.)
(PROG (ASPECT HOW)
(SETQ HOW (SELECTQ (SETQ ASPECT
(\CURSOR.IN.MIDDLE.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)
LOCALHOTREGION LOCALGROUPREGION LOCALELEMENTS))
]
(* history and undo stuff for groups)
(DEFINEQ
(SK.DO.GROUP
[LAMBDA (GROUPELT GELTS SKW) (* rrb "10-Dec-85 12:38")
(* 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 "10-Dec-85 17:50")
(* undoes a group event)
(for GRP in EVENTARGS do (SK.DO.UNGROUP (CAR GRP)
(CADR GRP)
SKW))
T])
(SK.UNGROUP.UNDO
[LAMBDA (EVENTARGS SKW) (* rrb "10-Dec-85 17:50")
(* undoes a ungroup event)
(for GRP in EVENTARGS do (SK.DO.GROUP (CAR GRP)
(CADR GRP)
SKW))
T])
)
(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 "10-Dec-85 17:25")
(* 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 NIL (QUOTE MOVE))
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-Oct-85 17:35")
(* * returns ELT? if it is a global sketch element.)
(AND (SKETCH.ELEMENT.NAMEP (fetch (GLOBALPART GTYPE) of (LISTP 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 "10-Dec-85 17:26")
(* 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 NIL (QUOTE MOVE))
(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 "10-Dec-85 17:26")
(* 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 NIL (QUOTE MOVE))
(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 "10-Dec-85 17:26")
(* 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 NIL (QUOTE
COPY))
(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 "10-Dec-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 NIL (QUOTE
COPY))
(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 " 9-Dec-85 14:36")
(* 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 (COND
((NULL SKETCH)
(SKETCH.CREATE NIL))
(T (INSURE.SKETCH SKETCH]
(COND
((NULL ELEMENT)
(RETURN SKSTRUC))
((NOT (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 SKSTRUC])
(SKETCH.DELETE.ELEMENT
[LAMBDA (ELEMENT SKETCH INSIDEGROUPSFLG NODISPLAYFLG) (* rrb "19-Oct-85 17:09")
(* 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.IMAGEOBJ.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 "23-Oct-85 11:24")
(* returns the SKETCH structure from a window, sketch
stream, or a structure.)
(SK.CHECK.SKETCH.VERSION (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]
[(type? IMAGEOBJ SK)
(PROG [(SK? (fetch (SKETCHIMAGEOBJ SKIO.SKETCH)
of (LISTP (IMAGEOBJPROP SK (QUOTE
OBJECTDATUM]
(RETURN (COND
((type? SKETCH SK?)
SK?)
(NOERRORFLG NIL)
(T (ERROR "not a sketch image object" 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])
)
(* 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 OPERATION) (* rrb "10-Dec-85 17:01")
(* 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)))
[(SK.HAS.SOME.HOTSPOTS (SETQ HOTSPOTCACHE (SK.HOTSPOT.CACHE.FOR.OPERATION WINDOW
OPERATION]
(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.HOTSPOT.CACHE.FOR.OPERATION
[LAMBDA (VIEWER OPERATION) (* rrb "10-Dec-85 16:59")
(* returns the hotspot cache for the elements in a
viewer that are not protected against OPERATION.)
(PROG (SCRELTS)
(RETURN (COND
((AND OPERATION (bind PROTECTION for SCRELT in (SETQ SCRELTS
(
LOCALSPECS.FROM.VIEWER
VIEWER))
thereis (* look for any element that disallows the current
operation)
(SK.ELEMENT.PROTECTED? (fetch
(SCREENELT
GLOBALPART)
of SCRELT)
OPERATION)))
(* compute special cache)
(SK.BUILD.CACHE SCRELTS OPERATION))
(T (* use the cache of all elements.)
(SK.HOTSPOT.CACHE VIEWER])
(SK.BUILD.CACHE
[LAMBDA (SCRELTS SKETCHOP) (* rrb "11-Dec-85 11:10")
(* Builds a cache of the elements in SCRELTS that
aren't protected against SKETCHOP.)
(PROG (CACHE)
(for ELT in SCRELTS when (NOT (SK.ELEMENT.PROTECTED? (fetch (SCREENELT
GLOBALPART)
of ELT)
SKETCHOP))
do (SETQ CACHE (SK.ADD.HOTSPOTS.TO.CACHE1 ELT CACHE)))
(RETURN CACHE])
(SK.ELEMENT.PROTECTED?
[LAMBDA (GELT HOW) (* rrb " 5-Dec-85 11:16")
(* determines if GELT is protected against the
operation HOW)
(PROG [(PROTECTIONLST (GETSKETCHELEMENTPROP GELT (QUOTE PROTECTION]
(RETURN (OR (EQMEMB HOW PROTECTIONLST)
(AND (NEQ HOW (QUOTE COPYSELECT))
(OR (EQMEMB T PROTECTIONLST)
(EQMEMB (QUOTE FROZEN)
PROTECTIONLST])
(SK.HAS.SOME.HOTSPOTS
[LAMBDA (HOTSPOTCACHE) (* rrb "17-Oct-85 11:18")
(* return T if there is a selectable point in
HOTSPOTCACHE.)
(for BUCKET in HOTSPOTCACHE when (SOME (CDR BUCKET)
(FUNCTION CDR))
do (RETURN T])
(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 " 4-Dec-85 21:27")
(* * 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 [SKETCH.CREATE (QUOTE DUMMYNAME)
(QUOTE ELEMENTS)
(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.ELEMENT.GLOBAL.REGION
[LAMBDA (GELT) (* rrb "18-Oct-85 10:30")
(* GELT is a global sketch element This function
returns the global region it occupies.)
(PROG [(REGIONFN (SK.GLOBAL.REGIONFN (fetch (GLOBALPART GTYPE) of GELT]
(RETURN (COND
((OR (NULL REGIONFN)
(EQ REGIONFN (QUOTE NILL)))
NIL)
((APPLY* REGIONFN GELT])
(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.GLOBAL.REGIONFN
[LAMBDA (ELEMENTTYPE) (* rrb "18-Oct-85 10:30")
(* * access fn for getting the function that returns the global region of a global sketch element from its type.)
(fetch (SKETCHTYPE GLOBALREGIONFN) 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 OPERATION) (* rrb "10-Dec-85 17:34")
(* * 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
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)))
[(AND (SETQ SELECTABLEITEMS (LOCALSPECS.FROM.VIEWER WINDOW))
(SK.HAS.SOME.HOTSPOTS (SETQ HOTSPOTCACHE (SK.HOTSPOT.CACHE.FOR.OPERATION
WINDOW OPERATION]
(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 "26-Nov-85 15:51")
(* 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 ACTIVEREGION)
(RETURN (COND
((OR (NULL TRANSLATEFN)
(EQ TRANSLATEFN (QUOTE NILL)))
(* if can't translate, return the same thing.
This is probably an error condition.)
GLOBALELT)
((SETQ NEWGLOBAL (APPLY* TRANSLATEFN GLOBALELT DELTAPOS))
[COND
([AND (SETQ ACTIVEREGION (GETSKETCHELEMENTPROP NEWGLOBAL
(QUOTE
ACTIVEREGION)))
(EQUAL ACTIVEREGION (GETSKETCHELEMENTPROP GLOBALELT
(QUOTE
ACTIVEREGION]
(* update the ACTIVEREGION if the element has one and
it is the same in the new element.)
(* copy the property list so that undoing works)
(SK.COPY.ELEMENT.PROPERTY.LIST NEWGLOBAL)
(PUTSKETCHELEMENTPROP NEWGLOBAL (QUOTE ACTIVEREGION)
(REL.MOVE.REGION ACTIVEREGION
(fetch (POSITION XCOORD)
of DELTAPOS)
(fetch (POSITION YCOORD)
of DELTAPOS]
NEWGLOBAL)
(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])
)
(* stuff for setting feedback amount)
(DEFINEQ
(SK.SET.FEEDBACK.MODE
[LAMBDA (VALUE) (* rrb "19-Nov-85 13:25")
(* sets the control on how much feedback to give the
user as they are entering new figure elements.)
[OR (MEMB VALUE (QUOTE (POINTS T ALWAYS)))
(SETQ VALUE (\CURSOR.IN.MIDDLE.MENU (create MENU
ITEMS ←(QUOTE (("Points only"
(QUOTE POINTS)
"Only the control points will be shown when entering elements.")
("Fast figures" T
"Wires, circles and ellipses are shown while they are being entered.")
("All figures"
(QUOTE ALWAYS)
"Most elements are shown while they are being entered.
This will be slow for arcs and curves.")))
CENTERFLG ← T]
(AND VALUE (SETQ SKETCH.VERBOSE.FEEDBACK (SELECTQ VALUE
(POINTS NIL)
VALUE])
(SK.SET.FEEDBACK.POINT
[LAMBDA NIL (* sets the feedback to points only)
(SK.SET.FEEDBACK.MODE (QUOTE POINTS])
(SK.SET.FEEDBACK.VERBOSE
[LAMBDA NIL (* sets the feedback to provide images on elements
that are fast.)
(SK.SET.FEEDBACK.MODE T])
(SK.SET.FEEDBACK.ALWAYS
[LAMBDA NIL (* sets the feedback to give images on all figures.)
(SK.SET.FEEDBACK.MODE (QUOTE ALWAYS])
)
(RPAQQ SKETCH.VERBOSE.FEEDBACK T)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS SKETCH.VERBOSE.FEEDBACK)
)
(* 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 "25-Nov-85 17:46")
(* 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 (SKETCH.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 "25-Nov-85 17:46")
(* 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 (SKETCH.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 "12-Nov-85 16:00")
(* moves the viewing region of a window to be over
NEWREGION which is in sketch coordinates.)
(PROG (WIDTHSCALE HEIGHTSCALE NEWSCALE NEWLEFT NEWSCALE (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)
(SETQ NEWSCALE HEIGHTSCALE))
(T (SETQ NEWSCALE WIDTHSCALE))) (* center the extra width)
(SETQ NEWLEFT (FIXR (FQUOTIENT (DIFFERENCE
(fetch (REGION LEFT) of NEWREGION)
(QUOTIENT (DIFFERENCE
(TIMES (fetch (REGION WIDTH)
of WINDOWREG)
NEWSCALE)
(fetch (REGION WIDTH)
of NEWREGION))
2))
NEWSCALE)))
(* center the extra height)
(SETQ NEWBOTTOM (FIXR (FQUOTIENT (DIFFERENCE
(fetch (REGION BOTTOM) of NEWREGION)
(QUOTIENT (DIFFERENCE
(TIMES (fetch (REGION HEIGHT)
of WINDOWREG)
NEWSCALE)
(fetch (REGION HEIGHT)
of NEWREGION))
2))
NEWSCALE)))
(COND
[(EQUAL OLDSCALE NEWSCALE) (* scale hasn't changed, just scroll)
(RETURN (SKETCHW.SCROLLFN SKETCHW (DIFFERENCE NEWLEFT (fetch (REGION LEFT)
of WINDOWREG))
(DIFFERENCE NEWBOTTOM (fetch (REGION BOTTOM)
of WINDOWREG]
(T (WINDOWPROP SKETCHW (QUOTE SCALE)
NEWSCALE)
(ABSWXOFFSET NEWLEFT SKETCHW)
(ABSWYOFFSET NEWBOTTOM 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"
"N@@G"
"N@@G"
"I@@I"
"HHAA"
"HDBA"
"@BD@"
"@@@@"
"@@@@"
"@BD@"
"HDBA"
"HHAA"
"I@@I"
"N@@G"
"N@@G"
"OLCO")} 7 . 8) ({(READBITMAP)(16 16
"H@@A"
"DBDB"
"BBDD"
"ABDH"
"@NG@"
"@NG@"
"GNGN"
"@@@@"
"@@@@"
"GNGN"
"@NG@"
"@NG@"
"ABDH"
"BBDD"
"DBDB"
"H@@A")} 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 "23-Oct-85 10:44")
(* 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 (SKETCH.REGION.OF.SKETCH SKETCH])
(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 "25-Nov-85 17:46")
(* 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
(SKETCH.REGION.VIEWED SKW]
(STATUSPRINT SKW " ... done."])
(SKETCH.ADD.VIEW
[LAMBDA (SKETCH NAME SCALE CENTERPOSITION) (* rrb "25-Nov-85 18:27")
(* Adds a view to SKETCH.)
(PROG ((SKETCH (INSURE.SKETCH SKETCH)))
(COND
(NAME (PUTSKETCHPROP SKETCH (QUOTE VIEWS)
(APPEND (GETSKETCHPROP SKETCH (QUOTE VIEWS))
(CONS (create SKETCHVIEW
VIEWNAME ← NAME
VIEWSCALE ←(OR (NUMBERP SCALE)
(\ILLEGAL.ARG
SCALE))
VIEWPOSITION ←(OR (POSITIONP
CENTERPOSITION)
(\ILLEGAL.ARG
CENTERPOSITION]
)
(SK.RESTORE.VIEW
[LAMBDA (SKW) (* rrb " 6-Nov-85 09:56")
(* puts up a menu of the previously saved places in
the sketch and moves to the one selected.)
(PROG [(VIEW (\CURSOR.IN.MIDDLE.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 " 6-Nov-85 09:57")
(* 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 "25-Nov-85 17:46")
(* puts a grid of size GRID onto SKW.)
(PROG ((SCALE (WINDOW.SCALE SKW))
(REGION (SKETCH.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 "25-Nov-85 17:46")
(* returns the default grid factor for a window.
Starts at about a quarter inch.)
(GRID.FACTOR1 (fetch (REGION HEIGHT) of (SKETCH.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 "25-Nov-85 17:46")
(* 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 (SKETCH.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 " 5-Dec-85 17:18")
(* gives the user a choice of past events to undo.)
(SKED.CLEAR.SELECTION SKW)
(PROG [EVENT UNDOFN (HISTLST (WINDOWPROP SKW (QUOTE SKETCHHISTORY]
(COND
((NULL HISTLST)
(STATUSPRINT SKW "Nothing to undo.")
(RETURN)))
(COND
([SETQ EVENT (\CURSOR.IN.MIDDLE.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 " 5-Dec-85 17:19")
(* undoes the first not yet undone history event.)
(SKED.CLEAR.SELECTION SKW)
(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 events 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 "10-Dec-85 17:55")
(* 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
((GROUP UNGROUP)
"")
[(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 "25-Nov-85 17:46")
(* 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 (SKETCH.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 "18-Oct-85 10:13")
(* 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.LOCAL.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 "28-Oct-85 16:43")
(* * 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.)
(SKED.CLEAR.SELECTION SKETCHW)
(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-Oct-85 16:43")
(* * changes a sketch window to show things in normal display mode.)
(COND
((IMAGESTREAMTYPEP (GETSTREAM SKETCHW (QUOTE OUTPUT))
(QUOTE HARDCOPY))
(SKED.CLEAR.SELECTION SKETCHW)
(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 " 6-Nov-85 09:57")
(* reads a brush shape from the user.)
(\CURSOR.IN.MIDDLE.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 " 6-Nov-85 09:57")
(* 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 (\CURSOR.IN.MIDDLE.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 " 6-Nov-85 09:57")
(* gets a description of how to change the arrow heads
of a wire or curve.)
(PROG (DASHING)
(SELECTQ [SETQ DASHING (\CURSOR.IN.MIDDLE.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 "30-Oct-85 11:33")
(* return DASHING if it is a legal DASHING Note that
NIL is a legal dashing and this will return NIL.)
(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 " 6-Nov-85 09:58")
(* reads a shade for the filling texture.)
(PROG (FILLING)
(SELECTQ (SETQ FILLING (\CURSOR.IN.MIDDLE.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 NOWCOLOR) (* rrb "29-Oct-85 12:29")
(* 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
(INITCOLOR (AND NOWCOLOR (INSURE.RGB.COLOR NOWCOLOR T]
[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 (COND
(NOWCOLOR (READCOLOR2 WIN (fetch (RGB RED) of NOWCOLOR)
(fetch (RGB GREEN) of NOWCOLOR)
(fetch (RGB BLUE) of NOWCOLOR)))
(T (READCOLOR2 WIN 0 0 0]
(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 REDLEVEL GREENLEVEL BLUELEVEL) (* rrb "29-Oct-85 12:29")
(* internal function to READCOLOR which polls mouse
and updates fields.)
(PROG ((VALBTM (IPLUS (fetch (REGION BOTTOM) of REDREGION)
264))
LEVEL LASTX LASTY HLS)
(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]
)
(SKETCH.TRACK.ELEMENTS
[LAMBDA (ELEMENTS VIEWER CONSTRAINTFN HOTSPOT) (* rrb "14-Nov-85 10:42")
(* gets a point from the user by displaying an image of ELEMENTS. It calls CONSTRAINTFN everytime the cursor moves
to allow user constraints on where the image is displayed. All positions and elements are in sketch coordinates.)
(PROG (FIGINFO FIRSTHOTSPOT NEWPOS LOWLFT IMAGEPOSX IMAGEPOSY IMAGEBM DELTAPOS NEWGLOBALS
SKETCH GDELTAPOS)
(COND
(T (* read new position from the user)
(SETQ FIGINFO (SK.FIGUREIMAGE SCRELTS (DSPCLIPPINGREGION NIL SKW)))
[SETQ FIRSTHOTSPOT (CAR (fetch (SCREENELT HOTSPOTS) of (CAR SCRELTS]
(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.)
(* calculate the delta that the selected point moves.)
(SETQ GDELTAPOS (SK.MAP.FROM.WINDOW.TO.NEAREST.GRID
[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]
(WINDOW.SCALE SKW])
(SK.READ.POINT.WITH.FEEDBACK
[LAMBDA (WINDOW CURSOR FEEDBACKFN FEEDBACKFNDATA) (* rrb "14-Nov-85 13:52")
(* reads a point from the user. Each time the cursor moves, a feedback fn is called passing it the new X, new Y,
WINDOW and FEEDBACKDATA It is expected to XOR something on the screen that tells the user something.)
(RESETFORM (CURSOR (OR CURSOR CROSSHAIRS))
(PROG ((USEGRID (WINDOWPROP WINDOW (QUOTE USEGRID)))
(GRID (SK.GRIDFACTOR WINDOW))
(SCALE (WINDOW.SCALE WINDOW))
(HOTSPOTCACHE (SK.HOTSPOT.CACHE WINDOW))
XSCREEN YSCREEN XGRID YGRID NEWX NEWY MOUSEDOWN ONGRID? NEARPOS
OLDOPERATION)
(OR FEEDBACKFN (SETQ FEEDBACKFN (QUOTE SHOWSKETCHXY)))
(SETQ OLDOPERATION (DSPOPERATION (QUOTE INVERT)
WINDOW))
(RETURN (PROG1 [until (COND
(MOUSEDOWN (MOUSESTATE UP))
((MOUSESTATE (OR LEFT MIDDLE RIGHT))
(COND
((NOT (INSIDEP WINDOW (LASTMOUSEX
WINDOW)
(LASTMOUSEY WINDOW)))
(RETURN)))
(SETQ MOUSEDOWN T)
NIL))
do (SETQ NEWX (LASTMOUSEX WINDOW))
(SETQ NEWY (LASTMOUSEY WINDOW))
[COND
((OR (NEQ NEWX XSCREEN)
(NEQ NEWY YSCREEN))
(* cursor changed position check if grid pt moved.)
(SKETCHW.UPDATE.LOCATORS WINDOW)
(SETQ XSCREEN NEWX)
(SETQ YSCREEN NEWY)
[COND
((AND 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.
Call the feedback function if the point is in the
window. If it is outside, don't show anything.)
(AND XGRID (INSIDEP WINDOW XGRID
YGRID)
(APPLY* FEEDBACKFN XGRID YGRID
WINDOW FEEDBACKFNDATA))
(AND (INSIDEP WINDOW (SETQ XGRID
NEWX)
(SETQ YGRID NEWY))
(APPLY* FEEDBACKFN XGRID YGRID
WINDOW FEEDBACKFNDATA]
finally (RETURN (COND
((AND XGRID
(INSIDEP WINDOW XGRID
YGRID))
(* if the cursor was outside the window when let up,
return NIL)
(APPLY* FEEDBACKFN XGRID
YGRID WINDOW
FEEDBACKFNDATA)
(create INPUTPT
INPUT.ONGRID? ←
ONGRID?
INPUT.POSITION ←(
create POSITION
XCOORD ←
XGRID
YCOORD ←
YGRID]
(DSPOPERATION OLDOPERATION WINDOW])
(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? DEFAULT.VISIBLE.SCALE.FACTOR 10.0)
(RPAQ? MINIMUM.VISIBLE.SCALE.FACTOR 4.0)
(RPAQQ SKETCH.ELEMENT.TYPES NIL)
(RPAQQ SKETCH.ELEMENT.TYPE.NAMES NIL)
(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 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)
(SKETCHTYPE 28 POINTER)))
(QUOTE 30))
(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 LOCALHOTREGION . 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 LOCALHOTREGION . OTHERLOCALINFO))
(RECORD SKETCH (ALLSKETCHPROPS . SKETCHTCELL)
(RECORD ALLSKETCHPROPS (SKETCHKEY SKETCHNAME . SKETCHPROPS)
(CREATE (LIST (QUOTE SKETCH)
NIL
(QUOTE VERSION)
SKETCH.VERSION)))
[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)
GLOBALREGIONFN
(* takes a GLOBAL element and returns the global region it occupies. Note: this is the only fn that takes a global
rather that a local element.)
))
(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 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)
(SKETCHTYPE 28 POINTER)))
(QUOTE 30))
)
(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 SKETCHBMELT TEDIT)
(DECLARE: DOEVAL@COMPILE EVAL@LOAD DONTCOPY
(FILESLOAD (LOADCOMP)
SKETCHELEMENTS SKETCHOBJ SKETCHEDIT)
)
(INIT.GROUP.ELEMENT)
(* version checking stuff)
(DECLARE: EVAL@COMPILE
(RPAQQ SKETCH.VERSION 3)
(CONSTANTS (SKETCH.VERSION 3))
)
(DEFINEQ
(SK.CHECK.SKETCH.VERSION
[LAMBDA (SKETCH) (* rrb " 6-Nov-85 11:11")
(* makes sure the sketch is the correct version.
If not, it tries to update it.
Returns SKETCH.)
(COND
((EQ (LISTGET (fetch (SKETCH SKETCHPROPS) of SKETCH)
(QUOTE VERSION))
SKETCH.VERSION)
SKETCH)
(T (SK.INSURE.RECORD.LENGTH (fetch (SKETCH SKETCHELTS) of SKETCH))
(* this is basically a PUTSKETCHPROP expanded in line
to avoid coersions which can cause loops.)
[PROG (PLIST)
(SETQ PLIST (fetch (SKETCH SKETCHPROPS) of SKETCH))
(COND
((SETQ PLIST (fetch (SKETCH SKETCHPROPS) of SKETCH))
(LISTPUT PLIST (QUOTE VERSION)
SKETCH.VERSION))
(T (replace (SKETCH SKETCHPROPS) of SKETCH with (LIST (QUOTE VERSION)
SKETCH.VERSION]
SKETCH])
(SK.INSURE.RECORD.LENGTH
[LAMBDA (SKETCHELTS) (* rrb "18-Oct-85 14:51")
(* makes sure the elements have the proper number of
fields.)
(bind INDPART TYPE NFIELDS for ELT in SKETCHELTS
do (SETQ INDPART (fetch (GLOBALPART INDIVIDUALGLOBALPART) of ELT))
(SETQ TYPE (fetch (INDIVIDUALGLOBALPART GTYPE) of INDPART))
(COND
([OR (SETQ NFIELDS (CADR (ASSOC TYPE SKETCH.RECORD.LENGTHS)))
(AND (RECLOOK TYPE)
(SETQ SKETCH.RECORD.LENGTHS
(NCONC1 SKETCH.RECORD.LENGTHS
(LIST TYPE (SETQ NFIELDS
(LENGTH (EVAL (LIST (QUOTE CREATE)
TYPE]
(SK.INSURE.HAS.LENGTH INDPART NFIELDS TYPE)))
(* if it's not a record, either it's an unknown sketch element type or its declaration wasn't copied to the
compiled file. In either case, assume it has the correct number of fields.)
(COND
((EQ TYPE (QUOTE GROUP)) (* recurse thru the subelements too.)
(SK.INSURE.RECORD.LENGTH (fetch (GROUP LISTOFGLOBALELTS) of INDPART])
(SK.INSURE.HAS.LENGTH
[LAMBDA (LIST N TYPE) (* rrb " 1-Nov-85 08:52")
(* makes sure LIST is at least N long. If not, it creates a record of type TYPE and nconcs the enough fields from
the end to make it be N long.)
(OR (EQLENGTH LIST N)
(NCONC LIST (COND
[(RECLOOK TYPE)
(NTH (EVAL (LIST (QUOTE CREATE)
TYPE))
(ADD1 (LENGTH LIST]
(T (* no record, add NILs and hope.)
(for I from (ADD1 (LENGTH LIST)) to N collect NIL])
(SK.SET.RECORD.LENGTHS
[LAMBDA NIL (* rrb "18-Oct-85 15:35")
(* sets up a variable that contains the lengths of the
sketch element records.)
(SETQ SKETCH.RECORD.LENGTHS (SK.SET.RECORD.LENGTHS.MACRO])
)
(DECLARE: EVAL@COMPILE
[PUTPROPS SK.SET.RECORD.LENGTHS.MACRO MACRO (ARGS (CONS (QUOTE LIST)
(for X in SKETCH.ELEMENT.TYPE.NAMES collect
(LIST (QUOTE LIST)
(KWOTE X)
(LIST (QUOTE LENGTH)
(LIST (QUOTE CREATE)
X]
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS SKETCH.RECORD.LENGTHS)
)
(SK.SET.RECORD.LENGTHS)
(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 (17873 22439 (SKETCH.TEST 17883 . 22437)) (22440 73451 (DRAW.LOCAL.SKETCH 22450 . 22811)
(SKETCHW.CREATE 22813 . 30245) (SKETCH.RESET 30247 . 31307) (SKETCHW.FIG.CHANGED 31309 . 31729) (
SK.WINDOW.TITLE 31731 . 32157) (EDITSLIDE 32159 . 32550) (EDITSKETCH 32552 . 32879) (SK.FIX.MENU 32881
. 34034) (SK.PUT.ON.FILE 34036 . 36083) (SK.GET.FROM.FILE 36085 . 40846) (SK.ADD.ELEMENTS.TO.SKETCH
40848 . 41141) (STATUSPRINT 41143 . 42291) (CLEARPROMPTWINDOW 42293 . 42758) (CLOSEPROMPTWINDOW 42760
. 43186) (MYGETPROMPTWINDOW 43188 . 43830) (PROMPT.GETINPUT 43832 . 44524) (SK.INSURE.HAS.MENU 44526
. 45181) (SKETCH.SET.A.DEFAULT 45183 . 48860) (SK.POPUP.SELECTIONFN 48862 . 49313) (GETSKETCHWREGION
49315 . 49526) (READ.FUNCTION 49528 . 50064) (READBRUSHSIZE 50066 . 50439) (READANGLE 50441 . 50880) (
READARCDIRECTION 50882 . 51622) (SK.ADD.ELEMENT 51624 . 52932) (SK.ADD.ELEMENTS 52934 . 53200) (
SK.CHECK.WHENADDEDFN 53202 . 53901) (SK.APPLY.MENU.COMMAND 53903 . 54825) (SK.DELETE.ELEMENT1 54827 .
56229) (SK.MARK.DIRTY 56231 . 56615) (SK.MARK.UNDIRTY 56617 . 57016) (SK.MENU.AND.RETURN.FIELD 57018
. 57601) (SK.SCALE.POSITION.INTO.VIEWER 57603 . 58102) (SKETCH.SET.BRUSH.SHAPE 58104 . 58710) (
SKETCH.SET.BRUSH.SIZE 58712 . 59147) (SKETCHW.CLOSEFN 59149 . 61267) (SKETCHW.OUTFN 61269 . 61570) (
SKETCHW.REOPENFN 61572 . 62041) (MAKE.LOCAL.SKETCH 62043 . 62714) (MAP.SKETCHSPEC.INTO.VIEWER 62716 .
63661) (SKETCHW.REPAINTFN 63663 . 64619) (SKETCHW.REPAINTFN1 64621 . 65459) (SK.DRAWFIGURE.IF 65461 .
65959) (SKETCHW.SCROLLFN 65961 . 69007) (SK.UPDATE.EVENT.SELECTION 69009 . 70495) (LIGHTGRAYWINDOW
70497 . 70677) (SK.ADD.SPACES 70679 . 71167) (SK.SKETCH.MENU 71169 . 71425) (
SK.CHECK.IMAGEOBJ.WHENDELETEDFN 71427 . 72103) (SK.APPLY.IMAGEOBJ.WHENDELETEDFN 72105 . 72849) (
SK.RETURN.TTY 72851 . 73169) (SK.TAKE.TTY 73171 . 73449)) (73494 85972 (SKETCH.COMMANDMENU 73504 .
73824) (SKETCH.COMMANDMENU.ITEMS 73826 . 84892) (CREATE.SKETCHW.COMMANDMENU 84894 . 85231) (
SKETCHW.SELECTIONFN 85233 . 85970)) (86024 93168 (SKETCH.CREATE 86034 . 86704) (GETSKETCHPROP 86706 .
88990) (PUTSKETCHPROP 88992 . 92296) (CREATE.DEFAULT.SKETCH.CONTEXT 92298 . 93166)) (93326 106858 (
SK.COPY.BUTTONEVENTFN 93336 . 102331) (SK.BUTTONEVENT.MARK 102333 . 102742) (SK.BUILD.IMAGEOBJ 102744
. 105646) (SK.BUTTONEVENT.OVERP 105648 . 106190) (SK.BUTTONEVENT.SAME.KEYS 106192 . 106856)) (107087
118672 (SK.SEL.AND.CHANGE 107097 . 107449) (SK.CHANGE.ELT 107451 . 107639) (SK.CHANGE.THING 107641 .
108612) (SK.CHANGEFN 108614 . 109063) (SK.READCHANGEFN 109065 . 109504) (SK.DEFAULT.CHANGEFN 109506 .
111312) (CHANGEABLEFIELDITEMS 111314 . 111912) (SK.SEL.AND.MAKE 111914 . 112363) (
SK.APPLY.CHANGE.COMMAND 112365 . 113183) (SK.ELEMENTS.CHANGEFN 113185 . 114992) (READ.POINT.TO.ADD
114994 . 115875) (GLOBAL.KNOT.FROM.LOCAL 115877 . 116409) (SK.ADD.KNOT.TO.ELEMENT 116411 . 117101) (
SK.GROUP.CHANGEFN 117103 . 118670)) (118745 128601 (ADD.ELEMENT.TO.SKETCH 118755 . 119140) (
ADD.SKETCH.VIEWER 119142 . 119759) (REMOVE.SKETCH.VIEWER 119761 . 120294) (ALL.SKETCH.VIEWERS 120296
. 120571) (VIEWER.BUCKET 120573 . 120720) (ELT.INSIDE.REGION? 120722 . 121101) (ELT.INSIDE.SKWP
121103 . 121446) (SCALE.FROM.SKW 121448 . 121708) (SK.ADDELT.TO.WINDOW 121710 . 122565) (
SK.CALC.REGION.VIEWED 122567 . 122878) (SK.DRAWFIGURE 122880 . 123756) (SK.DRAWFIGURE1 123758 . 124074
) (SK.LOCAL.FROM.GLOBAL 124076 . 125274) (SKETCH.REGION.VIEWED 125276 . 126059) (SKETCH.VIEW.FROM.NAME
126061 . 126553) (SK.UPDATE.REGION.VIEWED 126555 . 126898) (SKETCH.ADD.AND.DISPLAY 126900 . 127357) (
SKETCH.ADD.AND.DISPLAY1 127359 . 127824) (SK.ADD.ITEM 127826 . 128187) (SKETCHW.ADD.INSTANCE 128189 .
128599)) (128784 140057 (SK.SEL.AND.DELETE 128794 . 129116) (SK.ERASE.AND.DELETE.ITEM 129118 . 129467)
(REMOVE.ELEMENT.FROM.SKETCH 129469 . 130384) (SK.DELETE.ELEMENT 130386 . 131420) (SK.DELETE.KNOT
131422 . 131765) (SK.SEL.AND.DELETE.KNOT 131767 . 132626) (SK.DELETE.ELEMENT.KNOT 132628 . 134824) (
SK.CHECK.WHENDELETEDFN 134826 . 135831) (SK.CHECK.PREEDITFN 135833 . 136369) (SK.CHECK.WHENEDITEDFN
136371 . 136910) (SK.CHECK.WHENPOINTDELETEDFN 136912 . 137645) (SK.ERASE.ELT 137647 . 138027) (
SK.DELETE.ELT 138029 . 138330) (SK.DELETE.ITEM 138332 . 138739) (DELFROMTCONC 138741 . 140055)) (
140092 148827 (SK.COPY.ELT 140102 . 140398) (SK.SEL.AND.COPY 140400 . 140716) (SK.COPY.ELEMENTS 140718
. 144750) (SK.GLOBAL.FROM.LOCAL.ELEMENTS 144752 . 145028) (SK.COPY.ITEM 145030 . 145699) (
SK.INSERT.SKETCH 145701 . 148825)) (148863 169904 (SK.MOVE.ELT 148873 . 149196) (SK.MOVE.ELT.OR.PT
149198 . 149529) (SK.APPLY.DEFAULT.MOVE 149531 . 150030) (SK.SEL.AND.MOVE 150032 . 150543) (
SK.MOVE.ELEMENTS 150545 . 158667) (SKETCH.MOVE.ELEMENTS 158669 . 160364) (SK.TRANSLATE.ELEMENT 160366
. 160793) (SK.MAKE.ELEMENT.MOVE.ARG 160795 . 161381) (SK.MAKE.ELEMENTS.MOVE.ARG 161383 . 161882) (
SK.MAKE.POINTS.AND.ELEMENTS.MOVE.ARG 161884 . 162727) (SK.SHOW.FIG.FROM.INFO 162729 . 163047) (
SK.MOVE.THING 163049 . 163846) (UPDATE.ELEMENT.IN.SKETCH 163848 . 164802) (SK.UPDATE.ELEMENT 164804 .
166180) (SK.UPDATE.ELEMENTS 166182 . 166592) (SK.UPDATE.ELEMENT1 166594 . 169563) (
SK.MOVE.ELEMENT.POINT 169565 . 169902)) (169963 188181 (SK.MOVE.POINTS 169973 . 170307) (
SK.SEL.AND.MOVE.POINTS 170309 . 170595) (SK.DO.MOVE.ELEMENT.POINTS 170597 . 176836) (
SK.MOVE.ITEM.POINTS 176838 . 178436) (SK.TRANSLATEPTSFN 178438 . 178766) (SK.TRANSLATE.POINTS 178768
. 179147) (SK.SELECT.MULTIPLE.POINTS 179149 . 184111) (SK.CONTROL.POINTS.IN.REGION 184113 . 185290) (
SK.ADD.PT.SELECTION 185292 . 185725) (SK.REMOVE.PT.SELECTION 185727 . 186344) (SK.ADD.POINT 186346 .
186903) (SK.ELTS.CONTAINING.PTS 186905 . 187544) (SK.HOTSPOTS.NOT.ON.LIST 187546 . 188179)) (188306
190524 (SK.SET.MOVE.MODE 188316 . 188838) (SK.SET.MOVE.MODE.POINTS 188840 . 189119) (
SK.SET.MOVE.MODE.ELEMENTS 189121 . 189405) (SK.SET.MOVE.MODE.COMBINED 189407 . 189697) (READMOVEMODE
189699 . 190522)) (190584 199153 (SKETCH.CREATE.GROUP 190594 . 191018) (SK.CREATE.GROUP1 191020 .
191457) (SK.UPDATE.GROUP.AFTER.CHANGE 191459 . 192246) (SK.GROUP.ELTS 192248 . 192577) (
SK.SEL.AND.GROUP 192579 . 192899) (SK.GROUP.ELEMENTS 192901 . 194533) (SK.UNGROUP.ELT 194535 . 194867)
(SK.SEL.AND.UNGROUP 194869 . 195714) (SK.UNGROUP.ELEMENT 195716 . 197088) (
SK.GLOBAL.REGION.OF.LOCAL.ELEMENTS 197090 . 197809) (SK.GLOBAL.REGION.OF.GLOBAL.ELEMENTS 197811 .
198460) (SKETCH.REGION.OF.SKETCH 198462 . 198800) (SK.FLASHREGION 198802 . 199151)) (199154 208254 (
INIT.GROUP.ELEMENT 199164 . 200058) (GROUP.DRAWFN 200060 . 200509) (GROUP.EXPANDFN 200511 . 201620) (
GROUP.INSIDEFN 201622 . 202037) (GROUP.REGIONFN 202039 . 202364) (GROUP.GLOBALREGIONFN 202366 . 202736
) (GROUP.TRANSLATEFN 202738 . 204135) (GROUP.TRANSFORMFN 204137 . 206357) (GROUP.READCHANGEFN 206359
. 208252)) (208255 209081 (REGION.CENTER 208265 . 208772) (REMOVE.LAST 208774 . 209079)) (209324
211301 (SK.DO.GROUP 209334 . 210068) (SK.DO.UNGROUP 210070 . 210653) (SK.GROUP.UNDO 210655 . 210977) (
SK.UNGROUP.UNDO 210979 . 211299)) (211533 220480 (SK.SEL.AND.TRANSFORM 211543 . 211957) (
SK.TRANSFORM.ELEMENTS 211959 . 213066) (SK.TRANSFORM.ITEM 213068 . 213676) (SK.TRANSFORM.ELEMENT
213678 . 214121) (SK.TRANSFORM.POINT 214123 . 214362) (SK.TRANSFORM.POINT.LIST 214364 . 214585) (
SK.TRANSFORM.REGION 214587 . 216292) (SK.PUT.ELTS.ON.GRID 216294 . 216762) (
SK.TRANSFORM.GLOBAL.ELEMENTS 216764 . 217266) (GLOBALELEMENTP 217268 . 217554) (
SK.TRANSFORM.SCALE.FACTOR 217556 . 218720) (SK.TRANSFORM.BRUSH 218722 . 219100) (
SK.TRANSFORM.ARROWHEADS 219102 . 219890) (SCALE.BRUSH 219892 . 220478)) (220481 238149 (
TWO.PT.TRANSFORMATION.INPUTFN 220491 . 223069) (SK.TWO.PT.TRANSFORM.ELTS 223071 . 223519) (
SK.SEL.AND.TWO.PT.TRANSFORM 223521 . 224150) (SK.APPLY.AFFINE.TRANSFORM 224152 . 224952) (
SK.COMPUTE.TWO.PT.TRANSFORMATION 224954 . 228390) (SK.COMPUTE.SLOPE 228392 . 229038) (
SK.THREE.PT.TRANSFORM.ELTS 229040 . 229495) (SK.COMPUTE.THREE.PT.TRANSFORMATION 229497 . 233384) (
SK.SEL.AND.THREE.PT.TRANSFORM 233386 . 234021) (THREE.PT.TRANSFORMATION.INPUTFN 234023 . 238147)) (
238150 241952 (SK.COPY.AND.TWO.PT.TRANSFORM.ELTS 238160 . 238622) (SK.SEL.COPY.AND.TWO.PT.TRANSFORM
238624 . 239296) (SK.COPY.AND.THREE.PT.TRANSFORM.ELTS 239298 . 239771) (
SK.SEL.COPY.AND.THREE.PT.TRANSFORM 239773 . 240448) (SK.COPY.AND.TRANSFORM.ELEMENTS 240450 . 241390) (
SK.COPY.AND.TRANSFORM.ITEM 241392 . 241950)) (243887 252360 (SKETCH.ELEMENTS.OF.SKETCH 243897 . 244639
) (SKETCH.LIST.OF.ELEMENTS 244641 . 245302) (SKETCH.ADD.ELEMENT 245304 . 246316) (
SKETCH.DELETE.ELEMENT 246318 . 247818) (DELFROMGROUPELT 247820 . 248673) (SKETCH.ELEMENT.TYPE 248675
. 248954) (SKETCH.ELEMENT.CHANGED 248956 . 250337) (SK.ELEMENT.CHANGED1 250339 . 251011) (
SK.UPDATE.GLOBAL.IMAGE.OBJECT.ELEMENT 251013 . 252358)) (252410 255797 (INSURE.SKETCH 252420 . 254397)
(LOCALSPECS.FROM.VIEWER 254399 . 254724) (SK.LOCAL.ELT.FROM.GLOBALPART 254726 . 255228) (
SKETCH.FROM.VIEWER 255230 . 255412) (INSPECT.SKETCH 255414 . 255795)) (255798 259583 (MAPSKETCHSPECS
255808 . 256408) (MAPCOLLECTSKETCHSPECS 256410 . 257107) (MAPSKETCHSPECSUNTIL 257109 . 257905) (
MAPGLOBALSKETCHSPECS 257907 . 258535) (MAPGLOBALSKETCHELEMENTS 258537 . 259581)) (259618 262435 (
SK.SHOWMARKS 259628 . 260273) (MARKPOINT 260275 . 260997) (SK.MARKHOTSPOTS 260999 . 262011) (
SK.MARK.SELECTION 262013 . 262433)) (263045 268672 (SK.SELECT.ITEM 263055 . 265223) (IN.SKETCH.ELT?
265225 . 267053) (SK.MARK.HOTSPOT 267055 . 267601) (SK.MARK.POSITION 267603 . 267974) (SK.SELECT.ELT
267976 . 268345) (SK.DESELECT.ELT 268347 . 268670)) (268809 279289 (SK.HOTSPOT.CACHE 268819 . 269128)
(SK.HOTSPOT.CACHE.FOR.OPERATION 269130 . 270170) (SK.BUILD.CACHE 270172 . 270752) (
SK.ELEMENT.PROTECTED? 270754 . 271314) (SK.HAS.SOME.HOTSPOTS 271316 . 271710) (SK.SET.HOTSPOT.CACHE
271712 . 272035) (SK.CREATE.HOTSPOT.CACHE 272037 . 272412) (SK.ELTS.FROM.HOTSPOT 272414 . 273176) (
SK.ADD.HOTSPOTS.TO.CACHE 273178 . 273517) (SK.ADD.HOTSPOTS.TO.CACHE1 273519 . 273949) (
SK.ADD.HOTSPOT.TO.CACHE 273951 . 275488) (SK.REMOVE.HOTSPOTS.FROM.CACHE 275490 . 275831) (
SK.REMOVE.HOTSPOTS.FROM.CACHE1 275833 . 276245) (SK.REMOVE.HOTSPOT.FROM.CACHE 276247 . 276890) (
SK.REMOVE.VALUE.FROM.CACHE.BUCKET 276892 . 277586) (SK.FIND.CACHE.BUCKET 277588 . 278078) (
SK.ADD.VALUE.TO.CACHE.BUCKET 278080 . 279287)) (279347 303019 (SK.ADD.SELECTION 279357 . 280035) (
SK.COPY.INSERTFN 280037 . 281555) (SK.FIGUREIMAGE 281557 . 285278) (SCREENELEMENTP 285280 . 285647) (
SK.ITEM.REGION 285649 . 286153) (SK.ELEMENT.GLOBAL.REGION 286155 . 286685) (SK.LOCAL.ITEMS.IN.REGION
286687 . 288080) (SK.REGIONFN 288082 . 288390) (SK.GLOBAL.REGIONFN 288392 . 288736) (
SK.REMOVE.SELECTION 288738 . 289401) (SK.SELECT.MULTIPLE.ITEMS 289403 . 298647) (SK.PUT.MARKS.UP
298649 . 299056) (SK.TAKE.MARKS.DOWN 299058 . 299478) (SK.TRANSLATE.GLOBALPART 299480 . 301367) (
SK.TRANSLATE.ITEM 301369 . 302220) (SK.TRANSLATEFN 302222 . 302428) (TRANSLATE.SKETCH 302430 . 303017)
) (303341 304058 (ELT.INSIDE.SKETCHWP 303351 . 303689) (SK.INSIDE.REGION 303691 . 304056)) (304106
306763 (SK.INPUT.SCALE 304116 . 304870) (SK.UPDATE.SKETCHCONTEXT 304872 . 305512) (SK.SET.INPUT.SCALE
305514 . 305975) (SK.SET.INPUT.SCALE.CURRENT 305977 . 306321) (SK.SET.INPUT.SCALE.VALUE 306323 .
306761)) (306810 308414 (SK.SET.FEEDBACK.MODE 306820 . 307822) (SK.SET.FEEDBACK.POINT 307824 . 308002)
(SK.SET.FEEDBACK.VERBOSE 308004 . 308215) (SK.SET.FEEDBACK.ALWAYS 308217 . 308412)) (308562 320143 (
SKETCHW.SCALE 308572 . 308649) (SKETCH.ZOOM 308651 . 309565) (SAME.ASPECT.RATIO 309567 . 310623) (
SKETCH.DO.ZOOM 310625 . 311782) (SKETCH.NEW.VIEW 311784 . 312192) (ZOOM.UPDATE.ELT 312194 . 312888) (
SK.UPDATE.AFTER.SCALE.CHANGE 312890 . 314537) (SKETCH.AUTOZOOM 314539 . 317540) (
SKETCH.GLOBAL.REGION.ZOOM 317542 . 320141)) (320852 326974 (SKETCH.HOME 320862 . 321360) (SK.FRAME.IT
321362 . 321896) (SK.MOVE.TO.VIEW 321898 . 323135) (SK.NAME.CURRENT.VIEW 323137 . 323911) (
SKETCH.ADD.VIEW 323913 . 324623) (SK.RESTORE.VIEW 324625 . 325799) (SK.FORGET.VIEW 325801 . 326972)) (
327170 343466 (SK.SET.GRID 327180 . 327545) (SK.DISPLAY.GRID 327547 . 328057) (SK.DISPLAY.GRID.POINTS
328059 . 328248) (SK.REMOVE.GRID.POINTS 328250 . 328675) (SK.TAKE.DOWN.GRID 328677 . 329004) (
SK.SHOW.GRID 329006 . 331691) (SK.GRIDFACTOR 331693 . 332238) (SK.TURN.GRID.ON 332240 . 332588) (
SK.TURN.GRID.OFF 332590 . 332963) (SK.MAKE.GRID.LARGER 332965 . 333317) (SK.MAKE.GRID.SMALLER 333319
. 333671) (SK.CHANGE.GRID 333673 . 334211) (GRID.FACTOR1 334213 . 334623) (LEASTPOWEROF2GT 334625 .
335281) (GREATESTPOWEROF2LT 335283 . 335938) (SK.DEFAULT.GRIDFACTOR 335940 . 336386) (SK.PUT.ON.GRID
336388 . 336863) (MAP.WINDOW.ONTO.GRID 336865 . 337237) (MAP.SCREEN.ONTO.GRID 337239 . 337771) (
MAP.GLOBAL.PT.ONTO.GRID 337773 . 338235) (MAP.GLOBAL.REGION.ONTO.GRID 338237 . 339487) (
MAP.WINDOW.POINT.ONTO.GLOBAL.GRID 339489 . 340039) (MAP.WINDOW.ONTO.GLOBAL.GRID 340041 . 340381) (
SK.UPDATE.GRIDFACTOR 340383 . 340957) (SK.MAP.FROM.WINDOW.TO.GLOBAL.GRID 340959 . 341559) (
SK.MAP.INPUT.PT.TO.GLOBAL 341561 . 342505) (SK.MAP.FROM.WINDOW.TO.NEAREST.GRID 342507 . 343464)) (
343599 345202 (SKETCH.TITLE 343609 . 343927) (SK.SHRINK.ICONCREATE 343929 . 345200)) (350470 356495 (
SK.ADD.HISTEVENT 350480 . 351262) (SK.SEL.AND.UNDO 351264 . 353215) (SK.UNDO.LAST 353217 . 354799) (
SK.UNDO.NAME 354801 . 355181) (SKEVENTTYPEFNS 355183 . 355498) (SK.TYPE.OF.FIRST.ARG 355500 . 356493))
(356496 357279 (SK.DELETE.UNDO 356506 . 356891) (SK.ADD.UNDO 356893 . 357277)) (357280 358467 (
SK.CHANGE.UNDO 357290 . 357943) (SK.CHANGE.REDO 357945 . 358465)) (358468 360367 (SK.UNDO.UNDO 358478
. 359553) (SK.UNDO.MENULABEL 359555 . 359930) (SK.LABEL.FROM.TYPE 359932 . 360365)) (361156 379665 (
SKETCHW.HARDCOPYFN 361166 . 365513) (\SK.LIST.PAGE.IMAGE 365515 . 367280) (SK.LIST.IMAGE 367282 .
375678) (SK.LIST.IMAGE.ON.FILE 375680 . 376390) (SK.SET.HARDCOPY.MODE 376392 . 377628) (
SK.UNSET.HARDCOPY.MODE 377630 . 378061) (SK.UPDATE.AFTER.HARDCOPY 378063 . 378714) (
DEFAULTPRINTINGIMAGETYPE 378716 . 379228) (SK.SWITCH.REGION.X.AND.Y 379230 . 379663)) (379907 387373 (
SHOW.GLOBAL.COORDS 379917 . 380419) (LOCATOR.CLOSEFN 380421 . 380778) (SKETCHW.FROM.LOCATOR 380780 .
381155) (SKETCHW.UPDATE.LOCATORS 381157 . 381756) (LOCATOR.UPDATE 381758 . 382520) (
UPDATE.GLOBAL.LOCATOR 382522 . 383221) (UPDATE.GLOBALCOORD.LOCATOR 383223 . 383823) (
ADD.GLOBAL.DISPLAY 383825 . 384753) (ADD.GLOBAL.GRIDDED.DISPLAY 384755 . 384975) (
CREATE.GLOBAL.DISPLAYER 384977 . 385924) (UPDATE.GLOBAL.GRIDDED.COORD.LOCATOR 385926 . 387371)) (
387586 387976 (READBRUSHSHAPE 387596 . 387974)) (387977 396056 (SK.CHANGE.DASHING 387987 . 391127) (
READ.AND.SAVE.NEW.DASHING 391129 . 392430) (READ.NEW.DASHING 392432 . 393504) (READ.DASHING.CHANGE
393506 . 394478) (DASHINGP 394480 . 394874) (SK.CACHE.DASHING 394876 . 395621) (SK.DASHING.LABEL
395623 . 396054)) (396057 398941 (READ.FILLING.CHANGE 396067 . 397197) (SK.CACHE.FILLING 397199 .
397850) (READ.AND.SAVE.NEW.FILLING 397852 . 398471) (SK.FILLING.LABEL 398473 . 398939)) (399298 408965
(DISPLAYREADCOLORHLSLEVELS 399308 . 400159) (DISPLAYREADCOLORLEVEL 400161 . 401007) (DRAWREADCOLORBOX
401009 . 401822) (READ.CHANGE.COLOR 401824 . 401975) (READCOLOR1 401977 . 404158) (
READCOLORCOMMANDMENUSELECTEDFN 404160 . 404529) (READCOLOR2 404531 . 408963)) (408966 410244 (
CREATE.CNS.MENU 408976 . 410242)) (410392 411419 (SCALE.POSITION.INTO.SKETCHW 410402 . 410745) (
UNSCALE 410747 . 410879) (UNSCALE.REGION 410881 . 411417)) (411466 428631 (SK.GETGLOBALPOSITION 411476
. 411834) (GETSKWPOSITION 411836 . 415032) (SKETCH.TRACK.ELEMENTS 415034 . 418316) (
SK.READ.POINT.WITH.FEEDBACK 418318 . 422317) (NEAREST.HOT.SPOT 422319 . 423436) (GETWREGION 423438 .
424063) (GET.BITMAP.POSITION 424065 . 424778) (SK.TRACK.BITMAP1 424780 . 428629)) (430362 432488 (
SK.DRAWFN 430372 . 430682) (SK.TRANSFORMFN 430684 . 431009) (SK.EXPANDFN 431011 . 431236) (SK.INPUT
431238 . 431566) (SK.INSIDEFN 431568 . 431909) (SK.UPDATEFN 431911 . 432486)) (436761 440171 (
SK.CHECK.SKETCH.VERSION 436771 . 437876) (SK.INSURE.RECORD.LENGTH 437878 . 439166) (
SK.INSURE.HAS.LENGTH 439168 . 439822) (SK.SET.RECORD.LENGTHS 439824 . 440169)))))
STOP