(FILECREATED "13-Nov-85 17:32:54" {ERIS}<IRIS>KOTO>IRISSTREAM.;10 57695
changes to: (FNS \DRAWPOLYGON.IRIS \RESET.IRIS \FONTSAVAILABLE.IRIS)
(VARS IRISSTREAMCOMS)
previous date: "12-Nov-85 23:20:23" {ERIS}<IRIS>KOTO>IRISSTREAM.;8)
(PRETTYCOMPRINT IRISSTREAMCOMS)
(RPAQQ IRISSTREAMCOMS ((FILES SFFONT COLOR)
[ADDVARS (IMAGESTREAMTYPES (IRIS (OPENSTREAM OPENIRISSTREAM)
(FONTCREATE \FONTCREATE.IRIS)
(FONTSAVAILABLE \FONTSAVAILABLE.IRIS)
(CREATECHARSET \CREATECHARSET.IRIS]
(GLOBALVARS \IRIS.VERBOSE IRISNSHOSTNUMBER)
[INITVARS (\IRIS.VERBOSE T)
(IRISFONTDIRECTORIES (QUOTE {ERIS}<IRIS>SF>))
(\CHARSEGMENTS.IRIS 10)
(\IRIS.VERSION (QUOTE GL2))
(\IRIS.BITPLANES 4)
(IRISFONTFAMILIES (QUOTE (GACHA TIMESROMAN)))
(IRISFONTROTATIONS (QUOTE (0)))
(IRISFONTSIZES (QUOTE (8 10 12 14 18 24]
(VARS ZAXIS \BEZIERBASIS.IRIS (\IRISSTREAMS NIL)
\IRIS.DEBUG \IRISCOLORMAPCACHE)
(FNS BOXSCREEN CLEARIRIS DRAWBITMAP IRISBITMAP FILLPOLYGON INSTALL.OBJFONT OPENIRISSTREAM
\CLOSEF.IRIS R SPPINPUTSTREAM TRYGRAPHER \BACKCOLOR.IRIS \BITBLT.IRIS \BLTSHADE.IRIS
\FONTCREATE.IRIS \FONTSAVAILABLE.IRIS \LEFTMARGIN.IRIS \RESET.IRIS \LOOKUPRGB
\PSPLINE.TO.BEZIER.GEOMETRY \SCALE.IRIS \SCALE.SPLINE.BY.DERIVS \STRINGWIDTH.IRIS
\TERPRI.IRIS \FONT.IRIS \CREATECHARSET.IRIS \IRISSETFONTBASE \IRISFONTBASE
\CHANGECHARSET.IRIS \CHARWIDTH.IRIS \OUTCHARFN.IRIS \CLIPPINGREGION.IRIS \CLOSEFN.IRIS
\COLOR.IRIS \IRIS.ASSURE.COLOR \DRAWCIRCLE.IRIS \DRAWCURVE.IRIS \DRAWLINE.IRIS
\CONVERTLINESTYLE.IRIS \IRISSTREAMINIT \MOVETO.IRIS \XPOSITION.IRIS \YPOSITION.IRIS
\FILLCIRCLE.IRIS \DRAWELLIPSE.IRIS \FILLPOLYGON.IRIS \IRIS.BITBLT \DRAWPOLYGON.IRIS
ALIGN)
(* * test functions)
[DECLARE: EVAL@LOAD DONTCOPY (P (LOADDEF (QUOTE SPLINE)
(QUOTE RECORD)
(QUOTE ADISPLAY]
(RECORDS BEZIER IRISDATA IRISSTREAM SPLINE)
(CONSTANTS (\ALTLINESTYLE.IRIS 1)
(\IRIS.ITALICS.ROTATION -100)
(\PRIMARYLINESTLE.IRIS 0)
(\IRIS.BOLD.LINEWIDTH 2))
[P (\IRISSTREAMINIT)
(SETFONTCLASSCOMPONENT DEFAULTFONT (QUOTE IRIS)
(QUOTE (GACHA 12]
[ADDVARS (DEFAULTPRINTINGHOST (IRIS Iris))
(PRINTERTYPES (IRIS (CANPRINT (IRIS))
(BITMAPFILE (IRISBITMAP FILE BITMAP SCALEFACTOR REGION ROTATION
TITLE]
(P (PUTPROP (QUOTE Iris)
(QUOTE PRINTERTYPE)
(QUOTE IRIS)))
(PROP PRINTERTYPE Iris)
(MACROS WITH.IRIS.ATTR)))
(FILESLOAD SFFONT COLOR)
(ADDTOVAR IMAGESTREAMTYPES (IRIS (OPENSTREAM OPENIRISSTREAM)
(FONTCREATE \FONTCREATE.IRIS)
(FONTSAVAILABLE \FONTSAVAILABLE.IRIS)
(CREATECHARSET \CREATECHARSET.IRIS)))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \IRIS.VERBOSE IRISNSHOSTNUMBER)
)
(RPAQ? \IRIS.VERBOSE T)
(RPAQ? IRISFONTDIRECTORIES (QUOTE {ERIS}<IRIS>SF>))
(RPAQ? \CHARSEGMENTS.IRIS 10)
(RPAQ? \IRIS.VERSION (QUOTE GL2))
(RPAQ? \IRIS.BITPLANES 4)
(RPAQ? IRISFONTFAMILIES (QUOTE (GACHA TIMESROMAN)))
(RPAQ? IRISFONTROTATIONS (QUOTE (0)))
(RPAQ? IRISFONTSIZES (QUOTE (8 10 12 14 18 24)))
(RPAQQ ZAXIS 90)
(RPAQQ \BEZIERBASIS.IRIS ((-1.0 3.0 -3.0 1.0)
(3.0 -6.0 3.0 0.0)
(-3.0 3.0 0.0 0.0)
(1.0 0.0 0.0 0.0)))
(RPAQQ \IRISSTREAMS NIL)
(RPAQQ \IRIS.DEBUG NIL)
(RPAQQ \IRISCOLORMAPCACHE (((0 0 0) . 0)
((255 255 255) . 7)
((0 255 0) . 2)
((0 0 255) . 4)
((255 0 0) . 1)
((255 255 0) . 3)
((255 0 255) . 5)
((0 255 255) . 6)))
(DEFINEQ
(BOXSCREEN
[LAMBDA NIL (* gbn " 8-Nov-85 16:56")
(* * draw a box around the screen)
(DRAWLINE 0 0 (SUB1 SCREENWIDTH)
0 NIL NIL \IRISSTREAM)
(DRAWTO (SUB1 SCREENWIDTH)
(SUB1 SCREENHEIGHT)
NIL NIL \IRISSTREAM)
(DRAWTO 0 (SUB1 SCREENHEIGHT)
NIL NIL \IRISSTREAM)
(DRAWTO 0 0 NIL NIL \IRISSTREAM)
(FLUSHOUTPUT IRISCONN])
(CLEARIRIS
[LAMBDA (IRISCONN IRISSTREAM) (* gbn "12-Nov-85 16:20")
(OR IRISSTREAM (SETQ IRISSTREAM \IRISSTREAM))
[OR IRISCONN (SETQ IRISCONN (fetch SPPOUTSTREAM of (fetch IRISDATA of \IRISSTREAM]
(IRIS.SINGLEBUFFER IRISCONN)
(IRIS.GCONFIG IRISCONN)
(DSPCLIPPINGREGION WHOLESCREEN IRISSTREAM)
(IRIS.ORTHO 0 SCREENWIDTH 0 SCREENHEIGHT -1000 1000 IRISCONN)
(DSPCOLOR (QUOTE WHITE)
IRISSTREAM)
(IRIS.LINEWIDTH 1 IRISCONN) (* IRIS.RESETLS 0 IRISCONN)
(* make the IRIS not reset the line style between
curve segments)
(IRIS.CURSOFF IRISCONN)
(IRIS.CLEAR IRISCONN)
(DSPCOLOR (QUOTE BLUE)
IRISSTREAM)
(SELECTQ \IRIS.VERSION
(GL2 (IRIS.CURVEPRECISION \CHARSEGMENTS.IRIS IRISCONN)
(IRIS.DEFBASIS 1 \BEZIERBASIS.IRIS IRISCONN)
(IRIS.CURVEBASIS 1 IRISCONN))
(GL1)
(ERROR "Unknown version of IRIS: " \IRIS.VERSION))
(DSPRESET IRISSTREAM)
(SPP.FORCEOUTPUT IRISCONN])
(DRAWBITMAP
[LAMBDA (BITMAP SOURCELEFT SOURCEBOTTOM OUTPUTSTREAM DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT)
(* gbn "24-Oct-85 17:57")
(LET ((DESTBOTTOM (OR DESTINATIONBOTTOM (DSPYPOSITION NIL OUTPUTSTREAM)))
(DESTLEFT (OR DESTINATIONLEFT (DSPXPOSITION NIL OUTPUTSTREAM)))
(WIDTH (OR WIDTH (BITMAPWIDTH BITMAP)))
(HEIGHT (OR HEIGHT (BITMAPHEIGHT BITMAP)))
(SBOTTOM (OR SOURCEBOTTOM 0))
(SLEFT (OR SOURCELEFT 0)))
[for Y from SOURCEBOTTOM to (IPLUS SOURCEBOTTOM HEIGHT) as YBASE from 0
do (SETQ ROW (IPLUS DESTBOTTOM YBASE)) (* if there is a pixel set on the row, it is better to
set the row outside the loop)
(bind (STATE ←(QUOTE SKIP0S))
START END for X from SLEFT to (IPLUS SLEFT WIDTH) as BASE
from 0 do (SELECTQ STATE
[SKIP0S (if (IEQP 0 (BITMAPBIT BITMAP X Y))
then
(* skipping zeros, found a zero, so do nothing)
NIL
else
(* start a run.)
(SETQ START BASE)
(SETQ END BASE)
(SETQ STATE (QUOTE COLLECT1S]
[COLLECT1S (if (ILESSP END
(add END
(BITMAPBIT BITMAP X
Y)))
then
(* collecting 1's, found one.
The test already incremented END, so do nothing)
NIL
else (DRAWLINE (IPLUS DESTLEFT START)
ROW
(IPLUS DESTLEFT END)
ROW 1 NIL OUTPUTSTREAM)
(SETQ STATE (QUOTE SKIP0S]
(SHOULDNT "Unknown state: " STATE))
finally (if (EQ STATE (QUOTE COLLECT1S))
then (DRAWLINE (IPLUS DESTLEFT START)
ROW
(IPLUS DESTLEFT END)
ROW 1 NIL OUTPUTSTREAM]
(MOVETO DESTLEFT DESTBOTTOM OUTPUTSTREAM])
(IRISBITMAP
[LAMBDA (FILE BITMAP SCALEFACTOR REGION ROTATION TITLE) (* gbn "24-Oct-85 16:51")
(LET [(IRISSTREAM (OPENIMAGESTREAM (QUOTE {LPT}Iris.IRIS)
(QUOTE IRIS]
(BITBLT BITMAP (fetch (REGION LEFT) of REGION)
(fetch (REGION BOTTOM) of REGION)
IRISSTREAM
(DSPXPOSITION NIL IRISSTREAM)
(DSPYPOSITION NIL IRISSTREAM)
(fetch (REGION WIDTH) of REGION)
(fetch (REGION HEIGHT) of REGION])
(FILLPOLYGON
[LAMBDA (POINTS TEXTURE STREAM) (* gbn " 7-Aug-85 20:11")
(IMAGEOP (QUOTE IMFILLPOLYGON)
(SETQ STREAM (\OUTSTREAMARG STREAM))
STREAM POINTS TEXTURE])
(INSTALL.OBJFONT
[LAMBDA (FAMILY CHARSET LOWCHARCODE HIGHESTCHARCODE SCALE IRISSTREAM CSINFO)
(* gbn "12-Nov-85 19:17")
(* * takes a font in SF format that is already in core, ie, part of the value of \SPLINEFONTSINCORE, and installs
it on the iris connected to STREAM. Characters in the font which are nil are not downloaded)
(* * note that this fn is called by the fontcreate method for the iris, even when the font has already been
downloaded. This fn looks up in the stream and just returns the old cached info from the original downloading.)
(if \IRIS.DEBUG
then (SETQ LOWCHARCODE 97)
(SETQ HIGHESTCHARCODE 101)
else (SETQ LOWCHARCODE (OR LOWCHARCODE 1))
(SETQ HIGHESTCHARCODE (OR HIGHESTCHARCODE 255)))
(PROG ((FONTARRAY (\LOOKUPSPLINEFONT FAMILY CHARSET))
(IRISDATA (fetch IRISDATA of IRISSTREAM))
(MAXHEIGHT 0)
SPACEWIDTH OBJ# FONTBASE CHARDESC WIDTHARRAY STREAM)
(SETQ STREAM (fetch SPPOUTSTREAM of IRISDATA))
(if (NOT FONTARRAY)
then (ERROR "Charset for spline font not in core:" (LIST FAMILY CHARSET)))
(if (SETQ FONTBASE (\IRISFONTBASE FAMILY CHARSET IRISDATA))
then (* the font has already been downloaded, just return
the cached info)
(if \IRIS.DEBUG
then (SHOULDNT "font being redefined"))
(RETURN FONTBASE)
else (SETQ FONTBASE (add (fetch HIFONT# of IRISDATA)
256))
(SETQ WIDTHARRAY (\CREATECSINFOELEMENT)))
(if \IRIS.VERBOSE
then (PROMPTPRINT "Installing font on IRIS: " FAMILY))
(if (ZEROP (IRIS.ISOBJ 0 STREAM))
then (IRIS.MAKEOBJ 0 STREAM)
(IRIS.CURSOFF STREAM)
(IRIS.CLOSEOBJ STREAM)) (* character 0 of the font is always defined on the
IRIS as the way of telling if this charset has been
downloaded.)
(* NOT ANY MORE)
[for I from LOWCHARCODE to HIGHESTCHARCODE
do (SETQ CHARDESC (ELT FONTARRAY I))
(if CHARDESC
then (IRIS.MAKEOBJ (SETQ OBJ# (IPLUS FONTBASE I))
STREAM)
(SFDRAW CHARDESC NIL 0 0 SCALE IRISSTREAM)
(* The scale is always one when called for the iris,
because the printchar method makes the IRIS scale the
character anyway)
(IRIS.CLOSEOBJ STREAM)
(ALIGN) (* CONSISTENCY CHECK)
(if (ZEROP (IRIS.ISOBJ OBJ# STREAM))
then (ERROR (QUOTE
"(OBJECT FONT CHARACTER IS UNDEFINED DIRECTLY AFTER DEFINING INSIDE INSTALL.OBJFONT)"))
else (PRINTOUT PROMPTWINDOW (CHARACTER I]
(IRIS.GFLUSH STREAM)
(ALIGN)
(\IRISSETFONTBASE FAMILY CHARSET IRISDATA FONTBASE)
(SETQ OBJ# (IPLUS FONTBASE (CHARCODE SPACE)))
(if (ZEROP (IRIS.ISOBJ OBJ# STREAM))
then (* install a fake space char if there isn't one)
(SETQ SPACEWIDTH (\FGETWIDTH WIDTHARRAY (OR HIGHESTCHARCODE 127)))
(IRIS.MAKEOBJ OBJ# STREAM)
(MOVETO SPACEWIDTH 0 IRISSTREAM)
(IRIS.CLOSEOBJ STREAM)
(\FSETWIDTH WIDTHARRAY (CHARCODE SPACE)
SPACEWIDTH))
(RETURN (LIST FAMILY FONTBASE WIDTHARRAY MAXHEIGHT])
(OPENIRISSTREAM
[LAMBDA (NSHOSTNUMBER OPTIONS) (* gbn " 8-Nov-85 19:29")
(* * opens a stream to an iris workstation)
(DECLARE (GLOBALVARS \IRISIMAGEOPS))
(PROG ((IRISDATA (create IRISDATA))
(HOST (OR NSHOSTNUMBER IRISNSHOSTNUMBER))
(IRISSTREAM (OPENSTREAM (QUOTE {NODIRCORE}IRIS.SCRATCH)
(QUOTE OUTPUT)
(QUOTE NEW)
8
(QUOTE BINARY)))
TEMPCONN)
(if (NOT HOST)
then (ERROR "IRISNSHOSTNUMBER must be supplied"))
(if [AND (NOT (EQMEMB (QUOTE RECONNECT)
OPTIONS))
(SPP.OPENP IRISCONN)
(OR (NULL HOST)
(SELECTQ (TYPENAME HOST)
[NSADDRESS (EQUAL (fetch (NSADDRESS NSHOSTNUMBER)
of HOST)
(fetch (NSADDRESS NSHOSTNUMBER)
of (SPP.DESTADDRESS IRISCONN]
[LISTP (EQUAL HOST (fetch (NSADDRESS NSHOSTNUMBER)
of (SPP.DESTADDRESS IRISCONN]
[LITATOM (EQ (QUOTE LPT)
(LISTGET (UNPACKFILENAME HOST)
(QUOTE HOST]
(NILL]
then
(* there is still a stream open to the iris. Just use that, since one can have at most a single stream open to the
iris)
(RETURN \IRISSTREAM)
else (if [AND (TYPENAMEP HOST (QUOTE LITATOM))
(EQ (QUOTE LPT)
(LISTGET (UNPACKFILENAME HOST)
(QUOTE HOST]
then
(* * This is just a request to hardcopy when there is no open stream)
(SETQ HOST NIL))
(if (NOT (SETQ TEMPCONN (OPEN.IRISCONN HOST)))
then (ERROR "Iris did not respond to connection attempt" HOST)))
(* replace (STREAM USERCLOSEABLE) of IRISSTREAM with
NIL)
(STREAMADDPROP IRISSTREAM (QUOTE BEFORECLOSE)
(QUOTE \CLOSEF.IRIS))
(replace (STREAM OUTCHARFN) of IRISSTREAM with (FUNCTION \OUTCHARFN.IRIS))
(replace (IRISSTREAM IMAGEOPS) of IRISSTREAM with \IRISIMAGEOPS)
(replace (IRISSTREAM IRISDATA) of IRISSTREAM with IRISDATA)
(replace (IRISDATA SPPINSTREAM) of IRISDATA with TEMPCONN)
(replace (IRISDATA SPPOUTSTREAM) of IRISDATA with (SPPOUTPUTSTREAM TEMPCONN))
(replace (IRISDATA IRISCOLORMAPCACHE) of IRISDATA with \IRISCOLORMAPCACHE)
(replace (IRISDATA IRISCOLORMAP) of IRISDATA with (COLORMAPCREATE NIL
\IRIS.BITPLANES))
(replace (IRISDATA IRISCHARSET) of IRISDATA with -1)
(replace (IRISDATA IRISPAGE) of IRISDATA with (COPY WHOLESCREEN))
(SETQ IRISCONN (fetch SPPOUTSTREAM of IRISDATA))
(IRIS.GINIT IRISCONN)
(CLEARIRIS IRISCONN IRISSTREAM)
(RETURN (SETQ \IRISSTREAM IRISSTREAM])
(\CLOSEF.IRIS
[LAMBDA (IRISSTREAM) (* gbn "25-Oct-85 17:18")
(* * this fn is installed on the stream as a streamprop. It flushs the output to the stream, but does not close it)
(FORCEOUTPUT (fetch SPPOUTSTREAM of (fetch IRISDATA of IRISSTREAM)))
(RETFROM (QUOTE CLOSEF)
NIL])
(R
[LAMBDA NIL (* gbn "21-Jun-85 03:57")
(OPENIRISSTREAM NIL (QUOTE (DONTCONNECT])
(SPPINPUTSTREAM
[LAMBDA (OUTPUTSTREAM) (* gbn "17-Jun-85 17:40")
(PROG ((CON (fetch (STREAM F1) of OUTPUTSTREAM)))
(if CON
then (RETURN (fetch (SPPCON SPPINPUTSTREAM) of CON])
(TRYGRAPHER
[LAMBDA (DONTSETUP?) (* gbn "24-Jun-85 18:56")
(* * just a hack to try to draw a grapher graph)
(* * comment)
(PROG (vars...)
[SETQ G (LAYOUTSEXPR (QUOTE (stu (wxy xxx)
(xyzzy)))
NIL NIL (FONTCREATE (QUOTE GACHA)
20 NIL NIL (QUOTE IRIS]
(IF (NOT DONTSETUP?)
THEN (IRIS.GRESET)
(IRIS.SINGLEBUFFER) (* (IRIS.DOUBLEBUFFER))
(IRIS.GCONFIG)
(IRIS.PERSPECTIVE 120 1 -1000 1000)
(IRIS.LOOKAT 0 0 30000 0 0 0 0)
(IRIS.LINEWIDTH 2)
(CLEAR BLUE)
(IRIS.COLOR WHITE))
(DISPLAYGRAPH G \IRISSTREAM)
(RETURN])
(\BACKCOLOR.IRIS
[LAMBDA (STREAM COLOR) (* gbn "10-Jul-85 00:00")
(if COLOR
then (replace BACKCOLOR of (fetch IRISDATA of STREAM) with COLOR)
else (fetch BACKCOLOR of (fetch IRISDATA of STREAM])
(\BITBLT.IRIS
[LAMBDA (SOURCEBITMAP SOURCELEFT SOURCEBOTTOM DESTINATION DESTINATIONLEFT DESTINATIONBOTTOM WIDTH
HEIGHT SOURCETYPE OPERATION TEXTURE CLIPPINGREGION CLIPPEDSOURCELEFT
CLIPPEDSOURCEBOTTOM) (* gbn "12-Nov-85 14:35")
(* * produces a 3-d bitmap composed of lines)
(if (NOT (EQ (IMAGESTREAMTYPE DESTINATION)
(QUOTE IRIS)))
then (ERROR "Destination not IRIS stream: " DESTINATION))
(DRAWBITMAP SOURCEBITMAP SOURCELEFT SOURCEBOTTOM DESTINATION DESTINATIONLEFT DESTINATIONBOTTOM
WIDTH HEIGHT)
(FLUSHOUTPUT (fetch SPPOUTSTREAM of (fetch IRISDATA of \IRISSTREAM])
(\BLTSHADE.IRIS
[LAMBDA (TEXTURE IRISSTREAM DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT OPERATION CLIPPINGREGION)
(* gbn "12-Nov-85 12:13")
(* should not affect anything, so do a with attr)
(LET* ((IRISDATA (fetch IRISDATA of IRISSTREAM))
(SPPOUT (fetch (IRISDATA SPPOUTSTREAM) of IRISDATA)))
(WITH.IRIS.ATTR (IRIS.POLF2 4 (LIST (CREATEPOSITION DESTINATIONLEFT DESTINATIONBOTTOM)
(CREATEPOSITION (IPLUS DESTINATIONLEFT WIDTH)
DESTINATIONBOTTOM)
(CREATEPOSITION (IPLUS DESTINATIONLEFT WIDTH)
(IPLUS DESTINATIONBOTTOM HEIGHT)
)
(CREATEPOSITION DESTINATIONLEFT (IPLUS
DESTINATIONBOTTOM
HEIGHT)))
SPPOUT)
IRISSTREAM SPPOUT :COLOR TEXTURE)
(FORCEOUTPUT SPPOUT])
(\FONTCREATE.IRIS
[LAMBDA (FAMILY SIZE FACE ROTATION DEVICE CHARSET) (* gbn "22-Oct-85 12:40")
(* * This function reads in the spline definition for a font, but does not install it on the iris.
The installation is done on a demand basis on the IRIS, charset by charset.)
(PROG (WIDTHS)
(* since a spline font can be any size, we must guarantee that relative sizes are guaranteed, i.e. a 10 point font
is twice as big as a 5 point font)
(SETQ SCALE 1)
(* * the width arrays, the height, ascent, etc are all scaled)
(SETQ FONTDESC (create FONTDESCRIPTOR
FONTDEVICE ←(QUOTE IRIS)
FONTFAMILY ← FAMILY
FONTSIZE ← SIZE
FONTFACE ← FACE
ROTATION ← ROTATION))
(* CHECK WHAT FONTSCALE MEANS)
(SETQ CSINFO (\GETCHARSETINFO 0 FONTDESC T))
(if (NOT CSINFO)
then (RETURN NIL)) (* this will call the createcharset method for the
IRIS)
[SETQ SCALE (replace OTHERDEVICEFONTPROPS of FONTDESC
with (QUOTIENT (FLOAT SIZE)
(IPLUS (fetch (CHARSETINFO CHARSETASCENT)
of CSINFO)
(fetch (CHARSETINFO CHARSETDESCENT)
of CSINFO]
(SETQ WIDTHS (fetch (CHARSETINFO WIDTHS) of CSINFO))
[for I from 0 to \MAXTHINCHAR DO (\FSETWIDTH WIDTHS I
(FIX (TIMES (\FGETWIDTH WIDTHS I)
SCALE]
(replace \SFHeight of FONTDESC with SIZE)
[replace \SFAscent of FONTDESC with (FIX (TIMES SCALE (fetch (CHARSETINFO
CHARSETASCENT)
of CSINFO]
[replace \SFDescent of FONTDESC with (FIX (TIMES SCALE (fetch (CHARSETINFO
CHARSETDESCENT)
of CSINFO]
(* OTHERDEVICEFONTPROPS is used to hide the scale of
the font on the iris)
(RETURN FONTDESC])
(\FONTSAVAILABLE.IRIS
[LAMBDA (FAMILY PSIZE FACE ROTATION DEVICE) (* gbn "13-Nov-85 12:06")
(* * returns a list of the form (family size face rotation IRIS) for any font matching the specs.
* is used as wildcard.)
(DECLARE (GLOBALVARS IRISFONTDIRECTORIES)) (* Normalize face)
(LET [(FAMILIES (if (MEMB FAMILY IRISFONTFAMILIES)
then FAMILY
else NIL))
(SIZES (SELECTQ PSIZE (* IRISFONTSIZES)
(PROG1 PSIZE)))
[FACES (SELECTQ FACE (* (QUOTE ((MEDIUM REGULAR REGULAR)
(MEDIUM ITALIC REGULAR) (BOLD REGULAR REGULAR)
(BOLD ITALIC REGULAR))))
(PROG1 (LIST (\FONTFACE FACE]
(ROTATIONS (SELECTQ ROTATION (* IRISFONTROTATIONS)
(PROG1 ROTATION]
(for FFAMILY inside FAMILIES join (for SSIZE inside SIZES
join (for FFACE in FACES
join (for RROTATION inside
ROTATIONS
collect
(LIST FFAMILY SSIZE FFACE
RROTATION
(QUOTE IRIS])
(\LEFTMARGIN.IRIS
[LAMBDA (MARGIN STREAM) (* gbn " 8-Nov-85 17:33")
(OR 0 (if MARGIN
then (replace LEFT of (fetch IRISPAGE OF (fetch IRISDATA of STREAM))
with MARGIN)
else (fetch LEFT of (fetch IRISPAGE OF (fetch IRISDATA of STREAM])
(\RESET.IRIS
[LAMBDA (IRISSTREAM) (* gbn "13-Nov-85 00:46")
(MOVETO (DSPLEFTMARGIN NIL IRISSTREAM)
(IDIFFERENCE (fetch TOP of (DSPCLIPPINGREGION NIL IRISSTREAM))
(FONTPROP (DSPFONT NIL IRISSTREAM)
(QUOTE HEIGHT)))
IRISSTREAM])
(\LOOKUPRGB
[LAMBDA (RGB IRISDATA) (* gbn "15-Aug-85 20:08")
(* * returns the colormap index whose value is RGB. Looks first in the cache, then runs through the colormap.
Returns NIL if RGB NOT found)
(PROG (INDEX (CACHE (fetch IRISCOLORMAPCACHE of IRISDATA)))
(RETURN (if (SETQ INDEX (SASSOC RGB CACHE))
then (CDR INDEX)
else [SETQ INDEX (bind (CM ←(fetch IRISCOLORMAP of IRISDATA)) for I from 0
to (EXPT 2 \IRIS.BITPLANES)
thereis (AND (EQ (COLORLEVEL CM I (QUOTE RED))
(fetch (RGB RED) of LEVELS))
(EQ (COLORLEVEL CM I (QUOTE GREEN))
(fetch (RGB GREEN) of LEVELS))
(EQ (COLORLEVEL CM I (QUOTE BLUE))
(fetch (RGB BLUE) of LEVELS]
(if INDEX
then (push COLORMAPCACHE (CONS RGB INDEX)))
INDEX])
(\PSPLINE.TO.BEZIER.GEOMETRY
[LAMBDA (SPLINE KNOT#) (* gbn " 7-Jul-85 20:49")
(* * returns a bezier geometry matrix from the spline for knot KNOT#. (compare with SF.DERIVS.TO.BEZIER which does
the same thing for a SF spline description))
(* * the derivatives must already be scaled by the Factorials)
(* * should not create the BEZIER)
(PROG [(BEZ (create BEZIER
B0X ←(ELT (fetch SPLINEX of SPLINE)
KNOT#)
B0Y ←(ELT (fetch SPLINEY of SPLINE)
KNOT#]
(replace B1X of BEZ with (PLUS (ffetch B0X of BEZ)
(QUOTIENT (ELT (ffetch SPLINEDX of SPLINE)
KNOT#)
3)))
(replace B1Y of BEZ with (PLUS (ffetch B0Y of BEZ)
(QUOTIENT (ELT (ffetch SPLINEDY of SPLINE)
KNOT#)
3)))
(replace B2X of BEZ with (PLUS (ffetch B1X of BEZ)
(QUOTIENT (PLUS (ELT (ffetch SPLINEDX of SPLINE)
KNOT#)
(ELT (ffetch SPLINEDDX of SPLINE)
KNOT#))
3)))
(replace B2Y of BEZ with (PLUS (ffetch B1Y of BEZ)
(QUOTIENT (PLUS (ELT (ffetch SPLINEDY of SPLINE)
KNOT#)
(ELT (ffetch SPLINEDDY of SPLINE)
KNOT#))
3)))
(replace B3X of BEZ with (PLUS (ffetch B0X of BEZ)
(ELT (ffetch SPLINEDX of SPLINE)
KNOT#)
(ELT (ffetch SPLINEDDX of SPLINE)
KNOT#)
(ELT (ffetch SPLINEDDDX of SPLINE)
KNOT#)))
(replace B3Y of BEZ with (PLUS (ffetch B0Y of BEZ)
(ELT (fetch SPLINEDY of SPLINE)
KNOT#)
(ELT (ffetch SPLINEDDY of SPLINE)
KNOT#)
(ELT (ffetch SPLINEDDDY of SPLINE)
KNOT#)))
(RETURN BEZ])
(\SCALE.IRIS
[LAMBDA (STREAM SCALE) (* gbn "24-Jun-85 18:50")
(if (NOT SCALE)
then 1
else (ERROR])
(\SCALE.SPLINE.BY.DERIVS
[LAMBDA (SPLINE) (* gbn " 8-Jul-85 17:20")
(* * For the form used by \PSPLINE.TO.BEZIER.GEOMETRY, the derivs can all be premultiplied by the factorial
coefficients, rather than repeatedly multiplying them in)
(bind (DDX ←(fetch SPLINEDDX of SPLINE))
(DDY ←(fetch SPLINEDDY of SPLINE))
(DDDX ←(fetch SPLINEDDDX of SPLINE))
(DDDY ←(fetch SPLINEDDDY of SPLINE)) for I from 1 to (fetch #KNOTS of SPLINE)
do (SETA DDX I (FQUOTIENT (ELT DDX I)
2.0))
(SETA DDY I (FQUOTIENT (ELT DDY I)
2.0))
(SETA DDDX I (FQUOTIENT (ELT DDDX I)
6.0))
(SETA DDDY I (FQUOTIENT (ELT DDDY I)
6.0])
(\STRINGWIDTH.IRIS
[LAMBDA (STR FONT RDTBL) (* gbn "12-Nov-85 17:56")
(* * this is not called by stringwidth. It is now obsolete (since the scaling is done at fontcreate time.))
(* * note that this is already returning scaled values since th array was built by SFDRAW who takes the scale as
input.)
(LET ((STRING (MKSTRING STR)))
(for CH instring STRING sum (FIX (TIMES (fetch OTHERDEVICEFONTPROPS
of FONT)
(\FGETCHARWIDTH FONT CH])
(\TERPRI.IRIS
[LAMBDA (STREAM) (* gbn "12-Nov-85 14:37")
(MOVETO (DSPLEFTMARGIN NIL STREAM)
(IDIFFERENCE (DSPYPOSITION NIL STREAM)
(FONTPROP (DSPFONT NIL STREAM)
(QUOTE HEIGHT)))
STREAM)
(if (ILESSP (DSPYPOSITION NIL STREAM)
0)
then (DSPRESET STREAM))
(FLUSHOUTPUT (fetch SPPOUTSTREAM of (fetch IRISDATA of STREAM])
(\FONT.IRIS
[LAMBDA (IRISSTREAM FONTDESC) (* gbn "29-Oct-85 15:25")
(if FONTDESC
then (LET ((IRISDATA (fetch IRISDATA of IRISSTREAM)))
[if [NOT (AND (type? FONTDESCRIPTOR FONTDESC)
(EQ (QUOTE IRIS)
(fetch FONTDEVICE of FONTDESC]
then (SETQ FONTDESC (\COERCEFONTDESC FONTDESC (QUOTE IRIS]
(* user supplied a font so install it)
(replace (IRISDATA CURRENTFONTDESC) of IRISDATA with FONTDESC)
(\CHANGECHARSET.IRIS IRISSTREAM 0) (* this validates the caches for fontbase, current
charset, etc.)
FONTDESC)
else (fetch CURRENTFONTDESC of (fetch IRISDATA of IRISSTREAM])
(\CREATECHARSET.IRIS
[LAMBDA (FAMILY SIZE FACE ROTATION DEVICE CHARSET FONTDESC NOSLUG?)
(* gbn " 7-Nov-85 21:30")
(* * This function reads in the spline definition for a CHARSET but does not install it on the iris.
The installation is done on a demand basis on the IRIS, charset by charset.)
(PROG ((FONTARRAY (\LOOKUPSPLINEFONT FAMILY CHARSET))
(MAXHEIGHT 1)
WIDTHS CSINFO FONTARRAY)
(if (NOT FONTARRAY)
then (* we haven't even read this into core.)
(SETQ FILES (DIRECTORY (PACK* IRISFONTDIRECTORIES FAMILY (QUOTE *.*SF))
(QUOTE COLLECT)))
(* THIS METHOD OF FINDING THE FILES WILL NEED TO BE
UPGRADED IF WE GET SPLINE DEFINITIONS FOR NS
CHARACTERS)
(if (NOT FILES)
then (* if you can't find the file then just return NIL to
createcharset who will either report the error or
build a slug charset)
(RETURN (if NOSLUG?
then (* if you can't find the file then just return NIL to
createcharset who will report the error)
NIL
else (* this will guarantee that all the chars in the
charset have 0 width)
(\BUILDSLUGCSINFO 0 0 0)))
else (if \IRIS.VERBOSE
then (PROMPTPRINT "Reading the following spline font files: "
FILES))
(if \IRIS.DEBUG
then (READ.SPLINE.FONT (CAR FILES)
FAMILY CHARSET)
else (READ.SPLINE.FONT FILES FAMILY CHARSET)))
(* now see if it really worked)
(if (NOT (SETQ FONTARRAY (\LOOKUPSPLINEFONT FAMILY CHARSET)))
then (* we just lost horribly, so die with an
inconsistency)
(SHOULDNT
"Inside \FONTCREATE.IRIS, some SFFONTS were found, but reading them did not produce an entry in \SPLINEFONTSINCORE"
))) (* we have the FAMILY/CHARSET entries, now see if
there is a font descriptor ready made for this size)
(* since a spline font can be any size, we must guarantee that relative sizes are guaranteed, i.e. a 10 point font
is twice as big as a 5 point font)
(SETQ CSINFO (create CHARSETINFO))
(SETQ WIDTHS (fetch (CHARSETINFO WIDTHS) of CSINFO))
(bind CHARDESC for I from 1 to \MAXTHINCHAR
do (SETQ CHARDESC (ELT FONTARRAY I)) (* If there is no description for a character, set its
width to zero, so that dspprintchar can recognize not
to call this character.)
(if CHARDESC
then (\FSETWIDTH WIDTHS I (fetch XWIDTH of (fetch SF.WIDTH
of CHARDESC)))
[SETQ MAXHEIGHT (IMAX MAXHEIGHT (fetch YFIDUCIAL
of (fetch FIDUCIAL
of CHARDESC]
else (\FSETWIDTH WIDTHS I 0)))
(replace (CHARSETINFO CHARSETASCENT) of CSINFO with (FIX (TIMES .7 MAXHEIGHT)))
(replace (CHARSETINFO CHARSETDESCENT) of CSINFO with (FIX (TIMES .3 MAXHEIGHT)))
[if (fetch OTHERDEVICEFONTPROPS of FONTDESC)
then
(* this fontdescriptor has already build character sets, and has determined its scale. So scale the widths in this
character set. For the first character set, this is done in \fontcreate.iris)
(for I from 0 to \MAXTHINCHAR
do (\FSETWIDTH WIDTHS I (FIX (TIMES (\FGETWIDTH WIDTHS I)
SCALE]
(RETURN CSINFO])
(\IRISSETFONTBASE
[LAMBDA (FAMILY CHARSET IRISDATA FONTBASE) (* gbn "18-Oct-85 16:15")
(PUTASSOC (CONS FAMILY CHARSET)
FONTBASE
(fetch FONTSINIRIS of IRISDATA])
(\IRISFONTBASE
[LAMBDA (FAMILY CHARSET IRISDATA) (* gbn "18-Oct-85 16:15")
(CDR (SASSOC (CONS FAMILY CHARSET)
(fetch FONTSINIRIS of IRISDATA])
(\CHANGECHARSET.IRIS
[LAMBDA (IRISSTREAM CHARSET) (* gbn "18-Oct-85 16:16")
(* * called when a character is about to be printed which is in a different charset than the current one.)
(LET ((IRISDATA (fetch IRISDATA of IRISSTREAM))
CSINFO BASE FONTDESC)
(SETQ FONTDESC (fetch CURRENTFONTDESC of IRISDATA))
[replace (IRISDATA IRISWIDTHSCACHE) of IRISDATA with (fetch (CHARSETINFO WIDTHS)
of (SETQ CSINFO
(\GETCHARSETINFO
CHARSET
FONTDESC]
(SETQ BASE (\IRISFONTBASE (fetch FONTFAMILY of FONTDESC)
CHARSET IRISDATA))
(if (NOT BASE)
then (* this stream has never seen this charset before so
install it on the IRIS.)
(INSTALL.OBJFONT (fetch FONTFAMILY of FONTDESC)
CHARSET NIL NIL NIL IRISSTREAM CSINFO)
(SETQ BASE (\IRISFONTBASE (fetch FONTFAMILY of FONTDESC)
CHARSET IRISDATA)))
(replace (IRISDATA CURRENTFONTBASE) of IRISDATA with BASE)
(replace (IRISDATA IRISCHARSET) of IRISDATA with CHARSET])
(\CHARWIDTH.IRIS
[LAMBDA (CHARCODE FONT) (* gbn "18-Oct-85 19:11")
(FIX (TIMES (fetch OTHERDEVICEFONTPROPS of FONT)
(\FGETCHARWIDTH FONT CHARCODE])
(\OUTCHARFN.IRIS
[LAMBDA (IRISSTREAM CHARCODE) (* gbn "22-Oct-85 12:32")
(LET* ((IRISDATA (fetch IRISDATA of IRISSTREAM))
(SPPOUT (fetch SPPOUTSTREAM of IRISDATA))
OBJNO
(FONTDESC (fetch CURRENTFONTDESC of IRISDATA))
PUSHEDATTRIBUTES SCALE)
(if (NOT FONTDESC)
then (* this is so that the stream can be opened without
the expensive font create operation)
(SETQ FONTDESC (DSPFONT (FONTCREATE (QUOTE GACHA)
12 NIL NIL (QUOTE IRIS))
IRISSTREAM)))
(if (NEQ (fetch (IRISDATA IRISCHARSET) of IRISDATA)
(\CHARSET CHARCODE))
then (\CHANGECHARSET.IRIS IRISSTREAM (\CHARSET CHARCODE)))
(SETQ OBJNO (IPLUS (fetch CURRENTFONTBASE of IRISDATA)
CHARCODE))
(COND
((EQ CHARCODE (CHARCODE EOL))
(\TERPRI.IRIS IRISSTREAM))
((NILL (* ZEROP (IRIS.ISOBJ CURRENTFONTBASE SPPOUT))
) (* this character set has not been installed on the
IRIS. character zero is defined for every charset that
is installed.)
(SHOULDNT "\CHANGECHARSET.IRIS has not guaranteed that char 0 is defined. Obj = "
OBJNO))
([ZEROP (SETQ WIDTH (\FGETWIDTH (fetch (IRISDATA IRISWIDTHSCACHE) of IRISDATA)
(\CHAR8CODE CHARCODE]
(* the character is not defined.
don't call it)
)
(T (IRIS.PUSHMATRIX SPPOUT)
(IRIS.TRANSLATE (DSPXPOSITION NIL IRISSTREAM)
(DSPYPOSITION NIL IRISSTREAM)
0 SPPOUT)
(IRIS.SCALE (SETQ SCALE (fetch OTHERDEVICEFONTPROPS of FONTDESC))
SCALE SCALE SPPOUT)
(if (EQ (CAR (fetch FONTFACE of FONTDESC))
(QUOTE BOLD))
then (SETQ PUSHEDATTRIBUTES T)
(IRIS.PUSHATTRIBUTES SPPOUT)
(IRIS.LINEWIDTH \IRIS.BOLD.LINEWIDTH SPPOUT))
(if (EQ (CADR (fetch FONTFACE of FONTDESC))
(QUOTE ITALIC))
then (* fake italics with a rotation)
(IRIS.ROTATE \IRIS.ITALICS.ROTATION ZAXIS SPPOUT))
(if PUSHEDATTRIBUTES
then (IRIS.POPATTRIBUTES SPPOUT))
(IRIS.CALLOBJ OBJNO SPPOUT)
(IRIS.POPMATRIX SPPOUT)
(RELMOVETO (FIX (\FGETWIDTH (fetch IRISWIDTHSCACHE of IRISDATA)
CHARCODE))
0 IRISSTREAM)
(FLUSHOUTPUT (fetch SPPOUTSTREAM of (fetch IRISDATA of IRISSTREAM])
(\CLIPPINGREGION.IRIS
[LAMBDA (STREAM REGION) (* gbn "30-Jun-85 21:21")
(if REGION
then (replace IRISCLIPPINGREGION of (fetch IRISDATA of STREAM) with REGION)
else (fetch IRISCLIPPINGREGION of (fetch IRISDATA of STREAM])
(\CLOSEFN.IRIS
[LAMBDA (STR) (* gbn "12-Nov-85 14:25")
(* * (I DONT THINK THAT SGI IMPLEMENTS THE SPP CLOSE PROTOCOL, BUT WE SHOULD TRY TO CONVINCE THEM))
(FORCEOUTPUT IRISCONN])
(\COLOR.IRIS
[LAMBDA (STREAM COLOR) (* gbn " 8-Nov-85 19:25")
(if COLOR
then (IRIS.COLOR (\IRIS.ASSURE.COLOR COLOR STREAM)
(fetch SPPOUTSTREAM of (fetch IRISDATA of STREAM)))
else (IRIS.GETCOLOR (fetch SPPOUTSTREAM of (fetch IRISDATA of STREAM])
(\IRIS.ASSURE.COLOR
[LAMBDA (COLOR# IRISSTREAM) (* gbn "11-Nov-85 16:10")
(PROG (LEVELS)
(AND (COND
((FIXP COLOR#) (* since Sketch and others call fillpolygon with
textures, just return a consistent color from a
texture)
(RETURN (IMOD COLOR# 8)))
[(LITATOM COLOR#)
(RETURN (COND
((SETQ LEVELS (\LOOKUPCOLORNAME COLOR#))
(* recursively look up color number)
(\IRIS.ASSURE.COLOR (CDR LEVELS)
IRISSTREAM))
(T (ERROR "Unknown color name" COLOR#]
((EQ (LENGTH COLOR#)
2) (* temporarily, handle the case of being given a
texture and a color, by using the color)
(RETURN (\IRIS.ASSURE.COLOR (CADR COLOR#)
IRISSTREAM)))
((HLSP COLOR#) (* HLS form convert to RGB)
(SETQ LEVELS (HLSTORGB COLOR#)))
((RGBP COLOR#) (* check for RGB or HLS)
(SETQ LEVELS COLOR#))
((TYPENAMEP COLOR# (QUOTE BITMAP))
(* just a hack to not blow up)
(RETURN (IMOD (for I from 1 to (BITMAPWIDTH COLOR#)
sum (BITMAPBIT COLOR# I 1))
8)))
(T (\ILLEGAL.ARG COLOR#)))
(RETURN (COND
((\LOOKUPRGB LEVELS (fetch IRISDATA of IRISSTREAM)))
(T (ERROR COLOR# "not available in color map"])
(\DRAWCIRCLE.IRIS
[LAMBDA (IRISSTREAM X Y RADIUS BRUSH DASHING) (* gbn "12-Nov-85 17:13")
(LET [(SPPOUT (fetch (IRISDATA SPPOUTSTREAM) of (fetch IRISDATA of IRISSTREAM]
(WITH.IRIS.ATTR (IRIS.CIRC X Y RADIUS SPPOUT)
SPPOUT IRISSTREAM :COLOR (CADDR BRUSH)
:WIDTH
(if (NOT (EQP (CADR BRUSH)
1))
then (CADR BRUSH)
else NIL)
:DASHING DASHING])
(\DRAWCURVE.IRIS
[LAMBDA (IRISSTREAM KNOTS CLOSED BRUSH DASHING) (* gbn "12-Nov-85 15:43")
(* * takes a list of knots. It must build a set of bezier control points for each knot pair.)
(LET ((SPPOUT (fetch SPPOUTSTREAM of (fetch IRISDATA of IRISSTREAM)))
SPLINE)
(WITH.IRIS.ATTR [PROGN [SETQ SPLINE (PARAMETRICSPLINE KNOTS CLOSED
(fetch SCRATCHSPLINE
of (fetch IRISDATA
of IRISSTREAM]
(* convert the list of knots to a parametric spline
description.)
(\SCALE.SPLINE.BY.DERIVS SPLINE)
(* For each knot in the spline, use the knots and the
derivatives to compute bezier control points)
(for KNOT# from 1 to (SUB1 (fetch #KNOTS of SPLINE))
do (SETQ GEOMETRY (\PSPLINE.TO.BEZIER.GEOMETRY SPLINE
KNOT#))
(SELECTQ \IRIS.VERSION
(GL1 (IRIS.CURVE 10 \BEZIERBASIS.IRIS GEOMETRY
SPPOUT))
(GL2 (IRIS.CRV GEOMETRY SPPOUT))
(ERROR "UNKNOWN IRIS VERSION" \IRIS.VERSION]
SPPOUT IRISSTREAM :COLOR (CADDR BRUSH)
:WIDTH
(if (NOT (EQP (CADR BRUSH)
1))
then (CADR BRUSH)
else NIL)
:DASHING DASHING)
(fetch #KNOTS of SPLINE])
(\DRAWLINE.IRIS
[LAMBDA (IRISSTREAM X1 Y1 X2 Y2 WIDTH OPERATION COLOR DASHING)
(* gbn "12-Nov-85 17:15")
(* * (check about color and operation) (sets irisx and irisy to x2 and y2 respectively))
(PROG ((IRISDATA (fetch IRISDATA of IRISSTREAM))
PUSHEDATTRIBUTES SPPOUT)
(SETQ SPPOUT (fetch (IRISDATA SPPOUTSTREAM) of IRISDATA))
(WITH.IRIS.ATTR (PROGN (IRIS.MOVE X1 Y1 (fetch IRISZ of IRISDATA)
SPPOUT)
(IRIS.DRAW (replace IRISX of IRISDATA with X2)
(replace IRISY of IRISDATA with Y2)
(fetch IRISZ of IRISDATA)
SPPOUT))
IRISSTREAM SPPOUT :COLOR COLOR :WIDTH WIDTH :DASHING DASHING])
(\CONVERTLINESTYLE.IRIS
[LAMBDA (DASHING) (* gbn "12-Nov-85 13:54")
(* * takes an Interlisp style dashing description (a list of on then off pixels) and turns it into a 16 bit dashing
description, like the IRIS likes.)
(bind (RESULT ← 0) for PIX in DASHING as (FLAG ← 1) by (IDIFFERENCE 1 FLAG)
do [SETQ RESULT (LOGOR (LLSH RESULT PIX)
(ITIMES FLAG (SUB1 (EXPT 2 PIX]
finally (RETURN (LOGAND (SUB1 (EXPT 2 16))
RESULT])
(\IRISSTREAMINIT
[LAMBDA NIL (* gbn "11-Nov-85 16:17")
(* * installs the definition of the Iris ImageOps)
(DECLARE (GLOBALVARS \IRISIMAGEOPS))
(SETQ \IRISIMAGEOPS (create IMAGEOPS
IMAGETYPE ←(QUOTE IRIS)
IMCLOSEFN ←(FUNCTION \CLOSEFN.IRIS)
IMMOVETO ←(FUNCTION \MOVETO.IRIS)
IMXPOSITION ←(FUNCTION \XPOSITION.IRIS)
IMYPOSITION ←(FUNCTION \YPOSITION.IRIS)
IMFONT ←(FUNCTION \FONT.IRIS)
IMFONTCREATE ←(FUNCTION IRIS)
IMDRAWLINE ←(FUNCTION \DRAWLINE.IRIS)
IMLEFTMARGIN ←(FUNCTION \LEFTMARGIN.IRIS)
IMRIGHTMARGIN ←(FUNCTION \ILLEGALARG)
IMLINEFEED ←(FUNCTION \ILLEGALARG)
IMDRAWCURVE ←(FUNCTION \DRAWCURVE.IRIS)
IMDRAWCIRCLE ←(FUNCTION \DRAWCIRCLE.IRIS)
IMDRAWELLIPSE ←(FUNCTION \DRAWELLIPSE.IRIS)
IMFILLCIRCLE ←(FUNCTION \FILLCIRCLE.IRIS)
IMSTRINGWIDTH ←(FUNCTION \STRINGWIDTH.IRIS)
IMCHARWIDTH ←(FUNCTION \CHARWIDTH.IRIS)
IMBLTSHADE ←(FUNCTION \BLTSHADE.IRIS)
IMBITBLT ←(FUNCTION \BITBLT.IRIS)
IMNEWPAGE ←(FUNCTION \ILLEGALARG)
IMSCALE ←(FUNCTION \SCALE.IRIS)
IMTERPRI ←(FUNCTION \TERPRI.IRIS)
IMTOPMARGIN ←(FUNCTION \ILLEGALARG)
IMBOTTOMMARGIN ←(FUNCTION \ILLEGALARG)
IMBACKCOLOR ←(FUNCTION \BACKCOLOR.IRIS)
IMCOLOR ←(FUNCTION \COLOR.IRIS)
IMCLIPPINGREGION ←(FUNCTION \CLIPPINGREGION.IRIS)
IMRESET ←(FUNCTION \RESET.IRIS)
IMDRAWPOLYGON ←(FUNCTION \DRAWPOLYGON.IRIS)
IMFILLPOLYGON ←(FUNCTION \FILLPOLYGON.IRIS)))
(SETQ \FACT.IRIS (ARRAY 4 0 0.0 0))
(SETA \FACT.IRIS 0 1.0)
(SETA \FACT.IRIS 1 1.0)
(SETA \FACT.IRIS 2 2.0)
(SETA \FACT.IRIS 3 6.0)
\IRISIMAGEOPS])
(\MOVETO.IRIS
[LAMBDA (IRISSTREAM XPOS YPOS) (* gbn "12-Nov-85 14:36")
(LET ((IRISDATA (fetch IRISDATA of IRISSTREAM)))
(IRIS.MOVE (replace IRISX of IRISDATA with XPOS)
(replace IRISY of IRISDATA with YPOS)
(fetch IRISZ of IRISDATA)
(fetch SPPOUTSTREAM of IRISDATA])
(\XPOSITION.IRIS
[LAMBDA (IRISSTREAM XPOS) (* gbn "24-Jun-85 01:17")
(* * adjust only the xpos)
(PROG ((IRISDATA (fetch IRISDATA of IRISSTREAM)))
(RETURN (if XPOS
then (IRIS.MOVE (replace IRISX of IRISDATA with XPOS)
(fetch IRISY of IRISDATA)
(fetch IRISZ of IRISDATA)
(fetch SPPOUTSTREAM of IRISDATA))
XPOS
else (OR (fetch IRISX of IRISDATA)
(replace IRISX of IRISDATA
with (CAR (IRIS.GETGPOS NIL NIL NIL NIL \IRISSTREAM])
(\YPOSITION.IRIS
[LAMBDA (IRISSTREAM YPOS) (* gbn "17-Jun-85 15:05")
(* * adjust only the ypos)
(PROG ((IRISDATA (fetch IRISDATA of IRISSTREAM)))
(RETURN (if YPOS
then (IRIS.MOVE (fetch IRISX of IRISDATA)
(replace IRISY of IRISDATA with YPOS)
(fetch IRISZ of IRISDATA)
(fetch SPPOUTSTREAM of IRISDATA))
YPOS
else (fetch IRISY of IRISDATA])
(\FILLCIRCLE.IRIS
[LAMBDA (IRISSTREAM CENTERX CENTERY RADIUS TEXTURE) (* gbn "11-Nov-85 19:19")
(* IRISSTREAM is guaranteed to be an IRIS stream)
(COND
((OR (NOT (NUMBERP RADIUS))
(ILESSP (SETQ RADIUS (FIXR RADIUS))
0))
(\ILLEGAL.ARG RADIUS))
(T (LET* ((IRISDATA (fetch IRISDATA of IRISSTREAM))
(SPPOUT (fetch (IRISDATA SPPOUTSTREAM) of IRISDATA)))
(WITH.IRIS.ATTR (IRIS.CIRCF CENTERX CENTERY RADIUS SPPOUT)
IRISSTREAM SPPOUT :COLOR TEXTURE])
(\DRAWELLIPSE.IRIS
[LAMBDA (IRISSTREAM CENTERX CENTERY SEMIMINORRADIUS SEMIMAJORRADIUS ORIENTATION BRUSH DASHING)
(* gbn "11-Nov-85 19:07")
(PROG [(SINOR (COND
(ORIENTATION (SIN ORIENTATION))
(T 0.0)))
(COSOR (COND
(ORIENTATION (COS ORIENTATION))
(T 1.0]
(\DRAWCURVE.IRIS IRISSTREAM [LIST (CREATEPOSITION (PLUS CENTERX (FTIMES COSOR
SEMIMAJORRADIUS))
(PLUS CENTERY (FTIMES SINOR
SEMIMAJORRADIUS)))
(CREATEPOSITION (DIFFERENCE CENTERX
(FTIMES SINOR
SEMIMINORRADIUS))
(PLUS CENTERY (FTIMES COSOR
SEMIMINORRADIUS)))
(CREATEPOSITION (DIFFERENCE CENTERX
(FTIMES COSOR
SEMIMAJORRADIUS))
(DIFFERENCE CENTERY
(FTIMES SINOR
SEMIMAJORRADIUS)))
(CREATEPOSITION (PLUS CENTERX (FTIMES SINOR
SEMIMINORRADIUS))
(DIFFERENCE CENTERY
(FTIMES COSOR
SEMIMINORRADIUS]
T BRUSH DASHING)
(MOVETO CENTERX CENTERY IRISSTREAM])
(\FILLPOLYGON.IRIS
[LAMBDA (IRISSTREAM POINTS TEXTURE CONVEX?) (* gbn "11-Nov-85 19:30")
(LET ((IRISDATA (fetch IRISDATA of IRISSTREAM))
COLOR PUSHEDATTRIBUTES SPPOUT)
(SETQ COLOR (\IRIS.ASSURE.COLOR TEXTURE IRISSTREAM))
(SETQ SPPOUT (fetch (IRISDATA SPPOUTSTREAM) of IRISDATA))
(if COLOR
then (* save the current attributes since this fn is to
have no side effects)
(SETQ PUSHEDATTRIBUTES T)
(IRIS.PUSHATTRIBUTES SPPOUT)
(IRIS.COLOR COLOR SPPOUT))
(if (NOT CONVEX?)
then (* break the polygon up into convex hunks, then fill
each of those.)
(for POLY in (TRAPLOOP POINTS) do (IRIS.POLF2
(LENGTH POLY)
(for P in POLY
collect (LIST (CAR P)
(CDR P)))
SPPOUT))
else (IRIS.POLF2 (LENGTH POINTS)
(for P in POINTS collect (LIST (CAR P)
(CDR P)))
SPPOUT))
(if PUSHEDATTRIBUTES
then (IRIS.POPATTRIBUTES SPPOUT])
(\IRIS.BITBLT
[LAMBDA (SOURCE SOURCELEFT SOURCEBOTTOM DESTINATION DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT
SOURCETYPE OPERATION TEXTURE CLIPPINGREGION)
(* gbn " 7-Aug-85 23:36")
(PROG ((COLOR (DSPCOLOR NIL DESTINATION))
(SPPOUT (fetch SPPOUTSTREAM of (fetch IRISDATA of DESTINATION)))
NLONGS)
(for Y from DESTINATIONBOTTOM to (IPLUS DESTINATIONBOTTOM HEIGHT)
do (IRIS.CMOV2I DESTINATIONLEFT (PLUS DESTINATIONBOTTOM Y)
SPPOUT)
(* IRIS.WRITEPIXELS WIDTH (for X from SOURCELEFT to (IPLUS SOURCELEFT (SUB1 WIDTH)) collect
(ITIMES (BITMAPBIT SOURCE X Y) COLOR)) DESTINATION)
(* the current character position determines where a
write pixels op happens)
(PROGN
(* * now do an inline IRIS.WRITEPIXELS)
(IRIS.GCMD 182 SPPOUT)
(IRIS.SENDS WIDTH SPPOUT)
(SETQ NLONGS (FOLDHI WIDTH 2))
(IRIS.SENDL (LLSH NLONGS 1)
SPPOUT) (* Send the number of bytes to be sent)
(bind ALONG for X from SOURCELEFT to (IPLUS SOURCELEFT (SUB1 WIDTH))
by 2
do (SETQ ALONG (LOGOR (LLSH (ITIMES (BITMAPBIT SOURCE X Y)
COLOR)
16)
(ITIMES (BITMAPBIT SOURCE (ADD1 X)
Y)
COLOR)))
(COND
((IRIS.DOSYNC (IQUOTIENT X 2))
(IRIS.PUTGCHAR IRIS\AESC SPPOUT)))
(IRIS.SENDL ALONG SPPOUT])
(\DRAWPOLYGON.IRIS
[LAMBDA (IRISSTREAM POINTS TEXTURE) (* gbn "13-Nov-85 17:32")
(PROG ((IRISDATA (fetch IRISDATA of IRISSTREAM))
COLOR SPPOUT)
[SETQ COLOR (if (AND (LISTP TEXTURE)
(RGBP (CADR TEXTURE)))
then (SETQ INDEX (\LOOKUPRGB (CADR TEXTURE)
IRISDATA]
(SETQ SPPOUT (fetch (IRISDATA SPPOUTSTREAM) of IRISDATA))
(if COLOR
then (* save the current attributes since this fn is to
have no side effects)
(SETQ PUSHEDATTRIBUTES T)
(IRIS.PUSHATTRIBUTES SPPOUT)
(IRIS.COLOR COLOR SPPOUT))
(IRIS.POLY2 (LENGTH POINTS)
POINTS SPPOUT)
(if PUSHEDATTRIBUTES
then (IRIS.POPATTRIBUTES SPPOUT])
(ALIGN
[LAMBDA (STREAM) (* gbn "17-Jun-85 15:06")
(* * this is a dummy to insure that the IRIS has caught up on the output side. When it returns a value, it has
caught up)
(IRIS.GETCOLOR (OR STREAM (fetch SPPINSTREAM of (fetch IRISDATA of \IRISSTREAM])
)
(* * test functions)
(DECLARE: EVAL@LOAD DONTCOPY
(LOADDEF (QUOTE SPLINE)
(QUOTE RECORD)
(QUOTE ADISPLAY))
)
[DECLARE: EVAL@COMPILE
(RECORD BEZIER ((B0X B0Y B0Z)
(B1X B1Y B1Z)
(B2X B2Y B2Z)
(B3X B3Y B3Z))
B0Z ← 0 B1Z ← 0 B2Z ← 0 B3Z ← 0)
(DATATYPE IRISDATA (IRISX IRISY IRISZ SPPOUTSTREAM SPPINSTREAM SCRATCHSPLINE FONTSINIRIS
CURRENTFONTDESC HIFONT# CURRENTFONTBASE BACKCOLOR IRISCLIPPINGREGION
IRISCOLORMAP IRISCOLORMAPCACHE IRISCHARSET IRISWIDTHSCACHE IRISPAGE)
FONTSINIRIS ←(LIST NIL)
IRISX ← 0 IRISY ← 0 IRISZ ← 0 SCRATCHSPLINE ←(create SPLINE)
HIFONT# ← -255 IRISCOLORMAP ←(COLORMAPCREATE NIL \IRIS.BITPLANES))
(RECORD IRISSTREAM STREAM (SUBRECORD STREAM)
[ACCESSFNS ((IRISDATA (FETCH (STREAM IMAGEDATA) OF DATUM)
(REPLACE (STREAM IMAGEDATA) OF DATUM
WITH NEWVALUE]
(TYPE? (TYPE? IRISDATA OF (FETCH (STREAM IMAGEDATA) OF DATUM))))
(RECORD SPLINE (#KNOTS SPLINEX SPLINEY SPLINEDX SPLINEDY SPLINEDDX SPLINEDDY SPLINEDDDX SPLINEDDDY))
]
(/DECLAREDATATYPE (QUOTE IRISDATA)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER))
(QUOTE ((IRISDATA 0 POINTER)
(IRISDATA 2 POINTER)
(IRISDATA 4 POINTER)
(IRISDATA 6 POINTER)
(IRISDATA 8 POINTER)
(IRISDATA 10 POINTER)
(IRISDATA 12 POINTER)
(IRISDATA 14 POINTER)
(IRISDATA 16 POINTER)
(IRISDATA 18 POINTER)
(IRISDATA 20 POINTER)
(IRISDATA 22 POINTER)
(IRISDATA 24 POINTER)
(IRISDATA 26 POINTER)
(IRISDATA 28 POINTER)
(IRISDATA 30 POINTER)
(IRISDATA 32 POINTER)))
(QUOTE 34))
(DECLARE: EVAL@COMPILE
(RPAQQ \ALTLINESTYLE.IRIS 1)
(RPAQQ \IRIS.ITALICS.ROTATION -100)
(RPAQQ \PRIMARYLINESTLE.IRIS 0)
(RPAQQ \IRIS.BOLD.LINEWIDTH 2)
(CONSTANTS (\ALTLINESTYLE.IRIS 1)
(\IRIS.ITALICS.ROTATION -100)
(\PRIMARYLINESTLE.IRIS 0)
(\IRIS.BOLD.LINEWIDTH 2))
)
(\IRISSTREAMINIT)
(SETFONTCLASSCOMPONENT DEFAULTFONT (QUOTE IRIS)
(QUOTE (GACHA 12)))
(ADDTOVAR DEFAULTPRINTINGHOST (IRIS Iris))
(ADDTOVAR PRINTERTYPES (IRIS (CANPRINT (IRIS))
(BITMAPFILE (IRISBITMAP FILE BITMAP SCALEFACTOR REGION ROTATION TITLE))
))
(PUTPROP (QUOTE Iris)
(QUOTE PRINTERTYPE)
(QUOTE IRIS))
(PUTPROPS Iris PRINTERTYPE IRIS)
(DECLARE: EVAL@COMPILE
[DEFMACRO WITH.IRIS.ATTR (FORM SPPOUT IRISSTREAM &KEY (COLOR NIL COLORSET)
(WIDTH NIL WIDTHSET)
(DASHING NIL DASHINGSET))
(BQUOTE (LET [PUSHED ., [if COLORSET then (BQUOTE ((ECOLOR , COLOR]
.,
[if WIDTHSET then (BQUOTE ((EWIDTH , WIDTH]
.,
(if DASHINGSET then (BQUOTE ((EDASHING , DASHING]
.,
[if COLORSET then (BQUOTE ((SETQ ECOLOR (AND ECOLOR (\IRIS.ASSURE.COLOR ECOLOR
IRISSTREAM]
.,
[if DASHINGSET then (BQUOTE ((SETQ EDASHING (AND EDASHING (
\CONVERTLINESTYLE.IRIS
EDASHING]
[IF [OR ., (if COLORSET then (QUOTE (ECOLOR)))
.,
(if WIDTHSET then (QUOTE (EWIDTH)))
.,
(if DASHINGSET then (QUOTE (EDASHING]
THEN
(SETQ PUSHED T)
(IRIS.PUSHATTRIBUTES , SPPOUT)
.,
[IF COLORSET THEN (BQUOTE ((IF ECOLOR THEN (IRIS.COLOR ECOLOR , SPPOUT]
.,
[IF WIDTHSET THEN
(BQUOTE ((IF EWIDTH THEN (SELECTQ \IRIS.VERSION
(GL2 (IRIS.LINEWIDTH EWIDTH , SPPOUT)
)
(GL1 (if (IGREATERP EWIDTH 2)
then NIL else
(IRIS.LINEWIDTH 2 , SPPOUT))
)
(ERROR "UNKNOWN VERSION"
\IRIS.VERSION]
.,
(IF DASHINGSET THEN (BQUOTE ((IF EDASHING THEN (IRIS.DEFLINESTYLE
\ALTLINESTYLE.IRIS
EDASHING ,
SPPOUT)
(IRIS.SETLINESTYLE \ALTLINESTYLE.IRIS
SPPOUT)
(IRIS.RESETLS 0 SPPOUT]
, FORM (IF PUSHED THEN (IRIS.POPATTRIBUTES , SPPOUT]
)
(DECLARE: DONTCOPY
(FILEMAP (NIL (3553 53560 (BOXSCREEN 3563 . 4031) (CLEARIRIS 4033 . 5237) (DRAWBITMAP 5239 . 7487) (
IRISBITMAP 7489 . 7991) (FILLPOLYGON 7993 . 8216) (INSTALL.OBJFONT 8218 . 12012) (OPENIRISSTREAM 12014
. 15100) (\CLOSEF.IRIS 15102 . 15486) (R 15488 . 15639) (SPPINPUTSTREAM 15641 . 15915) (TRYGRAPHER
15917 . 16724) (\BACKCOLOR.IRIS 16726 . 17025) (\BITBLT.IRIS 17027 . 17724) (\BLTSHADE.IRIS 17726 .
18705) (\FONTCREATE.IRIS 18707 . 20908) (\FONTSAVAILABLE.IRIS 20910 . 22148) (\LEFTMARGIN.IRIS 22150
. 22514) (\RESET.IRIS 22516 . 22858) (\LOOKUPRGB 22860 . 23879) (\PSPLINE.TO.BEZIER.GEOMETRY 23881 .
26003) (\SCALE.IRIS 26005 . 26180) (\SCALE.SPLINE.BY.DERIVS 26182 . 27013) (\STRINGWIDTH.IRIS 27015 .
27601) (\TERPRI.IRIS 27603 . 28085) (\FONT.IRIS 28087 . 28929) (\CREATECHARSET.IRIS 28931 . 32960) (
\IRISSETFONTBASE 32962 . 33172) (\IRISFONTBASE 33174 . 33382) (\CHANGECHARSET.IRIS 33384 . 34685) (
\CHARWIDTH.IRIS 34687 . 34907) (\OUTCHARFN.IRIS 34909 . 37769) (\CLIPPINGREGION.IRIS 37771 . 38095) (
\CLOSEFN.IRIS 38097 . 38355) (\COLOR.IRIS 38357 . 38723) (\IRIS.ASSURE.COLOR 38725 . 40473) (
\DRAWCIRCLE.IRIS 40475 . 40941) (\DRAWCURVE.IRIS 40943 . 42472) (\DRAWLINE.IRIS 42474 . 43286) (
\CONVERTLINESTYLE.IRIS 43288 . 43889) (\IRISSTREAMINIT 43891 . 45854) (\MOVETO.IRIS 45856 . 46249) (
\XPOSITION.IRIS 46251 . 46910) (\YPOSITION.IRIS 46912 . 47451) (\FILLCIRCLE.IRIS 47453 . 48081) (
\DRAWELLIPSE.IRIS 48083 . 49352) (\FILLPOLYGON.IRIS 49354 . 50632) (\IRIS.BITBLT 50634 . 52318) (
\DRAWPOLYGON.IRIS 52320 . 53199) (ALIGN 53201 . 53558)))))
STOP