[src=bash]
(defpackage lunar
(:use :trivial-gamekit)
(:export #:start))
;; Load gamekit (for developing only)
;; (ql:quickload :trivial-gamekit)
(defun get-time-stamp ()
(/ (get-internal-real-time)
internal-time-units-per-second))
;; state type of the game
(defstruct state x-v y-v y-a x-pos y-pos angle up? rotate-left? rotate-right? fuel)
;; initial state value
(defparameter initial-state (make-state :x-v 0 :y-v 0 :y-a 0 :x-pos 350 :y-pos 500
:angle 0 :up? nil :rotate-left? nil :rotate-right? nil
:fuel 1000))
;; globals
(defparameter *s* initial-state)
(defparameter *pause* nil)
(defparameter *status*

lay)
(defparameter *canvas-width* 800)
(defparameter *canvas-height* 600)
(defparameter *a* 0.2)
(defparameter *thrust-a* -0.5)
(defparameter *lander-width* 40)
(defparameter *lander-height* 40)
;; landing zone, consists of a start and end x-pos
(defstruct landing-zone start end)
(defun random-landing-zone (width)
(let* ((half (/ width 2))
(middle (+ half (random (- *canvas-width* width)))))
(make-landing-zone :start (- middle half)
:end (+ middle half))))
(defparameter *landing-zone* (random-landing-zone 70))
(gamekit:defgame lunar-lander () ()
(:viewport-width *canvas-width*)
(:viewport-height *canvas-height*)
(:viewport-title "Lunar Lander"))
(gamekit:define-image :lander "lander.png")
(defun initialize ()
(setf *pause* t)
(setf *status*

lay)
(setf *s* initial-state)
(setf *landing-zone* (random-landing-zone 70)))
;; functions to determine new values
(defun new-x-pos (x-pos v)
(cond
((> x-pos (+ 40 *canvas-width*)) -40)
((< x-pos -40) (+ 40 *canvas-width*))
(t (+ x-pos v))))
(defun new-v (a old-v)
(+ old-v (* 0.04 a)))
(defun new-y-a (s)
(if (state-up? s)
(+ *a* *thrust-a*)
*a*))
(defun new-y-pos (y-pos v)
(- y-pos v))
(defun new-y-v (a angle old-v)
(+ old-v (* (cos angle) 0.04 a)))
(defun new-x-v (a angle old-v)
(+ old-v (* (sin angle) 0.04 a)))
(defun new-angle (s)
(let* ((old (state-angle s))
(right? (state-rotate-right? s))
(left? (state-rotate-left? s)))
(cond
((and left? right?) old)
((and right? (> old -1.4))
(- old 0.04))
((and left? (< old 1.4))
(+ old 0.04))
(t old))))
(defun lander-left-pos (x-pos)
(- x-pos (/ *lander-width* 2)))
(defun lander-right-pos (x-pos)
(+ x-pos (/ *lander-width* 2)))
;; win condition helping functions
(defun lander-on-landing-zone? (x-pos landing-zone)
(let ((left (lander-left-pos x-pos))
(right (lander-right-pos x-pos)))
(and (> left (landing-zone-start landing-zone))
(< right (landing-zone-end landing-zone)))))
(defun won? (y-v angle)
(and (lander-on-landing-zone? (state-x-pos *s*) *landing-zone*)
(< y-v 0.4)
(< angle 0.08)))
(defun on-ground? (y-pos)
(< y-pos 10))
;; gets invoked on every time tick
(defun update-state ()
(cond
((< (state-fuel *s*) 0)
(setf *status* :lose))
;; win condition
((and (on-ground? (state-y-pos *s*))
(won? (state-y-v *s*) (state-angle *s*)))
(setf *status* :win))
;; lose condition
((on-ground? (state-y-pos *s*))
(setf *status* :lose))
;; Not on ground and enough fuel
(t
(setf *s* (make-state :x-v (new-x-v (if (state-up? *s*)
*thrust-a* 0)
(state-angle *s*)
(state-x-v *s*))
:y-v (new-y-v (state-y-a *s*)
(state-angle *s*)
(state-y-v *s*))
:y-a (new-y-a *s*)
:x-pos (new-x-pos (state-x-pos *s*) (state-x-v *s*))
:y-pos (new-y-pos (state-y-pos *s*) (state-y-v *s*))
:up? (state-up? *s*)
:rotate-left? (state-rotate-left? *s*)
:rotate-right? (state-rotate-right? *s*)
:angle (new-angle *s*)
:fuel (if (state-up? *s*)
(- (state-fuel *s*) 1)
(state-fuel *s*)))))))
(defun key-bindings ()
(gamekit:bind-button

ressed
(lambda () nil))
(gamekit:bind-button

:released
(lambda () (setf *pause* (not *pause*))))
(gamekit:bind-button :up

ressed
(lambda () (setf (state-up? *s*) t)))
(gamekit:bind-button :up :released
(lambda () (setf (state-up? *s*) nil)))
(gamekit:bind-button :left

ressed
(lambda () (setf (state-rotate-left? *s*) t)))
(gamekit:bind-button :left :released
(lambda () (setf (state-rotate-left? *s*) nil)))
(gamekit:bind-button :right

ressed
(lambda () (setf (state-rotate-right? *s*) t)))
(gamekit:bind-button :right :released
(lambda () (setf (state-rotate-right? *s*) nil)))
(gamekit:bind-button :r

ressed
(lambda ()
(initialize))))
(defun draw-img (img x-pos y-pos width height scaling rot-deg)
(gamekit:with-pushed-canvas ()
(gamekit:translate-canvas x-pos y-pos)
(gamekit:rotate-canvas rot-deg)
(gamekit:scale-canvas scaling scaling)
(gamekit:draw-image (gamekit:vec2 (/ width -2) (/ height -2)) img)))
(defun draw-landing-zone (landing-zone)
(gamekit:draw-line (gamekit:vec2 (landing-zone-start landing-zone)
0)
(gamekit:vec2 (landing-zone-end landing-zone)
0)
(gamekit:vec4 1 1 1 1)
:thickness 3))
(defun draw-header ()
(gamekit:draw-text "Lunar Lander" (gamekit:vec2 300 570) :fill-color (gamekit:vec4 1 1 1 1)))
(defun draw-stats ()
(gamekit:with-pushed-canvas ()
(gamekit:scale-canvas 0.75 0.75)
(gamekit:draw-text (format nil "State: ~a" *status*) (gamekit:vec2 0 700)
:fill-color (gamekit:vec4 1 1 1 1))
(gamekit:draw-text (format nil "Pause: ~a" *pause*) (gamekit:vec2 0 670)
:fill-color (gamekit:vec4 1 1 1 1))
(gamekit:draw-text (format nil "Angle: ~2,2@F" (state-angle *s*)) (gamekit:vec2 0 640)
:fill-color (gamekit:vec4 1 1 1 1))
(gamekit:draw-text (format nil "y-velocity: ~2,2@F" (* 10 (floor (* (state-y-v *s*) 10)))) (gamekit:vec2 0 610)
:fill-color (gamekit:vec4 1 1 1 1))
(gamekit:draw-text (format nil "FUEL: ~a" (state-fuel *s*)) (gamekit:vec2 0 580)
:fill-color (gamekit:vec4 1 1 1 11))))
(defmethod gamekit:draw ((this lunar-lander))
(gamekit:draw-rect (gamekit:vec2 0 0) (- *canvas-width* 1) (- *canvas-height* 1)
:fill-paint (gamekit:vec4 0 0 0 1)
:stroke-paint (gamekit:vec4 0 0 0 1))
(draw-img :lander (state-x-pos *s*) (state-y-pos *s*) *lander-width* *lander-height* 0.5 (state-angle *s*))
(draw-landing-zone *landing-zone*)
(draw-header)
(draw-stats))
;; tick function
(defmethod gamekit:act ((this lunar-lander))
(if *pause*
nil
(update-state)))
(defun start ()
(gamekit:start 'lunar-lander :autoscaled nil)
(key-bindings))
(start)
[/src]