(FILECREATED "16-Oct-84 10:22:50" {ERIS}<LISPCORE>DEMO>MAPSKETCH.;1 91273
changes to: (VARS MAPSKETCHCOMS))
(* Copyright (c) 1984 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT MAPSKETCHCOMS)
(RPAQQ MAPSKETCHCOMS ((FNS ADDFIGUREWELT BITMAPFROMFILE DECODEBITMAP FIGURESPECS GETDRAWPOSITION
MAPFIGURESPECS MAPFIGURESPECSUNTIL READBRUSHSIZE READSPLINE READCIRCLE
READELLIPSE RESHAPEBYREPAINTANDMOVEFN SETFIGUREWBRUSHSHAPE
SETFIGUREWBRUSHSIZE SHOWDRAWPOINT SHOWFIGUREKNOTS)
(FNS FIGW.DRAWFIGURE FIGW.ERASE.ELT FIGW.DRAWCURVE FIGW.DRAWIMAGE FIGW.DRAWCIRCLE
FIGW.DRAWELLIPSE)
(FNS FIGW.ADDCLOSEDCURVE FIGW.ADDCIRCLE FIGW.ADDELLIPSE FIGW.ADDOPENCURVE FIGW.DELETE.ELT
FIGW.SEL.AND.DELETE FIGW.DELETE.ITEM FIGW.ERASE.AND.DELETE.ITEM CREATE.CIRCLE.ELT
LOCAL.CIRCLE.FROM.GLOBAL CREATE.SPLINE.ELT CREATE.ELLIPSE.ELT LOCAL.ELLIPSE.FROM.GLOBAL
COMPUTE.ELLIPSE.ORIENTATION)
(FNS FIGW.ADD.ELEMENT FIGW.DELETE.ELEMENT MAPW.INSIDE.REGION ELT.INSIDE.MAPWP
FIGW.DISPLAY.AND.ADD.ITEM FIGW.DISPLAY.AND.ADD.ITEMS FIGW.MOVE.THING FIGW.MOVE.ELT
FIGW.SEL.AND.MOVE FIGW.MOVE.CURVEPART FIGW.MOVE.CIRCLEPART FIGW.MOVE.ELLIPSEPART
FIGW.MOVE.IMAGE)
(FNS MARKFIGURE FIGW.SHOWMARKS FIGW.MARKSELECTIONSPOTS MARKKNOTS MARKPOINT MARKCIRCLEKNOTS
MARKELLIPSEKNOTS MARKIMAGEKNOTS)
(FNS ON.CIRCLE.HOT.SPOT FIGW.SELECT.ITEM FIGW.DESELECT.ELT FIGW.MARK.SELECTION
FIGW.SELECT.ELT IN.FIGURE.ELT? ON.HOT.SPOT ON.CURVE.HOT.SPOT ON.ELLIPSE.HOT.SPOT
ON.IMAGE.HOT.SPOT FIGW.NEARPT)
(COMS (* stuff for changing properties of a figure element)
(FNS FIGW.CHANGE.ELT FIGW.SEL.AND.CHANGE FIGW.CHANGE.PROPERTY FIGW.UPDATE.ELEMENT
LOCAL.ELT.OF.GLOBALPART FIGW.LOCAL.FROM.GLOBAL LOCAL.CURVE.FROM.GLOBAL
LOCAL.TEXT.FROM.GLOBAL LOCAL.IMAGE.FROM.GLOBAL FIGW.UPDATE.FIGURE.ELEMENT1
CHANGE.CURVEPART FIGW.DECODE.DASHING CREATE.SPLINE.ELT.USING READDASHING)
(VARS (CURVE.PROPERTY.MENU)
(TEXT.PROPERTY.MENU)
(IMAGE.PROPERTY.MENU)
(CIRCLE.PROPERTY.MENU)
(ELLIPSE.PROPERTY.MENU)
(CHOOSE.FONT.MENU)
(MAPW.NUMBERPAD.READER)))
(FNS FIGUREW CREATE.FIGUREW.COMMANDMENU INSPECTFIGURESPECS FIGUREW.BUTTON.HANDLER
FIGUREW.CLOSEFN FIGUREW.MOVEFN FIGUREW.OPENFN FIGUREW.REPAINTFN FIGUREW.SELECTIONFN
CREATE.MAPW.NUMBERPAD.READER)
(* functions for dealing with text.)
(FNS FIGW.DRAWTEXT FIGW.ADDTEXT READTEXT POSITIONTEXTELT FIGW.MOVE.TEXT MARKTEXTREGION
ON.TEXT.HOT.SPOT CREATE.TEXT.ELT.USING CHANGE.TEXTPART READFONT)
(FNS GET.BITMAP.POSITION TRACK.BITMAP1)
(FNS DISTANCEBETWEEN SQUARE)
(FNS GETAISFILEINFO INVISIBLEPARTP UPPERLEFTMENUPOSITION)
(EXPORT (RECORDS PELT SCREENELT CURVE TEXT CIRCLE ELLIPSE IMAGE LOCALIMAGE LOCALELLIPSE
LOCALCIRCLE LOCALTEXT LOCALCURVE))
(CURSORS POINTREADINGCURSOR)
(UGLYVARS POINTMARK FIGW.SELECTEDMARK FIGW.LOCATEMARK CLOSECURVEICON OPENCURVEICON CIRCLEICON
ELLIPSEICON)
(COMS (* functions needed from NOTEPAD. Copied here so don't need all of notepad.)
(FNS MARK.SPOT READ.FROM.PROMPT.WINDOW GETWREGION)
(BITMAPS SPOTMARKER)
(CURSORS CIRCLE.CENTER CIRCLE.EDGE ELLIPSE.CENTER ELLIPSE.SEMI.MAJOR ELLIPSE.SEMI.MINOR
CURVE.KNOT))
(RECORDS BRUSH)
(VARS BITMAPDIRECTORIES DRAWBITMAPALIST DRAWCURVESWITHLINESFLG FIGURE.ELEMENT.TYPES (
DRAWCURVEWITHLINESFLG)
DEFAULT.VISIBLE.SCALE.FACTOR
(CURRENTFIGUREWBRUSH (CREATE BRUSH BRUSHSHAPE ← (QUOTE ROUND)
BRUSHSIZE ← 1 BRUSHCOLOR ← WHITECOLOR))
(CURRENTFIGUREWDASHING)
(CURRENTFIGWFONT (QUOTE (HELVETICA 12)))
(CHARMICONFONT))
(FILES (FROM VALUEOF LISPUSERSDIRECTORIES)
READNUMBER)
(GLOBALVARS BITMAPDIRECTORIES DRAWBITMAPALIST DRAWCURVEWITHLINESFLG CURRENTFIGUREWBRUSH
CURRENTFIGUREWDASHING POINTMARK CLOSECURVEICON OPENCURVEICON ELLIPSEICON
CIRCLEICON POINTMARKHALFWIDTH POINTMARKWIDTH DEFAULT.VISIBLE.SCALE.FACTOR
FIGURE.ELEMENT.TYPES)))
(DEFINEQ
(ADDFIGUREWELT
[LAMBDA (PELT FIGUREW) (* rrb "13-JAN-83 11:06")
(* adds a picture element to a figure window.)
(AND PELT (WINDOWADDPROP FIGUREW (QUOTE FIGURESPECS)
PELT])
(BITMAPFROMFILE
[LAMBDA (FILE) (* rrb "30-NOV-82 18:31")
(* reads a bitmap from a file.)
(PROG (BM)
(SELECTQ (LISTGET (UNPACKFILENAME FILE)
(QUOTE EXTENTION))
[AIS (AISBLT FILE NIL NIL (SETQ BM (BITMAPCREATE (GETAISFILEINFO FILE
(QUOTE WIDTH))
(GETAISFILEINFO FILE
(QUOTE HEIGHT]
(ERROR "Unknown bitmap file format." FILE))
(RETURN BM])
(DECODEBITMAP
[LAMBDA (BMSPEC) (* rrb "30-NOV-82 18:33")
(* decodes a specification of a bitmap into a bitmap. The spec can be a bitmap, the name of a bitmap, a file name or
an expression that evaluates into a bitmap.)
(PROG (X)
(RETURN (COND
((BITMAPP BMSPEC))
((SETQ X (FASSOC BMSPEC DRAWBITMAPALIST))
(* provides a way of caching specs)
(CDR X))
((AND (LITATOM BMSPEC)
(SETQ X (FINDFILE BMSPEC NIL BITMAPDIRECTORIES)))
(* maybe its a file name such as an AIS file.)
(* if so save it in the cache for future use.)
(SETQ DRAWBITMAPALIST (CONS (CONS BMSPEC (SETQ X (BITMAPFROMFILE X)))
BITMAPDIRECTORIES))
X)
((BITMAPP (EVAL BMSPEC])
(FIGURESPECS
[LAMBDA (FIGUREW) (* returns the figure specs from a figure window.)
(WINDOWPROP FIGUREW (QUOTE FIGURESPECS])
(GETDRAWPOSITION
[LAMBDA (W CURSOR) (* rrb "13-JAN-83 13:33")
(* 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 (UPDATELATLON W))
(until (MOUSESTATE (NOT LEFT)) do (UPDATELATLON W))
(create POSITION
XCOORD ←(LASTMOUSEX W)
YCOORD ←(LASTMOUSEY W])
(MAPFIGURESPECS
[LAMBDA (FIGSPECS SPECFN DATUM DATUM2) (* rrb "24-JAN-83 19:51")
(* walks through a figure specification list and
applies SPECFN to each of the individual elements.)
(AND FIGSPECS (COND
((FMEMB (fetch PTYPE of (fetch (SCREENELT GLOBALPART) of FIGSPECS))
FIGURE.ELEMENT.TYPES)
(APPLY* SPECFN FIGSPECS DATUM DATUM2))
((LISTP FIGSPECS)
(for FIGSPEC in FIGSPECS do (MAPFIGURESPECS FIGSPEC SPECFN DATUM DATUM2)))
(T (ERROR "unknown figure specification" FIGSPECS])
(MAPFIGURESPECSUNTIL
[LAMBDA (FIGSPECS SPECFN DATUM DATUM2) (* rrb "27-JAN-83 11:49")
(* walks through a figure specification list and
applies SPECFN to each of the individual elements.)
(AND FIGSPECS (COND
((FMEMB (fetch PTYPE of (fetch (SCREENELT GLOBALPART) of FIGSPECS))
FIGURE.ELEMENT.TYPES)
(APPLY* SPECFN FIGSPECS DATUM DATUM2))
((LISTP FIGSPECS)
(for FIGSPEC in FIGSPECS bind VALUE when (SETQ VALUE (MAPFIGURESPECSUNTIL FIGSPEC SPECFN
DATUM DATUM2))
do (RETURN VALUE)))
(T (ERROR "unknown figure specification" FIGSPECS])
(READBRUSHSIZE
[LAMBDA NIL (* rrb "25-JAN-83 13:54")
(* reads a brush size from the user.)
(PROMPTPRINT "Enter new brush size.
Entering 0 will leave it the same as now.")
(PROG [(N (NUMBERPAD.READ (COND
(MAPW.NUMBERPAD.READER)
(T (SETQ MAPW.NUMBERPAD.READER (CREATE.MAPW.NUMBERPAD.READER]
(CLRPROMPT)
(RETURN (COND
((EQ N 0)
NIL)
(T N])
(READSPLINE
[LAMBDA (W CLOSEFLG) (* rrb "24-JAN-83 18:42")
(* reads a spline {series of points} from the user.)
(PROG (PT PTS)
(PROMPTPRINT
"Enter the points the curve goes through using the left button.
Click outside the window to stop.")
LP (COND
((INVISIBLEPARTP W (SETQ PT (GETDRAWPOSITION W POINTREADINGCURSOR)))
(* add the point to the list and mark it.)
(SETQ PTS (NCONC1 PTS PT))
(SHOWDRAWPOINT PT W)
(GO LP))
(T (* erase point markers.)
(for PT in PTS do (SHOWDRAWPOINT PT W))
(CLRPROMPT) (* return points)
(RETURN (AND PTS (CREATE.SPLINE.ELT PTS CLOSEFLG CURRENTFIGUREWBRUSH
CURRENTFIGUREWDASHING W])
(READCIRCLE
[LAMBDA (WINDOW) (* rrb "25-JAN-83 18:09")
(* reads a two points from the user and returns a
circle figure element that it represents.)
(PROG (P1 P2)
(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.ELT P1 P2 CURRENTFIGUREWBRUSH CURRENTFIGUREWDASHING WINDOW])
(READELLIPSE
[LAMBDA (WINDOW) (* rrb "24-JAN-83 20:33")
(* 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 (CREATE.ELLIPSE.ELT CENTER MINRAD MAJRAD CURRENTFIGUREWBRUSH CURRENTFIGUREWDASHING
WINDOW])
(RESHAPEBYREPAINTANDMOVEFN
[LAMBDA (WNEW OLDIMAGEBM OLDREGION) (* rrb "30-DEC-82 11:17")
(DECLARE (GLOBALVARS LAMBDASPLST)) (* reshapes a figure window.
Moves the menu to its upper left corner.)
(PROG [WREG NEWPOS (USERMOVEFN (WINDOWPROP WNEW (QUOTE MOVEFN]
(* call repaintfn to redisplay the window.)
(RESHAPEBYREPAINTFN WNEW OLDIMAGEBM OLDREGION) (* call the move functions if any)
(COND
(USERMOVEFN (SETQ NEWPOS (create POSITION
XCOORD ←[fetch (REGION LEFT)
of (SETQ WREG (WINDOWPROP WNEW (QUOTE REGION]
YCOORD ←(fetch (REGION BOTTOM) of WREG)))
(* can't implement DON'T as stopping reshape because
window has already been reshaped but at least don't
cause a udf DON'T.)
(COND
[(AND (LISTP USERMOVEFN)
(NOT (FMEMB (CAR USERMOVEFN)
LAMBDASPLST)))
(for MFN in USERMOVEFN do (OR (EQ MFN (QUOTE DON'T))
(APPLY* MFN WNEW NEWPOS]
((NEQ USERMOVEFN (QUOTE DON'T))
(APPLY* USERMOVEFN WNEW NEWPOS])
(SETFIGUREWBRUSHSHAPE
[LAMBDA (W) (* rrb " 1-DEC-82 12:49")
(* sets the size of the brush for drawing in a figure
window.)
(PROG ((NEWSHAPE (PAINTW.READBRUSHSHAPE)))
(RETURN (AND NEWSHAPE (SETQ CURRENTFIGUREWBRUSH (create BRUSH using CURRENTFIGUREWBRUSH
BRUSHSHAPE ← NEWSHAPE])
(SETFIGUREWBRUSHSIZE
[LAMBDA (W) (* rrb " 1-DEC-82 12:45")
(* sets the size of the brush for drawing in a figure
window.)
(PROG ((NEWSIZE (READBRUSHSIZE)))
(RETURN (AND NEWSIZE (SETQ CURRENTFIGUREWBRUSH (create BRUSH using CURRENTFIGUREWBRUSH
BRUSHSIZE ← NEWSIZE])
(SHOWDRAWPOINT
[LAMBDA (PT W) (* rrb "30-NOV-82 17:09")
(* puts down the marker for a point.)
(BITBLT POINTMARK NIL NIL W (IDIFFERENCE (fetch (POSITION XCOORD) of PT)
(LRSH (fetch (BITMAP BITMAPWIDTH) of POINTMARK)
1))
(IDIFFERENCE (fetch (POSITION YCOORD) of PT)
(LRSH (fetch (BITMAP BITMAPHEIGHT) of POINTMARK)
1))
NIL NIL (QUOTE INPUT)
(QUOTE INVERT])
(SHOWFIGUREKNOTS
[LAMBDA (FIGW) (* rrb " 3-JAN-83 11:26")
(* puts up knot markers for all of the curves in a
figure window.)
(MAPFIGURESPECS (WINDOWPROP FIGW (QUOTE FIGURESPECS))
(FUNCTION MARKFIGURE)
FIGW])
)
(DEFINEQ
(FIGW.DRAWFIGURE
[LAMBDA (SCREENELT DS REGION SCALE) (* rrb "25-JAN-83 18:07")
(* draws an element of a figure 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 ([LONGSCALE (COND
((NULL SCALE)
(SCALE.FROM.MAPW DS))
((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 LONGSCALE (fetch (PELT MINSCALE) of GLOBALPART))
(ILEQ LONGSCALE (fetch (PELT MAXSCALE) of GLOBALPART))
(SELECTQ (fetch (PELT PTYPE) of GLOBALPART)
(CURVE (FIGW.DRAWCURVE SCREENELT DS REGION))
(TEXT (FIGW.DRAWTEXT SCREENELT DS REGION))
(IMAGE (FIGW.DRAWIMAGE SCREENELT DS REGION))
(CIRCLE (FIGW.DRAWCIRCLE SCREENELT DS REGION))
(ELLIPSE (FIGW.DRAWELLIPSE SCREENELT DS REGION))
(MAPPIECE (FIGW.DRAWMAP SCREENELT DS REGION))
(ERROR "bad figure element" SCREENELT])
(FIGW.ERASE.ELT
[LAMBDA (ELT WINDOW KNOTFLAG REGION) (* rrb "24-JAN-83 19:40")
(* erases a figure element)
(DSPOPERATION (QUOTE ERASE)
WINDOW)
(FIGW.DRAWFIGURE ELT WINDOW REGION (SCALE.FROM.MAPW WINDOW))
(DSPOPERATION (QUOTE PAINT)
WINDOW])
(FIGW.DRAWCURVE
[LAMBDA (CURVEELT WINDOW REGION SHOWKNOTSFLG) (* rrb "24-JAN-83 17:47")
(* draws a curve figure element.)
(PROG ((GCURVE (fetch (SCREENELT GLOBALPART) of CURVEELT))
KNOTS)
(DRAWCURVE (SETQ KNOTS (fetch (LOCALCURVE KNOTS) of (fetch (SCREENELT LOCALPART)
of CURVEELT)))
(fetch (CURVE CLOSE) of GCURVE)
(fetch (CURVE BRUSH) of GCURVE)
(fetch (CURVE DASHING) of GCURVE)
WINDOW)
(COND
(SHOWKNOTSFLG (for K in KNOTS do (SHOWDRAWPOINT K WINDOW])
(FIGW.DRAWIMAGE
[LAMBDA (IMAGEELT WINDOW REGION) (* rrb "24-JAN-83 17:56")
(* shows an image element element.
If REGION is given, it is a clipping region.)
(PROG ((GIMAGE (fetch (SCREENELT GLOBALPART) of IMAGEELT))
(LOCALPOS (fetch (LOCALIMAGE IMAGEPOSITION) of (fetch (SCREENELT LOCALPART) of IMAGEELT)))
IMAGECR)
(SETQ IMAGECR (fetch (IMAGE SUBREGION) of GIMAGE))
(BITBLT (DECODEBITMAP (fetch (IMAGE BITMAP) of IMAGEELT))
(fetch (REGION LEFT) of IMAGECR)
(fetch (REGION BOTTOM) of IMAGECR)
WINDOW
(fetch XCOORD of LOCALPOS)
(fetch YCOORD of LOCALPOS)
(fetch (REGION WIDTH) of IMAGECR)
(fetch (REGION HEIGHT) of IMAGECR])
(FIGW.DRAWCIRCLE
[LAMBDA (CIRCLEELT WINDOW REGION) (* rrb "24-JAN-83 18:35")
(* 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])
(FIGW.DRAWELLIPSE
[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])
)
(DEFINEQ
(FIGW.ADDCLOSEDCURVE
[LAMBDA (W) (* rrb "26-JAN-83 17:43")
(* reads a closed curve from the user and adds it to
the figure associated with W.)
(FIGW.ADD.ELEMENT (READSPLINE W T)
W])
(FIGW.ADDCIRCLE
[LAMBDA (W) (* rrb "26-JAN-83 17:44")
(* reads a circle from the user and adds it to the
figure associated with W.)
(FIGW.ADD.ELEMENT (READCIRCLE W)
W])
(FIGW.ADDELLIPSE
[LAMBDA (W) (* rrb "26-JAN-83 17:44")
(* reads a circle from the user and adds it to the
figure associated with W.)
(FIGW.ADD.ELEMENT (READELLIPSE W)
W])
(FIGW.ADDOPENCURVE
[LAMBDA (W) (* rrb "26-JAN-83 17:44")
(* reads a closed curve from the user and adds it to
the figure associated with W.)
(FIGW.ADD.ELEMENT (READSPLINE W NIL)
W])
(FIGW.DELETE.ELT
[LAMBDA (W) (* lets the user select an element and deletes it.)
(EVAL.AS.PROCESS (LIST (QUOTE FIGW.SEL.AND.DELETE)
W])
(FIGW.SEL.AND.DELETE
[LAMBDA (W) (* rrb "27-JAN-83 09:15")
(* lets the user select an element and deletes it.)
(PROG ((SELELT (FIGW.SELECT.ITEM W T)))
(AND SELELT (FIGW.DELETE.ELEMENT SELELT W))
(RETURN SELELT])
(FIGW.DELETE.ITEM
[LAMBDA (ELT FIGUREW) (* deletes an element from a window)
(WINDOWDELPROP FIGUREW (QUOTE FIGURESPECS)
ELT])
(FIGW.ERASE.AND.DELETE.ITEM
[LAMBDA (SELELT FIGW) (* rrb "10-JAN-83 15:34")
(COND
(SELELT (FIGW.ERASE.ELT SELELT FIGW)
(FIGW.DELETE.ITEM SELELT FIGW])
(CREATE.CIRCLE.ELT
[LAMBDA (CENTER RADIUSPT BRUSH DASHING MAPW) (* rrb "26-JAN-83 14:34")
(* creates a circle element)
(PROG ((MAPINFO (MAPDESCFROMFIGUREW MAPW))
SCALE)
(SETQ SCALE (SCALE.FROM.MAPINFO MAPINFO))
(RETURN (LOCAL.CIRCLE.FROM.GLOBAL (create CIRCLE
MAXSCALE ←(TIMES SCALE
DEFAULT.VISIBLE.SCALE.FACTOR)
MINSCALE ←(QUOTIENT SCALE
DEFAULT.VISIBLE.SCALE.FACTOR)
BRUSH ←(OR BRUSH CURRENTFIGUREWBRUSH)
DASHING ←(FIGW.DECODE.DASHING DASHING
CURRENTFIGUREWDASHING)
CENTERLATLON ←(UNSCALE.POSITION.FROM.MAPINFO
CENTER MAPINFO)
RADIUSLATLON ←(UNSCALE.POSITION.FROM.MAPINFO
RADIUSPT MAPINFO))
MAPW])
(LOCAL.CIRCLE.FROM.GLOBAL
[LAMBDA (GCIRCLE FIGW) (* rrb "26-JAN-83 14:51")
(* returns a screen elt that has a circle screen
element calculated from the global part.)
(PROG ((MAPINFO (MAPDESCFROMFIGUREW FIGW))
CENTER RADIUSPT)
(RETURN (create SCREENELT
LOCALPART ←(create LOCALCIRCLE
CENTERPOSITION ←(SETQ CENTER (
SCALE.POSITION.FROM.MAPINFO (fetch (CIRCLE
CENTERLATLON)
of GCIRCLE)
MAPINFO))
RADIUSPOSITION ←(SETQ RADIUSPT
(SCALE.POSITION.FROM.MAPINFO (fetch (CIRCLE
RADIUSLATLON)
of GCIRCLE)
MAPINFO))
RADIUS ←(DISTANCEBETWEEN CENTER RADIUSPT))
GLOBALPART ← GCIRCLE])
(CREATE.SPLINE.ELT
[LAMBDA (KNOTS CLOSEFLG BRUSH DASHING MAPW) (* rrb "26-JAN-83 12:50")
(* creates a spline element)
(PROG ((MAPINFO (MAPDESCFROMFIGUREW MAPW))
SCALE)
(SETQ SCALE (SCALE.FROM.MAPINFO MAPINFO))
(RETURN (create SCREENELT
LOCALPART ←(create LOCALCURVE
KNOTS ← KNOTS)
GLOBALPART ←(create CURVE
MINSCALE ←(QUOTIENT SCALE DEFAULT.VISIBLE.SCALE.FACTOR)
MAXSCALE ←(TIMES SCALE DEFAULT.VISIBLE.SCALE.FACTOR)
BRUSH ← BRUSH
CLOSE ← CLOSEFLG
DASHING ← DASHING
LATLONKNOTS ←(for PT in KNOTS collect (
UNSCALE.POSITION.FROM.MAPINFO PT MAPINFO])
(CREATE.ELLIPSE.ELT
[LAMBDA (CENTER MINRAD MAJRAD BRUSH DASHING MAPW) (* rrb "26-JAN-83 14:32")
(PROG ((MAPINFO (MAPDESCFROMFIGUREW MAPW))
SCALE)
(SETQ SCALE (SCALE.FROM.MAPINFO MAPINFO))
(RETURN (LOCAL.ELLIPSE.FROM.GLOBAL (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.MAPINFO CENTER MAPINFO)
SEMIMINORLATLON ←(UNSCALE.POSITION.FROM.MAPINFO
MINRAD MAPINFO)
SEMIMAJORLATLON ←(UNSCALE.POSITION.FROM.MAPINFO
MAJRAD MAPINFO))
MAPW])
(LOCAL.ELLIPSE.FROM.GLOBAL
[LAMBDA (GELLIPSE FIGW) (* rrb "26-JAN-83 14:51")
(* returns a screen elt that has a ellipse screen
element calculated from the global part.)
(PROG ((MAPINFO (MAPDESCFROMFIGUREW FIGW))
CENTER MINRAD MAJRAD)
(RETURN (create SCREENELT
LOCALPART ←(create LOCALELLIPSE
ELLIPSECENTER ←(SETQ CENTER (SCALE.POSITION.FROM.MAPINFO
(fetch (ELLIPSE ELLIPSECENTERLATLON) of GELLIPSE)
MAPINFO))
MINORRADIUSPOSITION ←(SETQ MINRAD
(SCALE.POSITION.FROM.MAPINFO (fetch (ELLIPSE
SEMIMINORLATLON)
of GELLIPSE)
MAPINFO))
MAJORRADIUSPOSITION ←(SETQ MAJRAD
(SCALE.POSITION.FROM.MAPINFO (fetch (ELLIPSE
SEMIMAJORLATLON)
of GELLIPSE)
MAPINFO))
SEMIMINORRADIUS ←(DISTANCEBETWEEN CENTER MINRAD)
SEMIMAJORRADIUS ←(DISTANCEBETWEEN CENTER MAJRAD))
GLOBALPART ← GELLIPSE])
(COMPUTE.ELLIPSE.ORIENTATION
[LAMBDA (CENTERPT MINRADPT) (* rrb "26-JAN-83 14:08")
(FDIFFERENCE (ATAN (IDIFFERENCE (fetch (POSITION XCOORD) of MINRADPT)
(fetch (POSITION XCOORD) of CENTERPT))
(IDIFFERENCE (fetch (POSITION YCOORD) of MINRADPT)
(fetch (POSITION YCOORD) of CENTERPT)))
90.0])
)
(DEFINEQ
(FIGW.ADD.ELEMENT
[LAMBDA (NEWELT FIGUREW) (* rrb "27-JAN-83 11:29")
(* adds a new element to a figure window and handles
propagation to all other figure windows)
(AND NEWELT (PROG ((GLOBALPART (fetch (SCREENELT GLOBALPART) of NEWELT)))
(* do the window that the interaction occurred in
first.)
(FIGW.DISPLAY.AND.ADD.ITEM NEWELT FIGUREW)
(* propagate to other windows.)
(for FIGW in ALL.MAPWS when (AND (NEQ FIGW FIGUREW)
(ELT.INSIDE.MAPWP GLOBALPART FIGW))
do (FIGW.DISPLAY.AND.ADD.ITEM (FIGW.LOCAL.FROM.GLOBAL GLOBALPART FIGW)
FIGW])
(FIGW.DELETE.ELEMENT
[LAMBDA (OLDELT FIGUREW) (* rrb "27-JAN-83 09:15")
(* deletes an element to a figure window and handles
propagation to all other figure windows)
(PROG ((GLOBALPART (fetch (SCREENELT GLOBALPART) of OLDELT))
LOCALELT) (* do the window that the interaction occurred in
first.)
(FIGW.ERASE.AND.DELETE.ITEM OLDELT FIGUREW) (* propagate to other windows.)
(for FIGW in ALL.MAPWS when (AND (NEQ FIGW FIGUREW)
(SETQ LOCALELT (LOCAL.ELT.OF.GLOBALPART GLOBALPART FIGW)))
do (FIGW.ERASE.AND.DELETE.ITEM LOCALELT FIGW])
(MAPW.INSIDE.REGION
[LAMBDA (GLOBALPART WORLDREG) (* rrb "27-JAN-83 08:33")
(SELECTQ (fetch (PELT PTYPE) of GLOBALPART)
(CURVE (MAPW.INSIDE.CURVE GLOBALPART WORLDREG))
(TEXT (MAPW.INSIDE.TEXT GLOBALPART WORLDREG))
(IMAGE (MAPW.INSIDE.IMAGE GLOBALPART WORLDREG))
(CIRCLE (MAPW.INSIDE.CIRCLE GLOBALPART WORLDREG))
(ELLIPSE (MAPW.INSIDE.ELLIPSE GLOBALPART WORLDREG))
(MAPPIECE (* for now map pieces aren't inside other map pieces.)
NIL)
(ERROR "bad figure element" GLOBALPART])
(ELT.INSIDE.MAPWP
[LAMBDA (GLOBALPART FIGW) (* rrb "26-JAN-83 17:43")
(* determines if a global element is in the world
region of a map window.)
(MAPW.INSIDE.REGION GLOBALPART (fetch (MAPPIECE WORLDREGION) of (MAPDESCFROMFIGUREW FIGW])
(FIGW.DISPLAY.AND.ADD.ITEM
[LAMBDA (FIGELT FIGW SCALE) (* rrb "24-JAN-83 15:43")
(* displays a figure element and adds it to the
window.)
(COND
(FIGELT (FIGW.DRAWFIGURE FIGELT FIGW NIL SCALE)
(ADDFIGUREWELT FIGELT FIGW])
(FIGW.DISPLAY.AND.ADD.ITEMS
[LAMBDA (SELITEMS FIGW SCALE) (* adds a list of items to a figure window and displays
them.)
(for ELT in SELITEMS do (FIGW.DISPLAY.AND.ADD.ITEM ELT FIGW SCALE])
(FIGW.MOVE.THING
[LAMBDA (SELPOS NEWPOS W) (* rrb "26-JAN-83 16:16")
(* moves the selected point to the new position.)
(AND NEWPOS (PROG ((FIGUREELT (IN.FIGURE.ELT? (WINDOWPROP W (QUOTE FIGURESPECS))
SELPOS)))
(* moving a piece of an element.)
(AND FIGUREELT (FIGW.UPDATE.ELEMENT FIGUREELT
(SELECTQ (fetch PTYPE
of (fetch (SCREENELT GLOBALPART)
of FIGUREELT))
(CURVE (FIGW.MOVE.CURVEPART
FIGUREELT
SELPOS
NEWPOS W))
(TEXT (FIGW.MOVE.TEXT FIGUREELT
SELPOS
NEWPOS W))
(IMAGE (FIGW.MOVE.IMAGE FIGUREELT
SELPOS
NEWPOS W))
(CIRCLE (FIGW.MOVE.CIRCLEPART
FIGUREELT SELPOS NEWPOS
W))
(ELLIPSE (FIGW.MOVE.ELLIPSEPART
FIGUREELT SELPOS NEWPOS
W))
(ERROR "bad figure element"
FIGUREELT))
W])
(FIGW.MOVE.ELT
[LAMBDA (W) (* rrb "10-JAN-83 15:15")
(* lets the user select an element and move it.)
(EVAL.AS.PROCESS (LIST (QUOTE FIGW.SEL.AND.MOVE)
W])
(FIGW.SEL.AND.MOVE
[LAMBDA (W) (* rrb "10-JAN-83 18:06")
(* lets the user select an element and move it.)
(PROG ((SELPOS (FIGW.SELECT.ITEM W))
NEWPOS)
(COND
(SELPOS (CURSORPOSITION SELPOS W)
(SETQ NEWPOS (GETDRAWPOSITION W))
(FIGW.MOVE.THING SELPOS NEWPOS W)))
(RETURN SELPOS])
(FIGW.MOVE.CURVEPART
[LAMBDA (CURVESPEC SELPOS NEWPOS WINDOW) (* rrb "26-JAN-83 15:44")
(* returns a curve element which has the part SELPOS
moved to NEWPOS.)
(PROG ((MAPINFO (MAPDESCFROMFIGUREW WINDOW))
(GCURVE (fetch (SCREENELT GLOBALPART) of CURVESPEC)))
[replace (CURVE LATLONKNOTS) of GCURVE with (for PT in (fetch (LOCALCURVE KNOTS)
of (fetch (SCREENELT LOCALPART)
of CURVESPEC))
as LATLONPT in (fetch (CURVE LATLONKNOTS)
of GCURVE)
collect (COND
((EQUAL PT SELPOS)
(UNSCALE.POSITION.FROM.MAPINFO
NEWPOS MAPINFO))
(T LATLONPT]
(RETURN (LOCAL.CURVE.FROM.GLOBAL GCURVE WINDOW])
(FIGW.MOVE.CIRCLEPART
[LAMBDA (CIRCLESPEC SELPOS NEWPOS WINDOW) (* rrb "27-JAN-83 08:50")
(* returns a circle element which has the part SELPOS
moved to NEWPOS.)
(PROG ((LCIRCLE (fetch (SCREENELT LOCALPART) of CIRCLESPEC))
(GCIRCLE (fetch (SCREENELT GLOBALPART) of CIRCLESPEC))
(MAPINFO (MAPDESCFROMFIGUREW WINDOW))
CENTERPT RADIUSPT)
(SETQ CENTERPT (fetch (LOCALCIRCLE CENTERPOSITION) of LCIRCLE))
(SETQ RADIUSPT (fetch (LOCALCIRCLE RADIUSPOSITION) of LCIRCLE))
(* first update the global structures then create a new
local one from it.)
[COND
((EQUAL SELPOS CENTERPT) (* center point moved, move both center and radius.)
(replace (CIRCLE CENTERLATLON) of GCIRCLE with (UNSCALE.POSITION.FROM.MAPINFO NEWPOS
MAPINFO))
(replace (CIRCLE RADIUSLATLON) of GCIRCLE with (UNSCALE.POSITION.FROM.MAPINFO
(PTPLUS RADIUSPT (PTDIFFERENCE NEWPOS
CENTERPT))
MAPINFO)))
((EQUAL SELPOS RADIUSPT)
(replace (CIRCLE RADIUSLATLON) of GCIRCLE with (UNSCALE.POSITION.FROM.MAPINFO NEWPOS
MAPINFO]
(RETURN (LOCAL.CIRCLE.FROM.GLOBAL GCIRCLE WINDOW])
(FIGW.MOVE.ELLIPSEPART
[LAMBDA (ELLIPSEELT SELPOS NEWPOS WINDOW) (* rrb "26-JAN-83 16:37")
(* returns an ellipse element which has the part SELPOS
moved to NEWPOS.)
(PROG ((LOCALEL (fetch (SCREENELT LOCALPART) of ELLIPSEELT))
(GLOBALEL (fetch (SCREENELT GLOBALPART) of ELLIPSEELT))
(MAPINFO (MAPDESCFROMFIGUREW WINDOW))
CENTERPT MINRADPT MAJRADPT)
(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.)
(replace (ELLIPSE ELLIPSECENTERLATLON) of GLOBALEL with (UNSCALE.POSITION.FROM.MAPINFO
NEWPOS MAPINFO))
(replace (ELLIPSE SEMIMINORLATLON) of GLOBALEL with (UNSCALE.POSITION.FROM.MAPINFO
(PTPLUS MINRADPT
(PTDIFFERENCE NEWPOS
CENTERPT))
MAPINFO))
(replace (ELLIPSE SEMIMAJORLATLON) of GLOBALEL with (UNSCALE.POSITION.FROM.MAPINFO
(PTPLUS MAJRADPT
(PTDIFFERENCE NEWPOS
CENTERPT))
MAPINFO)))
((EQUAL SELPOS MINRADPT)
(replace (ELLIPSE SEMIMINORLATLON) of GLOBALEL with (UNSCALE.POSITION.FROM.MAPINFO
NEWPOS MAPINFO)))
((EQUAL SELPOS MAJRADPT)
(replace (ELLIPSE SEMIMAJORLATLON) of GLOBALEL with (UNSCALE.POSITION.FROM.MAPINFO
NEWPOS MAPINFO]
(replace (ELLIPSE ORIENTATION) of GLOBALEL with (COMPUTE.ELLIPSE.ORIENTATION
(fetch (ELLIPSE ELLIPSECENTERLATLON)
of GLOBALEL)
(fetch (ELLIPSE SEMIMINORLATLON)
of GLOBALEL)))
(RETURN (LOCAL.ELLIPSE.FROM.GLOBAL GLOBALEL WINDOW])
(FIGW.MOVE.IMAGE
[LAMBDA (IMAGEELT SELPOS NEWPOS WINDOW) (* rrb "26-JAN-83 16:14")
(* moves a image figure element to a new position.)
(PROG ((GIMAGE (fetch (SCREENELT GLOBALPART) of IMAGEELT)))
(replace (IMAGE DISPLAYLATLON) of GIMAGE with (UNSCALE.POSITION.FROM.MAPINFO NEWPOS
(
MAPDESCFROMFIGUREW WINDOW)))
(RETURN (LOCAL.IMAGE.FROM.GLOBAL GIMAGE WINDOW])
)
(DEFINEQ
(MARKFIGURE
[LAMBDA (FIGUREELT W MARK) (* rrb "24-JAN-83 19:30")
(* marks the pick up points of a figure element.)
(SELECTQ (fetch PTYPE of (fetch (SCREENELT GLOBALPART) of FIGUREELT))
(CURVE (MARKKNOTS (fetch (LOCALCURVE KNOTS) of (fetch (SCREENELT LOCALPART)
of FIGUREELT))
W MARK))
(TEXT (MARKTEXTREGION FIGUREELT W MARK))
(CIRCLE (MARKCIRCLEKNOTS FIGUREELT W MARK))
(ELLIPSE (MARKELLIPSEKNOTS FIGUREELT W MARK))
(IMAGE (MARKIMAGEKNOTS FIGUREELT W MARK))
(MAPPIECE (* for now don't allow it to be selected.)
NIL)
NIL])
(FIGW.SHOWMARKS
[LAMBDA (W) (* marks all of the hot spots of figure elements in a
figure window.)
(MAPFIGURESPECS (WINDOWPROP W (QUOTE FIGURESPECS))
(FUNCTION FIGW.MARKSELECTIONSPOTS)
W])
(FIGW.MARKSELECTIONSPOTS
[LAMBDA (FIGUREELT W) (* rrb "10-JAN-83 11:51")
(* marks the pick up points of a figure element.)
(MARKFIGURE FIGUREELT W FIGW.LOCATEMARK])
(MARKKNOTS
[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])
(MARKPOINT
[LAMBDA (PT WINDOW MARK) (* rrb "25-JAN-83 20:02")
(* marks a point in a window with a mark.
The mark should be a bitmap.
NIL)
(OR MARK (SETQ MARK FIGW.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])
(MARKCIRCLEKNOTS
[LAMBDA (CIRCLESPEC W MARK) (* rrb "24-JAN-83 19:29")
(* marks the hotspots of a circle.)
(MARKPOINT (fetch (LOCALCIRCLE CENTERPOSITION) of (SETQ CIRCLESPEC (fetch (SCREENELT LOCALPART)
of CIRCLESPEC)))
W MARK)
(MARKPOINT (fetch (LOCALCIRCLE RADIUSPOSITION) of CIRCLESPEC)
W MARK])
(MARKELLIPSEKNOTS
[LAMBDA (ELLIPSEELT W MARK) (* rrb "24-JAN-83 19:29")
(* marks the hotspots of a ellispe.)
(MARKPOINT (fetch (LOCALELLIPSE ELLIPSECENTER) of (SETQ ELLIPSEELT (fetch (SCREENELT LOCALPART)
of ELLIPSEELT)))
W MARK)
(MARKPOINT (fetch (LOCALELLIPSE MINORRADIUSPOSITION) of ELLIPSEELT)
W MARK)
(MARKPOINT (fetch (LOCALELLIPSE MAJORRADIUSPOSITION) of ELLIPSEELT)
W MARK])
(MARKIMAGEKNOTS
[LAMBDA (IMAGEELT WINDOW MARK) (* rrb "24-JAN-83 19:30")
(* marks the hot area for text element.)
(* for now mark the position of the image)
(MARKPOINT (fetch (LOCALIMAGE IMAGEPOSITION) of (fetch (SCREENELT LOCALPART) of IMAGEELT))
WINDOW MARK])
)
(DEFINEQ
(ON.CIRCLE.HOT.SPOT
[LAMBDA (CIRCLESPEC POS PTFLG) (* rrb "24-JAN-83 18:58")
(* determines if POS is on a hot spot of a circle
element.)
(PROG ((LOCALCIRCLE (fetch (SCREENELT LOCALPART) of CIRCLESPEC))
CENTERPT RADIUSPT)
(SETQ CENTERPT (fetch (LOCALCIRCLE CENTERPOSITION) of LOCALCIRCLE))
(SETQ RADIUSPT (fetch (LOCALCIRCLE RADIUSPOSITION) of LOCALCIRCLE))
(RETURN (COND
((NULL PTFLG)
(AND (OR (FIGW.NEARPT CENTERPT POS)
(FIGW.NEARPT RADIUSPT POS))
CIRCLESPEC))
((FIGW.NEARPT CENTERPT POS)
CENTERPT)
((FIGW.NEARPT RADIUSPT POS)
RADIUSPT])
(FIGW.SELECT.ITEM
[LAMBDA (WINDOW ITEMFLG) (* rrb "10-JAN-83 18:02")
(* selects allows the user to select one of the figure elements from the figurew WINDOW. If ITEMFLG is non-NIL, it
returns the item selected, otherwise it returns the position. Keeps control and probably shouldn't)
(PROG ((SELECTABLEITEMS (WINDOWPROP WINDOW (QUOTE FIGURESPECS)))
NOW PREVIOUS OLDPOS BUTTON)
(COND
((NULL SELECTABLEITEMS) (* no items, don't do anything.)
(RETURN)))
(TOTOPW WINDOW)
(FIGW.SHOWMARKS WINDOW)
(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.FIGURE.ELT? SELECTABLEITEMS (SETQ OLDPOS (CURSORPOSITION NIL WINDOW))
(NULL ITEMFLG)))
FLIP (* turn off old selection.)
(FIGW.DESELECT.ELT PREVIOUS WINDOW)
(FIGW.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)
(FIGW.DESELECT.ELT PREVIOUS WINDOW)
(FIGW.SHOWMARKS WINDOW)
(RETURN PREVIOUS))
([EQ PREVIOUS (SETQ NOW (IN.FIGURE.ELT? SELECTABLEITEMS (CURSORPOSITION NIL WINDOW OLDPOS)
(NULL ITEMFLG]
(GO LP))
(T (GO FLIP])
(FIGW.DESELECT.ELT
[LAMBDA (ELT FIGW) (* rrb "10-JAN-83 15:14")
(* deselects an item from a figure window.)
(* for now just unmark it.)
(AND ELT (FIGW.MARK.SELECTION ELT FIGW])
(FIGW.MARK.SELECTION
[LAMBDA (ELT FIGW) (* rrb "10-JAN-83 15:14")
(* marks or unmarks a selection.)
(COND
((POSITIONP ELT) (* handle positions {points} specially.)
(MARKPOINT ELT FIGW FIGW.SELECTEDMARK))
(T (MARKFIGURE ELT FIGW FIGW.SELECTEDMARK])
(FIGW.SELECT.ELT
[LAMBDA (ELT FIGW) (* rrb "10-JAN-83 15:14")
(* selects an item from a figure window.)
(* for now just mark it.)
(AND ELT (FIGW.MARK.SELECTION ELT FIGW])
(IN.FIGURE.ELT?
[LAMBDA (ITEMS POS PTFLG) (* rrb "10-JAN-83 15:09")
(MAPFIGURESPECSUNTIL ITEMS (FUNCTION ON.HOT.SPOT)
POS PTFLG])
(ON.HOT.SPOT
[LAMBDA (FIGUREELT POS PTFLG) (* rrb "24-JAN-83 19:01")
(* 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.)
(SELECTQ (fetch PTYPE of (fetch (SCREENELT GLOBALPART) of FIGUREELT))
(CURVE (ON.CURVE.HOT.SPOT FIGUREELT POS PTFLG))
(TEXT (ON.TEXT.HOT.SPOT FIGUREELT POS PTFLG))
(CIRCLE (ON.CIRCLE.HOT.SPOT FIGUREELT POS PTFLG))
(ELLIPSE (ON.ELLIPSE.HOT.SPOT FIGUREELT POS PTFLG))
(IMAGE (ON.IMAGE.HOT.SPOT FIGUREELT POS PTFLG))
(MAPPIECE (* for now map pieces don't have hot spots.)
NIL)
NIL])
(ON.CURVE.HOT.SPOT
[LAMBDA (CURVE POS PTFLG) (* rrb "24-JAN-83 18:58")
(* returns the curve if POS is close to any of its
knots.)
(PROG (NEARPT)
(SETQ NEARPT (for PT in (fetch (LOCALCURVE KNOTS) of (fetch (SCREENELT LOCALPART)
of CURVE))
thereis (FIGW.NEARPT PT POS)))
(RETURN (AND NEARPT (COND
(PTFLG NEARPT)
(T CURVE])
(ON.ELLIPSE.HOT.SPOT
[LAMBDA (ELLIPSEELT POS PTFLG) (* rrb "24-JAN-83 18:59")
(* determines if POS is on one of the hot spots of an
ellipse element.)
(PROG ((LOCALELLIPSE (fetch (SCREENELT LOCALPART) of ELLIPSEELT))
CENTERPT MINRADPT MAJRADPT)
(SETQ CENTERPT (fetch (LOCALELLIPSE ELLIPSECENTER) of LOCALELLIPSE))
(SETQ MINRADPT (fetch (LOCALELLIPSE MINORRADIUSPOSITION) of LOCALELLIPSE))
(SETQ MAJRADPT (fetch (LOCALELLIPSE MAJORRADIUSPOSITION) of LOCALELLIPSE))
(RETURN (COND
((NULL PTFLG)
(AND (OR (FIGW.NEARPT CENTERPT POS)
(FIGW.NEARPT MINRADPT POS)
(FIGW.NEARPT MAJRADPT POS))
ELLIPSEELT))
((FIGW.NEARPT CENTERPT POS)
CENTERPT)
((FIGW.NEARPT MINRADPT POS)
MINRADPT)
((FIGW.NEARPT MAJRADPT POS)
MAJRADPT])
(ON.IMAGE.HOT.SPOT
[LAMBDA (IMAGEELT POS PTFLG) (* rrb "24-JAN-83 19:00")
(* determines if a position is on the hot spot of a
image element.)
(* for now use the position of the image)
(PROG [(IMAGEPT (fetch (LOCALIMAGE IMAGEPOSITION) of (fetch (SCREENELT LOCALPART) of IMAGEELT]
(RETURN (AND (FIGW.NEARPT IMAGEPT POS)
(COND
(PTFLG IMAGEPT)
(T IMAGEELT])
(FIGW.NEARPT
[LAMBDA (TARGETPT HITPT) (* rrb " 3-JAN-83 16:26")
(* returns T if HITPT is "near" TARGETPT.)
(PROG ((TX (fetch (POSITION XCOORD) of TARGETPT))
(TY (fetch (POSITION YCOORD) of TARGETPT))
(HX (fetch (POSITION XCOORD) of HITPT))
(HY (fetch (POSITION YCOORD) of HITPT))
(FIGW.POINT.WIDTH 4))
(RETURN (AND (IGREATERP HX (IDIFFERENCE TX FIGW.POINT.WIDTH))
(IGREATERP (IPLUS TX FIGW.POINT.WIDTH)
HX)
(IGREATERP HY (IDIFFERENCE TY FIGW.POINT.WIDTH))
(IGREATERP (IPLUS TY FIGW.POINT.WIDTH)
HY])
)
(* stuff for changing properties of a figure element)
(DEFINEQ
(FIGW.CHANGE.ELT
[LAMBDA (W) (* rrb "25-JAN-83 12:29")
(* lets the user select an element and change one of
its properties.)
(EVAL.AS.PROCESS (LIST (QUOTE FIGW.SEL.AND.CHANGE)
W])
(FIGW.SEL.AND.CHANGE
[LAMBDA (W) (* rrb "25-JAN-83 16:35")
(* lets the user select an element and change one of
its properties.)
(PROG ((SELELT (FIGW.SELECT.ITEM W T)))
(FIGW.CHANGE.PROPERTY SELELT W)
(RETURN SELELT])
(FIGW.CHANGE.PROPERTY
[LAMBDA (FIGUREELT WINDOW) (* rrb "27-JAN-83 13:00")
(* changes a property of a figure element.)
(COND
(FIGUREELT (PROG [(NEWFIGUREELT (SELECTQ (fetch PTYPE of (fetch (SCREENELT GLOBALPART)
of FIGUREELT))
(CURVE (CHANGE.CURVEPART FIGUREELT WINDOW))
(TEXT (CHANGE.TEXTPART FIGUREELT WINDOW))
(IMAGE)
(CIRCLE)
(ELLIPSE)
(ERROR "bad figure element" FIGUREELT]
(COND
(NEWFIGUREELT
(* if the user interaction resulted in a new element update it. The new element can have either a new global part or
the same global part depending on whether the information that changed is needed to display the element.
If the element can be displayed from its local information only, such as if one of the knots of a curve changed,
then the global part can be reused. NIL)
(FIGW.UPDATE.ELEMENT FIGUREELT NEWFIGUREELT WINDOW])
(FIGW.UPDATE.ELEMENT
[LAMBDA (OLDELT NEWELT FIGUREW) (* rrb "27-JAN-83 11:32")
(* replaces an old element with a new one. The two elements may have the same global part. This also handles
propagation to other windows that have the same figure displayed.)
(PROG ((GLOBALPART (fetch (SCREENELT GLOBALPART) of OLDELT))
(NEWGLOBAL (fetch (SCREENELT GLOBALPART) of NEWELT))
LOCALELT) (* do the window that the interaction occurred in
first.)
(FIGW.UPDATE.FIGURE.ELEMENT1 OLDELT NEWELT FIGUREW)
(* propagate to other windows.)
(for FIGW in ALL.MAPWS when (AND (NEQ FIGW FIGUREW)
(SETQ LOCALELT (LOCAL.ELT.OF.GLOBALPART GLOBALPART FIGW)))
do (FIGW.UPDATE.FIGURE.ELEMENT1 LOCALELT (FIGW.LOCAL.FROM.GLOBAL NEWGLOBAL FIGW)
FIGW])
(LOCAL.ELT.OF.GLOBALPART
[LAMBDA (GLOBALPART FIGW) (* returns the local element from FIGW that has global
part GLOBALPART -
NIL if there isn't one.)
(for ELT in (FIGURESPECS FIGW) when (EQ (fetch (SCREENELT GLOBALPART) of ELT)
GLOBALPART)
do (RETURN ELT])
(FIGW.LOCAL.FROM.GLOBAL
[LAMBDA (GLOBALELT FIGW) (* rrb "26-JAN-83 16:58")
(* calculates a screen element from a global element
into a figure window.)
(SELECTQ (fetch PTYPE of GLOBALELT)
(CURVE (LOCAL.CURVE.FROM.GLOBAL GLOBALELT FIGW))
(TEXT (LOCAL.TEXT.FROM.GLOBAL GLOBALELT FIGW))
(IMAGE (LOCAL.IMAGE.FROM.GLOBAL GLOBALELT FIGW))
(CIRCLE (LOCAL.CIRCLE.FROM.GLOBAL GLOBALELT FIGW))
(ELLIPSE (LOCAL.ELLIPSE.FROM.GLOBAL GLOBALELT FIGW))
(MAPPIECE (* shouldn't happen but if it does it will undoubtedly
be in a demo so return something reasonable.)
(create SCREENELT
LOCALPART ← NIL
GLOBALPART ← GLOBALELT))
(ERROR "bad figure element" GLOBALELT])
(LOCAL.CURVE.FROM.GLOBAL
[LAMBDA (CURVE WINDOW) (* rrb "26-JAN-83 15:44")
(* returns a screen elt that has a curve screen element
calculated from the global part.)
(PROG ((MAPINFO (MAPDESCFROMFIGUREW WINDOW)))
(RETURN (create SCREENELT
LOCALPART ←(create LOCALCURVE
KNOTS ←(for LATLONPT in (fetch (CURVE LATLONKNOTS)
of CURVE)
collect (SCALE.POSITION.FROM.MAPINFO LATLONPT
MAPINFO)))
GLOBALPART ← CURVE])
(LOCAL.TEXT.FROM.GLOBAL
[LAMBDA (GTEXT WINDOW) (* rrb "26-JAN-83 16:32")
(* creates a local text screen element from a global
text element.)
(PROG ((MAPINFO (MAPDESCFROMFIGUREW WINDOW))
TEXTPOS)
(RETURN (create SCREENELT
LOCALPART ←(create LOCALTEXT
LOCATIONPOSITION ←(SETQ TEXTPOS
(SCALE.POSITION.FROM.MAPINFO (fetch (TEXT
LOCATIONLATLON)
of GTEXT)
MAPINFO))
DISPLAYPOSITION ←(PTPLUS TEXTPOS (fetch (TEXT
DISPLAYOFFSET)
of GTEXT)))
GLOBALPART ← GTEXT])
(LOCAL.IMAGE.FROM.GLOBAL
[LAMBDA (IMAGE WINDOW) (* rrb "26-JAN-83 16:58")
(* creates an image screen element from a global one
onto WINDOW.)
(create SCREENELT
LOCALPART ←(create LOCALIMAGE
IMAGEPOSITION ←(SCALE.POSITION.FROM.MAPINFO (fetch (IMAGE
DISPLAYLATLON)
of IMAGE)
(MAPDESCFROMFIGUREW WINDOW)
))
GLOBALPART ← IMAGE])
(FIGW.UPDATE.FIGURE.ELEMENT1
[LAMBDA (OLDELT NEWELT FIGUREW) (* rrb "26-JAN-83 09:32")
(* replaces an old element with a new one. The two elements should have the same global part but this may not be
critical. This also handles propagation to other windows that have the same figure displayed.)
(FIGW.ERASE.AND.DELETE.ITEM OLDELT FIGUREW)
(FIGW.DISPLAY.AND.ADD.ITEM NEWELT FIGUREW])
(CHANGE.CURVEPART
[LAMBDA (CURVEELT WINDOW) (* rrb "27-JAN-83 10:21")
(* lets the user specify a new property for CURVEELT
and returns a new one.)
(PROG (NEWVAL)
(RETURN (SELECTQ [MENU (COND
((type? MENU CURVE.PROPERTY.MENU)
CURVE.PROPERTY.MENU)
(T (SETQ CURVE.PROPERTY.MENU
(create MENU
ITEMS ←(QUOTE (Brush% Shape Brush% Size Dashing
Move% Knot Add% Knot
Delete% Knot
Close% or% Open Scale))
CENTERFLG ← T
TITLE ← "Which property?"]
(Brush% Shape (AND (SETQ NEWVAL (PAINTW.READBRUSHSHAPE))
(CREATE.SPLINE.ELT.USING
CURVEELT NIL NIL (create BRUSH
BRUSHSHAPE ← NEWVAL
using (fetch (CURVE BRUSH)
of (fetch (SCREENELT
GLOBALPART)
of CURVEELT)))
NIL NIL NIL WINDOW)))
(Brush% Size (AND (SETQ NEWVAL (READBRUSHSIZE))
(CREATE.SPLINE.ELT.USING
CURVEELT NIL NIL (create BRUSH
BRUSHSIZE ← NEWVAL
using (fetch (CURVE BRUSH)
of (fetch (SCREENELT
GLOBALPART)
of CURVEELT)))
NIL NIL NIL WINDOW)))
(Dashing (AND (SETQ NEWVAL (READDASHING))
(CREATE.SPLINE.ELT.USING CURVEELT NIL NIL NIL NEWVAL NIL NIL
WINDOW)))
(Move% Knot)
(Add% Knot)
(Delete% Knot)
(Close% or% Open (CREATE.SPLINE.ELT.USING CURVEELT NIL
(COND
((fetch (CURVE CLOSE)
of (fetch (SCREENELT
GLOBALPART)
of CURVEELT))
(* now close, switch it to open.)
(QUOTE OPEN))
(T (QUOTE CLOSE)))
NIL NIL NIL NIL WINDOW))
NIL])
(FIGW.DECODE.DASHING
[LAMBDA (DASH DEFAULT) (* rrb "26-JAN-83 12:02")
(* goes from a read dash into an object that the curve
drawing routines like.)
(COND
((NULL DASH)
DEFAULT)
((EQ DASH 0) (* 0 is used to indicate no dashing.)
NIL)
(T DASH])
(CREATE.SPLINE.ELT.USING
[LAMBDA (OLDCURVEELT NEWKNOTS NEWCLOSEFLG NEWBRUSH NEWDASHING NEWMINSCALE NEWMAXSCALE MAPW)
(* rrb "27-JAN-83 11:12")
(* creates a spline element)
(PROG ([KNOTS (OR NEWKNOTS (fetch (LOCALCURVE KNOTS) of (fetch (SCREENELT LOCALPART)
of OLDCURVEELT]
(GCURVE (fetch (SCREENELT GLOBALPART) of OLDCURVEELT))
(MAPINFO (MAPDESCFROMFIGUREW MAPW)))
(RETURN (create SCREENELT
LOCALPART ←(create LOCALCURVE
KNOTS ← KNOTS)
GLOBALPART ←(create CURVE
MINSCALE ←(OR NEWMINSCALE (fetch (CURVE MINSCALE)
of GCURVE))
MAXSCALE ←(OR NEWMAXSCALE (fetch (CURVE MAXSCALE)
of GCURVE))
BRUSH ←(OR NEWBRUSH (fetch (CURVE BRUSH) of GCURVE))
CLOSE ←(COND
(NEWCLOSEFLG (NEQ NEWCLOSEFLG (QUOTE OPEN)))
(T (fetch (CURVE CLOSE) of GCURVE)))
DASHING ←(FIGW.DECODE.DASHING NEWDASHING
(fetch (CURVE DASHING)
of GCURVE))
LATLONKNOTS ←(COND
(NEWKNOTS (for PT in KNOTS collect (
UNSCALE.POSITION.FROM.MAPINFO PT MAPINFO)))
(T (fetch (CURVE LATLONKNOTS) of GCURVE])
(READDASHING
[LAMBDA NIL (* rrb "25-JAN-83 17:24")
(* 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 a number over 999 to leave the dashing unchanged.")
[COND
(MAPW.NUMBERPAD.READER)
(T (SETQ MAPW.NUMBERPAD.READER (CREATE.MAPW.NUMBERPAD.READER]
(bind VAL DASHLST OFF? until (EQ (SETQ VAL (PROGN [printout PROMPTWINDOW T
"Enter the number of points "
(COND
(OFF? (QUOTE OFF))
(T (QUOTE ON]
(NUMBERPAD.READ MAPW.NUMBERPAD.READER)))
0)
do [COND
((IGREATERP VAL 999)
(RETURN))
(T (SETQ DASHLST (CONS VAL DASHLST))
(SETQ OFF? (NOT OFF?]
finally (RETURN (OR (REVERSE DASHLST)
0])
)
(RPAQQ CURVE.PROPERTY.MENU NIL)
(RPAQQ TEXT.PROPERTY.MENU NIL)
(RPAQQ IMAGE.PROPERTY.MENU NIL)
(RPAQQ CIRCLE.PROPERTY.MENU NIL)
(RPAQQ ELLIPSE.PROPERTY.MENU NIL)
(RPAQQ CHOOSE.FONT.MENU NIL)
(RPAQQ MAPW.NUMBERPAD.READER NIL)
(DEFINEQ
(FIGUREW
[LAMBDA (FIGURESPECS REGION TITLE) (* rrb "20-JAN-83 12:20")
(* creates a figure window and returns it.)
(PROG ((W (CREATEW REGION TITLE)))
(* 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 FIGURESPECS)
FIGURESPECS)
(WINDOWPROP W (QUOTE COMMANDMENU)
(CREATE.FIGUREW.COMMANDMENU W))
(WINDOWPROP W (QUOTE BUTTONEVENTFN)
(FUNCTION FIGUREW.BUTTON.HANDLER))
(WINDOWPROP W (QUOTE REPAINTFN)
(FUNCTION FIGUREW.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))
(FIGUREW.REPAINTFN W)
(RETURN W])
(CREATE.FIGUREW.COMMANDMENU
[LAMBDA (WINDOW) (* rrb "28-JAN-83 16:16")
(* returns the control menu for a figure window.)
(PROG [(CMENU (create MENU
ITEMS ←(LIST (QUOTE (Delete FIGW.DELETE.ELT "Deletes a piece."))
(QUOTE (Move FIGW.MOVE.ELT "Moves one of the pieces."))
(QUOTE (Change FIGW.CHANGE.ELT
"Changes a property of a piece."))
(QUOTE ("" NILL))
(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.")
(LIST OPENCURVEICON (QUOTE FIGW.ADDOPENCURVE)
"Adds a curve by accepting points the curve goes through.")
(QUOTE ("" NILL))
(QUOTE (Size SETFIGUREWBRUSHSIZE
"Sets the size of the brush that new lines are drawn with."))
(QUOTE (Shape SETFIGUREWBRUSHSHAPE
"Sets the shape of the brush that new lines are drawn with."))
(QUOTE ("" NILL))
(QUOTE (inspect INSPECTFIGURESPECS
"Calls the Inspector on the figure data structures.")))
CENTERFLG ← T
WHENSELECTEDFN ←(FUNCTION FIGUREW.SELECTIONFN)
MENUUSERDATA ←(LIST (QUOTE FIGUREW)
WINDOW)
MENUFONT ←(QUOTE (GACHA 12 BOLD]
(SETQ CMENU (ADDMENU CMENU NIL (UPPERLEFTMENUPOSITION CMENU WINDOW)))
(WINDOWPROP CMENU (QUOTE FIGUREW)
WINDOW)
[COND
(CHARMICONFONT (* if charm icon menu stuff is loaded, put an icon menu
beside the regular command menu.)
(WINDOWPROP CMENU (QUOTE ICONMENU)
(CREATE.FIGUREW.ICONMENU CMENU))
(WINDOWPROP CMENU (QUOTE MOVEFN)
(FUNCTION MOVE.ICONMENU))
(WINDOWPROP CMENU (QUOTE CLOSEFN)
(FUNCTION CLOSE.ICONMENU))
(WINDOWPROP CMENU (QUOTE OPENFN)
(FUNCTION OPEN.ICONMENU]
(RETURN CMENU])
(INSPECTFIGURESPECS
[LAMBDA (MAPW) (* rrb "26-JAN-83 08:43")
(* calls the inspector on the figure specs of a figure
window.)
(INSPECT/TOP/LEVEL/LIST (FIGURESPECS MAPW])
(FIGUREW.BUTTON.HANDLER
[LAMBDA (W) (* handles a button event in a figure window.)
(TOTOPW W])
(FIGUREW.CLOSEFN
[LAMBDA (W) (* rrb "26-JAN-83 08:48")
(* closes and breaks the link from a windows command
menu to it so that it will be collected.)
(PROG [(COMWINDOW (WINDOWPROP W (QUOTE COMMANDMENU]
(for MENU in (WINDOWPROP COMWINDOW (QUOTE MENU)) do (PUTMENUPROP MENU (QUOTE FIGUREW)
NIL))
(CLOSEW COMWINDOW)
(RETURN W])
(FIGUREW.MOVEFN
[LAMBDA (W NEWPOS) (* rrb "30-DEC-82 10:57")
(* move function for a figure window.
Moves the command menu.)
(PROG [(WMENU (WINDOWPROP W (QUOTE COMMANDMENU]
(AND WMENU (MOVEW WMENU (UPPERLEFTMENUPOSITION WMENU W NEWPOS])
(FIGUREW.OPENFN
[LAMBDA (W) (* rrb "26-JAN-83 09:06")
(* creates the link from a windows command menu to it
that had been deleted so that it would be collected.)
(PROG [(COMMANDMENUW (WINDOWPROP W (QUOTE COMMANDMENU]
(for MENU in (WINDOWPROP COMMANDMENUW (QUOTE MENU)) do (PUTMENUPROP MENU (QUOTE FIGUREW)
W))
(OPENW COMMANDMENUW])
(FIGUREW.REPAINTFN
[LAMBDA (W REG) (* rrb "25-JAN-83 20:23")
(* redisplays the figure in a window)
(* for now ignore the region.)
(DSPOPERATION (QUOTE PAINT)
W)
(MAPFIGURESPECS (FIGURESPECS W)
(FUNCTION FIGW.DRAWFIGURE)
W REG])
(FIGUREW.SELECTIONFN
[LAMBDA (ITEM MENU) (* rrb "12-JAN-83 11:29")
(* calls the function appropriate for the item selected
from the command menu associated with a figure window.)
(APPLY* (CADR ITEM)
(WINDOWPROP (WFROMMENU MENU)
(QUOTE FIGUREW])
(CREATE.MAPW.NUMBERPAD.READER
[LAMBDA NIL (* rrb "25-JAN-83 13:54")
(CREATE.NUMBERPAD.READER NIL NIL (QUOTE (GACHA 12 BOLD))
(QUOTE (GACHA 12 BOLD])
)
(* functions for dealing with text.)
(DEFINEQ
(FIGW.DRAWTEXT
[LAMBDA (TEXTELT WINDOW REGION) (* rrb "24-JAN-83 17:50")
(* shows a text element)
(* the text element has a location that identifies its
latitude longitude and a display position that give the
origin of the text.)
(PROG [(GTEXT (fetch (SCREENELT GLOBALPART) of TEXTELT))
(POSITION (fetch (LOCALTEXT DISPLAYPOSITION) of (fetch (SCREENELT LOCALPART) of TEXTELT]
(DSPFONT (fetch (TEXT FONT) of GTEXT)
WINDOW)
(MOVETO (fetch XCOORD of POSITION)
(fetch YCOORD of POSITION)
WINDOW)
(PRIN3 (fetch (TEXT CHARACTERS) of GTEXT)
WINDOW])
(FIGW.ADDTEXT
[LAMBDA (W) (* rrb "26-JAN-83 17:46")
(* reads a piece of text from the user and adds it to
the figure associated with W.)
(FIGW.ADD.ELEMENT (READTEXT W)
W])
(READTEXT
[LAMBDA (WINDOW) (* rrb "20-JAN-83 13:03")
(* reads text and a place to put it from the user and returns a TEXTELT that represents it. Can return NIL if the
user positions it outside of the window.)
(POSITIONTEXTELT (READ.FROM.PROMPT.WINDOW "Text to be printed: ")
CURRENTFIGWFONT WINDOW "locate the text"])
(POSITIONTEXTELT
[LAMBDA (TEXT FONT WINDOW PROMPTMSG) (* rrb "26-JAN-83 14:49")
(* gets a position for a piece of text from the user and returns a text element that represents it.
The text location is the center position of the text.)
(* later this should change the cursor to the image
being placed.)
(PROG (P1 LOCATION DISPLAYPOSITION SCALE (MAPINFO (MAPDESCFROMFIGUREW WINDOW))
NEW.BITMAP DSP (WDTH (STRINGWIDTH TEXT FONT))
(HGHT (FONTHEIGHT FONT))
(DESCNT (FONTDESCENT FONT)))
(SETQ SCALE (SCALE.FROM.MAPINFO MAPINFO))
(SETQ NEW.BITMAP (BITMAPCREATE WDTH HGHT))
(SETQ DSP (DSPCREATE NEW.BITMAP))
(DSPFONT FONT DSP)
(MOVETO 0 DESCNT DSP)
(PRIN3 TEXT DSP)
(SETQ P1 (GET.BITMAP.POSITION WINDOW NEW.BITMAP (QUOTE PAINT)
PROMPTMSG)) (* correction is because GET.BITMAP.POSITION returns
the lower left corner but text is position by the
center.)
(RETURN (AND P1 (create SCREENELT
LOCALPART ←[create LOCALTEXT
LOCATIONPOSITION ←[SETQ LOCATION
(create POSITION
XCOORD ←(IPLUS (fetch (POSITION XCOORD)
of P1)
(LRSH WDTH 1))
YCOORD ←(IPLUS (fetch (POSITION YCOORD)
of P1)
(LRSH HGHT 1]
DISPLAYPOSITION ←(SETQ DISPLAYPOSITION
(create POSITION
XCOORD ←(fetch (POSITION XCOORD)
of P1)
YCOORD ←(IPLUS (fetch (POSITION YCOORD)
of P1)
DESCNT]
GLOBALPART ←(create TEXT
MAXSCALE ←(TIMES SCALE
DEFAULT.VISIBLE.SCALE.FACTOR)
MINSCALE ←(QUOTIENT SCALE
DEFAULT.VISIBLE.SCALE.FACTOR)
CHARACTERS ← TEXT
FONT ← FONT
LOCATIONLATLON ←(AND MAPINFO (
UNSCALE.POSITION.FROM.MAPINFO
LOCATION MAPINFO))
DISPLAYOFFSET ←(PTDIFFERENCE DISPLAYPOSITION
LOCATION])
(FIGW.MOVE.TEXT
[LAMBDA (TEXTELT SELPOS NEWPOS WINDOW) (* rrb "26-JAN-83 16:40")
(* moves a text figure element to a new position. A text elt has two pick up points, its location and its label
display position.)
(PROG ((MAPINFO (MAPDESCFROMFIGUREW WINDOW))
(LTEXT (fetch (SCREENELT LOCALPART) of TEXTELT))
(GTEXT (fetch (SCREENELT GLOBALPART) of TEXTELT))
LOC)
[COND
((EQUAL (SETQ LOC (fetch (LOCALTEXT LOCATIONPOSITION) of LTEXT))
SELPOS) (* move both the text location)
(replace (TEXT LOCATIONLATLON) of GTEXT with (UNSCALE.POSITION.FROM.MAPINFO NEWPOS
MAPINFO)))
((EQUAL (fetch (LOCALTEXT DISPLAYPOSITION) of LTEXT)
SELPOS) (* keep the display offset up to date.)
(replace (TEXT DISPLAYOFFSET) of GTEXT with (PTDIFFERENCE NEWPOS LOC]
(RETURN (LOCAL.TEXT.FROM.GLOBAL GTEXT WINDOW])
(MARKTEXTREGION
[LAMBDA (TEXTELT WINDOW MARK) (* rrb "24-JAN-83 19:30")
(* marks the hot area for text element.)
(* mark the location and the display position of the
text)
(MARKPOINT (fetch (LOCALTEXT LOCATIONPOSITION) of (SETQ TEXTELT (fetch (SCREENELT LOCALPART)
of TEXTELT)))
WINDOW MARK)
(MARKPOINT (fetch (LOCALTEXT DISPLAYPOSITION) of TEXTELT)
WINDOW MARK])
(ON.TEXT.HOT.SPOT
[LAMBDA (TEXTELT POS PTFLG) (* rrb "24-JAN-83 19:41")
(* determines whether or not POS is on a hot spot of a
text element.)
(* look at both the location of the text and its
display position.)
(PROG ((LOCALTEXT (fetch (SCREENELT LOCALPART) of TEXTELT))
TEXTPT)
(RETURN (COND
((OR (FIGW.NEARPT (SETQ TEXTPT (fetch (LOCALTEXT LOCATIONPOSITION) of LOCALTEXT))
POS)
(FIGW.NEARPT (SETQ TEXTPT (fetch (LOCALTEXT DISPLAYPOSITION) of LOCALTEXT))
POS))
(COND
(PTFLG TEXTPT)
(T TEXTELT])
(CREATE.TEXT.ELT.USING
[LAMBDA (OLDTEXTELT NEWFONT NEWCHARACTERS NEWCOLOR NEWMINSCALE NEWMAXSCALE MAPW)
(* rrb "29-JAN-83 16:38")
(* creates a text element that has changed some of the
fields)
(PROG ((GTEXT (fetch (SCREENELT GLOBALPART) of OLDTEXTELT)))
(RETURN (create SCREENELT
LOCALPART ←(create LOCALTEXT using (fetch (SCREENELT LOCALPART)
of OLDTEXTELT))
GLOBALPART ←(create TEXT
MINSCALE ←(OR NEWMINSCALE (fetch (TEXT MINSCALE)
of GTEXT))
MAXSCALE ←(OR NEWMAXSCALE (fetch (TEXT MAXSCALE)
of GTEXT))
LOCATIONLATLON ←(fetch (TEXT LOCATIONLATLON)
of GTEXT)
FONT ←(OR NEWFONT (fetch (TEXT FONT) of GTEXT))
COLOR ←(OR NEWFONT (fetch (TEXT COLOR) of GTEXT))
CHARACTERS ←(OR NEWCHARACTERS (fetch (TEXT CHARACTERS)
of GTEXT))
DISPLAYOFFSET ←(fetch (TEXT DISPLAYOFFSET)
of GTEXT])
(CHANGE.TEXTPART
[LAMBDA (TEXTELT WINDOW) (* rrb "29-JAN-83 16:37")
(* lets the user specify a new property for TEXTELT and
returns a new one.)
(PROG (NEWVAL)
(RETURN (SELECTQ [MENU (COND
((type? MENU TEXT.PROPERTY.MENU)
TEXT.PROPERTY.MENU)
(T (SETQ TEXT.PROPERTY.MENU
(create MENU
ITEMS ←(QUOTE (Font% Style Location Display% Position
MinScale MaxScale))
CENTERFLG ← T
TITLE ← "Which property?"]
(Font% Style (AND (SETQ NEWVAL (READFONT))
(CREATE.TEXT.ELT.USING TEXTELT NEWVAL NIL NIL NIL NIL
WINDOW)))
(Location (AND (SETQ NEWVAL (READLATLON (fetch (TEXT LOCATIONLATLON)
of (fetch (SCREENELT GLOBALPART)
of TEXTELT))
WINDOW))
(* move location)
))
(Display% Position)
(MinScale)
(MaxScale)
NIL])
(READFONT
[LAMBDA NIL (* rrb "29-JAN-83 15:17")
(* give the user a choice of fonts)
(MENU (COND
((type? MENU CHOOSE.FONT.MENU)
CHOOSE.FONT.MENU)
(T (SETQ CHOOSE.FONT.MENU (create MENU
ITEMS ←[QUOTE ((Helvetica5 (QUOTE (HELVETICA 5)))
(Helvetica8 (QUOTE (HELVETICA 8)))
(Helvetica10 (QUOTE (HELVETICA 10)))
(Helvetica12 (QUOTE (HELVETICA 12)))
(Helvetica14 (QUOTE (HELVETICA 14)))
(Helvetica18 (QUOTE (HELVETICA 18)))
(TimesRoman8 (QUOTE (TIMESROMAN 8)))
(TimesRoman10 (QUOTE (TIMESROMAN 10)))
(TimesRoman12 (QUOTE (TIMESROMAN 12)))
(TimesRoman14 (QUOTE (TIMESROMAN 14)))
(TimesRoman18 (QUOTE (TIMESROMAN 18)))
(Gacha8 (QUOTE (GACHA 8)))
(Gacha10 (QUOTE (GACHA 10)))
(Gacha12 (QUOTE (GACHA 12)))
(Gacha12B (QUOTE (GACHA 12 BOLD]
CENTERFLG ← T])
)
(DEFINEQ
(GET.BITMAP.POSITION
[LAMBDA (WINDOW BITMAP OPERATION MSG) (* rrb "17-JAN-83 12:28")
(* gets a position by tracking with a bitmap)
(PROG (BUFFER.BITMAP WIDTH HEIGHT)
(SETQ WIDTH (BITMAPWIDTH BITMAP))
(SETQ HEIGHT (BITMAPHEIGHT BITMAP))
(SETQ BUFFER.BITMAP (BITMAPCREATE WIDTH HEIGHT))
(printout PROMPTWINDOW T MSG)
(RETURN (TRACK.BITMAP1 WINDOW BITMAP BUFFER.BITMAP WIDTH HEIGHT (OR OPERATION (QUOTE PAINT])
(TRACK.BITMAP1
[LAMBDA (W BITMAP BUFFER.BITMAP WIDTH HEIGHT OPERATION) (* rrb "20-JAN-83 11:38")
(* tracks BITMAP until a button goes down and comes up.
Returns the position at the up click.)
(* there is other code in BIGFONT that is probably
better for this.)
(PROG [DOWN LEFT BOTTOM NEW.LEFT NEW.BOTTOM (DSP (WINDOWPROP W (QUOTE DSP]
(RETURN (until (AND DOWN (LASTMOUSESTATE UP))
do (GETMOUSESTATE)
(UPDATELATLON W)
(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))
[COND
(LEFT (BITBLT BUFFER.BITMAP 0 0 DSP LEFT BOTTOM WIDTH HEIGHT
(QUOTE INPUT)
(QUOTE REPLACE]
(SETQ LEFT NEW.LEFT)
(SETQ BOTTOM NEW.BOTTOM)
(BITBLT DSP LEFT BOTTOM BUFFER.BITMAP 0 0 WIDTH HEIGHT (QUOTE INPUT)
(QUOTE REPLACE))
(BITBLT BITMAP 0 0 DSP LEFT BOTTOM WIDTH HEIGHT (QUOTE INPUT)
OPERATION)))
finally (* restore screen)
(BITBLT BUFFER.BITMAP 0 0 DSP LEFT BOTTOM WIDTH HEIGHT (QUOTE INPUT)
(QUOTE REPLACE))
(RETURN (AND (INSIDEP (DSPCLIPPINGREGION NIL DSP)
LEFT BOTTOM)
(create POSITION
XCOORD ← LEFT
YCOORD ← BOTTOM])
)
(DEFINEQ
(DISTANCEBETWEEN
[LAMBDA (P1 P2) (* rrb " 5-JAN-83 12:17")
(* returns the distance between two points)
(SQRT (PLUS (SQUARE (DIFFERENCE (fetch (POSITION XCOORD) of P1)
(fetch (POSITION XCOORD) of P2)))
(SQUARE (DIFFERENCE (fetch (POSITION YCOORD) of P1)
(fetch (POSITION YCOORD) of P2])
(SQUARE
[LAMBDA (X)
(TIMES X X])
)
(DEFINEQ
(GETAISFILEINFO
[LAMBDA (FILE PROPERTY) (* rrb "30-NOV-82 18:28")
(* returns a property from an AIS file.)
(PROG (OFD TMP) (* check the file.)
[COND
((OR (SETQ OFD (FINDFILE FILE NIL AISDIRECTORIES))
(SETQ OFD FILE))
(SETQ OFD (GETSTREAM (OPENFILE OFD (QUOTE INPUT))
(QUOTE INPUT] (* make sure the file is an AIS file and read its bits
per sample, width and height.)
(SETQ TMP (INSUREAISFILE OFD))
(RETURN (SELECTQ PROPERTY
(BITSPERSAMPLE (CAR TMP))
(WIDTH (CADR TMP))
(HEIGHT (CADDR TMP))
(WORDSPERSAMPLE (CADDDR TMP))
(ERROR "unknown AIS file property." PROPERTY])
(INVISIBLEPARTP
[LAMBDA (WINDOW POINT) (* rrb "30-NOV-82 17:25")
(* determines if POINT is in the visible part of a
window.)
(INSIDE? (DSPCLIPPINGREGION NIL WINDOW)
(fetch (POSITION XCOORD) of POINT)
(fetch (POSITION YCOORD) of POINT])
(UPPERLEFTMENUPOSITION
[LAMBDA (MENU WINDOW NEWPOS) (* rrb "10-JAN-83 18:17")
(* returns the position MENU needs to be in in order to
fit in next to WINDOW on the upper left.)
(* doesn't check for being off the right hand side of
the screen and probably should.)
(PROG [(WREG (WINDOWPROP WINDOW (QUOTE REGION]
(RETURN (create POSITION
XCOORD ←(COND
(NEWPOS (IPLUS (fetch (POSITION XCOORD) of NEWPOS)
(fetch (REGION WIDTH) of WREG)))
(T (fetch (REGION PRIGHT) of WREG)))
YCOORD ←(IDIFFERENCE (COND
(NEWPOS (IPLUS (fetch (POSITION YCOORD)
of NEWPOS)
(fetch (REGION HEIGHT) of WREG)))
(T (fetch (REGION PTOP) of WREG)))
(COND
((type? MENU MENU)
(fetch (MENU IMAGEHEIGHT) of MENU))
[(WINDOWP MENU)
(fetch (REGION HEIGHT) of (WINDOWPROP
MENU
(QUOTE REGION]
(T (ERROR "arg not MENU or WINDOW" MENU])
)
(* FOLLOWING DEFINITIONS EXPORTED)
[DECLARE: EVAL@COMPILE
(RECORD PELT (PTYPE MINSCALE MAXSCALE . PBODY))
(RECORD SCREENELT (LOCALPART . GLOBALPART))
(TYPERECORD CURVE (MINSCALE MAXSCALE LATLONKNOTS BRUSH COLOR CLOSE DASHING))
(TYPERECORD TEXT (MINSCALE MAXSCALE LOCATIONLATLON FONT COLOR CHARACTERS DISPLAYOFFSET))
(TYPERECORD CIRCLE (MINSCALE MAXSCALE CENTERLATLON RADIUSLATLON BRUSH DASHING))
(TYPERECORD ELLIPSE (MINSCALE MAXSCALE ELLIPSECENTERLATLON SEMIMINORLATLON SEMIMAJORLATLON
ORIENTATION BRUSH DASHING))
(TYPERECORD IMAGE (MINSCALE MAXSCALE DISPLAYLATLON BITMAP SUBREGION))
(RECORD LOCALIMAGE (IMAGEPOSITION))
(RECORD LOCALELLIPSE (ELLIPSECENTER SEMIMINORRADIUS SEMIMAJORRADIUS MINORRADIUSPOSITION
MAJORRADIUSPOSITION))
(RECORD LOCALCIRCLE (CENTERPOSITION RADIUSPOSITION RADIUS))
(RECORD LOCALTEXT (LOCATIONPOSITION DISPLAYPOSITION))
(RECORD LOCALCURVE (KNOTS))
]
(* END EXPORTED DEFINITIONS)
(RPAQ POINTREADINGCURSOR (CURSORCREATE (READBITMAP) 7 7))
(16 16
"@@@@"
"@GL@"
"AMG@"
"CAAH"
"FA@L"
"DA@D"
"LA@F"
"HA@B"
"OOON"
"HA@B"
"LA@F"
"DA@D"
"FA@L"
"CAAH"
"AMG@"
"@GL@")(READVARS POINTMARK FIGW.SELECTEDMARK FIGW.LOCATEMARK CLOSECURVEICON OPENCURVEICON CIRCLEICON
ELLIPSEICON)
({(READBITMAP)(7 7
"HB@@"
"DD@@"
"BH@@"
"A@@@"
"BH@@"
"DD@@"
"HB@@")} {(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)(20 12
"@@OH@@@@"
"@OOO@@@@"
"@OHON@@@"
"AL@AO@@@"
"AH@@G@@@"
"CH@@C@@@"
"CH@@C@@@"
"CH@@G@@@"
"AN@@N@@@"
"@OCLN@@@"
"@COOL@@@"
"@@NCH@@@")} {(READBITMAP)(20 12
"@@@@@@@@"
"@L@@@@@@"
"@L@@F@@@"
"AL@@O@@@"
"AH@@G@@@"
"CH@@C@@@"
"CH@@C@@@"
"CH@@G@@@"
"AN@@N@@@"
"@OCLN@@@"
"@COOL@@@"
"@@NCH@@@")} {(READBITMAP)(20 12
"@AOH@@@@"
"@COL@@@@"
"@G@N@@@@"
"@F@F@@@@"
"@N@G@@@@"
"@L@C@@@@"
"@L@C@@@@"
"@N@G@@@@"
"@F@F@@@@"
"@G@N@@@@"
"@COL@@@@"
"@AOH@@@@")} {(READBITMAP)(20 12
"@COL@@@@"
"AOOOH@@@"
"CN@GL@@@"
"G@@@N@@@"
"N@@@G@@@"
"L@@@C@@@"
"L@@@C@@@"
"N@@@G@@@"
"G@@@N@@@"
"CN@GL@@@"
"AOOOH@@@"
"@COL@@@@")})
(* functions needed from NOTEPAD. Copied here so don't need all of notepad.)
(DEFINEQ
(MARK.SPOT
[LAMBDA (X/POSITION Y WINDOW) (* rrb "14-JAN-83 15:40")
(PROG [X WIDTH HEIGHT (COLORDS (WINDOWPROP WINDOW (QUOTE INCOLOR]
(COND
((POSITIONP X/POSITION)
(SETQ X (fetch (POSITION XCOORD) of X/POSITION))
(SETQ Y (fetch (POSITION YCOORD) of X/POSITION)))
(T (SETQ X X/POSITION)))
(SETQ WIDTH (BITMAPWIDTH SPOTMARKER))
(SETQ HEIGHT (BITMAPHEIGHT SPOTMARKER))
(BITBLT (COND
[COLORDS (COND
((AND (BITMAPP COLORSPOTMARKER)
(EQ (BITSPERPIXEL COLORSPOTMARKER)
(COLORNUMBERBITSPERPIXEL)))
COLORSPOTMARKER)
(T (SETQ COLORSPOTMARKER (COLORIZEBITMAP SPOTMARKER 0 (MAXIMUMCOLOR)
(COLORNUMBERBITSPERPIXEL]
(T SPOTMARKER))
0 0 (OR COLORDS WINDOW)
(IDIFFERENCE X (IQUOTIENT WIDTH 2))
(IDIFFERENCE Y (IQUOTIENT HEIGHT 2))
WIDTH HEIGHT (QUOTE INPUT)
(QUOTE INVERT])
(READ.FROM.PROMPT.WINDOW
[LAMBDA (PRMPT) (* edited: "15-DEC-82 23:02")
(CLEARBUF T T)
(CAR (PROCESS.READ PROMPTWINDOW PRMPT T])
(GETWREGION
[LAMBDA (W) (* rrb "28-JAN-83 12:56")
(* gets a region from a window)
(PROG ((REG (GETREGION)))
(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 SPOTMARKER (READBITMAP))
(17 18
"@@@@@@@@"
"@@@@@@@@"
"@@L@@@@@"
"@@L@@@@@"
"@@L@@@@@"
"@@L@@@@@"
"@@@@@@@@"
"ANMN@@@@"
"ANMN@@@@"
"@@@@@@@@"
"@@L@@@@@"
"@@L@@@@@"
"@@L@@@@@"
"@@L@@@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@@@@@@")
(RPAQ CIRCLE.CENTER (CURSORCREATE (READBITMAP) 8 8))
(16 16
"@GN@"
"AOOH"
"CLCL"
"G@@N"
"FDBF"
"NJEG"
"LEJC"
"LBDC"
"LBDC"
"LEJC"
"NJEG"
"FDBF"
"G@@N"
"CLCL"
"AOOH"
"@GN@")(RPAQ CIRCLE.EDGE (CURSORCREATE (READBITMAP) 15 8))
(16 16
"@@AL"
"@@@L"
"@@@N"
"@@@F"
"@@BG"
"@@CC"
"@@CK"
"OOOO"
"OOOO"
"@@CK"
"@@CC"
"@@BG"
"@@@F"
"@@@N"
"@@@L"
"@@AL")(RPAQ ELLIPSE.CENTER (CURSORCREATE (READBITMAP) 8 8))
(16 16
"@GN@"
"AOOH"
"CLCL"
"G@@N"
"FDBF"
"NJEG"
"LEJC"
"LBDC"
"LBDC"
"LEJC"
"NJEG"
"FDBF"
"G@@N"
"CLCL"
"AOOH"
"@GN@")(RPAQ ELLIPSE.SEMI.MAJOR (CURSORCREATE (READBITMAP) 15 8))
(16 16
"@@AL"
"@@@L"
"@@@N"
"@@@F"
"@@BG"
"@@CC"
"@@CK"
"OOOO"
"OOOO"
"@@CK"
"@@CC"
"@@BG"
"@@@F"
"@@@N"
"@@@L"
"@@AL")(RPAQ ELLIPSE.SEMI.MINOR (CURSORCREATE (READBITMAP) 8 15))
(16 16
"@OO@"
"COOL"
"OIIO"
"NCLG"
"HGNA"
"@OO@"
"@AH@"
"@AH@"
"@AH@"
"@AH@"
"@AH@"
"@AH@"
"@AH@"
"@AH@"
"@AH@"
"@AH@")(RPAQ CURVE.KNOT (CURSORCREATE (READBITMAP) 8 8))
(16 16
"@GN@"
"AOOH"
"CLCL"
"G@@N"
"FDBF"
"NJEG"
"LEJC"
"LBDC"
"LBDC"
"LEJC"
"NJEG"
"FDBF"
"G@@N"
"CLCL"
"AOOH"
"@GN@")[DECLARE: EVAL@COMPILE
(RECORD BRUSH (BRUSHSHAPE BRUSHSIZE BRUSHCOLOR))
]
(RPAQQ BITMAPDIRECTORIES ({DSK} {PHYLUM}<AIS>))
(RPAQQ DRAWBITMAPALIST NIL)
(RPAQQ DRAWCURVESWITHLINESFLG NIL)
(RPAQQ FIGURE.ELEMENT.TYPES (CURVE TEXT CIRCLE ELLIPSE MAPPIECE IMAGE))
(RPAQQ DRAWCURVEWITHLINESFLG NIL)
(RPAQQ DEFAULT.VISIBLE.SCALE.FACTOR 3)
(RPAQ CURRENTFIGUREWBRUSH (CREATE BRUSH BRUSHSHAPE ← (QUOTE ROUND)
BRUSHSIZE ← 1 BRUSHCOLOR ← WHITECOLOR))
(RPAQQ CURRENTFIGUREWDASHING NIL)
(RPAQQ CURRENTFIGWFONT (HELVETICA 12))
(RPAQQ CHARMICONFONT NIL)
(FILESLOAD (FROM VALUEOF LISPUSERSDIRECTORIES)
READNUMBER)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS BITMAPDIRECTORIES DRAWBITMAPALIST DRAWCURVEWITHLINESFLG CURRENTFIGUREWBRUSH
CURRENTFIGUREWDASHING POINTMARK CLOSECURVEICON OPENCURVEICON ELLIPSEICON CIRCLEICON
POINTMARKHALFWIDTH POINTMARKWIDTH DEFAULT.VISIBLE.SCALE.FACTOR FIGURE.ELEMENT.TYPES)
)
(PUTPROPS MAPSKETCH COPYRIGHT ("Xerox Corporation" 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (3989 15055 (ADDFIGUREWELT 3999 . 4304) (BITMAPFROMFILE 4306 . 4894) (DECODEBITMAP 4896
. 5947) (FIGURESPECS 5949 . 6138) (GETDRAWPOSITION 6140 . 6778) (MAPFIGURESPECS 6780 . 7456) (
MAPFIGURESPECSUNTIL 7458 . 8224) (READBRUSHSIZE 8226 . 8780) (READSPLINE 8782 . 9817) (READCIRCLE 9819
. 10624) (READELLIPSE 10626 . 11766) (RESHAPEBYREPAINTANDMOVEFN 11768 . 13143) (SETFIGUREWBRUSHSHAPE
13145 . 13619) (SETFIGUREWBRUSHSIZE 13621 . 14081) (SHOWDRAWPOINT 14083 . 14676) (SHOWFIGUREKNOTS
14678 . 15053)) (15056 20091 (FIGW.DRAWFIGURE 15066 . 16406) (FIGW.ERASE.ELT 16408 . 16789) (
FIGW.DRAWCURVE 16791 . 17483) (FIGW.DRAWIMAGE 17485 . 18388) (FIGW.DRAWCIRCLE 18390 . 19160) (
FIGW.DRAWELLIPSE 19162 . 20089)) (20092 27601 (FIGW.ADDCLOSEDCURVE 20102 . 20442) (FIGW.ADDCIRCLE
20444 . 20771) (FIGW.ADDELLIPSE 20773 . 21102) (FIGW.ADDOPENCURVE 21104 . 21444) (FIGW.DELETE.ELT
21446 . 21660) (FIGW.SEL.AND.DELETE 21662 . 22039) (FIGW.DELETE.ITEM 22041 . 22234) (
FIGW.ERASE.AND.DELETE.ITEM 22236 . 22462) (CREATE.CIRCLE.ELT 22464 . 23351) (LOCAL.CIRCLE.FROM.GLOBAL
23353 . 24256) (CREATE.SPLINE.ELT 24258 . 25053) (CREATE.ELLIPSE.ELT 25055 . 26013) (
LOCAL.ELLIPSE.FROM.GLOBAL 26015 . 27171) (COMPUTE.ELLIPSE.ORIENTATION 27173 . 27599)) (27602 38081 (
FIGW.ADD.ELEMENT 27612 . 28526) (FIGW.DELETE.ELEMENT 28528 . 29348) (MAPW.INSIDE.REGION 29350 . 29976)
(ELT.INSIDE.MAPWP 29978 . 30354) (FIGW.DISPLAY.AND.ADD.ITEM 30356 . 30728) (
FIGW.DISPLAY.AND.ADD.ITEMS 30730 . 30993) (FIGW.MOVE.THING 30995 . 32220) (FIGW.MOVE.ELT 32222 . 32520
) (FIGW.SEL.AND.MOVE 32522 . 32998) (FIGW.MOVE.CURVEPART 33000 . 33904) (FIGW.MOVE.CIRCLEPART 33906 .
35413) (FIGW.MOVE.ELLIPSEPART 35415 . 37552) (FIGW.MOVE.IMAGE 37554 . 38079)) (38082 42013 (MARKFIGURE
38092 . 38897) (FIGW.SHOWMARKS 38899 . 39192) (FIGW.MARKSELECTIONSPOTS 39194 . 39478) (MARKKNOTS
39480 . 39764) (MARKPOINT 39766 . 40486) (MARKCIRCLEKNOTS 40488 . 40963) (MARKELLIPSEKNOTS 40965 .
41548) (MARKIMAGEKNOTS 41550 . 42011)) (42014 50264 (ON.CIRCLE.HOT.SPOT 42024 . 42850) (
FIGW.SELECT.ITEM 42852 . 45102) (FIGW.DESELECT.ELT 45104 . 45476) (FIGW.MARK.SELECTION 45478 . 45919)
(FIGW.SELECT.ELT 45921 . 46287) (IN.FIGURE.ELT? 46289 . 46477) (ON.HOT.SPOT 46479 . 47279) (
ON.CURVE.HOT.SPOT 47281 . 47825) (ON.ELLIPSE.HOT.SPOT 47827 . 48878) (ON.IMAGE.HOT.SPOT 48880 . 49487)
(FIGW.NEARPT 49489 . 50262)) (50327 62003 (FIGW.CHANGE.ELT 50337 . 50677) (FIGW.SEL.AND.CHANGE 50679
. 51075) (FIGW.CHANGE.PROPERTY 51077 . 52215) (FIGW.UPDATE.ELEMENT 52217 . 53244) (
LOCAL.ELT.OF.GLOBALPART 53246 . 53633) (FIGW.LOCAL.FROM.GLOBAL 53635 . 54580) (LOCAL.CURVE.FROM.GLOBAL
54582 . 55219) (LOCAL.TEXT.FROM.GLOBAL 55221 . 55971) (LOCAL.IMAGE.FROM.GLOBAL 55973 . 56518) (
FIGW.UPDATE.FIGURE.ELEMENT1 56520 . 56980) (CHANGE.CURVEPART 56982 . 59048) (FIGW.DECODE.DASHING 59050
. 59502) (CREATE.SPLINE.ELT.USING 59504 . 60930) (READDASHING 60932 . 62001)) (62264 69265 (FIGUREW
62274 . 63694) (CREATE.FIGUREW.COMMANDMENU 63696 . 66169) (INSPECTFIGURESPECS 66171 . 66487) (
FIGUREW.BUTTON.HANDLER 66489 . 66648) (FIGUREW.CLOSEFN 66650 . 67207) (FIGUREW.MOVEFN 67209 . 67613) (
FIGUREW.OPENFN 67615 . 68168) (FIGUREW.REPAINTFN 68170 . 68624) (FIGUREW.SELECTIONFN 68626 . 69032) (
CREATE.MAPW.NUMBERPAD.READER 69034 . 69263)) (69311 79361 (FIGW.DRAWTEXT 69321 . 70193) (FIGW.ADDTEXT
70195 . 70525) (READTEXT 70527 . 70940) (POSITIONTEXTELT 70942 . 73291) (FIGW.MOVE.TEXT 73293 . 74379)
(MARKTEXTREGION 74381 . 75005) (ON.TEXT.HOT.SPOT 75007 . 75828) (CREATE.TEXT.ELT.USING 75830 . 77042)
(CHANGE.TEXTPART 77044 . 78183) (READFONT 78185 . 79359)) (79362 81673 (GET.BITMAP.POSITION 79372 .
79977) (TRACK.BITMAP1 79979 . 81671)) (81674 82231 (DISTANCEBETWEEN 81684 . 82181) (SQUARE 82183 .
82229)) (82232 84877 (GETAISFILEINFO 82242 . 83158) (INVISIBLEPARTP 83160 . 83571) (
UPPERLEFTMENUPOSITION 83573 . 84875)) (87102 88947 (MARK.SPOT 87112 . 88188) (READ.FROM.PROMPT.WINDOW
88190 . 88390) (GETWREGION 88392 . 88945)))))
STOP