Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

New version of asteroids

  • Loading branch information...
commit 1dd11938e3b5fae30b3db5163bd7564a51908dec 1 parent b39ce30
dharmatech authored

Showing 1 changed file with 76 additions and 17 deletions. Show diff stats Hide diff stats

  1. +76 17 demos/asteroids.sps
93 demos/asteroids.sps
... ... @@ -1,7 +1,6 @@
1 1
2 2 (import (rnrs)
3 3 (only (surfage s1 lists) filter-map)
4   - (surfage s42 eager-comprehensions)
5 4 (gl)
6 5 (glut)
7 6 (dharmalab records define-record-type)
@@ -11,12 +10,19 @@
11 10 (agave glamour window)
12 11 (agave glamour misc)
13 12 (surfage s19 time)
14   - (surfage s27 random-bits))
  13 + (surfage s27 random-bits)
  14 + (surfage s42 eager-comprehensions))
15 15
16 16 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
17 17 ;; utilities
18 18 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
19 19
  20 +(define (say . args)
  21 + (for-each display args)
  22 + (newline))
  23 +
  24 +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  25 +
20 26 (define (gl-translate-pt p)
21 27 (glTranslated (pt-x p) (pt-y p) 0.0))
22 28
@@ -81,10 +87,6 @@
81 87 (define particles '())
82 88
83 89 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
84   -
85   -(define key-pressed #f)
86   -
87   -;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
88 90 ;; bullet
89 91 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
90 92
@@ -109,13 +111,27 @@
109 111 (define asteroids #f)
110 112
111 113 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  114 +;; bullet-pack
  115 +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  116 +
  117 +(define-record-type++ bullet-pack
  118 + (fields (mutable pos)
  119 + (mutable vel)))
  120 +
  121 +(define pack #f)
  122 +
  123 +(is-bullet-pack pack)
  124 +
  125 +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
112 126
113 127 (initialize-glut)
114 128
115 129 (window (size 800 400)
116   - (title "test")
  130 + (title "Asteroids")
117 131 (reshape (width height)))
118 132
  133 +(random-source-randomize! default-random-source)
  134 +
119 135 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
120 136
121 137 (define (pt-wrap p)
@@ -132,6 +148,8 @@
132 148
133 149 (is-spaceship ship)
134 150
  151 +(define ammo 0)
  152 +
135 153 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
136 154
137 155 (set! asteroids
@@ -144,6 +162,13 @@
144 162
145 163 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
146 164
  165 +(set! pack (make-bullet-pack (pt (inexact (random-integer width))
  166 + (inexact (random-integer height)))
  167 + (pt (inexact (+ -50 (random-integer 100)))
  168 + (inexact (+ -50 (random-integer 100))))))
  169 +
  170 +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  171 +
147 172 (buffered-display-procedure
148 173 (lambda ()
149 174 (background 0.0)
@@ -195,6 +220,14 @@
195 220 (glutWireSphere (asteroid-radius asteroid) 10 10)))
196 221 asteroids)
197 222
  223 + ;; bullet-pack
  224 +
  225 + (glColor3f 0.0 0.0 1.0)
  226 +
  227 + (gl-matrix-excursion
  228 + (gl-translate-pt pack.pos)
  229 + (glutWireCube 10.0))
  230 +
198 231 ))
199 232
200 233 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -211,6 +244,8 @@
211 244
212 245 (ship.pos! (pt-wrap (pt+ ship.pos (pt*n ship.vel dt))))
213 246
  247 + (pack.pos! (pt-wrap (pt+ pack.pos (pt*n pack.vel dt))))
  248 +
214 249 (set! particles
215 250 (filter-map
216 251 (lambda (par)
@@ -249,9 +284,7 @@
249 284 a.radius)
250 285
251 286 (begin (set! score (+ score 1))
252   - (display "score: ")
253   - (display score)
254   - (newline)
  287 + (say "score: " score)
255 288 #f)
256 289
257 290 (set! asteroids
@@ -320,6 +353,16 @@
320 353 (inexact (+ -50 (random-integer 100))))
321 354 50.0))))
322 355
  356 + ;; ship pack contact
  357 +
  358 + (when (<= (pt-distance ship.pos pack.pos) 10.0)
  359 + (set! ammo (+ ammo 5))
  360 + (set! pack (make-bullet-pack (pt (inexact (random-integer width))
  361 + (inexact (random-integer height)))
  362 + (pt (inexact (+ -50 (random-integer 100)))
  363 + (inexact (+ -50 (random-integer 100))))))
  364 + (say "ammo: " ammo))
  365 +
323 366 )
324 367
325 368 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -363,15 +406,31 @@
363 406 ((#\x) (ship.theta! (+ ship.theta (radians 180.0))))
364 407
365 408 ((#\space)
366   - (set! bullets
367   - (cons
368   - (make-bullet ship.pos
369   - (pt+ ship.vel
370   - (pt*n (angle->pt ship.theta) 400.0))
371   - (current-time-in-seconds))
372   - bullets)))
  409 +
  410 + (when (> ammo 0)
  411 +
  412 + (set! ammo (- ammo 1))
  413 +
  414 + (set! bullets
  415 + (cons
  416 + (make-bullet ship.pos
  417 + (pt+ ship.vel
  418 + (pt*n (angle->pt ship.theta) 400.0))
  419 + (current-time-in-seconds))
  420 + bullets)))
  421 +
  422 + (say "ammo: " ammo)
  423 + )
373 424 )))
374 425
375 426 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
376 427
  428 +(say "w - Thrusters")
  429 +(say "a/d - Left/Right")
  430 +(say "s - Stop")
  431 +(say "x - Flip")
  432 +(say "spc - Laser")
  433 +
  434 +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  435 +
377 436 (glutMainLoop)

0 comments on commit 1dd1193

Please sign in to comment.
Something went wrong with that request. Please try again.