(use-modules (chickadee graphics sprite) (chickadee) (chickadee graphics viewport) (chickadee audio) (ice-9 pretty-print) (ice-9 format) (turbo vehicles)) ;;;; Constants and variables (define the-font (load-bitmap-font "thick_8x8.xml")) (define lane-height 65) (define lane-length 192) (define road-start-y 80) (define road-section-position 0) (define road (load-tileset "road.png" lane-length lane-height)) (define road-num-lanes 5) (define road-end-y (+ road-start-y (* road-num-lanes lane-height))) (define road-top (texture-atlas-ref road 2)) (define road-bottom (texture-atlas-ref road 0)) (define road-lane (texture-atlas-ref road 1)) (define grass (load-image "grass.png")) (define grass-height 96) (define vehicles-sprites (load-tileset "vehicles.png" vehicle-length vehicle-height)) (define player-car (texture-atlas-ref vehicles-sprites 0)) (define player-velocity (vec2 0 0)) (define player-min-speed 4) (define player-max-speed 20) (define player-speed (+ player-min-speed 1)) (define player-rotation 0) (define music-play? #f) (define music-res (load-audio "music.ogg")) (define music (make-source #:audio music-res #:loop? #t)) (define (calculate-vehicle-position lane) (vec2 (window-width (current-window)) (+ road-start-y (* 65 (- lane 1)) (/ (- lane-height vehicle-height) 2)))) (define (random-lane-start-pos) (calculate-vehicle-position (+ 1 (random road-num-lanes)))) (define (make-vehicle-list vehicle-list tile-ref) (if (< tile-ref (texture-atlas-size vehicles-sprites)) (cons (make-inactive-vehicle (* 2 tile-ref) (texture-atlas-ref vehicles-sprites tile-ref) (random-lane-start-pos)) (cons (make-inactive-vehicle (+ 1 (* 2 tile-ref)) (texture-atlas-ref vehicles-sprites tile-ref) (random-lane-start-pos)) (make-vehicle-list vehicle-list (+ tile-ref 1)))) vehicle-list)) (define vehicles (make-vehicle-list (list) 0)) (define game-over #f) (define (vehicle-has-spawn-space? vehicle) (let loop ((vehicles vehicles)) (let ((other-vehicle (car vehicles)) (other-vehicle-id (vehicle-id (car vehicles)))) (if (or (= other-vehicle-id (vehicle-id vehicle)) (not (vehicle-active? other-vehicle)) (vehicle-safety-distance? (car vehicles) vehicle)) (if (null? (cdr vehicles)) #t (loop (cdr vehicles))) #f)))) ;;;; Game functions (define (draw-lanes x y num-lanes) (if (> num-lanes 0) (begin (draw-sprite road-lane (vec2 x y)) (draw-lanes x (+ lane-height y) (- num-lanes 1))))) (define (draw-road-section startx starty num-lanes) (draw-sprite road-bottom (vec2 startx starty)) (draw-lanes startx (+ lane-height starty) (- num-lanes 2)) (draw-sprite road-top (vec2 startx (+ starty (* lane-height (- num-lanes 1)))))) (define (draw-grass-down x y) (draw-sprite grass (vec2 x (- y grass-height)))) (define (draw-grass-up x y) (draw-sprite grass (vec2 x y))) (define (draw-road startx starty num-lanes) (if (< startx (window-width (current-window))) (begin (draw-grass-down startx starty) (draw-road-section startx starty num-lanes) (draw-road (+ startx lane-length) starty num-lanes) (draw-grass-up startx (+ starty (* lane-height num-lanes)))))) (define (lane-y num-lane) (+ road-start-y (* lane-height (- num-lane 1)))) (define player-position (vec2 (/ (- (window-width (current-window)) vehicle-length) 4) (+ (lane-y 3) (/ (- lane-height vehicle-height) 2)))) (define (player-on-road?) (and (> (vec2-y player-position) road-start-y) (< (+ (vec2-y player-position) vehicle-height) road-end-y))) (define (off-road-player-top) (set! player-rotation 1) (set! player-position (vec2+ player-position (vec2 0 30))) (set! player-speed 0)) (define (off-road-player-bottom) (set! player-rotation -1) (set! player-position (vec2+ player-position (vec2 0 -10))) (set! player-speed 0)) (define (off-road-player) "Moves the player off-road" (if (> (vec2-y player-position) road-start-y) (off-road-player-top) (off-road-player-bottom))) (define (player-collides?) (let ((player-hitbox (vehicle-hitbox player-position))) (let loop ((vehicles vehicles)) (if (rect-intersects? player-hitbox (vehicle-hitbox (vehicle-position (car vehicles)))) #t (if (null? (cdr vehicles)) #f (loop (cdr vehicles))))))) ;;;; Chickadee hooks (if music-play? (source-play music)) (define (update interval) (if (not game-over) (begin (if (not (player-on-road?)) (begin (off-road-player) (set! game-over #t))) (if (player-collides?) (begin (off-road-player) ;; TODO: Think of different animation for this game over (set! game-over #t))) (set! road-section-position (if (< road-section-position (* lane-length -1)) (- (+ road-section-position lane-length) player-speed) (- road-section-position player-speed))) (set! player-position (vec2+ player-position player-velocity)) (for-each (lambda (veh) (if (vehicle-active? veh) (let ((speed-diff (- player-speed (vehicle-speed veh)))) (set-vehicle-position! veh (vec2+ (vehicle-position veh) (vec2 (* speed-diff -1) 0)))))) vehicles) ;; when van goes off screen (for-each (lambda (veh) (if (>= (* vehicle-length -1) (vec2-x (vehicle-position veh))) (begin (set-vehicle-position! veh (calculate-vehicle-position (+ 1 (random road-num-lanes)))) (set-vehicle-active! veh #f)) (if (and (not (vehicle-active? veh)) (= 0 (random 200)) (vehicle-has-spawn-space? veh)) (set-vehicle-active! veh #t)))) vehicles)))) (define (draw alpha) (draw-road road-section-position road-start-y road-num-lanes) (draw-text "Turbo Racer 3000!" (vec2 170.0 (- (window-height (current-window)) 25)) #:font the-font #:scale (vec2 2 2)) (draw-sprite player-car player-position #:rotation player-rotation) (for-each (lambda (veh) (if (vehicle-active? veh) (draw-sprite (vehicle-sprite veh) (vehicle-position veh)))) vehicles) (draw-text (format #f "Speed: ~smph" (* player-speed 5)) (vec2 450.0 20.0) #:font the-font #:scale (vec2 2 2)) (if game-over (draw-text "GAME OVER" (vec2 260 (/ (window-width (current-window)) 2)) #:font the-font #:scale (vec2 2 2)))) (define (key-press key modifiers repeat?) (cond ((eq? key 'w) (set! player-velocity (vec2 0 vehicle-steering-speed))) ((eq? key 's) (set! player-velocity (vec2 0 (* vehicle-steering-speed -1)))) ((eq? key 'a) (set! player-speed (max (- player-speed 1) player-min-speed))) ((eq? key 'd) (set! player-speed (min (+ player-speed 1) player-max-speed))) ((eq? key 'escape) (abort-game)))) (define (key-release key modifiers) (if (or (eq? key 'w) (eq? key 's)) (set! player-velocity (vec2 0 0))))