path: root/turbo.scm

(use-modules (chickadee graphics sprite)
	     (chickadee)
	     (chickadee graphics viewport)
	     (chickadee audio)
	     (ice-9 pretty-print)
	     (ice-9 format)
	     (turbo vehicles)
	     (srfi srfi-1))

;;;; 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-velocity (vec2 0 0))
(define player-min-speed 4)
(define player-max-speed 20)
(define player-rotation 0)

(define level-difficulty 50)

(define music-play? #t)
(define music-res (load-audio "music.ogg"))
(define music (make-source #:audio music-res #:loop? #t))
(define engine-res (load-audio "engine-loop-1.ogg"))
(define engine-sound (make-source #:audio engine-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 (vehicle-reset-ahead veh)
  (let ((lane-num (random road-num-lanes)))
    (set-vehicle-position! veh (calculate-vehicle-position
				(+ 1 lane-num)))
    (set-vehicle-speed! veh (+ player-min-speed lane-num) )
    (set-vehicle-active! veh #f)))

(define vehicles (make-vehicle-list (list) 0))
(for-each vehicle-reset-ahead vehicles)

;; Important: set one vehicle active to bootstrap the game ????
;; TODO: nope, bug here somewhere!
(set-vehicle-active! (car vehicles) #t)

(define game-over #f)

(define (vehicle-has-spawn-space? vehicle)
  (define (vehicle-in-the-way? v)
    (and (not (= (vehicle-id vehicle) (vehicle-id v)))
	 (vehicle-inactive? v)
	 (vehicle-safety-distance? v vehicle)))
  (not (any vehicle-in-the-way? vehicles)))


;;;; 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 initial-player-position
  (vec2 (/ (- (window-width (current-window)) vehicle-length) 4)
	(+ (lane-y 3)
	   (/ (- lane-height vehicle-height) 2))))

(define player-car (make-vehicle
		    0
		    (texture-atlas-ref vehicles-sprites 0)
		    initial-player-position
		    (+ 1 player-min-speed)
		    #t))

(define (set-player-speed! new-speed)
  (let* ((player-speed (max (min new-speed player-max-speed) player-min-speed))
	(pitch-factor (* 0.10
			 (- player-speed
			    player-min-speed))))
    (set-vehicle-speed! player-car player-speed)
    (set-source-pitch! engine-sound (+ 1 pitch-factor))))

(define (player-on-road?)
  (and (> (vec2-y (vehicle-position player-car)) road-start-y)
       (< (+ (vec2-y (vehicle-position player-car)) vehicle-height) road-end-y)))

(define (crash-player top?)
  (set! player-rotation (if top? 1 -1))
  (set-vehicle-position! player-car (vec2+ (vehicle-position player-car) (vec2 0 (if top? 30 10))))
  (set-vehicle-speed! player-car 0)
  (source-stop engine-sound))

(define (off-road-player-top)
  (crash-player #t))

(define (off-road-player-bottom)
  (crash-player #f))

(define (off-road-player)
  "Moves the player off-road"
  (if (> (vec2-y (vehicle-position player-car)) road-start-y)
      (off-road-player-top)
      (off-road-player-bottom)))

(define (player-collides?)
  (let ((player-hitbox (vehicle-hitbox player-car)))
    (any (lambda (vehicle)
	   (rect-intersects? player-hitbox (vehicle-hitbox vehicle)))
	 vehicles)))


(define (vehicle-off-screen? veh)
  (and vehicle-active?
       (>= (- 0 vehicle-length) (vec2-x (vehicle-position veh)))))

;;;; Chickadee hooks

(set-source-volume! music 0.5)
(if music-play?
    (source-play music))

(if music-play?
    (source-play engine-sound))

(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 (- 0 lane-length))
		  (- (+ road-section-position lane-length) (vehicle-speed player-car))
		  (- road-section-position (vehicle-speed player-car))))

	(set-vehicle-position! player-car (vec2+ (vehicle-position player-car) player-velocity))

	(for-each (lambda (veh)
		    (vehicle-move! veh (vec2 (- 0 (vehicle-speed-diff player-car veh)) 0)))
		  (filter vehicle-active? vehicles))

	;; when vehicle goes off screen
	(for-each vehicle-reset-ahead (filter vehicle-off-screen? vehicles))

	(if (= 0 (random level-difficulty))
	    (begin
	      (let* ((inactive-vehicles (filter vehicle-inactive? vehicles))
		     (spawnable-vehicles (filter vehicle-has-spawn-space? inactive-vehicles)))
		(if (not (null? spawnable-vehicles))
		    (set-vehicle-active! (car spawnable-vehicles) #t)))))
	;; End begin
	)))

(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 (vehicle-sprite player-car) (vehicle-position player-car) #:rotation player-rotation)

  (for-each (lambda (veh)
	      (draw-sprite (vehicle-sprite veh) (vehicle-position veh)))
	    (filter vehicle-active? vehicles))

  (draw-text (format #f "Speed: ~smph" (* (vehicle-speed player-car) 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 (- 0 vehicle-steering-speed))))
   ((eq? key 'a)
    (set-player-speed! (- (vehicle-speed player-car) 1)))
   ((eq? key 'd)
    (set-player-speed! (+ (vehicle-speed player-car) 1)))
   ((eq? key 'escape)
       (abort-game))
   ((and (eq? key 'return) game-over)
    (set-vehicle-position! player-car initial-player-position)
    (set-player-speed! (+ 1 player-min-speed))
    (set! player-rotation 0)
    (source-play engine-sound)
    ;; Reset all vehicles
    (set! game-over #f))))

(define (key-release key modifiers)
  (if (or (eq? key 'w) (eq? key 's))
      (set! player-velocity (vec2 0 0))))