~cadence/eval-em-up

08cf5e27f71c6a02b981184f829a29252a6df5b0 — Cadence Ember 1 year, 3 days ago 58f62d5
version 1.1

* game states: tutorial -> playing -> game over
* can now restart after game over
* restart from wave 3 if you've reached that wave
* fix lag when hitting first enemy
* key B toggles hitbox display
* ships must be 70% visible on screen before they can be hit
  (no more insta-killing them at the right edge)
1 files changed, 273 insertions(+), 99 deletions(-)

M main.rkt
M main.rkt => main.rkt +273 -99
@@ 22,22 22,22 @@
;;; Important constants
(define screen-width 1280)
(define screen-height 720)
(define debug-mode #f)
(define debug-mode? #f)
(define show-hitboxes? #f)
(define game-state 'tutorial)
(define (transition-to new-state)
  (for/list ([e (es)])
    (send e transition new-state))
  (set! game-state new-state))
(define (debug . args)
  (when debug-mode
  (when debug-mode?
    (if (= (length args) 1)
        (println (car args))
        (apply printf args))))

#|
;;; Workman layout
(define key-up KEY_R)
(define key-down KEY_H)
(define key-left KEY_S)
(define key-right KEY_T)
(define key-shoot KEY_SPACE)
|#
;;; QWERTY layout

;;; Key definitions for gameplay
;; When used with IsKeyUp/Down/Pressed functions, these refer to key locations, not characters
(define key-up KEY_W)
(define key-down KEY_S)
(define key-left KEY_A)


@@ 59,6 59,9 @@
(define health-bars-tex (delay (LoadTexture "tex/health-bars.png")))
(define enemy-shot-tex (delay (LoadTexture "tex/enemy-shot-sheet.png")))
(define explosion-tex (delay (LoadTexture "tex/explosion-sheet.png")))
(define wasd-tutorial-tex (delay (LoadTexture "tex/wasd.png")))
(define space-tutorial-tex (delay (LoadTexture "tex/spaceshoot.png")))
(define game-over-tex (delay (LoadTexture "tex/gameover.png")))
(define chalk-texes
  (vector (list 425 324 (delay (LoadTexture "tex/chalk-angel.png")))
          (list 442 510 (delay (LoadTexture "tex/chalk-heart.png")))


@@ 111,6 114,12 @@
     (define/public (draw)
       (void))

     (define/public (letter chars)
       (void))

     (define/public (transition new-state)
       (void))

     (define/public (die)
       (debug "dead: ~a~n" this%)
       (priority-queue-remove! entities this)


@@ 151,7 160,7 @@
                      (make-Vector2 0.0 0.0) ;; origin
                      0.0 ;; rotation
                      WHITE)
      (when debug-mode
      (when show-hitboxes?
        (for ([hitbox hitboxes])
          (DrawRectangleRec
           (make-Rectangle


@@ 180,6 189,16 @@
             (* (get-field scale that) (vector-ref hitbox2 2))
             (* (get-field scale that) (vector-ref hitbox2 3))))))))


(define hitbox-controller%
  (class entity%
    (super-new [x 0.0] [y 0.0] [order 0])

    (define/override (letter chars)
      (super letter chars)
      (when (memq (char->integer #\b) chars)
        (set! show-hitboxes? (not show-hitboxes?))))))

(define (flipper-mixin %)
  ;; (printf "building flipper-mixin off ~v~n" %)
  ;; (println (interface->method-names (class->interface %)))


@@ 200,7 219,12 @@
;;; The ship that the player controls.
(define ship%
  (class (flipper-mixin (sprite-mixin entity%))
    (super-new [order 40]
    (define initial-x 220.0)
    (define initial-y 250.0)
    (define initial-hp 5)
    (super-new [x initial-x]
               [y initial-y]
               [order 40]
               [width 471.0]
               [height 391.0]
               [scale 0.5]


@@ 214,46 238,71 @@
                           #(265 155 15 125)
                           #(280 170 75 90)
                           #(355 196 37 36))])
    (inherit-field x y width height scale)
    (inherit-field x y width height scale dead?)
    (field [speed 5]
           [last-shot 0]
           [shot-spacing 180]
           [hp 5]
           [hp initial-hp]
           [health-gauge (new health-gauge%
                              [offset-x 60]
                              [offset-y 190])])

    (define wasd-tutorial (new wasd-tutorial%))
    (define space-tutorial (new space-tutorial%))
    (define movement-frames-until-space-tutorial 40)

    (define/override (transition new-state)
      (super transition new-state)
      (when (and (eq? game-state 'dead) (eq? new-state 'main))
        (set! x initial-x)
        (set! y initial-y)
        (set! hp initial-hp)
        (set! dead? #f)))

    (define (damage by)
      (set! hp (sub1 hp))
      (when (= hp 0)
        (send this die))
        (set! dead? #t)
        (transition-to 'dead))
      (new explosion% [x (send by center-x)] [y (send by center-y)]))

    (define/override (tick)
      (super tick)
      (when (IsKeyDown key-right)
        (set! x (+ x speed)))
      (when (IsKeyDown key-left)
        (set! x (- x speed)))
      (when (IsKeyDown key-up)
        (set! y (- y speed)))
      (when (IsKeyDown key-down)
        (set! y (+ y speed)))
      (when (IsKeyDown key-shoot)
        ;; ensure time spacing between shots
        (when ((current-milliseconds) . > . (+ last-shot shot-spacing))
          (for ([ys (list 178.0 230.0)])
            (new shot% [x (+ x (* (- width 70) scale))] [y (+ y (* ys scale))]))
          (set! last-shot (current-milliseconds))))
      (for ([entity (in-vector (es))])
        (when (and (or (is-a? entity enemy%) (is-a? entity enemy-shot%))
                   (send this touching? entity))
          (damage entity)
          (send entity contact))))
      (unless dead?
        (super tick)
        (define moved-this-frame? #f)
        (when (IsKeyDown key-right)
          (set! x (+ x speed))
          (set! moved-this-frame? #t))
        (when (IsKeyDown key-left)
          (set! x (- x speed))
          (set! moved-this-frame? #t))
        (when (IsKeyDown key-up)
          (set! y (- y speed))
          (set! moved-this-frame? #t))
        (when (IsKeyDown key-down)
          (set! y (+ y speed))
          (set! moved-this-frame? #t))
        (when moved-this-frame?
          (set! movement-frames-until-space-tutorial (sub1 movement-frames-until-space-tutorial))
          (when (= movement-frames-until-space-tutorial 0)
            (send space-tutorial show)
            (set! movement-frames-until-space-tutorial -1)))
        (when (IsKeyDown key-shoot)
          ;; ensure time spacing between shots
          (when ((current-milliseconds) . > . (+ last-shot shot-spacing))
            (for ([ys (list 178.0 230.0)])
              (new shot% [x (+ x (* (- width 70) scale))] [y (+ y (* ys scale))]))
            (set! last-shot (current-milliseconds))))
        (for ([entity (in-vector (es))])
          (when (and (or (is-a? entity enemy%) (is-a? entity enemy-shot%))
                     (send this touching? entity))
            (damage entity)
            (send entity contact)))))

    (define/override (draw)
      (super draw)
      (send health-gauge draw x y hp))))
      (unless dead?
        (super draw)
        (send health-gauge draw x y hp)))))


;;; Shots fired by the player ship.


@@ 277,6 326,11 @@
          (send entity damage)
          (send this die)))
      (when (x . > . screen-width)
        (send this die)))

    (define/override (transition new-state)
      (super transition new-state)
      (when (eq? new-state 'dead)
        (send this die)))))




@@ 302,7 356,12 @@
  (class (die-offscreen-mixin (flipper-mixin (sprite-mixin entity%)))
    (super-new)
    (define/public (contact)
      (send this die))))
      (send this die))

    (define/override (transition new-state)
      (super transition new-state)
      (when (and (eq? game-state 'dead) (eq? new-state 'main))
        (send this die)))))


(define enemy-shot-aimed%


@@ 374,10 433,12 @@

    (define/override (tick)
      (super tick)
      (set! shot-time-count (add1 shot-time-count))
      (when (shot-time-count . >= . shot-time-ticks)
        (new shot-class% [x (send this center-x)] [y (send this center-y)])
        (set! shot-time-count 0)))))
      (case game-state
        [(main)
         (set! shot-time-count (add1 shot-time-count))
         (when (shot-time-count . >= . shot-time-ticks)
           (new shot-class% [x (send this center-x)] [y (send this center-y)])
           (set! shot-time-count 0))]))))


(define health-gauge%


@@ 390,41 451,127 @@
    (define bar-breakpoints #(0.0 44.0 76.0 107.0 140.0 179.0))

    (define/public (draw parent-x parent-y hp)
      (define x (+ parent-x offset-x))
      (define y (+ parent-y offset-y))
      ;; background
      (DrawTexturePro (force health-background-tex) ;; texture
                      (make-Rectangle 0.0 0.0 width height) ;; source
                      (make-Rectangle x y (* width scale) (* height scale)) ;; dest
                      (make-Vector2 0.0 0.0) ;; origin
                      0.0 ;; rotation
                      WHITE)
      ;; bars
      (define bar-draw-width (vector-ref bar-breakpoints hp))
      (DrawTexturePro (force health-bars-tex) ;; texture
                      (make-Rectangle 0.0 0.0 bar-draw-width height) ;; source
                      (make-Rectangle x y (* bar-draw-width scale) (* height scale)) ;; dest
                      (make-Vector2 0.0 0.0) ;; origin
                      0.0 ;; rotation
                      WHITE)
      ;; frame
      (DrawTexturePro (force health-frame-tex) ;; texture
                      (make-Rectangle 0.0 0.0 width height) ;; source
                      (make-Rectangle x y (* width scale) (* height scale)) ;; dest
                      (make-Vector2 0.0 0.0) ;; origin
                      0.0 ;; rotation
                      WHITE))))
      (case game-state
        [(main)
         (define x (+ parent-x offset-x))
         (define y (+ parent-y offset-y))
         ;; background
         (DrawTexturePro (force health-background-tex) ;; texture
                         (make-Rectangle 0.0 0.0 width height) ;; source
                         (make-Rectangle x y (* width scale) (* height scale)) ;; dest
                         (make-Vector2 0.0 0.0) ;; origin
                         0.0 ;; rotation
                         WHITE)
         ;; bars
         (define bar-draw-width (vector-ref bar-breakpoints hp))
         (DrawTexturePro (force health-bars-tex) ;; texture
                         (make-Rectangle 0.0 0.0 bar-draw-width height) ;; source
                         (make-Rectangle x y (* bar-draw-width scale) (* height scale)) ;; dest
                         (make-Vector2 0.0 0.0) ;; origin
                         0.0 ;; rotation
                         WHITE)
         ;; frame
         (DrawTexturePro (force health-frame-tex) ;; texture
                         (make-Rectangle 0.0 0.0 width height) ;; source
                         (make-Rectangle x y (* width scale) (* height scale)) ;; dest
                         (make-Vector2 0.0 0.0) ;; origin
                         0.0 ;; rotation
                         WHITE)]))))


(define wasd-tutorial%
  (class (sprite-mixin entity%)
    (super-new [x 0.0]
               [y 0.0]
               [order 61]
               [width 512.0]
               [height 347.0]
               [scale 0.5]
               [sprite-tex wasd-tutorial-tex]
                [hitboxes null])
    (inherit-field x y)

    (define/override (transition new-state)
      (super transition new-state)
      (case game-state
        [(main)
         (send this die)]))

    (define/override (draw)
      (case game-state
        [(tutorial)
         (define ship
           (for/first ([e (es)]
                       #:when (is-a? e ship%))
             e))
         (when ship
           (set! x (+ (get-field x ship) -20))
           (set! y (+ (get-field y ship) 200)))
         (super draw)]))))


(define space-tutorial%
  (class (sprite-mixin entity%)
    (super-new [x (- screen-width (* 305.0 0.5 1.5))]
               [y (- (/ screen-height 2) (* 142.0 0.5 0.5))]
               [order 61]
               [width 305.0]
               [height 142.0]
               [scale 0.5]
               [sprite-tex space-tutorial-tex]
               [hitboxes null])
    (inherit-field x y)

    (define visible? #f)

    (define/public (show)
      (set! visible? #t))

    (define/override (tick)
      (when (and visible? (IsKeyDown key-shoot))
        (transition-to 'main)))

    (define/override (transition new-state)
      (super transition new-state)
      (case game-state
        [(main)
         (set! visible? #f)
         (send this die)]))

    (define/override (draw)
      (when (and visible? (eq? game-state 'tutorial))
        (super draw)))))


(define game-over%
  (class (sprite-mixin entity%)
    (super-new [x (- (/ screen-width 2) (* 1708.0 0.5 0.5))]
               [y (- (/ screen-height 2) (* 625.0 0.5 0.5))]
               [order 99]
               [width 1708.0]
               [height 625.0]
               [scale 0.5]
               [sprite-tex game-over-tex]
               [hitboxes null])
    (inherit-field x y)

    (define/override (letter chars)
      (when (and (eq? game-state 'dead) (memq (char->integer #\r) chars))
        (transition-to 'main)))

    (define/override (draw)
      (when (eq? game-state 'dead)
        (super draw)))))


;;; An enemy that can be shot and attacked to evaluate its code. Most enemies will simply have their code as (die).
(define enemy%
  (class (die-offscreen-mixin (flipper-mixin (sprite-mixin entity%)))
    (super-new [order 50])
    (inherit-field x y)
    (inherit-field x y width scale)

    (field [shots-taken 0]
           [can-be-hit-this-tick? #t])
           [can-be-hit-this-tick? #f])
    (init-field [base-command "hit"])

    (define command (string-append "(" base-command ")"))


@@ 440,7 587,9 @@

    (define/override (tick)
      (super tick)
      (set! can-be-hit-this-tick? #t))
      ;; ship has to come 70% of the way screen before it can be hit
      (when ((- screen-width x) . > . (* width scale 70/100))
        (set! can-be-hit-this-tick? #t)))

    (define/public (hit)
      (send this die))


@@ 454,7 603,12 @@
        (set! can-be-hit-this-tick? #f)
        (compute-display-text)
        (when (shots-taken . >= . 3)
          (send this eval command))))))
          (send this eval command))))

    (define/override (transition new-state)
      (super transition new-state)
      (when (and (eq? game-state 'dead) (eq? new-state 'main))
        (send this die)))))


(define enemy-basic%


@@ 724,36 878,47 @@
    (define pointer 0)
    (define wave-enemies (mutable-set))

    (define/override (transition new-state)
      (when (and (eq? game-state 'dead) (eq? new-state 'main))
        (set! ticks 0)
        (if (wave-index . >= . 2)
            (set! wave-index 2)
            (set! wave-index 0))
        (set! pointer 0)
        (set-clear! wave-enemies)))

    (define/override (tick)
      (super tick)
      (inc ticks)
      ;; current wave (list of spawning occurrences)
      (define wave (vector-ref waves wave-index))
      (define enemies (mutable-set))
      (let loop ()
        ;; has this whole wave been spawned yet?
        (define wave-all-spawned? (pointer . >= . (vector-length wave)))
        (if (not wave-all-spawned?)
            ;; no - check if we should spawn the next thing
            (let ([next (vector-ref wave pointer)])
              (when (ticks . >= . (car next))
                (define enemy (new (second next) [x (exact->inexact screen-width)] [y (exact->inexact (third next))]))
                (set-add! wave-enemies enemy)
                (set! pointer (add1 pointer))
                (loop)))
            ;; yes - wait for all enemies to be killed, then proceed to the next wave
            (when (for/and ([enemy (in-set wave-enemies)]) (get-field dead? enemy))
              (set! pointer 0)
              (set! ticks -45)
              (set-clear! wave-enemies)
              (inc wave-index)
              (when (wave-index . >= . (vector-length waves))
                (send this die))))))))
      (case game-state
        [(main)
         (inc ticks)
         ;; current wave (list of spawning occurrences)
         (when (wave-index . < . (vector-length waves))
           (define wave (vector-ref waves wave-index))
           (define enemies (mutable-set))
           (let loop ()
             ;; has this whole wave been spawned yet?
             (define wave-all-spawned? (pointer . >= . (vector-length wave)))
             (if (not wave-all-spawned?)
                 ;; no - check if we should spawn the next thing
                 (let ([next (vector-ref wave pointer)])
                   (when (ticks . >= . (car next))
                     (define enemy (new (second next) [x (exact->inexact screen-width)] [y (exact->inexact (third next))]))
                     (set-add! wave-enemies enemy)
                     (set! pointer (add1 pointer))
                     (loop)))
                 ;; yes - wait for all enemies to be killed, then proceed to the next wave
                 (when (for/and ([enemy (in-set wave-enemies)]) (get-field dead? enemy))
                   (set! pointer 0)
                   (set! ticks -45)
                   (set-clear! wave-enemies)
                   (inc wave-index)))))]))))


;;; Wave definitions
(define waves-def
  `(((spawn ,enemy-clunker% 300)
  `(((wait 60)
     (spawn ,enemy-clunker% 300)
     (wait 80)
     (spawn ,enemy-clunker% 80))
    ((spawn ,enemy-basic% 100)


@@ 808,18 973,21 @@

(define background0 (new background% [i 0]))
(define background1 (new background% [i 1]))
(define ship (new ship% [x 220.0] [y 250.0]))
;; (define enemy (new enemy-basic% [x (- (exact->inexact screen-width) 200)] [y 400.0]))
;; (define spawner (new spawner%))
(define chalk-spawner (new chalk-spawner%))
(new hitbox-controller%)
(define ship (new ship%))
(define game-over (new game-over%))
(define wave-spawner (new wave-spawner%))


(define (main)
  (SetTargetFPS 60)

  ;; must initialise window (and opengl context) before any textures can be loaded
  (InitWindow screen-width screen-height "Eval-em-up!")

  (eval '(void)) ;; prevent small lag spike when shooting first enemy

  (collect-garbage)

  (let loop ((close? #f))


@@ 828,12 996,18 @@
    ;; give repl a chance to run
    (sleep/yield 0)

    (define chars-pressed-this-frame
      (for/list ([char (in-producer (λ _ (GetCharPressed)) 0)])
        char))

    ;; compute sorted entities ahead of time
    (update-es!)

    ;; tick all entities
    (for ([entity (in-vector (es))])
      (send entity tick))
      (send entity tick)
      (when (pair? chars-pressed-this-frame)
        (send entity letter chars-pressed-this-frame)))

    ;; recompute sorted entities as some may have died
    (update-es!)