(FILECREATED "30-Sep-85 11:41:40" {ERIS}<LISPCORE>LIBRARY>PIXELBLT.;2
 5205   

      changes to:  (FNS PIXELBLT)

      previous date: "14-Jun-85 18:58:32" {ERIS}<LISPCORE>LIBRARY>PIXELBLT.;1)


(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT PIXELBLTCOMS)

(RPAQQ PIXELBLTCOMS
 ((FNS BLUE+YELLOW=GREEN PIXELBLT PIXELBLT.TABLEBUILDER SPECKLE TESTFN)
		     (VARS BLUECOLOR GREENCOLOR YELLOWCOLOR)))
(DEFINEQ

(BLUE+YELLOW=GREEN

  [LAMBDA (SOURCE DEST XLO YLO)                              (* hdj "14-Jun-85 17:38")

    (LET ((BLUECOLOR 1)
       (YELLOWCOLOR 4)
       (GREENCOLOR 2))
      (if
 (
OR
 (
AND
 (
EQ
 SOURCE BLUECOLOR)
		   (
EQ
 DEST YELLOWCOLOR))
	      (
AND
 (
EQ
 SOURCE YELLOWCOLOR)
		   (
EQ
 DEST BLUECOLOR)))
	  then
 GREENCOLOR
	else
 SOURCE])

(PIXELBLT

  [LAMBDA (COLORTABLE SOURCEBITMAP SOURCELEFT SOURCEBOTTOM DESTBITMAP DESTINATIONLEFT 
		      DESTINATIONBOTTOM WIDTH HEIGHT)        (* hdj "30-Sep-85 11:26")

    (
PROG
 ((REALWIDTH (
OR
 WIDTH (
BITMAPWIDTH
 SOURCEBITMAP)))
	   (REALHEIGHT (
OR
 HEIGHT (
BITMAPHEIGHT
 SOURCEBITMAP)))
	   (REALDESTINATIONLEFT (
OR
 DESTINATIONLEFT 0))
	   (REALDESTINATIONBOTTOM (
OR
 DESTINATIONBOTTOM 0))
	   (REALSOURCELEFT (
OR
 SOURCELEFT 0))
	   (REALSOURCEBOTTOM (
OR
 SOURCEBOTTOM 0))
	   VALID-SOURCE-REGION VALID-DEST-REGION)
          (
\DTEST
 REALWIDTH (
QUOTE
 SMALLP))
          (
\DTEST
 REALHEIGHT (
QUOTE
 SMALLP))
          (
\DTEST
 REALDESTINATIONLEFT (
QUOTE
 SMALLP))
          (
\DTEST
 REALDESTINATIONBOTTOM (
QUOTE
 SMALLP))
          (
\DTEST
 COLORTABLE (
QUOTE
 ARRAYP))
          (
\DTEST
 SOURCEBITMAP (
QUOTE
 BITMAP))
          (
\DTEST
 DESTBITMAP (
QUOTE
 BITMAP))
          (
OR
 (
AND
 (
IGEQ
 REALSOURCELEFT 0)
		   (
IGEQ
 REALSOURCEBOTTOM 0)
		   (
IGEQ
 REALWIDTH 0)
		   (
IGEQ
 REALHEIGHT 0)
		   (
ILESSP
 REALSOURCELEFT (
BITMAPWIDTH
 SOURCEBITMAP))
		   (
ILESSP
 REALSOURCEBOTTOM (
BITMAPHEIGHT
 SOURCEBITMAP))
		   (
ILESSP
 REALDESTINATIONLEFT (
BITMAPWIDTH
 DESTBITMAP))
		   (
ILESSP
 REALDESTINATIONBOTTOM (
BITMAPHEIGHT
 DESTBITMAP)))
	      (
RETURN
))
          (
SETQ
 VALID-SOURCE-REGION (
INTERSECTREGIONS
 (
CREATEREGION
 0 0 (
BITMAPWIDTH
 SOURCEBITMAP)
								    (
BITMAPHEIGHT
 SOURCEBITMAP))
						      (
CREATEREGION
 REALSOURCELEFT REALSOURCEBOTTOM 
								    REALWIDTH REALHEIGHT)))
          (
SETQ
 VALID-DEST-REGION (
INTERSECTREGIONS
 (
CREATEREGION
 0 0 (
BITMAPWIDTH
 DESTBITMAP)
								  (
BITMAPHEIGHT
 DESTBITMAP))
						    (
CREATEREGION
 REALDESTINATIONLEFT 
								  REALDESTINATIONBOTTOM REALWIDTH 
								  REALHEIGHT)))
          (
NOT-PIXELBLT
 (fetch
 (
ARRAYP
 BASE) of
 COLORTABLE)
			SOURCEBITMAP REALSOURCELEFT REALSOURCEBOTTOM DESTBITMAP REALDESTINATIONLEFT 
			REALDESTINATIONBOTTOM (
IMIN
 (fetch
 WIDTH of
 VALID-SOURCE-REGION)
						    (fetch
 WIDTH of
 VALID-DEST-REGION))
			0
			(
IMIN
 (fetch
 HEIGHT of
 VALID-SOURCE-REGION)
			      (fetch
 HEIGHT of
 VALID-DEST-REGION])

(PIXELBLT.TABLEBUILDER

  [LAMBDA (FN)                                               (* hdj "14-Jun-85 16:41")

    (LET ((TABLE (
ARRAY
 256 (
QUOTE
 WORD)
			0 0 128)))
      [for
 sourceNybble from
 0 to
 15
	 do
 (for
 destNybble from
 0 to
 15
	       do
 (for
 XLowBit from
 0 to
 1
		     do
 (for
 YLowBit from
 0 to
 1
			   do
 

          (* The (LLSH ... (UNFOLD ...)) stuff below maps from (XLowBit YLowBit) into the position of the corresponding nybble

	  in the value. Believe it or not, we are saying (0 0) -> LLSH 12 , (1 0) -> LLSH 8 , (0 1) -> LLSH 4 , 

	  (1 1) -> LLSH 0)



			      (LET ((ELEMENT (
LOGOR
 (
LLSH
 sourceNybble 4)
						    destNybble)))
				(
SETA
 TABLE ELEMENT
				      (
LOGOR
 (
ELT
 TABLE ELEMENT)
					     (
LLSH
 (
APPLY*
 FN sourceNybble destNybble XLowBit YLowBit)
						   (UNFOLD (
IDIFFERENCE
 (
IDIFFERENCE
 3
										     (UNFOLD YLowBit 
											     2))
									XLowBit)
							   4]
      TABLE])

(SPECKLE

  [LAMBDA (SOURCE DEST XLO YLO)                              (* hdj "14-Jun-85 18:24")

    (LET ((BLUECOLOR 1)
       (YELLOWCOLOR 4)
       (GREENCOLOR 2)
       (REDCOLOR 3))
      (if
 (
OR
 (
AND
 (
ODDP
 XLO)
		   (
EQ
 SOURCE YELLOWCOLOR)
		   (
EQ
 DEST BLUECOLOR))
	      (
AND
 (
ODDP
 XLO)
		   (
EQ
 SOURCE BLUECOLOR)
		   (
EQ
 DEST YELLOWCOLOR)))
	  then
 YELLOWCOLOR
	elseif
 (
OR
 (
AND
 (
EVENP
 XLO)
			(
EQ
 SOURCE YELLOWCOLOR)
			(
EQ
 DEST BLUECOLOR))
		   (
AND
 (
EVENP
 XLO)
			(
EQ
 SOURCE BLUECOLOR)
			(
EQ
 DEST YELLOWCOLOR)))
	  then
 REDCOLOR
	else
 SOURCE])

(TESTFN

  [LAMBDA (SOURCE DEST XLOW YLOW)                            (* hdj "14-Jun-85 16:17")

    (if
 (
NEQ
 DEST 15)
	then
 SOURCE
      else
 DEST])
)

(RPAQQ BLUECOLOR
 1)

(RPAQQ GREENCOLOR
 2)

(RPAQQ YELLOWCOLOR
 4)
(PUTPROPS PIXELBLT COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (443 5048 (BLUE+YELLOW=GREEN 453 . 842) (PIXELBLT 844 . 3166) (PIXELBLT.TABLEBUILDER 
3168 . 4216) (SPECKLE 4218 . 4873) (TESTFN 4875 . 5046)))))
STOP