Commit 46bc6c63 authored by Dave Cooper's avatar Dave Cooper
Browse files

added wire-world demo and cleaned up SBCL compile warnings

parent d506336b
......@@ -33,7 +33,7 @@
(let ((all (all-inputs-single sym)))
(when (consp all) all)))
symbol))))
(t (error "symbol is ~s which doesn't compute.~%"))))
(t (error "symbol is ~s which doesn't compute.~%" symbol))))
(defun all-inputs-single (symbol)
......
......@@ -267,9 +267,8 @@ children as returned by (the-object node children).\")"
((functionp get-children)
(funcall get-children node))
(t (error
(format nil
"
Get-Children arg of ~s Not Handled by traverse-tree"))))))))
"
Get-Children arg of ~s Not Handled by traverse-tree" node)))))))
(defun hash-table-copy (ht)
......@@ -649,7 +648,7 @@ toplevel inputs as specified in the snapshot file.
(not (eql (class-of (find-class (first root-form))) (find-class 'gdl-class)))
;;(not (find :%gdl-messages% (symbol-plist (first root-form))))
)
(error "Invalid object type specifier as first element of second form in ~a.~%"))
(error "Invalid object type specifier as first element of second form in ~a.~%" root-form))
(let ((object (cond ((and object keep-bashed-values?) object)
(object (the-object object restore-tree!) object)
......
......@@ -21,7 +21,7 @@
(in-package :com.genworks.lisp)
(eval-when (:compile-toplevel :load-toplevel :execute)
(glisp:without-package-variance-warnings
(defpackage :com.genworks.lisp
(:use :common-lisp)
(:nicknames :glisp)
......
......@@ -21,6 +21,7 @@
(in-package :gdl-user)
(gdl:define-package :geom-base
(:export #:angular-dimension #:sample-drawing #:generate-sample-drawing #:center-line #:*break-leaders?*
#:print-document))
(glisp:without-package-variance-warnings
(gdl:define-package :geom-base
(:export #:angular-dimension #:sample-drawing #:generate-sample-drawing #:center-line #:*break-leaders?*
#:print-document)))
......@@ -107,7 +107,7 @@ supports a full range of output options such as page dimensions, view transforms
(let ((*stream* (if file?
(open ,stream-or-file :if-does-not-exist :create
:if-exists :supersede :direction :output
:element-type '(unsigned-byte 8)
;;:element-type '(unsigned-byte 8)
;;:external-format ,(or external-format :default)
)
,stream-or-file))
......
(in-package :com.genworks.lisp)
(eval-when (:compile-toplevel :load-toplevel :execute)
(glisp:without-package-variance-warnings
(defpackage :com.genworks.lisp
(:use :common-lisp)
(:nicknames :glisp)
......
......@@ -21,7 +21,8 @@
(in-package :geom-base)
(gdl:define-package :geom-base (:export #:general-note #:text-line))
(glisp:without-package-variance-warnings
(gdl:define-package :geom-base (:export #:general-note #:text-line)))
(defparameter *general-note-center-circ* nil)
......
......@@ -42,10 +42,6 @@ angles are measured anti-clockwise."
("Number. Distance from center to any point on the arc."
radius
("3D Point. Indicates in global coordinates where the center of the arc should be located.
Defaults to #(0.0 0.0 0.0)."
center (make-point 0.0 0.0 0.0))
(arc 2pi)
("Angle in radians. Start angle of the arc. Defaults to zero."
......@@ -119,6 +115,14 @@ Defaults to #(0.0 0.0 0.0)."
(the-object (lastcar beziers) (equi-spaced-points curve-chords)))))))
("3D Vector. Returns the tangent to the arc at the given point (which should be on the arc).
:arguments (point \"3D point. The point at which you want the tangent.\""
tangent
(point)
(let ((top (the (face-normal-vector :top)))
(radial (subtract-vectors point (the center))))
(cross-vectors top radial)))
("List of points. Returns a list of points equally spaced around the arc, including
the start and end point of the arc.
......
......@@ -181,8 +181,8 @@ Partial cylinders and hollow cylinders are supported."
(center-line (list (the (:end-arcs 0) :center) (the (:end-arcs 1) :center)))
(top-points (the (end-arcs 1) (equi-spaced-points (the number-of-sections))))
(bottom-points (the (end-arcs 0) (equi-spaced-points (the number-of-sections))))
(top-points (the (end-arcs 1) (equi-spaced-points (max (the number-of-sections) 12))))
(bottom-points (the (end-arcs 0) (equi-spaced-points (max (the number-of-sections) 12))))
(polygons-for-ifs (unless (the simple?)
;;
......
......@@ -21,7 +21,7 @@
(in-package :geom-base)
(define-object torus (arcoid-mixin base-object)
(define-object torus (ifs-output-mixin arcoid-mixin base-object)
:documentation (:description "A single-holed ``ring'' torus, also known as an ``anchor ring.''
This is basically a circular cylinder ``bent'' into a donut shape. Partial donuts (``elbows'') are supported.
......@@ -96,11 +96,12 @@ Partial ``bent'' cylinders are not currently supported."
(torus-arc-curves (let (result)
(dotimes (index (the :number-of-longitudinal-sections) result)
(let* ((reference-point (translate center :right major-radius))
(sample-point (translate-along-vector reference-point
(rotate-vector right-vector
(* index torus-arc-angle)
front-vector)
minor-radius))
(sample-point (translate-along-vector
reference-point
(rotate-vector right-vector
(* index torus-arc-angle)
front-vector)
minor-radius))
(center (inter-line-plane sample-point right-vector
center right-vector))
......@@ -136,8 +137,21 @@ Partial ``bent'' cylinders are not currently supported."
(width (twice (+ (the major-radius) (the minor-radius))))
(length (the width)) (height (twice (the minor-radius)))
(equi-points (the centerline-arc (equi-spaced-points (1+ (the number-of-transverse-sections)))))
)
(polygon-points (mapcar #'(lambda(circle)
(the-object circle (equi-spaced-points (max 12 (the number-of-longitudinal-sections)))))
(list-elements (the transverse-circles))))
(polygons-for-ifs (apply #'append
(mapcar #'(lambda(circle-points-1 circle-points-2)
(mapcar #'(lambda (p1 p2 p3 p4)
(list p1 p2 p4 p3))
circle-points-1
(rest circle-points-1)
circle-points-2
(rest circle-points-2)))
(the polygon-points) (rest (the polygon-points))))))
:hidden-objects
((inner-torus :type (if (the :inner-minor-radius) 'torus 'null-part)
......@@ -148,6 +162,14 @@ Partial ``bent'' cylinders are not currently supported."
:major-radius (- (the :major-radius)
(- (the :inner-minor-radius)
(the :minor-radius))))
(transverse-circles :type 'circle
:radius (the minor-radius)
:sequence (:size (length (the equi-points)))
:center (nth (the-child index) (the equi-points))
:orientation (alignment :top (the centerline-arc (tangent (the-child center)))))
(start-circle :type 'circle
:radius (the minor-radius))
......
(in-package :gdl-user)
(gdl:define-package :gwl
(:use :net.aserve :net.aserve.client :net.uri :net.html.generator :cl-who)
(:shadow #:define-package))
(glisp:without-package-variance-warnings
(gdl:define-package :gwl
(:use :net.aserve :net.aserve.client :net.uri :net.html.generator :cl-who)
(:shadow #:define-package)))
(in-package :com.genworks.lisp)
(eval-when (compile load eval)
(glisp:without-package-variance-warnings
(defpackage :com.genworks.lisp
(:use :common-lisp)
(:nicknames :glisp)
......
......@@ -48,23 +48,26 @@
----------------------------------*/
.ui-widget { font-family: 'Trebuchet MS',Verdana,Arial,sans-serif; font-size: 1.1em; }
.ui-widget input, .ui-widget select, .ui-widget textarea, .ui-widget button { font-family: 'Trebuchet MS',Verdana,Arial,sans-serif; font-size: 1em; }
.ui-widget-content { border: 1px solid #777; background: #f9f9f9 url(images/ui-bg_flat_75_f9f9f9_40x100.png) 50% 50% repeat-x; color: #424242; }
.ui-widget-content a { color: #424242; }
.ui-widget-header { border: 1px solid #777; background: #b6b6b6 url(images/ui-bg_highlight-hard_75_b6b6b6_1x100.png) 50% 50% repeat-x; color: #424242; font-weight: bold; }
.ui-widget-header { border: 1px solid #777; background: #b6b6b6 url(images/ui-bg_highlight-hard_75_b6b6b6_1x100.png) 50% 50% repeat-x; color: #424242; font-weight: bold; }
.ui-widget-header a { color: #424242; }
/* Interaction states
----------------------------------*/
/* DJC */
.ui-state-default, .ui-widget-content .ui-state-default { border: 1px solid #777; background: #e6e6e6 url(images/ui-bg_highlight-hard_75_e6e6e6_1x100.png) 50% 50% repeat-x; font-weight: normal; color: #555555; outline: none; }
.ui-state-default a, .ui-state-default a:link, .ui-state-default a:visited { color: #555555; text-decoration: none; outline: none; }
.ui-state-hover, .ui-widget-content .ui-state-hover, .ui-state-focus, .ui-widget-content .ui-state-focus { border: 1px solid #bed73b; background: #bed73b url(images/ui-bg_highlight-hard_75_bed73b_1x100.png) 50% 50% repeat-x; font-weight: normal; color: #fff; outline: none; }
.ui-state-hover, .ui-widget-content .ui-state-hover, .ui-state-focus, .ui-widget-content .ui-state-focus { border: 1px solid #bed73b; background: #bed73b url(images/ui-bg_highlight-hard_75_bed73b_1x100.png) 50% 50% repeat-x; font-weight: normal; color: #fff; outline: none; }
.ui-state-hover a, .ui-state-hover a:hover { color: #fff; text-decoration: none; outline: none; }
.ui-state-active, .ui-widget-content .ui-state-active { border: 1px solid #bed73b; background: #bed73b url(images/ui-bg_highlight-hard_65_bed73b_1x100.png) 50% 50% repeat-x; font-weight: normal; color: #fff; outline: none; }
.ui-state-active, .ui-widget-content .ui-state-active { border: 1px solid #bed73b; background: #bed73b url(images/ui-bg_highlight-hard_65_bed73b_1x100.png) 50% 50% repeat-x; font-weight: normal; color: #fff; outline: none; }
.ui-state-active a, .ui-state-active a:link, .ui-state-active a:visited { color: #fff; outline: none; text-decoration: none; }
/* Interaction Cues
----------------------------------*/
.ui-state-highlight, .ui-widget-content .ui-state-highlight {border: 1px solid #bed73b; background: #e7f0b7 url(images/ui-bg_highlight-hard_55_e7f0b7_1x100.png) 50% top repeat-x; color: #424242; }
.ui-state-highlight, .ui-widget-content .ui-state-highlight {border: 1px solid #bed73b; background: #e7f0b7 url(images/ui-bg_highlight-hard_55_e7f0b7_1x100.png) 50% top repeat-x; color: #424242; }
.ui-state-highlight a, .ui-widget-content .ui-state-highlight a { color: #424242; }
.ui-state-error, .ui-widget-content .ui-state-error {border: 1px solid #cd0a0a; background: #fef1ec url(images/ui-bg_glass_95_fef1ec_1x400.png) 50% 50% repeat-x; color: #cd0a0a; }
.ui-state-error a, .ui-widget-content .ui-state-error a { color: #cd0a0a; }
......
(:gdl-base)
\ No newline at end of file
(in-package :cl-user)
(load (merge-pathnames
"quicklisp-local/cl-typesetting-20110219-svn/hyphenation-fp.lisp"
com.genworks.lisp:*genworks-source-home*))
#+nil
(let ((fasl
(compile-file
(merge-pathnames
......
......@@ -32,6 +32,9 @@
#+clisp :unix)
(unless (boundp '*compile-file-truename*)
(setq *compile-file-truename* nil))
(defvar *cl-typesetting-base-directory*
(make-pathname :name nil :type nil :version nil
:defaults #.(or #-gcl *compile-file-truename* *load-truename*))
......
(in-package :com.genworks.lisp)
(eval-when (compile load eval)
(glisp:without-package-variance-warnings
(defpackage :com.genworks.lisp
(:use :common-lisp)
(:nicknames :glisp)
......
......@@ -87,6 +87,7 @@
(:file "source/trimmed-surface")
(:file "source/utilities")
(:file "source/validated-solid")
(:file "source/cad-assembly")
(:file "source/vertex") (:file "source/views")
(:file "lenses/source/vrml")
(:file "lenses/source/x3d")))
\ No newline at end of file
......@@ -714,7 +714,8 @@ Default is t (one IndexedFaceSet for each brep).")
:output-functions
((shape
()
(with-error-handling (:timeout *brep-vrml-timeout*)
(with-error-handling (;;:timeout *brep-vrml-timeout*
)
(dolist (data (if *separate-brep-faces-for-vrml?*
(the triangle-data)
(list (the one-face-data))))
......
......@@ -345,7 +345,7 @@
(define-lens (vrml line)()
(define-lens (x3d line)()
:output-functions
((shape
()
......@@ -362,6 +362,46 @@
(get-y point)
(get-z point))) points)))))))))))
(define-lens (x3d arc)()
:output-functions
((shape
()
(dolist (bezier (list-elements (the beziers)))
(let* ((points (mapcar #'(lambda(point) (the (global-to-local point))) (the-object bezier (equi-spaced-points *curve-chords*))))
(indices (list-of-numbers 0 (1- (length points)))))
(cl-who:with-html-output (*stream* nil :indent nil)
((:Shape
(:Appearance (write-the material-properties)))
((:IndexedLineSet :coordIndex (format nil "~{~a ~}-1" indices))
((:Coordinate :point (format nil "~{~a~^ ~}"
(mapcar #'(lambda(point) (format nil "~a ~a ~a"
(get-x point)
(get-y point)
(get-z point))) points))))))))))))
;;
;; FLAG -- identical to curve
;;
(define-lens (x3d ellipse)()
:output-functions
((shape
()
(dolist (bezier (list-elements (the beziers)))
(let* ((points (mapcar #'(lambda(point) (the (global-to-local point))) (the-object bezier (equi-spaced-points *curve-chords*))))
(indices (list-of-numbers 0 (1- (length points)))))
(cl-who:with-html-output (*stream* nil :indent nil)
((:Shape
(:Appearance (write-the material-properties)))
((:IndexedLineSet :coordIndex (format nil "~{~a ~}-1" indices))
((:Coordinate :point (format nil "~{~a~^ ~}"
(mapcar #'(lambda(point) (format nil "~a ~a ~a"
(get-x point)
(get-y point)
(get-z point))) points))))))))))))
(define-lens (x3d cone)()
:output-functions
(
......@@ -411,7 +451,9 @@
(define-lens (x3d torus)()
:output-functions
((shape
(
#+nil
(shape
()
(let ((cross-section (mapcar #'(lambda(point)
(the (global-to-local point))) (the start-circle interpolated-points)))
......
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