(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