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