(FILECREATED " 4-Sep-85 15:46:31" {ERIS}<LISPUSERS>GKSEXTERN.;1 32316
changes to: (MACROS GKS.INQTBOX)
(VARS GKSEXTERNCOMS)
previous date: "29-May-85 12:48:41" {ERIS}<SHIH>F>CODE>GKSEXTERN.;1)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT GKSEXTERNCOMS)
(RPAQQ GKSEXTERNCOMS ((FNS GKS.BEGINGKS GKS.CLOSEGKS)
(FNS GKS.BEGINWORK GKS.CLOSEWORK)
(FNS GKS.ACTIVWORK GKS.DEACTWORK)
(FNS GKS.CLEARWORK GKS.UPDATWORK)
(FNS GKS.POLYLINE GKS.POLYMARK GKS.TEXT GKS.FILLAREA)
(FNS GKSFN.PLIN GKSFN.PMRK GKSFN.TEXT GKSFN.FILL)
(FNS GKS.INQSTATE GKS.ESCAPE)
(MACROS GKS.INQLEVEL)
(MACROS GKS.INQWKCN GKS.INQWKTR GKS.INQINDV GKS.INQCLIP GKS.INQNORM GKS.INQNNUM
GKS.INQTBOX GKS.INQSIZE GKS.INQLWST GKS.INQPLIN GKS.INQPMRK GKS.INQFILL)
(FNS GKS.SETLSTYLE GKS.SETLSCALE GKS.SETLCOLOR)
(FNS GKS.SETMSTYLE GKS.SETMSCALE GKS.SETMCOLOR)
(FNS GKS.SETFCOLOR GKS.SETFINNER)
(FNS GKS.SETTPTSIZ GKS.SETTUPDIR GKS.SETTALIGN GKS.SETTCOLOR)
(FNS GKS.SETCLIP GKS.SETTRNNUM GKS.SETWINDOW GKS.SETVWPORT GKS.SETWKWIND
GKS.SETWKVIEW)))
(DEFINEQ
(GKS.BEGINGKS
[LAMBDA (ERRFILE BUFFSIZ) (* edited: "17-May-85 13:07")
(PROG NIL
(if (NOT (EQ GKS.STATE (QUOTE GKCL)))
then (GKSFN.ERRN 1 (QUOTE GKS.BEGINGKS))
(RETURN NIL))
(SETQQ GKS.STATE GKOP)
(GKSFN.DSCRINIT)
(GKSFN.SLSTINIT)
(GKSFN.ELSTINIT)
(GKSFN.WDSCINIT)
(GKSFN.SETEFIELD EFILE ERRFILE)
(RETURN NIL])
(GKS.CLOSEGKS
[LAMBDA NIL (* FS "24-May-85 16:02")
(PROG NIL (* Close GKS. Not really meaningful here.
*)
(if (NOT (EQ GKS.STATE (QUOTE GKOP)))
then (GKSFN.ERRN 2 (QUOTE GKS.CLOSEGKS))
(RETURN NIL))
(SETQQ GKS.STATE GKCL])
)
(DEFINEQ
(GKS.BEGINWORK
[LAMBDA (WORK WIND TYPE) (* edited: " 8-May-85 16:49")
(PROG (FUNC OPEN)
(SETQQ FUNC GKS.BEGINWORK)
(if [NOT (MEMB GKS.STATE (QUOTE (GKOP WSOP WSAC SGOP]
then (GKSFN.ERRN 8 FUNC)
(RETURN NIL))
(SETQ OPEN (GKSFN.GETFIELD OPEN))
(if (MEMB WORK OPEN)
then (GKSFN.ERRN 24 FUNC)
(RETURN NIL))
(SETQQ GKS.STATE WSOP)
(GKSFN.SETFIELD OPEN (CONS WORK OPEN)) (* (with GKSTYP.SLST GKS.SLST
(SETQ OPEN (CONS WORK OPEN))))
(SET WORK (GKSFN.NEWWLST))
(GKSFN.SETWFIELD WORK CONN WIND)
(GKS.CLEARWORK WORK (QUOTE ALWAYS))
(RETURN NIL])
(GKS.CLOSEWORK
[LAMBDA (WORK) (* edited: " 8-May-85 16:45")
(PROG (FUNC)
(SETQQ FUNC GKS.CLOSEWORK)
(if [NOT (MEMB GKS.STATE (QUOTE (WSOP WSAC SGOP]
then (GKSFN.ERRN 7 FUNC)
(RETURN NIL))
(if (NOT (GKSFN.OPEN? WORK))
then (GKSFN.ERRN 25 FUNC)
(RETURN NIL))
(if (GKSFN.ACTV? WORK)
then (GKSFN.ERRN 29 FUNC)
(RETURN NIL))
(with GKSTYP.SLST GKS.SLST (SETQ OPEN (REMOVE WORK OPEN))
(if (NOT (LISTP OPEN))
then (SETQQ GKS.STATE GKOP)))
(RETURN NIL])
)
(DEFINEQ
(GKS.ACTIVWORK
[LAMBDA (WNAME) (* edited: " 8-May-85 16:33")
(PROG (FUNC)
(SETQQ FUNC GKS.ACTIVWORK)
(if [NOT (MEMB GKS.STATE (QUOTE (WSOP WSAC]
then (GKSFN.ERRN 6 FUNC)
(RETURN NIL))
(if (NOT (GKSFN.OPEN? WNAME))
then (GKSFN.ERRN 25 FUNC)
(RETURN NIL))
(if (GKSFN.ACTV? WNAME)
then (GKSFN.ERRN 29 FUNC)
(RETURN NIL))
(SETQQ GKS.STATE WSAC)
(with GKSTYP.SLST GKS.SLST (SETQ ACTV (CONS WNAME ACTV])
(GKS.DEACTWORK
[LAMBDA (WORK) (* FS "24-May-85 16:03")
(PROG (FUNC NADA)
(SETQQ FUNC GKS.DEACTWORK)
(if (NOT (EQ GKS.STATE (QUOTE WSAC)))
then (GKSFN.ERRN 3 FUNC)
(RETURN NIL))
(if (NOT (GKSFN.ACTV? WORK))
then (GKSFN.ERRN 30 FUNC)
(RETURN NIL))
(with GKSTYP.SLST GKS.SLST (SETQ ACTV (REMOVE WORK ACTV))
(if (NOT (LISTP ACTV))
then (SETQQ GKS.STATE WSOP)))
(RETURN NIL])
)
(DEFINEQ
(GKS.CLEARWORK
[LAMBDA (WORK CTRL) (* edited: "10-May-85 16:12")
(* * CLEAR WORKSTATION)
(PROG (FUNC)
(SETQQ FUNC GKS.CLEARWORK)
(if [NOT (MEMB GKS.STATE (QUOTE (WSOP WSAC]
then (GKSFN.ERRN 6 FUNC)
(RETURN NIL))
(* * HANDLE LIST OF WORKS *)
(if (EQ WORK NIL)
then (RETURN NIL))
(if (LISTP WORK)
then (GKS.CLEARWORK (CAR WORK)
CTRL)
(GKS.CLEARWORK (CDR WORK)
CTRL)
(RETURN NIL))
(* * MORE ERRORS *)
(if (NOT (MEMB WORK (GKSFN.GETFIELD OPEN)))
then (GKSFN.ERRN 25 FUNC)
(RETURN NIL))
(* * DO REAL WORK *)
(with GKSTYP.WLST (EVAL WORK)
(if (OR (EQUAL WEMPTY (QUOTE NOTEMPTY))
(EQUAL CTRL (QUOTE ALWAYS)))
then (DSPRESET CONN))
(if (EQUAL WTPEND (QUOTE PENDING))
then (SETQ CURRWN (COPY NEXTWN))
(SETQ CURRVW (COPY NEXTVW))
(SETQ WTPEND (QUOTE NOTPENDING))
(GKSFN.FIXCLIP WORK))
(SETQ WNEWFM (QUOTE NO))
(SETQ WEMPTY (QUOTE EMPTY)))
(RETURN NIL])
(GKS.UPDATWORK
[LAMBDA (WORK CTRL) (* edited: " 8-May-85 16:55")
(* * UPDATE WORKSTATION)
(PROG (FUNC)
(SETQQ FUNC GKS.UPDATWORK)
(if [NOT (MEMB GKS.STATE (QUOTE (WSOP WSAC SGOP]
then (GKSFN.ERRN 7 FUNC)
(RETURN NIL))
(* * HANDLE LIST OF WORKS *)
(if (LISTP WORK)
then (GKS.UPDATWORK (CAR WORK)
CTRL)
(if (NOT (EQ NIL (CDR WORK)))
then (GKS.UPDATWORK (CDR WORK)
CTRL))
(RETURN NIL))
(* * HANDLE MORE ERRORS *)
(if (NOT (GKSFN.OPEN? WORK))
then (GKSFN.ERRN 25 FUNC)
(RETURN NIL))
(* * DO REAL WORK HERE *)
(IF (AND (EQUAL CTRL (QUOTE PERFORM))
(EQUAL (GKSFN.GETWFIELD WORK WNEWFM)
(QUOTE YES)))
THEN (GKS.CLEARWORK WORK (QUOTE CONDITIONALLY))
ELSE (NILL))
(RETURN NIL])
)
(DEFINEQ
(GKS.POLYLINE
[LAMBDA (NPTS DATA) (* edited: " 8-May-85 16:49")
(PROG (FUNC)
(SETQQ FUNC GKS.POLYLINE)
(if [NOT (MEMB GKS.STATE (QUOTE (WSAC SGOP]
then (GKSFN.ERRN 5 FUNC)
(RETURN NIL))
(if (LESSP NPTS 0)
then (GKSFN.ERRN 100 FUNC)
(RETURN NIL))
[MAPC (GKSFN.GETFIELD ACTV)
(QUOTE (LAMBDA (WORKID)
(GKSFN.PLIN DATA WORKID]
(RETURN NIL])
(GKS.POLYMARK
[LAMBDA (NPTS DATA) (* edited: " 7-May-85 17:32")
(PROG (FUNC)
(SETQQ FUNC GKS.POLYMARK)
(if [NOT (MEMB GKS.STATE (QUOTE (WSAC SGOP]
then (GKSFN.ERRN 5 FUNC)
(RETURN NIL))
(if (LESSP NPTS 0)
then (GKSFN.ERRN 100 FUNC)
(RETURN NIL))
[MAPC (GKSFN.GETFIELD ACTV)
(QUOTE (LAMBDA (WORKID)
(GKSFN.PMRK DATA WORKID]
(RETURN NIL])
(GKS.TEXT
[LAMBDA (POS CHARS) (* edited: "24-Apr-85 15:45")
(* * comment)
(PROG (vars...)
(if [NOT (MEMB GKS.STATE (QUOTE (WSAC SGOP]
then (GKSFN.ERRN 5 (QUOTE GKS.TEXT))
(RETURN NIL))
[MAPC (GKSFN.GETFIELD ACTV)
(QUOTE (LAMBDA (WORKID)
(GKSFN.TEXT POS CHARS WORKID]
(RETURN NIL])
(GKS.FILLAREA
[LAMBDA (NPTS DATA) (* edited: " 8-May-85 16:47")
(* * CURRENT SUPPORT ONLY FOR HOLLOW FILL STYLE)
(PROG (FUNC)
(SETQQ FUNC GKS.FILLAREA)
(if [NOT (MEMB GKS.STATE (QUOTE (WSAC SGOP]
then (GKSFN.ERRN 5 FUNC)
(RETURN NIL))
(if (LESSP NPTS 0)
then (GKSFN.ERRN 100 FUNC)
(RETURN NIL))
[MAPC (GKSFN.GETFIELD ACTV)
(QUOTE (LAMBDA (WORKID)
(GKSFN.FILL DATA WORKID]
(RETURN NIL])
)
(DEFINEQ
(GKSFN.PLIN
[LAMBDA (KLIST WORK) (* edited: "16-May-85 15:13")
(PROG (ALIST A B SEG STRM LSCALE LSTYLE LBRUSH LDASHS)
(SETQ ALIST (MATFN.TRANLIST (GKSFN.GETWTOD WORK)
KLIST))
(SETQ STRM (GKSFN.GETWFIELD WORK CONN))
(GKSFN.SETWFIELD WORK WEMPTY (QUOTE NOTEMPTY))
(SETQ LSCALE (GKSFN.GETFIELD LSCALE))
(SETQ LSTYLE (GKSFN.GETFIELD LSTYLE))
(SETQ LDASHS (GKSFN.GETDASHS LSTYLE))
(SETQ LBRUSH (GKSFN.GETBRUSH LSCALE))
[SETQ SEG (QUOTE ((8.0 . 246.0)
(89.0 . 287.0]
(SETQ A (CAR SEG))
(SETQ B (CADR SEG))
(RPLACA B (CAAR ALIST))
(RPLACD B (CDAR ALIST))
(SETQ ALIST (CDR ALIST))
(while (NOT (EQUAL ALIST NIL))
do (RPLACA A (CAR B))
(RPLACD A (CDR B))
(RPLACA B (CAAR ALIST))
(RPLACD B (CDAR ALIST))
(DRAWCURVE SEG NIL LBRUSH LDASHS STRM)
(SETQ ALIST (CDR ALIST)))
(RETURN NIL])
(GKSFN.PMRK
[LAMBDA (ALIST WORK) (* edited: "16-May-85 15:13")
(* * THIS ROUTINE DRAWS A POLYMARKER ON A DISPLAY STREAM. NOT YET CLEANED UP, WHICH IS WHY IT IS CURRENTLY SO
INEFFICIENT)
(PROG (KLIST RADIUS STRM SHADE MCOLOR)
(SETQ KLIST (MATFN.TRANLIST (GKSFN.GETWTOD WORK)
ALIST))
(SETQ STRM (GKSFN.GETWFIELD WORK CONN))
(GKSFN.SETWFIELD WORK WEMPTY (QUOTE NOTEMPTY))
(SETQ RADIUS (GKSFN.GETFIELD MSCALE))
(SETQ MCOLOR (GKSFN.GETFIELD MCOLOR))
(SETQ SHADE (GKSFN.GETSHADE MCOLOR))
(while (NOT (EQUAL KLIST NIL))
do (FILLCIRCLE (CAAR KLIST)
(CDAR KLIST)
RADIUS SHADE STRM)
(SETQ KLIST (CDR KLIST)))
(RETURN NIL])
(GKSFN.TEXT
[LAMBDA (SPOS CHARS WORK) (* edited: "16-May-85 15:59")
(* * comment)
(PROG (POS STRM EXTENT X Y)
(SETQ POS (MATFN.TRAN2 (GKSFN.GETWTOD WORK)
(CAR SPOS)
(CDR SPOS)))
(SETQ STRM (GKSFN.GETWFIELD WORK CONN))
(GKSFN.SETWFIELD WORK WEMPTY (QUOTE NOTEMPTY))
(MOVETO (CAR POS)
(CDR POS)
STRM)
(SETQ EXTENT (STRINGREGION CHARS STRM NIL NIL))
(SETQ X (fetch (REGION LEFT) of EXTENT))
(SETQ Y (fetch (REGION WIDTH) of EXTENT))
(SETQ X (DIFFERENCE X (QUOTIENT Y 2)))
(SETQ Y (fetch (REGION BOTTOM) of EXTENT))
(MOVETO X Y STRM)
(printout STRM CHARS)
(RETURN NIL])
(GKSFN.FILL
[LAMBDA (ALIST WORK) (* edited: "16-May-85 15:24")
(PROG (BLIST A B SEG STRM LSCALE LSTYLE LDASHS LBRUSH HEAD)
(SETQ BLIST (MATFN.TRANLIST (GKSFN.GETWTOD WORK)
ALIST))
(SETQ STRM (GKSFN.GETWFIELD WORK CONN))
(GKSFN.SETWFIELD WORK WEMPTY (QUOTE NOTEMPTY))
(SETQ LSCALE 1)
(SETQ LSTYLE NIL)
(SETQ LDASHS (GKSFN.GETDASHS LSTYLE))
(SETQ LBRUSH (GKSFN.GETBRUSH LSCALE))
[SETQ SEG (QUOTE ((296.0 . 123.0)
(275.0 . 22.0]
(SETQ A (CAR SEG))
(SETQ B (CADR SEG))
(RPLACA B (CAAR BLIST))
(RPLACD B (CDAR BLIST))
(SETQ HEAD BLIST)
(SETQ BLIST (CDR BLIST))
(while (NOT (EQUAL BLIST NIL))
do (RPLACA A (CAR B))
(RPLACD A (CDR B))
(RPLACA B (CAAR BLIST))
(RPLACD B (CDAR BLIST))
(DRAWCURVE SEG NIL LBRUSH LDASHS STRM)
(SETQ BLIST (CDR BLIST)))
(RPLACA A (CAR B))
(RPLACD A (CDR B))
(RPLACA B (CAAR HEAD))
(RPLACD B (CDAR HEAD))
(DRAWCURVE SEG NIL LBRUSH LDASHS STRM)
(RETURN NIL])
)
(DEFINEQ
(GKS.INQSTATE
[LAMBDA NIL (* FS "22-Apr-85 17:26")
(* * comment)
(PROG NIL
(RETURN GKS.STATE])
(GKS.ESCAPE
[LAMBDA (FNID DATUM) (* edited: " 7-May-85 17:29")
(* * REQUISITE STUB)
(PROG (FUNC)
(SETQQ FUNC GKS.ESCAPE)
(if [NOT (MEMB GKS.STATE (QUOTE (GKOP WSOP WSAC SGOP]
then (GKSFN.ERRN 8 FUNC)
(RETURN NIL))
(GKSFN.ERRN 180 FUNC)
(RETURN NIL])
)
(DECLARE: EVAL@COMPILE
[PUTPROPS GKS.INQLEVEL DMACRO ((ERRN LVEL)
(SETQ LVEL (GKSFN.GETDFIELD LEVL))
(IF [NOT (MEMB GKS.STATE (QUOTE (GKOP WSOP WSAC SGOP]
THEN
(SETQ ERRN 8)
ELSE
(SETQ ERRN 0]
)
(DECLARE: EVAL@COMPILE
[PUTPROPS GKS.INQWKCN DMACRO ((WORK ERRN CONN TYPE)
(PROG (RESULT)
(SETQ RESULT (GKSFN.INQWKCN WORK))
(SETQ ERRN (CAR RESULT))
(SETQ CONN (CADR RESULT))
(SETQ TYPE (CADDR RESULT))
(RETURN NIL]
[PUTPROPS GKS.INQWKTR DMACRO
((WORK ERRN UPDATE RWXMIN RWXMAX RWYMIN RWYMAX CWXMIN CWXMAX CWYMIN CWYMAX RVXMIN RVXMAX
RVYMIN RVYMAX CVXMIN CVXMAX CVYMIN CVYMAX)
(IF [NOT (MEMB GKS.STATE (QUOTE (WSOP WSAC SGOP]
THEN
(SETQ ERRN 8)
ELSEIF
(NOT (GKSFN.OPEN? WORK))
THEN
(SETQ ERRN 25)
ELSE
(WITH GKSTYP.WLST (EVAL WORK)
(WITH GKSTYP.RECT NEXTWN (RWXMIN ← XMIN)
(RWXMAX ← XMAX)
(RWYMIN ← YMIN)
(RWYMAX ← YMAX))
(WITH GKSTYP.RECT CURRWN (CWXMIN ← XMIN)
(CWXMAX ← XMAX)
(CWYMIN ← YMIN)
(CWYMAX ← YMAX))
(WITH GKSTYP.RECT NEXTVW (RVXMIN ← XMIN)
(RVXMAX ← XMAX)
(RVYMIN ← YMIN)
(RVYMAX ← YMAX))
(WITH GKSTYP.RECT CURRVW (CVXMIN ← XMIN)
(CVXMAX ← XMAX)
(CVYMIN ← YMIN)
(CVYMAX ← YMAX)))
(SETQ ERRN 0]
[PUTPROPS GKS.INQINDV DMACRO ((ERRN OLSTYLE OLSCALE OLCOLOR OMSTYLE OMSCALE OMCOLOR OFINNER OFSTYLE
OFCOLOR)
(IF [NOT (MEMB GKS.STATE (QUOTE (GKOP WSOP WSAC SGOP]
THEN
(SETQ ERRN 8)
ELSE
(SETQ ERRN 0)
(SETQ OLSTYLE (GKSFN.GETFIELD LSTYLE))
(SETQ OLSCALE (GKSFN.GETFIELD LSCALE))
(SETQ OLCOLOR (GKSFN.GETFIELD LCOLOR))
(SETQ OMSTYLE (GKSFN.GETFIELD MSTYLE))
(SETQ OMSCALE (GKSFN.GETFIELD MSCALE))
(SETQ OMCOLOR (GKSFN.GETFIELD MCOLOR))
(SETQ OFINNER (GKSFN.GETFIELD FINNER))
(SETQ OFSTYLE (GKSFN.GETFIELD FSTYLE))
(SETQ OFCOLOR (GKSFN.GETFIELD FCOLOR]
[PUTPROPS GKS.INQCLIP DMACRO ((ERRN OCLIP)
(IF [NOT (MEMB GKS.STATE (QUOTE (GKOP WSOP WSAC SGOP]
THEN
(SETQ ERRN 8)
ELSE
(SETQ ERRN 0)
(SETQ OCLIP (GKSFN.GETFIELD CLIP]
[PUTPROPS GKS.INQNORM DMACRO ((NORMNUM ERRN WXMIN WXMAX WYMIN WYMAX VXMIN VXMAX VYMIN VYMAX)
(IF [NOT (MEMB GKS.STATE (QUOTE (GKOP WSOP WSAC SGOP]
THEN
(SETQ ERRN 8)
ELSEIF
(OR (NORMNUM < 0)
(NORMNUM > (GKSFN.GETDFIELD MAXTRAN)))
THEN
(SETQ ERRN 50)
ELSE
(WITH GKSTYP.NORM (GKSFN.GETNORM NORMNUM)
(WITH GKSTYP.RECT WIND (WXMIN ← XMIN)
(WXMAX ← XMAX)
(WYMIN ← YMIN)
(WYMAX ← YMAX))
(WITH GKSTYP.RECT VIEW (VXMIN ← XMIN)
(VXMAX ← XMAX)
(VYMIN ← YMIN)
(VYMAX ← YMAX)))
(SETQ ERRN 0]
[PUTPROPS GKS.INQNNUM DMACRO ((ERRN NORMNUM)
(IF [NOT (MEMB GKS.STATE (QUOTE (GKOP WSOP WSAC SGOP]
THEN
(SETQ ERRN 8)
ELSE
(SETQ ERRN 0)
(SETQ NORMNUM (GKSFN.GETFIELD NNUM]
[PUTPROPS GKS.INQTBOX DMACRO ((WORK POS CHARS ERRN CONC AREA)
(IF [NOT (MEMB GKS.STATE (QUOTE (WSOP WSAC SGOP]
THEN
(SETQ ERRN 7)
ELSEIF
(NOT (MEMB WORK (GKSFN.GETFIELD ACTV)))
THEN
(SETQ ERRN 25)
ELSE
(SETQ ERRN 0)
(MOVETO (CAR POS)
(CDR POS)
(GKSFN.GETWFIELD WORK CONN))
(SETQ AREA (STRINGREGION CHARS (GKSFN.GETWFIELD WORK CONN)
NIL NIL))
(SETQ CONC POS]
[PUTPROPS GKS.INQSIZE DMACRO ((WTYPE ERRN UNITS UNITSIZE RASTSIZE)
(SETQ ERRN 0)
(SETQ UNITS (GKSFN.GETIFIELD WTYPE DEVUNITS))
(SETQ UNITSIZE (GKSFN.GETIFIELD WTYPE UNITSIZE))
(SETQ RASTSIZE (GKSFN.GETIFIELD WTYPE RASTSIZE]
[PUTPROPS GKS.INQLWST DMACRO ((WTYPE ERRN MXLBUN MXMBUN MXTBUN MXFBUN MXPATT MXCLOR)
(IF [NOT (MEMB GKS.STATE (QUOTE (GKOP WSOP WSAC SGOP]
THEN
(SETQ ERRN 8)
ELSE
(SETQ ERRN 0)
(SETQ MXLBUN 0)
(SETQ MXMBUN 0)
(SETQ MXTBUN 0)
(SETQ MXFBUN 0)
(SETQ MXCLOR 2]
[PUTPROPS GKS.INQPLIN DMACRO ((WTYPE ERRN NLTYPE LLTYPE NLSCAL NOMLNW MINLNW MAXLNW NMPBUN)
(IF [NOT (MEMB GKS.STATE (QUOTE (GKOP WSOP WSAC SGOP]
THEN
(SETQ ERRN 8)
ELSE
(SETQ ERRN 0)
(SETQ NLTYPE (GKSFN.GETIFIELD WTYPE LTYPES))
(SETQ LLTYPE NIL)
(SETQ NLSCAL (GKSFN.GETIFIELD WTYPE LSIZES))
(SETQ NOMLNW (GKSFN.GETIFIELD WTYPE LNOMSZ))
(SETQ MINLNW (GKSFN.GETIFIELD WTYPE LMINSZ))
(SETQ MAXLNW (GKSFN.GETIFIELD WTYPE LMAXSZ))
(SETQ NMPBUN (GKSFN.GETIFIELD WTYPE LBUNDS]
[PUTPROPS GKS.INQPMRK DMACRO ((WTYPE ERRN NMTYPE LMTYPE NMSCAL NOMMKW MINMKW MAXMKW NMMBUN)
(IF [NOT (MEMB GKS.STATE (QUOTE (GKOP WSOP WSAC SGOP]
THEN
(SETQ ERRN 8)
ELSE
(SETQ ERRN 0)
(SETQ NMTYPE (GKSFN.GETIFIELD WTYPE MTYPES))
(SETQ LMTYPE NIL)
(SETQ NMSCAL (GKSFN.GETIFIELD WTYPE MSIZES))
(SETQ NOMMKW (GKSFN.GETIFIELD WTYPE MNOMSZ))
(SETQ MINMKW (GKSFN.GETIFIELD WTYPE MMINSZ))
(SETQ MAXMKW (GKSFN.GETIFIELD WTYPE MMAXSZ))
(SETQ NMMBUN (GKSFN.GETIFIELD WTYPE MBUNDS]
[PUTPROPS GKS.INQFILL DMACRO ((WTYPE ERRN NINNER LINNER NTYPES LTYPES NUMBUN)
(IF [NOT (MEMB GKS.STATE (QUOTE (GKOP WSOP WSAC SGOP]
THEN
(SETQ ERRN 8)
ELSE
(SETQ ERRN 0)
(SETQ NINNER (GKSFN.GETIFIELD WTYPE FOPAQS))
(SETQ LINNER NIL)
(SETQ NTYPES (GKSFN.GETIFIELD WTYPE FTYPES))
(SETQ LTYPES NIL)
(SETQ NUMBUN (GKSFN.GETIFIELD WTYPE FBUNDS]
)
(DEFINEQ
(GKS.SETLSTYLE
[LAMBDA (NEWVAL) (* edited: "24-Apr-85 18:30")
(* * comment)
(PROG NIL
(if [NOT (MEMB GKS.STATE (QUOTE (GKOP WSOP WSAC SGOP]
then (GKSFN.ERRN 8 (QUOTE GKS.SETLSTYLE))
(RETURN NIL))
(if (LEQ NEWVAL 0)
then (GKSFN.ERRN 62 (QUOTE GKS.SETLSTYLE))
(RETURN NIL))
(GKSFN.SETFIELD LSTYLE NEWVAL)
(RETURN NIL])
(GKS.SETLSCALE
[LAMBDA (NEWVAL) (* edited: "24-Apr-85 18:31")
(* * comment)
(PROG NIL
(if [NOT (MEMB GKS.STATE (QUOTE (GKOP WSOP WSAC SGOP]
then (GKSFN.ERRN 8 (QUOTE GKS.SETLSCALE))
(RETURN NIL))
(if (LEQ NEWVAL 0)
then (GKSFN.ERRN 90 (QUOTE GKS.SETLSCALE))
(RETURN NIL))
(GKSFN.SETFIELD LSCALE NEWVAL)
(RETURN NIL])
(GKS.SETLCOLOR
[LAMBDA (NEWVAL) (* edited: "24-Apr-85 18:29")
(* * comment)
(PROG NIL
(IF [NOT (MEMB GKS.STATE (QUOTE (GKOP WSOP WSAC SGOP]
THEN (GKSFN.ERRN 8 (QUOTE GKS.SETLCOLOR))
(RETURN NIL))
(IF (NEWVAL LE 0)
THEN (GKSFN.ERRN 85 (QUOTE GKS.SETLCOLOR))
(RETURN NIL))
(GKSFN.SETFIELD LCOLOR NEWVAL)
(RETURN NIL])
)
(DEFINEQ
(GKS.SETMSTYLE
[LAMBDA (NEWVAL) (* edited: "24-Apr-85 18:31")
(* * comment)
(PROG NIL
(if [NOT (MEMB GKS.STATE (QUOTE (GKOP WSOP WSAC SGOP]
then (GKSFN.ERRN 8 (QUOTE GKS.SETMSTYLE))
(RETURN NIL))
(if (LEQ NEWVAL 0)
then (GKSFN.ERRN 66 (QUOTE GKS.SETMSTYLE))
(RETURN NIL))
(GKSFN.SETFIELD MSTYLE NEWVAL)
(RETURN NIL])
(GKS.SETMSCALE
[LAMBDA (NEWVAL) (* edited: "24-Apr-85 18:32")
(* * comment)
(PROG NIL
(if [NOT (MEMB GKS.STATE (QUOTE (GKOP WSOP WSAC SGOP]
then (GKSFN.ERRN 8 (QUOTE GKS.SETMSCALE))
(RETURN NIL))
(if (LEQ NEWVAL 0)
then (GKSFN.ERRN 90 (QUOTE GKS.SETMSCALE))
(RETURN NIL))
(GKSFN.SETFIELD MSCALE NEWVAL)
(RETURN NIL])
(GKS.SETMCOLOR
[LAMBDA (NEWVAL) (* edited: "24-Apr-85 18:29")
(* * comment)
(PROG NIL
(if [NOT (MEMB GKS.STATE (QUOTE (GKOP WSOP WSAC SGOP]
then (GKSFN.ERRN 8 (QUOTE GKS.SETMCOLOR))
(RETURN NIL))
(if (LEQ NEWVAL 0)
then (GKSFN.ERRN 85 (QUOTE GKS.SETMCOLOR))
(RETURN NIL))
(GKSFN.SETFIELD MCOLOR NEWVAL)
(RETURN NIL])
)
(DEFINEQ
(GKS.SETFCOLOR
[LAMBDA (NEWVAL) (* edited: "24-Apr-85 18:28")
(* * comment)
(PROG NIL
(IF [NOT (MEMB GKS.STATE (QUOTE (GKOP WSOP WSAC SGOP]
THEN (GKSFN.ERRN 8 (QUOTE GKS.SETFCOLOR))
(RETURN NIL))
(IF (NEWVAL LE 0)
THEN (GKSFN.ERRN 85 (QUOTE GKS.SETFCOLOR))
(RETURN NIL))
(GKSFN.SETFIELD FCOLOR NEWVAL)
(RETURN NIL])
(GKS.SETFINNER
[LAMBDA (NEWVAL) (* edited: "24-Apr-85 18:40")
(* * comment)
(PROG NIL
(IF [NOT (MEMB GKS.STATE (QUOTE (GKOP WSOP WSAC SGOP]
THEN (GKSFN.ERRN 8 (QUOTE GKS.SETFINNER))
(RETURN NIL))
(IF [NOT (MEMB NEWVAL (QUOTE (HOLLOW SOLID PATTERN HATCH]
THEN (GKSFN.ERRN 85 (QUOTE GKS.SETFINNER))
(RETURN NIL))
(GKSFN.SETFIELD FINNER NEWVAL)
(RETURN NIL])
)
(DEFINEQ
(GKS.SETTPTSIZ
[LAMBDA (NEWVAL) (* edited: " 7-May-85 17:34")
(* * SET CHARACTER HEIGHT)
(PROG (FUNC)
(SETQQ FUNC GKS.SETTPTSIZ)
(if [NOT (MEMB GKS.STATE (QUOTE (GKOP WSOP WSAC SGOP]
then (GKSFN.ERRN 8 FUNC)
(RETURN NIL))
(if (LEQ NEWVAL 0)
then (GKSFN.ERRN 73 FUNC)
(RETURN NIL))
(GKSFN.SETFIELD TPTSIZ NEWVAL)
(RETURN NIL])
(GKS.SETTUPDIR
[LAMBDA (NEWVAL) (* edited: " 7-May-85 17:34")
(* * SET CHARACTER HEIGHT)
(PROG (FUNC)
(SETQQ FUNC GKS.SETTUPDIR)
(if [NOT (MEMB GKS.STATE (QUOTE (GKOP WSOP WSAC SGOP]
then (GKSFN.ERRN 8 FUNC)
(RETURN NIL))
(if (AND (EQ 0 (CAR NEWVAL))
(EQ 0 (CDR NEWVAL)))
then (GKSFN.ERRN 74 FUNC)
(RETURN NIL))
(GKSFN.SETFIELD TUPDIR NEWVAL)
(RETURN NIL])
(GKS.SETTALIGN
[LAMBDA (NEWVAL) (* edited: "25-Apr-85 14:33")
(* * SET CHARACTER HEIGHT)
(PROG NIL
(if [NOT (MEMB GKS.STATE (QUOTE (GKOP WSOP WSAC SGOP]
then (GKSFN.ERRN 8 (QUOTE GKS.SETTALIGN))
(RETURN NIL))
(if [OR [NOT (MEMB (CAR NEWVAL)
(QUOTE (NORMAL LEFT CENTRE RIGHT]
(NOT (MEMB (CDR NEWVAL)
(QUOTE (NORMAL TOP CAP HALF BASE BOTTOM]
then (GKSFN.ERRN 73 (QUOTE GKS.SETTALIGN))
(RETURN NIL))
(GKSFN.SETFIELD TALIGN NEWVAL)
(RETURN NIL])
(GKS.SETTCOLOR
[LAMBDA (NEWVAL) (* edited: "25-Apr-85 14:37")
(* * comment)
(PROG NIL
(if [NOT (MEMB GKS.STATE (QUOTE (GKOP WSOP WSAC SGOP]
then (GKSFN.ERRN 8 (QUOTE GKS.SETTCOLOR))
(RETURN NIL))
(if (LEQ NEWVAL 0)
then (GKSFN.ERRN 85 (QUOTE GKS.SETTCOLOR))
(RETURN NIL))
(GKSFN.SETFIELD TCOLOR NEWVAL)
(RETURN NIL])
)
(DEFINEQ
(GKS.SETCLIP
[LAMBDA (NEWVAL) (* edited: "10-May-85 16:17")
(* * comment)
(PROG (FUNC)
(SETQQ FUNC GKS.SETCLIP)
(if [NOT (MEMB GKS.STATE (QUOTE (GKOP WSOP WSAC SGOP]
then (GKSFN.ERRN 8 FUNC)
(RETURN NIL))
(if [NOT (MEMB NEWVAL (QUOTE (CLIP NOCLIP]
then (GKSFN.ERRN 85 FUNC)
(RETURN NIL))
(GKSFN.SETFIELD CLIP NEWVAL)
(GKSFN.FIXCLIP (GKSFN.GETFIELD ACTV))
(RETURN NIL])
(GKS.SETTRNNUM
[LAMBDA (TNUM XMIN XMAX YMIN YMAX) (* edited: " 7-May-85 17:33")
(* * comment)
(PROG (FUNC)
(SETQQ FUNC GKS.SETTRNNUM)
(if [NOT (MEMB GKS.STATE (QUOTE (GKOP WSOP WSAC SGOP]
then (GKSFN.ERRN 8 FUNC)
(RETURN NIL))
(if (OR (LESSP TNUM 0)
(GREATERP TNUM (GKSFN.GETDFIELD MAXTRAN)))
then (GKSFN.ERRN 50 FUNC)
(RETURN NIL))
(GKSFN.SETFIELD NNUM TNUM)
(RETURN NIL])
(GKS.SETWINDOW
[LAMBDA (TNUM IXMIN IXMAX IYMIN IYMAX) (* edited: " 7-May-85 17:41")
(* * comment)
(PROG (FUNC NORM)
(SETQQ FUNC GKS.SETWINDOW)
(if [NOT (MEMB GKS.STATE (QUOTE (GKOP WSOP WSAC SGOP]
then (GKSFN.ERRN 8 FUNC)
(RETURN NIL))
(if (OR (LESSP TNUM 1)
(GREATERP TNUM (GKSFN.GETDFIELD MAXTRAN)))
then (GKSFN.ERRN 50 FUNC)
(RETURN NIL))
(if (OR (LESSP IXMAX IXMIN)
(LESSP IYMAX IYMIN))
then (GKSFN.ERRN 51 FUNC)
(RETURN NIL))
(SETQ NORM (GKSFN.GETNORM TNUM))
(with GKSTYP.NORM NORM
(SETQ WIND (create GKSTYP.RECT
XMIN ← IXMIN
XMAX ← IXMAX
YMIN ← IYMIN
YMAX ← IYMAX)))
(RETURN NIL])
(GKS.SETVWPORT
[LAMBDA (TNUM XMIN XMAX YMIN YMAX) (* edited: "10-May-85 16:17")
(* * comment)
(PROG (FUNC NORM)
(SETQQ FUNC GKS.SETVWPORT)
(if [NOT (MEMB GKS.STATE (QUOTE (GKOP WSOP WSAC SGOP]
then (GKSFN.ERRN 8 FUNC)
(RETURN NIL))
(if (OR (LESSP TNUM 1)
(GREATERP TNUM (GKSFN.GETDFIELD MAXTRAN)))
then (GKSFN.ERRN 50 FUNC)
(RETURN NIL))
(if (OR (LESSP XMAX XMIN)
(LESSP YMAX YMIN))
then (GKSFN.ERRN 51 FUNC)
(RETURN NIL))
(if (OR (LESSP XMIN 0)
(GREATERP XMAX 1)
(LESSP YMIN 0)
(GREATERP YMAX 1))
then (GKSFN.ERRN 52 FUNC)
(RETURN NIL))
(SETQ NORM (GKSFN.GETNORM TNUM))
(with GKSTYP.NORM NORM
(SETQ VIEW (create GKSTYP.RECT
XMIN ← XMIN
XMAX ← XMAX
YMIN ← YMIN
YMAX ← YMAX)))
(GKSFN.FIXCLIP (GKSFN.GETFIELD ACTV))
(RETURN NIL])
(GKS.SETWKWIND
[LAMBDA (WORK IXMIN IXMAX IYMIN IYMAX) (* edited: "10-May-85 16:15")
(* * comment)
(PROG (RECT FUNC)
(SETQQ FUNC GKS.SETWKWIND)
(* * HANDLE ERRORS *)
(if [NOT (MEMB GKS.STATE (QUOTE (WSOP WSAC SGOP]
then (GKSFN.ERRN 7 FUNC)
(RETURN NIL))
(if (NOT (GKSFN.OPEN? WORK))
then (GKSFN.ERRN 25 FUNC)
(RETURN NIL))
(if (OR (LESSP IXMAX IXMIN)
(LESSP IYMAX IYMIN))
then (GKSFN.ERRN 51 FUNC)
(RETURN NIL))
(if (OR (LESSP IXMIN 0)
(GREATERP IXMAX 1)
(LESSP IYMIN 0)
(GREATERP IYMAX 1))
then (GKSFN.ERRN 53 FUNC)
(RETURN NIL))
(* * DO REAL WORK *)
(with GKSTYP.WLST (EVAL WORK)
(if (EQ WEMPTY (QUOTE EMPTY))
then (SETQ RECT CURRWN)
(SETQ WTPEND (QUOTE NOTPENDING))
else (SETQ RECT NEXTWN)
(SETQ WTPEND (QUOTE PENDING)))
(with GKSTYP.RECT RECT (SETQ XMIN IXMIN)
(SETQ XMAX IXMAX)
(SETQ YMIN IYMIN)
(SETQ YMAX IYMAX))
(GKSFN.FIXCLIP WORK))
(RETURN NIL])
(GKS.SETWKVIEW
[LAMBDA (WORK IXMIN IXMAX IYMIN IYMAX) (* edited: "10-May-85 16:15")
(* * comment)
(PROG (RECT FUNC)
(SETQQ FUNC GKS.SETWKVIEW)
(* * HANDLE ERRORS *)
(if [NOT (MEMB GKS.STATE (QUOTE (WSOP WSAC SGOP]
then (GKSFN.ERRN 7 FUNC)
(RETURN NIL))
(if (NOT (GKSFN.OPEN? WORK))
then (GKSFN.ERRN 25 FUNC)
(RETURN NIL))
(if (OR (LESSP IXMAX IXMIN)
(LESSP IYMAX IYMIN))
then (GKSFN.ERRN 51 FUNC)
(RETURN NIL))
(if (OR (LESSP IXMIN 0)
(GREATERP IXMAX 9999)
(LESSP IYMIN 0)
(GREATERP IYMAX 9999))
then (GKSFN.ERRN 54 FUNC)
(RETURN NIL))
(* * DO REAL WORK *)
(with GKSTYP.WLST (EVAL WORK)
(if (EQ WEMPTY (QUOTE EMPTY))
then (SETQ RECT CURRVW)
(SETQ WTPEND (QUOTE NOTPENDING))
else (SETQ RECT NEXTVW)
(SETQ WTPEND (QUOTE PENDING)))
(with GKSTYP.RECT RECT (SETQ XMIN IXMIN)
(SETQ XMAX IXMAX)
(SETQ YMIN IYMIN)
(SETQ YMAX IYMAX))
(GKSFN.FIXCLIP WORK))
(RETURN NIL])
)
(PUTPROPS GKSEXTERN COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1194 2114 (GKS.BEGINGKS 1204 . 1692) (GKS.CLOSEGKS 1694 . 2112)) (2115 3647 (
GKS.BEGINWORK 2125 . 2941) (GKS.CLOSEWORK 2943 . 3645)) (3648 4882 (GKS.ACTIVWORK 3658 . 4284) (
GKS.DEACTWORK 4286 . 4880)) (4883 7308 (GKS.CLEARWORK 4893 . 6221) (GKS.UPDATWORK 6223 . 7306)) (7309
9462 (GKS.POLYLINE 7319 . 7858) (GKS.POLYMARK 7860 . 8399) (GKS.TEXT 8401 . 8853) (GKS.FILLAREA 8855
. 9460)) (9463 13725 (GKSFN.PLIN 9473 . 10624) (GKSFN.PMRK 10626 . 11495) (GKSFN.TEXT 11497 . 12364)
(GKSFN.FILL 12366 . 13723)) (13726 14336 (GKS.INQSTATE 13736 . 13926) (GKS.ESCAPE 13928 . 14334)) (
19982 21524 (GKS.SETLSTYLE 19992 . 20501) (GKS.SETLSCALE 20503 . 21012) (GKS.SETLCOLOR 21014 . 21522))
(21525 23068 (GKS.SETMSTYLE 21535 . 22044) (GKS.SETMSCALE 22046 . 22555) (GKS.SETMCOLOR 22557 . 23066
)) (23069 24147 (GKS.SETFCOLOR 23079 . 23587) (GKS.SETFINNER 23589 . 24145)) (24148 26461 (
GKS.SETTPTSIZ 24158 . 24682) (GKS.SETTUPDIR 24684 . 25260) (GKS.SETTALIGN 25262 . 25948) (
GKS.SETTCOLOR 25950 . 26459)) (26462 32236 (GKS.SETCLIP 26472 . 27057) (GKS.SETTRNNUM 27059 . 27625) (
GKS.SETWINDOW 27627 . 28508) (GKS.SETVWPORT 28510 . 29612) (GKS.SETWKWIND 29614 . 30920) (
GKS.SETWKVIEW 30922 . 32234)))))
STOP