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 200)

(define music-play? #t)
(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 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 (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 (off-road-player-top)
  (set! player-rotation 1)
  (set-vehicle-position! player-car (vec2+ (vehicle-position player-car) (vec2 0 30)))
  (set-vehicle-speed! player-car 0))
(define (off-road-player-bottom)
  (set! player-rotation -1)
  (set-vehicle-position! player-car (vec2+ (vehicle-position player-car) (vec2 0 -10)))
  (set-vehicle-speed! player-car 0))

(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)))


;;;; 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) (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)
		    (if (vehicle-active? veh)
			(let ((speed-diff (vehicle-speed-diff player-car 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 level-difficulty))
			(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 (vehicle-sprite player-car) (vehicle-position player-car) #: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" (* (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 (* vehicle-steering-speed -1))))
   ((eq? key 'a)
       (set-vehicle-speed! player-car (max (- (vehicle-speed player-car) 1) player-min-speed)))
   ((eq? key 'd)
       (set-vehicle-speed! player-car (min (+ (vehicle-speed player-car) 1) player-max-speed)))
   ((eq? key 'escape)
       (abort-game))
   ((and (eq? key 'return) game-over)
    (set-vehicle-position! player-car initial-player-position)
    (set-vehicle-speed! player-car (+ 1 player-min-speed))
    (set! player-rotation 0)
    ;; 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))))