Commit 359c10a8 authored by Dave Cooper's avatar Dave Cooper
Browse files

fixed orientation issue with x3d lens - connected with quaternion-to-rotation.

parent 4189a30f
;;
;; Copyright 2002, 2009 Genworks International and Genworks BV
;; Copyright 2002, 2009 Genworks International
;;
;; This source file is part of the General-purpose Declarative
;; Language project (GDL).
......
......@@ -138,8 +138,8 @@
(transform
()
(let* (;;(rotation (quaternion-to-rotation (matrix-to-quaternion (the orientation*))))
(rotation (matrix-to-rotation (the orientation*)))
(let* ((rotation (quaternion-to-rotation (matrix-to-quaternion (the orientation*))))
;;(rotation (matrix-to-rotation (the orientation*)))
(x (get-x (the center)))
(y (get-y (the center)))
(z (get-z (the center))))
......@@ -172,8 +172,8 @@
(let ((orientation (the orientation*)))
(let (;;(rotation (quaternion-to-rotation (matrix-to-quaternion orientation)))
(rotation (matrix-to-rotation orientation))
(let ((rotation (quaternion-to-rotation (matrix-to-quaternion orientation)))
;;(rotation (matrix-to-rotation orientation))
(x (get-x (the center)))
(y (get-y (the center)))
(z (get-z (the center)))
......@@ -223,8 +223,8 @@
(let ((center (if from-root? (the center) (the local-center*)))
(orientation (if from-root? (the orientation*) (the local-orientation*))))
(let (;;(rotation (quaternion-to-rotation (matrix-to-quaternion orientation)))
(rotation (matrix-to-rotation orientation))
(let ((rotation (quaternion-to-rotation (matrix-to-quaternion orientation)))
;;(rotation (matrix-to-rotation orientation))
(x (get-x center)) (y (get-y center)) (z (get-z center)))
......
......@@ -92,6 +92,11 @@ your code would be responsible for wrapping the :div tag with :id (the dom-id).]
inner-html (progn (the view-toggle) (with-cl-who-string ()
(let ((*html-stream* *stream*))
(write-the inner-html)))))
(main-view (progn (the view-toggle) (with-cl-who-string ()
(let ((*html-stream* *stream*))
(write-the main-view)))))
("String of valid Javascript. This Javascript will be send with the Ajax response,
......@@ -413,12 +418,24 @@ running the Javascript interpreter to evaluate (the js-to-eval), if any.
(define-lens (html-format skeleton-ui-element)()
:output-functions
(
(inner-html
()
(with-cl-who ()
(fmt "~a Has no inner-html defined." (the strings-for-display))))
(str (the main-view))))
(main-view
()
(with-cl-who ()
(fmt "~a Has no main-view defined." (the strings-for-display))))
#+nil
(inner-html
()
(with-cl-who ()
(fmt "~a Has no inner-html defined." (the strings-for-display))))
(main-div
()
......
;;
;; Copyright 2012 Genworks International
;;
;; This source file is part of the General-purpose Declarative
;; Language project (GDL).
;;
;; This source file contains free software: you can redistribute it
;; and/or modify it under the terms of the GNU Affero General Public
;; License as published by the Free Software Foundation, either
;; version 3 of the License, or (at your option) any later version.
;;
;; This source file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public
;; License along with this source file. If not, see
;; <http://www.gnu.org/licenses/>.
;;
(in-package :gdl-lift-tests)
(define-object orientations (base-object)
:input-slots ((max-depth 2) (depth 0) (length 5) (width 15) (height 2)
(display-controls (list :color :grey :transparency 0.7)))
:objects
((left-box :type (if (> (the depth) (the max-depth)) 'null-part 'orientations )
:display-controls (list :line-thickness 2 :color :red :transparency 0.5)
:max-depth (the max-depth)
:depth (1+ (the depth))
:center (translate (the center) :left (- (half (the width)) (half (the-child width))))
:length (half (the length)) :width (half (the width)) :height (half (the height))
:orientation (alignment :rear (rotate-vector-d (the (face-normal-vector :rear))
45
(the (face-normal-vector :right)))
:right
(the (face-normal-vector :right))
#+nil
(rotate-vector-d (the (face-normal-vector :right))
20
(the (face-normal-vector :top)))))
(right-box :type (if (> (the depth) (the max-depth)) 'null-part 'orientations)
:display-controls (list :color :green :transparency 0.5)
:max-depth (the max-depth)
:depth (1+ (the depth))
:center (translate (the center) :right (- (half (the width)) (half (the-child width))))
:length (half (the length)) :width (half (the width)) :height (half (the height))
:orientation (alignment :rear (rotate-vector-d (the (face-normal-vector :rear))
45
(the (face-normal-vector :right)))
:right
(the (face-normal-vector :right))
#+nil
(rotate-vector-d (the (face-normal-vector :left))
20
(the (face-normal-vector :bottom)))))
(axis :type 'axes )
(box :type 'box)
))
(define-object axes (base-object)
:input-slots
((length 10 :defaulting)
(width 10 :defaulting)
(height 10 :defaulting))
:objects
((x-line :type 'c-cylinder
:radius 0.1
:start (the center)
:end (translate (the-child start) :right (the width))
:display-controls (list :color :red))
(y-line :type 'c-cylinder
:radius 0.1
:start (the center)
:end (translate (the-child start) :rear (the length))
:display-controls (list :color :green))
(z-line :type 'c-cylinder
:radius 0.1
:start (the center)
:end (translate (the-child start) :top (the height))
:display-controls (list :color :blue))))
......@@ -51,25 +51,14 @@ Default is t (one IndexedFaceSet for each brep).")
(let ((3d-points
(mapcar
#'(lambda(point)
(the (global-to-local
(the (global-to-local*
(make-point (if (the left-handed?)
(- (get-x point)) (get-x point))
(get-y point) (get-z point)))))
3d-points))
(normals normals)
#+nil
(normals
(when *include-vrml-normals?*
(mapcar
#'(lambda(point)
(the (global-to-local
(make-point (if (the left-handed?)
(- (get-x point)) (get-x point))
(get-y point) (get-z point)))))
normals))))
(normals normals))
(format *stream* "
Shape
{geometry IndexedFaceSet {
......
......@@ -49,8 +49,17 @@
(formatted-vertices (format nil "~{~a -1 ~}"
(surf::make-triplet-strings vertex-list)))
(3d-points (mapcar #'(lambda (coord)
(the (global-to-local* coord)))
(the (global-to-local*
(make-point (if (the left-handed?)
(- (get-x coord)) (get-x coord))
(get-y coord) (get-z coord))))
;;(the (global-to-local* coord))
;;(the (global-to-local coord))
)
3d-point-list)))
(cl-who:with-html-output (*stream* nil :indent nil)
(:Shape
(:Appearance (progn (if (getf (the display-controls) :pixel-texture)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment