source: abuse-frabs/trunk/addon/pong/pong.lsp @ 44

Last change on this file since 44 was 44, checked in by Sam Hocevar, 14 years ago
  • Importing abuse-frabs 2.10.
File size: 12.1 KB
Line 
1;;;; Copyright 1995 Crack dot Com,  All Rights reserved
2;;;; See licensing information for more details on usage rights
3
4;;;; to play this game, go to the abuse root directory and type :
5;;;; abuse -lsf addon/pong/pong.lsp
6;;;; -lsf tells abuse to use an alternate Lisp Startup File than abuse.lsp
7
8;;;; Notes :
9;;;;   This "game" was written by Jonathan Clark as a demonstration of the
10;;;; capabilities of the abuse engine.  It is not meant to be a complete game
11;;;; and is released strictly for purpose of study only.  Any part of this file
12;;;; may be used by others and distributed in any form, but it uses some of the
13;;;; lisp, sound effects, and artwork from Abuse (TM) which may only distributed
14;;;; as a complete package with no files missing or changed.
15
16;;;; ***** Emacs plug *********
17;;;; If you don't already have emacs, get it!  It's free.
18;;;; Firstly it makes editing lisp 100% easier because it matches braces.
19;;;; Secondly if you load the hi-lighting .el file you can read this file much
20;;;; easier because all comments, strings, etc will be different colors.
21;;;; I don't know the exact site where to find it, but if you telnet to
22;;;; archie.unl.edu or look it up on a web search server you are sure to find it.
23;;;; You might be interest to know emacs is also very customizable using a language
24;;;; called lisp :-)
25
26;;;; Please do not ask me for docs on how to code with the abuse engine, there are
27;;;; none at this time and there won't be any until networked abuse is available.
28;;;; ALL games written with the abuse engine are network ready with no additional
29;;;; work including this one, but there are some issues that need addressing
30;;;; that cannot be fully discussed until the net code is finished.  When these
31;;;; docs are written they will be available at http://www.crack.com   Estimated
32;;;; date for these docs is sometime late Oct. 1995
33
34(perm-space)   ; define all functions and global variable in "perm space" which
35               ; is a space which will be garbage collected when it fills up.
36               ; The down side to garbage collection is that it is a little slow
37               ; and users of very slow machines will notice a very small pause
38               ; from time to time, though writers of games may ignore this issue and
39               ; always stay in "perm space"
40               ;
41               ; "tmp space" on the other hand, is not garbage collected, but rather
42               ; at the end of executing an object's function will be completely
43               ; thrown away it's important not to do a setq on a global variable
44               ; (not local and not a member of the object) because the memory the
45               ; item resides in will be lost after the function finishes.. see the
46               ; add_score function in this file.
47
48
49;; this is a simple check to see if they player has an engine version
50;; capable of playing the game.  All games should at least check for version 1.0
51;; because all version before that are beta and have known bugs.
52(if (< (+ (* (major_version) 100) (minor_version)) 100)    ; require at least version 1.0
53    (progn
54      (print "Your engine is out of date.  This game requires verion 1.0")
55      (quit)))
56
57
58(setq pong_dir "addon/pong/")  ; in case we change the location of these files later
59                               ; this is always a very good idea to do because the user of
60                               ; this program may/may not be able to install into this directory       
61(setq pong_art (concatenate 'string pong_dir "pong.spe"))  ; all artwork is in this file
62
63(setq load_warn nil)            ; don't show a waringing if these files aren't there
64(load "gamma.lsp")              ; gamma correction values (if saved)
65(setq load_warn T)
66
67(load "addon/pong/common.lsp")        ; grab the definition of abuse's light holder & obj mover
68(load "addon/pong/userfuns.lsp")      ; load seq defun
69(load "lisp/input.lsp")         ; get input mapping stuff from abuse
70
71
72;; these are a few things that the engine requires you to load...
73(load_big_font     "art/letters.spe" "letters")
74(load_small_font   "art/letters.spe" "small_font")
75(load_console_font "art/consfnt.spe" "fnt5x7")
76(load_color_filter "art/back/backgrnd.spe")
77(load_palette      "art/back/backgrnd.spe")
78(load_tiles pong_art)  ; load all foreground & background type images from pong.spe
79
80;; this is the image that will be displayed when the game starts
81;; this needs to be in the form (X . Y) where X is the filename and
82;; Y is the name of the image
83(setq title_screen      (cons pong_art "title_screen"))
84
85;; define a few sound effects to be used (these are all from abuse)
86(def_sound 'METAL  "sfx/lasrmis2.wav")
87(def_sound 'BHIT   "sfx/delobj01.wav")
88(def_sound 'BLOWUP "sfx/ball01.wav")
89(def_sound 'BUTTON_PRESS_SND "sfx/button02.wav")  ; used by menu system
90
91;; use these images to draw the score
92(setq nums (make-array 10 :initial-contents (list (def_image pong_art "0")
93                                                  (def_image pong_art "1")
94                                                  (def_image pong_art "2")
95                                                  (def_image pong_art "3")
96                                                  (def_image pong_art "4")
97                                                  (def_image pong_art "5")
98                                                  (def_image pong_art "6")
99                                                  (def_image pong_art "7")
100                                                  (def_image pong_art "8")
101                                                  (def_image pong_art "9"))))
102(setq score 0)
103
104(defun show_score (x y digs_left score)
105  (if (not (eq digs_left 0))       ; end recursion
106      (let ((this-digit (/ score digs_left)))
107        (put_image x y (aref nums this-digit))
108        (show_score (+ x (image_width (aref nums this-digit))) y
109                    (/ digs_left 10) (- score (* digs_left this-digit))))))
110
111(defun paddle_draw ()
112  (draw)                          ; normal draw function
113  (show_score (- (view_x2) 80) (view_y1) 1000000 score))
114
115(defun add_score (amount)
116  (perm-space)     ; we are modifing a global var, so we need swith to perm space
117  (setq score (+ score amount))
118  (tmp-space))     ; switch back to tmp space which is not garbage collected
119
120
121(defun destroyable_tile (x) (> x 1))
122
123(defun blow_up_tile (tilex tiley)
124  (let ((gamex (+ (* tilex 16) 8))
125        (gamey   (+ (* tiley 7) 7)))
126    (add_score 200)
127    (add_object EXPLOSION gamex gamey)
128    (destroy_tile tilex tiley)))
129
130(defun destroy_tile (tilex tiley)
131  (let ((gamex (+ (* tilex 16) 8))
132        (gamey   (+ (* tiley 7) 7))
133        (type (fg_tile tilex tiley)))
134    (add_score 100)
135    (set_fg_tile tilex tiley 0)            ; clear the tile and start animation
136    (if (eq type 6)                        ; dinamite tile?
137        (progn
138          (blow_up_tile tilex tiley)
139          (if (and (> tilex 0))
140              (blow_up_tile (- tilex 1) tiley))
141          (if (and (> tiley 0))
142              (blow_up_tile tilex (- tiley 1)))
143          (blow_up_tile tilex (+ tiley 1))
144          (blow_up_tile (+ tilex 1) tiley)))
145             
146    (with_object (bg) (add_hp 10))           ; give player points
147
148    (add_object TILE_BLOW_UP gamex gamey)
149    (if (eq (random 10) 0)
150        (add_object PILL1 gamex gamey)
151      (if (eq (random 30) 0)
152          (add_object PILL2 gamex gamey)))))
153
154
155(defun check_collide (status)    ;; returns T if we hit something
156  (if (not (eq status T))                                  ; did we hit anything?
157      (if (eq (car (cdr status)) 'object)                  ; did we hit an object?           
158          (let ((object (car (cdr (cdr status)))))
159            (if (eq (with_object object (otype)) PADDLE)   ; did we hit the paddle?
160                (if (<= (aistate) 180)
161                    (progn
162                      (set_aistate (+ (aistate) (- (with_object object (x)) (x))))
163                      (if (> 20 (aistate)) (set_aistate 20)
164                        (if (< 160 (aistate)) (set_aistate 160)))
165                      T)
166                  nil)
167              nil)
168            nil)
169        (if (eq (car (cdr status)) 'tile)                   ; did we hit a tile?
170            (let ((tilex (car (cdr (cdr status))))
171                  (tiley (car (cdr (cdr (cdr status))))))
172              (let ((type (fg_tile tilex tiley)))
173              (if (destroyable_tile type)                   ; can we destroy the tile?
174                  (progn
175                    (destroy_tile tilex tiley)
176                    (if (eq type 6)
177                        (play_sound BLOWUP 100)
178                      (play_sound BHIT)))
179                (play_sound METAL 60)))
180              T)
181          nil))
182    nil))
183
184
185(defun move_ball ()  ;; returns status of move
186  (let ((status (float_tick)))
187    (if (not (eq status T))   ; T means we did not hit anything
188        (let ((block_flags (car status)))
189          (if (or (blocked_left block_flags) (blocked_right block_flags)) ; bounce left/right
190              (if (<= (aistate) 180)
191                  (set_aistate (- 180 (aistate)))
192                (set_aistate (+ 180 (- 360 (aistate))))))
193          (if (or (blocked_up block_flags) (blocked_down block_flags))    ; bounce up/down
194              (progn
195                (if (<= (aistate) 180)
196                    (set_aistate (mod (+ (- 180 (aistate)) 180) 360))
197                  (set_aistate (- 360 (aistate))))
198                ))
199          (if (not (eq block_flags 0))       ; move the ball one tick, because we just bounced
200              (progn
201                (set_course (aistate) 7)
202                (float_tick)))))
203    status))
204
205
206(defun ball_ai ()
207  (set_course (aistate) 7)
208  (select (aitype)
209          (0  ; normal play, bounce around and stuff..
210           (check_collide (move_ball))             
211           (if (> (y) 240)  ; check to see if we are dead
212               (progn
213                 (if (> score 500)
214                     (add_score -500))
215                 (if (find_closest BALL)  ; don't regenerate if other balls exsist
216                     nil
217                   (progn
218                     (set_aistate 90)        ; reset ball to 90 degree angle
219                     (set_fade_count 15)
220                     (set_aitype 1)
221                     T)))
222             T))
223                 
224           (1 ; ball is dead - go to paddle and fade in
225            (set_x (with_object (bg) (x)))
226            (set_y (- (with_object (bg) (y)) 14))
227            (set_fade_count (- (fade_count) 1))
228            (if (eq (fade_count) 0)
229                (set_aitype 0))
230            T)))
231         
232
233(def_char BALL
234  (funs (ai_fun ball_ai))
235  (flags (hurt_all  T))
236  (range 100 100)                 ; make sure ball doesn't stop when off screen
237  (states pong_art (stopped "ball")))
238
239(defun paddle_mover (xm ym but)
240  (print xm)
241  (set_gravity 0)
242  (set_shift_down (me) 80)
243  (set_shift_right (me) (- 0 (x)))   ; adjust screen shift so it doesn't scroll
244  (if (> fire_delay 0)
245      (setq fire_delay (- fire_delay 1))
246    (if (> shooting_time 0)
247        (progn
248          (add_object MISSLE (x) (- (y) 20))
249          (setq fire_delay 5)
250          (setq shooting_time (- shooting_time 1)))))
251
252  (if (or (and (< xm 0) (> (x) 20)) (and (> xm 0) (< (x) 300)))
253      (mover xm 0 0)
254    0))
255     
256
257(def_char PADDLE
258  (vars shooting_time fire_delay)
259  (funs (move_fun paddle_mover)    ; move fun get's passed the player input and responsible for calling ai_fun
260        (draw_fun paddle_draw))
261  (abilities (walk_top_speed 8)
262             (start_accel 8))
263  (flags (can_block T))
264  (states pong_art (stopped  "big_paddle")))
265
266(defun do_nothing () T)
267
268(def_char START
269  (funs (draw_fun dev_draw)   ; dev draw is a compiled fun
270        (ai_fun do_nothing))  ; always return T, therefore it never "dies"
271  (states pong_art (stopped "start")))
272
273
274(def_char TILE_BLOW_UP
275  (funs (ai_fun block_ai))
276  (states pong_art (stopped (seq "block_die" 1 9))))
277
278(defun pill1_ai ()
279  (set_y (+ (y) 3))
280  (next_picture)
281  (if (touching_bg)  ; are we touching the paddle
282      (progn
283        (add_score 1000)
284        (with_object (add_object BALL (x) (y) 1) (progn (set_fade_count 15) (set_aistate 80)))
285        nil)
286    (> 240 (y))))
287
288(defun pill2_ai ()
289  (set_y (+ (y) 3))
290  (next_picture)
291  (if (touching_bg)  ; are we touching the paddle?
292      (progn
293        (add_score 300)
294        (with_object (bg) (setq shooting_time 20))   ; give 'em a 20 ticks of fire power
295        nil)
296    (> 240 (y))))
297
298
299(def_char PILL1  ; the extra ball pill
300  (funs (ai_fun pill1_ai))
301  (states pong_art (stopped (seq "pill" 1 24))))
302
303(def_char PILL2  ; the extra ball pill
304  (funs (ai_fun pill2_ai))
305  (states pong_art (stopped (seq "pill2" 1 24))))
306
307(defun missle_ai ()
308  (set_course 90 10)
309  (not (check_collide (move_ball))))
310
311
312(def_char MISSLE
313  (funs (ai_fun missle_ai))
314  (states pong_art  (stopped "missle")))
315
316(defun block_ai () (next_picture))
317
318(def_char EXPLOSION
319  (funs (ai_fun block_ai))
320  (states pong_art (stopped (seq "exp" 1 10))))
321
322
323(setq current_level 1)
324(defun get_level_name (num)
325  (concatenate 'string pong_dir "pong" (digstr num 2) ".lvl"))
326
327(create_players PADDLE)
328(set_first_level (get_level_name current_level))
329(gc)    ; garbage collect
330(tmp-space)
331
Note: See TracBrowser for help on using the repository browser.