(FILECREATED "30-MAR-83 11:31:44" {PHYLUM}<BURTON>ORB>NEWSKETCH.;12 61309
changes to: (FNS GETDRAWPOSITION SCALE.POSITION SKETCHW.CREATE SKETCH.NEW.VIEW
MAP.SKETCHSPEC.INTO.VIEWER SK.UPDATE.AFTER.SCALE.CHANGE INIT.SKETCH.ELEMENTS
SK.INSIDEFN SKETCH.ADD.AND.DISPLAY ELT.INSIDE.SKETCHWP CIRCLE.INSIDEFN
ELLIPSE.INSIDEFN CURVE.INSIDEFN TEXT.INSIDEFN IMAGE.INSIDEFN SK.INSIDE.REGION
ELLIPSE.MOVEFN CREATE.SKETCHW.COMMANDMENU SK.DRAWFIGURE SKETCH.ZOOM
ZOOM.UPDATE.ELT GETWREGION SKETCH.HOME UNSCALE.POSITION ABSWYOFFSET
ABSWXOFFSET SAME.ASPECT.RATIO)
(VARS NEWSKETCHCOMS)
previous date: "24-MAR-83 16:01:55" {PHYLUM}<BURTON>ORB>NEWSKETCH.;10)
(* Copyright (c) 1983 by Xerox Corporation)
(PRETTYCOMPRINT NEWSKETCHCOMS)
(RPAQQ NEWSKETCHCOMS ((FNS SKETCHW.CREATE MAP.SKETCHSPEC.INTO.VIEWER SKETCHW.REPAINTFN
CREATE.SKETCHW.COMMANDMENU SKETCHW.SELECTIONFN)
(* fns for adding elements)
(FNS ADD.ELEMENT.TO.SKETCH ADD.SKETCH.VIEWER ALL.SKETCH.VIEWERS ELT.INSIDE.REGION?
ELT.INSIDE.SKWP SCALE.FROM.SKW SK.ADDELT.TO.WINDOW SK.CALC.REGION.VIEWED SK.DRAWFIGURE
SK.DRAWFIGURE1 SK.LOCAL.FROM.GLOBAL SK.REGION.VIEWED SK.UPDATE.REGION.VIEWED
SKETCH.ADD.AND.DISPLAY SKETCH.ADD.AND.DISPLAY1 SKETCH.FROM.VIEWER SKETCHW.ADD.INSTANCE)
(* fns for deleting things)
(FNS SK.SEL.AND.DELETE SK.ERASE.AND.DELETE.ITEM REMOVE.ELEMENT.FROM.SKETCH SK.DELETE.ELEMENT
SK.ERASE.ELT SK.DELETE.ELT SK.DELETE.ITEM)
(* fns for moving things.)
(FNS SK.MOVE.ELT SK.SEL.AND.MOVE SK.MOVE.THING UPDATE.ELEMENT.IN.SKETCH SK.UPDATE.ELEMENT
SK.UPDATE.ELEMENT1)
(* utility routines for sketch windows.)
(FNS LOCALSPECS.FROM.VIEWER SK.LOCAL.ELT.FROM.GLOBALPART)
(FNS INSURE.SKETCH INSPECT.SKETCH INIT.SKETCH.ELEMENTS SKETCH.ELEMENT.NAMEP)
(FNS MAPSKETCHSPECS MAPSKETCHSPECSUNTIL)
(* functions for marking)
(FNS SK.SHOWMARKS MARKPOINT SK.MARKHOTSPOTS SK.MARKSELECTIONSPOTS MARKSPOTS SK.MARK.SELECTION)
(* hit detection functions.)
(FNS IN.SKETCH.ELT? SK.ON.HOT.SPOT SK.SELECT.ITEM SK.SELECT.ELT SK.DESELECT.ELT)
(* functions for determining what is inside of a window.)
(FNS ELT.INSIDE.SKETCHWP SK.INSIDE.REGION)
(FNS SKETCH.ZOOM SAME.ASPECT.RATIO ABSWXOFFSET ABSWYOFFSET SKETCH.HOME SKETCH.NEW.VIEW
ZOOM.UPDATE.ELT SK.UPDATE.AFTER.SCALE.CHANGE)
(COMS (* functions for the individual sketch element types.)
(COMS (FNS CIRCLE.EXPANDFN CIRCLE.DRAWFN CIRCLE.MOVEFN CIRCLE.INPUTFN CIRCLE.INSIDEFN)
(RECORDS LOCALCIRCLE))
(COMS (FNS ELLIPSE.EXPANDFN ELLIPSE.DRAWFN ELLIPSE.MOVEFN ELLIPSE.INPUTFN
ELLIPSE.INSIDEFN ELLIPSE.CREATE)
(RECORDS LOCALELLIPSE))
(COMS (FNS CURVE.INSIDEFN)
(RECORDS))
(COMS (FNS TEXT.INSIDEFN)
(RECORDS))
(COMS (FNS IMAGE.INSIDEFN)
(RECORDS)))
(FNS SCALE.POSITION.INTO.SKETCHW SKETCHW.SCALE SCALE.POSITION UNSCALE.POSITION.FROM.SKETCHW
UNSCALE.POSITION SCALE.REGION)
(FNS GETDRAWPOSITION GETWREGION)
(INITVARS (ALL.SKETCHES)
(INITIAL.SCALE 16)
(SKETCH.ELEMENT.TYPES)
(SKETCH.ELEMENT.TYPE.NAMES)
(DEFAULT.VISIBLE.SCALE.FACTOR 10))
(GLOBALVARS ALL.SKETCHES INITIAL.SCALE DEFAULT.VISIBLE.SCALE.FACTOR SKETCH.ELEMENT.TYPES
SKETCH.ELEMENT.TYPE.NAMES SK.SELECTEDMARK SK.LOCATEMARK)
(UGLYVARS SK.SELECTEDMARK SK.LOCATEMARK)
(* accessing functions for the methods of a sketch type. (SKETCHW.CREATE))
(FNS SK.DRAWFN SK.MOVEFN SK.EXPANDFN SK.INPUT SK.INSIDEFN)
(RECORDS GLOBALELEMENT LOCALPART SKETCH SKETCHTYPE)
(P (INIT.SKETCH.ELEMENTS))))
(DEFINEQ
(SKETCHW.CREATE
[LAMBDA (SKETCH REGION TITLE SCALE) (* rrb "29-MAR-83 18:00")
(* creates a sketch window and returns it.)
(PROG ((W (CREATEW REGION TITLE))
[SKETCHNAME (COND
((NULL SKETCH)
(GENSYM (QUOTE SK)))
((LITATOM SKETCH) (* a sketch is named with its specifications kept on its
property list under the SKETCH property.)
SKETCH)
((type? SKETCH SKETCH)
(fetch (SKETCH SKETCHNAME) of SKETCH]
SK)
(* 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)
(OR TITLE (WINDOWPROP W (QUOTE TITLE)
(CONCAT "Viewer onto " SKETCHNAME)))
(WINDOWPROP W (QUOTE SKETCH)
SKETCHNAME)
[SETQ SK (COND
((GETPROP SKETCHNAME (QUOTE SKETCH)))
(T (* put the name of the sketch as the first element.)
(/PUTPROP SKETCHNAME (QUOTE SKETCH)
(create SKETCH
SKETCHNAME ← SKETCHNAME]
[WINDOWPROP W (QUOTE SCALE)
(COND
((NUMBERP SCALE))
((NULL SCALE)
INITIAL.SCALE)
(T (ERROR "unkonwn SCALE" SCALE]
(MAP.SKETCHSPEC.INTO.VIEWER SK W)
(SK.UPDATE.REGION.VIEWED W)
(WINDOWPROP W (QUOTE COMMANDMENU)
(CREATE.SKETCHW.COMMANDMENU W))
(WINDOWPROP W (QUOTE BUTTONEVENTFN)
(FUNCTION FIGUREW.BUTTON.HANDLER))
(WINDOWPROP W (QUOTE REPAINTFN)
(FUNCTION SKETCHW.REPAINTFN))
(WINDOWPROP W (QUOTE MOVEFN)
(FUNCTION FIGUREW.MOVEFN))
(WINDOWPROP W (QUOTE RESHAPEFN)
(FUNCTION RESHAPEBYREPAINTANDMOVEFN))
(FIGUREW.MOVEFN W)
(WINDOWPROP W (QUOTE CLOSEFN)
(FUNCTION FIGUREW.CLOSEFN))
(WINDOWPROP W (QUOTE OPENFN)
(FUNCTION FIGUREW.OPENFN))
(WINDOWPROP W (QUOTE SCROLLFN)
(FUNCTION SCROLLBYREPAINTFN))
(ADD.SKETCH.VIEWER SKETCHNAME W)
(FIGUREW.REPAINTFN W)
(RETURN W])
(MAP.SKETCHSPEC.INTO.VIEWER
[LAMBDA (SKETCH SKW) (* rrb "29-MAR-83 17:50")
(* creates the local parts of a sketch and puts it onto
the viewer.)
(WINDOWPROP SKW (QUOTE SKETCHSPECS)
(CONS (fetch (SKETCH SKETCHNAME) of SKETCH)
(for SKELT in (fetch (SKETCH SKETCHELTS) of SKETCH) collect (
SK.LOCAL.FROM.GLOBAL SKELT SKW])
(SKETCHW.REPAINTFN
[LAMBDA (W REG) (* rrb "24-MAR-83 16:00")
(* redisplays the sketch in a window)
(* for now ignore the region.)
(DSPOPERATION (QUOTE PAINT)
W)
(MAPSKETCHSPECS (LOCALSPECS.FROM.VIEWER W)
(FUNCTION SK.DRAWFIGURE)
W REG])
(CREATE.SKETCHW.COMMANDMENU
[LAMBDA (WINDOW) (* rrb "28-MAR-83 21:03")
(* returns the control menu for a figure window.)
(* additional command (QUOTE
((Change FIGW.CHANGE.ELT
"Changes a property of a piece."))))
(PROG [(CMENU (create MENU
ITEMS ←[APPEND (QUOTE ((Delete SK.DELETE.ELT "Deletes a piece.")))
(QUOTE ((Move SK.MOVE.ELT "Moves one of the pieces.")))
(QUOTE (("" NILL)))
(for ELEMENT in SKETCH.ELEMENT.TYPES
collect (LIST (fetch (SKETCHTYPE LABEL) of ELEMENT)
ELEMENT
(fetch (SKETCHTYPE DOCSTR) of ELEMENT)))
(QUOTE (("" NILL)))
(QUOTE ((New% View SKETCH.NEW.VIEW
"opens another viewer onto this sketch")))
(QUOTE ((Zoom SKETCH.ZOOM
"changes the scale of the display.")))
(QUOTE ((Home SKETCH.HOME
"returns to {0,0} at a medium scale")))
(QUOTE ((inspect INSPECT.SKETCH
"Calls the Inspector on the figure data structures."]
CENTERFLG ← T
WHENSELECTEDFN ←(FUNCTION SKETCHW.SELECTIONFN)
MENUUSERDATA ←(LIST (QUOTE SKETCHW)
WINDOW)
MENUFONT ←(QUOTE (GACHA 12 BOLD]
(SETQ CMENU (ADDMENU CMENU NIL (UPPERLEFTMENUPOSITION CMENU WINDOW)))
(WINDOWPROP CMENU (QUOTE SKETCHW)
WINDOW)
(RETURN CMENU])
(SKETCHW.SELECTIONFN
[LAMBDA (ITEM MENU) (* rrb "17-MAR-83 20:58")
(* calls the function appropriate for the item selected
from the command menu associated with a figure window.)
(PROG [(COMMAND (CADR ITEM))
(SKETCHW (WINDOWPROP (WFROMMENU MENU)
(QUOTE SKETCHW]
(RETURN (COND
((type? SKETCHTYPE COMMAND) (* if the selected item is an element type, add an
instance.)
(SKETCHW.ADD.INSTANCE COMMAND SKETCHW))
(T (APPLY* COMMAND SKETCHW])
)
(* fns for adding elements)
(DEFINEQ
(ADD.ELEMENT.TO.SKETCH
[LAMBDA (GELT SKETCH) (* rrb "17-MAR-83 22:18")
(* changes the global sketch)
(PROG ((SKETCHDATA (INSURE.SKETCH SKETCH)))
(replace (SKETCH SKETCHELTS) of SKETCHDATA with (NCONC1 (fetch (SKETCH SKETCHELTS)
of SKETCHDATA)
GELT))
(MARKASCHANGED (LIST (fetch (SKETCH SKETCHNAME) of SKETCHDATA)
(QUOTE SKETCH))
(QUOTE PROPS])
(ADD.SKETCH.VIEWER
[LAMBDA (SKETCH VIEWER) (* rrb "11-MAR-83 11:02")
(* adds VIEWER as a viewer of SKETCH.)
(PROG (VIEWERS)
(COND
((SETQ VIEWERS (ALL.SKETCH.VIEWERS SKETCH)) (* already has at least one viewer)
(NCONC1 VIEWERS VIEWER))
(T (* doesn't have any viewers yet.)
(SETQ ALL.SKETCHES (CONS (LIST SKETCH VIEWER)
ALL.SKETCHES])
(ALL.SKETCH.VIEWERS
[LAMBDA (SKETCH) (* rrb "11-MAR-83 10:05")
(* returns the list of all active viewers of a sketch)
(CDR (FASSOC SKETCH ALL.SKETCHES])
(ELT.INSIDE.REGION?
[LAMBDA (GLOBALPART WORLDREG) (* rrb "11-MAR-83 12:59")
(* determines if any part of an element is inside the
region WORLDREG)
(APPLY* (SK.INSIDEFN GLOBALPART)
GLOBALPART WORLDREG])
(ELT.INSIDE.SKWP
[LAMBDA (GLOBALPART SKETCHW) (* rrb "14-MAR-83 10:38")
(* determines if a global element is in the world region
of a map window.)
(ELT.INSIDE.REGION? GLOBALPART (SK.REGION.VIEWED SKETCHW])
(SCALE.FROM.SKW
[LAMBDA (WINDOW) (* rrb "11-MAR-83 11:52")
(* gets the scale of a sketch window.)
(WINDOWPROP WINDOW (QUOTE SCALE])
(SK.ADDELT.TO.WINDOW
[LAMBDA (PELT SKETCHW) (* rrb "11-MAR-83 12:06")
(* adds a picture element to a sketch window.)
(AND PELT (WINDOWADDPROP SKETCHW (QUOTE SKETCHSPECS)
PELT])
(SK.CALC.REGION.VIEWED
[LAMBDA (WINDOW SCALE) (* rrb "11-MAR-83 12:53")
(* returns the region of the sketch visible in window.)
(SCALE.REGION (DSPCLIPPINGREGION NIL WINDOW)
SCALE])
(SK.DRAWFIGURE
[LAMBDA (SCREENELT SKW REGION SCALE) (* rrb "28-MAR-83 17:28")
(* 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. Assumes SCALE is a small number.)
(PROG ([SCALE (COND
((NULL SCALE)
(SCALE.FROM.SKW SKW))
((NUMBERP SCALE))
((POSITIONP SCALE)
(fetch (POSITION YCOORD) of SCALE))
(T (ERROR "illegal SCALE" SCALE]
(GLOBALPART (fetch (SCREENELT GLOBALPART) of SCREENELT)))
(* use longitude scale for determining what to display.)
(RETURN (AND (IGEQ SCALE (fetch (GLOBALELEMENT MINSCALE) of GLOBALPART))
(ILEQ SCALE (fetch (GLOBALELEMENT MAXSCALE) of GLOBALPART))
(SK.DRAWFIGURE1 SCREENELT SKW REGION])
(SK.DRAWFIGURE1
[LAMBDA (ELT SKW REGION) (* rrb "17-MAR-83 22:27")
(* displays a sketch element in a window)
(APPLY* (SK.DRAWFN (fetch (GLOBALELEMENT GTYPE) of (fetch (SCREENELT GLOBALPART) of ELT)))
ELT SKW REGION])
(SK.LOCAL.FROM.GLOBAL
[LAMBDA (GELT SKW) (* rrb "11-MAR-83 11:40")
(* returns the element instance of the global element
GELT expanded into the window SKW.)
(APPLY* (SK.EXPANDFN (fetch (GLOBALELEMENT GTYPE) of GELT))
GELT SKW])
(SK.REGION.VIEWED
[LAMBDA (SKETCHW) (* rrb "11-MAR-83 12:53")
(* returns the region in sketch coordinates of the area
visible in SKETCHW.)
(WINDOWPROP SKETCHW (QUOTE REGION.VIEWED])
(SK.UPDATE.REGION.VIEWED
[LAMBDA (SKW) (* rrb "14-MAR-83 10:39")
(* updates the REGION.VIEWED property of a window.)
(WINDOWPROP SKW (QUOTE REGION.VIEWED)
(SK.CALC.REGION.VIEWED SKW (SKETCHW.SCALE SKW])
(SKETCH.ADD.AND.DISPLAY
[LAMBDA (GELT SKETCHW) (* rrb "30-MAR-83 11:20")
(* adds a new element to a sketch window and handles
propagation to all other figure windows)
(COND
(GELT (PROG ((SKETCH (SKETCH.FROM.VIEWER SKETCHW))) (* add the element to the sketch.)
(ADD.ELEMENT.TO.SKETCH GELT SKETCH) (* do the window that the interaction occurred in
first.)
(SKETCH.ADD.AND.DISPLAY1 GELT SKETCHW) (* 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])
(SKETCH.ADD.AND.DISPLAY1
[LAMBDA (GELT SKETCHW SCALE) (* rrb "17-MAR-83 22:23")
(* displays a sketch element and adds it to the window.)
(COND
(GELT (PROG ((ELT (SK.LOCAL.FROM.GLOBAL GELT SKETCHW)))
(SK.DRAWFIGURE ELT SKETCHW NIL SCALE)
(SK.ADDELT.TO.WINDOW ELT SKETCHW])
(SKETCH.FROM.VIEWER
[LAMBDA (SKETCHW) (* returns the sketch that the window views.)
(WINDOWPROP SKETCHW (QUOTE SKETCH])
(SKETCHW.ADD.INSTANCE
[LAMBDA (TYPE SKW) (* rrb "14-MAR-83 10:39")
(* reads an instance of type TYPE from the user and
displays it in SKW.)
(PROG ((ELT (SK.INPUT TYPE SKW)))
(AND ELT (SKETCH.ADD.AND.DISPLAY ELT SKW))
(RETURN ELT])
)
(* fns for deleting things)
(DEFINEQ
(SK.SEL.AND.DELETE
[LAMBDA (W) (* rrb "18-MAR-83 13:13")
(* lets the user select an element and deletes it.)
(PROG ((SELELT (SK.SELECT.ITEM W T)))
(AND SELELT (SK.DELETE.ELEMENT SELELT W))
(RETURN SELELT])
(SK.ERASE.AND.DELETE.ITEM
[LAMBDA (SELELT SKW) (* rrb "18-MAR-83 13:02")
(* removes a sketch element from a viewer.)
(COND
(SELELT (SK.ERASE.ELT SELELT SKW)
(SK.DELETE.ITEM SELELT SKW])
(REMOVE.ELEMENT.FROM.SKETCH
[LAMBDA (GELT SKETCH) (* rrb "18-MAR-83 13:05")
(* changes the global sketch)
(PROG ((SKETCHDATA (INSURE.SKETCH SKETCH)))
(replace (SKETCH SKETCHELTS) of SKETCHDATA with (REMOVE GELT (fetch (SKETCH SKETCHELTS)
of SKETCHDATA)))
(MARKASCHANGED (LIST (fetch (SKETCH SKETCHNAME) of SKETCHDATA)
(QUOTE SKETCH))
(QUOTE PROPS])
(SK.DELETE.ELEMENT
[LAMBDA (OLDELT SKETCHW) (* rrb "18-MAR-83 13:13")
(* deletes an element to a sketch window and handles
propagation to all other figure windows)
(PROG ((GLOBALPART (fetch (SCREENELT GLOBALPART) of OLDELT))
(SKETCH (SKETCH.FROM.VIEWER SKETCHW))
LOCALELT) (* delete the element to the sketch.)
(REMOVE.ELEMENT.FROM.SKETCH GLOBALPART SKETCH) (* do the window that the interaction occurred in
first.)
(SK.ERASE.AND.DELETE.ITEM OLDELT SKETCHW) (* propagate to other windows.)
(for SKW in (ALL.SKETCH.VIEWERS SKETCH) when (AND (NEQ SKW SKETCHW)
(SETQ LOCALELT (
SK.LOCAL.ELT.FROM.GLOBALPART
GLOBALPART SKW)
))
do (SK.ERASE.AND.DELETE.ITEM LOCALELT SKW])
(SK.ERASE.ELT
[LAMBDA (ELT WINDOW REGION) (* rrb "18-MAR-83 12:59")
(* erases a sketch element)
(DSPOPERATION (QUOTE ERASE)
WINDOW)
(SK.DRAWFIGURE ELT WINDOW REGION)
(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 "18-MAR-83 13:02")
(* deletes an element from a window)
(AND ELT (WINDOWDELPROP SKETCHW (QUOTE SKETCHSPECS)
ELT])
)
(* fns for moving things.)
(DEFINEQ
(SK.MOVE.ELT
[LAMBDA (W) (* rrb "19-MAR-83 11:26")
(* lets the user select an element and move it.)
(EVAL.AS.PROCESS (LIST (QUOTE SK.SEL.AND.MOVE)
W])
(SK.SEL.AND.MOVE
[LAMBDA (W) (* rrb "19-MAR-83 11:33")
(* lets the user select an element and move it.)
(PROG ((SELPOS (SK.SELECT.ITEM W))
NEWPOS)
(COND
(SELPOS (CURSORPOSITION SELPOS W)
(SETQ NEWPOS (GETDRAWPOSITION W))
(SK.MOVE.THING SELPOS NEWPOS W)))
(RETURN SELPOS])
(SK.MOVE.THING
[LAMBDA (SELPOS NEWPOS W) (* rrb "19-MAR-83 11:26")
(* moves the selected point to the new position.)
(AND NEWPOS (PROG ((SKETCHELT (IN.SKETCH.ELT? (LOCALSPECS.FROM.VIEWER W)
SELPOS)))
(* moving a piece of an element.)
(* (SELECTQ (fetch PTYPE of (fetch (SCREENELT GLOBALPART) of SKETCHELT)) (CURVE (FIGW.MOVE.CURVEPART SKETCHELT
SELPOS NEWPOS W)) (TEXT (FIGW.MOVE.TEXT SKETCHELT SELPOS NEWPOS W)) (IMAGE (FIGW.MOVE.IMAGE SKETCHELT SELPOS
NEWPOS W)) (CIRCLE (FIGW.MOVE.CIRCLEPART SKETCHELT SELPOS NEWPOS W)) (ELLIPSE (FIGW.MOVE.ELLIPSEPART SKETCHELT
SELPOS NEWPOS W)) (ERROR "bad figure element" SKETCHELT)))
(AND SKETCHELT (SK.UPDATE.ELEMENT SKETCHELT
(APPLY* (SK.MOVEFN
(fetch (GLOBALELEMENT GTYPE)
of (fetch (SCREENELT GLOBALPART)
of SKETCHELT)))
SKETCHELT SELPOS NEWPOS W)
W])
(UPDATE.ELEMENT.IN.SKETCH
[LAMBDA (OLDGELT NEWGELT SKETCH) (* rrb "19-MAR-83 11:55")
(* changes the global sketch)
(PROG ((SKETCHDATA (INSURE.SKETCH SKETCH))) (* if old and new are the same, the change was done
destructively; otherwise clobber the new one in.)
(OR (EQ OLDGELT NEWGELT)
(for GELTTAIL on SKETCHDATA when (EQ (CAR GELTTAIL)
OLDGELT)
do (RPLACA GELTTAIL NEWGELT)
(RETURN)))
(MARKASCHANGED (LIST (fetch (SKETCH SKETCHNAME) of SKETCHDATA)
(QUOTE SKETCH))
(QUOTE PROPS])
(SK.UPDATE.ELEMENT
[LAMBDA (OLDELT NEWGLOBAL SKETCHW) (* rrb "19-MAR-83 11:25")
(* 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 ((GLOBALPART (fetch (SCREENELT GLOBALPART) of OLDELT))
(SKETCH (SKETCH.FROM.VIEWER SKETCHW))
LOCALELT) (* update the element in the sketch first.)
(UPDATE.ELEMENT.IN.SKETCH GLOBALPART NEWGLOBAL SKETCH)
(* do the window that the interaction occurred in
first.)
(SK.UPDATE.ELEMENT1 OLDELT NEWGLOBAL SKETCHW) (* propagate to other windows.)
(for SKW in (ALL.SKETCH.VIEWERS SKETCH) when (AND (NEQ SKW SKETCHW)
(SETQ LOCALELT (
SK.LOCAL.ELT.FROM.GLOBALPART
GLOBALPART SKW)
))
do (SK.UPDATE.ELEMENT1 LOCALELT NEWGLOBAL SKW])
(SK.UPDATE.ELEMENT1
[LAMBDA (OLDELT NEWGELT SKETCHW) (* rrb "19-MAR-83 11:22")
(* replaces an old element with a new one created from a
new global part. This works only in the given window.)
(SK.ERASE.AND.DELETE.ITEM OLDELT SKETCHW)
(SKETCH.ADD.AND.DISPLAY1 NEWGELT SKETCHW])
)
(* utility routines for sketch windows.)
(DEFINEQ
(LOCALSPECS.FROM.VIEWER
[LAMBDA (SKW) (* rrb "18-MAR-83 11:22")
(* returns the sketch specification displayed in the
window SKW.)
(CDR (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])
)
(DEFINEQ
(INSURE.SKETCH
[LAMBDA (SK) (* rrb "17-MAR-83 22:06")
(* returns the SKETCH structure from a name or a
structure.)
(COND
[(LITATOM SK)
(COND
((GETPROP SK (QUOTE SKETCH)))
(T (ERROR SK "not a SKETCH"]
(T SK])
(INSPECT.SKETCH
[LAMBDA (SKW) (* rrb "17-MAR-83 22:36")
(* calls the inspector on the sketch specs of a sketch
window.)
(INSPECT/TOP/LEVEL/LIST (LOCALSPECS.FROM.VIEWER SKW])
(INIT.SKETCH.ELEMENTS
[LAMBDA NIL (* rrb "30-MAR-83 11:54")
(* sets up the initial sketch element types.)
(* put the datatype for the element on the property list
of the name and use the name in the instances.)
(* (QUOTE (Text FIGW.ADDTEXT "Adds text to the figure.")) (LIST CIRCLEICON (QUOTE FIGW.ADDCIRCLE)
"Adds a circle to the figure.") (LIST ELLIPSEICON (QUOTE FIGW.ADDELLIPSE) "Adds an ellipse to the figure.")
(LIST CLOSECURVEICON (QUOTE FIGW.ADDCLOSEDCURVE) "Adds a closed curve by accepting points the curve goes through."
))
(SETQ SKETCH.ELEMENT.TYPES (CONS (PUTPROP (QUOTE CIRCLE)
(QUOTE SKETCHTYPE)
(create SKETCHTYPE
LABEL ← CIRCLEICON
DOCSTR ← "Adds a circle to the figure."
DRAWFN ←(FUNCTION CIRCLE.DRAWFN)
EXPANDFN ←(FUNCTION CIRCLE.EXPANDFN)
MOVEFN ←(FUNCTION CIRCLE.MOVEFN)
CHANGEFN ←(FUNCTION)
INPUTFN ←(FUNCTION CIRCLE.INPUTFN)
INSIDEFN ←(FUNCTION CIRCLE.INSIDEFN)))
SKETCH.ELEMENT.TYPES))
(SETQ SKETCH.ELEMENT.TYPE.NAMES (CONS (QUOTE CIRCLE)
SKETCH.ELEMENT.TYPE.NAMES))
(SETQ SKETCH.ELEMENT.TYPES (CONS (PUTPROP (QUOTE ELLIPSE)
(QUOTE SKETCHTYPE)
(create SKETCHTYPE
LABEL ← ELLIPSEICON
DOCSTR ← "Adds a circle to the figure."
DRAWFN ←(FUNCTION ELLIPSE.DRAWFN)
EXPANDFN ←(FUNCTION ELLIPSE.EXPANDFN)
MOVEFN ←(FUNCTION ELLIPSE.MOVEFN)
CHANGEFN ←(FUNCTION)
INPUTFN ←(FUNCTION ELLIPSE.INPUTFN)
INSIDEFN ←(FUNCTION)))
SKETCH.ELEMENT.TYPES))
(SETQ SKETCH.ELEMENT.TYPE.NAMES (CONS (QUOTE ELLIPSE)
SKETCH.ELEMENT.TYPE.NAMES))
(SETQ SKETCH.ELEMENT.TYPES (CONS (PUTPROP (QUOTE OPENCURVE)
(QUOTE SKETCHTYPE)
(create SKETCHTYPE
LABEL ← OPENCURVEICON
DOCSTR ←
"Adds a curve by accepting points the curve goes through."
DRAWFN ←(FUNCTION)
EXPANDFN ←(FUNCTION)
MOVEFN ←(FUNCTION)
CHANGEFN ←(FUNCTION)
INPUTFN ←(FUNCTION)
INSIDEFN ←(FUNCTION)))
SKETCH.ELEMENT.TYPES))
(SETQ SKETCH.ELEMENT.TYPE.NAMES (CONS (QUOTE OPENCURVE)
SKETCH.ELEMENT.TYPE.NAMES])
(SKETCH.ELEMENT.NAMEP
[LAMBDA (X) (* rrb "18-MAR-83 11:53")
(* is X a sketch element type name?)
(FMEMB X SKETCH.ELEMENT.TYPE.NAMES])
)
(DEFINEQ
(MAPSKETCHSPECS
[LAMBDA (SKSPECS SPECFN DATUM DATUM2) (* rrb "18-MAR-83 15:49")
(* walks through a sketch specification list and applies
SPECFN to each of the individual elements.)
(AND SKSPECS (PROG (X)
(RETURN (COND
((AND (SETQ X (fetch (SCREENELT GLOBALPART) of SKSPECS))
(SKETCH.ELEMENT.NAMEP (fetch (GLOBALELEMENT GTYPE)
of X)))
(APPLY* SPECFN SKSPECS DATUM DATUM2))
((LISTP SKSPECS)
(for FIGSPEC in SKSPECS do (MAPSKETCHSPECS FIGSPEC SPECFN DATUM
DATUM2)))
(T (ERROR "unknown figure specification" SKSPECS])
(MAPSKETCHSPECSUNTIL
[LAMBDA (SKETCHSPECS SPECFN DATUM DATUM2) (* rrb "18-MAR-83 11:54")
(* walks through a sketch specification list and applies
SPECFN to each of the individual elements.)
(AND SKETCHSPECS (COND
((SKETCH.ELEMENT.NAMEP (fetch (GLOBALELEMENT GTYPE) of (fetch (SCREENELT GLOBALPART)
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])
)
(* functions for marking)
(DEFINEQ
(SK.SHOWMARKS
[LAMBDA (W ELEMENTS) (* rrb "18-MAR-83 11:48")
(* marks all of the hot spots of sketch elements in a
figure window.)
(MAPSKETCHSPECS (OR ELEMENTS (LOCALSPECS.FROM.VIEWER W))
(FUNCTION SK.MARKSELECTIONSPOTS)
W])
(MARKPOINT
[LAMBDA (PT WINDOW MARK) (* rrb "18-MAR-83 11:47")
(* marks a point in a window with a mark.
The mark should be a bitmap. NIL)
(OR MARK (SETQ MARK SK.SELECTEDMARK))
(PROG ((MARKWIDTH (BITMAPWIDTH MARK))
HALFWIDTH)
(RETURN (BITBLT MARK 0 0 WINDOW (IDIFFERENCE (fetch (POSITION XCOORD) of PT)
(SETQ HALFWIDTH (LRSH MARKWIDTH 1)))
(IDIFFERENCE (fetch (POSITION YCOORD) of PT)
HALFWIDTH)
MARKWIDTH MARKWIDTH (QUOTE INPUT)
(QUOTE INVERT])
(SK.MARKHOTSPOTS
[LAMBDA (SKETCHELT W MARK) (* rrb "18-MAR-83 11:47")
(* marks the hotspots of a sketch element.)
(MARKSPOTS (fetch (LOCALPART HOTSPOTS) of (fetch (SCREENELT LOCALPART) of SKETCHELT))
W MARK])
(SK.MARKSELECTIONSPOTS
[LAMBDA (SKETCHELT W) (* rrb "18-MAR-83 13:30")
(* marks the pick up points of a figure element.)
(SK.MARKHOTSPOTS SKETCHELT W SK.LOCATEMARK])
(MARKSPOTS
[LAMBDA (PTS WINDOW MARK) (* rrb "10-JAN-83 11:01")
(* marks the points on the list PTS in window.)
(for PT in PTS do (MARKPOINT PT WINDOW MARK])
(SK.MARK.SELECTION
[LAMBDA (ELT SKW) (* rrb "18-MAR-83 12:31")
(* marks or unmarks a selection.)
(COND
((POSITIONP ELT) (* handle positions {points} specially.)
(MARKPOINT ELT SKW SK.SELECTEDMARK))
(T (SK.MARKHOTSPOTS ELT SKW SK.SELECTEDMARK])
)
(* hit detection functions.)
(DEFINEQ
(IN.SKETCH.ELT?
[LAMBDA (ITEMS POS PTFLG) (* rrb "18-MAR-83 12:27")
(MAPSKETCHSPECSUNTIL ITEMS (FUNCTION SK.ON.HOT.SPOT)
POS PTFLG])
(SK.ON.HOT.SPOT
[LAMBDA (SKETCHELT POS PTFLG) (* rrb "18-MAR-83 12:27")
(* determines if the position POS is on the element FIGUREELT. If so it returns the element unless PTFLG is
non-NIL when it returns the point it hit.)
(PROG (NEARPT)
(SETQ NEARPT (for PT in (fetch (LOCALPART HOTSPOTS) of (fetch (SCREENELT LOCALPART)
of SKETCHELT))
thereis (FIGW.NEARPT PT POS)))
(RETURN (AND NEARPT (COND
(PTFLG NEARPT)
(T SKETCHELT])
(SK.SELECT.ITEM
[LAMBDA (WINDOW ITEMFLG) (* rrb "18-MAR-83 12:51")
(* 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. Keeps control and probably shouldn't)
(PROG ((SELECTABLEITEMS (LOCALSPECS.FROM.VIEWER WINDOW))
NOW PREVIOUS OLDPOS BUTTON)
(COND
((NULL SELECTABLEITEMS) (* no items, don't do anything.)
(RETURN)))
(TOTOPW WINDOW)
(SK.SHOWMARKS WINDOW SELECTABLEITEMS)
(until (MOUSESTATE (NOT UP)))
(COND
((LASTMOUSESTATE MIDDLE)
(SETQQ BUTTON MIDDLE))
((LASTMOUSESTATE LEFT)
(SETQQ BUTTON LEFT))
(T (* for now not interested in anything besides left and
middle.)
(RETURN))) (* note current item selection.)
(SETQ NOW (IN.SKETCH.ELT? SELECTABLEITEMS (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)
(GETMOUSESTATE) (* look for change of buttons.)
(COND
((LASTMOUSESTATE MIDDLE)
(SETQQ BUTTON MIDDLE))
((LASTMOUSESTATE LEFT)
(SETQQ BUTTON LEFT))
(T (SETQ BUTTON NIL)))
(COND
((NOT BUTTON) (* button up, selected item if one)
(SK.DESELECT.ELT PREVIOUS WINDOW)
(SK.SHOWMARKS WINDOW SELECTABLEITEMS)
(RETURN PREVIOUS))
([EQ PREVIOUS (SETQ NOW (IN.SKETCH.ELT? SELECTABLEITEMS (CURSORPOSITION NIL WINDOW OLDPOS)
(NULL ITEMFLG]
(GO LP))
(T (GO FLIP])
(SK.SELECT.ELT
[LAMBDA (ELT FIGW) (* rrb "18-MAR-83 12:43")
(* selects an item from a figure window.)
(* for now just mark it.)
(AND ELT (SK.MARK.SELECTION ELT FIGW])
(SK.DESELECT.ELT
[LAMBDA (ELT SKW) (* rrb "18-MAR-83 12:44")
(* deselects an item from a figure window.)
(* for now just unmark it.)
(AND ELT (SK.MARK.SELECTION ELT SKW])
)
(* functions for determining what is inside of a window.)
(DEFINEQ
(ELT.INSIDE.SKETCHWP
[LAMBDA (ELT SKW) (* rrb "30-MAR-83 11:57")
(* determines if a global element is in the region of a
viewer)
(SK.INSIDE.REGION ELT (WINDOWPROP SKW (QUOTE REGION.VIEWED])
(SK.INSIDE.REGION
[LAMBDA (ELT REGION) (* rrb "30-MAR-83 11:54")
(* determines if the element ELT is inside of the region
viewed by SKW.)
(APPLY* (SK.INSIDEFN (fetch (GLOBALELEMENT GTYPE) of (fetch (SCREENELT GLOBALPART) of ELT)))
ELT REGION])
)
(DEFINEQ
(SKETCH.ZOOM
[LAMBDA (SKW) (* rrb "29-MAR-83 11:47")
(* changes the scale of the figure being looked at in a
window.)
(PROG (NEWREG NEWSCALE (OLDSCALE (SKETCHW.SCALE SKW))
(OLDREG (DSPCLIPPINGREGION NIL SKW)))
(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))
(CLRPROMPT) (* scale on the basis of heights.)
(COND
((AND (EQ [SETQ NEWSCALE (FIX (FTIMES OLDSCALE (FQUOTIENT (fetch (REGION HEIGHT)
of NEWREG)
(fetch (REGION HEIGHT)
of OLDREG]
1)
(EQ OLDSCALE 1))
(PROMPTPRINT "Can't zoom out any farther.")))
(WINDOWPROP SKW (QUOTE SCALE)
NEWSCALE)
(ABSWXOFFSET (FIX (FQUOTIENT (FTIMES (fetch (REGION LEFT) of NEWREG)
OLDSCALE)
NEWSCALE))
SKW)
(ABSWYOFFSET (FIX (FQUOTIENT (FTIMES (fetch (REGION BOTTOM) of NEWREG)
OLDSCALE)
NEWSCALE))
SKW)
(SK.UPDATE.AFTER.SCALE.CHANGE SKW])
(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])
(ABSWXOFFSET
[LAMBDA (NEWX W) (* rrb "29-MAR-83 11:27")
(* sets the offset of a window.)
(WXOFFSET (IDIFFERENCE (WXOFFSET NIL W)
NEWX)
W])
(ABSWYOFFSET
[LAMBDA (NEWY W) (* rrb "29-MAR-83 11:28")
(* sets the offset of a window.)
(WYOFFSET (IDIFFERENCE (WYOFFSET NIL W)
NEWY)
W])
(SKETCH.HOME
[LAMBDA (SKW) (* rrb "28-MAR-83 21:07")
(* changes the scale of the figure being looked at in a
window.)
(PROG NIL (* scale on the basis of heights.)
(WINDOWPROP SKW (QUOTE SCALE)
INITIAL.SCALE)
(WXOFFSET (WXOFFSET NIL SKW)
SKW)
(WYOFFSET (WYOFFSET NIL SKW)
SKW)
(SK.UPDATE.AFTER.SCALE.CHANGE SKW])
(SKETCH.NEW.VIEW
[LAMBDA (SKW) (* rrb "29-MAR-83 17:47")
(* opens a new view onto the sketch viewed by SKW.)
(SKETCHW.CREATE (SKETCH.FROM.VIEWER SKW)
NIL NIL (SKETCHW.SCALE SKW])
(ZOOM.UPDATE.ELT
[LAMBDA (ELT SKW) (* rrb "28-MAR-83 20:27")
(* destructively updates the local part of an element in
response to a zoom command.)
(replace (SCREENELT LOCALPART) of ELT with (fetch (SCREENELT LOCALPART)
of (SK.LOCAL.FROM.GLOBAL (fetch (SCREENELT
GLOBALPART)
of ELT)
SKW])
(SK.UPDATE.AFTER.SCALE.CHANGE
[LAMBDA (SKETCHW) (* rrb "29-MAR-83 18:04")
(* called to update the display and local elements after
a window has had a scale change.)
(MAPSKETCHSPECS (LOCALSPECS.FROM.VIEWER SKETCHW)
(FUNCTION ZOOM.UPDATE.ELT)
SKETCHW)
(SK.UPDATE.REGION.VIEWED SKETCHW)
(DSPFILL NIL NIL (QUOTE REPLACE)
SKETCHW)
(SKETCHW.REPAINTFN SKETCHW])
)
(* functions for the individual sketch element types.)
(DEFINEQ
(CIRCLE.EXPANDFN
[LAMBDA (GCIRCLE SKETCHW) (* rrb "18-MAR-83 15:52")
(* returns a screen elt that has a circle screen element
calculated from the global part.)
(PROG (CENTER RADIUSPT)
(RETURN (create SCREENELT
LOCALPART ←(create LOCALCIRCLE
CENTERPOSITION ←(SETQ CENTER (
SCALE.POSITION.INTO.SKETCHW (fetch (CIRCLE
CENTERLATLON)
of GCIRCLE)
SKETCHW))
RADIUSPOSITION ←(SETQ RADIUSPT
(SCALE.POSITION.INTO.SKETCHW (fetch (CIRCLE
RADIUSLATLON)
of GCIRCLE)
SKETCHW))
RADIUS ←(DISTANCEBETWEEN CENTER RADIUSPT))
GLOBALPART ← GCIRCLE])
(CIRCLE.DRAWFN
[LAMBDA (CIRCLEELT WINDOW REGION) (* rrb "18-MAR-83 15:54")
(* draws a circle from a circle element.)
(PROG ((GCIRCLE (fetch (SCREENELT GLOBALPART) of CIRCLEELT))
(LCIRCLE (fetch (SCREENELT LOCALPART) of CIRCLEELT))
CPOS)
(SETQ CPOS (fetch (LOCALCIRCLE CENTERPOSITION) of LCIRCLE))
(RETURN (DRAWCIRCLE (fetch (POSITION XCOORD) of CPOS)
(fetch (POSITION YCOORD) of CPOS)
(fetch (LOCALCIRCLE RADIUS) of LCIRCLE)
(fetch (CIRCLE BRUSH) of GCIRCLE)
(fetch (CIRCLE DASHING) of GCIRCLE)
WINDOW])
(CIRCLE.MOVEFN
[LAMBDA (CIRCLESPEC SELPOS NEWPOS WINDOW) (* rrb "19-MAR-83 11:57")
(* returns a changed global circle element which has the
part SELPOS moved to NEWPOS.)
(PROG ((LCIRCLE (fetch (SCREENELT LOCALPART) of CIRCLESPEC))
(GCIRCLE (fetch (SCREENELT GLOBALPART) of CIRCLESPEC))
CENTERPT RADIUSPT)
(SETQ CENTERPT (fetch (LOCALCIRCLE CENTERPOSITION) of LCIRCLE))
(SETQ RADIUSPT (fetch (LOCALCIRCLE RADIUSPOSITION) of LCIRCLE))
[COND
((EQUAL SELPOS CENTERPT) (* center point moved, move both center and radius.)
(replace (CIRCLE CENTERLATLON) of GCIRCLE with (UNSCALE.POSITION.FROM.SKETCHW NEWPOS
WINDOW))
(replace (CIRCLE RADIUSLATLON) of GCIRCLE with (UNSCALE.POSITION.FROM.SKETCHW
(PTPLUS RADIUSPT (PTDIFFERENCE NEWPOS
CENTERPT))
WINDOW)))
((EQUAL SELPOS RADIUSPT)
(replace (CIRCLE RADIUSLATLON) of GCIRCLE with (UNSCALE.POSITION.FROM.SKETCHW NEWPOS
WINDOW]
(RETURN GCIRCLE])
(CIRCLE.INPUTFN
[LAMBDA (WINDOW) (* rrb "23-MAR-83 15:07")
(* reads a two points from the user and returns a circle
element that it represents.)
(PROG (P1 P2 (SCALE (SKETCHW.SCALE WINDOW)))
(printout PROMPTWINDOW T "Indicate center of circle")
(SETQ P1 (GETPOSITION WINDOW CIRCLE.CENTER))
(MARK.SPOT P1 NIL WINDOW)
(printout PROMPTWINDOW T "Indicate a point of the circumference of the circle")
(SETQ P2 (GETPOSITION WINDOW CIRCLE.EDGE)) (* erase center mark)
(MARK.SPOT P1 NIL WINDOW)
(RETURN (create CIRCLE
MAXSCALE ←(TIMES SCALE DEFAULT.VISIBLE.SCALE.FACTOR)
MINSCALE ←(QUOTIENT SCALE DEFAULT.VISIBLE.SCALE.FACTOR)
CENTERLATLON ←(UNSCALE.POSITION.FROM.SKETCHW P1 WINDOW)
RADIUSLATLON ←(UNSCALE.POSITION.FROM.SKETCHW P2 WINDOW)
BRUSH ← CURRENTFIGUREWBRUSH
DASHING ← CURRENTFIGUREWDASHING])
(CIRCLE.INSIDEFN
[LAMBDA (GCIRCLE WREG) (* rrb "24-JAN-83 20:19")
(* determines if the global circle GCIRCLE is inside of
WREG.)
(* consider a circle inside only if one of its control points is inside. {old code (PROG ((CPOS
(fetch (CIRCLE CENTERLATLON) of LCIRCLE)) CX CY RAD) (SETQ RAD (DISTANCEBETWEEN CPOS (fetch
(CIRCLE RADIUSLATLON) of LCIRCLE))) (RETURN (AND (ILESSP (FETCH (REGION BOTTOM) OF WREG) (DIFFERENCE
(SETQ CY (FETCH (POSITION YCOORD) OF CPOS)) RAD)) (ILESSP (FETCH (REGION LEFT) OF WREG) (DIFFERENCE
(SETQ CX (FETCH (POSITION XCOORD) OF CPOS)) RAD)) (IGREATERP (FETCH (REGION TOP) OF WREG)
(IPLUS CY RAD)) (IGREATERP (FETCH (REGION RIGHT) OF WREG) (IPLUS CX RAD))))) })
(OR (INSIDEP WREG (fetch (CIRCLE CENTERLATLON) of GCIRCLE))
(INSIDEP WREG (fetch (CIRCLE RADIUSLATLON) of GCIRCLE])
)
[DECLARE: EVAL@COMPILE
(RECORD LOCALCIRCLE ((CENTERPOSITION RADIUSPOSITION)
RADIUS))
]
(DEFINEQ
(ELLIPSE.EXPANDFN
[LAMBDA (GELLIPSE SKETCHW) (* rrb "19-MAR-83 11:54")
(* returns a screen elt that has a ellipse screen
element calculated from the global part.)
(PROG (CENTER MINRAD MAJRAD)
(RETURN (create SCREENELT
LOCALPART ←(create LOCALELLIPSE
ELLIPSECENTER ←(SETQ CENTER (SCALE.POSITION.INTO.SKETCHW
(fetch (ELLIPSE ELLIPSECENTERLATLON) of GELLIPSE)
SKETCHW))
MINORRADIUSPOSITION ←(SETQ MINRAD
(SCALE.POSITION.INTO.SKETCHW (fetch (ELLIPSE
SEMIMINORLATLON)
of GELLIPSE)
SKETCHW))
MAJORRADIUSPOSITION ←(SETQ MAJRAD
(SCALE.POSITION.INTO.SKETCHW (fetch (ELLIPSE
SEMIMAJORLATLON)
of GELLIPSE)
SKETCHW))
SEMIMINORRADIUS ←(DISTANCEBETWEEN CENTER MINRAD)
SEMIMAJORRADIUS ←(DISTANCEBETWEEN CENTER MAJRAD))
GLOBALPART ← GELLIPSE])
(ELLIPSE.DRAWFN
[LAMBDA (ELLIPSEELT WINDOW REGION) (* rrb "24-JAN-83 18:36")
(* draws a ellipse from a circle element.)
(PROG ((GELLIPSE (fetch (SCREENELT GLOBALPART) of ELLIPSEELT))
(LELLIPSE (fetch (SCREENELT LOCALPART) of ELLIPSEELT))
CPOS)
(SETQ CPOS (fetch (LOCALELLIPSE ELLIPSECENTER) of LELLIPSE))
(RETURN (DRAWELLIPSE (fetch (POSITION XCOORD) of CPOS)
(fetch (POSITION YCOORD) of CPOS)
(fetch (LOCALELLIPSE SEMIMINORRADIUS) of LELLIPSE)
(fetch (LOCALELLIPSE SEMIMAJORRADIUS) of LELLIPSE)
(fetch (ELLIPSE ORIENTATION) of GELLIPSE)
(fetch (ELLIPSE BRUSH) of GELLIPSE)
(fetch (ELLIPSE DASHING) of GELLIPSE)
WINDOW])
(ELLIPSE.MOVEFN
[LAMBDA (ELLIPSEELT SELPOS NEWPOS WINDOW) (* rrb "28-MAR-83 16:55")
(* returns a global ellipse element which has the part
SELPOS moved to NEWPOS.)
(PROG ((LOCALEL (fetch (SCREENELT LOCALPART) of ELLIPSEELT))
(GLOBALEL (fetch (SCREENELT GLOBALPART) of ELLIPSEELT))
CENTERPT MINRADPT MAJRADPT PTSCALE)
(SETQ CENTERPT (fetch (LOCALELLIPSE ELLIPSECENTER) of LOCALEL))
(SETQ MINRADPT (fetch (LOCALELLIPSE MINORRADIUSPOSITION) of LOCALEL))
(SETQ MAJRADPT (fetch (LOCALELLIPSE MAJORRADIUSPOSITION) of LOCALEL))
[COND
((EQUAL SELPOS CENTERPT) (* if the center moves, take everything else with it.)
(SETQ MINRADPT (UNSCALE.POSITION.FROM.SKETCHW (PTPLUS MINRADPT (SETQ PTSCALE
(PTDIFFERENCE NEWPOS CENTERPT)))
WINDOW))
(SETQ MAJRADPT (UNSCALE.POSITION.FROM.SKETCHW (PTPLUS MAJRADPT PTSCALE)
WINDOW))
(SETQ CENTERPT (UNSCALE.POSITION.FROM.SKETCHW NEWPOS WINDOW)))
((PROGN (SETQ CENTERPT (fetch (ELLIPSE ELLIPSECENTERLATLON) of GLOBALEL))
(EQUAL SELPOS MINRADPT))
(SETQ MINRADPT (UNSCALE.POSITION.FROM.SKETCHW NEWPOS WINDOW))
(SETQ MAJRADPT (fetch (ELLIPSE SEMIMAJORLATLON) of GLOBALEL)))
((EQUAL SELPOS MAJRADPT)
(SETQ MAJRADPT (UNSCALE.POSITION.FROM.SKETCHW NEWPOS WINDOW))
(SETQ MINRADPT (fetch (ELLIPSE SEMIMINORLATLON) of GLOBALEL]
(* return a new global elt because the orientation
changes but is needed to erase the one that is already
on the screen.)
(RETURN (create ELLIPSE
MAXSCALE ←(fetch (ELLIPSE MAXSCALE) of GLOBALEL)
MINSCALE ←(fetch (ELLIPSE MINSCALE) of GLOBALEL)
ORIENTATION ←(COMPUTE.ELLIPSE.ORIENTATION CENTERPT MINRADPT)
BRUSH ←(fetch (ELLIPSE BRUSH) of GLOBALEL)
DASHING ←(fetch (ELLIPSE DASHING) of GLOBALEL)
ELLIPSECENTERLATLON ← CENTERPT
SEMIMINORLATLON ← MINRADPT
SEMIMAJORLATLON ← MAJRADPT])
(ELLIPSE.INPUTFN
[LAMBDA (WINDOW) (* rrb "19-MAR-83 12:09")
(* reads three points from the user and returns the
ellipse figure element that it represents.)
(PROG (CENTER MAJRAD MINRAD ANGLE)
(printout PROMPTWINDOW T "Indicate center of ellipse")
(SETQ CENTER (GETPOSITION WINDOW ELLIPSE.CENTER))
(MARK.SPOT CENTER NIL WINDOW)
(printout PROMPTWINDOW T "Indicate semi-major axis")
(SETQ MAJRAD (GETPOSITION WINDOW ELLIPSE.SEMI.MAJOR))
(MARK.SPOT MAJRAD NIL WINDOW)
(printout PROMPTWINDOW T "Indicate semi-minor axis")
(SETQ MINRAD (GETPOSITION WINDOW ELLIPSE.SEMI.MINOR))
(* erase the point marks.)
(MARK.SPOT MAJRAD NIL WINDOW)
(MARK.SPOT CENTER NIL WINDOW)
(RETURN (ELLIPSE.CREATE CENTER MINRAD MAJRAD CURRENTFIGUREWBRUSH CURRENTFIGUREWDASHING
WINDOW])
(ELLIPSE.INSIDEFN
[LAMBDA (GELLIPSE WREG) (* rrb "24-JAN-83 20:19")
(* determines if the global ellipse GELLIPSE is inside
of WREG.)
(* consider an ellipse inside only if one of its control
points is inside.)
(OR (INSIDEP WREG (fetch (ELLIPSE ELLIPSECENTERLATLON) of GELLIPSE))
(INSIDEP WREG (fetch (ELLIPSE SEMIMINORLATLON) of GELLIPSE))
(INSIDEP WREG (fetch (ELLIPSE SEMIMAJORLATLON) of GELLIPSE])
(ELLIPSE.CREATE
[LAMBDA (CENTER MINRAD MAJRAD BRUSH DASHING SKETCHW) (* rrb "19-MAR-83 12:11")
(* creates a global ellipse element.)
(PROG ((SCALE (SKETCHW.SCALE SKETCHW)))
(RETURN (create ELLIPSE
MAXSCALE ←(TIMES SCALE DEFAULT.VISIBLE.SCALE.FACTOR)
MINSCALE ←(QUOTIENT SCALE DEFAULT.VISIBLE.SCALE.FACTOR)
ORIENTATION ←(COMPUTE.ELLIPSE.ORIENTATION CENTER MINRAD)
BRUSH ←(OR BRUSH CURRENTFIGUREWBRUSH)
DASHING ←(OR DASHING CURRENTFIGUREWDASHING)
ELLIPSECENTERLATLON ←(UNSCALE.POSITION.FROM.SKETCHW CENTER SKETCHW)
SEMIMINORLATLON ←(UNSCALE.POSITION.FROM.SKETCHW MINRAD SKETCHW)
SEMIMAJORLATLON ←(UNSCALE.POSITION.FROM.SKETCHW MAJRAD SKETCHW])
)
[DECLARE: EVAL@COMPILE
(RECORD LOCALELLIPSE ((ELLIPSECENTER MINORRADIUSPOSITION MAJORRADIUSPOSITION)
SEMIMINORRADIUS SEMIMAJORRADIUS))
]
(DEFINEQ
(CURVE.INSIDEFN
[LAMBDA (GCURVE WREG) (* rrb "24-JAN-83 20:20")
(* determines if the global curve GCURVE is inside of
WREG.)
(* consider a curve inside only if one of its control
points is inside.)
(for PT in (fetch (CURVE LATLONKNOTS) of GCURVE) when (INSIDEP WREG PT) do (RETURN T])
)
[DECLARE: EVAL@COMPILE
]
(DEFINEQ
(TEXT.INSIDEFN
[LAMBDA (GTEXT WREG) (* rrb "24-JAN-83 20:23")
(* determines if a piece of text is inside of a world
region.)
(* consider it inside only if its location is inside.)
(INSIDEP WREG (fetch (TEXT LOCATIONLATLON) of GTEXT])
)
[DECLARE: EVAL@COMPILE
]
(DEFINEQ
(IMAGE.INSIDEFN
[LAMBDA (GIMAGE WREG) (* rrb "24-JAN-83 20:24")
(* determines if an image is inside of a world region.)
(* consider it inside only if its location is inside.)
(INSIDEP WREG (fetch (IMAGE DISPLAYLATLON) of GIMAGE])
)
[DECLARE: EVAL@COMPILE
]
(DEFINEQ
(SCALE.POSITION.INTO.SKETCHW
[LAMBDA (POS SKETCHW) (* rrb "19-MAR-83 12:05")
(* scales a position into a sketch window using its
scale factor.)
(PROG ((CLIPREG (DSPCLIPPINGREGION NIL SKETCHW)))
(RETURN (SCALE.POSITION POS (SKETCHW.SCALE SKETCHW)
(fetch (REGION LEFT) of CLIPREG)
(fetch (REGION BOTTOM) of CLIPREG])
(SKETCHW.SCALE
[LAMBDA (SKETCHW) (* rrb "14-MAR-83 10:31")
(* returns the scale of a sketch window.)
(WINDOWPROP SKETCHW (QUOTE SCALE])
(SCALE.POSITION
[LAMBDA (POSITION SCALE WLEFT WBOTTOM) (* rrb "29-MAR-83 11:45")
(* scales a position from a large coordinate space into
a window.)
(create POSITION
XCOORD ←(QUOTIENT (fetch (POSITION XCOORD) of POSITION)
SCALE)
YCOORD ←(QUOTIENT (fetch (POSITION YCOORD) of POSITION)
SCALE])
(UNSCALE.POSITION.FROM.SKETCHW
[LAMBDA (POS SKETCHW) (* rrb "19-MAR-83 12:05")
(* unscales a position in window coordinates into a
position in the larger coordinate space.)
(PROG ((CLIPREG (DSPCLIPPINGREGION NIL SKETCHW)))
(RETURN (UNSCALE.POSITION POS (SKETCHW.SCALE SKETCHW)
(fetch (REGION LEFT) of CLIPREG)
(fetch (REGION BOTTOM) of CLIPREG])
(UNSCALE.POSITION
[LAMBDA (POSITION SCALE WLEFT WBOTTOM) (* rrb "29-MAR-83 11:45")
(* unscales a point in a window out into the larger
coordinate space.)
(create POSITION
XCOORD ←(TIMES (fetch (POSITION XCOORD) of POSITION)
SCALE)
YCOORD ←(TIMES (fetch (POSITION YCOORD) of POSITION)
SCALE])
(SCALE.REGION
[LAMBDA (REGION SCALE) (* rrb "11-MAR-83 12:53")
(* scales a region)
(create REGION
LEFT ←(TIMES SCALE (fetch (REGION LEFT) of REGION))
BOTTOM ←(TIMES SCALE (fetch (REGION BOTTOM) of REGION))
WIDTH ←(TIMES SCALE (fetch (REGION WIDTH) of REGION))
HEIGHT ←(TIMES SCALE (fetch (REGION HEIGHT) of REGION])
)
(DEFINEQ
(GETDRAWPOSITION
[LAMBDA (W CURSOR) (* rrb "29-MAR-83 17:01")
(* provides a hook for the inputting of a point via mouse from the user. for now it is just reading a point but
later should add features such as yellow button means an existing pt or left means on a grid.)
(RESETFORM (CURSOR (OR CURSOR CROSSHAIRS))
(until (MOUSESTATE LEFT) do)
(until (MOUSESTATE (NOT LEFT)) do)
(create POSITION
XCOORD ←(LASTMOUSEX W)
YCOORD ←(LASTMOUSEY W])
(GETWREGION
[LAMBDA (W NEWREGIONFN NEWREGIONFNDATA) (* rrb "28-MAR-83 20:47")
(* gets a region from a window)
(PROG ((REG (GETREGION NIL NIL (WINDOWPROP W (QUOTE REGION))
NEWREGIONFN NEWREGIONFNDATA)))
(RETURN (create REGION
LEFT ←(IDIFFERENCE (fetch LEFT of REG)
(DSPXOFFSET NIL W))
BOTTOM ←(IDIFFERENCE (fetch BOTTOM of REG)
(DSPYOFFSET NIL W))
WIDTH ←(fetch WIDTH of REG)
HEIGHT ←(fetch HEIGHT of REG])
)
(RPAQ? ALL.SKETCHES )
(RPAQ? INITIAL.SCALE 16)
(RPAQ? SKETCH.ELEMENT.TYPES )
(RPAQ? SKETCH.ELEMENT.TYPE.NAMES )
(RPAQ? DEFAULT.VISIBLE.SCALE.FACTOR 10)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS ALL.SKETCHES INITIAL.SCALE DEFAULT.VISIBLE.SCALE.FACTOR SKETCH.ELEMENT.TYPES
SKETCH.ELEMENT.TYPE.NAMES SK.SELECTEDMARK SK.LOCATEMARK)
)
(READVARS SK.SELECTEDMARK SK.LOCATEMARK)
( {(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@")})
(* accessing functions for the methods of a sketch type. (SKETCHW.CREATE))
(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.MOVEFN
[LAMBDA (ELEMENTTYPE) (* rrb "19-MAR-83 11:45")
(* goes from an element type name to its EXPANDFN)
(fetch (SKETCHTYPE MOVEFN) 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])
)
[DECLARE: EVAL@COMPILE
(RECORD GLOBALELEMENT (GTYPE MINSCALE MAXSCALE . GOTHERINFO))
(RECORD LOCALPART (HOTSPOTS . OTHERLOCALINFO))
(RECORD SKETCH (SKETCHNAME . SKETCHELTS)
[TYPE? (AND (LISTP DATUM)
(LITATOM (CAR DATUM])
(DATATYPE SKETCHTYPE (LABEL DOCSTR DRAWFN EXPANDFN MOVEFN CHANGEFN INPUTFN INSIDEFN))
]
(/DECLAREDATATYPE (QUOTE SKETCHTYPE)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER)))
(INIT.SKETCH.ELEMENTS)
(PUTPROPS NEWSKETCH COPYRIGHT ("Xerox Corporation" 1983))
(DECLARE: DONTCOPY
(FILEMAP (NIL (3532 8952 (SKETCHW.CREATE 3542 . 5814) (MAP.SKETCHSPEC.INTO.VIEWER 5816 . 6310) (
SKETCHW.REPAINTFN 6312 . 6763) (CREATE.SKETCHW.COMMANDMENU 6765 . 8299) (SKETCHW.SELECTIONFN 8301 .
8950)) (8989 16067 (ADD.ELEMENT.TO.SKETCH 8999 . 9547) (ADD.SKETCH.VIEWER 9549 . 10098) (
ALL.SKETCH.VIEWERS 10100 . 10373) (ELT.INSIDE.REGION? 10375 . 10710) (ELT.INSIDE.SKWP 10712 . 11050) (
SCALE.FROM.SKW 11052 . 11304) (SK.ADDELT.TO.WINDOW 11306 . 11605) (SK.CALC.REGION.VIEWED 11607 . 11910
) (SK.DRAWFIGURE 11912 . 12837) (SK.DRAWFIGURE1 12839 . 13193) (SK.LOCAL.FROM.GLOBAL 13195 . 13575) (
SK.REGION.VIEWED 13577 . 13895) (SK.UPDATE.REGION.VIEWED 13897 . 14233) (SKETCH.ADD.AND.DISPLAY 14235
. 15071) (SKETCH.ADD.AND.DISPLAY1 15073 . 15493) (SKETCH.FROM.VIEWER 15495 . 15669) (
SKETCHW.ADD.INSTANCE 15671 . 16065)) (16104 19277 (SK.SEL.AND.DELETE 16114 . 16473) (
SK.ERASE.AND.DELETE.ITEM 16475 . 16798) (REMOVE.ELEMENT.FROM.SKETCH 16800 . 17341) (SK.DELETE.ELEMENT
17343 . 18367) (SK.ERASE.ELT 18369 . 18701) (SK.DELETE.ELT 18703 . 18992) (SK.DELETE.ITEM 18994 .
19275)) (19313 23445 (SK.MOVE.ELT 19323 . 19605) (SK.SEL.AND.MOVE 19607 . 20057) (SK.MOVE.THING 20059
. 21177) (UPDATE.ELEMENT.IN.SKETCH 21179 . 21885) (SK.UPDATE.ELEMENT 21887 . 23033) (
SK.UPDATE.ELEMENT1 23035 . 23443)) (23495 24308 (LOCALSPECS.FROM.VIEWER 23505 . 23817) (
SK.LOCAL.ELT.FROM.GLOBALPART 23819 . 24306)) (24309 27813 (INSURE.SKETCH 24319 . 24687) (
INSPECT.SKETCH 24689 . 25007) (INIT.SKETCH.ELEMENTS 25009 . 27550) (SKETCH.ELEMENT.NAMEP 27552 . 27811
)) (27814 29363 (MAPSKETCHSPECS 27824 . 28562) (MAPSKETCHSPECSUNTIL 28564 . 29361)) (29398 31786 (
SK.SHOWMARKS 29408 . 29786) (MARKPOINT 29788 . 30434) (SK.MARKHOTSPOTS 30436 . 30783) (
SK.MARKSELECTIONSPOTS 30785 . 31070) (MARKSPOTS 31072 . 31356) (SK.MARK.SELECTION 31358 . 31784)) (
31824 35447 (IN.SKETCH.ELT? 31834 . 32021) (SK.ON.HOT.SPOT 32023 . 32587) (SK.SELECT.ITEM 32589 .
34728) (SK.SELECT.ELT 34730 . 35084) (SK.DESELECT.ELT 35086 . 35445)) (35514 36259 (
ELT.INSIDE.SKETCHWP 35524 . 35854) (SK.INSIDE.REGION 35856 . 36257)) (36260 41138 (SKETCH.ZOOM 36270
. 37662) (SAME.ASPECT.RATIO 37664 . 38649) (ABSWXOFFSET 38651 . 38923) (ABSWYOFFSET 38925 . 39197) (
SKETCH.HOME 39199 . 39766) (SKETCH.NEW.VIEW 39768 . 40088) (ZOOM.UPDATE.ELT 40090 . 40598) (
SK.UPDATE.AFTER.SCALE.CHANGE 40600 . 41136)) (41202 46137 (CIRCLE.EXPANDFN 41212 . 42057) (
CIRCLE.DRAWFN 42059 . 42803) (CIRCLE.MOVEFN 42805 . 44058) (CIRCLE.INPUTFN 44060 . 45124) (
CIRCLE.INSIDEFN 45126 . 46135)) (46238 53060 (ELLIPSE.EXPANDFN 46248 . 47339) (ELLIPSE.DRAWFN 47341 .
48242) (ELLIPSE.MOVEFN 48244 . 50531) (ELLIPSE.INPUTFN 50533 . 51621) (ELLIPSE.INSIDEFN 51623 . 52260)
(ELLIPSE.CREATE 52262 . 53058)) (53212 53747 (CURVE.INSIDEFN 53222 . 53745)) (53774 54226 (
TEXT.INSIDEFN 53784 . 54224)) (54253 54683 (IMAGE.INSIDEFN 54263 . 54681)) (54710 57398 (
SCALE.POSITION.INTO.SKETCHW 54720 . 55213) (SKETCHW.SCALE 55215 . 55470) (SCALE.POSITION 55472 . 55927
) (UNSCALE.POSITION.FROM.SKETCHW 55929 . 56457) (UNSCALE.POSITION 56459 . 56908) (SCALE.REGION 56910
. 57396)) (57399 58590 (GETDRAWPOSITION 57409 . 57989) (GETWREGION 57991 . 58588)) (59261 60742 (
SK.DRAWFN 59271 . 59573) (SK.MOVEFN 59575 . 59879) (SK.EXPANDFN 59881 . 60098) (SK.INPUT 60100 . 60405
) (SK.INSIDEFN 60407 . 60740)))))
STOP