Commit 6b96f860 authored by Dave Cooper's avatar Dave Cooper
Browse files

added wire-world

parent 268c8516
(in-package :wire-world)
(define-object assembly (base-object)
:objects
((hangar :type 'hangar
:orientation (alignment :top (the (face-normal-vector :rear)))
:center (translate (the center)
:right (half (the-child width))
:front (half (the-child height))))
(ground :type 'ground
:height 0 :length 50 :width (* +phi+ 50))
(tree :type 'tree
:center (translate (the center) :left 12 :front 12 :top (half (the-child length)))
:orientation (alignment :rear (the (face-normal-vector :top)))
:length 7
:radius-1 3 :radius-2 0)
(teepee :type 'teepee
:center (translate (the center) :right 4 :front 12 :top (half (the-child length)))
:orientation (alignment :rear (the (face-normal-vector :top)))
:length 3
:arc (* 3/2 pi)
:radius-1 2 :radius-2 0.5)
(silo :type 'silo
:radius 1
:arc (* 3/2 pi)
:length 5
:orientation (alignment :rear (the (face-normal-vector :top)))
:center (translate (the center) :right 4 :rear 12 :top (half (the-child length))))))
(define-object silo (cylinder)
:computed-slots ((display-controls (list :color :blue))))
(define-object teepee (cone)
:computed-slots ((display-controls (list :color :brown))))
(define-object tree (cone)
:computed-slots ((display-controls (list :color :green-forest))))
(define-object ground (box)
:computed-slots ((display-controls (list :color :green-lime :transparency 0.3))))
(define-object hangar (base-object)
:computed-slots ((display-controls (list :color :grey :transparency 0.7))
(width (- (apply #'max (mapcar #'get-x (the vertex-list-local)))
(apply #'min (mapcar #'get-x (the vertex-list-local)))))
(height (the shape projection-depth))
(length (- (apply #'max (mapcar #'get-y (the vertex-list-local)))
(apply #'min (mapcar #'get-y (the vertex-list-local)))))
(vertex-list-local (list (make-point 0 0 0)
(make-point 2 2 0)
(make-point 4 3 0)
(make-point 6 2 0)
(make-point 8 0 0)))
(vertex-list (mapcar #'(lambda(point)
(the (local-to-global point)))
(the vertex-list-local))))
:objects
((shape :type 'global-polygon-projection
:vertex-list (the vertex-list)
:projection-depth 10
:projection-vector (the (face-normal-vector :top)))))
(in-package :common-lisp-user)
(gdl:define-package :wire-world (:export #:assembly))
......@@ -23,7 +23,7 @@
(define-object part-type-form (base-html-sheet)
:input-slots
((object-type "gwl-user::tasty-test-part" :settable)
((object-type "robot:assembly" :settable)
make-instance-function set-root-function tatu-root package-default)
:computed-slots
......
......@@ -21,7 +21,7 @@
(in-package :geom-base)
(define-object cone (cylinder)
(define-object cone (cylinder ifs-output-mixin)
:documentation (:description "A pyramid with a circular cross section, with its vertex above
the center of its base. Partial cones and hollow cones are supported."
......@@ -56,7 +56,12 @@ the center of its base. Partial cones and hollow cones are supported."
:computed-slots
((width (twice (max (the radius-1) (the radius-2))))
(height (the width))))
(height (the width))
(polygons-for-ifs (when (or (the inner-radius)
(not (zerop (the radius-2)))
(not (near-to? (the arc) 2pi)))
(the %polygons-for-ifs%)))))
......@@ -149,24 +149,27 @@ each direction.</li>
(polygons-for-ifs)
:computed-slots
((ifs-vertex-ht (let ((ht (make-hash-table :test #'equalp))
(count -1))
(dolist (polygon (the polygons-for-ifs) ht)
(dolist (vertex polygon)
(let ((current (gethash vertex ht)))
(unless current
(setf (gethash vertex ht) (incf count))))))))
((ifs-vertex-ht (when (the polygons-for-ifs)
(let ((ht (make-hash-table :test #'equalp))
(count -1))
(dolist (polygon (the polygons-for-ifs) ht)
(dolist (vertex polygon)
(let ((current (gethash vertex ht)))
(unless current
(setf (gethash vertex ht) (incf count)))))))))
(ifs-array (let ((array (make-array (list (hash-table-count (the ifs-vertex-ht))))))
(maphash #'(lambda(vertex index)
(setf (aref array index) vertex))
(the ifs-vertex-ht)) array))
(ifs-array (when (the polygons-for-ifs)
(let ((array (make-array (list (hash-table-count (the ifs-vertex-ht))))))
(maphash #'(lambda(vertex index)
(setf (aref array index) vertex))
(the ifs-vertex-ht)) array)))
(ifs-indices (mapcar #'(lambda(polygon)
(mapcar #'(lambda(vertex)
(gethash vertex (the ifs-vertex-ht)))
polygon))
(the polygons-for-ifs)))))
(ifs-indices (when (the polygons-for-ifs)
(mapcar #'(lambda(polygon)
(mapcar #'(lambda(vertex)
(gethash vertex (the ifs-vertex-ht)))
polygon))
(the polygons-for-ifs))))))
......
......@@ -750,7 +750,8 @@ to call the :write-embedded-x3d-world function."))
(with-format (x3d *stream*) (write-the view-object cad-output))
))
((:script :type "text/javascript" :src "http://www.x3dom.org/x3dom/release/x3dom.js" :id "xdom_script"))
((:script :type "text/javascript"
:src "/static/3rdpty/x3dom/x3dom.js" :id "xdom_script"))
......
......@@ -9,41 +9,24 @@
:serial
t
:version
"2011121800"
"2012021100"
:depends-on
(:gdl-base
:gdl-cl-lite
:aserve
:cl-pdf
:cl-who
:cl-ppcre
:cl-base64
:trivial-backtrace)
(:gdl-base :gdl-cl-lite :aserve :cl-pdf :cl-who :cl-ppcre
:cl-base64 :trivial-backtrace)
:components
((:file "source/package")
(:file "source/genworks")
(:file "source/defparameters")
(:file "source/base-html-sheet")
(:file "source/base-html-utils")
(:file "source/macros")
((:file "source/package") (:file "source/genworks")
(:file "source/defparameters") (:file "source/base-html-sheet")
(:file "source/base-html-utils") (:file "source/macros")
(:file "source/ignore-errors-with-backtrace")
(:file "source/initialize")
(:file "source/utilities")
(:file "source/answer")
(:file "source/accessories")
(:file "source/gdl-remote")
(:file "source/vanilla-remote")
(:file "source/base64-utils")
(:file "source/cl-pdf-patches")
(:file "source/color-palette")
(:file "source/crawler")
(:file "source/log-utils")
(:file "source/new-urls")
(:file "source/publish")
(:file "source/remote-object")
(:file "source/initialize") (:file "source/utilities")
(:file "source/answer") (:file "source/accessories")
(:file "source/gdl-remote") (:file "source/vanilla-remote")
(:file "source/base64-utils") (:file "source/cl-pdf-patches")
(:file "source/color-palette") (:file "source/crawler")
(:file "source/log-utils") (:file "source/new-urls")
(:file "source/publish") (:file "source/remote-object")
(:file "source/security-check-failed")
(:file "ajax/source/parameters")
(:file "ajax/source/ajax")
(:file "ajax/source/parameters") (:file "ajax/source/ajax")
(:file "ajax/source/base-ajax-sheet")
(:file "ajax/source/skeleton-ui-element")
(:file "form-elements/source/grid-form-element")
......
......@@ -30,73 +30,9 @@
;;-------------------------------------------------
(define-object session-control-mixin ()
:documentation (:description "Mixin to the root object of the part which you wish to have session control over"
:author "Brian Sorg, Liberating Insight LLC (revised Dave Cooper, Genworks)")
:input-slots
(("Universal time after which the session should expire"
expires-at nil :settable)
("Length of time a session should last without activity in minutes"
session-duration 20)
("Boolean. Determines whether expired sessions are replaced by recovery object. Default is nil."
use-recovery-object? nil)
("Expiration time of the recovery object. After the recovery object has replaced the orginal
instance at what time should the recovery instance expire?"
recovery-expires-at (+ (get-universal-time) (* 60 (the session-duration))))
("Url to which a user will be redirected if requesting a session that has been cleared"
recovery-url *recovery-url-default*)
("Type of original object, useful when viewing session report log"
org-type (type-of self))
(;; For future use
%state-plist% '(0)))
:functions
(("This is the function called to check for and handle session control
:&key ((debug? nil) \"Boolean. Prints debug statement if needed\")"
clear-expired-session
(&key debug?)
(when debug?
(format t "Validating instance ~a~% of class ~a~% Current Universal Time: ~a.~% Expiration Time: ~a.~% Clear now? ~a.~%"
(the instance-id)
(class-of self)
(get-universal-time)
(the expires-at)
(the (clear-now?))))
(when (the clear-now?)
(the (session-clean-up))
(glisp:w-o-interrupts (clear-instance (the instance-id))
(when (and (the use-recovery-object?) (the recovery-expires-at))
(let ((recovery (make-object 'session-recovery
:instance-id (the instance-id)
:expires-at (the recovery-expires-at)
:recovery-url (the recovery-url)
:state-plist (the %state-plist%)
:org-type (the org-type))))
(setf (gethash (make-keyword (the instance-id)) *instance-hash-table*)
;;
;; FLAG -- that last entry is actually supposed to be the skin class.
;;
(list recovery (list 0) t)))))))
("Gets called right before the instance is going to get cleared. Is intended to be used to stop any instance states that may not be elequently handled by the garbage collector. ie database connections, multiprocessing locks, open streams etc."
session-clean-up
())
("Boolean. Test to run to see if this session has expired and needs to be cleared now."
clear-now?
() (when (the expires-at) (> (get-universal-time) (the expires-at))))
("Method which will set the expires-at slot to the current time + the session-duration"
set-expires-at
(&optional (duration (the session-duration)))
(the (set-slot! :expires-at (+ (get-universal-time) (* 60 duration)))))))
;;
;; Definition moved to answer.lisp.
;;
......
......@@ -29,7 +29,6 @@
;;-------------------------------------------------
(define-object session-recovery (session-control-mixin)
:input-slots
(instance-id ))
;;
;; definition moved to answer.lisp
;;
......@@ -24,6 +24,84 @@
(defparameter *f-e-p* nil)
(define-object session-control-mixin ()
:documentation (:description "Mixin to the root object of the part which you wish to have session control over"
:author "Brian Sorg, Liberating Insight LLC (revised Dave Cooper, Genworks)")
:input-slots
(("Universal time after which the session should expire"
expires-at nil :settable)
("Length of time a session should last without activity in minutes"
session-duration 20)
("Boolean. Determines whether expired sessions are replaced by recovery object. Default is nil."
use-recovery-object? nil)
("Expiration time of the recovery object. After the recovery object has replaced the orginal
instance at what time should the recovery instance expire?"
recovery-expires-at (+ (get-universal-time) (* 60 (the session-duration))))
("Url to which a user will be redirected if requesting a session that has been cleared"
recovery-url *recovery-url-default*)
("Type of original object, useful when viewing session report log"
org-type (type-of self))
(;; For future use
%state-plist% '(0)))
:functions
(("This is the function called to check for and handle session control
:&key ((debug? nil) \"Boolean. Prints debug statement if needed\")"
clear-expired-session
(&key debug?)
(when debug?
(format t "Validating instance ~a~% of class ~a~% Current Universal Time: ~a.~% Expiration Time: ~a.~% Clear now? ~a.~%"
(the instance-id)
(class-of self)
(get-universal-time)
(the expires-at)
(the (clear-now?))))
(when (the clear-now?)
(the (session-clean-up))
(glisp:w-o-interrupts (clear-instance (the instance-id))
(when (and (the use-recovery-object?) (the recovery-expires-at))
(let ((recovery (make-object 'session-recovery
:instance-id (the instance-id)
:expires-at (the recovery-expires-at)
:recovery-url (the recovery-url)
:state-plist (the %state-plist%)
:org-type (the org-type))))
(setf (gethash (make-keyword (the instance-id)) *instance-hash-table*)
;;
;; FLAG -- that last entry is actually supposed to be the skin class.
;;
(list recovery (list 0) t)))))))
("Gets called right before the instance is going to get cleared. Is intended to be used to stop any instance states that may not be elequently handled by the garbage collector. ie database connections, multiprocessing locks, open streams etc."
session-clean-up
())
("Boolean. Test to run to see if this session has expired and needs to be cleared now."
clear-now?
() (when (the expires-at) (> (get-universal-time) (the expires-at))))
("Method which will set the expires-at slot to the current time + the session-duration"
set-expires-at
(&optional (duration (the session-duration)))
(the (set-slot! :expires-at (+ (get-universal-time) (* 60 duration)))))))
(define-object session-recovery (session-control-mixin)
:input-slots
(instance-id ))
(defun answer (req ent)
(let ((query (request-query req)))
......
/*
* X3DOM JavaScript Library
* http://x3dom.org
*
* (C)2009 Fraunhofer Insitute for Computer
* Graphics Reseach, Darmstadt
* Dual licensed under the MIT and GPL.
*
* Based on code originally provided by
* Philip Taylor: http://philip.html5.org
*/
body {
background-color: white;
font-family: Helvetica, sans-serif;
font-size: 12px;
}
X3D, x3d {
position:relative; /* in order to be able to position stat-div within X3D */
float:left; /* float the element so it has the same size like the canvas */
cursor:pointer;
margin:0;
padding: 0;
border: 1px solid #000;
}
object {
margin: 0;
padding: 0;
border: none;
z-index: 0;
}
X3D:hover,
x3d:hover,
.x3dom-canvas:hover {
-webkit-user-select: none;
-webkit-touch-callout: none;
}
.x3dom-canvas {
border:none;
cursor:pointer;
width:100%;
height:100%;
float:left;
}
.x3dom-canvas:focus {
outline:none;
}
.x3dom-progress {
margin: 0;
padding: 6px 8px 0 26px;
left: 0px;
top: 0px;
position: absolute;
color: #0f0;
font-family: Helvetica, sans-serif;
line-height:10px;
font-size: 10px;
min-width: 45px;
min-height: 20px;
border: 0px;
background-position: 4px 4px;
background-repeat: no-repeat;
background-color: #333;
background-color: rgba(51, 51, 51, 0.9);
z-index: 100;
background-image: url('data:image/gif;base64,R0lGODlhEAAQAPQAADMzM////z4+Po+Pj0pKSsbGxpycnP///7e3t+Hh4XR0dGZmZu7u7oGBgfr6+tLS0qqqqgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH/C05FVFNDQVBFMi4wAwEAAAAh/hpDcmVhdGVkIHdpdGggYWpheGxvYWQuaW5mbwAh+QQJCgAAACwAAAAAEAAQAAAFdyAgAgIJIeWoAkRCCMdBkKtIHIngyMKsErPBYbADpkSCwhDmQCBethRB6Vj4kFCkQPG4IlWDgrNRIwnO4UKBXDufzQvDMaoSDBgFb886MiQadgNABAokfCwzBA8LCg0Egl8jAggGAA1kBIA1BAYzlyILczULC2UhACH5BAkKAAAALAAAAAAQABAAAAV2ICACAmlAZTmOREEIyUEQjLKKxPHADhEvqxlgcGgkGI1DYSVAIAWMx+lwSKkICJ0QsHi9RgKBwnVTiRQQgwF4I4UFDQQEwi6/3YSGWRRmjhEETAJfIgMFCnAKM0KDV4EEEAQLiF18TAYNXDaSe3x6mjidN1s3IQAh+QQJCgAAACwAAAAAEAAQAAAFeCAgAgLZDGU5jgRECEUiCI+yioSDwDJyLKsXoHFQxBSHAoAAFBhqtMJg8DgQBgfrEsJAEAg4YhZIEiwgKtHiMBgtpg3wbUZXGO7kOb1MUKRFMysCChAoggJCIg0GC2aNe4gqQldfL4l/Ag1AXySJgn5LcoE3QXI3IQAh+QQJCgAAACwAAAAAEAAQAAAFdiAgAgLZNGU5joQhCEjxIssqEo8bC9BRjy9Ag7GILQ4QEoE0gBAEBcOpcBA0DoxSK/e8LRIHn+i1cK0IyKdg0VAoljYIg+GgnRrwVS/8IAkICyosBIQpBAMoKy9dImxPhS+GKkFrkX+TigtLlIyKXUF+NjagNiEAIfkECQoAAAAsAAAAABAAEAAABWwgIAICaRhlOY4EIgjH8R7LKhKHGwsMvb4AAy3WODBIBBKCsYA9TjuhDNDKEVSERezQEL0WrhXucRUQGuik7bFlngzqVW9LMl9XWvLdjFaJtDFqZ1cEZUB0dUgvL3dgP4WJZn4jkomWNpSTIyEAIfkECQoAAAAsAAAAABAAEAAABX4gIAICuSxlOY6CIgiD8RrEKgqGOwxwUrMlAoSwIzAGpJpgoSDAGifDY5kopBYDlEpAQBwevxfBtRIUGi8xwWkDNBCIwmC9Vq0aiQQDQuK+VgQPDXV9hCJjBwcFYU5pLwwHXQcMKSmNLQcIAExlbH8JBwttaX0ABAcNbWVbKyEAIfkECQoAAAAsAAAAABAAEAAABXkgIAICSRBlOY7CIghN8zbEKsKoIjdFzZaEgUBHKChMJtRwcWpAWoWnifm6ESAMhO8lQK0EEAV3rFopIBCEcGwDKAqPh4HUrY4ICHH1dSoTFgcHUiZjBhAJB2AHDykpKAwHAwdzf19KkASIPl9cDgcnDkdtNwiMJCshACH5BAkKAAAALAAAAAAQABAAAAV3ICACAkkQZTmOAiosiyAoxCq+KPxCNVsSMRgBsiClWrLTSWFoIQZHl6pleBh6suxKMIhlvzbAwkBWfFWrBQTxNLq2RG2yhSUkDs2b63AYDAoJXAcFRwADeAkJDX0AQCsEfAQMDAIPBz0rCgcxky0JRWE1AmwpKyEAIfkECQoAAAAsAAAAABAAEAAABXkgIAICKZzkqJ4nQZxLqZKv4NqNLKK2/Q4Ek4lFXChsg5ypJjs1II3gEDUSRInEGYAw6B6zM4JhrDAtEosVkLUtHA7RHaHAGJQEjsODcEg0FBAFVgkQJQ1pAwcDDw8KcFtSInwJAowCCA6RIwqZAgkPNgVpWndjdyohACH5BAkKAAAALAAAAAAQABAAAAV5ICACAimc5KieLEuUKvm2xAKLqDCfC2GaO9eL0LABWTiBYmA06W6kHgvCqEJiAIJiu3gcvgUsscHUERm+kaCxyxa+zRPk0SgJEgfIvbAdIAQLCAYlCj4DBw0IBQsMCjIqBAcPAooCBg9pKgsJLwUFOhCZKyQDA3YqIQAh+QQJCgAAACwAAAAAEAAQAAAFdSAgAgIpnOSonmxbqiThCrJKEHFbo8JxDDOZYFFb+A41E4H4OhkOipXwBElYITDAckFEOBgMQ3arkMkUBdxIUGZpEb7kaQBRlASPg0FQQHAbEEMGDSVEAA1QBhAED1E0NgwFAooCDWljaQIQCE5qMHcNhCkjIQAh+QQJCgAAACwAAAAAEAAQAAAFeSAgAgIpnOSoLgxxvqgKLEcCC65KEAByKK8cSpA4DAiHQ/DkKhGKh4ZCtCyZGo6F6iYYPAqFgYy02xkSaLEMV34tELyRYNEsCQyHlvWkGCzsPgMCEAY7Cg04Uk48LAsDhRA8MVQPEF0GAgqYYwSRlycNcWskCkApIyEAOwAAAAAAAAAAAA==');
}
.x3dom-progress.bar span {
position: absolute;
left: 0;
top: 0;
line-height: 20px;
background-color: red;
}
.x3dom-statdiv {
margin: 0;
padding: 0;
right: 10px;
top: 10px;
position: absolute;
color: #0f0;
font-family: Helvetica, sans-serif;
line-height:10px;
font-size: 10px;
width: 75px;
height: 70px;
border: 0px;
}
.x3dom-touch-marker {
display:inline;
padding: 5px;
border-radius: 10px;
position: absolute;
font-family: Helvetica, sans-serif;
line-height:10px;
font-size: 10px;
border: 1px solid green;
z-index:100;
width:60px;
}
.x3dom-nox3d {
font-family: Helvetica, sans-serif;
font-size: 14px;
background-color: #eb7a7a;
padding: 1em;
opacity: 0.75;
}
.x3dom-nox3d p {
color: #fff;
font-size: 14px;
}
.x3dom-nox3d a {
color: #fff;
font-size: 14px;
}
/* self-clearing floats */
.group:after {
content: ".";
display: block;
height: 0;
clear: both;
visibility: hidden;
}
/*
* X3DOM JavaScript Library
* http://x3dom.org
*
* (C)2009 Fraunhofer Insitute for Computer
* Graphics Reseach, Darmstadt
* Dual licensed under the MIT and GPL.
*
* Based on code originally provided by
* Philip Taylor: http://philip.html5.org
*/
body {
background-color: white;
font-family: Helvetica, sans-serif;
font-size: 12px;
}
X3D, x3d {
position:relative; /* in order to be able to position stat-div within X3D */
float:left; /* float the element so it has the same size like the canvas */
cursor:pointer;
margin:0;
padding: 0;
border: 1px solid #000;
}
object {
margin: 0;
padding: 0;
border: none;
z-index: 0;
}
X3D:hover,
x3d:hover,
.x3dom-canvas:hover {
-webkit-user-select: none;
-webkit-touch-callout: none;
}
.x3dom-canvas {
border:none;
cursor:pointer;
width:100%;
height:100%;
float:left;
}
.x3dom-canvas:focus {
outline:none;
}
.x3dom-progress {
margin: 0;
padding: 6px 8px 0