Permalink
Browse files

Fixed examples.

  • Loading branch information...
1 parent f983d13 commit 961ff2931a4f6acd89b4bad2ed5d6b01244ba4df @anwyn committed Nov 30, 2009
Showing with 95 additions and 74 deletions.
  1. +84 −70 examples/chicago.lisp
  2. +9 −2 examples/examples.lisp
  3. +2 −2 examples/knight.lisp
View
@@ -57,11 +57,11 @@
(char-res (h3d:add-resource :scene-graph "models/man/man.scene.xml"))
(char-walk-res (h3d:add-resource :animation "animations/man.anim")))
- (setf (hdr-pipeline app) deferred-pipeline)
-
;; Load resources
(h3d:load-resources-from-disk (namestring (content-path app)))
+ (setf (hdr-pipeline app) deferred-pipeline)
+
;; add camera
(setf (camera-node app)
(h3d:add-camera-node h3d:+root-node+ "Camera" deferred-pipeline))
@@ -100,16 +100,14 @@
(defmethod app-main-loop ((app chicago-application))
(unless (freeze? app)
- (let ((inv-fps (/ 1.0 (curr-fps app))))
- (incf (anim-time app) inv-fps)
- (update-crowd app)))
+ (update-crowd app))
;; Set camera parameters
- (with-accessors ((pos viewer-position)
- (rot viewer-orientation)
- (cam camera-node)
- (font font-resource)
- (panel panel-resource)) app
+ (with-accessors ((pos viewer-position)
+ (rot viewer-orientation)
+ (cam camera-node)
+ (font font-resource)
+ (panel panel-resource)) app
(h3d:set-node-transform cam (aref pos 0) (aref pos 1) (aref pos 2)
(aref rot 0) (aref rot 1) 0 1 1 1 )
@@ -118,7 +116,11 @@
(h3d:show-frame-statistics font panel (stat-mode app))
;; Display weight
- (h3d:show-text (format nil "Weight: ~a" (anim-weight app))
+ (h3d:show-text (format nil "Pipeline: ~a"
+ (if (eql (h3d:node-parameter cam :camera-pipeline-resource)
+ (fwd-pipeline app))
+ "forward"
+ "deferred"))
0.03 0.24 0.026 1 1 1 font 5))
;; Show logo
@@ -133,65 +135,77 @@
(defun update-crowd (app)
(let ((d1 0.25) (d2 2.0) (d3 4.5)
(f1 3.0) (f2 1.0) (f3 0.1))
- (loop for p across (particles app) do
- (with-accessors ((px px) (pz pz)
- (dx dx) (dz dz)
- (fx fx) (fz fz)
- (ox ox) (oz oz)) p
- ;; reset force
- (setf fx 0.0 fz 0.0)
- (let ((dist (sqrt (+ (* (- dx px) (- dx px))
- (* (- dz pz) (- dz pz))))))
- (cond
- ((> dist 3.0)
- ;; destination not reached, walk towards destination
- (incf fx (* 0.035 (/ (- dx px) dist)))
- (incf fz (* 0.035 (/ (- dz pz) dist)))
- (loop for p2 across (particles app)
- when (not (eq p p2)) do
- (let* ((dist2 (sqrt (+ (* (- px (px p2)) (- px (px p2)))
- (* (- pz (pz p2)) (- pz (pz p2))))))
- (strength (cond
- ((and (<= dist2 d3) (> dist2 d2))
- (let* ((m (/ (- f3 0) (- d2 d3)))
- (n (- 0 (* m d3))))
- (+ (* m dist2)) n))
- ((and (<= dist2 d2) (> dist2 d1))
- (let* ((m (/ (- f2 f3) (- d1 d2)))
- (n (- f3 (* m d2))))
- (+ (* m dist2)) n))
- ((<= dist2 d1)
- (let* ((m (/ (- f1 f2) (- 0 d1)))
- (n (- f2 (* m d1))))
- (+ (* m dist2)) n))
- (t
- 0.0))))
- (incf fx (* strength (/ (- px (px p2)) dist2)))
- (incf fz (* strength (/ (- pz (pz p2)) dist2))))))
- (t
- ;; near destination, choose a new one
- (choose-destination p)))
-
- ;; make force framerate independant
- (setf fx (* fx (/ 30.0 (curr-fps app)))
- fz (* fz (/ 30.0 (curr-fps app))))
-
- ;; set new position
- (incf px fx)
- (incf pz fz)
-
- ;; calculate orientation
- (setf ox (/ (+ ox fx) 2))
- (setf oz (/ (+ oz fz) 2))
-
- ;; update character position
- (let ((ry (degtorad (if (/= oz 0.0) (atan ox oz) 0.0))))
- (h3d:set-node-transform (node p) px 0.02 pz 0 ry 0 1 1 1))
-
- ;; update character animation
- (let ((vel (sqrt (+ (* fx fx) (* fz fz)))))
- (incf (anim-time p) (* vel 35.0))
- (h3d:set-model-animation-parameters (node p) 0 (anim-time p) 1.0)))))))
+ (declare (type single-float d1 d2 d3 f1 f2 f3)
+ (optimize (speed 3)))
+ (loop :for p :across (particles app) :do
+ (let ((px (px p)) (pz (pz p))
+ (dx (dx p)) (dz (dz p))
+ (ox (ox p)) (oz (oz p))
+ (fx 0.0) (fz 0.0))
+ (declare (type single-float px pz dx dz ox oz fx fz))
+ ;; reset force
+ (let ((dist (sqrt (+ (* (- dx px) (- dx px))
+ (* (- dz pz) (- dz pz))))))
+ (declare (type single-float dist))
+ (cond
+ ((> dist 3.0)
+ ;; destination not reached, walk towards destination
+ (incf fx (* 0.035 (/ (- dx px) dist)))
+ (incf fz (* 0.035 (/ (- dz pz) dist)))
+ (loop :for p2 :across (particles app)
+ :when (not (eq p p2)) :do
+ (let* ((p2x (px p2))
+ (p2z (pz p2))
+ (dist2 (sqrt (+ (* (- px p2x) (- px p2x))
+ (* (- pz p2z) (- pz p2z)))))
+ (strength (cond
+ ((and (<= dist2 d3) (> dist2 d2))
+ (let* ((m (/ (- f3 0) (- d2 d3)))
+ (n (- 0 (* m d3))))
+ (+ (* m dist2) n)))
+ ((and (<= dist2 d2) (> dist2 d1))
+ (let* ((m (/ (- f2 f3) (- d1 d2)))
+ (n (- f3 (* m d2))))
+ (+ (* m dist2) n)))
+ ((<= dist2 d1)
+ (let* ((m (/ (- f1 f2) (- 0 d1)))
+ (n (- f2 (* m d1))))
+ (+ (* m dist2) n)))
+ (t
+ 0.0))))
+ (declare (type single-float p2x p2z dist strength))
+ (incf fx (* strength (the single-float (/ (- px p2x) dist2))))
+ (incf fz (* strength (the single-float (/ (- pz p2z) dist2)))))))
+ (t
+ ;; near destination, choose a new one
+ (choose-destination p)))
+
+ ;; make force framerate independant
+ (setf fx (* fx (/ 30.0 (curr-fps app)))
+ fz (* fz (/ 30.0 (curr-fps app))))
+
+ ;; set new position
+ (incf px fx)
+ (incf pz fz)
+ (setf (px p) px)
+ (setf (pz p) pz)
+
+ ;; calculate orientation
+ (setf ox (the single-float (/ (+ ox fx) 2.0)))
+ (setf oz (the single-float (/ (+ oz fz) 2.0)))
+
+ ;; update character position
+ (let ((ry (radtodeg (if (/= oz 0.0) (atan ox oz) 0.0))))
+ (declare (type single-float ry))
+ (setf (ox p) ox)
+ (setf (oz p) oz)
+ (h3d:set-node-transform (node p) px 0.02 pz 0 ry 0 1 1 1))
+
+ ;; update character animation
+ (let ((vel (sqrt (+ (* fx fx) (* fz fz)))))
+ (declare (type single-float vel))
+ (incf (anim-time p) (* vel 35.0))
+ (h3d:set-model-animation-parameters (node p) 0 (anim-time p) 1.0)))))))
View
@@ -13,8 +13,8 @@
(in-package :horde3d-examples)
(defclass example-application ()
- ((viewer-position :accessor viewer-position :initarg :viewer-position :initform (make-array 3 :initial-element 0.0))
- (viewer-orientation :accessor viewer-orientation :initarg :viewer-orientation :initform (make-array 2 :initial-element 0.0))
+ ((viewer-position :accessor viewer-position :initarg :viewer-position :initform (make-array 3 :initial-element 0.0 :element-type '(or null single-float)))
+ (viewer-orientation :accessor viewer-orientation :initarg :viewer-orientation :initform (make-array 2 :initial-element 0.0 :element-type '(or null single-float)))
(velocity :accessor velocity :initform 10.0)
(keys :accessor keys :initform (make-hash-table))
(modifiers :accessor modifiers :initform nil)
@@ -129,6 +129,11 @@
(declare (type single-float angle))
(the single-float (* angle (/ pi 180.0))))
+(declaim (inline radtodeg))
+(defun radtodeg (angle)
+ (declare (type single-float angle))
+ (the single-float (* angle (/ 180.0 pi))))
+
(defun handle-movement (app)
(let ((curr-vel (/ (velocity app) (curr-fps app))))
(declare (type single-float curr-vel))
@@ -145,6 +150,7 @@
(when (or w s)
(let ((rx (degtorad (aref rot 0)))
(ry (degtorad (aref rot 1))))
+ (declare (type single-float rx ry))
(when w
(decf (aref pos 0) (coerce (* curr-vel (sin ry) (cos (- rx))) 'single-float))
(decf (aref pos 1) (coerce (* curr-vel (sin (- rx))) 'single-float))
@@ -159,6 +165,7 @@
(when (or a d)
(let ((ry-90 (degtorad (- (aref rot 1) 90.0f0)))
(ry+90 (degtorad (+ (aref rot 1) 90.0f0))))
+ (declare (type single-float ry-90 ry+90))
(when a
(incf (aref pos 0) (coerce (* curr-vel (sin ry-90)) 'single-float))
(incf (aref pos 2) (coerce (* curr-vel (cos ry-90)) 'single-float)))
View
@@ -25,8 +25,8 @@
:stat-mode 2
:anim-weight 0.0
:content-path #p"/home/ole/src/graphics//Horde3D_SDK_1.0.0_Beta4/Horde3D/Binaries/Content/")
- :width 1280
- :height 800
+ :width 800
+ :height 600
:caption "Knight - Horde3D Sample"))

0 comments on commit 961ff29

Please sign in to comment.