summaryrefslogtreecommitdiff
path: root/examples
diff options
context:
space:
mode:
authorDavid Thompson <dthompson@vistahigherlearning.com>2019-07-09 19:56:45 -0400
committerDavid Thompson <dthompson@vistahigherlearning.com>2019-07-09 19:56:45 -0400
commitacf4465f95900f936f4fbb837784b266d48682f2 (patch)
tree05998eb9ff3e7cc76495dc21b6ac1b926db0b181 /examples
parentcb47ca44b0302ab7906e5dad18f829631dcaf1e1 (diff)
Update hacky shmup prototype code.
Diffstat (limited to 'examples')
-rw-r--r--examples/shmup/images/ship.pngbin1589 -> 0 bytes
-rw-r--r--examples/shmup/shmup.scm200
2 files changed, 153 insertions, 47 deletions
diff --git a/examples/shmup/images/ship.png b/examples/shmup/images/ship.png
deleted file mode 100644
index 7c3aba4..0000000
--- a/examples/shmup/images/ship.png
+++ /dev/null
Binary files differ
diff --git a/examples/shmup/shmup.scm b/examples/shmup/shmup.scm
index 5fe51d7..fa757e5 100644
--- a/examples/shmup/shmup.scm
+++ b/examples/shmup/shmup.scm
@@ -24,7 +24,7 @@
;;;
(define *render-hitboxes?* #t)
-(define *god-mode?* #f)
+(define *god-mode?* #t)
;;;
@@ -377,17 +377,13 @@
#:texture space-marine
#:origin #v(32.0 0.0)))
(script
- ;;(set-vec2-x! (velocity marine) -2.0)
- (sleep (* 60 5))
- (set! (health marine) 0))
- (script
(let loop ((theta 0.0))
(emit-bullet/circle marine space-marine-bullet-type 0.0 18.0 theta 4 3.0)
(sleep 5)
(loop (+ theta (/ pi 32.0))))))
(define-class <drone> (<enemy>)
- (health #:accessor health #:init-form 300)
+ (health #:accessor health #:init-form 40)
(hitboxes #:getter hitboxes
#:init-form (list (make <hitbox>
#:rect (make-rect -18.0 -26.0 40.0 52.0)))))
@@ -399,20 +395,32 @@
#:texture drone-texture
#:origin #v(27.0 26.0)))
;; (run-script drone
- ;; (let loop ((theta 0.0))
- ;; (emit-bullet/circle drone space-marine-bullet-type 0.0 0.0 theta 20 1.5)
- ;; (sleep 60)
- ;; (loop (+ theta (/ pi 33.0)))))
- (run-script drone
- (let loop ((theta (/ pi 2.0)))
- (emit-bullet/circle drone space-marine-bullet-type 0.0 0.0 theta 3 1.5)
- (sleep 10)
- (loop (- theta (/ pi 33.0)))))
- ;; (run-script drone
;; (forever
- ;; (let ((theta (angle-to-player (parent drone) drone 0 0)))
- ;; (emit-bullet drone space-marine-bullet-type 0.0 0.0 theta 2.0)
- ;; (sleep 10))))
+ ;; (emit-bullet/circle drone space-marine-bullet-type 0.0 0.0 0.0 10 1.5)
+ ;; (sleep 5)
+ ;; (emit-bullet/circle drone space-marine-bullet-type 0.0 0.0 0.5 10 1.5)
+ ;; (sleep 5)
+ ;; (emit-bullet/circle drone space-marine-bullet-type 0.0 0.0 1.0 10 1.5)
+ ;; (sleep 5)))
+ ;; (run-script drone
+ ;; (let loop ((theta (/ pi 2.0)))
+ ;; (emit-bullet/circle drone space-marine-bullet-type 0.0 0.0 theta 3 1.5)
+ ;; (sleep 10)
+ ;; (loop (- theta (/ pi 33.0)))))
+ (run-script drone
+ ;; (teleport drone 3600.0 120.0)
+ ;; (move-to drone 290.0 120.0 90)
+ (forever
+ (let ((theta (angle-to-player (parent drone) drone 0 0)))
+ (repeat 6
+ (emit-bullet drone space-marine-bullet-type 0.0 0.0 theta 3.0)
+ (emit-bullet drone space-marine-bullet-type 0.0 0.0 (+ theta 0.04) 3.0)
+ (emit-bullet drone space-marine-bullet-type 0.0 0.0 (- theta 0.04) 3.0)
+ ;; (emit-bullet/circle drone space-marine-bullet-type 0.0 0.0 theta 20 3.0)
+ ;; (emit-bullet/circle drone space-marine-bullet-type 0.0 0.0 (+ theta 0.04) 20 3.0)
+ ;; (emit-bullet/circle drone space-marine-bullet-type 0.0 0.0 (- theta 0.04) 20 3.0)
+ (sleep 2))
+ (sleep 90))))
)
@@ -425,9 +433,11 @@
(hitboxes #:getter hitboxes
#:init-form (list (make <hitbox>
#:rect (make-rect -1.0 -1.0 2.0 2.0))))
- (speed #:accessor speed #:init-keyword #:speed #:init-form 1.0)
+ (speed #:accessor speed #:init-keyword #:speed #:init-form 2.0)
(shooting? #:accessor shooting? #:init-form #f)
(shooting-timer #:accessor shooting-timer #:init-form 0)
+ (guarding? #:accessor guarding? #:init-form #f)
+ (shield-charge #:accessor shield-charge #:init-form 100.0)
(invincible? #:accessor invincible? #:init-form #f)
(lives #:accessor lives #:init-form 3)
(score #:accessor score #:init-form 0))
@@ -437,8 +447,9 @@
(set! (lives player) 1)
(set! (shooting? player) #f)
(set! (shooting-timer player) 0)
+ (set! (guarding? player) #f)
+ (set! (shield-charge player) 100.0)
(set! (invincible? player) #f)
- (set! (speed player) 2.5)
(teleport player 8.0 100.0)
(set-vec2! (velocity player) 0.0 0.0)
(show player))
@@ -456,7 +467,7 @@
(define-method (on-boot (player <player>))
(attach-to player
- (mae <animated-sprite>
+ (make <animated-sprite>
#:name 'sprite
#:atlas player-atlas
#:origin #v(41.0 44.0)
@@ -466,7 +477,12 @@
(shoot . ,(make <animation>
#:frames #(23 24 25)
#:frame-duration 50)))
- #:default-animation 'idle)))
+ #:default-animation 'idle)
+ (make <filled-rect>
+ #:name 'shield
+ #:region (make-rect -30.0 -35.0 60.0 60.0)
+ #:color (make-color 1.0 0.0 1.0 0.5)
+ #:visible? #f)))
(define-method (emit-bullet (player <player>) ox oy theta speed)
(let ((p (position player)))
@@ -512,6 +528,9 @@
(when (zero? (modulo (shooting-timer player) 2))
(shoot player))
(set! (shooting-timer player) (+ (shooting-timer player) 1)))
+ (if (guarding? player)
+ (set! (shield-charge player) (max (- (shield-charge player) 1.0) 0.0))
+ (set! (shield-charge player) (min (+ (shield-charge player) 0.1) 100.0)))
(next-method))
(define-method (change-direction (player <player>) left? right? down? up?)
@@ -521,8 +540,8 @@
(if right? 1.0 0.0))
(+ (if down? -1.0 0.0)
(if up? 1.0 0.0)))
- (vec2-normalize! v))
- (vec2-mult! v (speed player)))
+ (vec2-normalize! v)
+ (vec2-mult! v (speed player))))
(define-method (begin-shooting (player <player>))
(set! (shooting? player) #t)
@@ -533,6 +552,47 @@
(set! (shooting? player) #f)
(change-animation (& player sprite) 'idle))
+(define-method (begin-guarding (player <player>))
+ (set! (guarding? player) #t)
+ (show (& player shield)))
+
+(define-method (end-guarding (player <player>))
+ (set! (guarding? player) #f)
+ (hide (& player shield)))
+
+
+;;;
+;;; Meter
+;;;
+
+(define-class <meter> (<node-2d>)
+ (width #:accessor width #:init-keyword #:width)
+ (thickness #:accessor thickness #:init-keyword #:thickness)
+ (proc #:accessor proc #:init-keyword #:proc)
+ (background-color #:accessor background-color #:init-form black
+ #:init-keyword #:background-color)
+ (fill-color #:accessor fill-color #:init-form tango-light-scarlet-red
+ #:init-keyword #:fill-color)
+ (background-rect #:getter background-rect #:init-form (make-rect 0.0 0.0 0.0 0.0))
+ (fill-rect #:getter fill-rect #:init-form (make-rect 0.0 0.0 0.0 0.0)))
+
+(define-method (update (meter <meter>) dt)
+ (let ((b (background-rect meter))
+ (f (fill-rect meter))
+ (w (width meter))
+ (h (thickness meter))
+ (t ((proc meter))))
+ (set-rect-width! b w)
+ (set-rect-height! b h)
+ (set-rect-width! f (* w t))
+ (set-rect-height! f h)))
+
+(define-method (render (meter <meter>) alpha)
+ (draw-filled-rect (background-rect meter) (background-color meter)
+ #:matrix (world-matrix meter))
+ (draw-filled-rect (fill-rect meter) (fill-color meter)
+ #:matrix (world-matrix meter)))
+
;;;
;;; Shmup scene
@@ -540,35 +600,56 @@
(define-class <shmup> (<scene-2d>)
(state #:accessor state #:init-form 'play)
- (enemies #:accessor enemies #:init-form '()))
+ (enemies #:accessor enemies #:init-form '())
+ (cont #:accessor cont #:init-form #f)
+ (cont-x #:accessor cont-x #:init-form +inf.0))
(define-method (update-hud (shmup <shmup>))
(let ((player (& shmup player)))
(set! (text (& shmup hud-lives))
- (format #f "LIVES ~d" (max (- (lives player) 1) 0)))
+ (format #f "lives ~d" (max (- (lives player) 1) 0)))
(set! (text (& shmup hud-score))
- (format #f "SCORE ~7d" (score player)))))
+ (format #f "score ~7d" (score player)))))
+
+(define (wait-for-scroll shmup x)
+ (yield
+ (lambda (k)
+ (set! (cont shmup) k)
+ (set! (cont-x shmup) x))))
+
+(define-method (stage-1 (shmup <shmup>))
+ (wait-for-scroll shmup 100.0)
+ ;; (add-enemy shmup
+ ;; (make <drone>))
+ ;; (wait-for-scroll shmup 500.0)
+ ;; (add-enemy shmup
+ ;; (make <drone>
+ ;; #:position #v(290.0 120.0)))
+ )
(define-method (reset-game (shmup <shmup>))
+ (set! (enemies shmup) '())
(with-agenda (agenda shmup) (reset-agenda))
(reset-player (& shmup player))
(set! (state shmup) 'play)
(update-hud shmup)
- (run-script shmup
- (forever
- (when (null? (enemies shmup))
- (sleep 30)
- (add-enemy shmup
- (make <drone>
- #:position #v(290.0 120.0)))
- ;; (add-enemy shmup
- ;; (make <drone>
- ;; #:position #v(290.0 170.0)))
- )
- (sleep 2))))
+ (run-script shmup (stage-1 shmup)
+ ;; (forever
+ ;; (when (null? (enemies shmup))
+ ;; (sleep 30)
+ ;; (add-enemy shmup
+ ;; (make <drone>
+ ;; #:position #v(290.0 120.0)))
+ ;; ;; (add-enemy shmup
+ ;; ;; (make <drone>
+ ;; ;; #:position #v(290.0 170.0)))
+ ;; )
+ ;; (sleep 2))
+ ))
(define-method (start-over (shmup <shmup>))
(detach (& shmup game-over))
+ (for-each detach (enemies shmup))
(reset-game shmup))
(define-method (on-boot (shmup <shmup>))
@@ -616,7 +697,19 @@
#:name 'hud-score
#:rank 5
#:position #v(230.0 228.0)
- #:text ""))
+ #:text "")
+ (make <label>
+ #:name 'hud-shield
+ #:rank 5
+ #:position #v(60.0 0.0)
+ #:text "shield")
+ (make <meter>
+ #:position #v(100.0 4.0)
+ #:width 120
+ #:thickness 2
+ #:proc (lambda ()
+ (/ (shield-charge (& shmup player)) 100.0))
+ #:rank 5))
(reset-game shmup))
(define-method (game-over-maybe (shmup <shmup>))
@@ -644,6 +737,10 @@
(let ((player (& shmup player))
(player-bullets (& shmup player-bullets))
(enemy-bullets (& shmup enemy-bullets)))
+ (when (and (cont shmup) (>= (x (& shmup background)) (cont-x shmup)))
+ (let ((k (cont shmup)))
+ (set! (cont shmup) #f)
+ (k)))
(collide enemy-bullets player
(lambda (bullet-id hitbox)
(kill-bullet enemy-bullets bullet-id)
@@ -704,6 +801,11 @@
(begin-shooting (& shmup player))
(end-shooting (& shmup player))))
+(define-method (update-player-guarding (shmup <shmup>))
+ (if (key-pressed? 'x)
+ (begin-guarding (& shmup player))
+ (end-guarding (& shmup player))))
+
(define-method (pause-game (shmup <shmup>))
(set! (state shmup) 'pause)
(pause (& shmup background))
@@ -722,19 +824,15 @@
(update-player-shooting shmup)
(for-each resume (enemies shmup)))
-(define-method (begin-shooting (shmup <shmup>))
- (begin-shooting (& shmup player)))
-
-(define-method (end-shooting (shmup <shmup>))
- (end-shooting (& shmup player)))
-
(define-method (on-key-press (shmup <shmup>) key scancode modifiers repeat?)
(match (state shmup)
('play
(match key
((or 'up 'down 'left 'right) (update-player-movement shmup))
('z (update-player-shooting shmup))
+ ('x (update-player-guarding shmup))
('return (pause-game shmup))
+ ('r (reset-game shmup))
(_ #f)))
('pause
(match key
@@ -752,9 +850,17 @@
(match key
((or 'up 'down 'left 'right) (update-player-movement shmup))
('z (update-player-shooting shmup))
+ ('x (update-player-guarding shmup))
(_ #f)))
(_ #f)))
+(define-method (on-mouse-press (shmup <shmup>) button clicks x y)
+ (match button
+ ('left
+ (add-enemy shmup
+ (make <drone> #:position (vec2 (/ x game-scale) (/ y game-scale)))))
+ (_ #f)))
+
(boot-kernel (make <kernel>
#:window-config (make <window-config>
#:title "shmup game thing i guess whatever"