(FILECREATED " 6-Aug-85 13:37:11" {ERIS}<LISPUSERS>FACEINVADER.;2 17759
changes to: (FNS INITFI)
previous date: "22-NOV-82 08:08:15" {ERIS}<LISPUSERS>FACEINVADER.;1)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT FACEINVADERCOMS)
(RPAQQ FACEINVADERCOMS ((BITMAPS BASE MISSLE1 NORMALFACE SMILEFACE FROWNFACE)
(FNS * FACEINVADERFNS)))
(RPAQ BASE (READBITMAP))
(16 10
"@AH@"
"@CL@"
"@GN@"
"@OO@"
"OOOO"
"OOOO"
"OOOO"
"OOOO"
"GOON"
"COOL")
(RPAQ MISSLE1 (READBITMAP))
(5 15
"B@@@"
"G@@@"
"OH@@"
"B@@@"
"D@@@"
"B@@@"
"A@@@"
"B@@@"
"D@@@"
"B@@@"
"A@@@"
"B@@@"
"D@@@"
"B@@@"
"A@@@")
(RPAQ NORMALFACE (READBITMAP))
(16 16
"@OO@"
"AOOH"
"COOL"
"GOON"
"NCLG"
"OGNO"
"OOOO"
"OOOO"
"OOOO"
"OOOO"
"OLCO"
"OOOO"
"GOON"
"COOL"
"AOOH"
"@OO@")
(RPAQ SMILEFACE (READBITMAP))
(16 16
"@OO@"
"A@@H"
"B@@D"
"D@@B"
"HDAA"
"HNCI"
"HDAA"
"H@@A"
"J@@E"
"I@@I"
"HHAA"
"HDBA"
"DCLB"
"B@@D"
"A@@H"
"@OO@")
(RPAQ FROWNFACE (READBITMAP))
(16 16
"@OO@"
"A@@H"
"B@@D"
"DHAB"
"ILCI"
"HHAA"
"H@@A"
"H@@A"
"H@@A"
"H@@A"
"HCLA"
"HDBA"
"DHAB"
"B@@D"
"A@@H"
"@OO@")
(RPAQQ FACEINVADERFNS (BASEOVERRUN FI HITBAR HITFACE INITFI MOVEBAR MOVEBASE MOVEFACE MOVEMISSLE
MOVEOBJ PRINTINSTRUCTIONS))
(DEFINEQ
(BASEOVERRUN
[LAMBDA NIL (* jss: "22-NOV-82 08:07")
(* This function is called when the face oveeruns the base line. It removes a spare base, ending the game if there
are no more spare bases.)
(* Erase the base)
(COND
(MISSLEY (* Erase the missle)
(MOVEOBJ MISSLE1 FIWINDOW MISSLEX MISSLEY -1 0)
(SETQ MISSLEY NIL)))
(MOVEOBJ BASE FIWINDOW OBASEX 15 -1 0) (* Smile face)
(MOVEOBJ FACE FIWINDOW OFACEX OFACEY -1 0)
(MOVEOBJ SMILEFACE FIWINDOW -1 OFACEY OBASEX 15)
(COND
((IEQP BASESLEFT 0)
(CLRPROMPT)
(PROMPTPRINT "Click left mousebutton when ready to proceed")
(UNTILMOUSESTATE (ONLY LEFT))
(PROMPTPRINT (CONCAT "Final score: " SCORE))
(CLOSEW FIWINDOW)
T)
(T (* Decrease the base count by 1)
(SETQ BASESLEFT (SUB1 BASESLEFT))
(CLRPROMPT)
(PROMPTPRINT "Click left mousebutton when ready to proceed")
(RECLAIM (QUOTE LISTP))
(UNTILMOUSESTATE (ONLY LEFT))
(SELECTQ BASESLEFT
(2 (MOVEOBJ BASE FIWINDOW 36 0 -1 0))
(1 (MOVEOBJ BASE FIWINDOW 18 0 -1 0))
(MOVEOBJ BASE FIWINDOW 0 0 -1 0)) (* Erase smile face)
(MOVEOBJ SMILEFACE FIWINDOW OBASEX 15 -1 0)
(SETQ OFACEX (RAND 0 WMAX))
(SETQ OFACEY (RAND 30 HMAX))
(SETQ FACEDX (RAND (IMAX 1 (IDIFFERENCE SKILL 2))
SKILL))
(SETQ FACEDY (RAND (IMAX 1 (IDIFFERENCE SKILL 2))
SKILL))
NIL])
(FI
[LAMBDA (INSTRUCTIONS?) (* jss: "22-NOV-82 08:07")
(* This program was written by Jeffrey Shulman)
(* This is the top-level Face Invader game function.
It coordinates all the activities)
(* This game was inspired by FLY written by Lou
Steinberg)
(PROG (OBASEX NBASEX MISSLEX MISSLEY MISSLEDY FIWINDOW BASESLEFT WINDOWHEIGHT WINDOWWIDTH
WINDOWLEFT WINDOWBOTTOM SCOREWINDOW SCORE FACE OFACEX NFACEX NFACEY OFACEY FACEDY
FACEDX WMAX HMAX SKILL BAR THEBAR BARX BARY BARW BARH BARDX BARTOP R1M R1F R2 R1B
R1BAR ANS)
(COND
((NULL INSTRUCTIONS?)
(CLRPROMPT)
(PROMPTPRINT "Click left mousekey for instructions, middle to proceed")
(UNTILMOUSESTATE (OR LEFT MIDDLE))
(AND (LASTMOUSESTATE LEFT)
(PRINTINSTRUCTIONS))
(UNTILMOUSESTATE UP))) (* Initialize everything)
(INITFI)
(SETQ R1M (create REGION
WIDTH ← 5))
(SETQ R2 (create REGION
WIDTH ← 16
HEIGHT ← 16))
(SETQ R1F (create REGION
LEFT ← 0
BOTTOM ← 0
WIDTH ← WINDOWWIDTH
HEIGHT ← 25))
(SETQ R1B (create REGION))
(SETQ R1BAR (create REGION
WIDTH ← BARW
HEIGHT ← BARH)) (* Main loop, move base, move missle, move bar, move
face, check missle for hitting anything)
LOOP(COND
((AND (NULL MISSLEY)
(MOUSESTATE (ONLY MIDDLE))) (* Only ONE missle in the air at a time)
(SETQ MISSLEX (IPLUS OBASEX 6))
(SETQ MISSLEY 20)))
(MOVEBASE)
(MOVEMISSLE)
(MOVEBAR)
(MOVEFACE)
(AND MISSLEY (replace BOTTOM of R1M with (IDIFFERENCE MISSLEY MISSLEDY))
(replace LEFT of R1M with MISSLEX)
(replace HEIGHT of R1M with (IPLUS MISSLEDY 15))
(AND BAR (replace BOTTOM of R1BAR with BARY)
(replace LEFT of R1BAR with BARX)))
[COND
((AND BAR MISSLEY (REGIONSINTERSECTP R1M R1BAR))
(* Come here if the missle intersects with the bar)
(HITBAR))
((AND MISSLEY (REGIONSINTERSECTP R1M R2)) (* Come here if the missle intersected the face)
(HITFACE))
((AND (REGIONSINTERSECTP R1F R2)) (* Come here of the face is below 25)
(COND
((BASEOVERRUN)
(CLOSEW FIWINDOW)
(RETURN T]
(GO LOOP])
(HITBAR
[LAMBDA NIL (* jss: "19-NOV-82 14:03")
(* When a missle hits the bar this function is called to
delete the missle and the bar)
(* Delete the missle)
(MOVEOBJ MISSLE1 FIWINDOW MISSLEX MISSLEY -1 0)
(SETQ MISSLEY NIL) (* Erase the bar)
(MOVEOBJ BAR FIWINDOW BARX BARY -1 0)
(SETQ BAR NIL)
(UNTILMOUSESTATE UP 50])
(HITFACE
[LAMBDA NIL (* jss: "22-NOV-82 08:06")
(* This function is called when the missle hits the face. It scores the hit, prints a frown and then sets up a new
face. It also puts in a new bar if necessary)
(* Erase the missle)
(MOVEOBJ MISSLE1 FIWINDOW MISSLEX MISSLEY -1 0)
(SETQ MISSLEY NIL) (* First frown)
(MOVEOBJ FROWNFACE FIWINDOW -1 0 OFACEX OFACEY) (* Increase score)
(SETQ SCORE (IPLUS SCORE (ITIMES 10 SKILL)))
(CLEARW SCOREWINDOW)
(PRINT SCORE SCOREWINDOW) (* Wait for right mouse keyclick)
(CLRPROMPT)
(PROMPTPRINT "Click left mousebutton when ready to proceed")
(RECLAIM (QUOTE LISTP))
(UNTILMOUSESTATE (ONLY LEFT)) (* Erase frown face)
(MOVEOBJ FROWNFACE FIWINDOW OFACEX OFACEY -1 0) (* Get new face place)
(SETQ OFACEX (RAND 0 WMAX))
(SETQ OFACEY (RAND 30 HMAX))
(SETQ FACE NORMALFACE)
(SETQ FACEDX (RAND (IMAX 1 (IDIFFERENCE SKILL 2))
(ADD1 SKILL)))
(SETQ FACEDY (RAND (IMAX 1 (IDIFFERENCE SKILL 2))
(ADD1 SKILL)))
(SETQ SKILL (ADD1 SKILL)) (* Replace the bar if necessary)
(AND (NULL BAR)
(SETQ BAR THEBAR)
(MOVEOBJ BAR FIWINDOW -1 0 BARX BARY])
(INITFI
(LAMBDA NIL (* kbr: " 6-Aug-85 13:26")
(* This function initializes the window, score, puts in
spare bases, bar, and whatever else is needed)
(SETQ FIWINDOW (CREATEW NIL "Face Invader"))
(SETQ WINDOWHEIGHT (fetch HEIGHT of (DSPCLIPPINGREGION NIL FIWINDOW)))
(SETQ HMAX (IDIFFERENCE WINDOWHEIGHT 16))
(SETQ WINDOWWIDTH (WINDOWPROP FIWINDOW 'WIDTH))
(SETQ WMAX (IDIFFERENCE WINDOWWIDTH 16))
(SETQ WINDOWBOTTOM (fetch BOTTOM of (WINDOWPROP FIWINDOW 'REGION)))
(SETQ WINDOWLEFT (fetch LEFT of (WINDOWPROP FIWINDOW 'REGION)))
(SETQ SCOREWINDOW (CREATEW (create REGION
LEFT ← WINDOWLEFT
BOTTOM ← (IPLUS WINDOWBOTTOM (fetch HEIGHT
of (WINDOWPROP FIWINDOW
'REGION)))
HEIGHT ← 40
WIDTH ← 60)
"Score"))
(DSPFONT LAMBDAFONT SCOREWINDOW)
(SETQ SCORE 0)
(PRINT SCORE SCOREWINDOW)
(WINDOWPROP FIWINDOW 'RESHAPEFN 'DON'T)
(WINDOWPROP FIWINDOW 'SCOREWINDOW SCOREWINDOW)
(WINDOWPROP FIWINDOW 'CLOSEFN '(LAMBDA (W)
(CLOSEW (WINDOWPROP W 'SCOREWINDOW)))) (* Put spare bases in window)
(BITBLT BASE 0 0 FIWINDOW 0 0)
(BITBLT BASE 0 0 FIWINDOW 18 0)
(BITBLT BASE 0 0 FIWINDOW 36 0)
(SETQ BASESLEFT 3) (* Position the orginal base)
(SETQ OBASEX 15)
(SETQ NBASEX 0)
(SETQ SKILL 1)
(SETQ MISSLEDY 10) (* Position the face)
(SETQ OFACEX (RAND 0 WMAX))
(SETQ OFACEY (RAND 30 HMAX))
(SETQ FACE NORMALFACE)
(SETQ FACEDX (RAND 1 2))
(SETQ FACEDY (RAND 1 2))
(SETQ BAR (BITMAPCREATE (SETQ BARW (IQUOTIENT WINDOWWIDTH 4))
(SETQ BARH 5)))
(SETQ THEBAR BAR)
(SETQ BARX 0)
(SETQ BARY 50)
(SETQ BARDX 5)
(SETQ BARTOP (IPLUS BARY BARH))
(BITBLT BAR 0 0 BAR 0 0 NIL NIL 'INVERT)
(MOVEOBJ BAR FIWINDOW -1 0 BARX BARY)))
(MOVEBAR
[LAMBDA NIL (* jss: "18-NOV-82 07:30")
(* This function moves the bar back and fourth if there
is a bar to be moved)
(COND
(BAR (AND (OR (IGREATERP (IPLUS BARX BARW)
WINDOWWIDTH)
(ILESSP BARX 0))
(SETQ BARDX (IMINUS BARDX)))
(MOVEOBJ BAR FIWINDOW BARX BARY (IPLUS BARX BARDX)
BARY)
(SETQ BARX (IPLUS BARX BARDX])
(MOVEBASE
[LAMBDA NIL (* jss: "18-NOV-82 07:28")
(* This function is called to move the base.
It bounces the base off the side walls if it hits them)
[SETQ NBASEX (IMAX 0 (IMIN WMAX (IDIFFERENCE (fetch XCOORD (CURSORPOSITION NIL FIWINDOW))
16]
(MOVEOBJ BASE FIWINDOW OBASEX 15 NBASEX 15)
(SETQ OBASEX NBASEX])
(MOVEFACE
[LAMBDA NIL (* jss: "18-NOV-82 07:31")
(* This function moves the face.
It bounces the face off any wall or bar it hits)
(SETQ NFACEX (IPLUS OFACEX FACEDX))
(SETQ NFACEY (IPLUS OFACEY FACEDY))
(AND (IGEQ NFACEX WMAX)
(SETQ NFACEX WMAX)
(SETQ FACEDX (IMINUS FACEDX)))
(AND (ILEQ NFACEX 0)
(SETQ NFACEX 0)
(SETQ FACEDX (IMINUS FACEDX)))
(AND (IGEQ NFACEY (IDIFFERENCE WINDOWHEIGHT 16))
(SETQ NFACEY (IDIFFERENCE WINDOWHEIGHT 16))
(SETQ FACEDY (IMINUS FACEDY)))
(replace LEFT of R2 with NFACEX)
(replace BOTTOM of R2 with NFACEY)
[COND
(BAR (replace HEIGHT of R2 with (IDIFFERENCE 16 FACEDY))
(replace LEFT of R1B with BARX)
(replace BOTTOM of R1B with BARY)
(replace WIDTH of R1B with BARW)
(replace HEIGHT of R1B with BARH)
(AND (REGIONSINTERSECTP R1B R2)
(SETQ FACEDY (IMINUS FACEDY))
(SETQ NFACEY BARTOP]
(MOVEOBJ FACE FIWINDOW OFACEX OFACEY NFACEX NFACEY)
(SETQ OFACEX NFACEX)
(SETQ OFACEY NFACEY])
(MOVEMISSLE
[LAMBDA NIL (* jss: "18-NOV-82 07:29")
(* This function moves the missle.
When the missle is off the screen it informs the rest of
the program of it)
(AND MISSLEY (MOVEOBJ MISSLE1 FIWINDOW MISSLEX MISSLEY MISSLEX (IPLUS MISSLEY MISSLEDY))
(SETQ MISSLEY (IPLUS MISSLEY MISSLEDY)))
(AND MISSLEY (IGREATERP MISSLEY WINDOWHEIGHT)
(SETQ MISSLEY NIL])
(MOVEOBJ
[LAMBDA (OBJ WINDOW OX OY NX NY) (* jss: "18-NOV-82 07:20")
(* Moves the object OBJ in window WINDOW from OX OY to
NX NY)
(* If NX is -1 then we erase.
If OX is -1 then don't erase)
(COND
((OR (NEQ OX NX)
(NEQ OY NY))
(AND (NEQ -1 OX)
(BITBLT OBJ 0 0 WINDOW OX OY NIL NIL (QUOTE INPUT)
(QUOTE ERASE)))
(AND (NEQ -1 NX)
(BITBLT OBJ 0 0 WINDOW NX NY))
T)
(T])
(PRINTINSTRUCTIONS
[LAMBDA NIL (* jss: "18-NOV-82 12:14")
(* This function prints the instructions to Face
Invader)
(PROG (IWINDOW)
(SETQ IWINDOW (CREATEW (QUOTE (40 326 541 400))
"Instructions for Face Invader"))
(PRIN1 "Welcome to FACE INVADER, a game of challenge and excitement!" IWINDOW)
(TERPRI IWINDOW)
(PRIN1 "The object of the game is to shoot the bouncing 'face' before it" IWINDOW)
(TERPRI IWINDOW)
(PRIN1 "overruns your base." IWINDOW)
(TERPRI IWINDOW)
(TERPRI IWINDOW)
(PRIN1 "Game play:" IWINDOW)
(TERPRI IWINDOW)
(TERPRI IWINDOW)
(PRIN1 "1. " IWINDOW)
(PRIN1 "You will first be asked to specify the size of the game window. You" IWINDOW)
(TERPRI IWINDOW)
(TAB 3 NIL IWINDOW)
(PRIN1 "do this by deciding upon the location of the lower left hand corner" IWINDOW)
(TERPRI IWINDOW)
(TAB 3 NIL IWINDOW)
(PRIN1 "of the window. Then while holding down the left mouse button, move" IWINDOW)
(TERPRI IWINDOW)
(TAB 3 NIL IWINDOW)
(PRIN1 "the mouse until you have the window size you want. At that time release" IWINDOW)
(TERPRI IWINDOW)
(TAB 3 NIL IWINDOW)
(PRIN1 "the left button." IWINDOW)
(TERPRI IWINDOW)
(PRIN1 "2. The base will move horizontally according to the location of" IWINDOW)
(TERPRI IWINDOW)
(TAB 3 NIL IWINDOW)
(PRIN1 "the regular cursor within the game's window boundries." IWINDOW)
(TERPRI IWINDOW)
(PRIN1 "3. The middle mouse key is used to fire a missle from the base." IWINDOW)
(TERPRI IWINDOW)
(TAB 3 NIL IWINDOW)
(PRIN1 "You are only allowed to have ONE missle in the air at a given time." IWINDOW)
(TERPRI IWINDOW)
(PRIN1 "4. If the missle hits the face it will be replaced with a frowning" IWINDOW)
(TERPRI IWINDOW)
(TAB 3 NIL IWINDOW)
(PRIN1 "face and you will be awarded some points (10 for the first, 20 for" IWINDOW)
(TERPRI IWINDOW)
(TAB 3 NIL IWINDOW)
(PRIN1 "the second, etc.) The face will move at an increasing rate the next" IWINDOW)
(TERPRI IWINDOW)
(TAB 3 NIL IWINDOW)
(PRIN1 "time. Clicking the left mouse button will resume play." IWINDOW)
(TERPRI IWINDOW)
(PRIN1 "5. If the missle hits the moving bar it will destroy the bar. You" IWINDOW)
(TERPRI IWINDOW)
(TAB 3 NIL IWINDOW)
(PRIN1 "will receive a new bar when you shoot another face." IWINDOW)
(TERPRI IWINDOW)
(PRIN1 "6. If the face moves below the top of the missle base line (anywhere" IWINDOW)
(TERPRI IWINDOW)
(TAB 3 NIL IWINDOW)
(PRIN1 "along the bottom) you will see a smiling face where your base used to" IWINDOW)
(TERPRI IWINDOW)
(TAB 3 NIL IWINDOW)
(PRIN1 "be. It has been destroyed. It will be replaced (after you type" IWINDOW)
(TERPRI IWINDOW)
(TAB 3 NIL IWINDOW)
(PRIN1 "the left mouse button) with one of your spare bases. The game" IWINDOW)
(TERPRI IWINDOW)
(TAB 3 NIL IWINDOW)
(PRIN1 "ends when you have no more spare bases. Your final score will" IWINDOW)
(TERPRI IWINDOW)
(TAB 3 NIL IWINDOW)
(PRIN1 "be printed in the prompt window." IWINDOW)
(TERPRI IWINDOW)
(PRIN1 "7. " IWINDOW)
(PRIN1 "If you call this game with an argument of T [ie (FI T)] you will" IWINDOW)
(TERPRI IWINDOW)
(TAB 3 NIL IWINDOW)
(PRIN1 "not be asked if you want instructions." IWINDOW)
(TERPRI IWINDOW)
(TERPRI IWINDOW)
(PRIN1 "Hit the left mouse key to be asked for the Face Invader window" IWINDOW)
(UNTILMOUSESTATE LEFT)
(CLOSEW IWINDOW])
)
(PUTPROPS FACEINVADER COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1239 17677 (BASEOVERRUN 1249 . 2904) (FI 2906 . 5743) (HITBAR 5745 . 6337) (HITFACE
6339 . 7829) (INITFI 7831 . 10146) (MOVEBAR 10148 . 10654) (MOVEBASE 10656 . 11130) (MOVEFACE 11132 .
12354) (MOVEMISSLE 12356 . 12883) (MOVEOBJ 12885 . 13492) (PRINTINSTRUCTIONS 13494 . 17675)))))
STOP