(FILECREATED " 4-Dec-84 14:04:43" {ERIS}<LISPCORE>SOURCES>NEWBITBLTS.;1 7061
changes to: (VARS NEWBITBLTSCOMS))
(* Copyright (c) 1984 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT NEWBITBLTSCOMS)
(RPAQQ NEWBITBLTSCOMS ((FNS \BITBLT.IP \BITBLT.PRESS \INTERPRESSINIT \PRESSINIT)))
(DEFINEQ
(\BITBLT.IP
[LAMBDA (SOURCEBITMAP SOURCELEFT SOURCEBOTTOM DESTSTRM DESTINATIONLEFT DESTINATIONBOTTOM WIDTH
HEIGHT SOURCETYPE OPERATION TEXTURE CLIPPINGREGION)
(* hdj " 3-Dec-84 18:02")
(LET ((DESTINATIONLEFT (OR DESTINATIONLEFT (\DSPXPOSITION.IP DESTSTRM)))
(DESTINATIONBOTTOM (OR DESTINATIONBOTTOM (\DSPYPOSITION.IP DESTSTRM)))
(SOURCELEFT (OR SOURCELEFT 0))
(SOURCEBOTTOM (OR SOURCEBOTTOM 0))
(WIDTH (OR WIDTH (BITMAPWIDTH SOURCEBITMAP)))
(HEIGHT (OR HEIGHT (BITMAPHEIGHT SOURCEBITMAP)))
(OLDX (\DSPXPOSITION.IP DESTSTRM))
(OLDY (\DSPYPOSITION.IP DESTSTRM)))
(\MOVETO.IP DESTSTRM DESTINATIONLEFT DESTINATIONBOTTOM)
(SHOWBITMAP.IP DESTSTRM SOURCEBITMAP (COND
(CLIPPINGREGION (INTERSECTREGIONS CLIPPINGREGION (CREATEREGION SOURCELEFT
SOURCEBOTTOM
WIDTH HEIGHT)))
(T (CREATEREGION SOURCELEFT SOURCEBOTTOM WIDTH HEIGHT)))
1)
(\MOVETO.IP DESTSTRM OLDX OLDY])
(\BITBLT.PRESS
[LAMBDA (SOURCEBITMAP SOURCELEFT SOURCEBOTTOM DESTSTRM DESTINATIONLEFT DESTINATIONBOTTOM WIDTH
HEIGHT SOURCETYPE OPERATION TEXTURE CLIPPINGREGION)
(* hdj " 3-Dec-84 17:56")
(LET [(DESTINATIONLEFT (OR DESTINATIONLEFT (\DSPXPOSITION.PRESS DESTSTRM)))
(DESTINATIONBOTTOM (OR DESTINATIONBOTTOM (\DSPYPOSITION.PRESS DESTSTRM)))
(SOURCELEFT (OR SOURCELEFT 0))
(SOURCEBOTTOM (OR SOURCEBOTTOM 0))
(WIDTH (OR WIDTH (BITMAPWIDTH SOURCEBITMAP)))
(HEIGHT (OR HEIGHT (BITMAPHEIGHT SOURCEBITMAP]
(\WRITEPRESSBITMAP SOURCEBITMAP DESTINATIONLEFT DESTINATIONBOTTOM 1
(COND
(CLIPPINGREGION (INTERSECTREGIONS CLIPPINGREGION
(CREATEREGION SOURCELEFT SOURCEBOTTOM
WIDTH HEIGHT)))
(T (CREATEREGION SOURCELEFT SOURCEBOTTOM WIDTH HEIGHT)))
DESTSTRM])
(\INTERPRESSINIT
[LAMBDA NIL (* hdj " 3-Dec-84 17:19")
(DECLARE (GLOBALVARS \IPIMAGEOPS \ASCIITONS \ASCIITOSTAR HIPPOTONS))
(SETQ \IPIMAGEOPS (create IMAGEOPS
IMAGETYPE ←(QUOTE INTERPRESS)
IMCLOSEFN ←(FUNCTION \CLOSEIPSTREAM)
IMXPOSITION ←(FUNCTION \DSPXPOSITION.IP)
IMYPOSITION ←(FUNCTION \DSPYPOSITION.IP)
IMFONT ←(FUNCTION \DSPFONT.IP)
IMLEFTMARGIN ←(FUNCTION \DSPLEFTMARGIN.IP)
IMRIGHTMARGIN ←(FUNCTION \DSPRIGHTMARGIN.IP)
IMLINEFEED ←(FUNCTION \DSPLINEFEED.IP)
IMDRAWLINE ←(FUNCTION \DRAWLINE.IP)
IMDRAWCURVE ←(FUNCTION \DRAWCURVE.IP)
IMDRAWCIRCLE ←(FUNCTION \DRAWCIRCLE.IP)
IMDRAWELLIPSE ←(FUNCTION \DRAWELLIPSE.IP)
IMFILLCIRCLE ←[FUNCTION (LAMBDA (STREAM)
(\UNIMPIMAGEOP STREAM (QUOTE FILLCIRCLE]
IMBLTSHADE ←[FUNCTION (LAMBDA (STREAM)
(\UNIMPIMAGEOP STREAM (QUOTE BLTSHADE]
IMBITBLT ←(FUNCTION \BITBLT.IP)
IMMOVETO ←(FUNCTION \MOVETO.IP)
IMSCALE ←[FUNCTION (LAMBDA NIL
(CONSTANT (FQUOTIENT MICASPERINCH POINTSPERINCH]
IMTERPRI ←(FUNCTION NEWLINE.IP)
IMBOTTOMMARGIN ←(FUNCTION \DSPBOTTOMMARGIN.IP)
IMTOPMARGIN ←(FUNCTION \DSPTOPMARGIN.IP)
IMFONTCREATE ←(QUOTE INTERPRESS)
IMNEWPAGE ←(FUNCTION NEWPAGE.IP)
IMSPACEFACTOR ←(FUNCTION \DSPSPACEFACTOR.IP)
IMSTRINGWIDTH ←(FUNCTION \STRINGWIDTH.IP)
IMCHARWIDTH ←(FUNCTION \CHARWIDTH.IP)))
(* * Translation table for standard ascii to NS)
[SETQ \ASCIITONS (NSMAP NIL (QUOTE ((↑ 0 173)
(← 0 172)
($ 0 164)
(- 33 62)
(↑N 0 197)
(↑S 239 37)
(↑V 239 36)
(↑X 0 45)
(↑O 239 45)
(↑\ 239 44)
(↑Y 239 46)
(↑D 0 200)
(↑G 0 169)
(↑H 0 161)
(↑B 0 191)
(96 0 185)
(#↑%[ 239 36)
(#↑\ 239 37)
(#7 239 102] (* Map from ASCII to printer character code
(XC1-1-1 NS Encoding standard))
[SETQ \ASCIITOSTAR (NSMAP NIL (QUOTE ((↑ 0 173)
(← 0 172)
($ 0 164)
(↑N 0 197)
(↑S 239 37)
(↑V 239 36)
(↑X 0 45)
(↑O 239 45)
(↑\ 239 44)
(↑Y 239 46)
(↑D 0 200)
(↑G 0 169)
(↑H 0 161)
(↑B 0 191)
(96 0 185)
(#↑%[ 239 36)
(#↑\ 239 37)
(#7 239 102]
(* Map from ASCII to wedged OSD screen & .WD file character coding (alleged to be XC2-x-x, soon to come). The
difference is that "-" maps to itself for width purposes.)
(* Last 4 are backquote, hyphen instead of minus sign,
en dash, em dash, bullet)
])
(\PRESSINIT
[LAMBDA NIL (* hdj " 3-Dec-84 17:04")
(DECLARE (GLOBALVARS \PRESSIMAGEOPS))
(SETQ \PRESSIMAGEOPS (create IMAGEOPS
IMAGETYPE ←(QUOTE PRESS)
IMCLOSEFN ←(FUNCTION \CLOSEF.PRESS)
IMXPOSITION ←(FUNCTION \DSPXPOSITION.PRESS)
IMYPOSITION ←(FUNCTION \DSPYPOSITION.PRESS)
IMFONT ←(FUNCTION \DSPFONT.PRESS)
IMLEFTMARGIN ←(FUNCTION \DSPLEFTMARGIN.PRESS)
IMRIGHTMARGIN ←(FUNCTION \DSPRIGHTMARGIN.PRESS)
IMLINEFEED ←(FUNCTION \DSPLINEFEED.PRESS)
IMDRAWLINE ←(FUNCTION \DRAWLINE.PRESS)
IMDRAWCURVE ←(FUNCTION \DRAWCURVE.PRESS)
IMDRAWCIRCLE ←(FUNCTION \DRAWCIRCLE.PRESS)
IMDRAWELLIPSE ←(FUNCTION \DRAWELLIPSE.PRESS)
IMFILLCIRCLE ←[FUNCTION (LAMBDA (STREAM)
(\UNIMPIMAGEOP STREAM (QUOTE FILLCIRCLE]
IMBLTSHADE ←[FUNCTION (LAMBDA (STREAM)
(\UNIMPIMAGEOP STREAM (QUOTE BLTSHADE]
IMBITBLT ←(FUNCTION \BITBLT.PRESS)
IMSCALE ←[FUNCTION (LAMBDA NIL
(CONSTANT (FQUOTIENT MICASPERINCH 72]
IMTERPRI ←(FUNCTION NEWLINE.PRESS)
IMBOTTOMMARGIN ←(FUNCTION \DSPBOTTOMMARGIN.PRESS)
IMTOPMARGIN ←(FUNCTION \DSPTOPMARGIN.PRESS)
IMFONTCREATE ←(QUOTE PRESS)
IMNEWPAGE ←(FUNCTION NEWPAGE.PRESS)
IMSPACEFACTOR ←(FUNCTION \DSPSPACEFACTOR.PRESS)
IMSTRINGWIDTH ←(FUNCTION \STRINGWIDTH.PRESS)
IMCHARWIDTH ←(FUNCTION \CHARWIDTH.PRESS])
)
(PUTPROPS NEWBITBLTS COPYRIGHT ("Xerox Corporation" 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (318 6980 (\BITBLT.IP 328 . 1463) (\BITBLT.PRESS 1465 . 2431) (\INTERPRESSINIT 2433 .
5424) (\PRESSINIT 5426 . 6978)))))
STOP