58 lines
2.1 KiB
Common Lisp
58 lines
2.1 KiB
Common Lisp
#|
|
|
This file is a part of stoe project.
|
|
Copyright (c) 2015 Renaud Casenave-Péré (renaud@casenave-pere.fr)
|
|
|#
|
|
|
|
(uiop:define-package :stoe-game
|
|
(:use :cl :stoe))
|
|
(in-package :stoe-game)
|
|
|
|
(defun load-cube ()
|
|
(with-lock-held ((scene-lock (get-world)))
|
|
(with-accessors ((scene world-scene) (camera world-camera) (scenes scenes)) (get-world)
|
|
(push (import-graphic-assets #P"data/cube.dae") scenes)
|
|
(setf scene (first scenes))
|
|
(setf camera (make-camera 90 (/ 16 9) 1.0 1000.0)))))
|
|
|
|
(defun load-tie ()
|
|
(with-lock-held ((scene-lock (get-world)))
|
|
(with-accessors ((scene world-scene) (camera world-camera) (scenes scenes)) (get-world)
|
|
(push (import-graphic-assets #P"data/TieFighter.dae") scenes)
|
|
(setf scene (first scenes))
|
|
(setf camera (make-camera 90 (/ 16 9) 1.0 1000.0)))))
|
|
|
|
(defun setup-input ()
|
|
(global-set-key :escape #'quit)
|
|
(global-set-key (:e :continuous) (lambda () (move (get-current-camera) :dz -0.1)))
|
|
(global-set-key (:j :continuous) (lambda () (move (get-current-camera) :dz 0.1)))
|
|
(global-set-key (:q :continuous) (lambda () (move (get-current-camera) :dx -0.1)))
|
|
(global-set-key (:k :continuous) (lambda () (move (get-current-camera) :dx 0.1)))
|
|
(global-set-key (:o :continuous) (lambda () (rotate (get-current-camera) :dz -2)))
|
|
(global-set-key (:u :continuous) (lambda () (rotate (get-current-camera) :dz 2)))
|
|
(let (freelook-mode)
|
|
(flet ((set-freelook (enable)
|
|
(setf freelook-mode enable))
|
|
(freelook-move (dx dy)
|
|
(when freelook-mode
|
|
(rotate (get-current-camera) :dx (- dx) :dy dy))))
|
|
(global-set-key 3 #'set-freelook t)
|
|
(global-set-key (3 :release) #'set-freelook nil)
|
|
(global-set-motion #'freelook-move :dx :dy))))
|
|
|
|
(defun initialize (&optional argv)
|
|
(declare (ignore argv))
|
|
(setup-input)
|
|
(world-initialize)
|
|
(load-cube))
|
|
|
|
(defun finalize ())
|
|
|
|
(defun update (delta-time)
|
|
(declare (ignore delta-time))
|
|
(unless (null (get-world))
|
|
(with-lock-held ((scene-lock (get-world)))
|
|
(when (get-current-camera)
|
|
(update-view (get-current-camera))))))
|
|
|
|
(defmodule stoe-game :game)
|
|
|