(FILECREATED "26-APR-82 19:23:37" {PHYLUM}<LISPCORE>COLOR>OVERPAINT.;10
 5599   

     changes to:  NEWX NEWY

     previous date: "26-APR-82 19:02:15" {PHYLUM}<LISPCORE>COLOR>OVERPAINT.;9)


(PRETTYCOMPRINT OVERPAINTCOMS)

(RPAQQ OVERPAINTCOMS
 ((FNS NEWX NEWY OVERPAINT OVERPAINTBM OVERPAINTDEMO OVERPAINTSELFN 
			   BITMAPFROMSTRING SHADEBITMAP)
		      (VARS (OVERPAINTBITMAPS))))
(DEFINEQ

(NEWX

  [LAMBDA (BW SW)                                            (* º´Æ£ "26-APR-82 19:13")

    (SELECTQ MOVEMODE
	     (RANDOM (RAND (IMINUS BW)
			   SW))
	     (CURSOR (IDIFFERENCE LASTMOUSEX (IQUOTIENT BW 2)))
	     (LINE [COND
		     ((ILEQ (SETQ NSTEPS (SUB1 NSTEPS))
			    0)
		       (SETQ NSTEPS (RAND 0 40))
		       (COND
			 ((IGEQ (RAND 0 4)
				2)
			   (SETQ DX (RAND 0 10)))
			 (T (SETQ DY (RAND 0 10]
		   (COND
		     ((ILESSP (SETQ LASTX (IPLUS LASTX DX))
			      0)
		       (SETQ LASTX (IMINUS LASTX))
		       (SETQ DX (IMINUS DX)))
		     ((IGEQ LASTX SW)
		       (SETQ LASTX (IDIFFERENCE (ITIMES 2 SW)
						LASTX))
		       (SETQ DX (IMINUS DX)))
		     (T LASTX)))
	     (SHOULDNT])

(NEWY

  [LAMBDA (BH SH)                                            (* º´Æ£ "26-APR-82 19:13")

    (SELECTQ MOVEMODE
	     (RANDOM (RAND (IMINUS BH)
			   SH))
	     (CURSOR (IDIFFERENCE LASTMOUSEY (IQUOTIENT BH 2)))
	     (LINE [COND
		     ((ILEQ (SETQ NSTEPS (SUB1 NSTEPS))
			    0)
		       (SETQ NSTEPS (RAND 0 40))
		       (COND
			 ((IGEQ (RAND 0 4)
				2)
			   (SETQ DX (RAND 0 10)))
			 (T (SETQ DY (RAND 0 10]
		   (COND
		     ((ILESSP (SETQ LASTY (IPLUS LASTY DY))
			      0)
		       (SETQ LASTY (IMINUS LASTY))
		       (SETQ DY (IMINUS DY)))
		     ((IGEQ LASTY SH)
		       (SETQ LASTY (IDIFFERENCE (ITIMES 2 SH)
						LASTY))
		       (SETQ DY (IMINUS DY)))
		     (T LASTY)))
	     (SHOULDNT])

(OVERPAINT

  [LAMBDA (BM1 BM2 X Y TXT SCR)                              (* bas: "25-APR-82 14:58")

                                                             (* Uses BM1 as a mask thru which it paints texture onto 

							     BM2 at position X Y)

    [OR SCR (SETQ SCR (BITMAPCREATE (fetch
 BITMAPWIDTH of
 BM1)
				    (fetch
 BITMAPHEIGHT of
 BM1]
                                                             (* We need a scratch BM. Most demos cache one)

    (BITBLT BM2 X Y SCR 0 0 (fetch
 BITMAPWIDTH of
 BM1)
	    (fetch
 BITMAPHEIGHT of
 BM1)
	    (QUOTE INPUT)
	    (QUOTE REPLACE))
    (BITBLT BM1 0 0 SCR 0 0 NIL NIL (QUOTE INPUT)
	    (QUOTE ERASE))
    (BITBLT BM1 0 0 SCR 0 0 NIL NIL (QUOTE MERGE)
	    (QUOTE PAINT)
	    TXT)
    (BITBLT SCR 0 0 BM2 X Y (fetch
 BITMAPWIDTH of
 BM1)
	    (fetch
 BITMAPHEIGHT of
 BM1)
	    (QUOTE INPUT)
	    (QUOTE REPLACE])

(OVERPAINTBM

  [LAMBDA (BM FONT)                                          (* bas: "26-APR-82 19:01")

    (OR (BITMAPP BM)
	(SETQ BM (BITMAPFROMSTRING
 BM FONT)))
    (PROG ((BMW (fetch
 BITMAPWIDTH of
 BM))
	   (BMH (fetch
 BITMAPHEIGHT of
 BM))
	   (EBM (EXPANDBITMAP BM 4))
	   SCR)
          (SETQ SCR (BITMAPCREATE (ITIMES BMW 4)
				  BMH))
          (COLORBACKGROUND (RAND 0 7))
          (until
 (QUITP) do
 (AND (EQ 51 (RAND 0 200))
				 (COLORBACKGROUND (RAND 0 7)))
			    (OVERPAINT
 EBM (fetch
 COLORBITMAPPTR of
 (COLORSCREENBITMAP))
				       (ITIMES 4 (NEWX
 BMW COLORSCREENWIDTH))
				       (NEWY
 BMH COLORSCREENHEIGHT)
				       (COLORTEXTUREFROMCOLOR# (RAND 0 7))
				       SCR])

(OVERPAINTDEMO

  [LAMBDA NIL                                                (* bas: "26-APR-82 18:38")

    (DECLARE
 (GLOBALVARS /NEWCOLORDEMO STOPDATE))
    (RESETLST [RESETSAVE NIL (LIST (QUOTE CLOSEW)
				   (ADDMENU (create
 MENU
						    ITEMS _(QUOTE (RANDOM LINE CURSOR NONE))
						    WHENSELECTEDFN _(QUOTE OVERPAINTSELFN]
	      (SETQ MOVEMODE (QUOTE LINE))
	      [SETQ LASTX (SETQ LASTY (SETQ DX (SETQ DY (SETQ NSTEPS 0]
	      (for
 I in
 [OR OVERPAINTBITMAPS (SETQ OVERPAINTBITMAPS (CONS (BITMAPFROMSTRING
)
									  (READBMLST (QUOTE HLSTRINGS]
		 until
 (OR /NEWCOLORDEMO (EQ MOVEMODE (QUOTE NONE))) do
 (SETQ STOPDATE
									  (IPLUS 60 (IDATE)))
									(OVERPAINTBM
 I])

(OVERPAINTSELFN

  [LAMBDA (V)                                                (* bas: "26-APR-82 18:07")

    (SETQ MOVEMODE V])

(BITMAPFROMSTRING

  [LAMBDA (STR FONT)                                         (* bas: "24-APR-82 16:18")

    (OR STR (SETQ STR "Interlisp-D"))
    [OR (FONTP FONT)
	(SETQ FONT (FONTCREATE (QUOTE TIMESROMAND)
			       (QUOTE 36]
    (PROG ((SCR (DSPCREATE))
	   (SW (STRINGWIDTH STR FONT))
	   (FH (FONTPROP FONT (QUOTE HEIGHT)))
	   BM)
          (SETQ BM (BITMAPCREATE SW FH))
          (DSPDESTINATION BM SCR)
          (DSPFONT FONT SCR)
          (MOVETO 0 (FONTPROP FONT (QUOTE DESCENT))
		  SCR)
          (PRIN1 STR SCR)
          (RETURN BM])

(SHADEBITMAP

  [LAMBDA (BM T0 T1)                                         (* bas: "25-APR-82 15:02")

                                                             (* Shades bitmap BM with T0 into 0 areas and T1 into 1 

							     areas)

    (BITBLT NIL NIL NIL BM NIL NIL NIL NIL (QUOTE TEXTURE)
	    (QUOTE INVERT)
	    (LOGAND T0 (LOGXOR T0 T1)))
    (BITBLT NIL NIL NIL BM NIL NIL NIL NIL (QUOTE TEXTURE)
	    (QUOTE PAINT)
	    (LOGAND T0 T1))
    (BITBLT NIL NIL NIL BM NIL NIL NIL NIL (QUOTE TEXTURE)
	    (QUOTE ERASE)
	    (LOGXOR (LOGOR T0 T1)
		    65535])
)

(RPAQQ OVERPAINTBITMAPS
 NIL)
(DECLARE: DONTCOPY
  (FILEMAP (NIL (392 5543 (NEWX 402 . 1124) (NEWY 1126 . 1848) (OVERPAINT 1850 . 2781) (OVERPAINTBM 2783
 . 3529) (OVERPAINTDEMO 3531 . 4259) (OVERPAINTSELFN 4261 . 4395) (BITMAPFROMSTRING 4397 . 4957) (
SHADEBITMAP 4959 . 5541)))))
STOP