(FILECREATED "21-Jan-85 18:50:08" {PHYLUM}<PEDERSEN>LISP>SPINBLT.;2
 4229   

      changes to:  (FNS BMSTUFF SPINBLT)

      previous date: "14-Jan-85 16:13:02" {FLOPPY}<STEPHEN% PETERS>SPINBLT.;1)


(PRETTYCOMPRINT SPINBLTCOMS)

(RPAQQ SPINBLTCOMS
 ((FNS BMSTUFF ONSPHERE SCATTER SPIN SPINBLT)))
(DEFINEQ

(BMSTUFF

  [LAMBDA (XYZ BMSTACK BMZ)                                  (* jop: "21-Jan-85 16:26")


          (* * comment)



    (
PROG
 ((X (
CAR
 XYZ))
	   (Y (
CADR
 XYZ))
	   (Z (
CADDR
 XYZ)))
          (
RETURN
 (for
 BZ in
 BMZ as
 BM in
 BMSTACK do
 (if
 (
FLESSP
 Z BZ)
							 then
 (
BITMAPBIT
 BM (
FIX
 X)
									 (
FIX
 Y)
									 1)
							      (
RETURN
 T])

(ONSPHERE

  [LAMBDA (RADIUS CENTER)                                    (* SCP "14-Jan-85 12:58")


          (* * comment)



    (
PROG
 ((X (
FLOAT
 (
RAND
 -1000 1000)))
	   (Y (
FLOAT
 (
RAND
 -1000 1000)))
	   (Z (
FLOAT
 (
RAND
 -1000 1000)))
	   LENGTH)
          [
SETQ
 LENGTH (
SQRT
 (
FPLUS
 (
FTIMES
 X X)
				    (
FTIMES
 Y Y)
				    (
FTIMES
 Z Z]
          (
RETURN
 (
LIST
 (
FPLUS
 (
CAR
 CENTER)
			       (
FTIMES
 RADIUS (
FQUOTIENT
 X LENGTH)))
			(
FPLUS
 (
CADR
 CENTER)
			       (
FTIMES
 RADIUS (
FQUOTIENT
 Y LENGTH)))
			(
FPLUS
 (
CADDR
 CENTER)
			       (
FTIMES
 RADIUS (
FQUOTIENT
 Z LENGTH])

(SCATTER

  [LAMBDA (BITMAP XYZ)                                       (* SCP "11-Jan-85 15:00")


          (* * comment)



    (
PROG
 [(COSTHETA (
COS
 (
FTIMES
 (
FLOAT
 LASTMOUSEX)
				  .18)))
	   (SINTHETA (
SIN
 (
FTIMES
 (
FLOAT
 LASTMOUSEX)
				  .18]
          (for
 POINT in
 XYZ do
 (
BITMAPBIT
 BITMAP [
IPLUS
 200 (
FIX
 (
FPLUS
 (
FTIMES
 COSTHETA
										(
CAR
 POINT))
									(
FTIMES
 SINTHETA
										(
CADDR
 POINT]
					  (
IPLUS
 200 (
FIX
 (
CADR
 POINT)))
					  1])

(SPIN

  [LAMBDA NIL                                                (* SCP "11-Jan-85 15:01")


          (* * comment)



    (
PROG
 ((W (
CREATEW
 (
CREATEREGION
 0 0 400 400)))
	   (B (
BITMAPCREATE
 400 400 1))
	   (XYZ NIL))
          [for
 I from
 -150 to
 150 by
 100
	     do
 (for
 J from
 -150 to
 150 by
 100 do
 (for
 K from
 -150 to
 -50 by
 100
						     do
 (push
 XYZ (
LIST
 (
FLOAT
 I)
									(
FLOAT
 J)
									(
FLOAT
 K]
          (while
 T
	     do
 (SCATTER
 B XYZ)
		(
BITBLT
 B 0 0 W 0 0 400 400 (
QUOTE
 INPUT)
			(
QUOTE
 REPLACE)
			NIL NIL)
		(
BITBLT
 B 0 0 B 0 0 400 400 (
QUOTE
 INPUT)
			(
QUOTE
 INVERT)
			NIL NIL)
		(
BLOCK
])

(SPINBLT

  [LAMBDA (
ARG
)                                              (* jop: "21-Jan-85 17:04")


          (* * comment)



    (LET* ((W (
CREATEW
))
       (WWIDTH (
WINDOWPROP
 W (
QUOTE
 WIDTH)))
       (WHEIGHT (
WINDOWPROP
 W (
QUOTE
 HEIGHT)))
       (WBACK (
BITMAPCREATE
 WWIDTH WHEIGHT))
       (BMSTACK (for
 I from
 1 to
 8 collect
 (
BITMAPCREATE
 WWIDTH WHEIGHT)))
       (WRADIUS (
QUOTIENT
 (
MIN
 WWIDTH WHEIGHT)
			  2.0))
       (BMZ (for
 Z from
 (
MINUS
 WRADIUS) to
 WRADIUS by
 (
QUOTIENT
 WRADIUS 3.5) collect
 Z)))
      (for
 I from
 1 to
 ARG do
 (BMSTUFF
 (ONSPHERE
 (
QUOTIENT
 WRADIUS 1.3)
						 (
LIST
 (
QUOTIENT
 WWIDTH 2.0)
						       (
QUOTIENT
 WHEIGHT 2.0)
						       0.0))
				       BMSTACK BMZ))
      (while
 T
	 do
 [
SETQ
 TANTHETA (
SIN
 (
FLOAT
 (
QUOTIENT
 LASTMOUSEX 15]
	    [
SETQ
 TANPHI (
SIN
 (
FLOAT
 (
QUOTIENT
 LASTMOUSEY 15]
	    (for
 BM in
 BMSTACK as
 Z in
 BMZ do
 (
BITBLT
 BM 0 0 WBACK (
FIX
 (
FTIMES
 Z TANTHETA))
						      (
FIX
 (
FTIMES
 Z TANPHI))
						      WWIDTH WHEIGHT (
QUOTE
 INPUT)
						      (
QUOTE
 PAINT)))
	    (
BITBLT
 WBACK 0 0 W 0 0 WWIDTH WHEIGHT (
QUOTE
 INPUT)
		    (
QUOTE
 REPLACE))
	    (
BITBLT
 WBACK 0 0 WBACK 0 0 WWIDTH WHEIGHT (
QUOTE
 INPUT)
		    (
QUOTE
 INVERT))
	    (
BLOCK
])
)
(DECLARE: DONTCOPY
  (FILEMAP (NIL (306 4207 (BMSTUFF 316 . 746) (ONSPHERE 748 . 1439) (SCATTER 1441 . 1993) (SPIN 1995 . 
2759) (SPINBLT 2761 . 4205)))))
STOP