(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "12-Oct-87 17:02:01" {PHYLUM}<FOSTER>LISP>USERS>STARBG.;3 15095  

      changes to%:  (VARS STARBGCOMS)

      previous date%: "12-Oct-87 16:58:13" {PHYLUM}<FOSTER>LISP>USERS>STARBG.;2)


(* "
Copyright (c) 1984, 1985, 1986, 1987 by Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT STARBGCOMS)

(RPAQQ STARBGCOMS ((INITVARS (eventPause 0) (changeStars NIL) (starShade WHITESHADE) (voidShade BLACKSHADE) (stars1 (QUOTE (500 . 3000))) (stars2 (QUOTE (40 . 400))) (stars3 (QUOTE (6 . 70))) (stars4 (QUOTE (1 . 3))) (stars5 (QUOTE (1 . 10))) (constellations (QUOTE (1 . 9))) (clusters (QUOTE (0 . 5))) (clusterRadius (QUOTE (5 . 15))) (starsInCluster (QUOTE (50 . 150))) (superClusters (QUOTE (0 . 1))) (superClusterRadius (QUOTE (8 . 20))) (interiorClusters (QUOTE (2 . 7))) (starsInterior (QUOTE (30 . 100))) (BM1 (SETQ BM1 (BITMAPCREATE 1 1))) (BM2 (BITMAPCREATE 2 2)) (BM4 (BITMAPCREATE 3 3))) (BITMAPS BM3 BM5 nova) (VARS noReverseVideo saucer darkSaucer saucerMask supernova STARBGParameters trekNotes) (FNS Between BlackHole Catastrophe ChanceIn CloseFollower Constellation Cosmos InvertBM FillWithStars Marble OneChanceIn LowerBound OpenFollower PlusOrMinus RandGrey SaucerOn SaucerOff STARBG StarCluster SuperCluster SomethingCosmic StarFollowCursor StarryWindow Stomp TimePasses UFO UpperBound) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) (LAMA))) (P (RANDSET T) (OR (BOUNDP (QUOTE cursorFollower)) (SETQ cursorFollower (ICONW saucer saucerMask (CREATEPOSITION 0 0) T))) (if (BOUNDP (QUOTE IDLE.FUNCTIONS)) then (PUSH IDLE.FUNCTIONS (QUOTE ("Cosmos" (QUOTE Cosmos) "Go where no one has gone before... "))))))
)

(RPAQ? eventPause 0)

(RPAQ? changeStars NIL)

(RPAQ? starShade WHITESHADE)

(RPAQ? voidShade BLACKSHADE)

(RPAQ? stars1 (QUOTE (500 . 3000)))

(RPAQ? stars2 (QUOTE (40 . 400)))

(RPAQ? stars3 (QUOTE (6 . 70)))

(RPAQ? stars4 (QUOTE (1 . 3)))

(RPAQ? stars5 (QUOTE (1 . 10)))

(RPAQ? constellations (QUOTE (1 . 9)))

(RPAQ? clusters (QUOTE (0 . 5)))

(RPAQ? clusterRadius (QUOTE (5 . 15)))

(RPAQ? starsInCluster (QUOTE (50 . 150)))

(RPAQ? superClusters (QUOTE (0 . 1)))

(RPAQ? superClusterRadius (QUOTE (8 . 20)))

(RPAQ? interiorClusters (QUOTE (2 . 7)))

(RPAQ? starsInterior (QUOTE (30 . 100)))

(RPAQ? BM1 (SETQ BM1 (BITMAPCREATE 1 1)))

(RPAQ? BM2 (BITMAPCREATE 2 2))

(RPAQ? BM4 (BITMAPCREATE 3 3))

