(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