floss/stoe
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add some simple objects to be rendered

Browse source 
A cube and a triangle
Make use of the input system to move the camera.
This commit is contained in:
Renaud Casenave-Péré 2014-11-10 16:52:35 +09:00
parent f51bb6d4cf
commit 6b2c2df3bf
3 changed files with 108 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

65
data/cube.lisp Normal file
View file

@ -0,0 +1,65 @@
(:name "cube"
:streams ((:program simple-shader
:vertex-buffer ((position :float 3
#(0.5 0.5 0.5
0.5 -0.5 0.5
-0.5 -0.5 0.5
-0.5 0.5 0.5
0.5 0.5 0.5
-0.5 0.5 0.5
-0.5 0.5 -0.5
0.5 0.5 -0.5
0.5 0.5 0.5
0.5 0.5 -0.5
0.5 -0.5 -0.5
0.5 -0.5 0.5
0.5 0.5 -0.5
-0.5 0.5 -0.5
-0.5 -0.5 -0.5
0.5 -0.5 -0.5
0.5 -0.5 0.5
0.5 -0.5 -0.5
-0.5 -0.5 -0.5
-0.5 -0.5 0.5
-0.5 0.5 0.5
-0.5 -0.5 0.5
-0.5 -0.5 -0.5
-0.5 0.5 -0.5))
(color :float 4
#(0.0 1.0 0.0 1.0
0.0 1.0 0.0 1.0
0.0 1.0 0.0 1.0
0.0 1.0 0.0 1.0
0.0 0.0 1.0 1.0
0.0 0.0 1.0 1.0
0.0 0.0 1.0 1.0
0.0 0.0 1.0 1.0
1.0 0.0 0.0 1.0
1.0 0.0 0.0 1.0
1.0 0.0 0.0 1.0
1.0 0.0 0.0 1.0
1.0 1.0 0.0 1.0
1.0 1.0 0.0 1.0
1.0 1.0 0.0 1.0
1.0 1.0 0.0 1.0
0.0 1.0 1.0 1.0
0.0 1.0 1.0 1.0
0.0 1.0 1.0 1.0
0.0 1.0 1.0 1.0
1.0 0.0 1.0 1.0
1.0 0.0 1.0 1.0
1.0 0.0 1.0 1.0
1.0 0.0 1.0 1.0)))
:index-buffer (:unsigned-short :triangles
#(0 1 2
2 3 0
4 5 6
6 7 4
8 9 10
10 11 8
12 13 14
14 15 12
16 17 18
18 19 16
20 21 22
22 23 20)))))

12
data/triangle.lisp Normal file
View file

@ -0,0 +1,12 @@
(:name "triangle"
:streams ((:program simple-shader
:vertex-buffer ((position :float 3
#(0.25 0.25 0.0
0.25 -0.25 0.0
-0.25 -0.25 0.0))
(color :float 4
#(0.0 0.0 1.0 1.0
0.0 1.0 0.0 1.0
1.0 0.0 0.0 1.0)))
:index-buffer (:unsigned-short :triangles
#(0 1 2)))))

33
src/stoe.lisp
View file

@ -6,7 +6,7 @@
(in-package :cl-user)
(defpackage stoe
(:use :cl
:utils)
:utils :input)
(:export :main :quit))
(in-package :stoe)
@ -28,9 +28,38 @@ continue unless `unprotected' is t."
"Quit the main loop."
(setf exit-main-loop t)))
(global-set-key :escape #'quit)
(let (freelook-mode
start-orient
(start-coords '(0.0 . 0.0)))
(defun set-freelook (enable)
(setf freelook-mode enable)
(setf start-orient (go:direction (game:get-current-camera))))
(defun freelook-move (x y)
(if freelook-mode
(let ((dx (- (car start-coords) x))
(dy (- (cdr start-coords) y)))
(setf (go:direction (game:get-current-camera)) (q:* (q:from-axis-and-angle (v:vec 0 1 0) (maths:deg-to-rad dx))
start-orient
(q:from-axis-and-angle (v:vec 1 0 0) (maths:deg-to-rad dy)))))
(setf start-coords (cons x y)))))
(global-set-key 3 #'set-freelook t)
(global-set-key (3 :release) #'set-freelook nil)
(global-set-motion #'freelook-move :x :y)
(defun game-start ()
(let ((f (file:load-file #P"../data/cube.lisp" :sync t :type 'character)))
(go:attach (go:make-object :mesh (with-input-from-string (s f)
(mesh:make-mesh (read s)))) (game:get-world-origin))))
(defun main (&optional argv)
"Run the program."
(modules:initialize argv)
(unwind-protect
(main-loop)
(progn
(game-start)
(main-loop))
(modules:finalize)))