(RPAQQ BM3 #*(3 3)J@@@@@@@J@@@)

(RPAQQ BM5 #*(5 5)MH@@HH@@@@@@HH@@MH@@)

(RPAQQ nova #*(9 9)OGH@OGH@NCH@LAH@@@@@LAH@NCH@OGH@OGH@)

(RPAQQ noReverseVideo NIL)

(RPAQQ saucer #*(24 16)@@@@@@@@C@@@@L@@C@CL@L@@@HDBA@@@@DHAB@@@@C@@L@@@@OG@O@@@CBE@DL@@DBG@DB@@HB@@DA@@LAHAHC@@K@GN@O@@FN@@GJ@@CKOOJL@@@NJJO@@@@AOOH@@@
)

(RPAQQ darkSaucer #*(24 16)A@@@@D@@D@@@A@@@@H@@@B@@B@CL@H@@@@GN@@@@@@OO@@@@@@HO@@@@@MJOK@@@CMHOKL@@GMOOKN@@CNGNGL@@DOHAO@@@AAOOHD@@@D@@E@@@@AEE@@@@@@@@@@@@
)

(RPAQQ saucerMask #*(24 16)EH@@AF@@G@@@AL@@CHCL@N@@FHGNAJ@@@DOOB@@@@COOL@@@@OOOO@@@COOOOL@@GOOOON@@OOOOOO@@OOOOOO@@OOOOOO@@GOOOON@@COOOOL@@@OOOO@@@@AOOH@@@
)

(RPAQQ supernova #*(13 13)OMOHOMOHOHOHN@CHN@CHL@AH@@@@L@AHN@CHN@CHOHOHOMOHOMOH)

(RPAQQ STARBGParameters (SBM BM1 BM2 BM3 BM4 BM5 nova supernova stars1 stars2 stars3 stars4 stars5 changeStars eventPause clusters clusterRadius constellations starsInCluster superClusters superClusterRadius interiorClusters starsInterior)
)

(RPAQQ trekNotes (<A+ D/ G+ F# E/ D/ D@/ C))
(DEFINEQ

(Between
(LAMBDA (pair) (* gsf%: "19-Apr-85 10:33") (* * picks an integer between limits given in the pair) (RAND (LowerBound pair) (UpperBound pair)))
)

(BlackHole
(LAMBDA (win x y radius) (* gsf "21-Nov-85 15:53") (OR x (SETQ x (RAND 0 SCREENWIDTH))) (OR y (SETQ y (RAND 0 SCREENHEIGHT))) (OR radius (SETQ radius (RAND 5 300))) (FILLCIRCLE x y radius voidShade win) (if (ZEROP (RAND 0 2)) then (FILLCIRCLE x y (RAND 2 5) starShade win)))
)

(Catastrophe
(LAMBDA (win) (* gsf%: "13-Aug-85 15:47") (LET ((extent (RAND 10 200)) (cx (RAND 0 SCREENWIDTH)) (cy (RAND 0 SCREENHEIGHT))) (for i from 1 to extent do (Stomp win 50 (IPLUS cx (PlusOrMinus (RAND 0 extent))) (IPLUS cy (PlusOrMinus (RAND 0 extent)))))))
)

(ChanceIn
(LAMBDA (n) (* gsf%: "23-Oct-85 14:49") (ZEROP (RAND 0 (IDIFFERENCE n 1)))))

(CloseFollower
(LAMBDA NIL (* gsf%: "28-Jun-85 11:14") (CLOSEW cursorFollower)))

(Constellation
(LAMBDA (bitmap cx cy stars) (* gsf%: "12-Nov-85 13:09") (OR cx (SETQ cx (RAND 0 SCREENWIDTH))) (OR cy (SETQ cy (RAND 0 SCREENHEIGHT))) (LET ((halfwidth (RAND 25 100)) (halfheight (RAND 25 100)) BM NEXT) (OR stars (SETQ stars (RAND 4 (IQUOTIENT (MIN halfwidth halfheight) 3)))) (for i from 1 to stars do (SETQ BM (COND ((ILESSP (SETQ NEXT (RAND 0 100)) 40) BM3) ((ILESSP NEXT 60) BM4) ((ILESSP NEXT 96) BM5) (T nova))) (BITBLT BM 0 0 bitmap (IPLUS cx (PlusOrMinus (RAND 0 halfwidth))) (IPLUS cy (PlusOrMinus (RAND 0 halfheight)))))))
)

(Cosmos
(LAMBDA (starWindow) (* gsf "19-Jun-86 14:01") (OR starWindow (SETQ starWindow (CREATEW WHOLESCREEN NIL 0))) (if (AND (BOUNDP (QUOTE \IDLING)) \IDLING) then (RESETLST (RESETSAVE voidShade WHITESHADE) (RESETSAVE starShade BLACKSHADE) (DSPFILL NIL voidShade (QUOTE REPLACE) starWindow) (RESETSAVE BM1 (InvertBM BM1)) (RESETSAVE BM2 (InvertBM BM2)) (RESETSAVE BM3 (InvertBM BM3)) (RESETSAVE BM4 (InvertBM BM4)) (RESETSAVE BM5 (InvertBM BM5)) (RESETSAVE cursorFollower (ICONW darkSaucer saucerMask (CREATEPOSITION 0 0) T)) (RESETSAVE nova (InvertBM nova)) (RESETSAVE supernova (InvertBM supernova)) (RESETSAVE NIL (LIST (FUNCTION (LAMBDA (starWindow) (if changeStars then (BITBLT (InvertBM starWindow (QUOTE inPlace)) 0 0 SBM) (CLOSEW starWindow) (CHANGEBACKGROUND SBM) (CLOSEW cursorFollower)))) starWindow)) (while T do (SomethingCosmic starWindow) (BLOCK eventPause))) else (DSPFILL NIL voidShade (QUOTE REPLACE) starWindow) (while T do (SomethingCosmic starWindow) (BLOCK)) (CLOSEW starWindow)))
)

(InvertBM
(LAMBDA (bm inPlace?) (* gsf " 2-Jan-86 14:32") (LET ((bitmap (if inPlace? then bm else (BITMAPCOPY bm)))) (BITBLT bm NIL NIL bitmap NIL NIL NIL NIL (QUOTE INVERT) (QUOTE REPLACE)) bitmap))
)

(FillWithStars
(LAMBDA (bitmap) (* gsf "19-Jun-86 14:01") (* * Fill a bitmap with stars and return it -- defaults to a screen sized bitmap) (LET (width height) (OR bitmap (SETQ bitmap (BITMAPCREATE 1024 808))) (SETQ width (BITMAPWIDTH bitmap)) (SETQ height (if (WINDOWP bitmap) then (WINDOWPROP bitmap (QUOTE HEIGHT)) else (BITMAPHEIGHT bitmap))) (BITBLT bitmap 0 0 bitmap 0 0 width height (QUOTE INVERT) (QUOTE PAINT)) (for x from 1 to (Between stars1) do (BITMAPBIT bitmap (RAND 0 width) (RAND 0 height) (if (EQUAL voidShade BLACKSHADE) then 0 else 1))) (for x from 1 to (Between stars2) do (BITBLT BM2 0 0 bitmap (RAND 0 width) (RAND 0 height))) (for x from 1 to (Between stars3) do (BITBLT BM3 0 0 bitmap (RAND 0 width) (RAND 0 height))) (for x from 1 to (Between stars4) do (BITBLT BM4 0 0 bitmap (RAND 0 width) (RAND 0 height))) (for x from 1 to (Between stars5) do (BITBLT BM5 0 0 bitmap (RAND 0 width) (RAND 0 height))) (if (ChanceIn 5) then (BITBLT nova 0 0 bitmap (RAND 0 width) (RAND 0 height))) (if (ChanceIn 100) then (BITBLT supernova 0 0 bitmap (RAND 0 width) (RAND 0 height))) (for x from 1 to (Between constellations) do (Constellation bitmap)) (for x from 1 to (Between clusters) do (StarCluster (Between clusterRadius) (RAND 0 width) (RAND 0 height) NIL bitmap)) (for x from 1 to (Between superClusters) do (SuperCluster (Between superClusterRadius) (RAND 0 width) (RAND 0 height) (Between interiorClusters) NIL bitmap)) bitmap))
)

(Marble
(LAMBDA (bm) (* gsf " 1-Apr-87 13:32") (RESETLST (RESETSAVE stars1 (QUOTE (100000 . 200000))) (RESETSAVE stars2 (QUOTE (400 . 2000))) (RESETSAVE stars3 (QUOTE (1000 . 4000))) (RESETSAVE stars4 (QUOTE (400 . 2000))) (RESETSAVE stars5 (QUOTE (200 . 400))) (RESETSAVE clusters (QUOTE (50 . 100))) (RESETSAVE clusterRadius (QUOTE (5 . 15))) (RESETSAVE starsInCluster (QUOTE (50 . 150))) (RESETSAVE superClusters (QUOTE (20 . 50))) (RESETSAVE superClusterRadius (QUOTE (8 . 20))) (RESETSAVE interiorClusters (QUOTE (2 . 7))) (RESETSAVE starsInterior (QUOTE (30 . 100))) (FillWithStars bm)))
)

(OneChanceIn
(LAMBDA (n) (* gsf%: "23-Oct-85 15:04") (ChanceIn n)))

(LowerBound
(LAMBDA (pair) (* edited%: " 5-Apr-85 17:33") (* * comment) (CAR pair)))

(OpenFollower
(LAMBDA NIL (* gsf%: "11-Oct-85 15:15") (OPENW cursorFollower) (StarFollowCursor)))

(PlusOrMinus
(LAMBDA (x) (* gsf%: "25-Jun-84 18:02") (ITIMES x (COND ((ZEROP (RAND 0 1)) -1) (T 1)))))

(RandGrey
(LAMBDA (bitmap) (* gsf " 1-Apr-87 14:00") (LET (width height) (OR bitmap (SETQ bitmap (BITMAPCREATE 1024 808))) (SETQ width (BITMAPWIDTH bitmap)) (SETQ height (if (WINDOWP bitmap) then (WINDOWPROP bitmap (QUOTE HEIGHT)) else (BITMAPHEIGHT bitmap))) (BITBLT bitmap 0 0 bitmap 0 0 width height (QUOTE INVERT) (QUOTE PAINT)) (for x from 1 to (RAND (IQUOTIENT (TIMES width height) 2) (TIMES width height)) do (BITMAPBIT bitmap (RAND 0 width) (RAND 0 height) 0)) bitmap))
)

(SaucerOn
(LAMBDA NIL (* gsf%: "11-Oct-85 15:16") (SETQ BACKGROUNDCURSORINFN (QUOTE OpenFollower)) (SETQ BACKGROUNDCURSORMOVEDFN (QUOTE StarFollowCursor)) (SETQ BACKGROUNDCURSOROUTFN (QUOTE CloseFollower)) (QUOTE TakeMeToYourLeader))
)

(SaucerOff
(LAMBDA NIL (* edited%: " 7-Aug-85 18:12") (SETQ BACKGROUNDCURSORINFN NIL) (SETQ BACKGROUNDCURSORMOVEDFN NIL) (SETQ BACKGROUNDCURSOROUTFN NIL) (CLOSEW cursorFollower))
)

(STARBG
(LAMBDA (tuneFLG) (* gsf "11-Dec-85 15:09") (SETQ SBM (FillWithStars (AND (BOUNDP (QUOTE SBM)) (BITMAPP SBM) SBM))) (AND tuneFLG (GETD (QUOTE PLAY.NOTES)) (Enterprise)) (if (NEQ tuneFLG (QUOTE NO)) then (CHANGEBACKGROUNDBORDER BLACKSHADE) (SaucerOn) (CHANGEBACKGROUND SBM)))
)

(StarCluster
(LAMBDA (radius cx cy numStars bitmap) (* gsf "21-Nov-85 15:04") (OR numStars (SETQ numStars (RAND 10 (EXPT (if (ChanceIn 20) then radius else (IDIFFERENCE radius 3)) 2)))) (LET ((dither (IQUOTIENT radius 2)) NEXT BM) (for x from 1 to numStars do (* pick a random star bitmap) (SETQ BM (COND ((ILESSP (SETQ NEXT (RAND 0 100)) 70) BM1) ((ILESSP NEXT 83) BM2) ((ILESSP NEXT 96) BM3) ((ILESSP NEXT 100) BM5) (T (if (ChanceIn 1000) then supernova elseif (ChanceIn 50) then nova else BM4)))) (* put the star in a random constrained place) (BITBLT BM 0 0 bitmap (IPLUS cx (PlusOrMinus (EXPT (RAND 1 (SUB1 radius)) 2)) (RAND (MINUS dither) dither)) (IPLUS cy (PlusOrMinus (EXPT (RAND 1 (SUB1 radius)) 2)) (RAND (MINUS dither) dither))))))
)

(SuperCluster
(LAMBDA (radius cx cy numberOfClusters maxStars bitmap) (* gsf "21-Nov-85 15:05") (LET (rad) (for x from 1 to numberOfClusters do (StarCluster (SETQ rad (RAND 5 radius)) (IPLUS (PlusOrMinus (RAND 0 radius)) cx) (IPLUS (PlusOrMinus (RAND 0 radius)) cy) (if maxStars then (RAND 25 maxStars) else (EXPT (SUB1 rad) 2)) bitmap))))
)

(SomethingCosmic
(LAMBDA (bitmap) (* gsf "21-Nov-85 16:41") (* * gsf%: "14-Aug-85 16:24") (LET ((x (RAND 0 1000)) (width (BITMAPWIDTH bitmap)) (height (if (WINDOWP bitmap) then (WINDOWPROP bitmap (QUOTE HEIGHT)) else (BITMAPHEIGHT bitmap)))) (if (LESSP x 600) then (BITMAPBIT bitmap (RAND 0 width) (RAND 0 height) (if (EQUAL voidShade BLACKSHADE) then 0 else 1)) (if (ZEROP (RAND 0 100)) then (for i from 1 to 100 do (BITMAPBIT bitmap (RAND 0 width) (RAND 0 height) (if (EQUAL voidShade BLACKSHADE) then 0 else 1)))) elseif (LESSP x 700) then (BITBLT BM2 0 0 bitmap (RAND 0 width) (RAND 0 height)) elseif (LESSP x 720) then (BITBLT BM3 0 0 bitmap (RAND 0 width) (RAND 0 height)) elseif (LESSP x 725) then (LET ((bm BM4)) (if (ChanceIn 50) then (if (ChanceIn 10) then (SETQ bm supernova) else (SETQ bm nova)) else (BITBLT bm 0 0 bitmap (RAND 0 width) (RAND 0 height)))) elseif (LESSP x 740) then (BITBLT BM5 0 0 bitmap (RAND 0 width) (RAND 0 height)) elseif (LESSP x 745) then (Constellation bitmap) elseif (LESSP x 747) then (StarCluster (Between clusterRadius) (RAND 0 width) (RAND 0 height) NIL bitmap) elseif (LESSP x 748) then (SuperCluster (Between superClusterRadius) (RAND 0 width) (RAND 0 height) (Between interiorClusters) NIL bitmap) elseif (LESSP x 752) then (SELECTQ (RAND 0 7) (0 (if (BITMAPP bitmap) then (Catastrophe bitmap) else (if (ChanceIn 4) then (for i from 1 to (RAND 2 5) do (BlackHole bitmap)) else (BlackHole bitmap)))) ((1 2 3 4) (if (ChanceIn 3) then (for i from 1 to (RAND 2 9) do (Catastrophe bitmap)) else (Catastrophe bitmap))) (5 (if (BITMAPP bitmap) then (Catastrophe bitmap) else (UFO))) (6 (for i from 1 to (RAND 2 9) do (SELECTQ (RAND 0 5) ((0 1 2) (Catastrophe bitmap)) ((3 4) (if (BITMAPP bitmap) then (Catastrophe bitmap) else (BlackHole bitmap))) (TimePasses bitmap)))) (TimePasses bitmap)) else (Stomp bitmap))))
)

(StarFollowCursor
(LAMBDA NIL (* gsf%: "23-Oct-85 16:16") (LET ((oldRegion (WINDOWPROP cursorFollower (QUOTE REGION))) (x (DIFFERENCE LASTMOUSEX 25)) (y (DIFFERENCE LASTMOUSEY 17))) (if (OR (NEQ (fetch LEFT of oldRegion) x) (NEQ (fetch BOTTOM of oldRegion) y)) then (MOVEW cursorFollower x y))))
)

(StarryWindow
(LAMBDA (win) (* gsf%: " 9-Aug-85 10:57") (RESETLST (RESETSAVE stars1 (CONS 10 1000)) (RESETSAVE stars1 (CONS 10 1000)) (RESETSAVE stars2 (CONS 10 500)) (RESETSAVE stars3 (CONS 10 200)) (RESETSAVE stars4 (CONS 1 3)) (RESETSAVE stars5 (CONS 1 5)) (RESETSAVE clusters (CONS 0 3)) (RESETSAVE starsInCluster (CONS 10 30)) (RESETSAVE superClusters (CONS 0 1)) (RESETSAVE starsInterior (CONS 10 50)) (OR win (SETQ win (CREATEW NIL NIL 0))) (FillWithStars win)))
)

(Stomp
(LAMBDA (win footprint x y) (* gsf "21-Nov-85 15:53") (OR footprint (SETQ footprint 40)) (OR x (SETQ x (RAND (MINUS footprint) (if (WINDOWP win) then (WINDOWPROP win (QUOTE WIDTH)) else (BITMAPWIDTH win))))) (OR y (SETQ y (RAND (MINUS footprint) (if (WINDOWP win) then (WINDOWPROP win (QUOTE HEIGHT)) else (BITMAPHEIGHT win))))) (BITBLT NIL NIL NIL win x y (RAND 1 footprint) (RAND 1 footprint) (QUOTE TEXTURE) (QUOTE REPLACE) voidShade))
)

(TimePasses
(LAMBDA (win) (* gsf%: "13-Aug-85 16:05") (for i from 1 to (RAND 100 4000) do (Stomp win 30))))

(UFO
(LAMBDA NIL (* gsf "14-Nov-85 10:33") (LET ((x (RAND 0 SCREENWIDTH)) (y (RAND 0 SCREENHEIGHT)) (deltaX (RAND -7 7)) (deltaY (RAND -7 7))) (MOVEW cursorFollower x y) (OPENW cursorFollower) (until (OR (LESSP x 0) (LESSP y 0) (GREATERP x SCREENWIDTH) (GREATERP y SCREENHEIGHT)) do (MOVEW cursorFollower (SETQ x (IPLUS x deltaX)) (SETQ y (IPLUS y deltaY))) (if (ZEROP (RAND 0 15)) then (SETQ deltaX (RAND -7 7))) (if (ZEROP (RAND 0 15)) then (SETQ deltaY (RAND -7 7))) (if (ZEROP (RAND 0 30)) then (BLOCK (RAND 10 1001)))) (CLOSEW cursorFollower)))
)

(UpperBound
(LAMBDA (pair) (* edited%: " 5-Apr-85 17:34") (* * comment) (CDR pair)))
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA )

(ADDTOVAR NLAML )

(ADDTOVAR LAMA )
)
(RANDSET T)
(OR (BOUNDP (QUOTE cursorFollower)) (SETQ cursorFollower (ICONW saucer saucerMask (CREATEPOSITION 0 0) T)))
(if (BOUNDP (QUOTE IDLE.FUNCTIONS)) then (PUSH IDLE.FUNCTIONS (QUOTE ("Cosmos" (QUOTE Cosmos) "Go where no one has gone before... "))))
(PUTPROPS STARBG COPYRIGHT ("Xerox Corporation" 1984 1985 1986 1987))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (3461 14625 (Between 3471 . 3624) (BlackHole 3626 . 3913) (Catastrophe 3915 . 4181) (
ChanceIn 4183 . 4269) (CloseFollower 4271 . 4351) (Constellation 4353 . 4903) (Cosmos 4905 . 5910) (
InvertBM 5912 . 6113) (FillWithStars 6115 . 7565) (Marble 7567 . 8162) (OneChanceIn 8164 . 8231) (
LowerBound 8233 . 8317) (OpenFollower 8319 . 8416) (PlusOrMinus 8418 . 8520) (RandGrey 8522 . 9001) (
SaucerOn 9003 . 9238) (SaucerOff 9240 . 9420) (STARBG 9422 . 9706) (StarCluster 9708 . 10454) (
SuperCluster 10456 . 10797) (SomethingCosmic 10799 . 12654) (StarFollowCursor 12656 . 12953) (
StarryWindow 12955 . 13426) (Stomp 13428 . 13875) (TimePasses 13877 . 13984) (UFO 13986 . 14537) (
UpperBound 14539 . 14623)))))
STOP