bullet hell test

bullet-hell.lisp

(in-package #:cl-user)
(defpackage #:shooter
  (:use #:cl)
  (:export #:init
           #:main))
(in-package #:shooter)


(defparameter *window-width* 800)
(defparameter *window-height* 600)

;;;
;;; game objects

(defstruct object pos-fn draw-fn act-fn available?)
(defparameter *objects* (make-array 5000 :initial-element nil))

(defun make-object* (pos-fn draw-fn act-fn)
  (make-object :pos-fn (lambda (tick) (funcall pos-fn tick))
               :draw-fn draw-fn
               :act-fn act-fn
               :available? t))

(defun alloc-object (pos-fn draw-fn act-fn)
  (let ((idx (position-if #'(lambda (o) (or (null o) (null (object-available? o)))) *objects*)))
    (when idx
      (let ((obj (make-object* pos-fn draw-fn act-fn)))
        (setf (aref *objects* idx) obj)
        obj))))

;;;
;;; bullet

(defun draw-bullet (pos tick)
  (declare (ignore tick))
  (sdl:draw-circle (sdl:point :x (car pos) :y (cdr pos)) 10
                   :color (sdl:color :r 50 :g 100 :b 180)))

(defun disable-on-out (obj pos tick)
  (declare (ignore tick))
  (let ((x (car pos))
        (y (cdr pos)))
    (when (or (> 0 x) (< *window-width* x)
              (> 0 y) (< *window-height* y))
      (setf (object-available? obj) nil))))

(defun shoot-arround (v)
  (loop
    :for deg :from 0 :upto 360 :by 15
    :do (let ((obj (alloc-object (let ((dx (* v (cos (* deg (/ pi 180)))))
                                       (dy (* v (sin (* deg (/ pi 180)))))
                                       (x 400)
                                       (y 300))
                                   #'(lambda (tick)
                                       (declare (ignore tick))
                                       (cons (incf x dx) (incf y dy))))
                                 #'draw-bullet
                                 #'disable-on-out)))
          (when obj
            (setf (object-available? obj) t)))))

;;;
;;; system

(defun init ()
  (alloc-object #'(lambda (tick)
                    (when (zerop (mod tick 34))
                      (dotimes (n 10)
                        (shoot-arround (float (1+ (* 1.6 n))))))
                    (cons 400 300))
                #'(lambda (pos tick)
                    (declare (ignore tick))
                    (sdl:draw-circle (sdl:point :x (car pos) :y (cdr pos)) 5
                                     :color sdl:*black*))
                #'disable-on-out))

(defparameter *tick* 0)

(defun proc ()
  (loop
    :for o :across *objects*
    :when (and o (object-available? o))
    :do (let ((pos (funcall (object-pos-fn o) *tick*)))
          (when pos
            (funcall (object-draw-fn o) pos *tick*)
            (funcall (object-act-fn o) o pos *tick*))))
  (incf *tick*))

(defun main ()
  (sdl:with-init ()
    (sdl:window *window-width* *window-height*
                :title-caption "shooter")
    (setf (sdl:frame-rate) 60)
    (init)

    (sdl:with-events ()
      (:quoit-event () t)
      (:idle ()
       (sdl:clear-display sdl:*white*)
       (proc)
       (sdl:update-display)))))