home *** CD-ROM | disk | FTP | other *** search
/ MacAddict 3 / MacAddict_003_1996_11.iso / Demos / Abuse / addon / bong / bong.lsp next >
Lisp/Scheme  |  1996-08-01  |  13KB  |  344 lines
  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.  
  344.