(FILECREATED " 3-Apr-86 11:40:16" {QV}<PEDERSEN>LISP>PLOT.;132 157072
changes to: (FNS PRINTPLOTOBJECT REDRAWPLOTWINDOW)
previous date: "27-Mar-86 21:56:48" {QV}<PEDERSEN>LISP>PLOT.;131)
(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT PLOTCOMS)
(RPAQQ PLOTCOMS [(* * PLOT manager fns)
(FNS ADDPLOTOBJECT ADJUSTSCALE? ADJUSTVIEWPORT APPLY.AFTERFN.MACRO ASKFORLABEL ASKFORSCALE
BOXREGION CHOOSESCALE CHOOSETICS CLOSEPLOTWINDOW CLOSESTPLOTOBJECT COMPOUNDSUBTYPE
COMPUTEBOTTOMMARGIN COMPUTELEFTMARGIN COMPUTERIGHTMARGIN COMPUTETOPMARGIN COPYMENU
CREATEPLOT CREATEPLOTBITMAPOBJ CREATEPLOTFNS CREATEPLOTOBJECT DEFAULTSCALEFN
DEFAULTTICFN DEFAULTTICMETHOD DELETEPLOTOBJECT DESELECTPLOTOBJECT DISTANCETOPLOTOBJECT
DRAWBOTTOMMARGIN DRAWLEFTMARGIN DRAWMARGIN DRAWPLOTOBJECT DRAWPLOT DRAWRIGHTMARGIN
DRAWTOPMARGIN ERASEPLOTOBJECT EXTENDEDSCALEFN EXTENTOFPLOTOBJECT EXTENTOFPLOT
GETPLOTWINDOW GETTICLIST HIGHLIGHTPLOTOBJECT LABELPLOTOBJECT LOWLIGHTPLOTOBJECT
MANUALRESCALE MINSTREAMREGIONSIZE MOVEPLOTOBJECT OPENPLOTWINDOW PLOT.BUTTONEVENTFN
PLOT.CLOSEFN PLOT.FIXRIGHTMENU PLOT.HARDCOPYFN PLOT.ICONFN PLOT.LABELTOWORLD
PLOT.REPAINTFN PLOT.RESET PLOT.SETUP PLOT.SKETCH.CREATE PLOT.WHENSELECTEDFN
PLOT.WORLDTOLABEL PLOTADDMENUITEMS PLOTADDPROP PLOTAXISINTERVAL PLOTDELMENUITEMS
PLOTDELPROP PLOTLABEL PLOTMENU PLOTMENUITEMS PLOTOBJECTADDPROP PLOTOBJECTDELPROP
PLOTOBJECTLABEL PLOTOBJECTPROP PLOTOBJECTPROPMACRO PLOTOBJECTSUBTYPE PLOTOPERROR
PLOTPROMPT PLOTPROP PLOTPROPMACRO PLOTREMPROP PLOTSCALEFN PLOTTICFN PLOTTICINFO
PLOTTICMETHOD PLOTTICS PRINTFONT PRINTMENU REDRAWPLOTWINDOW RELABELSELECTEDPLOTOBJECT
RESCALEPLOT SCALE TOGGELLABEL TOGGLEEXTENDEDAXES TOGGLEFIXEDMENU TOGGLETICS
TRANSLATEPLOTOBJECT UNDELETEPLOTOBJECT UNLABELPLOTOBJECT WHICHLABEL WHICHPLOT)
(RECORDS EXTENT MARGIN PLOT PLOTFNS PLOTOBJECT AXISINFO AXISINTERVAL PLOTSCALE TICINFO)
(MACROS APPLY.AFTERFN PLOTOBJECTSUBTYPE? PLOTOBJECTPROP PLOTPROP)
(PROP ARGNAMES PLOTOBJECTPROP PLOT.FIXRIGHTMENU PLOTLABEL PLOTMENU PLOTMENUITEMS
PLOTPRETTYFNS PLOTPROP PLOTSCALEFN PLOTTICFN PLOTTICS)
[INITVARS (SMALLPLOTFONT (QUOTE (GACHA 8 MRR)))
(LARGEPLOTFONT (QUOTE (GACHA 12 BRR]
(DECLARE: FIRST (VARS OBJECTOPSTABLE))
(* * PLOT I/O)
(FNS COPYPLOTOBJECT COPYPLOT PLOTOBJECTPRINT PRINTPLOTOBJECT PRINTPLOT READFONT READMENU
READPLOTOBJECT READPLOT)
(FILEPKGCOMS PLOTS)
(ADDVARS (HPRINTMACROS (FONTDESCRIPTOR . PRINTFONT)
(MENU . PRINTMENU)
(PLOT . PRINTPLOT)
(PLOTOBJECT . PRINTPLOTOBJECT)))
(P (DEFPRINT (QUOTE PLOTOBJECT)
(FUNCTION PLOTOBJECTPRINT)))
(* * Numeric fns)
(FNS PLOT.EXP10 PLOT.LOG10 PLOT.FLOOR PLOT.CEILING SINEWAVE)
(* * PLOT image object FNS)
(FNS CREATEPLOTIMAGEOBJ PLIO.BUTTONEVENTINFN PLIO.COPYFN PLIO.GETFN PLIO.PUTFN
PLIO.REINSERTOBJ PLOT.COPYBUTTONEVENTFN PLIO.DISPLAYFN PLIO.IMAGEBOXFN)
[INITVARS (PLOTIMAGEFNS (IMAGEFNSCREATE (FUNCTION PLIO.DISPLAYFN)
(FUNCTION PLIO.IMAGEBOXFN)
(FUNCTION PLIO.PUTFN)
(FUNCTION PLIO.GETFN)
(FUNCTION PLIO.COPYFN)
(FUNCTION PLIO.BUTTONEVENTINFN)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL]
(GLOBALVARS PLOTIMAGEFNS)
(* * Initialize PLOTFNS)
(P (PLOT.SETUP OBJECTOPSTABLE))
(* * Dependent files)
(FILES TWODGRAPHICS PLOTOBJECTS)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (LOCALVARS . T))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA)
(NLAML)
(LAMA PLOTTICS PLOTTICFN PLOTSCALEFN PLOTPROP PLOTOBJECTPROP PLOTMENUITEMS
PLOTMENU PLOTLABEL PLOT.FIXRIGHTMENU])
(* * PLOT manager fns)
(DEFINEQ
(ADDPLOTOBJECT
[LAMBDA (OBJECT PLOT NODRAWFLG) (* edited: "27-Mar-86 21:26")
(PROG ((WHENADDEDFN (PLOTOBJECTPROP OBJECT (QUOTE WHENADDEDFN)))
REDRAWFLG NEWSCALES)
[if (NOT (MEMB OBJECT (fetch PLOTOBJECTS of PLOT)))
then (replace PLOTOBJECTS of PLOT with (CONS OBJECT (fetch PLOTOBJECTS
of PLOT]
(if (ADJUSTSCALE? (EXTENTOFPLOTOBJECT OBJECT PLOT)
PLOT)
then (SETQ REDRAWFLG T))
(if (NULL NODRAWFLG)
then (if [OR REDRAWFLG (NOT (OPENWP (fetch PLOTWINDOW of PLOT]
then (REDRAWPLOTWINDOW PLOT)
else (DRAWPLOTOBJECT OBJECT (fetch PLOTWINDOWVIEWPORT of PLOT)
PLOT)))
(APPLY.AFTERFN WHENADDEDFN OBJECT PLOT NODRAWFLG)
(RETURN OBJECT])
(ADJUSTSCALE?
[LAMBDA (EXTENT PLOT) (* jop: "20-Feb-86 17:19")
(* * Determines whether the plotting scale must be adjusted to included the extrema "minx", "maxx", etc. If so
returns T. Side effects the PLOTSCALE of PLOT)
(LET* ((PLOTSCALE (fetch (PLOT PLOTSCALE) of PLOT))
(XINTERVAL (fetch (PLOTSCALE XINTERVAL) of PLOTSCALE))
(XAXISINFO (fetch (PLOTSCALE XAXISINFO) of PLOTSCALE))
(XTICINFO (fetch (PLOTSCALE XTICINFO) of PLOTSCALE))
(YINTERVAL (fetch (PLOTSCALE YINTERVAL) of PLOTSCALE))
(YAXISINFO (fetch (PLOTSCALE YAXISINFO) of PLOTSCALE))
(YTICINFO (fetch (PLOTSCALE YTICINFO) of PLOTSCALE))
(MINX (fetch MINX of EXTENT))
(MAXX (fetch MAXX of EXTENT))
(MINY (fetch MINY of EXTENT))
(MAXY (fetch MAXY of EXTENT))
CHANGEDFLG)
[if (OR (LESSP MINX (fetch (AXISINTERVAL MIN) of XINTERVAL))
(GREATERP MAXX (fetch (AXISINTERVAL MAX) of XINTERVAL)))
then (SETQ CHANGEDFLG T)
(LET [(NEWMIN (FMIN MINX (fetch (AXISINTERVAL MIN) of XINTERVAL)))
(NEWMAX (FMAX MAXX (fetch (AXISINTERVAL MAX) of XINTERVAL]
(SETQ XTICINFO (CHOOSETICS NEWMIN NEWMAX XAXISINFO PLOT))
(SETQ XINTERVAL (CHOOSESCALE NEWMIN NEWMAX XAXISINFO XTICINFO PLOT]
[if (OR (LESSP MINY (fetch (AXISINTERVAL MIN) of YINTERVAL))
(GREATERP MAXY (fetch (AXISINTERVAL MAX) of YINTERVAL)))
then (SETQ CHANGEDFLG T)
(LET [(NEWMIN (FMIN MINY (fetch (AXISINTERVAL MIN) of YINTERVAL)))
(NEWMAX (FMAX MAXY (fetch (AXISINTERVAL MAX) of YINTERVAL]
(SETQ YTICINFO (CHOOSETICS NEWMIN NEWMAX YAXISINFO PLOT))
(SETQ YINTERVAL (CHOOSESCALE NEWMIN NEWMAX YAXISINFO YTICINFO PLOT]
(if CHANGEDFLG
then (replace (PLOTSCALE XINTERVAL) of PLOTSCALE with XINTERVAL)
(replace (PLOTSCALE XTICINFO) of PLOTSCALE with XTICINFO)
(replace (PLOTSCALE YINTERVAL) of PLOTSCALE with YINTERVAL)
(replace (PLOTSCALE YTICINFO) of PLOTSCALE with YTICINFO))
CHANGEDFLG])
(ADJUSTVIEWPORT
[LAMBDA (VIEWPORT STREAMREGION PLOT) (* jop: "12-Aug-85 14:51")
(PROG ((PLOTSCALE (fetch PLOTSCALE of PLOT))
(PARENTSTREAM (fetch PARENTSTREAM of VIEWPORT))
BOTTOMMARGINSIZE LEFTMARGINSIZE RIGHTMARGINSIZE TOPMARGINSIZE)
(SETQ BOTTOMMARGINSIZE (COMPUTEBOTTOMMARGIN PARENTSTREAM (fetch BOTTOMMARGIN
of PLOT)
PLOT))
(SETQ LEFTMARGINSIZE (COMPUTELEFTMARGIN PARENTSTREAM (fetch LEFTMARGIN
of PLOT)
PLOT))
(SETQ RIGHTMARGINSIZE (COMPUTERIGHTMARGIN PARENTSTREAM (fetch RIGHTMARGIN
of PLOT)
PLOT))
(SETQ TOPMARGINSIZE (COMPUTETOPMARGIN PARENTSTREAM (fetch TOPMARGIN of PLOT)
PLOT))
[replace WORLDREGION of VIEWPORT with (CREATEREGION (fetch MIN
of (fetch XINTERVAL
of PLOTSCALE))
(fetch MIN
of (fetch YINTERVAL
of PLOTSCALE))
(fetch INTERVALLENGTH
of (fetch XINTERVAL
of PLOTSCALE))
(fetch INTERVALLENGTH
of (fetch YINTERVAL
of PLOTSCALE]
[replace STREAMSUBREGION of VIEWPORT with (CREATEREGION
(PLUS (fetch LEFT of STREAMREGION)
(CAR LEFTMARGINSIZE))
(PLUS (fetch BOTTOM of
STREAMREGION)
(CDR BOTTOMMARGINSIZE))
(IDIFFERENCE (fetch WIDTH
of STREAMREGION)
(IPLUS (CAR
LEFTMARGINSIZE)
(CAR
RIGHTMARGINSIZE)))
(IDIFFERENCE (fetch HEIGHT
of STREAMREGION)
(IPLUS (CDR
BOTTOMMARGINSIZE)
(CDR
TOPMARGINSIZE]
(COMPUTETRANSFORM VIEWPORT)
(RETURN VIEWPORT])
(APPLY.AFTERFN.MACRO
[LAMBDA (ARGS) (* jop: "20-Feb-86 16:21")
(PROG ((FNS (CAR ARGS))
(ARGLST (CDR ARGS)))
(RETURN (BQUOTE (if , FNS
then (if (AND (LISTP , FNS)
(NEQ (CAR , FNS)
(QUOTE LAMBDA)))
then (for FN in , FNS
do , (BQUOTE (APPLY* FN ,@ ARGLST)))
else , (BQUOTE (APPLY* , FNS ,@ ARGLST])
(ASKFORLABEL
[LAMBDA (PLOT MARGINNAME) (* jop: "10-Dec-85 20:51")
(* * Prompt for new label and make the required call to LABELPLOT)
(if (EQ MARGINNAME (QUOTE TITLE))
then (SETQ MARGINNAME (QUOTE TOP)))
(PROG ((PLOTPROMPT (fetch PLOTPROMPTWINDOW of PLOT))
(MARGIN (SELECTQ MARGINNAME
(BOTTOM (fetch BOTTOMMARGIN of PLOT))
(LEFT (fetch LEFTMARGIN of PLOT))
(TOP (fetch TOPMARGIN of PLOT))
(RIGHT (fetch RIGHTMARGIN of PLOT))
(HELP "ILLEGAL MARGIN NAME" MARGINNAME)))
(PROMPT (SELECTQ MARGINNAME
(BOTTOM "BOTTOM MARGIN LABEL?")
(LEFT "LEFT MARGIN LABEL?")
(TOP "TITLE?")
(RIGHT "RIGHT MARGIN LABEL?")
(HELP "ILLEGAL MARGIN NAME" MARGINNAME)))
LABEL NEWLABEL)
(SETQ LABEL (fetch (MARGIN LABEL) of MARGIN))
(TERPRI PLOTPROMPT)
[SETQ NEWLABEL (PROMPTFORWORD PROMPT LABEL "Type a label" PLOTPROMPT NIL NIL
(CHARCODE (EOL LF ESCAPE TAB]
(if (AND (NEQ NEWLABEL LABEL)
(NOT (STREQUAL NEWLABEL LABEL)))
then (PLOTLABEL PLOT MARGINNAME NEWLABEL])
(ASKFORSCALE
[LAMBDA (PLOT AXIS) (* jop: "19-Jan-86 17:55")
(* *)
(PROG ((PLOTPROMPT (fetch PLOTPROMPTWINDOW of PLOT))
(LOWER (PLOT.WORLDTOLABEL (SELECTQ AXIS
(X (fetch (PLOT XLOWER) of PLOT))
(Y (fetch (PLOT YLOWER) of PLOT))
(HELP "Illegal axis" AXIS))
PLOT AXIS))
(UPPER (PLOT.WORLDTOLABEL (SELECTQ AXIS
(X (fetch (PLOT XUPPER) of PLOT))
(Y (fetch (PLOT YUPPER) of PLOT))
(HELP "Illegal axis" AXIS))
PLOT AXIS)))
(TERPRI PLOTPROMPT)
(SETQ LOWER (PLOT.LABELTOWORLD [READ (OPENSTRINGSTREAM
(PROMPTFORWORD (CONCAT AXIS
" axis: From ")
LOWER "Type a number"
PLOTPROMPT NIL NIL
(CHARCODE (EOL LF ESCAPE
TAB]
PLOT AXIS))
(SETQ UPPER (PLOT.LABELTOWORLD [READ (OPENSTRINGSTREAM
(PROMPTFORWORD " to " UPPER
"Type a number"
PLOTPROMPT NIL NIL
(CHARCODE (EOL LF ESCAPE
TAB]
PLOT AXIS))
(RETURN (CONS LOWER UPPER])
(BOXREGION
[LAMBDA (REGION STREAM) (* jop: "25-Aug-85 16:10")
(* * Draw a box around a region in STREAM)
(PROG ((RLEFT (fetch LEFT of REGION))
(RBOTTOM (fetch BOTTOM of REGION))
(RRIGHT (fetch RIGHT of REGION))
(RTOP (fetch TOP of REGION))
(LINEWIDTH (DSPSCALE NIL STREAM)))
(DRAWLINE RLEFT RBOTTOM RRIGHT RBOTTOM LINEWIDTH (QUOTE REPLACE)
STREAM)
(DRAWLINE RRIGHT RBOTTOM RRIGHT RTOP LINEWIDTH (QUOTE REPLACE)
STREAM)
(DRAWLINE RRIGHT RTOP RLEFT RTOP LINEWIDTH (QUOTE REPLACE)
STREAM)
(DRAWLINE RLEFT RTOP RLEFT RBOTTOM LINEWIDTH (QUOTE REPLACE)
STREAM])
(CHOOSESCALE
[LAMBDA (MIN MAX AXISINFO TICINFO PLOT) (* jop: "20-Feb-86 17:09")
(* *)
(PROG ((SCALEFN (fetch (AXISINFO SCALEFN) of AXISINFO))
NEWINTERVAL)
(SETQ NEWINTERVAL (if SCALEFN
then (APPLY* SCALEFN MIN MAX TICINFO PLOT)
else (DEFAULTSCALEFN MIN MAX TICINFO)))
(AND (NOT (type? AXISINTERVAL NEWINTERVAL))
(HELP "Not an AXISINTERVAL" NEWINTERVAL))
(RETURN NEWINTERVAL])
(CHOOSETICS
[LAMBDA (MIN MAX AXISINFO PLOT) (* jop: "20-Feb-86 16:52")
(* *)
(PROG ((TICFN (fetch (AXISINFO TICFN) of AXISINFO))
NEWTICINFO)
(SETQ NEWTICINFO (if TICFN
then (APPLY* TICFN MIN MAX PLOT)
else (DEFAULTTICFN MIN MAX)))
(AND (NOT (type? TICINFO NEWTICINFO))
(HELP "Not a TICINFO" NEWTICINFO))
(RETURN NEWTICINFO])
(CLOSEPLOTWINDOW
[LAMBDA (PLOT) (* jop: " 8-May-85 14:26")
(* * LETS the CLOSEFN do all the work)
(if (NOT (type? PLOT PLOT))
then (HELP "NOT A PLOT" PLOT))
(CLOSEW (fetch PLOTWINDOW of PLOT])
(CLOSESTPLOTOBJECT
[LAMBDA (PLOT STREAMPOSITION) (* edited: "27-Mar-86 21:25")
(for OBJECT in (fetch PLOTOBJECTS of PLOT) smallest (DISTANCETOPLOTOBJECT OBJECT
STREAMPOSITION
PLOT])
(COMPOUNDSUBTYPE
[LAMBDA (COMPOUNDOBJECT) (* edited: " 3-Sep-85 11:45")
(fetch COMPOUNDTYPE of (fetch OBJECTDATA of COMPOUNDOBJECT])
(COMPUTEBOTTOMMARGIN
[LAMBDA (STREAM BOTTOMMARGIN PLOT) (* jop: "10-Dec-85 21:45")
(* * Returns a size cons pair (width . height) in streamcoordinates)
(DECLARE (SPECVARS SMALLFONT LARGEFONT))
(PROG ((SMALLFONT (FONTCREATE SMALLPLOTFONT NIL NIL NIL STREAM))
(LARGEFONT (FONTCREATE LARGEPLOTFONT NIL NIL NIL STREAM))
(TICS? (fetch (MARGIN TICS?) of BOTTOMMARGIN))
(LABEL (fetch (MARGIN LABEL) of BOTTOMMARGIN))
(WIDTH 0)
SMALLASCENT LARGEHEIGHT HEIGHT)
(SETQ SMALLASCENT (FONTPROP SMALLFONT (QUOTE ASCENT)))
(SETQ LARGEHEIGHT (FONTPROP LARGEFONT (QUOTE HEIGHT)))
(* margin of at least one LARGEHEIGHT)
(SETQ HEIGHT (if (OR TICS? LABEL)
then LARGEHEIGHT
else (ITIMES 2 LARGEHEIGHT)))
[if TICS?
then (SETQ HEIGHT (IPLUS HEIGHT (ITIMES 3 SMALLASCENT]
(if LABEL
then (SETQ HEIGHT (IPLUS HEIGHT (ITIMES 2 LARGEHEIGHT)))
(SETQ WIDTH (STRINGWIDTH LABEL LARGEFONT)))
(RETURN (CONS WIDTH HEIGHT])
(COMPUTELEFTMARGIN
[LAMBDA (STREAM LEFTMARGIN PLOT) (* jop: "15-Dec-85 18:35")
(* * Returns a (width . height) pair)
(DECLARE (SPECVARS PRXFLG SMALLPLOTFONT LARGEPLOTFONT))
(PROG ((SMALLFONT (FONTCREATE SMALLPLOTFONT NIL NIL NIL STREAM))
(LARGEFONT (FONTCREATE LARGEPLOTFONT NIL NIL NIL STREAM))
(TICS? (fetch (MARGIN TICS?) of LEFTMARGIN))
(TICLIST (GETTICLIST (QUOTE LEFT)
PLOT))
(LABEL (fetch (MARGIN LABEL) of LEFTMARGIN))
(HEIGHT 0)
LARGEWIDTH SMALLWIDTH WIDTH)
(SETQ SMALLWIDTH (STRINGWIDTH (QUOTE A)
SMALLFONT))
(SETQ LARGEWIDTH (STRINGWIDTH (QUOTE A)
LARGEFONT))
(SETQ WIDTH (if (OR TICS? LABEL)
then LARGEWIDTH
else (ITIMES 2 LARGEWIDTH)))
[if TICS?
then (SETQ WIDTH
(IPLUS WIDTH (ITIMES 2 SMALLWIDTH)
(RESETLST [RESETSAVE (FLTFMT (QUOTE (FLOAT NIL NIL NIL
NIL 5]
(RESETSAVE PRXFLG T)
(bind (MAX ← 0)
TICWIDTH for TICPAIR in TICLIST
do (SETQ TICWIDTH (STRINGWIDTH
(if (LISTP TICPAIR)
then (CDR TICPAIR)
else TICPAIR)
SMALLFONT))
(if (GREATERP TICWIDTH MAX)
then (SETQ MAX TICWIDTH))
finally (RETURN MAX]
[if LABEL
then (SETQ WIDTH (IPLUS WIDTH (ITIMES 2 LARGEWIDTH)))
(SETQ HEIGHT (ITIMES (NCHARS LABEL)
(FONTPROP LARGEFONT (QUOTE HEIGHT]
(RETURN (CONS WIDTH HEIGHT])
(COMPUTERIGHTMARGIN
[LAMBDA (STREAM RIGHTMARGIN PLOT) (* jop: "10-Dec-85 21:46")
(* * Returns a (width . height) pair)
(DECLARE (SPECVARS PRXFLG SMALLFONT LARGEFONT))
(PROG ((SMALLFONT (FONTCREATE SMALLPLOTFONT NIL NIL NIL STREAM))
(LARGEFONT (FONTCREATE LARGEPLOTFONT NIL NIL NIL STREAM))
(TICS? (fetch (MARGIN TICS?) of RIGHTMARGIN))
(TICLIST (GETTICLIST (QUOTE RIGHT)
PLOT))
(LABEL (fetch (MARGIN LABEL) of RIGHTMARGIN))
(HEIGHT 0)
SMALLWIDTH LARGEWIDTH WIDTH)
(SETQ SMALLWIDTH (STRINGWIDTH (QUOTE A)
SMALLFONT))
(SETQ LARGEWIDTH (STRINGWIDTH (QUOTE A)
LARGEFONT))
(SETQ WIDTH (if (OR TICS? LABEL)
then LARGEWIDTH
else (ITIMES 2 LARGEWIDTH)))
[if TICS?
then (SETQ WIDTH
(IPLUS WIDTH (ITIMES 2 SMALLWIDTH)
(RESETLST [RESETSAVE (FLTFMT (QUOTE (FLOAT NIL NIL NIL
NIL 5]
(RESETSAVE PRXFLG T)
(bind (MAX ← 0)
TICWIDTH for TICPAIR in TICLIST
do (SETQ TICWIDTH (STRINGWIDTH
(if (LISTP TICPAIR)
then (CDR TICPAIR)
else TICPAIR)
SMALLFONT))
(if (GREATERP TICWIDTH MAX)
then (SETQ MAX TICWIDTH))
finally (RETURN MAX]
[if LABEL
then (SETQ WIDTH (IPLUS WIDTH (ITIMES 2 LARGEWIDTH)))
(SETQ HEIGHT (ITIMES (NCHARS LABEL)
(FONTPROP LARGEFONT (QUOTE HEIGHT]
(RETURN (CONS WIDTH HEIGHT])
(COMPUTETOPMARGIN
[LAMBDA (STREAM TOPMARGIN PLOT) (* jop: "10-Dec-85 21:46")
(* *)
(DECLARE (SPECVARS SMALLFONT LARGEFONT))
(PROG ((SMALLFONT (FONTCREATE SMALLPLOTFONT NIL NIL NIL STREAM))
(LARGEFONT (FONTCREATE LARGEPLOTFONT NIL NIL NIL STREAM))
(TICS? (fetch (MARGIN TICS?) of TOPMARGIN))
(LABEL (fetch (MARGIN LABEL) of TOPMARGIN))
(WIDTH 0)
SMALLASCENT LARGEHEIGHT HEIGHT)
(SETQ SMALLASCENT (FONTPROP SMALLFONT (QUOTE ASCENT)))
(SETQ LARGEHEIGHT (FONTPROP LARGEFONT (QUOTE HEIGHT)))
(* margin of at least one LARGEHEIGHT)
(SETQ HEIGHT (if (OR TICS? LABEL)
then LARGEHEIGHT
else (ITIMES 2 LARGEHEIGHT)))
[if TICS?
then (SETQ HEIGHT (IPLUS HEIGHT (ITIMES 3 SMALLASCENT]
[if LABEL
then (SETQ HEIGHT (IPLUS HEIGHT (ITIMES 2 LARGEHEIGHT)))
(SETQ WIDTH (IMAX WIDTH (STRINGWIDTH LABEL LARGEFONT]
(RETURN (CONS WIDTH HEIGHT])
(COPYMENU
[LAMBDA (MENU NEWITEMS) (* jop: "11-Dec-85 17:13")
(* * Note that menu props are not copied)
(create MENU
ITEMS ←(OR NEWITEMS (fetch ITEMS of MENU))
WHENSELECTEDFN ←(fetch WHENSELECTEDFN of MENU)
WHENHELDFN ←(fetch WHENHELDFN of MENU)
WHENUNHELDFN ←(fetch WHENUNHELDFN of MENU)
MENUPOSITION ←(fetch MENUPOSITION of MENU)
MENUOFFSET ←(fetch MENUOFFSET of MENU)
MENUFONT ←(fetch MENUFONT of MENU)
MENUTITLEFONT ←(fetch MENUTITLEFONT of MENU)
TITLE ←(fetch TITLE of MENU)
CENTERFLG ←(fetch CENTERFLG of MENU)
MENUBORDERSIZE ←(fetch MENUBORDERSIZE of MENU)
MENUOUTLINESIZE ←(fetch MENUOUTLINESIZE of MENU)
CHANGEOFFSETFLG ←(fetch CHANGEOFFSETFLG of MENU])
(CREATEPLOT
[LAMBDA (OPENFLG REGION TITLE BORDER) (* edited: "27-Mar-86 21:35")
(* * Creates a PLOT. If OPENFLG is T then the PLOT's asssociated window is opened. The other arguments are passed
to CREATEW)
(PROG [(PLOT (create PLOT))
[MIDDLEMENUITEMS (QUOTE ((Label TOGGELLABEL "Toggle label on/off"
(SUBITEMS (Relabel RELABELSELECTEDPLOTOBJECT
"Change label")))
(Delete DELETEPLOTOBJECT "Delete object"]
(RIGHTMENUITEMS (QUOTE ((Layout PLOT.SKETCH.CREATE "Create a sketch of the PLOT")
(Redraw REDRAWPLOTWINDOW "Redraw plot")
[Rescale RESCALEPLOT "Rescale plot axes"
(SUBITEMS (X% Axis
(RESCALEPLOT (QUOTE X))
"Rescale X axis"
(SUBITEMS (Automatic
(RESCALEPLOT (QUOTE
X))
"Rescale automatically")
(Manual (MANUALRESCALE
(QUOTE X))
"Rescale manually")))
(Y% Axis
(RESCALEPLOT (QUOTE Y))
"Rescale Y axis"
(SUBITEMS (Automatic
(RESCALEPLOT (QUOTE
Y))
"Rescale automatically")
(Manual (MANUALRESCALE
(QUOTE Y))
"Rescale manually"]
(Extend TOGGLEEXTENDEDAXES "Extend plot axes on/off"
(SUBITEMS (X% Axis (TOGGLEEXTENDEDAXES
(QUOTE X))
"Extend X axis on/off")
(Y% Axis (TOGGLEEXTENDEDAXES
(QUOTE Y))
"Extend Y axis on/off")))
(Labels WHICHLABEL "Relabel plot"
(SUBITEMS (Title (ASKFORLABEL (QUOTE TOP))
"Title plot")
(Left (ASKFORLABEL (QUOTE LEFT))
"Label left of plot")
(Bottom (ASKFORLABEL (QUOTE BOTTOM))
"Label bottom of plot")
(Right (ASKFORLABEL (QUOTE RIGHT))
"Label right of plot")))
(Tics TOGGLETICS "Tics on or off"
(SUBITEMS (Top (TOGGLETICS (QUOTE TOP))
"Top tics on/off")
(Left (TOGGLETICS (QUOTE LEFT))
"Left tics on/off")
(Bottom (TOGGLETICS (QUOTE BOTTOM))
"Bottom tics on/off")
(Right (TOGGLETICS (QUOTE RIGHT))
"Right tics on/off")))
(Undelete UNDELETEPLOTOBJECT "Undelete last deleted object"
(SUBITEMS (Top (UNDELETEPLOTOBJECT (QUOTE
TOP))
"Undelete last deleted object")
(Select (UNDELETEPLOTOBJECT
(QUOTE SELECT))
"Select object to undelete")
(Above (UNDELETEPLOTOBJECT
(QUOTE ABOVE))
"Undelete all objects above selected object")
(All (UNDELETEPLOTOBJECT (QUOTE
ALL))
"Undelete all deleted objects")))
(Fixed% Menu TOGGLEFIXEDMENU "Fix Plot menu"]
(replace (PLOT PLOTSCALE) of PLOT
with (create PLOTSCALE
XAXISINFO ←(create AXISINFO)
XINTERVAL ←(create AXISINTERVAL
MIN ← 0.0
MAX ← 1.0)
XTICINFO ←(create TICINFO
TICMIN ← 0.0
TICMAX ← 1.0
TICINC ← 1.0
NTICS ← 2)
YAXISINFO ←(create AXISINFO)
YINTERVAL ←(create AXISINTERVAL
MIN ← 0.0
MAX ← 1.0)
YTICINFO ←(create TICINFO
TICMIN ← 0.0
TICMAX ← 1.0
TICINC ← 1.0
NTICS ← 2)))
(PLOTMENUITEMS PLOT (QUOTE MIDDLE)
(COPY MIDDLEMENUITEMS))
(PLOTMENUITEMS PLOT (QUOTE RIGHT)
(COPY RIGHTMENUITEMS)) (* Compute size of margins in stream coordinates)
(replace (PLOT BOTTOMMARGIN) of PLOT with (create MARGIN
TICMETHOD ←(QUOTE DEFAULT)))
(replace (PLOT LEFTMARGIN) of PLOT with (create MARGIN
TICMETHOD ←(QUOTE DEFAULT)))
(replace (PLOT TOPMARGIN) of PLOT with (create MARGIN
TICMETHOD ←(QUOTE DEFAULT)))
(replace (PLOT RIGHTMARGIN) of PLOT with (create MARGIN
TICMETHOD ←(QUOTE DEFAULT)))
(* Cache display parameters until OPENPLOTWINDOW is
called)
(if (OR REGION TITLE BORDER)
then (replace (PLOT PLOTWINDOW) of PLOT with (LIST REGION TITLE BORDER)))
(if OPENFLG
then (OPENPLOTWINDOW PLOT))
(RETURN PLOT])
(CREATEPLOTBITMAPOBJ
[LAMBDA (PLOT) (* jop: "25-Feb-86 15:31")
(* *)
(LET* [(WINDOW (fetch (PLOT PLOTWINDOW) of PLOT))
(BITMAP (BITMAPCREATE (WINDOWPROP WINDOW (QUOTE WIDTH))
(WINDOWPROP WINDOW (QUOTE HEIGHT]
(BITBLT WINDOW NIL NIL BITMAP)
(BITMAPTEDITOBJ BITMAP 1 0])
(CREATEPLOTFNS
[LAMBDA (DRAWFN ERASEFN EXTENTFN DISTANCEFN HIGHLIGHTFN LOWLIGHTFN LABELFN MOVEFN COPYFN PUTFN
GETFN BORROWFROM) (* jop: "26-Aug-85 21:04")
(* * Create an instance of PLOTFNS, a vector of functions that implement generic plot object operations.
A DRAWFN , ERASEFN , and a EXTENTFN are required. If there is a DISTANCEFN then a HIGHLIGHTFN must also be supplied.
Supplies defaults for some generic operations. If BORROWFROM then it must be another PLOTFNS, in which case NIL
functions are inherited from USING.)
(DECLARE (SPECVARS DRAWFN ERASEFN EXTENTFN DISTANCEFN HIGHLIGHTFN LOWLIGHTFN LABELFN MOVEFN
COPYFN PUTFN GETFN))
[if BORROWFROM
then (if (AND (NULL LOWLIGHTFN)
(NULL HIGHLIGHTFN))
then (SETQ LOWLIGHTFN (fetch LOWLIGHTFN of BORROWFROM)))
(for FN in (QUOTE (DRAWFN ERASEFN EXTENTFN HIGHLIGHTFN LABELFN DISTANCEFN MOVEFN COPYFN
PUTFN GETFN))
do (if (NULL (EVAL FN))
then (SET FN (RECORDACCESS FN BORROWFROM]
(if (NOT (AND DRAWFN ERASEFN EXTENTFN))
then (HELP "Attempt to create PLOTFNS without required FNS"))
(if (AND DISTANCEFN (NOT HIGHLIGHTFN))
then (HELP "DISTANCEFN without a HIGHLIGHTFN"))
(create PLOTFNS
DRAWFN ← DRAWFN
ERASEFN ← ERASEFN
HIGHLIGHTFN ←(OR HIGHLIGHTFN (FUNCTION PLOTOPERROR))
LOWLIGHTFN ←(OR LOWLIGHTFN HIGHLIGHTFN (FUNCTION PLOTOPERROR))
MOVEFN ←(OR MOVEFN (FUNCTION PLOTOPERROR))
LABELFN ←(OR LABELFN (FUNCTION LABELGENERIC))
EXTENTFN ← EXTENTFN
DISTANCEFN ←(OR DISTANCEFN (FUNCTION [LAMBDA NIL MAX.SMALLP]))
COPYFN ←(OR COPYFN (FUNCTION COPYGENERIC))
PUTFN ←(OR PUTFN (FUNCTION PUTGENERIC))
GETFN ←(OR GETFN (FUNCTION GETGENERIC])
(CREATEPLOTOBJECT
[LAMBDA (OBJECTFNS OBJECTSUBTYPE OBJECTLABEL OBJECTMENU OBJECTDATA)
(* jop: "20-Jan-86 16:02")
(if (NOT (AND OBJECTFNS OBJECTDATA))
then (HELP "Attempt to create a PLOTOBJECT without a FNS vector or OBJECTDATA"))
(PROG ((PLOTOBJECT (create PLOTOBJECT
OBJECTFNS ← OBJECTFNS
OBJECTSUBTYPE ← OBJECTSUBTYPE
OBJECTLABEL ← OBJECTLABEL
OBJECTDATA ← OBJECTDATA)))
(* PLOTOBJECTPROP coerces OBJECTMENU to a menu if it
is an item list)
(PLOTOBJECTPROP PLOTOBJECT (QUOTE OBJECTMENU)
OBJECTMENU)
(RETURN PLOTOBJECT])
(DEFAULTSCALEFN
[LAMBDA (MIN MAX TICINFO) (* jop: "20-Feb-86 17:09")
(* *)
(create AXISINTERVAL
MIN ←(fetch (TICINFO TICMIN) of TICINFO)
MAX ←(fetch (TICINFO TICMAX) of TICINFO])
(DEFAULTTICFN
[LAMBDA (MIN MAX TICS ROUND POWER) (* jop: "20-Jan-86 14:17")
(* * Computes an interval that includes (MIN,MAX) and can be exactly spanned by (NTICS-1) *some increment.
If TICS is NIL tries a few values and chooses the one that yields the shortest interval.)
(if (NULL TICS)
then (SETQ TICS (QUOTE (3 4 5 6 7 8)))
elseif (FIXP TICS)
then (SETQ TICS (LIST TICS))
elseif (NLISTP TICS)
then (HELP "Not a list of FIXP's" TICS))
(bind (SHORTEST ←(SCALE MIN MAX (CAR TICS)
ROUND POWER))
CURRENT for NTICS in (CDR TICS)
do (SETQ CURRENT (SCALE MIN MAX NTICS ROUND POWER))
(if (LESSP (fetch TICINTERVALLENGTH of CURRENT)
(fetch TICINTERVALLENGTH of SHORTEST))
then (SETQ SHORTEST CURRENT))
finally (RETURN SHORTEST])
(DEFAULTTICMETHOD
[LAMBDA (MARGIN PLOTSCALE PLOT) (* jop: "16-Dec-85 21:43")
(* * Return the default tic list based on the values of PLOTSCALE)
(PROG ((TICINFO (SELECTQ MARGIN
((BOTTOM TOP)
(fetch (PLOTSCALE XTICINFO) of PLOTSCALE))
((RIGHT LEFT)
(fetch (PLOTSCALE YTICINFO) of PLOTSCALE))
(HELP "MARGIN must be one of RIGHT, LEFT, TOP, BOTTOM" MARGIN)))
TICINC)
(SETQ TICINC (fetch (TICINFO TICINC) of TICINFO))
(RETURN (if (LISTP TICINC)
then TICINC
elseif (NUMBERP TICINC)
then (* Be carefull that min and max tics correspond to min
and max of interval)
(NCONC1 (for I from 1 to (SUB1 (fetch (TICINFO NTICS)
of TICINFO))
as X from (fetch (TICINFO TICMIN) of TICINFO)
by TICINC collect X)
(fetch (TICINFO TICMAX) of TICINFO))
else (HELP "Invalid TICINC" TICINC])
(DELETEPLOTOBJECT
[LAMBDA (OBJECT PLOT NODRAWFLG NOSAVEFLG) (* edited: "27-Mar-86 21:27")
(* * Delete object from display list of plot. If (NULL NODRAWFLG) then update the display (open it if necessary) if
(NULL NOSAVEFLG) then intern the object on the save list.)
(PROG [(PLOTOBJECTS (fetch (PLOT PLOTOBJECTS) of PLOT))
(PLOTWINDOW (fetch (PLOT PLOTWINDOW) of PLOT))
(WHENDELETEDFN (PLOTOBJECTPROP OBJECT (QUOTE WHENDELETEDFN]
(RETURN (if (MEMB OBJECT PLOTOBJECTS)
then (if (EQ OBJECT (fetch (PLOT SELECTEDOBJECT) of PLOT))
then (if (NULL NODRAWFLG)
then (if (OPENWP PLOTWINDOW)
then (LOWLIGHTPLOTOBJECT OBJECT PLOT)))
(replace (PLOT SELECTEDOBJECT) of PLOT with NIL))
(replace (PLOT PLOTOBJECTS) of PLOT with (DREMOVE OBJECT
PLOTOBJECTS))
(if (NULL NOSAVEFLG)
then (push (fetch (PLOT PLOTSAVELIST) of PLOT)
OBJECT))
(if (NULL NODRAWFLG)
then (if (NOT (OPENWP PLOTWINDOW))
then (OPENPLOTWINDOW PLOT)
else (ERASEPLOTOBJECT OBJECT PLOT)))
(APPLY.AFTERFN WHENDELETEDFN OBJECT PLOT NODRAWFLG NOSAVEFLG)
OBJECT])
(DESELECTPLOTOBJECT
[LAMBDA (PLOT) (* edited: "27-Mar-86 21:27")
(if (fetch SELECTEDOBJECT of PLOT)
then (LOWLIGHTPLOTOBJECT (fetch SELECTEDOBJECT of PLOT)
PLOT)
(replace SELECTEDOBJECT of PLOT with NIL])
(DISTANCETOPLOTOBJECT
[LAMBDA (OBJECT STREAMPOSITION PLOT) (* jop: "26-Apr-85 12:58")
(APPLY* (fetch DISTANCEFN of (fetch OBJECTFNS of OBJECT))
OBJECT STREAMPOSITION PLOT])
(DRAWBOTTOMMARGIN
[LAMBDA (BOTTOMMARGIN STREAM VIEWPORT STREAMREGION PLOT) (* jop: "10-Dec-85 21:38")
(* * DRAW the BOTTOM MARGIN)
(DECLARE (SPECVARS SMALLFONT LARGEFONT PRXFLG))
(PROG ((SMALLFONT (FONTCREATE SMALLPLOTFONT NIL NIL NIL STREAM))
(LARGEFONT (FONTCREATE LARGEPLOTFONT NIL NIL NIL STREAM))
(TICS? (fetch (MARGIN TICS?) of BOTTOMMARGIN))
(LABEL (fetch (MARGIN LABEL) of BOTTOMMARGIN))
(STREAMSUBREGION (fetch STREAMSUBREGION of VIEWPORT))
(XINTERVAL (fetch (PLOTSCALE XINTERVAL) of (fetch PLOTSCALE of PLOT)))
SMALLPLOTFONTASCENT LARGEFONTHEIGHT BOTTOM LEFT RIGHT TICLIST)
(SETQ SMALLPLOTFONTASCENT (FONTPROP SMALLFONT (QUOTE ASCENT)))
(SETQ LARGEFONTHEIGHT (FONTPROP LARGEFONT (QUOTE HEIGHT)))
(SETQ BOTTOM (fetch BOTTOM of STREAMSUBREGION))
(SETQ LEFT (fetch LEFT of STREAMSUBREGION))
(SETQ RIGHT (fetch RIGHT of STREAMSUBREGION))
[if TICS?
then (SETQ TICLIST (GETTICLIST (QUOTE BOTTOM)
PLOT))
(* * DRAW TICS and TIC labels if necessary)
(RESETLST (RESETSAVE (DSPFONT SMALLFONT STREAM)
(LIST (QUOTE DSPFONT)
(DSPFONT NIL STREAM)
STREAM))
[RESETSAVE (FLTFMT (QUOTE (FLOAT NIL NIL NIL NIL 5]
(* Only printout 5 significant figures)
(RESETSAVE PRXFLG T) (* So STRINGREGION will behave as expected)
(bind (MAX ←(fetch MAX of XINTERVAL))
(MIN ←(fetch MIN of XINTERVAL))
(TOPOFTIC ←(IPLUS SMALLPLOTFONTASCENT BOTTOM))
(BOTTOMOFTIC ←(IDIFFERENCE BOTTOM SMALLPLOTFONTASCENT))
XWINDOWLOC TICVALUE TICLABEL for TICPAIR in TICLIST
do (SETQ TICVALUE (if (LISTP TICPAIR)
then (CAR TICPAIR)
else TICPAIR))
(SETQ TICLABEL (if (LISTP TICPAIR)
then (CDR TICPAIR)
else TICPAIR))
(if (AND (GEQ TICVALUE MIN)
(LEQ TICVALUE MAX))
then (SETQ XWINDOWLOC (WORLDTOSTREAMX TICVALUE
VIEWPORT))
(* always draw the tic mark)
(MOVETO XWINDOWLOC TOPOFTIC STREAM)
(DRAWTO XWINDOWLOC BOTTOMOFTIC
(DSPSCALE NIL STREAM)
(QUOTE REPLACE)
STREAM)
(if TICLABEL
then (RELMOVETO 0
(IMINUS (ITIMES
2
SMALLPLOTFONTASCENT))
STREAM)
(RELMOVETO
(IMINUS (IQUOTIENT
(STRINGWIDTH
TICLABEL
SMALLFONT)
2))
0 STREAM)
(PRIN1 TICLABEL STREAM]
(if LABEL
then (RESETLST (RESETSAVE (DSPFONT LARGEFONT STREAM)
(LIST (QUOTE DSPFONT)
(DSPFONT NIL STREAM)
STREAM))
(* This assumes centering compute by
COMPUTEBOTTOMMARGIN)
(MOVETO (PLUS (fetch LEFT of STREAMREGION)
(IMAX 0 (IQUOTIENT (DIFFERENCE
(fetch WIDTH
of STREAMREGION)
(STRINGWIDTH LABEL
STREAM))
2)))
(PLUS (fetch BOTTOM of STREAMREGION)
(IPLUS (FONTPROP STREAM (QUOTE DESCENT))
LARGEFONTHEIGHT))
STREAM)
(PRIN1 LABEL STREAM])
(DRAWLEFTMARGIN
[LAMBDA (LEFTMARGIN STREAM VIEWPORT STREAMREGION PLOT) (* jop: "10-Dec-85 21:39")
(* * DRAW the BOTTOM MARGIN)
(DECLARE (SPECVARS SMALLFONT LARGEFONT PRXFLG))
(PROG ((SMALLFONT (FONTCREATE SMALLPLOTFONT NIL NIL NIL STREAM))
(LARGEFONT (FONTCREATE LARGEPLOTFONT NIL NIL NIL STREAM))
(TICS? (fetch (MARGIN TICS?) of LEFTMARGIN))
(LABEL (fetch (MARGIN LABEL) of LEFTMARGIN))
(STREAMSUBREGION (fetch STREAMSUBREGION of VIEWPORT))
(YINTERVAL (fetch (PLOTSCALE YINTERVAL) of (fetch PLOTSCALE of PLOT)))
SMALLWIDTH LARGEWIDTH BOTTOM LEFT TOP TICLIST)
(SETQ SMALLWIDTH (STRINGWIDTH (QUOTE A)
SMALLFONT))
(SETQ LARGEWIDTH (STRINGWIDTH (QUOTE A)
LARGEFONT))
(SETQ BOTTOM (fetch BOTTOM of STREAMSUBREGION))
(SETQ LEFT (fetch LEFT of STREAMSUBREGION))
(SETQ TOP (fetch TOP of STREAMSUBREGION))
[if TICS?
then (SETQ TICLIST (GETTICLIST (QUOTE LEFT)
PLOT))
(* * DRAW TICS and TIC labels if necessary)
(RESETLST (RESETSAVE (DSPFONT SMALLFONT STREAM)
(LIST (QUOTE DSPFONT)
(DSPFONT NIL STREAM)
STREAM))
[RESETSAVE (FLTFMT (QUOTE (FLOAT NIL NIL NIL NIL 5]
(RESETSAVE PRXFLG T)
(bind (MIN ←(fetch MIN of YINTERVAL))
(MAX ←(fetch MAX of YINTERVAL))
(RIGHTTIC ←(IPLUS SMALLWIDTH LEFT))
(LEFTTIC ←(IDIFFERENCE LEFT SMALLWIDTH))
YWINDOWLOC TICVALUE TICLABEL for TICPAIR in TICLIST
do (SETQ TICVALUE (if (LISTP TICPAIR)
then (CAR TICPAIR)
else TICPAIR))
(SETQ TICLABEL (if (LISTP TICPAIR)
then (CDR TICPAIR)
else TICPAIR))
(if (AND (GEQ TICVALUE MIN)
(LEQ TICVALUE MAX))
then (SETQ YWINDOWLOC (WORLDTOSTREAMY TICVALUE
VIEWPORT))
(MOVETO RIGHTTIC YWINDOWLOC STREAM)
(DRAWTO LEFTTIC YWINDOWLOC (DSPSCALE NIL
STREAM)
(QUOTE REPLACE)
STREAM)
(if TICLABEL
then (RELMOVETO
(IMINUS (IPLUS SMALLWIDTH
(STRINGWIDTH
TICLABEL
STREAM)))
0 STREAM)
(PRIN1 TICLABEL STREAM]
(if LABEL
then (RESETLST (RESETSAVE (DSPFONT LARGEFONT STREAM)
(LIST (QUOTE DSPFONT)
(DSPFONT NIL STREAM)
STREAM))
(MOVETO (PLUS (fetch LEFT of STREAMREGION)
LARGEWIDTH)
(DIFFERENCE (fetch TOP of STREAMREGION)
(IQUOTIENT
(DIFFERENCE
(fetch HEIGHT of STREAMREGION)
(ITIMES (FONTPROP STREAM
(QUOTE HEIGHT))
(NCHARS LABEL)))
2))
STREAM)
(bind (LEFTMARK ←(PLUS (fetch LEFT of STREAMREGION)
LARGEWIDTH))
(LF ←(DSPLINEFEED NIL STREAM)) for CHAR
in (UNPACK LABEL)
do (PRIN1 CHAR STREAM)
(MOVETO LEFTMARK (IPLUS (DSPYPOSITION NIL STREAM)
LF)
STREAM])
(DRAWMARGIN
[LAMBDA (MARGIN STREAM STREAMVIEWPORT STREAMREGION PLOT) (* jop: "12-Aug-85 16:18")
(* * Draws the margin MARGIN (one of RIGHT LEFT BOTTOM or TOP))
(SELECTQ MARGIN
(RIGHT (DRAWRIGHTMARGIN (fetch RIGHTMARGIN of PLOT)
STREAM STREAMVIEWPORT STREAMREGION PLOT))
(LEFT (DRAWLEFTMARGIN (fetch LEFTMARGIN of PLOT)
STREAM STREAMVIEWPORT STREAMREGION PLOT))
(BOTTOM (DRAWBOTTOMMARGIN (fetch BOTTOMMARGIN of PLOT)
STREAM STREAMVIEWPORT STREAMREGION PLOT))
(TOP (DRAWTOPMARGIN (fetch TOPMARGIN of PLOT)
STREAM STREAMVIEWPORT STREAMREGION PLOT))
(HELP "MARGIN must be one of RIGHT, LEFT, BOTTOM, or TOP " MARGIN])
(DRAWPLOTOBJECT
[LAMBDA (OBJECT VIEWPORT PLOT) (* jop: "20-Feb-86 16:24")
(PROG [(TEXTOBJECT (PLOTOBJECTPROP OBJECT (QUOTE LABEL)))
(WHENDRAWNFN (PLOTOBJECTPROP OBJECT (QUOTE WHENDRAWNFN]
(APPLY* (fetch DRAWFN of (fetch OBJECTFNS of OBJECT))
OBJECT VIEWPORT PLOT)
(if TEXTOBJECT
then (DRAWPLOTOBJECT TEXTOBJECT VIEWPORT PLOT))
(APPLY.AFTERFN WHENDRAWNFN OBJECT VIEWPORT PLOT])
(DRAWPLOT
[LAMBDA (PLOT CURRENTSTREAM STREAMVIEWPORT STREAMREGION) (* edited: "27-Mar-86 21:25")
(* * Draws a plot on CURRENTSTREAM. STREAMREGION is the region the PLOT will occupy. Does not blank the
STREAMREGION before drawing)
(if (NOT (type? PLOT PLOT))
then (HELP "Not a PLOT " PLOT)) (* Will not check, for the moment, that the
streamregion is large enough)
(BOXREGION (fetch STREAMSUBREGION of STREAMVIEWPORT)
CURRENTSTREAM)
(for MARGIN in (QUOTE (BOTTOM LEFT TOP RIGHT)) do (DRAWMARGIN MARGIN CURRENTSTREAM
STREAMVIEWPORT
STREAMREGION PLOT))
(for OBJECT in (fetch PLOTOBJECTS of PLOT) do (DRAWPLOTOBJECT OBJECT STREAMVIEWPORT
PLOT])
(DRAWRIGHTMARGIN
[LAMBDA (RIGHTMARGIN STREAM VIEWPORT STREAMREGION PLOT) (* jop: "10-Dec-85 21:41")
(* * DRAW the RIGHT MARGIN)
(DECLARE (SPECVARS SMALLFONT LARGEFONT PRXFLG))
(PROG ((SMALLFONT (FONTCREATE SMALLPLOTFONT NIL NIL NIL STREAM))
(LARGEFONT (FONTCREATE LARGEPLOTFONT NIL NIL NIL STREAM))
(TICS? (fetch (MARGIN TICS?) of RIGHTMARGIN))
(LABEL (fetch (MARGIN LABEL) of RIGHTMARGIN))
(STREAMSUBREGION (fetch STREAMSUBREGION of VIEWPORT))
(YINTERVAL (fetch (PLOTSCALE YINTERVAL) of (fetch PLOTSCALE of PLOT)))
SMALLWIDTH LARGEWIDTH BOTTOM TOP RIGHT TICLIST)
(SETQ SMALLWIDTH (STRINGWIDTH (QUOTE A)
SMALLFONT))
(SETQ LARGEWIDTH (STRINGWIDTH (QUOTE A)
LARGEFONT))
(SETQ BOTTOM (fetch BOTTOM of STREAMSUBREGION))
(SETQ RIGHT (fetch RIGHT of STREAMSUBREGION))
(SETQ TOP (fetch TOP of STREAMSUBREGION))
[if TICS?
then (SETQ TICLIST (GETTICLIST (QUOTE RIGHT)
PLOT))
(* * DRAW TICS and TIC labels if necessary)
(RESETLST (RESETSAVE (DSPFONT SMALLFONT STREAM)
(LIST (QUOTE DSPFONT)
(DSPFONT NIL STREAM)
STREAM))
[RESETSAVE (FLTFMT (QUOTE (FLOAT NIL NIL NIL NIL 5]
(RESETSAVE PRXFLG T)
(bind (MIN ←(fetch MIN of YINTERVAL))
(MAX ←(fetch MAX of YINTERVAL))
(RIGHTTIC ←(IPLUS SMALLWIDTH RIGHT))
(LEFTTIC ←(IDIFFERENCE RIGHT SMALLWIDTH))
YWINDOWLOC TICVALUE TICLABEL for TICPAIR in TICLIST
do (SETQ TICVALUE (if (LISTP TICPAIR)
then (CAR TICPAIR)
else TICPAIR))
(SETQ TICLABEL (if (LISTP TICPAIR)
then (CDR TICPAIR)
else TICPAIR))
(if (AND (GEQ TICVALUE MIN)
(LEQ TICVALUE MAX))
then (SETQ YWINDOWLOC (WORLDTOSTREAMY TICVALUE
VIEWPORT))
(MOVETO LEFTTIC YWINDOWLOC STREAM)
(DRAWTO RIGHTTIC YWINDOWLOC (DSPSCALE
NIL STREAM)
(QUOTE REPLACE)
STREAM)
(if TICLABEL
then (RELMOVETO SMALLWIDTH 0 STREAM)
(PRIN1 TICLABEL STREAM]
(if LABEL
then (RESETLST (RESETSAVE (DSPFONT LARGEFONT STREAM)
(LIST (QUOTE DSPFONT)
(DSPFONT NIL STREAM)
STREAM))
(MOVETO (DIFFERENCE (fetch RIGHT of STREAMREGION)
(ITIMES 2 LARGEWIDTH))
(DIFFERENCE (fetch TOP of STREAMREGION)
(IQUOTIENT
(DIFFERENCE
(fetch HEIGHT of STREAMREGION)
(ITIMES (FONTPROP STREAM
(QUOTE HEIGHT))
(NCHARS LABEL)))
2))
STREAM)
(bind (LEFTMARK ←(DIFFERENCE (fetch RIGHT of STREAMREGION)
(ITIMES 2 LARGEWIDTH)))
(LF ←(DSPLINEFEED NIL STREAM)) for CHAR
in (UNPACK LABEL)
do (PRIN1 CHAR STREAM)
(MOVETO LEFTMARK (IPLUS (DSPYPOSITION NIL STREAM)
LF)
STREAM])
(DRAWTOPMARGIN
[LAMBDA (TOPMARGIN STREAM VIEWPORT STREAMREGION PLOT) (* jop: "10-Dec-85 21:42")
(* * DRAW the Top MARGIN)
(DECLARE (SPECVARS SMALLFONT LARGEFONT PRXFLG))
(PROG ((SMALLFONT (FONTCREATE SMALLPLOTFONT NIL NIL NIL STREAM))
(LARGEFONT (FONTCREATE LARGEPLOTFONT NIL NIL NIL STREAM))
(TICS? (fetch (MARGIN TICS?) of TOPMARGIN))
(LABEL (fetch (MARGIN LABEL) of TOPMARGIN))
(STREAMSUBREGION (fetch STREAMSUBREGION of VIEWPORT))
(XINTERVAL (fetch (PLOTSCALE XINTERVAL) of (fetch PLOTSCALE of PLOT)))
SMALLFONTASCENT LARGEFONTHEIGHT TOP LEFT RIGHT TICLIST)
(SETQ SMALLFONTASCENT (FONTPROP SMALLFONT (QUOTE ASCENT)))
(SETQ LARGEFONTHEIGHT (FONTPROP LARGEFONT (QUOTE HEIGHT)))
(SETQ TOP (fetch TOP of STREAMSUBREGION))
(SETQ LEFT (fetch LEFT of STREAMSUBREGION))
(SETQ RIGHT (fetch RIGHT of STREAMSUBREGION))
[if TICS?
then (SETQ TICLIST (GETTICLIST (QUOTE TOP)
PLOT))
(* * DRAW TICS and TIC labels if necessary)
(RESETLST (RESETSAVE (DSPFONT SMALLFONT STREAM)
(LIST (QUOTE DSPFONT)
(DSPFONT NIL STREAM)
STREAM))
[RESETSAVE (FLTFMT (QUOTE (FLOAT NIL NIL NIL NIL 5]
(RESETSAVE PRXFLG T)
(bind (MIN ←(fetch MIN of XINTERVAL))
(MAX ←(fetch MAX of XINTERVAL))
(TOPOFTIC ←(IPLUS SMALLFONTASCENT TOP))
(BOTTOMOFTIC ←(IDIFFERENCE TOP SMALLFONTASCENT))
XWINDOWLOC TICVALUE TICLABEL for TICPAIR in TICLIST
do (SETQ TICVALUE (if (LISTP TICPAIR)
then (CAR TICPAIR)
else TICPAIR))
(SETQ TICLABEL (if (LISTP TICPAIR)
then (CDR TICPAIR)
else TICPAIR))
(if (AND (GEQ TICVALUE MIN)
(LEQ TICVALUE MAX))
then (SETQ XWINDOWLOC (WORLDTOSTREAMX TICVALUE
VIEWPORT))
(MOVETO XWINDOWLOC BOTTOMOFTIC STREAM)
(DRAWTO XWINDOWLOC TOPOFTIC (DSPSCALE
NIL STREAM)
(QUOTE REPLACE)
STREAM)
(if TICLABEL
then (RELMOVETO 0 SMALLFONTASCENT
STREAM)
(RELMOVETO
(IMINUS (IQUOTIENT
(STRINGWIDTH
TICLABEL
SMALLFONT)
2))
0 STREAM)
(PRIN1 TICLABEL STREAM]
(if LABEL
then (RESETLST (RESETSAVE (DSPFONT LARGEFONT STREAM)
(LIST (QUOTE DSPFONT)
(DSPFONT NIL STREAM)
STREAM))
(MOVETO (PLUS (fetch LEFT of STREAMREGION)
(IMAX 0 (IQUOTIENT (DIFFERENCE
(fetch WIDTH
of STREAMREGION)
(STRINGWIDTH LABEL
STREAM))
2)))
[IDIFFERENCE (fetch TOP of STREAMREGION)
(IPLUS LARGEFONTHEIGHT
(FONTPROP STREAM (QUOTE
ASCENT]
STREAM)
(PRIN1 LABEL STREAM])
(ERASEPLOTOBJECT
[LAMBDA (OBJECT PLOT) (* jop: "20-Feb-86 16:25")
(PROG [(TEXTOBJECT (PLOTOBJECTPROP OBJECT (QUOTE LABEL)))
(WHENERASEDFN (PLOTOBJECTPROP OBJECT (QUOTE WHENERASEDFN]
(APPLY* (fetch ERASEFN of (fetch OBJECTFNS of OBJECT))
OBJECT
(fetch PLOTWINDOWVIEWPORT of PLOT)
PLOT)
(if TEXTOBJECT
then (ERASEPLOTOBJECT TEXTOBJECT PLOT))
(APPLY.AFTERFN WHENERASEDFN OBJECT PLOT])
(EXTENDEDSCALEFN
[LAMBDA (MIN MAX TICINFO) (* jop: "20-Feb-86 17:11")
(* *)
(PROG ((NEWMIN (fetch (TICINFO TICMIN) of TICINFO))
(NEWMAX (fetch (TICINFO TICMAX) of TICINFO))
(EPISILON .05)
DELTA)
(SETQ DELTA (FTIMES EPISILON (FDIFFERENCE NEWMAX NEWMIN)))
(RETURN (create AXISINTERVAL
MIN ←(FDIFFERENCE NEWMIN DELTA)
MAX ←(FPLUS NEWMAX DELTA])
(EXTENTOFPLOTOBJECT
[LAMBDA (OBJECT PLOT) (* jop: " 3-Mar-85 16:33")
(APPLY* (fetch EXTENTFN of (fetch OBJECTFNS of OBJECT))
OBJECT PLOT])
(EXTENTOFPLOT
[LAMBDA (PLOT) (* edited: "27-Mar-86 21:26")
(bind EXTENT (MINX ← MAX.FLOAT)
(MAXX ← MIN.FLOAT)
(MINY ← MAX.FLOAT)
(MAXY ← MIN.FLOAT) for OBJECT in (fetch PLOTOBJECTS of PLOT)
do (SETQ EXTENT (EXTENTOFPLOTOBJECT OBJECT))
(if (LESSP (fetch MINX of EXTENT)
MINX)
then (SETQ MINX (fetch MINX of EXTENT)))
(if (GREATERP (fetch MAXX of EXTENT)
MAXX)
then (SETQ MAXX (fetch MAXX of EXTENT)))
(if (LESSP (fetch MINY of EXTENT)
MINY)
then (SETQ MINY (fetch MINY of EXTENT)))
(if (GREATERP (fetch MAXY of EXTENT)
MAXY)
then (SETQ MAXY (fetch MAXY of EXTENT)))
finally (RETURN (create EXTENT
MINX ← MINX
MAXX ← MAXX
MINY ← MINY
MAXY ← MAXY])
(GETPLOTWINDOW
[LAMBDA (PLOT) (* jop: " 8-Dec-85 15:46")
(* *)
(WINDOWP (fetch (PLOT PLOTWINDOW) of PLOT])
(GETTICLIST
[LAMBDA (MARGINNAME PLOT) (* jop: " 9-Dec-85 14:50")
(PROG ((MARGIN (SELECTQ MARGINNAME
(BOTTOM (fetch BOTTOMMARGIN of PLOT))
(LEFT (fetch LEFTMARGIN of PLOT))
(TOP (fetch TOPMARGIN of PLOT))
(RIGHT (fetch RIGHTMARGIN of PLOT))
(SHOULDNT)))
TICMETHOD)
(SETQ TICMETHOD (fetch TICMETHOD of MARGIN))
(RETURN (if (EQ TICMETHOD (QUOTE DEFAULT))
then (DEFAULTTICMETHOD MARGINNAME (fetch PLOTSCALE of PLOT)
PLOT)
elseif (LISTP TICMETHOD)
then TICMETHOD
elseif (LITATOM TICMETHOD)
then (APPLY* TICMETHOD MARGINNAME (fetch PLOTSCALE of PLOT)
PLOT)
else (HELP "Illegal ticmethod" TICMETHOD])
(HIGHLIGHTPLOTOBJECT
[LAMBDA (OBJECT PLOT) (* jop: "20-Feb-86 16:29")
(PROG [(TEXTOBJECT (PLOTOBJECTPROP OBJECT (QUOTE LABEL)))
(WHENHIGHLIGHTEDFN (PLOTOBJECTPROP OBJECT (QUOTE WHENHIGHLIGHTEDFN]
(APPLY* (fetch HIGHLIGHTFN of (fetch OBJECTFNS of OBJECT))
OBJECT
(fetch PLOTWINDOWVIEWPORT of PLOT)
PLOT)
(if TEXTOBJECT
then (HIGHLIGHTPLOTOBJECT TEXTOBJECT PLOT))
(APPLY.AFTERFN WHENHIGHLIGHTEDFN OBJECT PLOT])
(LABELPLOTOBJECT
[LAMBDA (OBJECT PLOT) (* jop: "20-Feb-86 16:33")
(PROG [(WHENLABELEDFN (PLOTOBJECTPROP OBJECT (QUOTE WHENLABELEDFN]
(APPLY* (fetch LABELFN of (fetch OBJECTFNS of OBJECT))
OBJECT PLOT)
(APPLY.AFTERFN WHENLABELEDFN OBJECT PLOT])
(LOWLIGHTPLOTOBJECT
[LAMBDA (OBJECT PLOT) (* jop: "20-Feb-86 16:30")
(PROG [(TEXTOBJECT (PLOTOBJECTPROP OBJECT (QUOTE LABEL)))
(WHENLOWLIGHTEDFN (PLOTOBJECTPROP OBJECT (QUOTE WHENLOWLIGHTEDFN]
(APPLY* (fetch LOWLIGHTFN of (fetch OBJECTFNS of OBJECT))
OBJECT
(fetch PLOTWINDOWVIEWPORT of PLOT)
PLOT)
(if TEXTOBJECT
then (LOWLIGHTPLOTOBJECT TEXTOBJECT PLOT))
(APPLY.AFTERFN WHENLOWLIGHTEDFN OBJECT PLOT])
(MANUALRESCALE
[LAMBDA (PLOT AXIS) (* jop: "20-Feb-86 17:36")
(* *)
(if (NULL AXIS)
then (SETQ AXIS (QUOTE BOTH)))
(PROG ((PLOTSCALE (fetch PLOTSCALE of PLOT))
(PLOTOBJECTS (fetch PLOTOBJECTS of PLOT))
NEWSCALE)
[if (OR (EQ AXIS (QUOTE BOTH))
(EQ AXIS (QUOTE X)))
then (SETQ NEWSCALE (ASKFORSCALE PLOT (QUOTE X)))
(if (GREATERP (CDR NEWSCALE)
(CAR NEWSCALE))
then (LET ((NEWMIN (CAR NEWSCALE))
(NEWMAX (CDR NEWSCALE))
(AXISINFO (fetch (PLOTSCALE XAXISINFO) of PLOTSCALE)))
(replace (PLOTSCALE XTICINFO) of PLOTSCALE
with (CHOOSETICS NEWMIN NEWMAX AXISINFO PLOT))
(replace (PLOTSCALE XINTERVAL) of PLOTSCALE
with (create AXISINTERVAL
MIN ← NEWMIN
MAX ← NEWMAX]
[if (OR (EQ AXIS (QUOTE BOTH))
(EQ AXIS (QUOTE Y)))
then (SETQ NEWSCALE (ASKFORSCALE PLOT (QUOTE Y)))
(if (GREATERP (CDR NEWSCALE)
(CAR NEWSCALE))
then (LET ((NEWMIN (CAR NEWSCALE))
(NEWMAX (CDR NEWSCALE))
(AXISINFO (fetch (PLOTSCALE YAXISINFO) of PLOTSCALE)))
(replace (PLOTSCALE YTICINFO) of PLOTSCALE
with (CHOOSETICS NEWMIN NEWMAX AXISINFO PLOT))
(replace (PLOTSCALE YINTERVAL) of PLOTSCALE
with (create AXISINTERVAL
MIN ← NEWMIN
MAX ← NEWMAX]
(REDRAWPLOTWINDOW PLOT])
(MINSTREAMREGIONSIZE
[LAMBDA (STREAM PLOT) (* jop: "12-Aug-85 14:19")
(* * Compute the minimun acceptable size for a plot STREAMREGION. In the case of PLOTWINDOWS, corresponds to the
min exceptable interior size of the WINDOW. Returns a dotted pair (MINX . MINY))
(* Sizes are (width . height) pairs)
(PROG ((BOTTOMMARGINSIZE (COMPUTEBOTTOMMARGIN STREAM (fetch BOTTOMMARGIN of PLOT)
PLOT))
(LEFTMARGINSIZE (COMPUTELEFTMARGIN STREAM (fetch LEFTMARGIN of PLOT)
PLOT))
(RIGHTMARGINSIZE (COMPUTERIGHTMARGIN STREAM (fetch RIGHTMARGIN of PLOT)
PLOT))
(TOPMARGINSIZE (COMPUTETOPMARGIN STREAM (fetch TOPMARGIN of PLOT)
PLOT))
MINX MINY) (* The constant 100 is heuristic)
(SETQ MINX (IPLUS (CAR LEFTMARGINSIZE)
(IMAX (CAR BOTTOMMARGINSIZE)
(CAR TOPMARGINSIZE)
100)
(CAR RIGHTMARGINSIZE)))
(SETQ MINY (IPLUS (CDR BOTTOMMARGINSIZE)
(IMAX (CDR LEFTMARGINSIZE)
(CDR RIGHTMARGINSIZE)
100)
(CDR TOPMARGINSIZE)))
(RETURN (CONS MINX MINY])
(MOVEPLOTOBJECT
[LAMBDA (OBJECT DX DY PLOT) (* jop: "12-Dec-85 11:37")
(APPLY* (fetch MOVEFN of (fetch OBJECTFNS of OBJECT))
OBJECT DX DY PLOT])
(OPENPLOTWINDOW
[LAMBDA (PLOT) (* jop: "20-Feb-86 16:27")
(* * Open window associated with PLOT. Creates circularities later broken by PLOT.CLOSEFN)
(if (NOT (type? PLOT PLOT))
then (HELP "Not a plot" PLOT))
(PROG ((WINDOW (fetch (PLOT PLOTWINDOW) of PLOT))
(PLOTPROMPTWINDOW (fetch PLOTPROMPTWINDOW of PLOT))
(WHENOPENEDFN (PLOTPROP PLOT (QUOTE WHENOPENEDFN)))
MINSIZE WINDOWRESHAPEFLG PROMPTCREATEDFLG MINWINDOWEXTENT)
(if (OPENWP WINDOW)
then (* No need to continue)
(RETURN WINDOW))
[if (NOT (WINDOWP WINDOW))
then (LET (REGION TITLE BORDER)
(if (LISTP WINDOW)
then (SETQ REGION (CAR WINDOW))
(SETQ TITLE (CADR WINDOW))
(SETQ BORDER (CADDR WINDOW)))
(SETQ WINDOW (CREATEW (OR REGION (CREATEREGION 0 0 100 100))
(OR TITLE "Plot Window")
BORDER T))
(replace (PLOT PLOTWINDOW) of PLOT with WINDOW)
(SETQ WINDOWRESHAPEFLG (NOT REGION]
(* * setup plot window props)
(WINDOWPROP WINDOW (QUOTE PLOT)
PLOT)
(WINDOWADDPROP WINDOW (QUOTE REPAINTFN)
(FUNCTION PLOT.REPAINTFN))
(WINDOWADDPROP WINDOW (QUOTE RESHAPEFN)
(FUNCTION PLOT.REPAINTFN))
(WINDOWADDPROP WINDOW (QUOTE CLOSEFN)
(FUNCTION PLOT.CLOSEFN))
(WINDOWPROP WINDOW (QUOTE BUTTONEVENTFN)
(FUNCTION PLOT.BUTTONEVENTFN))
(WINDOWPROP WINDOW (QUOTE RIGHTBUTTONFN)
(FUNCTION PLOT.BUTTONEVENTFN))
(WINDOWPROP WINDOW (QUOTE COPYBUTTONEVENTFN)
(FUNCTION PLOT.COPYBUTTONEVENTFN))
(WINDOWPROP WINDOW (QUOTE HARDCOPYFN)
(FUNCTION PLOT.HARDCOPYFN))
(WINDOWPROP WINDOW (QUOTE ICONFN)
(FUNCTION PLOT.ICONFN)) (* Rest of VIEWPORT initializations in
REDRAWPLOTWINDOW)
[replace PLOTWINDOWVIEWPORT of PLOT with (CREATEVIEWPORT (WINDOWPROP
WINDOW
(QUOTE DSP]
(* * Get a prompt window, if none exists)
(if (NULL PLOTPROMPTWINDOW)
then (SETQ PLOTPROMPTWINDOW (CREATEW [CREATEREGION
0 0 100
(HEIGHTIFWINDOW
(FONTPROP (DEFAULTFONT
(QUOTE DISPLAY))
(QUOTE HEIGHT]
NIL NIL T))
(WINDOWPROP PLOTPROMPTWINDOW (QUOTE PAGEFULLFN)
(FUNCTION NILL))
[WINDOWPROP PLOTPROMPTWINDOW (QUOTE MAXSIZE)
(CONS MAX.SMALLP (fetch HEIGHT of (WINDOWPROP
PLOTPROMPTWINDOW
(QUOTE REGION]
(DSPSCROLL (QUOTE ON)
PLOTPROMPTWINDOW)
(replace PLOTPROMPTWINDOW of PLOT with PLOTPROMPTWINDOW)
(SETQ PROMPTCREATEDFLG T)) (* Establish a min size for the window)
(SETQ MINSIZE (MINSTREAMREGIONSIZE (WINDOWPROP WINDOW (QUOTE DSP))
PLOT))
[WINDOWPROP WINDOW (if (NULL (ATTACHEDWINDOWS WINDOW))
then (QUOTE MINSIZE)
else (QUOTE MAINWINDOWMINSIZE))
(CONS (WIDTHIFWINDOW (CAR MINSIZE)
(WINDOWPROP WINDOW (QUOTE BORDER)))
(HEIGHTIFWINDOW (CDR MINSIZE)
(WINDOWPROP WINDOW (QUOTE TITLE))
(WINDOWPROP WINDOW (QUOTE BORDER]
(if [AND (NOT WINDOWRESHAPEFLG)
(OR (ILESSP (WINDOWPROP WINDOW (QUOTE WIDTH))
(CAR MINSIZE))
(ILESSP (WINDOWPROP WINDOW (QUOTE HEIGHT))
(CDR MINSIZE]
then (SETQ WINDOWRESHAPEFLG T)
(PROMPTPRINT "Window too small: reshape"))
(* Shaping window implies redrawing it)
(if WINDOWRESHAPEFLG
then (SHAPEW WINDOW)
else (OPENW WINDOW)
(REDRAWPLOTWINDOW PLOT)) (* Attach the promptwindow if necessary)
(if (NOT (EQ WINDOW (MAINWINDOW PLOTPROMPTWINDOW)))
then (ATTACHWINDOW PLOTPROMPTWINDOW WINDOW (QUOTE TOP)))
(* attach the fixed menu)
(if (PLOTPROP PLOT (QUOTE FIXEDRIGHTMENU?))
then (PLOT.FIXRIGHTMENU PLOT T)) (* A user hook)
(APPLY.AFTERFN WHENOPENEDFN PLOT)
(RETURN WINDOW])
(PLOT.BUTTONEVENTFN
[LAMBDA (PLOTWINDOW) (* edited: "27-Mar-86 21:27")
(DECLARE (SPECVARS PLOT))
(TOTOPW PLOTWINDOW)
(LET* ((PLOT (WINDOWPROP PLOTWINDOW (QUOTE PLOT)))
(SELECTEDOBJECT (fetch (PLOT SELECTEDOBJECT) of PLOT)))
(if (MOUSESTATE LEFT)
then [LET ((OLDX 0)
(OLDY 0)
(PLOTSUBREGION (fetch (VIEWPORT STREAMSUBREGION)
of (fetch (PLOT PLOTWINDOWVIEWPORT) of PLOT)))
NEWSELECTEDOBJECT NEWCURSOR)
(while (MOUSESTATE LEFT)
do [SETQ NEWCURSOR (CURSORPOSITION NIL PLOTWINDOW
(CONSTANT (create POSITION]
(if (INSIDEP PLOTSUBREGION NEWCURSOR)
then (if [NOT (AND (IEQP OLDX (fetch (POSITION
XCOORD)
of NEWCURSOR))
(IEQP OLDY (fetch (POSITION
YCOORD)
of NEWCURSOR]
then (SETQ NEWSELECTEDOBJECT (CLOSESTPLOTOBJECT
PLOT NEWCURSOR))
(if (AND NEWSELECTEDOBJECT
(NEQ NEWSELECTEDOBJECT
SELECTEDOBJECT))
then (if SELECTEDOBJECT
then (LOWLIGHTPLOTOBJECT
SELECTEDOBJECT PLOT))
(HIGHLIGHTPLOTOBJECT
NEWSELECTEDOBJECT
PLOT)
(replace (PLOT SELECTEDOBJECT)
of PLOT with
NEWSELECTEDOBJECT)
(SETQ SELECTEDOBJECT
NEWSELECTEDOBJECT)
(* Try to print a meaningfull message in the
PLOTPROMPTWINDOW)
(PLOTPROMPT (fetch
(PLOTOBJECT
OBJECTLABEL)
of
NEWSELECTEDOBJECT)
PLOT)))
else (if SELECTEDOBJECT
then (LOWLIGHTPLOTOBJECT SELECTEDOBJECT PLOT)
(SETQ SELECTEDOBJECT NIL)
(replace (PLOT SELECTEDOBJECT) of PLOT
with SELECTEDOBJECT)))
(SETQ OLDX (fetch (POSITION XCOORD) of NEWCURSOR))
(SETQ OLDY (fetch (POSITION YCOORD) of NEWCURSOR]
elseif (AND SELECTEDOBJECT (MOUSESTATE MIDDLE))
then (LET ((MIDDLEMENU (fetch (PLOT MIDDLEMENU) of PLOT))
(OBJECTMENU (fetch (PLOTOBJECT OBJECTMENU) of SELECTEDOBJECT))
MIDMENU)
(SETQ MIDMENU (if OBJECTMENU
then (if (LITATOM OBJECTMENU)
then (SETQ OBJECTMENU
(LISTGET (fetch (PLOT
OTHERMENUS)
of PLOT)
OBJECTMENU)))
OBJECTMENU
else MIDDLEMENU))
(AND MIDMENU (MENU MIDMENU)))
elseif (MOUSESTATE RIGHT)
then (LET [(RIGHTMENU (fetch (PLOT RIGHTMENU) of PLOT))
(FIXEDRIGHTMENU? (PLOTPROP PLOT (QUOTE FIXEDRIGHTMENU?]
(if [OR FIXEDRIGHTMENU? (IGREATERP (fetch (POSITION YCOORD)
of (CURSORPOSITION NIL
PLOTWINDOW))
(WINDOWPROP PLOTWINDOW
(QUOTE HEIGHT]
then (DOWINDOWCOM PLOTWINDOW)
else (AND RIGHTMENU (MENU RIGHTMENU])
(PLOT.CLOSEFN
[LAMBDA (W) (* jop: "27-Feb-86 15:35")
(* * Remove all plot structure from window and return it to a pristine state Remove circularities from all fields
of PLOT)
(LET* [(PLOT (WINDOWPROP W (QUOTE PLOT)))
(WHENCLOSEDFN (PLOTPROP PLOT (QUOTE WHENCLOSEDFN]
(* * Unfix the right menu)
(WINDOWPROP W (QUOTE FIXEDRIGHTMENU)
NIL)
(DETACHALLWINDOWS W)
(* * Cleanup Window Props)
(WINDOWPROP W (QUOTE PLOT)
NIL)
(WINDOWDELPROP W (QUOTE REPAINTFN)
(FUNCTION PLOT.REPAINTFN))
(WINDOWDELPROP W (QUOTE RESHAPEFN)
(FUNCTION PLOT.REPAINTFN))
(WINDOWDELPROP W (QUOTE CLOSEFN)
(FUNCTION PLOT.CLOSEFN))
(WINDOWPROP W (QUOTE BUTTONEVENTFN)
(FUNCTION TOTOPW))
(WINDOWPROP W (QUOTE RIGHTBUTTONFN)
NIL)
(WINDOWPROP W (QUOTE COPYBUTTONEVENTFN)
NIL)
(WINDOWPROP W (QUOTE HARDCOPYFN)
NIL)
(WINDOWPROP W (QUOTE ICONFN)
NIL)
(WINDOWPROP W (QUOTE FIXEDRIGHTMENU)
NIL)
(* * A user hook)
(APPLY.AFTERFN WHENCLOSEDFN PLOT])
(PLOT.FIXRIGHTMENU
[LAMBDA ARGS (* jop: "12-Dec-85 10:29")
(* *)
(if (ILESSP ARGS 1)
then (HELP "Must have at least one arg"))
(PROG ((PLOT (ARG ARGS 1))
(FIXEDFLG (if (IGREATERP ARGS 1)
then (ARG ARGS 2)))
OLDVALUE PLOTWINDOW)
(SETQ OLDVALUE (PLOTPROP PLOT (QUOTE FIXEDRIGHTMENU?)))
(SETQ PLOTWINDOW (fetch (PLOT PLOTWINDOW) of PLOT))
[if (IGREATERP ARGS 1)
then (if FIXEDFLG
then (PLOTPROP PLOT (QUOTE FIXEDRIGHTMENU?)
T)
(if (OPENWP PLOTWINDOW)
then (LET [(RIGHTMENUW (ATTACHMENU (fetch (PLOT RIGHTMENU)
of PLOT)
PLOTWINDOW
(QUOTE RIGHT)
(QUOTE TOP]
(WINDOWPROP PLOTWINDOW (QUOTE FIXEDRIGHTMENU)
RIGHTMENUW)
(WINDOWPROP RIGHTMENUW (QUOTE FIXEDRIGHTMENU?)
T)))
else (PLOTPROP PLOT (QUOTE FIXEDRIGHTMENU?)
NIL)
(if (OPENWP PLOTWINDOW)
then (LET [(RIGHTMENUW (WINDOWPROP PLOTWINDOW (QUOTE
FIXEDRIGHTMENU]
(if (WINDOWP RIGHTMENUW)
then (CLOSEW RIGHTMENUW)
(DETACHWINDOW RIGHTMENUW)
(WINDOWPROP PLOTWINDOW (QUOTE
FIXEDRIGHTMENU)
NIL]
(RETURN OLDVALUE])
(PLOT.HARDCOPYFN
[LAMBDA (PLOTWINDOW PRINTERSTREAM) (* jop: "10-Dec-85 21:07")
(* * modified to allow hardcopy of plots on PRESS printers -- no landscape drawing)
(* * modified to center plot on page)
(DECLARE (SPECVARS DEFAULTLANDPAGEREGION))
(PROG ((WINDOWREGION (DSPCLIPPINGREGION NIL PLOTWINDOW))
(PLOT (WINDOWPROP PLOTWINDOW (QUOTE PLOT)))
(VIEWPORT (CREATEVIEWPORT PRINTERSTREAM))
PRINTERCLIPREGION STREAMREGION LARGEFONT SMALLFONT K)
(if (AND (EQ (IMAGESTREAMTYPE PRINTERSTREAM)
(QUOTE INTERPRESS))
(GREATERP (fetch WIDTH of WINDOWREGION)
(fetch HEIGHT of WINDOWREGION)))
then (* Print in landscape mode)
(* Hack to coerce Printerstream into landscapemode)
(ROTATE.IP PRINTERSTREAM 90)
(CONCATT.IP PRINTERSTREAM)
(TRANSLATE.IP PRINTERSTREAM 0 -21590)
(CONCATT.IP PRINTERSTREAM)
(DSPCLIPPINGREGION DEFAULTLANDPAGEREGION PRINTERSTREAM)
(* End HACK))
(SETQ PRINTERCLIPREGION (DSPCLIPPINGREGION NIL PRINTERSTREAM))
(* maintain the PLOTWINDOW's aspect ratio)
(SETQ K (QUOTIENT (fetch HEIGHT of PRINTERCLIPREGION)
(fetch HEIGHT of WINDOWREGION)))
(* if it doesnt fit try the other possiblity)
[if (GREATERP (TIMES K (fetch WIDTH of WINDOWREGION))
(fetch WIDTH of PRINTERCLIPREGION))
then (SETQ K (QUOTIENT (fetch WIDTH of PRINTERCLIPREGION)
(fetch WIDTH of WINDOWREGION]
(SETQ STREAMREGION (LET [[SWIDTH (FIXR (TIMES K (fetch WIDTH of WINDOWREGION]
(SHEIGHT (FIXR (TIMES K (fetch HEIGHT of WINDOWREGION]
(* * center plot on page)
(CREATEREGION (FIXR (PLUS (fetch LEFT of
PRINTERCLIPREGION)
(FQUOTIENT
(DIFFERENCE (fetch WIDTH
of
PRINTERCLIPREGION)
SWIDTH)
2)))
(FIXR (PLUS (fetch BOTTOM of
PRINTERCLIPREGION)
(FQUOTIENT
(DIFFERENCE (fetch HEIGHT
of
PRINTERCLIPREGION)
SHEIGHT)
2)))
SWIDTH SHEIGHT)))
(ADJUSTVIEWPORT VIEWPORT STREAMREGION PLOT)
(DRAWPLOT PLOT PRINTERSTREAM VIEWPORT STREAMREGION])
(PLOT.ICONFN
[LAMBDA (PLOTWINDOW OLDICON) (* edited: "27-Mar-86 21:25")
(PROG ((PLOT (WINDOWPROP PLOTWINDOW (QUOTE PLOT)))
(TITLEFONT (WINDOWTITLEFONT))
ICONWWIDTH ICONWHEIGHT SUBREGION ICONW VIEWPORT)
(if (GREATERP (WINDOWPROP PLOTWINDOW (QUOTE WIDTH))
(WINDOWPROP PLOTWINDOW (QUOTE HEIGHT)))
then (SETQ ICONWWIDTH (WIDTHIFWINDOW 100))
[SETQ ICONWHEIGHT (HEIGHTIFWINDOW
(FIXR (TIMES 100 (FQUOTIENT (WINDOWPROP PLOTWINDOW (QUOTE HEIGHT)
)
(WINDOWPROP PLOTWINDOW (QUOTE WIDTH]
else [SETQ ICONWWIDTH (WIDTHIFWINDOW (FIXR (TIMES 100
(FQUOTIENT
(WINDOWPROP
PLOTWINDOW
(QUOTE WIDTH))
(WINDOWPROP
PLOTWINDOW
(QUOTE HEIGHT]
(SETQ ICONWHEIGHT (HEIGHTIFWINDOW 100)))
(if OLDICON
then (SHAPEW OLDICON (CREATEREGION (fetch LEFT of (WINDOWPROP
OLDICON
(QUOTE REGION)))
(fetch BOTTOM of (WINDOWPROP
OLDICON
(QUOTE REGION)))
ICONWWIDTH ICONWHEIGHT))
(SETQ ICONW OLDICON)
else (SETQ ICONW (CREATEW (GETBOXREGION ICONWWIDTH ICONWHEIGHT)))
(DSPFONT TITLEFONT ICONW))
(CLEARW ICONW)
[SETQ SUBREGION (CREATEREGION [FIXR (TIMES .1 (WINDOWPROP ICONW (QUOTE WIDTH]
[FIXR (TIMES .1 (WINDOWPROP ICONW (QUOTE HEIGHT]
[FIXR (TIMES .8 (WINDOWPROP ICONW (QUOTE WIDTH]
(FIXR (TIMES .8 (WINDOWPROP ICONW (QUOTE HEIGHT]
[SETQ VIEWPORT (CREATEVIEWPORT (WINDOWPROP ICONW (QUOTE DSP))
SUBREGION
(fetch WORLDREGION of (fetch PLOTWINDOWVIEWPORT
of PLOT]
(BOXREGION SUBREGION ICONW)
[LET ((OBJECTS (fetch PLOTOBJECTS of PLOT))
TOBJECTS)
(if (ILESSP (SETQ TOBJECTS (LENGTH OBJECTS))
50)
then (* few enough objects so that all of them may be
drawn)
(for OBJECT in OBJECTS do (DRAWPLOTOBJECT OBJECT VIEWPORT PLOT))
else (* Sample the display list)
(bind (SAMPLERATE ←(FIXR (FQUOTIENT TOBJECTS 50))) for OBJECT
in OBJECTS as I from 1 when (IEQP 0 (IMOD I SAMPLERATE))
do (DRAWPLOTOBJECT OBJECT VIEWPORT PLOT]
(CENTERPRINTINREGION (OR (PLOTLABEL PLOT (QUOTE TOP))
(if (NOT (STREQUAL (WINDOWPROP PLOTWINDOW
(QUOTE TITLE))
"Plot Window"))
then (WINDOWPROP PLOTWINDOW (QUOTE TITLE)))
"Plot Icon")
NIL ICONW)
(RETURN ICONW])
(PLOT.LABELTOWORLD
[LAMBDA (VALUE PLOT AXIS) (* jop: "19-Jan-86 17:55")
(* given label VALUE computes corresponding VALUE in
world coords)
(PROG [(FN (SELECTQ AXIS
(X (PLOTPROP PLOT (QUOTE XWORLDFN)))
(Y (PLOTPROP PLOT (QUOTE YWORLDFN)))
(HELP "Illegal axis" AXIS]
(RETURN (if FN
then (APPLY* FN VALUE PLOT AXIS)
else (* use identity transformation)
VALUE])
(PLOT.REPAINTFN
[LAMBDA (WINDOW) (* jop: "30-Jul-85 20:22")
(* * Redraws a PLOT WINDOW based on data stored on property list of WINDOW)
(REDRAWPLOTWINDOW (WINDOWPROP WINDOW (QUOTE PLOT])
(PLOT.RESET
[LAMBDA (PLOT XSCALE YSCALE FLUSHMARGINS FLUSHPROPS NODRAWFLG)
(* jop: " 8-Dec-85 15:00")
(* * Reset a PLOT for reuse. XSCALE must be an AXISINTERVAL, defaults to the current interval.
Similarly for YSCALE. Non-NIL FLUSHMARGINS means flush all labels, ticmethods, etc. Non-NIL FLUSHPROPS means flush
all PLOTPROPS and cached menus)
(if (NOT (type? PLOT PLOT))
then (HELP "NOT A PLOT" PLOT)) (* Flush display list)
(replace (PLOT PLOTOBJECTS) of PLOT with NIL)
(replace (PLOT SELECTEDOBJECT) of PLOT with NIL)
(replace (PLOT PLOTSAVELIST) of PLOT with NIL)
(if FLUSHMARGINS
then (for MARGIN in (QUOTE (BOTTOM LEFT TOP RIGHT))
do (PLOTLABEL PLOT MARGIN NIL T)
(PLOTTICS PLOT MARGIN NIL T)
(PLOTTICMETHOD PLOT MARGIN NIL T)))
(if XSCALE
then (PLOTAXISINTERVAL PLOT (QUOTE X)
XSCALE T))
(if YSCALE
then (PLOTAXISINTERVAL PLOT (QUOTE Y)
YSCALE T)) (* Flush PLOT PROPS)
(if FLUSHPROPS
then (replace (PLOT PLOTUSERDATA) of PLOT with NIL)
(replace (PLOT OTHERMENUS) of PLOT with NIL))
(if (NULL NODRAWFLG)
then (REDRAWPLOTWINDOW PLOT])
(PLOT.SETUP
[LAMBDA (OPSTABLE) (* jop: "26-Aug-85 21:04")
(* * Assume opstable is a list of lists, one list for each PLOT object. The CAR of each sublist is the the name of
the PLOT object, e.g. POINT. Then follows pairs of method-names and function-names, e.g. (ADDFN ADDPOINTOBJECT))
(bind ASSOCLST for OBJECTLST in OPSTABLE
do (SET (PACK* (CAR OBJECTLST)
(QUOTE FNS))
(APPLY (FUNCTION CREATEPLOTFNS)
(first (SETQ ASSOCLST (CDR OBJECTLST)) for FNNAME
in (QUOTE (DRAWFN ERASEFN EXTENTFN DISTANCEFN HIGHLIGHTFN LOWLIGHTFN LABELFN
MOVEFN COPYFN PUTFN GETFN))
collect (CADR (ASSOC FNNAME ASSOCLST])
(PLOT.SKETCH.CREATE
[LAMBDA (PLOT) (* jop: "12-Aug-85 14:52")
(* * Creates a SKETCH STREAM and dumps the contents of PLOT into it)
(if (NOT (type? PLOT PLOT))
then (HELP "Not a PLOT " PLOT))
(if (NOT (GETD (FUNCTION OPENSKETCHSTREAM)))
then (PLOTPROMPT "SKETCHSTREAM not loaded" PLOT)
else (PROG ([SKETCHSTREAM (OPENSKETCHSTREAM "LAYOUT OF PLOT"
(if (fetch PLOTWINDOW of PLOT)
then (LET [(PLOTREGION
(WINDOWPROP (fetch
PLOTWINDOW
of PLOT)
(QUOTE
REGION]
(LIST (QUOTE REGION)
(GETBOXREGION
(fetch WIDTH
of PLOTREGION)
(fetch HEIGHT
of PLOTREGION]
SKETCHVIEWPORT)
(SETQ SKETCHVIEWPORT (CREATEVIEWPORT SKETCHSTREAM))
(ADJUSTVIEWPORT SKETCHVIEWPORT (DSPCLIPPINGREGION NIL SKETCHSTREAM)
PLOT)
(DRAWPLOT PLOT SKETCHSTREAM SKETCHVIEWPORT (DSPCLIPPINGREGION NIL
SKETCHSTREAM])
(PLOT.WHENSELECTEDFN
[LAMBDA (ITEM MENU BUTTON) (* edited: "27-Mar-86 21:27")
(* * Apply the function given as the CADR of ITEM with the arguments PLOT (if RIGHT BUTTON) or SELECTEDOBJECT PLOT
(if MIDDLE). If the CADR is a LIST , consider the CAR as a function and the CDR as a list of additional arguments
to be passed. If Middle BUTTON, lowlight selected object)
(DECLARE (SPECVARS PLOT)) (* Hack to deal with fixed right menu)
[LET ((MW (WFROMMENU MENU)))
(if (WINDOWPROP MW (QUOTE FIXEDRIGHTMENU?))
then (SETQ PLOT (WINDOWPROP (MAINWINDOW MW)
(QUOTE PLOT]
(PROG ((SELECTEDOBJECT (fetch SELECTEDOBJECT of PLOT))
(SELECTEDFN (CADR ITEM))
EXTRAARGS ARGSTOPASS)
(if (LISTP SELECTEDFN)
then (SETQ EXTRAARGS (CDR SELECTEDFN))
(SETQ SELECTEDFN (CAR SELECTEDFN)))
(SETQ ARGSTOPASS (for ARG in EXTRAARGS collect (EVAL ARG)))
(if (EQ BUTTON (QUOTE MIDDLE))
then (replace SELECTEDOBJECT of PLOT with NIL)
(LOWLIGHTPLOTOBJECT SELECTEDOBJECT PLOT)
(APPLY SELECTEDFN (CONS SELECTEDOBJECT (CONS PLOT ARGSTOPASS)))
else (APPLY SELECTEDFN (CONS PLOT ARGSTOPASS])
(PLOT.WORLDTOLABEL
[LAMBDA (VALUE PLOT AXIS) (* jop: "19-Jan-86 17:54")
(* * given VALUE in world coords, computes corresponding label VALUE)
(PROG [(FN (SELECTQ AXIS
(X (PLOTPROP PLOT (QUOTE XLABELFN)))
(Y (PLOTPROP PLOT (QUOTE YLABELFN)))
(HELP "Illegal axis" AXIS]
(RETURN (if FN
then (APPLY* FN VALUE PLOT AXIS)
else (* use identity transformation)
VALUE])
(PLOTADDMENUITEMS
[LAMBDA (PLOT MENUNAME ITEMSTOADD) (* jop: "27-Aug-85 21:44")
(* * Add ITEMSTOADD to end of menu MENUNAME item list)
(PROG ((MENU (SELECTQ MENUNAME
(MIDDLE (fetch MIDDLEMENU of PLOT))
(RIGHT (fetch RIGHTMENU of PLOT))
(LISTGET (fetch OTHERMENUS of PLOT)
MENUNAME)))
(MENUITEMS (PLOTMENUITEMS PLOT MENUNAME)))
(if ITEMSTOADD
then (SETQ ITEMSTOADD (for ITEM in ITEMSTOADD
unless (for ELEMENT in MENUITEMS
thereis (EQUAL (CAR ELEMENT)
(CAR ITEM)))
collect ITEM))
(PLOTMENUITEMS PLOT MENUNAME (APPEND MENUITEMS ITEMSTOADD)))
(RETURN MENUITEMS])
(PLOTADDPROP
[LAMBDA (PLOT PROP ITEMTOADD FIRSTFLG) (* jop: " 5-Dec-85 16:44")
(* * As in WINDOWADDPROP.)
(PROG [(PROPVAL (MKLIST (PLOTPROP PLOT PROP]
[if (NOT (MEMB ITEMTOADD PROPVAL))
then (if FIRSTFLG
then (SETQ PROPVAL (CONS ITEMTOADD PROPVAL))
else (SETQ PROPVAL (APPEND PROPVAL (LIST ITEMTOADD]
(RETURN (PLOTPROP PLOT PROP PROPVAL])
(PLOTAXISINTERVAL
[LAMBDA (PLOT AXIS INTERVAL NODRAWFLG) (* jop: "10-Dec-85 14:26")
(* * If INTERVAL is NIL returns the current INTERVAL for AXIS of PLOT. If INTERVAL is non-NIL it must be an
INTERVAL, in which case the interval for axis AXIS of PLOT is set to INTERVAL)
(PROG ((PLOTSCALE (fetch PLOTSCALE of PLOT))
OLDVALUE)
(SETQ OLDVALUE (SELECTQ AXIS
(X (fetch (PLOTSCALE XINTERVAL) of PLOTSCALE))
(Y (fetch (PLOTSCALE YINTERVAL) of PLOTSCALE))
(SHOULDNT)))
(if (type? AXISINTERVAL INTERVAL)
then (SELECTQ AXIS
(X (replace (PLOTSCALE XINTERVAL) of PLOTSCALE with INTERVAL))
(Y (replace (PLOTSCALE YINTERVAL) of PLOTSCALE with INTERVAL))
(SHOULDNT))
(if (NULL NODRAWFLG)
then (REDRAWPLOTWINDOW PLOT)))
(RETURN OLDVALUE])
(PLOTDELMENUITEMS
[LAMBDA (PLOT MENUNAME ITEMSTODELETE) (* jop: "11-Dec-85 13:07")
(* * Delete ITEMSTODELETE from menu MENUNAME item list. RETURNS new item list if something deleted or else NIL.
ITEMSTODELETE may be a list of lists or of atoms, in which case the atoms are compared to secessive CARS of
MENUNAME's item list)
(SETQ ITEMSTODELETE (MKLIST ITEMSTODELETE))
(PROG ((MENU (SELECTQ MENUNAME
(MIDDLE (fetch MIDDLEMENU of PLOT))
(RIGHT (fetch RIGHTMENU of PLOT))
(LISTGET (fetch OTHERMENUS of PLOT)
MENUNAME)))
MENUITEMS SOMETHINGDELETED)
(SETQ MENUITEMS (AND MENU (fetch ITEMS of MENU)))
[bind TARGET for ITEMTODELETE in ITEMSTODELETE
do (if (LITATOM ITEMTODELETE)
then (if [SETQ TARGET (for ITEM in MENUITEMS
thereis (EQUAL ITEMTODELETE (CAR ITEM]
then (SETQ SOMETHINGDELETED T)
(SETQ MENUITEMS (REMOVE TARGET MENUITEMS)))
elseif [AND (LISTP ITEMTODELETE)
(SETQ TARGET (CAR (MEMBER ITEMTODELETE MENUITEMS]
then (SETQ SOMETHINGDELETED T)
(SETQ MENUITEMS (REMOVE TARGET MENUITEMS]
(RETURN (if SOMETHINGDELETED
then (PLOTMENUITEMS PLOT MENUNAME MENUITEMS)
MENUITEMS])
(PLOTDELPROP
[LAMBDA (PLOT PROP ITEMTODELETE) (* jop: " 5-Dec-85 16:43")
(* * As in WINDOWDELPROP)
(PROG ((PROPVAL (PLOTPROP PLOT PROP)))
(RETURN (if (EQ ITEMTODELETE PROPVAL)
then (PLOTPROP PLOT PROP NIL)
elseif (MEMB ITEMTODELETE PROPVAL)
then (PLOTPROP PLOT PROP (REMOVE ITEMTODELETE PROPVAL])
(PLOTLABEL
[LAMBDA ARGS (* jop: "10-Dec-85 17:07")
(* * IF NEWLABEL is not present then return current POSITION label of PLOT, else set the label to NEWLABEL and
return the old value. NODRAWFLG T suppresses redrawing. POSITIOn may be one of X , Y , TITLE)
(if (LESSP ARGS 2)
then (HELP "PLOTLABEL takes at least two args, plot and position"))
(PROG ((PLOT (ARG ARGS 1))
(POSITION (ARG ARGS 2))
(NEWLABEL (AND (GREATERP ARGS 2)
(ARG ARGS 3)))
(NODRAWFLG (AND (GREATERP ARGS 3)
(ARG ARGS 4)))
MARGIN OLDLABEL)
(SETQ MARGIN (SELECTQ POSITION
(BOTTOM (fetch BOTTOMMARGIN of PLOT))
(LEFT (fetch LEFTMARGIN of PLOT))
(TOP (fetch TOPMARGIN of PLOT))
(RIGHT (fetch RIGHTMARGIN of PLOT))
(HELP "Illegal margin" POSITION)))
(SETQ OLDLABEL (fetch (MARGIN LABEL) of MARGIN))
(if (GREATERP ARGS 2)
then (replace (MARGIN LABEL) of MARGIN with NEWLABEL)
(if (NULL NODRAWFLG)
then (REDRAWPLOTWINDOW PLOT)))
(RETURN OLDLABEL])
(PLOTMENU
[LAMBDA ARGS (* jop: "12-Dec-85 10:31")
(* * If no third argument then simply return items list for given menu (middle or right), else replace the cached
menu with the new list of items. If the NEWMENU's whenselectedfn is NIL it is replaced with PLOT.WHENSELECTEDFN)
(if (ILESSP ARGS 2)
then (HELP "Must have at least two args, PLOT and MENUNAME"))
(PROG ((PLOT (ARG ARGS 1))
(MENUNAME (ARG ARGS 2))
(NEWMENU (AND (IGREATERP ARGS 2)
(ARG ARGS 3)))
PLOTWINDOW OLDVALUE)
(SETQ PLOTWINDOW (fetch (PLOT PLOTWINDOW) of PLOT))
(SETQ OLDVALUE (SELECTQ MENUNAME
(MIDDLE (fetch MIDDLEMENU of PLOT))
(RIGHT (fetch RIGHTMENU of PLOT))
(LISTGET (fetch OTHERMENUS of PLOT)
MENUNAME)))
(if (NOT (OR (NULL NEWMENU)
(type? MENU NEWMENU)))
then (HELP "Not a menu" NEWMENU)
elseif (AND NEWMENU (NULL (fetch WHENSELECTEDFN of NEWMENU)))
then (replace (MENU WHENSELECTEDFN) of NEWMENU with (FUNCTION
PLOT.WHENSELECTEDFN)))
(if (IGREATERP ARGS 2)
then (SELECTQ MENUNAME
(MIDDLE (replace MIDDLEMENU of PLOT with NEWMENU))
(RIGHT (replace RIGHTMENU of PLOT with NEWMENU))
(if (NULL (fetch OTHERMENUS of PLOT))
then (replace OTHERMENUS of PLOT with (LIST MENUNAME
NEWMENU))
NEWMENU
else (LISTPUT (fetch OTHERMENUS of PLOT)
MENUNAME NEWMENU)))
(if (AND (OPENWP PLOTWINDOW)
(EQ MENUNAME (QUOTE RIGHT))
(PLOTPROP PLOT (QUOTE FIXEDRIGHTMENU?)))
then (* Update the fixed menu)
(PLOT.FIXRIGHTMENU PLOT NIL)
(PLOT.FIXRIGHTMENU PLOT T)))
(RETURN OLDVALUE])
(PLOTMENUITEMS
[LAMBDA ARGS (* jop: "11-Dec-85 14:39")
(* * If no third argument then simply return items list for given menu (middle or right), else replace the cached
menu with the new list of items)
(if (LESSP ARGS 2)
then (HELP "Must have at least two args, PLOT and MENUNAME"))
(PROG ((PLOT (ARG ARGS 1))
(MENUNAME (ARG ARGS 2))
(NEWITEMS (AND (GREATERP ARGS 2)
(ARG ARGS 3)))
MENU)
(if (AND (GREATERP ARGS 2)
(NOT (LISTP NEWITEMS)))
then (HELP "Not a list" NEWITEMS))
(SETQ MENU (SELECTQ MENUNAME
(MIDDLE (fetch MIDDLEMENU of PLOT))
(RIGHT (fetch RIGHTMENU of PLOT))
(LISTGET (fetch OTHERMENUS of PLOT)
MENUNAME)))
(if (GREATERP ARGS 2)
then [SETQ MENU (AND NEWITEMS (if MENU
then (COPYMENU MENU NEWITEMS)
else (create MENU
ITEMS ← NEWITEMS]
(PLOTMENU PLOT MENUNAME MENU))
(RETURN (if (LESSP ARGS 3)
then (if MENU
then (fetch ITEMS of MENU))
else NEWITEMS])
(PLOTOBJECTADDPROP
[LAMBDA (OBJECT PROP ITEMTOADD FIRSTFLG) (* jop: "20-Jan-86 16:03")
(* * As in WINDOWADDPROP.)
(PROG [(PROPVAL (MKLIST (PLOTOBJECTPROP OBJECT PROP]
[if (NOT (MEMB ITEMTOADD PROPVAL))
then (if FIRSTFLG
then (SETQ PROPVAL (CONS ITEMTOADD PROPVAL))
else (SETQ PROPVAL (APPEND PROPVAL (LIST ITEMTOADD]
(RETURN (PLOTOBJECTPROP OBJECT PROP PROPVAL])
(PLOTOBJECTDELPROP
[LAMBDA (OBJECT PROP ITEMTODELETE) (* jop: "20-Jan-86 16:03")
(* * As in WINDOWDELPROP)
(PROG ((PROPVAL (PLOTOBJECTPROP OBJECT PROP)))
(RETURN (if (EQ ITEMTODELETE PROPVAL)
then (PLOTOBJECTPROP OBJECT PROP NIL)
elseif (MEMB ITEMTODELETE PROPVAL)
then (PLOTOBJECTPROP OBJECT PROP (REMOVE ITEMTODELETE PROPVAL])
(PLOTOBJECTLABEL
[LAMBDA (OBJECT LABEL PLOT NODRAWFLG) (* edited: "27-Mar-86 21:29")
(* * IF LABEL is NIL then return current label of OBJECT, else set the label to LABEL and return the old value.
NODRAWFLG T suppresses drawing)
(if (NOT (type? PLOTOBJECT OBJECT))
then (HELP "NOT A PLOTOBJECT" OBJECT))
(PROG ((OLDLABEL (fetch (PLOTOBJECT OBJECTLABEL) of OBJECT)))
(if LABEL
then (if (AND (NULL NODRAWFLG)
(PLOTOBJECTPROP OBJECT (QUOTE LABEL))
PLOT)
then (UNLABELPLOTOBJECT OBJECT PLOT))
(replace (PLOTOBJECT OBJECTLABEL) of OBJECT with LABEL)
(if (AND PLOT (NULL NODRAWFLG))
then (LABELPLOTOBJECT OBJECT PLOT)))
(RETURN OLDLABEL])
(PLOTOBJECTPROP
[LAMBDA ARGS (* jop: "17-Jan-86 16:04")
(* * As in WINDOWPROP. Operates on field OBJECTUSERDATA of PLOTOBJECT. If PROP is (QUOTE MENU) then accesses the
object menu)
(if (LESSP ARGS 2)
then (HELP "OBJECTPROP takes at least two arguments, plotobject and prop"))
(PROG ((PLOTOBJECT (ARG ARGS 1))
(PROPNAME (ARG ARGS 2))
(NEWVALUE (AND (GREATERP ARGS 2)
(ARG ARGS 3)))
(FIELDNAMES (QUOTE (OBJECTMENU OBJECTLABEL OBJECTDATA)))
OLDVALUE OBJECTUSERDATA)
(SETQ OBJECTUSERDATA (fetch (PLOTOBJECT OBJECTUSERDATA) of PLOTOBJECT))
(SETQ OLDVALUE (if (MEMB PROPNAME FIELDNAMES)
then (SELECTQ PROPNAME
(OBJECTMENU (fetch (PLOTOBJECT OBJECTMENU)
of PLOTOBJECT))
(OBJECTLABEL (fetch (PLOTOBJECT OBJECTLABEL)
of PLOTOBJECT))
(OBJECTDATA (fetch (PLOTOBJECT OBJECTDATA)
of PLOTOBJECT))
(SHOULDNT))
else (LISTGET OBJECTUSERDATA PROPNAME)))
[if (GREATERP ARGS 2)
then
(if (MEMB PROPNAME FIELDNAMES)
then
(SELECTQ
PROPNAME
(OBJECTMENU
(replace OBJECTMENU of PLOTOBJECT
with (OR [if (LISTP NEWVALUE)
then
(if (type? MENU OLDVALUE)
then
(LET ((NEWMENU (COPYMENU OLDVALUE NEWVALUE)))
(if (NULL (fetch WHENSELECTEDFN
of NEWMENU))
then (replace WHENSELECTEDFN
of NEWMENU
with (FUNCTION
PLOT.WHENSELECTEDFN)))
NEWMENU)
else (create MENU
ITEMS ← NEWVALUE
WHENSELECTEDFN ←(FUNCTION
PLOT.WHENSELECTEDFN]
NEWVALUE)))
(OBJECTLABEL (replace (PLOTOBJECT OBJECTLABEL) of PLOTOBJECT
with NEWVALUE))
(OBJECTDATA (replace (PLOTOBJECT OBJECTDATA) of PLOTOBJECT with
NEWVALUE))
(SHOULDNT))
else (if (NULL OBJECTUSERDATA)
then (replace OBJECTUSERDATA of PLOTOBJECT
with (LIST PROPNAME NEWVALUE))
else (LISTPUT OBJECTUSERDATA PROPNAME NEWVALUE]
(RETURN OLDVALUE])
(PLOTOBJECTPROPMACRO
[LAMBDA (ARGS) (* jop: "17-Jan-86 16:05")
(* *)
(PROG [(BPLOTOBJECT (CAR ARGS))
(BPROPNAME (CADR ARGS))
(FIELDNAMES (QUOTE (OBJECTMENU OBJECTLABEL OBJECTDATA]
(RETURN (if (OR (NOT (EQLENGTH ARGS 2))
(NEQ (CAR BPROPNAME)
(QUOTE QUOTE))
(MEMB (CADR BPROPNAME)
FIELDNAMES))
then (QUOTE IGNOREMACRO)
else (BQUOTE (LISTGET (fetch (PLOTOBJECT OBJECTUSERDATA)
of , BPLOTOBJECT)
, BPROPNAME])
(PLOTOBJECTSUBTYPE
[LAMBDA (PLOTOBJECT) (* jop: "20-Jan-86 16:21")
(fetch (PLOTOBJECT OBJECTSUBTYPE) of PLOTOBJECT])
(PLOTOPERROR
[LAMBDA NIL (* edited: "19-May-85 13:48")
(HELP "ATTEMPT To APPLY a generic PLOT operation to a deficient PLOT OBJECT"])
(PLOTPROMPT
[LAMBDA (TEXT PLOT) (* jop: " 3-Mar-85 15:42")
(PROG ((PLOTPROMPTWINDOW (fetch PLOTPROMPTWINDOW of PLOT)))
(printout PLOTPROMPTWINDOW T TEXT])
(PLOTPROP
[LAMBDA ARGS (* jop: " 8-Dec-85 15:09")
(* * As in WINDOWPROP. See also PLOTPROPMACRO)
(if (LESSP ARGS 2)
then (HELP "PLOTPROP TAKES AT LEAST TWO ARGUMENTS, PLOT and PROPNAME"))
(PROG ((PLOT (ARG ARGS 1))
(PROPNAME (ARG ARGS 2))
(NEWVALUE (AND (GREATERP ARGS 2)
(ARG ARGS 3)))
(FIELDS (QUOTE (XLOWER XUPPER YLOWER YUPPER MIDDLEMENU RIGHTMENU OTHERMENUS LEFTMARGIN
RIGHTMARGIN TOPMARGIN BOTTOMMARGIN PLOTWINDOW
PLOTWINDOWVIEWPORT PLOTPROMPTWINDOW PLOTOBJECTS PLOTSCALE
SELECTEDOBJECT WINDOWINFO MARGININFO MENUINFO PLOTUSERDATA
PLOTSAVELIST)))
OLDVALUE USERDATA) (* FIELDS is given as an explicit LIST for efficiency
reasons -- RECORDFIELDNAMES, although more robust,
takes too long)
(SETQ USERDATA (fetch (PLOT PLOTUSERDATA) of PLOT))
(SETQ OLDVALUE (if (MEMB PROPNAME FIELDS)
then (RECORDACCESS PROPNAME PLOT)
else (LISTGET USERDATA PROPNAME)))
[if (GREATERP ARGS 2)
then (if (MEMB PROPNAME FIELDS)
then (RECORDACCESS PROPNAME PLOT NIL (QUOTE REPLACE)
NEWVALUE)
else (if (NULL USERDATA)
then (replace (PLOT PLOTUSERDATA) of PLOT
with (LIST PROPNAME NEWVALUE))
else (LISTPUT USERDATA PROPNAME NEWVALUE]
(RETURN OLDVALUE])
(PLOTPROPMACRO
[LAMBDA (ARGS) (* jop: "10-Dec-85 22:32")
(* *)
(PROG [(BPLOT (CAR ARGS))
(BPROPNAME (CADR ARGS))
(BVALUE (CADDR ARGS))
(FIELDNAMES (QUOTE (XLOWER XUPPER YLOWER YUPPER MIDDLEMENU RIGHTMENU OTHERMENUS
LEFTMARGIN RIGHTMARGIN TOPMARGIN BOTTOMMARGIN PLOTWINDOW
PLOTWINDOWVIEWPORT PLOTPROMPTWINDOW PLOTOBJECTS PLOTSCALE
SELECTEDOBJECT WINDOWINFO MARGININFO MENUINFO PLOTUSERDATA
PLOTSAVELIST]
(RETURN (if (NEQ (CAR BPROPNAME)
(QUOTE QUOTE))
then (QUOTE IGNOREMACRO)
else (if (MEMB (CADR BPROPNAME)
FIELDNAMES)
then (if (EQLENGTH ARGS 3)
then (BQUOTE (PROG1 (fetch (PLOT ,
(CADR
BPROPNAME))
of , BPLOT)
(replace
(PLOT , (CADR BPROPNAME))
of , BPLOT
with , BVALUE)))
else (BQUOTE (fetch (PLOT , (CADR BPROPNAME))
of , BPLOT)))
else (if (NOT (EQLENGTH ARGS 2))
then (QUOTE IGNOREMACRO)
else (BQUOTE (LISTGET (fetch (PLOT PLOTUSERDATA)
of , BPLOT)
, BPROPNAME])
(PLOTREMPROP
[LAMBDA (PLOT PROPNAME) (* jop: " 8-Dec-85 14:57")
(* * Destructively removes PROPNAME from proplist of PLOT)
(if (NOT (type? PLOT PLOT))
then (HELP "Not a plot" PLOT))
(PROG ((FIELDS (RECORDFIELDNAMES (QUOTE PLOT)))
(USERDATA (fetch (PLOT PLOTUSERDATA) of PLOT))
LSTPTR OLDVALUE)
(SETQ OLDVALUE (if (MEMB PROPNAME FIELDS)
then (RECORDACCESS PROPNAME PLOT)
else (LISTGET USERDATA PROPNAME)))
[if (MEMB PROPNAME FIELDS)
then (RECORDACCESS PROPNAME PLOT NIL (QUOTE REPLACE)
NIL)
else (if (SETQ LSTPTR (MEMB PROPNAME USERDATA))
then (* Splice out the offending links)
(if (EQ LSTPTR USERDATA)
then (replace (PLOT PLOTUSERDATA) of PLOT
with (CDDR USERDATA))
else (RPLACD (NLEFT USERDATA 1 LSTPTR)
(CDDR LSTPTR]
(RETURN OLDVALUE])
(PLOTSCALEFN
[LAMBDA ARGS (* jop: "16-Dec-85 21:56")
(* *)
(if (ILESSP ARGS 2)
then (HELP "Must have at least two args"))
(PROG ((PLOT (ARG ARGS 1))
(AXIS (ARG ARGS 2))
AXISINFO OLDVALUE)
(SETQ AXISINFO (SELECTQ AXIS
(X (fetch (PLOTSCALE XAXISINFO)
of (fetch PLOTSCALE of PLOT)))
(Y (fetch (PLOTSCALE YAXISINFO)
of (fetch PLOTSCALE of PLOT)))
(SHOULDNT)))
(SETQ OLDVALUE (fetch (AXISINFO SCALEFN) of AXISINFO))
(if (IGREATERP ARGS 2)
then (LET [(NEWVALUE (ARG ARGS 3))
(NODRAWFLG (AND (IGREATERP ARGS 3)
(ARG ARGS 4]
(replace (AXISINFO SCALEFN) of AXISINFO with NEWVALUE)
(RESCALEPLOT PLOT AXIS NODRAWFLG)))
(RETURN OLDVALUE])
(PLOTTICFN
[LAMBDA ARGS (* jop: "16-Dec-85 21:59")
(* *)
(if (ILESSP ARGS 2)
then (HELP "Must have at least two args"))
(PROG ((PLOT (ARG ARGS 1))
(AXIS (ARG ARGS 2))
AXISINFO OLDVALUE)
(SETQ AXISINFO (SELECTQ AXIS
(X (fetch (PLOTSCALE XAXISINFO)
of (fetch PLOTSCALE of PLOT)))
(Y (fetch (PLOTSCALE YAXISINFO)
of (fetch PLOTSCALE of PLOT)))
(SHOULDNT)))
(SETQ OLDVALUE (fetch (AXISINFO TICFN) of AXISINFO))
(if (IGREATERP ARGS 2)
then (LET [(NEWVALUE (ARG ARGS 3))
(NODRAWFLG (AND (IGREATERP ARGS 3)
(ARG ARGS 4]
(replace (AXISINFO TICFN) of AXISINFO with NEWVALUE)
(RESCALEPLOT PLOT AXIS NODRAWFLG)))
(RETURN OLDVALUE])
(PLOTTICINFO
[LAMBDA (PLOT AXIS NEWTICINFO NODRAWFLG) (* jop: "10-Dec-85 16:04")
(* *)
(PROG ((PLOTSCALE (fetch PLOTSCALE of PLOT))
OLDVALUE)
(SETQ OLDVALUE (SELECTQ AXIS
(X (fetch (PLOTSCALE XTICINFO) of PLOTSCALE))
(Y (fetch (PLOTSCALE YTICINFO) of PLOTSCALE))
(SHOULDNT)))
(if (type? TICINFO NEWTICINFO)
then (SELECTQ AXIS
(X (replace (PLOTSCALE XTICINFO) of PLOTSCALE with NEWTICINFO)
)
(Y (replace (PLOTSCALE YTICINFO) of PLOTSCALE with NEWTICINFO)
)
(SHOULDNT))
(if (NULL NODRAWFLG)
then (REDRAWPLOTWINDOW PLOT)))
(RETURN OLDVALUE])
(PLOTTICMETHOD
[LAMBDA (PLOT MARGINNAME NEWMETHOD NODRAWFLG) (* jop: " 1-Sep-85 15:53")
(* * If NEWMETHOD not present then RETURNS current tic method for margin MARGIN , else replaces the method with
NEWMETHOD, which may be a list of numbers, or a list of CONS pairs (VALUE . LABEL), or a function to be APPLIED to
MARGIN PLOTSCALE PLOT, or the atom DEFAULT)
(PROG (MARGIN OLDVALUE)
(SETQ MARGIN (SELECTQ MARGINNAME
(BOTTOM (fetch BOTTOMMARGIN of PLOT))
(LEFT (fetch LEFTMARGIN of PLOT))
(TOP (fetch TOPMARGIN of PLOT))
(RIGHT (fetch RIGHTMARGIN of PLOT))
(HELP "ILLEGAL MARGIN" MARGIN)))
(SETQ OLDVALUE (fetch (MARGIN TICMETHOD) of MARGIN))
(if NEWMETHOD
then (replace (MARGIN TICMETHOD) of MARGIN with NEWMETHOD)
(if (AND (NULL NODRAWFLG)
(fetch TICS? of MARGIN))
then (REDRAWPLOTWINDOW PLOT)))
(RETURN OLDVALUE])
(PLOTTICS
[LAMBDA ARGS (* jop: "10-Dec-85 21:22")
(* *)
(if (ILESSP ARGS 2)
then (HELP "Must have at least two args"))
(PROG ((PLOT (ARG ARGS 1))
(MARGINNAME (ARG ARGS 2))
MARGIN OLDVALUE)
(SETQ MARGIN (SELECTQ MARGINNAME
(BOTTOM (fetch BOTTOMMARGIN of PLOT))
(LEFT (fetch LEFTMARGIN of PLOT))
(TOP (fetch TOPMARGIN of PLOT))
(RIGHT (fetch RIGHTMARGIN of PLOT))
(HELP "Illegal margin" MARGINNAME)))
(SETQ OLDVALUE (fetch (MARGIN TICS?) of MARGIN))
[if (IGREATERP ARGS 2)
then (LET [(NEWVALUE (ARG ARGS 3))
(NODRAWFLG (AND (IGREATERP ARGS 3)
(ARG ARGS 4]
(replace (MARGIN TICS?) of MARGIN with NEWVALUE)
(if (NULL NODRAWFLG)
then (REDRAWPLOTWINDOW PLOT]
(RETURN OLDVALUE])
(PRINTFONT
[LAMBDA (FONT STREAM) (* jop: "27-Aug-85 15:56")
(PRINTOUT STREAM "(READFONT)(FAMILY" , .P2 (FONTPROP FONT (QUOTE FAMILY))
, "SIZE" , .P2 (FONTPROP FONT (QUOTE SIZE))
, "FACE" , (FONTPROP FONT (QUOTE FACE))
, "ROTATION" , (FONTPROP FONT (QUOTE ROTATION))
, "DEVICE" , (FONTPROP FONT (QUOTE DEVICE))
")")
T])
(PRINTMENU
[LAMBDA (MENU STREAM) (* jop: "27-Aug-85 15:56")
(* * Function for dumping menus on file)
(PRINTOUT STREAM "(READMENU)(ITEMS" , .P2 (fetch ITEMS of MENU)
, "WHENSELECTEDFN" , .P2 (fetch WHENSELECTEDFN of MENU)
, "WHENHELDFN" , .P2 (fetch WHENHELDFN of MENU)
, "WHENUNHELDFN" , .P2 (fetch WHENUNHELDFN of MENU)
, "MENUPOSITION" , .P2 (fetch MENUPOSITION of MENU)
, "MENUOFFSET" , .P2 (fetch MENUOFFSET of MENU)
,) (* use HPRINT here to avoid dumping the whole font)
(PRINTOUT STREAM "MENUFONT" ,)
(HPRINT (fetch MENUFONT of MENU)
STREAM T T)
(PRINTOUT STREAM ,)
(PRINTOUT STREAM "TITLE" , .P2 (fetch TITLE of MENU)
, "CENTERFLG" , .P2 (fetch CENTERFLG of MENU)
, "MENUROWS" , .P2 (fetch MENUROWS of MENU)
, "MENUCOLUMNS" , .P2 (fetch MENUCOLUMNS of MENU)
, "ITEMHEIGHT" , .P2 (fetch ITEMHEIGHT of MENU)
, "ITEMWIDTH" , .P2 (fetch ITEMWIDTH of MENU)
, "MENUBORDERSIZE" , .P2 (fetch MENUBORDERSIZE of MENU)
, "MENUOUTLINESIZE" , .P2 (fetch MENUOUTLINESIZE of MENU)
, "CHANGEOFFSETFLG" , .P2 (fetch CHANGEOFFSETFLG of MENU)
")")
T])
(REDRAWPLOTWINDOW
[LAMBDA (PLOT) (* jop: " 3-Apr-86 11:30")
(* * Redraws the PLOTWINDOW of a PLOT)
(if (NOT (type? PLOT PLOT))
then (HELP "Not a PLOT " PLOT))
(PROG ((PLOTWINDOW (fetch PLOTWINDOW of PLOT))
(PLOTWINDOWVIEWPORT (fetch PLOTWINDOWVIEWPORT of PLOT))
(SELECTEDOBJECT (fetch SELECTEDOBJECT of PLOT))
MINSIZE)
(if (NOT (OPENWP PLOTWINDOW))
then (* Assumes OPENPLOTWINDOW will call REDRAWPLOTWINDOW)
(OPENPLOTWINDOW PLOT)
else (SETQ MINSIZE (MINSTREAMREGIONSIZE (WINDOWPROP PLOTWINDOW (QUOTE DSP))
PLOT))
(* Establish a min size for the WINDOW)
(* Uses MAINWINDOWMINSIZE since PLOTWINDOW is the main
window of a group)
[WINDOWPROP PLOTWINDOW (QUOTE MAINWINDOWMINSIZE)
(CONS (WIDTHIFWINDOW (CAR MINSIZE)
(WINDOWPROP PLOTWINDOW (QUOTE BORDER))
)
(HEIGHTIFWINDOW (CDR MINSIZE)
(WINDOWPROP PLOTWINDOW (QUOTE TITLE))
(WINDOWPROP PLOTWINDOW (QUOTE BORDER]
(if (OR (LESSP (WINDOWPROP PLOTWINDOW (QUOTE WIDTH))
(CAR MINSIZE))
(LESSP (WINDOWPROP PLOTWINDOW (QUOTE HEIGHT))
(CDR MINSIZE)))
then (PROMPTPRINT "PLOTWINDOW TOO SMALL, RESHAPE")
(* Assumes SHAPEW will call REDRAWPLOTWINDOW)
(SHAPEW PLOTWINDOW)
else (ADJUSTVIEWPORT PLOTWINDOWVIEWPORT (DSPCLIPPINGREGION NIL
PLOTWINDOW)
PLOT)
(CLEARW PLOTWINDOW)
(DRAWPLOT PLOT (WINDOWPROP PLOTWINDOW (QUOTE DSP))
PLOTWINDOWVIEWPORT
(DSPCLIPPINGREGION NIL PLOTWINDOW))
(if SELECTEDOBJECT
then (HIGHLIGHTPLOTOBJECT SELECTEDOBJECT PLOT])
(RELABELSELECTEDPLOTOBJECT
[LAMBDA (SELECTEDOBJECT PLOT) (* edited: "27-Mar-86 21:29")
(PROG ((PLOTPROMPTWINDOW (fetch PLOTPROMPTWINDOW of PLOT))
LABEL LABELFLG) (* If the object is labeled, delete the label.)
(if (PLOTOBJECTPROP SELECTEDOBJECT (QUOTE LABEL))
then (UNLABELPLOTOBJECT SELECTEDOBJECT PLOT)
(SETQ LABELFLG T))
(SETQ LABEL (fetch OBJECTLABEL of SELECTEDOBJECT))
(TERPRI PLOTPROMPTWINDOW)
[SETQ LABEL (PROMPTFORWORD "TYPE NEW LABEL :" LABEL "ENTER NIL FOR NO LABEL"
PLOTPROMPTWINDOW NIL NIL (CHARCODE (EOL LF ESCAPE TAB]
(replace OBJECTLABEL of SELECTEDOBJECT with LABEL)
(LABELPLOTOBJECT SELECTEDOBJECT PLOT])
(RESCALEPLOT
[LAMBDA (PLOT AXIS NODRAWFLG) (* jop: "20-Feb-86 17:21")
(if (NULL AXIS)
then (SETQ AXIS (QUOTE BOTH)))
(LET* ((PLOTSCALE (fetch PLOTSCALE of PLOT))
(PLOTOBJECTS (fetch PLOTOBJECTS of PLOT))
(PLOTEXTENT (EXTENTOFPLOT PLOT))
(MINX (fetch (EXTENT MINX) of PLOTEXTENT))
(MAXX (fetch (EXTENT MAXX) of PLOTEXTENT))
(MINY (fetch (EXTENT MINY) of PLOTEXTENT))
(MAXY (fetch (EXTENT MAXY) of PLOTEXTENT)))
(if PLOTOBJECTS
then (LET ((XINTERVAL (fetch (PLOTSCALE XINTERVAL) of PLOTSCALE))
(XAXISINFO (fetch (PLOTSCALE XAXISINFO) of PLOTSCALE))
(YINTERVAL (fetch (PLOTSCALE YINTERVAL) of PLOTSCALE))
(YAXISINFO (fetch (PLOTSCALE YAXISINFO) of PLOTSCALE))
TEMP)
[if (AND (OR (EQ AXIS (QUOTE BOTH))
(EQ AXIS (QUOTE X)))
(GREATERP MAXX MINX))
then (LET ((AXISINFO (fetch (PLOTSCALE XAXISINFO) of PLOTSCALE))
TICINFO)
(SETQ TICINFO (CHOOSETICS MINX MAXX AXISINFO PLOT))
(replace (PLOTSCALE XTICINFO) of PLOTSCALE
with TICINFO)
(replace (PLOTSCALE XINTERVAL) of PLOTSCALE
with (CHOOSESCALE MINX MAXX AXISINFO TICINFO PLOT]
[if (AND (OR (EQ AXIS (QUOTE BOTH))
(EQ AXIS (QUOTE Y)))
(GREATERP MAXY MINY))
then (LET ((AXISINFO (fetch (PLOTSCALE YAXISINFO) of PLOTSCALE))
TICINFO)
(SETQ TICINFO (CHOOSETICS MINY MAXY AXISINFO PLOT))
(replace (PLOTSCALE YTICINFO) of PLOTSCALE
with TICINFO)
(replace (PLOTSCALE YINTERVAL) of PLOTSCALE
with (CHOOSESCALE MINY MAXY AXISINFO TICINFO PLOT]
(if (NULL NODRAWFLG)
then (REDRAWPLOTWINDOW PLOT])
(SCALE
[LAMBDA (MIN MAX NTICS ROUND POWER) (* jop: "20-Jan-86 14:15")
(* * Scaling algorithm for plots. NTICS is the desired number of tics. Round is a list of acceptable scaling
factors. POWER is the power of ten to use. Returns a TICINFO including NEWMAX, NEWMIN, INC, and NTICS)
[if (NULL ROUND)
then (SETQ ROUND (QUOTE (5.0 2.5 2.0 1.5 1.0]
(* Rounding Constants. Notice that they are in
decreasing order and end with 1.0)
(PROG ((NUMINC (SUB1 NTICS))
RAWINC MANTISSA INDEX)
(SETQ RAWINC (FQUOTIENT (DIFFERENCE MAX MIN)
NUMINC)) (* POWER is the power of ten)
[SETQ POWER (EXPT 10.0 (OR POWER (PLOT.FLOOR (PLOT.LOG10 RAWINC]
(* MANTISSA is the scale factor)
(SETQ MANTISSA (FQUOTIENT RAWINC POWER))
[if (GREATERP MANTISSA (CAR ROUND))
then (SETQ POWER (TIMES 10 POWER))
(SETQ INDEX (LAST ROUND))
else (SETQ INDEX (for MARK on ROUND as TEST in (CDR ROUND)
until (GREATERP MANTISSA TEST) finally (RETURN MARK]
(* * Find new max and new min)
(RETURN (bind (NEWMAX ← MIN)
NEWMIN INC FACTOR LOWERMULT UPPERMULT while (LESSP NEWMAX MAX)
do (SETQ INC (TIMES (CAR INDEX)
POWER))
(SETQ FACTOR (FQUOTIENT (FDIFFERENCE (FPLUS MAX MIN)
(FTIMES NUMINC INC))
(FTIMES 2.0 INC)))
[SETQ NEWMIN (FTIMES INC (SETQ LOWERMULT (PLOT.CEILING FACTOR]
[if (GREATERP NEWMIN MIN)
then (SETQ NEWMIN (FTIMES INC (SETQ LOWERMULT (SUB1
LOWERMULT]
(if (AND (GEQ MIN 0.0)
(MINUSP NEWMIN))
then (SETQ LOWERMULT 0)
(SETQ NEWMIN 0.0))
(SETQ UPPERMULT (IPLUS LOWERMULT NUMINC))
(SETQ NEWMAX (FTIMES INC UPPERMULT))
[if (AND (LEQ MAX 0.0)
(GREATERP NEWMAX 0.0))
then (SETQ UPPERMULT 0)
(SETQ NEWMAX 0.0)
(SETQ LOWERMULT (IMINUS NUMINC))
(SETQ NEWMIN (SETQ NEWMIN (FTIMES INC LOWERMULT]
(if (NULL (SETQ INDEX (NLEFT ROUND 1 INDEX)))
then (SETQ INDEX (LAST ROUND))
(SETQ POWER (TIMES 10 POWER)))
finally (RETURN (create TICINFO
TICMAX ← NEWMAX
TICMIN ← NEWMIN
TICINC ← INC
NTICS ← NTICS])
(TOGGELLABEL
[LAMBDA (SELECTEDOBJECT PLOT) (* edited: "27-Mar-86 21:29")
(if (PLOTOBJECTPROP SELECTEDOBJECT (QUOTE LABEL))
then (UNLABELPLOTOBJECT SELECTEDOBJECT PLOT)
else (LABELPLOTOBJECT SELECTEDOBJECT PLOT])
(TOGGLEEXTENDEDAXES
[LAMBDA (PLOT AXIS) (* jop: "10-Dec-85 17:56")
(* *)
(if (NULL AXIS)
then (SETQ AXIS (QUOTE BOTH)))
[PROG [(XSCALEFN (PLOTSCALEFN PLOT (QUOTE X)))
(YSCALEFN (PLOTSCALEFN PLOT (QUOTE Y]
(if (OR (EQ AXIS (QUOTE X))
(EQ AXIS (QUOTE BOTH)))
then (if (EQ XSCALEFN (FUNCTION EXTENDEDSCALEFN))
then (* recover previous state)
(PLOTSCALEFN PLOT (QUOTE X)
(PLOTPROP PLOT (QUOTE OLDXSCALEFN))
T)
else (* Remember the old fn for next time)
(PLOTPROP PLOT (QUOTE OLDXSCALEFN)
(PLOTSCALEFN PLOT (QUOTE X)))
(PLOTSCALEFN PLOT (QUOTE X)
(FUNCTION EXTENDEDSCALEFN)
T)))
(if (OR (EQ AXIS (QUOTE Y))
(EQ AXIS (QUOTE BOTH)))
then (if (EQ YSCALEFN (FUNCTION EXTENDEDSCALEFN))
then (PLOTSCALEFN PLOT (QUOTE Y)
(PLOTPROP PLOT (QUOTE OLDYSCALEFN))
T)
else (PLOTPROP PLOT (QUOTE OLDYSCALEFN)
(PLOTSCALEFN PLOT (QUOTE Y)))
(PLOTSCALEFN PLOT (QUOTE Y)
(FUNCTION EXTENDEDSCALEFN)
T]
(RESCALEPLOT PLOT AXIS])
(TOGGLEFIXEDMENU
[LAMBDA (PLOT) (* jop: "12-Dec-85 10:34")
(* *)
(PLOT.FIXRIGHTMENU PLOT (NOT (PLOT.FIXRIGHTMENU PLOT])
(TOGGLETICS
[LAMBDA (PLOT MARGINNAME) (* jop: "10-Dec-85 21:27")
(if (NULL MARGINNAME)
then (for MARGIN in (QUOTE (BOTTOM LEFT)) do (if (PLOTTICS PLOT MARGIN)
then (PLOTTICS PLOT MARGIN NIL
T)
else (PLOTTICS PLOT MARGIN T T)))
else (if (PLOTTICS PLOT MARGINNAME)
then (PLOTTICS PLOT MARGINNAME NIL T)
else (PLOTTICS PLOT MARGINNAME T T)))
(REDRAWPLOTWINDOW PLOT])
(TRANSLATEPLOTOBJECT
[LAMBDA (OBJECT DX DY PLOT NODRAWFLG) (* edited: "27-Mar-86 21:27")
(PROG [(TEXTOBJECT (PLOTOBJECTPROP OBJECT (QUOTE LABEL)))
(WHENTRANSLATEDFN (PLOTOBJECTPROP OBJECT (QUOTE WHENTRANSLATEDFN]
(if (NULL NODRAWFLG)
then (if (EQ OBJECT (fetch SELECTEDOBJECT of PLOT))
then (LOWLIGHTPLOTOBJECT (fetch SELECTEDOBJECT of PLOT)
PLOT)
(replace SELECTEDOBJECT of PLOT with NIL))
(ERASEPLOTOBJECT OBJECT PLOT)) (* Destructively modify the data structure for OBJECT)
(MOVEPLOTOBJECT OBJECT DX DY PLOT)
(if (NULL NODRAWFLG)
then (DRAWPLOTOBJECT OBJECT (fetch PLOTWINDOWVIEWPORT of PLOT)
PLOT))
(if TEXTOBJECT
then (TRANSLATEPLOTOBJECT TEXTOBJECT DX DY PLOT NODRAWFLG))
(APPLY.AFTERFN WHENTRANSLATEDFN OBJECT DX DY PLOT NODRAWFLG])
(UNDELETEPLOTOBJECT
[LAMBDA (PLOT MODE) (* edited: "27-Mar-86 21:22")
(* * MODE MAY BE ONE OF TOP, SELECT, ABOVE, ALL,. NIL defaults to TOP. TOP means restore the top element of the
save stack. SELECT means choose an object to restore from a menu. ABOVE means restore all objects above the
selected object. ALL means restore all the objects on the save stack.)
(if (NULL MODE)
then (SETQ MODE (QUOTE TOP)))
(PROG ((SAVELIST (fetch (PLOT PLOTSAVELIST) of PLOT))
SELECTION OBJECTSTORESTORE)
(if (NULL SAVELIST)
then (PLOTPROMPT "No object to undelete" PLOT)
(RETURN NIL))
(SETQ OBJECTSTORESTORE
(SELECTQ MODE
(TOP (LIST (CAR SAVELIST)))
(ALL SAVELIST)
[(ABOVE SELECT)
[SETQ SELECTION
(MENU (create MENU
ITEMS ←(bind OBJECTLABEL for OBJECT in SAVELIST
as I from 1
collect (SETQ OBJECTLABEL
(fetch (PLOTOBJECT OBJECTLABEL)
of OBJECT))
(LIST
(if OBJECTLABEL
then (CONCAT
(PLOTOBJECTSUBTYPE
OBJECT)
" " OBJECTLABEL)
else (PLOTOBJECTSUBTYPE
OBJECT))
I]
(AND SELECTION
(if (EQ MODE (QUOTE SELECT))
then (LIST (CAR (NTH SAVELIST SELECTION)))
else (for I from 1 to SELECTION as OBJECT in SAVELIST
collect OBJECT]
(SHOULDNT "Illegal mode")))
[if OBJECTSTORESTORE
then (for OBJECT in OBJECTSTORESTORE do (ADDPLOTOBJECT OBJECT PLOT))
(replace (PLOT PLOTSAVELIST) of PLOT
with (SELECTQ MODE
(TOP (CDR SAVELIST))
(ALL NIL)
(ABOVE (CDR (NTH SAVELIST SELECTION)))
(SELECT (DREMOVE (CAR OBJECTSTORESTORE)
SAVELIST))
(SHOULDNT "ILLEGAL MODE"]
(RETURN OBJECTSTORESTORE])
(UNLABELPLOTOBJECT
[LAMBDA (OBJECT PLOT) (* edited: "27-Mar-86 21:26")
(PROG [(TEXTOBJECT (PLOTOBJECTPROP OBJECT (QUOTE LABEL)))
(WHENUNLABELEDFN (PLOTOBJECTPROP OBJECT (QUOTE WHENUNLABELEDFN]
(if TEXTOBJECT
then (ERASEPLOTOBJECT TEXTOBJECT PLOT)
(PLOTOBJECTPROP OBJECT (QUOTE LABEL)
NIL)
(APPLY.AFTERFN WHENUNLABELEDFN OBJECT PLOT)
else (PLOTPROMPT "NOT A LABELED OBJECT" PLOT])
(WHICHLABEL
[LAMBDA (PLOT) (* jop: "10-Dec-85 17:01")
(* * Prompt for new label and make the required call to ASKFORLABEL)
(PROG ([LMENU (CONSTANT (create MENU
ITEMS ←(QUOTE (TOP LEFT BOTTOM RIGHT]
MARGIN)
(PLOTPROMPT "Select a margin" PLOT)
(SETQ MARGIN (MENU LMENU))
(AND MARGIN (ASKFORLABEL PLOT MARGIN])
(WHICHPLOT
[LAMBDA (X Y) (* jop: "19-Jan-86 17:50")
(* * like WHICHW but returns corresponding plot. First arg may be a window)
(PROG ((W (OR (WINDOWP X)
(WHICHW X Y)))
PLOT)
[SETQ PLOT (OR (WINDOWPROP W (QUOTE PLOT))
(WINDOWPROP (WINDOWPROP W (QUOTE ICONFOR))
(QUOTE PLOT]
(RETURN (if (type? PLOT PLOT)
then PLOT])
)
[DECLARE: EVAL@COMPILE
(DATATYPE EXTENT ((MINX FLOATING)
(MAXX FLOATING)
(MINY FLOATING)
(MAXY FLOATING)))
(DATATYPE MARGIN (TICS? TICMETHOD LABEL))
(DATATYPE PLOT (PLOTOBJECTS PLOTSCALE SELECTEDOBJECT WINDOWINFO MARGININFO MENUINFO PLOTUSERDATA
PLOTSAVELIST) (* PLOTOBJECTS is a display list, PLOTSCALE describes
the scale in world coordinates, USERDATA is a prop
list, SAVELIST is for undelete)
(* WINDOWINFO descibes the associated PLOTWINDOW and
its attached PLOTPROMPTWINDOW)
(DATATYPE WINDOWINFO (PLOTWINDOW PLOTWINDOWVIEWPORT PLOTPROMPTWINDOW))
(* MARGININFO describes the size of the plot margins
in stream coordinates)
(DATATYPE MARGININFO (LEFTMARGIN RIGHTMARGIN TOPMARGIN BOTTOMMARGIN))
(* MENUINFO decribes the PLOT's menus)
(DATATYPE MENUINFO (MIDDLEMENU RIGHTMENU OTHERMENUS))
[ACCESSFNS PLOT ([XLOWER (fetch MIN of (fetch XINTERVAL
of (fetch PLOTSCALE
of DATUM]
[XUPPER (fetch MAX of (fetch XINTERVAL
of (fetch PLOTSCALE of DATUM]
[YLOWER (fetch MIN of (fetch YINTERVAL
of (fetch PLOTSCALE of DATUM]
(YUPPER (fetch MAX of (fetch YINTERVAL
of (fetch PLOTSCALE of DATUM])
(DATATYPE PLOTFNS (DRAWFN ERASEFN HIGHLIGHTFN LOWLIGHTFN LABELFN MOVEFN EXTENTFN DISTANCEFN COPYFN
PUTFN GETFN))
(DATATYPE PLOTOBJECT (OBJECTFNS OBJECTSUBTYPE OBJECTUSERDATA OBJECTMENU OBJECTLABEL OBJECTDATA))
(DATATYPE AXISINFO (SCALEFN TICFN) (* SCALEFN and TICFN are functions)
)
(DATATYPE AXISINTERVAL ((MIN FLOATING)
(MAX FLOATING))
[ACCESSFNS (INTERVALLENGTH (FDIFFERENCE (fetch MAX of DATUM)
(fetch MIN of DATUM])
(DATATYPE PLOTSCALE (XINTERVAL XAXISINFO XTICINFO YINTERVAL YAXISINFO YTICINFO)
(* XINTERVAL YINTERVAL are instances of AXISINTERVAL,
XAXISINFO and YAXISINFO are instances of AXISINFO and
XTICINFO and YTICINFO are instances of TICINFO)
)
(DATATYPE TICINFO ((TICMIN FLOATING)
(TICMAX FLOATING)
TICINC NTICS)
[ACCESSFNS (TICINTERVALLENGTH (FDIFFERENCE (fetch (TICINFO TICMAX)
of DATUM)
(fetch (TICINFO TICMIN)
of DATUM])
]
(/DECLAREDATATYPE (QUOTE EXTENT)
(QUOTE (FLOATP FLOATP FLOATP FLOATP))
(QUOTE ((EXTENT 0 FLOATP)
(EXTENT 2 FLOATP)
(EXTENT 4 FLOATP)
(EXTENT 6 FLOATP)))
(QUOTE 8))
(/DECLAREDATATYPE (QUOTE MARGIN)
(QUOTE (POINTER POINTER POINTER))
(QUOTE ((MARGIN 0 POINTER)
(MARGIN 2 POINTER)
(MARGIN 4 POINTER)))
(QUOTE 6))
(/DECLAREDATATYPE (QUOTE MENUINFO)
(QUOTE (POINTER POINTER POINTER))
(QUOTE ((MENUINFO 0 POINTER)
(MENUINFO 2 POINTER)
(MENUINFO 4 POINTER)))
(QUOTE 6))
(/DECLAREDATATYPE (QUOTE MARGININFO)
(QUOTE (POINTER POINTER POINTER POINTER))
(QUOTE ((MARGININFO 0 POINTER)
(MARGININFO 2 POINTER)
(MARGININFO 4 POINTER)
(MARGININFO 6 POINTER)))
(QUOTE 8))
(/DECLAREDATATYPE (QUOTE WINDOWINFO)
(QUOTE (POINTER POINTER POINTER))
(QUOTE ((WINDOWINFO 0 POINTER)
(WINDOWINFO 2 POINTER)
(WINDOWINFO 4 POINTER)))
(QUOTE 6))
(/DECLAREDATATYPE (QUOTE PLOT)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER))
(QUOTE ((PLOT 0 POINTER)
(PLOT 2 POINTER)
(PLOT 4 POINTER)
(PLOT 6 POINTER)
(PLOT 8 POINTER)
(PLOT 10 POINTER)
(PLOT 12 POINTER)
(PLOT 14 POINTER)))
(QUOTE 16))
(/DECLAREDATATYPE (QUOTE PLOTFNS)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER))
(QUOTE ((PLOTFNS 0 POINTER)
(PLOTFNS 2 POINTER)
(PLOTFNS 4 POINTER)
(PLOTFNS 6 POINTER)
(PLOTFNS 8 POINTER)
(PLOTFNS 10 POINTER)
(PLOTFNS 12 POINTER)
(PLOTFNS 14 POINTER)
(PLOTFNS 16 POINTER)
(PLOTFNS 18 POINTER)
(PLOTFNS 20 POINTER)))
(QUOTE 22))
(/DECLAREDATATYPE (QUOTE PLOTOBJECT)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER))
(QUOTE ((PLOTOBJECT 0 POINTER)
(PLOTOBJECT 2 POINTER)
(PLOTOBJECT 4 POINTER)
(PLOTOBJECT 6 POINTER)
(PLOTOBJECT 8 POINTER)
(PLOTOBJECT 10 POINTER)))
(QUOTE 12))
(/DECLAREDATATYPE (QUOTE AXISINFO)
(QUOTE (POINTER POINTER))
(QUOTE ((AXISINFO 0 POINTER)
(AXISINFO 2 POINTER)))
(QUOTE 4))
(/DECLAREDATATYPE (QUOTE AXISINTERVAL)
(QUOTE (FLOATP FLOATP))
(QUOTE ((AXISINTERVAL 0 FLOATP)
(AXISINTERVAL 2 FLOATP)))
(QUOTE 4))
(/DECLAREDATATYPE (QUOTE PLOTSCALE)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER))
(QUOTE ((PLOTSCALE 0 POINTER)
(PLOTSCALE 2 POINTER)
(PLOTSCALE 4 POINTER)
(PLOTSCALE 6 POINTER)
(PLOTSCALE 8 POINTER)
(PLOTSCALE 10 POINTER)))
(QUOTE 12))
(/DECLAREDATATYPE (QUOTE TICINFO)
(QUOTE (FLOATP FLOATP POINTER POINTER))
(QUOTE ((TICINFO 0 FLOATP)
(TICINFO 2 FLOATP)
(TICINFO 4 POINTER)
(TICINFO 6 POINTER)))
(QUOTE 8))
(DECLARE: EVAL@COMPILE
(PUTPROPS APPLY.AFTERFN MACRO (ARGS (APPLY.AFTERFN.MACRO ARGS)))
[PUTPROPS PLOTOBJECTSUBTYPE? MACRO (ARGS (BQUOTE (EQ (QUOTE , (CAR ARGS))
(fetch (PLOTOBJECT OBJECTSUBTYPE)
of , (CADR ARGS]
(PUTPROPS PLOTOBJECTPROP MACRO (ARGS (PLOTOBJECTPROPMACRO ARGS)))
(PUTPROPS PLOTPROP MACRO (ARGS (PLOTPROPMACRO ARGS)))
)
(PUTPROPS PLOTOBJECTPROP ARGNAMES (NIL (PLOTOBJECT PROP NEWVALUE) . PROPARGS))
(PUTPROPS PLOT.FIXRIGHTMENU ARGNAMES (NIL (PLOT FIXEDFLG) . PROPARGS))
(PUTPROPS PLOTLABEL ARGNAMES (NIL (PLOT MARGINNAME NEWLABEL NODRAWFLG) . LABELARGS))
(PUTPROPS PLOTMENU ARGNAMES (NIL (PLOT MENUNAME NEWMENU) . MENUARGS))
(PUTPROPS PLOTMENUITEMS ARGNAMES (NIL (PLOT MENUNAME NEWMENUITEMS) . MENUARGS))
(PUTPROPS PLOTPRETTYFNS ARGNAMES (NIL (PLOT AXIS NEWPRETTYSCALEFN NEWINVPRETTYSCALEFN NODRAWFLG) .
PROPARGS))
(PUTPROPS PLOTPROP ARGNAMES (NIL (PLOT PROP NEWVALUE) . PROPARGS))
(PUTPROPS PLOTSCALEFN ARGNAMES (NIL (PLOT AXIS NEWSCALEFN NODRAWFLG) . PROPARGS))
(PUTPROPS PLOTTICFN ARGNAMES (NIL (PLOT AXIS NEWTICFN NODRAWFLG) . PROPARGS))
(PUTPROPS PLOTTICS ARGNAMES (NIL (PLOT MARGINNAME NEWTICFLG NODRAWFLG) . LABELARGS))
(RPAQ? SMALLPLOTFONT (QUOTE (GACHA 8 MRR)))
(RPAQ? LARGEPLOTFONT (QUOTE (GACHA 12 BRR)))
(DECLARE: FIRST
(RPAQQ OBJECTOPSTABLE ((POINT (DRAWFN DRAWPOINTOBJECT)
(ERASEFN ERASEPOINTOBJECT)
(HIGHLIGHTFN HIGHLIGHTPOINT)
(MOVEFN MOVEPOINT)
(LABELFN LABELPOINT)
(EXTENTFN EXTENTOFPOINT)
(DISTANCEFN DISTANCETOPOINT)
(COPYFN COPYPOINT)
(PUTFN PUTPOINT)
(GETFN GETPOINT))
(CURVE (DRAWFN DRAWCURVEOBJECT)
(ERASEFN ERASECURVEOBJECT)
(HIGHLIGHTFN HIGHLIGHTCURVE)
(MOVEFN MOVECURVE)
(EXTENTFN EXTENTOFCURVE)
(DISTANCEFN DISTANCETOCURVE)
(COPYFN COPYCURVE)
(PUTFN PUTCURVE)
(GETFN GETCURVE))
(POLYGON (DRAWFN DRAWPOLYGONOBJECT)
(ERASEFN ERASEPOLYGONOBJECT)
(HIGHLIGHTFN HIGHLIGHTPOLYGON)
(MOVEFN MOVEPOLYGON)
(EXTENTFN EXTENTOFPOLYGON)
(DISTANCEFN DISTANCETOPOLYGON)
(COPYFN COPYPOLYGON)
(PUTFN PUTPOLYGON)
(GETFN GETPOLYGON))
(LINE (DRAWFN DRAWLINEOBJECT)
(ERASEFN ERASELINEOBJECT)
(HIGHLIGHTFN HIGHLIGHTLINE)
(MOVEFN MOVELINE)
(EXTENTFN EXTENTOFLINE)
(DISTANCEFN DISTANCETOLINE)
(COPYFN COPYLINE)
(PUTFN PUTLINE)
(GETFN GETLINE))
(GRAPH (DRAWFN DRAWGRAPHOBJECT)
(ERASEFN ERASEGRAPHOBJECT)
(HIGHLIGHTFN HIGHLIGHTGRAPH)
(EXTENTFN EXTENTOFGRAPH)
(DISTANCEFN DISTANCETOGRAPH)
(COPYFN COPYGRAPHOBJECT)
(PUTFN PUTGRAPH)
(GETFN GETGRAPH))
(TEXT (DRAWFN DRAWTEXTOBJECT)
(ERASEFN ERASETEXTOBJECT)
(HIGHLIGHTFN HIGHLIGHTTEXT)
(MOVEFN MOVETEXT)
(LABELFN LABELTEXT)
(EXTENTFN EXTENTOFTEXT)
(DISTANCEFN DISTANCETOTEXT)
(COPYFN COPYTEXT)
(PUTFN PUTTEXT)
(GETFN GETTEXT))
(COMPOUND (DRAWFN DRAWCOMPOUNDOBJECT)
(ERASEFN ERASECOMPOUNDOBJECT)
(HIGHLIGHTFN HIGHLIGHTCOMPOUND)
(LOWLIGHTFN LOWLIGHTCOMPOUND)
(MOVEFN MOVECOMPOUND)
(EXTENTFN EXTENTOFCOMPOUND)
(DISTANCEFN DISTANCETOCOMPOUND)
(COPYFN COPYCOMPOUND)
(PUTFN PUTCOMPOUND)
(GETFN GETCOMPOUND))
(FILLEDRECTANGLE (DRAWFN DRAWFILLEDRECTANGLEOBJECT)
(ERASEFN ERASEFILLEDRECTANGLEOBJECT)
(HIGHLIGHTFN HIGHLIGHTFILLEDRECTANGLE)
(MOVEFN MOVEFILLEDRECTANGLE)
(EXTENTFN EXTENTOFFILLEDRECTANGLE)
(DISTANCEFN DISTANCETOFILLEDRECTANGLE)
(COPYFN COPYFILLEDRECTANGLE)
(PUTFN PUTFILLEDRECTANGLE)
(GETFN GETFILLEDRECTANGLE))))
)
(* * PLOT I/O)
(DEFINEQ
(COPYPLOTOBJECT
[LAMBDA (PLOTOBJECT PLOT) (* jop: "20-Jan-86 16:20")
(* * Returns a copy of PLOTOBJECT. OBJECTPROPS are handled as follows. If the PLOTOBJECT has a COPYFN
(which may be a list of fns) on its prop list, apply's it to NEWPLOTOBJECT PLOTOBJECT PLOT and expects it to copy
the OBJECTPROPs, else calls COPYALL, except for PLOTOBJECTS or lists of PLOTOBJECTS which are COPYOBJECT'ed)
(PROG ([OBJECTCOPYFN (MKLIST (PLOTOBJECTPROP PLOTOBJECT (QUOTE COPYFN]
NEWPLOTOBJECT)
(SETQ NEWPLOTOBJECT (CREATEPLOTOBJECT (fetch OBJECTFNS of PLOTOBJECT)
(PLOTOBJECTSUBTYPE PLOTOBJECT)
(COPYALL (fetch OBJECTLABEL of PLOTOBJECT)
)
(fetch OBJECTMENU of PLOTOBJECT)
(APPLY* (fetch (PLOTFNS COPYFN)
of (fetch OBJECTFNS
of PLOTOBJECT))
PLOTOBJECT PLOT)))
[for PROPNAME in (for PROP in (fetch OBJECTUSERDATA of PLOTOBJECT)
by (CDDR PROP) collect PROP)
do (PLOTOBJECTPROP NEWPLOTOBJECT PROPNAME
(OR (AND OBJECTCOPYFN
(bind PROPVALUE for FN in OBJECTCOPYFN
until (SETQ PROPVALUE
(APPLY* FN NEWPLOTOBJECT PLOTOBJECT
PLOT PROPNAME))
finally (RETURN PROPVALUE)))
(LET ((PROPVALUE (PLOTOBJECTPROP PLOTOBJECT PROPNAME)))
(if (type? PLOTOBJECT PROPVALUE)
then (COPYPLOTOBJECT PROPVALUE)
elseif (LISTP PROPVALUE)
then (for ITEM in PROPVALUE
collect (if (type? PLOTOBJECT
ITEM)
then (COPYPLOTOBJECT
ITEM PLOT)
else (HCOPYALL ITEM)))
else (HCOPYALL PROPVALUE]
(if [OR (NOT (type? PLOTOBJECT NEWPLOTOBJECT))
(NOT (EQ (PLOTOBJECTSUBTYPE NEWPLOTOBJECT)
(PLOTOBJECTSUBTYPE PLOTOBJECT]
then (HELP "Not a plotobject of correct type" NEWPLOTOBJECT))
(RETURN NEWPLOTOBJECT])
(COPYPLOT
[LAMBDA (PLOT OPENFLG REGION TITLE BORDER) (* edited: "27-Mar-86 21:23")
(* Copies a PLOT. Copying of PLOTPROP's is handled as follows. If PLOT has a COPYPLOTFN, (which may be a list of
fns) calls it with NEWPLOT PLOT as args, and expects it to copy the PLOTPROPS intelligently, else HCOPYALL's the
PROPS, except for PLOTOBJECTS or lists of PLOTOBJECTS which are COPYOBJECT'ed)
(PROG ([COPYFN (MKLIST (PLOTPROP PLOT (QUOTE COPYFN]
(NEWPLOT (create PLOT))) (* OK to share Menus)
(replace (PLOT MIDDLEMENU) of NEWPLOT with (fetch (PLOT MIDDLEMENU) of PLOT))
(replace (PLOT RIGHTMENU) of NEWPLOT with (fetch (PLOT RIGHTMENU) of PLOT))
(* OTHERMENUS copied since it is a list in prop format
and consists of MENU's or LITATOMS)
(replace (PLOT OTHERMENUS) of NEWPLOT with (COPY (fetch (PLOT OTHERMENUS)
of PLOT)))
(replace (PLOT LEFTMARGIN) of NEWPLOT with (create MARGIN
copying (fetch (PLOT LEFTMARGIN)
of PLOT)))
(replace (PLOT RIGHTMARGIN) of NEWPLOT with (create MARGIN
copying (fetch (PLOT RIGHTMARGIN)
of PLOT)))
(replace (PLOT TOPMARGIN) of NEWPLOT with (create MARGIN
copying (fetch (PLOT TOPMARGIN)
of PLOT)))
(replace (PLOT BOTTOMMARGIN) of NEWPLOT with (create MARGIN
copying (fetch (PLOT
BOTTOMMARGIN)
of PLOT)))
(* Plot objects not shared since they can be
distructively modified)
(replace (PLOT PLOTOBJECTS) of NEWPLOT with (for OBJECT
in (fetch (PLOT PLOTOBJECTS)
of PLOT)
collect (COPYPLOTOBJECT OBJECT
PLOT)))
(replace (PLOT PLOTSCALE) of NEWPLOT with (create PLOTSCALE
copying (fetch (PLOT PLOTSCALE)
of PLOT)))
(* Does a HCOPYALL since we don't know what's cached
here)
[for PROPNAME in (for PROP in (fetch (PLOT PLOTUSERDATA) of PLOT)
by (CDDR PROP) collect PROP)
do (PLOTPROP NEWPLOT PROPNAME (OR (AND COPYFN
(bind PROPVALUE for FN
in COPYFN
until (SETQ PROPVALUE
(APPLY* FN NEWPLOT PLOT
PROPNAME))
finally (RETURN PROPVALUE)))
(LET ((PROPVALUE (PLOTPROP PLOT PROPNAME)))
(if (type? PLOTOBJECT PROPVALUE)
then (COPYPLOTOBJECT PROPVALUE)
elseif (LISTP PROPVALUE)
then (for ITEM in PROPVALUE
collect
(if (type? PLOTOBJECT
ITEM)
then (
COPYPLOTOBJECT
ITEM PLOT)
else (HCOPYALL
ITEM)))
else (HCOPYALL PROPVALUE]
(* Cache the display parameters)
(if (OR REGION TITLE BORDER)
then (replace (PLOT PLOTWINDOW) of NEWPLOT with (LIST REGION TITLE BORDER)))
(if OPENFLG
then (OPENPLOTWINDOW NEWPLOT))
(RETURN NEWPLOT])
(PLOTOBJECTPRINT
[LAMBDA (PLOTOBJECT) (* jop: "10-Dec-85 21:01")
(* *)
(DECLARE (SPECVARS PRXFLG))
(RESETLST (RESETSAVE (RADIX 8))
(RESETSAVE PRXFLG T)
(LIST (CONCAT "<" (fetch OBJECTSUBTYPE of PLOTOBJECT)
" PLOTOBJECT>#"
(\HILOC PLOTOBJECT)
","
(\LOLOC PLOTOBJECT])
(PRINTPLOTOBJECT
[LAMBDA (PLOTOBJECT PLOT STREAM) (* jop: " 3-Apr-86 11:14")
(* * Puts a plot object on STREAM)
(PROG [(OBJECTPUTFN (MKLIST (PLOTOBJECTPROP PLOTOBJECT (QUOTE PUTFN]
(PRINTOUT STREAM "(READPLOTOBJECT)(" , "OBJECTSUBTYPE" , .P2 (fetch (PLOTOBJECT
OBJECTSUBTYPE)
of PLOTOBJECT)
, "OBJECTDATA" ,)
(APPLY* (fetch (PLOTFNS PUTFN) of (fetch OBJECTFNS of PLOTOBJECT))
PLOTOBJECT PLOT STREAM)
(PRINTOUT STREAM , "OBJECTMENU" ,)
(HPRINT (fetch OBJECTMENU of PLOTOBJECT)
STREAM T T)
(PRINTOUT STREAM , "OBJECTLABEL" , .P2 (fetch OBJECTLABEL of PLOTOBJECT)
,)
(PRINTOUT STREAM "OBJECTUSERDATA (")
(for PROPNAME in (for PROP in (fetch OBJECTUSERDATA of PLOTOBJECT)
by (CDDR PROP) collect PROP)
do (PRINTOUT STREAM PROPNAME ,)
(if (NULL (for FN in OBJECTPUTFN thereis (APPLY* FN PLOTOBJECT PLOT
PROPNAME STREAM)))
then (HPRINT (PLOTOBJECTPROP PLOTOBJECT PROPNAME)
STREAM NIL T)))
(PRINTOUT STREAM "))")
(RETURN T])
(PRINTPLOT
[LAMBDA (PLOT STREAM) (* jop: " 8-Dec-85 15:55")
(* * Puts out a symbolic representation of PLOT on STREAM)
(PROG [(PUTFN (MKLIST (PLOTPROP PLOT (QUOTE PUTFN]
(PRINTOUT STREAM "(READPLOT)(")
(for FIELDNAME in (QUOTE ((PLOT MIDDLEMENU)
(PLOT RIGHTMENU)
(PLOT OTHERMENUS)
(PLOT LEFTMARGIN)
(PLOT TOPMARGIN)
(PLOT RIGHTMARGIN)
(PLOT BOTTOMMARGIN)
(PLOT PLOTSCALE)))
do (PRINTOUT STREAM (CADR FIELDNAME)
,)
(HPRINT (RECORDACCESS FIELDNAME PLOT)
STREAM T T))
(PRINTOUT STREAM , "PLOTOBJECTS (")
(for OBJECT in (fetch (PLOT PLOTOBJECTS) of PLOT)
do (HPRINT OBJECT STREAM T T))
(PRINTOUT STREAM ")" ,)
(PRINTOUT STREAM , "PLOTUSERDATA (")
(for PROPNAME in (for PROP in (fetch (PLOT PLOTUSERDATA) of PLOT)
by (CDDR PROP) collect PROP)
do (PRINTOUT STREAM , PROPNAME ,)
(if (NULL (for FN in PUTFN thereis (APPLY* FN PLOT PROPNAME STREAM)))
then (HPRINT (PLOTPROP PLOT PROPNAME)
STREAM NIL T)))
(PRINTOUT STREAM ")" ,)
(PRINTOUT STREAM ")")
(RETURN T])
(READFONT
[LAMBDA (STREAM) (* jop: "27-Aug-85 13:34")
(PROG ((PROPLIST (READ STREAM)))
(RETURN (FONTCREATE (LISTGET PROPLIST (QUOTE FAMILY))
(LISTGET PROPLIST (QUOTE SIZE))
(LISTGET PROPLIST (QUOTE FACE))
(LISTGET PROPLIST (QUOTE ROTATION))
(LISTGET PROPLIST (QUOTE DEVICE])
(READMENU
[LAMBDA (STREAM) (* jop: "27-Aug-85 14:15")
(* * Function For Reading Menus From File)
(PROG ((PROPLIST (HREAD STREAM)))
(RETURN (create MENU
ITEMS ←(LISTGET PROPLIST (QUOTE ITEMS))
WHENSELECTEDFN ←(LISTGET PROPLIST (QUOTE WHENSELECTEDFN))
WHENHELDFN ←(LISTGET PROPLIST (QUOTE WHENHELDFN))
WHENUNHELDFN ←(LISTGET PROPLIST (QUOTE WHENUNHELDFN))
MENUPOSITION ←(LISTGET PROPLIST (QUOTE MENUPOSITION))
MENUOFFSET ←(LISTGET PROPLIST (QUOTE MENUOFFSET))
MENUFONT ←(LISTGET PROPLIST (QUOTE MENUFONT))
TITLE ←(LISTGET PROPLIST (QUOTE TITLE))
CENTERFLG ←(LISTGET PROPLIST (QUOTE CENTERFLG))
MENUROWS ←(LISTGET PROPLIST (QUOTE MENUROWS))
MENUCOLUMNS ←(LISTGET PROPLIST (QUOTE MENUCOLUMNS))
ITEMHEIGHT ←(LISTGET PROPLIST (QUOTE ITEMHEIGHT))
ITEMWIDTH ←(LISTGET PROPLIST (QUOTE ITEMWIDTH))
MENUBORDERSIZE ←(LISTGET PROPLIST (QUOTE MENUBORDERSIZE))
MENUOUTLINESIZE ←(LISTGET PROPLIST (QUOTE MENUOUTLINESIZE))
CHANGEOFFSETFLG ←(LISTGET PROPLIST (QUOTE CHANGEOFFSETFLG])
(READPLOTOBJECT
[LAMBDA (STREAM) (* jop: "20-Jan-86 16:02")
(* * Reads a plot object from STREAM previously written out by PRINTOBJECT)
(PROG ((PROPLST (HREAD STREAM))
OBJECTSUBTYPE OBJECTFNS OBJECTGETFN NEWOBJECT OBJECTUSERDATA)
(SETQ OBJECTSUBTYPE (LISTGET PROPLST (QUOTE OBJECTSUBTYPE)))
[SETQ OBJECTFNS (EVAL (PACK* OBJECTSUBTYPE (QUOTE FNS]
(SETQ OBJECTGETFN (fetch (PLOTFNS GETFN) of OBJECTFNS))
[SETQ NEWOBJECT (CREATEPLOTOBJECT OBJECTFNS OBJECTSUBTYPE (LISTGET PROPLST
(QUOTE
OBJECTLABEL))
(LISTGET PROPLST (QUOTE OBJECTMENU))
(APPLY* OBJECTGETFN (LISTGET PROPLST
(QUOTE
OBJECTDATA]
(SETQ OBJECTUSERDATA (LISTGET PROPLST (QUOTE OBJECTUSERDATA)))
(for PROPNAME in OBJECTUSERDATA by (CDDR PROPNAME) as PROPVALUE
in (CDR OBJECTUSERDATA) by (CDDR PROPVALUE)
do (PLOTOBJECTPROP NEWOBJECT PROPNAME (if (AND (LISTP PROPVALUE)
(EQ (CAR PROPVALUE)
(QUOTE FUNCTION)))
then (SETQ PROPVALUE
(APPLY* (CADR PROPVALUE)
NEWOBJECT PROPNAME))
else PROPVALUE)))
(RETURN NEWOBJECT])
(READPLOT
[LAMBDA (STREAM) (* jop: " 8-Dec-85 15:33")
(* * Reads In a Symbolic Representation Of A PLOT From Stream Previously Written Out By PRINTPLOT)
(PROG ((PROPLST (HREAD STREAM))
PLOT USERDATA)
[SETQ PLOT (create PLOT
MIDDLEMENU ←(LISTGET PROPLST (QUOTE MIDDLEMENU))
RIGHTMENU ←(LISTGET PROPLST (QUOTE RIGHTMENU))
OTHERMENUS ←(LISTGET PROPLST (QUOTE OTHERMENUS))
LEFTMARGIN ←(LISTGET PROPLST (QUOTE LEFTMARGIN))
TOPMARGIN ←(LISTGET PROPLST (QUOTE TOPMARGIN))
RIGHTMARGIN ←(LISTGET PROPLST (QUOTE RIGHTMARGIN))
BOTTOMMARGIN ←(LISTGET PROPLST (QUOTE BOTTOMMARGIN))
PLOTSCALE ←(LISTGET PROPLST (QUOTE PLOTSCALE))
PLOTOBJECTS ←(LISTGET PROPLST (QUOTE PLOTOBJECTS]
(SETQ USERDATA (LISTGET PROPLST (QUOTE PLOTUSERDATA)))
(for PROPNAME in USERDATA by (CDDR PROPNAME) as PROPVALUE in (CDR USERDATA)
by (CDDR PROPVALUE) do (PLOTPROP PLOT PROPNAME
(if [AND (LISTP PROPVALUE)
(AND (LISTP (CAR PROPVALUE)
)
(EQ (CAAR PROPVALUE)
(QUOTE FUNCTION]
then
(* Assumes Lists Of Form ((Function Foo) Bar))
(SETQ PROPVALUE
(APPLY* (CADAR PROPVALUE)
PLOT PROPNAME
(CADR PROPVALUE)))
else PROPVALUE)))
(RETURN PLOT])
)
(PUTDEF (QUOTE PLOTS) (QUOTE FILEPKGCOMS) [QUOTE ((COM MACRO (PLTS (HORRIBLEVARS . PLTS])
(ADDTOVAR HPRINTMACROS (FONTDESCRIPTOR . PRINTFONT)
(MENU . PRINTMENU)
(PLOT . PRINTPLOT)
(PLOTOBJECT . PRINTPLOTOBJECT))
(DEFPRINT (QUOTE PLOTOBJECT)
(FUNCTION PLOTOBJECTPRINT))
(* * Numeric fns)
(DEFINEQ
(PLOT.EXP10
[LAMBDA (X) (* jop: "20-Jan-86 21:08")
(* * this procedure returns exact power of ten for integer args)
(EXPT 10.0 X])
(PLOT.LOG10
[LAMBDA (X) (* jop: " 9-Dec-84 14:42")
(* * Returns log base 10 of X)
(PROG [(C (CONSTANT (FQUOTIENT 1.0 (LOG 10.0]
(RETURN (FTIMES C (LOG X])
(PLOT.FLOOR
[LAMBDA (X) (* jop: " 9-Sep-85 20:42")
(SETQ X (FLOAT X))
(PROG ((FIXX (FIX X)))
(RETURN (if (MINUSP X)
then (if (EQP FIXX X)
then FIXX
else (SUB1 FIXX))
else FIXX])
(PLOT.CEILING
[LAMBDA (X) (* jop: " 9-Sep-85 20:43")
(SETQ X (FLOAT X))
(PROG ((FIXX (FIX X)))
(RETURN (if (MINUSP X)
then FIXX
else (if (EQP FIXX X)
then FIXX
else (ADD1 FIXX])
(SINEWAVE
[LAMBDA (N FREQUENCY FROM TO AMPLITUDE) (* jop: "11-Jan-85 15:23")
(* * produce N points on a sine wave)
(PROG ((TWOPI (TIMES 2.0 3.14159))
(RANGE (FDIFFERENCE TO FROM)))
(if (NULL FREQUENCY)
then (SETQ FREQUENCY 1))
(if (NULL AMPLITUDE)
then (SETQ AMPLITUDE 1))
(RETURN (bind (X ← FROM)
(INC ←(FQUOTIENT RANGE N))
POINT for I from 1 to N
collect [SETQ POINT (create POSITION
XCOORD ← X
YCOORD ←(TIMES AMPLITUDE
(SIN (TIMES FREQUENCY
X)
T]
(SETQ X (PLUS X INC))
POINT])
)
(* * PLOT image object FNS)
(DEFINEQ
(CREATEPLOTIMAGEOBJ
[LAMBDA (PLOT) (* jop: "27-Aug-85 21:05")
(* creates PLOT image object from PLOT)
(PROG ((WINDOW (fetch (PLOT PLOTWINDOW) of PLOT))
(OBJ (IMAGEOBJCREATE (COPYPLOT PLOT)
PLOTIMAGEFNS)))
(IMAGEOBJPROP OBJ (QUOTE WIDTH)
(WINDOWPROP WINDOW (QUOTE WIDTH)))
(IMAGEOBJPROP OBJ (QUOTE HEIGHT)
(WINDOWPROP WINDOW (QUOTE HEIGHT)))
(RETURN OBJ])
(PLIO.BUTTONEVENTINFN
[LAMBDA (PLOTIMAGEOBJ WINDOWSTREAM SELECTION RELX RELY WINDOW TEXTSTREAM BUTTON)
(* jop: " 6-Dec-85 17:41")
(PROG ([CHOICEMENU (CONSTANT (create MENU
CENTERFLG ← T
ITEMS ←(QUOTE ((Select (QUOTE SELECT)
"Select the image object")
(Reshape (QUOTE RESHAPE)
"Reshape the image objcet")
(Plot% Window (QUOTE EDIT)
"Open a window containing plot"]
(PLOT (IMAGEOBJPROP PLOTIMAGEOBJ (QUOTE OBJECTDATUM)))
(IMAGEWIDTH (IMAGEOBJPROP PLOTIMAGEOBJ (QUOTE WIDTH)))
(IMAGEHEIGHT (IMAGEOBJPROP PLOTIMAGEOBJ (QUOTE HEIGHT)))
MINSIZE NEWREGION WIN NEWPLOT)
(if (EQ BUTTON (QUOTE LEFT))
then (SELECTQ (MENU CHOICEMENU)
(RESHAPE (SETQ MINSIZE (MINSTREAMREGIONSIZE
(WINDOWPROP (fetch PLOTWINDOW of PLOT)
(QUOTE DSP))
PLOT)) (* Assumes the WINDOWSTREAM has been changed to fit
the imageobj)
(SETQ NEWREGION (GETREGION (CAR MINSIZE)
(CDR MINSIZE)
(CREATEREGION
(DSPXOFFSET NIL
WINDOWSTREAM)
(DSPYOFFSET NIL
WINDOWSTREAM)
IMAGEWIDTH IMAGEHEIGHT)))
(IMAGEOBJPROP PLOTIMAGEOBJ (QUOTE WIDTH)
(fetch WIDTH of NEWREGION))
(IMAGEOBJPROP PLOTIMAGEOBJ (QUOTE HEIGHT)
(fetch HEIGHT of NEWREGION))
(* Redraw the Image object)
(RETURN (QUOTE CHANGED)))
(EDIT (SETQ NEWPLOT (COPYPLOT PLOT NIL
(GETBOXREGION (WIDTHIFWINDOW
IMAGEWIDTH)
(
HEIGHTIFWINDOW
IMAGEHEIGHT T)
)
"Plot Edit Window"))
(SETQ WIN (OPENPLOTWINDOW NEWPLOT))
(* Cache some info some that changes to NEWPLOT may be
reinserted into TEXTSTREAM.
Windowprops are used because they are not copied
(HACK))
(WINDOWPROP WIN (QUOTE SOURCETEXTSTREAM)
TEXTSTREAM)
(WINDOWPROP WIN (QUOTE SOURCEIMAGEOBJ)
PLOTIMAGEOBJ)
[PLOTADDMENUITEMS NEWPLOT (QUOTE RIGHT)
(QUOTE ((Reinsert PLIO.REINSERTOBJ
"Change source image object"]
(RETURN NIL))
(RETURN NIL))
else (RETURN NIL])
(PLIO.COPYFN
[LAMBDA (PLOTIOBJ) (* jop: "31-Jul-85 13:36")
(* simple copy)
(PROG ((NEWOBJ (IMAGEOBJCREATE NIL PLOTIMAGEFNS)))
[IMAGEOBJPROP NEWOBJ (QUOTE OBJECTDATUM)
(COPYPLOT (IMAGEOBJPROP PLOTIOBJ (QUOTE OBJECTDATUM]
(IMAGEOBJPROP NEWOBJ (QUOTE WIDTH)
(IMAGEOBJPROP PLOTIOBJ (QUOTE WIDTH)))
(IMAGEOBJPROP NEWOBJ (QUOTE HEIGHT)
(IMAGEOBJPROP PLOTIOBJ (QUOTE HEIGHT)))
(RETURN NEWOBJ])
(PLIO.GETFN
[LAMBDA (STREAM TEXTSTREAM) (* jop: "27-Aug-85 21:06")
(* * PLOT IMAGEOBJECT GETFN)
(PROG ((PROPLST (HREAD STREAM))
PLOTIMAGEOBJ)
(SETQ PLOTIMAGEOBJ (IMAGEOBJCREATE (LISTGET PROPLST (QUOTE PLOT))
PLOTIMAGEFNS))
(IMAGEOBJPROP PLOTIMAGEOBJ (QUOTE WIDTH)
(LISTGET PROPLST (QUOTE WIDTH)))
(IMAGEOBJPROP PLOTIMAGEOBJ (QUOTE HEIGHT)
(LISTGET PROPLST (QUOTE HEIGHT)))
(RETURN PLOTIMAGEOBJ])
(PLIO.PUTFN
[LAMBDA (PLOTIMAGEOBJ STREAM) (* jop: "27-Aug-85 21:09")
(* * PLOT IMAGEOBJECT PUTFN)
(PRINTOUT STREAM "(WIDTH" , (IMAGEOBJPROP PLOTIMAGEOBJ (QUOTE WIDTH))
, "HEIGHT" , (IMAGEOBJPROP PLOTIMAGEOBJ (QUOTE HEIGHT))
, "PLOT" ,)
(HPRINT (IMAGEOBJPROP PLOTIMAGEOBJ (QUOTE OBJECTDATUM))
STREAM T T)
(PRINTOUT STREAM ")"])
(PLIO.REINSERTOBJ
[LAMBDA (PLOT) (* jop: "31-Jul-85 13:31")
(* * allows modified plot to be reinserted in document)
(PROG ((PLOTWINDOW (fetch PLOTWINDOW of PLOT))
TEXTSTREAM OBJ)
(SETQ TEXTSTREAM (WINDOWPROP PLOTWINDOW (QUOTE SOURCETEXTSTREAM)))
(if (NOT (TEXTSTREAMP TEXTSTREAM))
then (HELP "Not a TEXTSTREAM" TEXTSTREAM))
(SETQ OBJ (WINDOWPROP PLOTWINDOW (QUOTE SOURCEIMAGEOBJ)))
(if (NOT (IMAGEOBJP OBJ))
then (HELP "Not an IMAGEOBJ" OBJ)) (* Destructively change imageobj to retain EQ ness)
(IMAGEOBJPROP OBJ (QUOTE OBJECTDATUM)
(COPYPLOT PLOT))
(IMAGEOBJPROP OBJ (QUOTE WIDTH)
(WINDOWPROP PLOTWINDOW (QUOTE WIDTH)))
(IMAGEOBJPROP OBJ (QUOTE HEIGHT)
(WINDOWPROP PLOTWINDOW (QUOTE HEIGHT)))
(TEDIT.OBJECT.CHANGED TEXTSTREAM OBJ])
(PLOT.COPYBUTTONEVENTFN
[LAMBDA (WINDOW) (* jop: "25-Feb-86 15:19")
(* allows plots to be copy selected)
(PROG ((PLOT (WINDOWPROP WINDOW (QUOTE PLOT)))
[IMAGETYPEMENU (CONSTANT (create MENU
ITEMS ←(QUOTE ((Plot (QUOTE PLOT))
(Bitmap (QUOTE BITMAP]
IMAGEOBJ)
(INVERTW WINDOW)
(UNTILMOUSESTATE UP)
(INVERTW WINDOW)
(if (INSIDEP WINDOW (CURSORPOSITION NIL WINDOW))
then (SELECTQ (MENU IMAGETYPEMENU)
(PLOT (SETQ IMAGEOBJ (CREATEPLOTIMAGEOBJ PLOT)))
(BITMAP (SETQ IMAGEOBJ (CREATEPLOTBITMAPOBJ PLOT)))
NIL)
(AND IMAGEOBJ (COPYINSERT IMAGEOBJ])
(PLIO.DISPLAYFN
[LAMBDA (PLOTIOBJ IMAGESTREAM) (* jop: " 4-Feb-86 10:24")
(* displays plot image object)
(PROG ((PLOT (IMAGEOBJPROP PLOTIOBJ (QUOTE OBJECTDATUM)))
(VIEWPORT (IMAGEOBJPROP PLOTIOBJ (QUOTE VIEWPORT)))
(SCALE (DSPSCALE NIL IMAGESTREAM))
STREAMREGION)
(if (OR (NULL VIEWPORT)
(NOT (EQ (fetch PARENTSTREAM of VIEWPORT)
IMAGESTREAM)))
then (SETQ VIEWPORT (CREATEVIEWPORT IMAGESTREAM))
(IMAGEOBJPROP PLOTIOBJ (QUOTE VIEWPORT)
VIEWPORT))
[SETQ STREAMREGION (CREATEREGION (DSPXPOSITION NIL IMAGESTREAM)
(DSPYPOSITION NIL IMAGESTREAM)
[FIXR (TIMES SCALE (IMAGEOBJPROP PLOTIOBJ
(QUOTE
WIDTH]
(FIXR (TIMES SCALE (IMAGEOBJPROP PLOTIOBJ
(QUOTE
HEIGHT]
(ADJUSTVIEWPORT VIEWPORT STREAMREGION PLOT)
(DRAWPLOT PLOT IMAGESTREAM VIEWPORT STREAMREGION])
(PLIO.IMAGEBOXFN
[LAMBDA (PLOTIOBJ IMAGESTREAM CURRENTX RIGHTMARGIN) (* jop: " 4-Feb-86 10:22")
(* * Determines size of plotimageobj)
(PROG ((IMAGEWIDTH (IMAGEOBJPROP PLOTIOBJ (QUOTE WIDTH)))
(IMAGEHEIGHT (IMAGEOBJPROP PLOTIOBJ (QUOTE HEIGHT)))
(PLOT (IMAGEOBJPROP PLOTIOBJ (QUOTE OBJECTDATUM)))
(SCALE (if IMAGESTREAM
then (DSPSCALE NIL IMAGESTREAM)
else 1))
NEWREGION MINSIZE)
(if (GREATERP (TIMES SCALE IMAGEWIDTH)
(DIFFERENCE RIGHTMARGIN CURRENTX))
then (if (NOT (EQ (IMAGESTREAMTYPE IMAGESTREAM)
(QUOTE DISPLAY)))
then (HELP "PLOT image object too big"))
(PROMPTPRINT "Image object too wide. Choose a smaller region")
(SETQ MINSIZE (MINSTREAMREGIONSIZE IMAGESTREAM PLOT))
(SETQ NEWREGION (GETREGION (CAR MINSIZE)
(CDR MINSIZE)))
(SETQ IMAGEWIDTH (fetch WIDTH of NEWREGION))
(IMAGEOBJPROP PLOTIOBJ (QUOTE WIDTH)
IMAGEWIDTH)
(SETQ IMAGEHEIGHT (fetch HEIGHT of NEWREGION))
(IMAGEOBJPROP PLOTIOBJ (QUOTE HEIGHT)
IMAGEHEIGHT))
(RETURN (create IMAGEBOX
XSIZE ←(TIMES SCALE IMAGEWIDTH)
YSIZE ←(TIMES SCALE IMAGEHEIGHT)
YDESC ← 0
XKERN ← 0])
)
(RPAQ? PLOTIMAGEFNS (IMAGEFNSCREATE (FUNCTION PLIO.DISPLAYFN)
(FUNCTION PLIO.IMAGEBOXFN)
(FUNCTION PLIO.PUTFN)
(FUNCTION PLIO.GETFN)
(FUNCTION PLIO.COPYFN)
(FUNCTION PLIO.BUTTONEVENTINFN)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS PLOTIMAGEFNS)
)
(* * Initialize PLOTFNS)
(PLOT.SETUP OBJECTOPSTABLE)
(* * Dependent files)
(FILESLOAD TWODGRAPHICS PLOTOBJECTS)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA PLOTTICS PLOTTICFN PLOTSCALEFN PLOTPROP PLOTOBJECTPROP PLOTMENUITEMS PLOTMENU
PLOTLABEL PLOT.FIXRIGHTMENU)
)
(PUTPROPS PLOT COPYRIGHT ("Xerox Corporation" 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (3835 121312 (ADDPLOTOBJECT 3845 . 4729) (ADJUSTSCALE? 4731 . 7113) (ADJUSTVIEWPORT 7115
. 9156) (APPLY.AFTERFN.MACRO 9158 . 9669) (ASKFORLABEL 9671 . 10914) (ASKFORSCALE 10916 . 12183) (
BOXREGION 12185 . 12958) (CHOOSESCALE 12960 . 13483) (CHOOSETICS 13485 . 13963) (CLOSEPLOTWINDOW 13965
. 14269) (CLOSESTPLOTOBJECT 14271 . 14547) (COMPOUNDSUBTYPE 14549 . 14745) (COMPUTEBOTTOMMARGIN 14747
. 15988) (COMPUTELEFTMARGIN 15990 . 17753) (COMPUTERIGHTMARGIN 17755 . 19514) (COMPUTETOPMARGIN 19516
. 20699) (COPYMENU 20701 . 21633) (CREATEPLOT 21635 . 26262) (CREATEPLOTBITMAPOBJ 26264 . 26674) (
CREATEPLOTFNS 26676 . 28659) (CREATEPLOTOBJECT 28661 . 29432) (DEFAULTSCALEFN 29434 . 29712) (
DEFAULTTICFN 29714 . 30687) (DEFAULTTICMETHOD 30689 . 31805) (DELETEPLOTOBJECT 31807 . 33197) (
DESELECTPLOTOBJECT 33199 . 33519) (DISTANCETOPLOTOBJECT 33521 . 33756) (DRAWBOTTOMMARGIN 33758 . 37583
) (DRAWLEFTMARGIN 37585 . 41094) (DRAWMARGIN 41096 . 41872) (DRAWPLOTOBJECT 41874 . 42375) (DRAWPLOT
42377 . 43232) (DRAWRIGHTMARGIN 43234 . 46668) (DRAWTOPMARGIN 46670 . 49999) (ERASEPLOTOBJECT 50001 .
50540) (EXTENDEDSCALEFN 50542 . 51033) (EXTENTOFPLOTOBJECT 51035 . 51251) (EXTENTOFPLOT 51253 . 52251)
(GETPLOTWINDOW 52253 . 52446) (GETTICLIST 52448 . 53299) (HIGHLIGHTPLOTOBJECT 53301 . 53867) (
LABELPLOTOBJECT 53869 . 54213) (LOWLIGHTPLOTOBJECT 54215 . 54775) (MANUALRESCALE 54777 . 56455) (
MINSTREAMREGIONSIZE 56457 . 57803) (MOVEPLOTOBJECT 57805 . 58021) (OPENPLOTWINDOW 58023 . 62780) (
PLOT.BUTTONEVENTFN 62782 . 66193) (PLOT.CLOSEFN 66195 . 67538) (PLOT.FIXRIGHTMENU 67540 . 69053) (
PLOT.HARDCOPYFN 69055 . 71903) (PLOT.ICONFN 71905 . 74975) (PLOT.LABELTOWORLD 74977 . 75589) (
PLOT.REPAINTFN 75591 . 75862) (PLOT.RESET 75864 . 77305) (PLOT.SETUP 77307 . 78106) (
PLOT.SKETCH.CREATE 78108 . 79315) (PLOT.WHENSELECTEDFN 79317 . 80740) (PLOT.WORLDTOLABEL 80742 . 81292
) (PLOTADDMENUITEMS 81294 . 82103) (PLOTADDPROP 82105 . 82584) (PLOTAXISINTERVAL 82586 . 83543) (
PLOTDELMENUITEMS 83545 . 85001) (PLOTDELPROP 85003 . 85422) (PLOTLABEL 85424 . 86709) (PLOTMENU 86711
. 88791) (PLOTMENUITEMS 88793 . 90081) (PLOTOBJECTADDPROP 90083 . 90584) (PLOTOBJECTDELPROP 90586 .
91035) (PLOTOBJECTLABEL 91037 . 91895) (PLOTOBJECTPROP 91897 . 94339) (PLOTOBJECTPROPMACRO 94341 .
94978) (PLOTOBJECTSUBTYPE 94980 . 95156) (PLOTOPERROR 95158 . 95356) (PLOTPROMPT 95358 . 95582) (
PLOTPROP 95584 . 97181) (PLOTPROPMACRO 97183 . 98550) (PLOTREMPROP 98552 . 99654) (PLOTSCALEFN 99656
. 100601) (PLOTTICFN 100603 . 101542) (PLOTTICINFO 101544 . 102324) (PLOTTICMETHOD 102326 . 103408) (
PLOTTICS 103410 . 104429) (PRINTFONT 104431 . 104879) (PRINTMENU 104881 . 106302) (REDRAWPLOTWINDOW
106304 . 108486) (RELABELSELECTEDPLOTOBJECT 108488 . 109325) (RESCALEPLOT 109327 . 111400) (SCALE
111402 . 114203) (TOGGELLABEL 114205 . 114494) (TOGGLEEXTENDEDAXES 114496 . 115925) (TOGGLEFIXEDMENU
115927 . 116133) (TOGGLETICS 116135 . 116688) (TRANSLATEPLOTOBJECT 116690 . 117664) (
UNDELETEPLOTOBJECT 117666 . 119832) (UNLABELPLOTOBJECT 119834 . 120356) (WHICHLABEL 120358 . 120804) (
WHICHPLOT 120806 . 121310)) (130616 144446 (COPYPLOTOBJECT 130626 . 132869) (COPYPLOT 132871 . 136598)
(PLOTOBJECTPRINT 136600 . 137015) (PRINTPLOTOBJECT 137017 . 138282) (PRINTPLOT 138284 . 139644) (
READFONT 139646 . 140069) (READMENU 140071 . 141322) (READPLOTOBJECT 141324 . 142764) (READPLOT 142766
. 144444)) (144760 146659 (PLOT.EXP10 144770 . 144982) (PLOT.LOG10 144984 . 145249) (PLOT.FLOOR
145251 . 145578) (PLOT.CEILING 145580 . 145903) (SINEWAVE 145905 . 146657)) (146694 156057 (
CREATEPLOTIMAGEOBJ 146704 . 147280) (PLIO.BUTTONEVENTINFN 147282 . 150018) (PLIO.COPYFN 150020 .
150630) (PLIO.GETFN 150632 . 151198) (PLIO.PUTFN 151200 . 151643) (PLIO.REINSERTOBJ 151645 . 152657) (
PLOT.COPYBUTTONEVENTFN 152659 . 153488) (PLIO.DISPLAYFN 153490 . 154618) (PLIO.IMAGEBOXFN 154620 .
156055)))))
STOP