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 250)
(define player-max-speed 1072)
(define player-rotation 0)
;; 2px/s/s acceleration
(define player-car-acceleration 100)
;; 4px/s/s deceleration
(define player-car-deceleration -500)
(define player-current-acceleration 0)

(define level-difficulty 1)

(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 (* 75 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= vehicle v))
	 (vehicle-active? v)
	 (not (vehicle-safety-distance? v vehicle))))
  (not (any vehicle-in-the-way? vehicles)))


;;;; Game functions

(define (draw-lanes x y num-lanes)
  (when (> num-lanes 0)
      (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)
  (when (< startx (window-width (current-window)))
      (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 (level-min-speed)
  (+ player-min-speed (* (- level-difficulty 1) 18)))

(define (set-player-speed! new-speed)
  (let* ((min-speed (level-min-speed))
	 (player-speed (max (min new-speed player-max-speed) min-speed))
	 (pitch-factor (* 0.10 (- player-speed 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?
       (>= (- vehicle-length) (vec2-x (vehicle-position veh)))))

;;;; Chickadee hooks

(set-source-volume! music 0.5)

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

(define (update interval)
  (unless game-over
      (unless (player-on-road?)
	  (off-road-player)
	  (set! game-over #t))

      (let ((new-speed (+ (vehicle-speed player-car)
			  (* player-current-acceleration interval))))
	(set-vehicle-speed! player-car (min player-max-speed
					    (max (level-min-speed)
						 new-speed))))

      (when (player-collides?)
	  (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))
		(- (+ road-section-position lane-length) (* interval (vehicle-speed player-car)))
		(- road-section-position (* interval (vehicle-speed player-car)))))

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

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

      ;; Reset vehicles that have gone off screen
      (for-each vehicle-reset-ahead (filter vehicle-off-screen? vehicles))

      ;; Randomly respawn vehicles based on level difficulty
      (let ((challenge (- (/ 200 level-difficulty) 9)))
	(when (= 0 (random challenge))
	  (let* ((inactive-vehicles (filter vehicle-inactive? vehicles))
		 (spawnable-vehicles (filter vehicle-has-spawn-space? inactive-vehicles)))
	    (if (not (null? spawnable-vehicles))
		(set-vehicle-active! (list-ref
				      spawnable-vehicles
				      (random (length spawnable-vehicles)))
				     #t)))))
      ;; End (unless game-over)
      ))

(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" (round (* (vehicle-speed player-car) 0.11187)))
	     (vec2 400.0 20.0)
	     #:font the-font
	     #:scale (vec2 2 2))

  (draw-text (format #f "Level: ~s" level-difficulty)
	     (vec2 30.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))))
   ((eq? key 'd)
    (set! player-current-acceleration player-car-acceleration))
   ((eq? key 'a)
    (set! player-current-acceleration player-car-deceleration))
   ((eq? key 'escape)
       (abort-game))
   ((and (eq? key 'return) game-over)
    (set-vehicle-position! player-car initial-player-position)
    (set-player-speed! (level-min-speed))
    (set! player-rotation 0)
    (source-play engine-sound)
    (for-each vehicle-reset-ahead vehicles)
    ;; Reset all vehicles
    (set! game-over #f))))

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