source: abuse-mac/trunk/addon/bong/bong.lsp @ 102

Last change on this file since 102 was 102, checked in by Sam Hocevar, 11 years ago
File size: 12.4 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 -a bong
6;;;; -a tells abuse to use an alternate Lisp Startup File from addon/bong/bong.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 version 1.0")
55      (quit)))
56
57
58(if (not (am_a_client))   ;; become a server if we are not a client
59    (progn
60      (set_game_name "Bong")
61      (start_server)
62      (set_net_min_players 1)
63      ))
64
65
66(setq pong_dir "addon/bong/")  ; in case we change the location of these files later
67                               ; this is always a very good idea to do because the user of
68                               ; this program may/may not be able to install into this directory       
69(setq pong_art (concatenate 'string pong_dir "bong.spe"))  ; all artwork is in this file
70
71(setq load_warn nil)            ; don't show a waringing if these files aren't there
72(setq section 'game_section)
73(load "lisp/english.lsp")       ; need this for various translated messages (english only pong for now!)
74(load "gamma.lsp")              ; gamma correction values (if saved)
75(setq load_warn T)
76
77(load "lisp/common.lsp")        ; grab the definition of abuse's light holder & obj mover
78(load "lisp/userfuns.lsp")      ; load seq defun
79(load "lisp/input.lsp")         ; get input mapping stuff from abuse
80
81
82;; these are a few things that the engine requires you to load...
83(load_big_font     "art/letters.spe" "letters")
84(load_small_font   "art/letters.spe" "small_font")
85(load_console_font "art/consfnt.spe" "fnt5x7")
86(load_color_filter "art/back/backgrnd.spe")
87(load_palette      "art/back/backgrnd.spe")
88(load_tiles pong_art)  ; load all foreground & background type images from pong.spe
89
90;; this is the image that will be displayed when the game starts
91;; this needs to be in the form (X . Y) where X is the filename and
92;; Y is the name of the image
93(setq title_screen      (cons pong_art "title_screen"))
94
95;; define a few sound effects to be used (these are all from abuse)
96(def_sound 'METAL  "sfx/lasrmis2.wav")
97(def_sound 'BHIT   "sfx/delobj01.wav")
98(def_sound 'BLOWUP "sfx/ball01.wav")
99(def_sound 'BUTTON_PRESS_SND "sfx/button02.wav")  ; used by menu system
100
101;; use these images to draw the score
102(setq nums (make-array 10 :initial-contents (list (def_image pong_art "0")
103                                                  (def_image pong_art "1")
104                                                  (def_image pong_art "2")
105                                                  (def_image pong_art "3")
106                                                  (def_image pong_art "4")
107                                                  (def_image pong_art "5")
108                                                  (def_image pong_art "6")
109                                                  (def_image pong_art "7")
110                                                  (def_image pong_art "8")
111                                                  (def_image pong_art "9"))))
112(setq score 0)
113
114(defun show_score (x y digs_left score)
115  (if (not (eq digs_left 0))       ; end recursion
116      (let ((this-digit (/ score digs_left)))
117        (put_image x y (aref nums this-digit))
118        (show_score (+ x (image_width (aref nums this-digit))) y
119                    (/ digs_left 10) (- score (* digs_left this-digit))))))
120
121(defun paddle_draw ()
122  (draw)                          ; normal draw function
123  (show_score (- (view_x2) 80) (view_y1) 1000000 score))
124
125(defun add_score (amount)
126  (perm-space)     ; we are modifing a global var, so we need swith to perm space
127  (setq score (+ score amount))
128  (tmp-space))     ; switch back to tmp space which is not garbage collected
129
130
131(defun destroyable_tile (x) (> x 1))
132
133(defun blow_up_tile (tilex tiley)
134  (let ((gamex (+ (* tilex 16) 8))
135        (gamey   (+ (* tiley 7) 7)))
136    (add_score 200)
137    (add_object EXPLOSION gamex gamey)
138    (destroy_tile tilex tiley)))
139
140(defun destroy_tile (tilex tiley)
141  (let ((gamex (+ (* tilex 16) 8))
142        (gamey   (+ (* tiley 7) 7))
143        (type (fg_tile tilex tiley)))
144    (add_score 100)
145    (set_fg_tile tilex tiley 0)            ; clear the tile and start animation
146    (if (eq type 6)                        ; dinamite tile?
147        (progn
148          (blow_up_tile tilex tiley)
149          (if (and (> tilex 0))
150              (blow_up_tile (- tilex 1) tiley))
151          (if (and (> tiley 0))
152              (blow_up_tile tilex (- tiley 1)))
153          (blow_up_tile tilex (+ tiley 1))
154          (blow_up_tile (+ tilex 1) tiley)))
155             
156    (with_object (bg) (add_hp 10))           ; give player points
157
158    (add_object TILE_BLOW_UP gamex gamey)
159    (if (eq (random 10) 0)
160        (add_object PILL1 gamex gamey)
161      (if (eq (random 30) 0)
162          (add_object PILL2 gamex gamey)))))
163
164
165(defun check_collide (status)    ;; returns T if we hit something
166  (if (not (eq status T))                                  ; did we hit anything?
167      (if (eq (car (cdr status)) 'object)                  ; did we hit an object?           
168          (let ((object (car (cdr (cdr status)))))
169            (if (eq (with_object object (otype)) PADDLE)   ; did we hit the paddle?
170                (if (<= (aistate) 180)
171                    (progn
172                      (set_aistate (+ (aistate) (- (with_object object (x)) (x))))
173                      (if (> 20 (aistate)) (set_aistate 20)
174                        (if (< 160 (aistate)) (set_aistate 160)))
175                      T)
176                  nil)
177              nil)
178            nil)
179        (if (eq (car (cdr status)) 'tile)                   ; did we hit a tile?
180            (let ((tilex (car (cdr (cdr status))))
181                  (tiley (car (cdr (cdr (cdr status))))))
182              (let ((type (fg_tile tilex tiley)))
183              (if (destroyable_tile type)                   ; can we destroy the tile?
184                  (progn
185                    (destroy_tile tilex tiley)
186                    (if (eq type 6)
187                        (play_sound BLOWUP 100)
188                      (play_sound BHIT)))
189                (play_sound METAL 60)))
190              T)
191          nil))
192    nil))
193
194
195(defun move_ball ()  ;; returns status of move
196  (let ((status (float_tick)))
197    (if (not (eq status T))   ; T means we did not hit anything
198        (let ((block_flags (car status)))
199          (if (or (blocked_left block_flags) (blocked_right block_flags)) ; bounce left/right
200              (if (<= (aistate) 180)
201                  (set_aistate (- 180 (aistate)))
202                (set_aistate (+ 180 (- 360 (aistate))))))
203          (if (or (blocked_up block_flags) (blocked_down block_flags))    ; bounce up/down
204              (progn
205                (if (<= (aistate) 180)
206                    (set_aistate (mod (+ (- 180 (aistate)) 180) 360))
207                  (set_aistate (- 360 (aistate))))
208                ))
209          (if (not (eq block_flags 0))       ; move the ball one tick, because we just bounced
210              (progn
211                (set_course (aistate) 7)
212                (float_tick)))))
213    status))
214
215
216(defun ball_ai ()
217  (set_course (aistate) 7)
218  (select (aitype)
219          (0  ; normal play, bounce around and stuff..
220           (check_collide (move_ball))             
221           (if (> (y) 240)  ; check to see if we are dead
222               (progn
223                 (if (> score 500)
224                     (add_score -500))
225                 (if (find_closest BALL)  ; don't regenerate if other balls exsist
226                     nil
227                   (progn
228                     (set_aistate 90)        ; reset ball to 90 degree angle
229                     (set_fade_count 15)
230                     (set_aitype 1)
231                     T)))
232             T))
233                 
234           (1 ; ball is dead - go to paddle and fade in
235            (set_x (with_object (bg) (x)))
236            (set_y (- (with_object (bg) (y)) 14))
237            (set_fade_count (- (fade_count) 1))
238            (if (eq (fade_count) 0)
239                (set_aitype 0))
240            T)))
241         
242
243(def_char BALL
244  (funs (ai_fun ball_ai))
245  (flags (hurt_all  T))
246  (range 100 100)                 ; make sure ball doesn't stop when off screen
247  (states pong_art (stopped "ball")))
248
249(defun paddle_mover (xm ym but)     ; passed in player input, should return "block" status
250                                    ; a "move" function is called from the "ai" function
251                                    ; by (move x y b), however in this case there is no ai fun, so
252                                    ; we can return 0 for block status sinse it is ignored
253  (set_gravity 0)
254  (set_shift_down (me) 80)
255  (set_shift_right (me) (- 0 (x)))   ; adjust screen shift so it doesn't scroll
256  (if (> fire_delay 0)
257      (setq fire_delay (- fire_delay 1))
258    (if (> shooting_time 0)
259        (progn
260          (add_object MISSLE (x) (- (y) 20))
261          (setq fire_delay 5)
262          (setq shooting_time (- shooting_time 1)))))
263
264  (if (or (and (< xm 0) (> (x) 20)) (and (> xm 0) (< (x) 300)))
265      (mover xm 0 0)
266    0))
267     
268
269(def_char PADDLE
270  (vars shooting_time fire_delay)
271  (funs (move_fun paddle_mover)    ; move fun get's passed the player input and responsible for calling ai_fun
272        (draw_fun paddle_draw))
273  (abilities (walk_top_speed 8)
274             (start_accel 8))
275  (flags (can_block T))
276  (states pong_art (stopped  "big_paddle")))
277
278(defun do_nothing () T)
279
280(def_char START
281  (funs (draw_fun dev_draw)   ; dev draw is a compiled fun
282        (ai_fun do_nothing))  ; always return T, therefore it never "dies"
283  (states pong_art (stopped "start")))
284
285
286(def_char TILE_BLOW_UP
287  (funs (ai_fun block_ai))
288  (states pong_art (stopped (seq "block_die" 1 9))))
289
290(defun pill1_ai ()
291  (set_y (+ (y) 3))
292  (next_picture)
293  (if (touching_bg)  ; are we touching the paddle
294      (progn
295        (add_score 1000)
296        (with_object (add_object BALL (x) (y) 1) (progn (set_fade_count 15) (set_aistate 80)))
297        nil)
298    (> 240 (y))))
299
300(defun pill2_ai ()
301  (set_y (+ (y) 3))
302  (next_picture)
303  (if (touching_bg)  ; are we touching the paddle?
304      (progn
305        (add_score 300)
306        (with_object (bg) (setq shooting_time 20))   ; give 'em a 20 ticks of fire power
307        nil)
308    (> 240 (y))))
309
310
311(def_char PILL1  ; the extra ball pill
312  (funs (ai_fun pill1_ai))
313  (states pong_art (stopped (seq "pill" 1 24))))
314
315(def_char PILL2  ; the extra ball pill
316  (funs (ai_fun pill2_ai))
317  (states pong_art (stopped (seq "pill2" 1 24))))
318
319(defun missle_ai ()
320  (set_course 90 10)
321  (not (check_collide (move_ball))))
322
323
324(def_char MISSLE
325  (funs (ai_fun missle_ai))
326  (states pong_art  (stopped "missle")))
327
328(defun block_ai () (next_picture))
329
330(def_char EXPLOSION
331  (funs (ai_fun block_ai))
332  (states pong_art (stopped (seq "exp" 1 10))))
333
334
335(setq current_level 1)
336(defun get_level_name (num)
337  (concatenate 'string pong_dir "pong" (digstr num 2) ".lvl"))
338
339(create_players PADDLE)
340(set_first_level (get_level_name current_level))
341(gc)    ; garbage collect
342(tmp-space)
343
Note: See TracBrowser for help on using the repository browser.