Commit a0c70179 authored by Dave Cooper's avatar Dave Cooper

updating training slides

parent 4a0478ef
......@@ -76,8 +76,13 @@
(or (ignore-errors (the target-object line-thickness)) 1)))
#+nil
(local-display-controls (gethash (the target-object) (the display-controls-hash)))
(local-display-controls
(or (gethash (the target-object) (the display-controls-hash))
(when (typep (the parent) 'newertree) (the parent local-display-controls))))
(kids-error (when (typep (the safe-children) 'error) (the safe-children)))
(safe-children (append (if *trap-errors?*
......
......@@ -339,7 +339,7 @@
#+allegro excl:*source-pathname*
#+lispworks dspec:*source-pathname*
#+sbcl (error "need source-pathname in sbcl~%")
#+ccl (error "need source-pathname in ccl~%")
#+ccl ccl:*loading-file-source-file*
#+clisp (error "need source-pathname in ccl~%")
#+abcl (extensions:source-pathname)
)
......
......@@ -187,6 +187,8 @@ If you are interested in this effort we would love to hear from you at open-sour
#:list-hash
#:list-of-numbers
#:lookup-color
#:load-quicklisp
#:*quicklisp-home*
#:make-canonical-part
#:make-keyword
#:ensure-keyword
......@@ -277,7 +279,9 @@ If you are interested in this effort we would love to hear from you at open-sour
#:xml-reader
#:^2
#:room-report
#:*onclick-function*))
#:*onclick-function*
#:*already-loaded-systems*
#:*packages-to-lock*))
#-(or allegro lispworks sbcl ccl abcl ecl clisp) (error "Need package for mop:validate-superclass for currently running lisp.~%")
......
......@@ -24,7 +24,8 @@
;;(defparameter *gendl-version* "1585p002")
;;(defparameter *gendl-version* "1587devo")
;;(defparameter *gendl-version* "1587p003")
(defparameter *gendl-version* "1587p004")
;;(defparameter *gendl-version* "1587p004")
(defparameter *gendl-version* "1587p005")
;;(defparameter *gendl-version* "ql-2013-12")
(defparameter *gendl-patch-level* nil)
......@@ -206,3 +207,9 @@ values are a color indicator for the default foreground and background of graphi
(defparameter *sort-children?* nil
"Boolean. Determine whether to sort child objects in lexigraphical
order. Defaults to nil, which is the behavior previous to gdl1585.")
(defparameter *already-loaded-systems* nil)
(defparameter *packages-to-lock* (list :gendl :geom-base :cl-lite :gwl :gwl-graphics
:tasty :robot :tree :yadd :surf :smlib :genworks-gdl))
(defvar *quicklisp-home* nil)
......@@ -66,15 +66,49 @@
(when (and homedir-init? homedir-init-file) (load homedir-init-file)))))
(defun quicklisp-copyright-string ()
(let ((ql-libs
(safe-sort
(set-difference *already-loaded-systems*
(append (list "asdf" "crypt" "quicklisp" "base" "ent" "validate" "glisp"
"monofasl" "pro" "enterprise")
*packages-to-lock*)
:key #'string :test #'string-equal) #'string-lessp))
(ql-version (with-open-file (in (or (probe-file
(merge-pathnames "quicklisp/dists/quicklisp/distinfo.txt"
glisp:*gdl-home*))
(probe-file
(merge-pathnames "quicklisp/dists/quicklisp/distinfo.txt"
glisp:*genworks-source-home*))))
(read-line in)
(string-trim (list #\space) (second (glisp:split-regexp ":" (read-line in)))))))
(format nil "Also contains the following Common Lisp libraries
from Quicklisp version ~a, whose source files are available in the
Quicklisp repository at http://quicklisp.org, Copyright© their
respective authors:
~{~a~^, ~}.~%"
ql-version
ql-libs)))
(defun startup-banner ()
(format t
"
"
Gendl® Free Edition, version ~a
Within ~a ~a
Copyright© 2002-2013, Genworks International, Birmingham MI, USA.
All Rights Reserved.
~a
Welcome to Gendl®
Copyright© 2002-2013, Genworks® International, Birmingham MI, USA.
Copyright© 2014, Genworks® International, Birmingham MI, USA.
All Rights Reserved.
This program 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
......@@ -89,7 +123,11 @@ You should have received a copy of the GNU Affero General Public
License along with the source code for this program. If not, see:
http://www.gnu.org/licenses/
"))
"
gendl:*gendl-version*
(lisp-implementation-type)
(lisp-implementation-version)
(quicklisp-copyright-string)
))
This diff is collapsed.
......@@ -24,12 +24,13 @@
(defun initialize ()
(declare (ignore edition))
(setq glisp:*gdl-program-home* (probe-file (glisp:executable-homedir-pathname)))
(setq glisp:*gdl-home* (make-pathname :name nil
:type nil
:directory (butlast (pathname-directory glisp:*gdl-program-home*))
:defaults glisp:*gdl-program-home*))
(setq glisp:*gendl-home* glisp:*gdl-home*)
(setq *quicklisp-home* (merge-pathnames "quicklisp/" glisp:*gendl-home*))
(pushnew (make-keyword (format nil "gendl-~a" *gendl-version*)) *features*)
(glisp:set-genworks-source-home-if-known)
(glisp:set-default-float-format)
......
......@@ -37,6 +37,7 @@
(introduction :type 'introduction)
(objects :type 'objects)
(geometry :type 'geometry)
(tower-example :type 'tower-example)
(user-interface :type 'user-interface)
(outside-world :type 'outside-world)
(debugging :type 'debugging)
......
......@@ -212,7 +212,7 @@ tab in tasty)")))
#+nil
(:title
"Curves, Surfaces, and Solids"
:bullet-points
......@@ -231,6 +231,7 @@ means the curve (surface) is controlled by a list (grid) of 3D control-points.")
(:description "Sometimes the control-points are combined with the weights
and written as 4D points.")))
#+nil
(:title
"Curve data structure in Gendl"
:bullet-points
......@@ -246,6 +247,7 @@ polynomial curve function)</li>
parameter values, affect the shape of the curve)</li>
</ol>")))
#+nil
(:title
"<span class=gdl-object-def style=\"font-size: 1em;\">b-spline-curve</span>"
:bullet-points
......@@ -259,6 +261,7 @@ parameter values, affect the shape of the curve)</li>
and knot vector, this is a Cubic Bezier curve and interpolates (i.e. touches)
its end points.")))
#+nil
(:title
"Probing the curve object"
:bullet-points
......@@ -289,7 +292,7 @@ its end points.")))
(:code (the curve (radius-of-curvature 0.5))
:return-value 3.375)))))
#+nil
(:title
"<i>Exercise</i> 6"
:bullet-points
......@@ -307,7 +310,7 @@ points and with each of the specified degree values?
increasing degree?
</ol>")))
#+nil
(:title
"Surface data structure in Gendl"
:bullet-points
......@@ -326,6 +329,7 @@ parameter values in u direction, affect the shape of the surface in u direction<
parameter values in v direction, affect the shape of the surface in v direction</li>
</ol>")))
#+nil
(:title
"<span class=gdl-object-def>b-spline-surface</span>"
:bullet-points
......@@ -339,7 +343,8 @@ of surface data directly"
(:description "Note that with default degree (3) and default weights
and knot vector, this is a Cubic Bezier surface and interpolates (i.e. touches)
its control points at its corners.")))
#+nil
(:title
"Probing the surface object"
:bullet-points
......@@ -369,6 +374,7 @@ its control points at its corners.")))
(:code (the surface v-degree)
:return-value 3)))))
#+nil
(:title
"Probing the surface object (cont'd)"
:bullet-points
......@@ -389,6 +395,7 @@ its control points at its corners.")))
(:code (the surface u-iso-curves first)
:return-value "#<curve @ #x74d5050a>")))))
#+nil
(:title
"<i>Exercise</i> 7"
:bullet-points
......@@ -404,7 +411,8 @@ points and with each of the specified <span class=gdl-message-name>u-degree</spa
<li>Ask each child for its <span class=gdl-message-name>area</span>.
<li>Does the area increase or decrease with an increasing
<span class=gdl-message-name>u-degree</span>?</ol>")))
#+nil
(:title
"Transforming Curves and Surfaces"
......@@ -424,6 +432,7 @@ and dimensions directly from global control points")
:projection-direction :top
)))))
#+nil
(:title
"<i>Exercise</i> 8"
:bullet-points
......@@ -440,7 +449,7 @@ by a factor of 2 in the X, Y, and Z axes, respectively. </li>
<span class=gdl-message-name>total-length</span>?</li>
</ol>
")))
#+nil
(:title
"Solids and Booleans"
......@@ -452,7 +461,8 @@ by a factor of 2 in the X, Y, and Z axes, respectively. </li>
(:description "A <i>brep</i> can have zero or more shells and one or more regions")
(:description "There is always the <i>infinite</i>
region (all of space outside the brep).")))
#+nil
(:title
"Boolean operations"
:bullet-points
......@@ -478,7 +488,7 @@ get one or more breps out")
:include-sample-drawing? t
)))))
#+nil
(:title
"Non-manifold Breps"
:bullet-points
......@@ -506,6 +516,7 @@ faces into a solid, and get rid of extra pieces of faces, in one operation."
(:code (setq *brep-isos-default* (list :n-u 8 :n-v 8))
:return-value (:n-u 8 :n-v 8))))))
#+nil
(:title
"<i>Exercise 9</i>"
......
......@@ -256,7 +256,6 @@
(when (and (the define-object) (the have-sample-drawing?))
(let* ((image-name (format nil "~(~a~).png" (the define-object)))
(output-file (merge-pathnames image-name (the images-path)))
#+nil
(temp-file (merge-pathnames (string-append image-name "-t")
(the images-path))))
......
......@@ -199,21 +199,9 @@
(defvar gdl-startup-string
(format
"(progn (unless (find-package :gendl)
(let ((load-file (or (probe-file (merge-pathnames \".load-gendl.lisp\" (user-homedir-pathname)))
(probe-file \"c:/users/dcooper8/.load-gendl.lisp\"))))
(let ((load-file (probe-file (merge-pathnames \".load-gendl.lisp\" (user-homedir-pathname)))))
(load load-file)))
(funcall (symbol-function (read-from-string \"uiop:setup-temporary-directory\")))
(when (and (find-package :gendl) (find-package :swank))
(load (compile-file \"%semacs/glime.lisp\"
:output-file
(merge-pathnames
(make-pathname :name \"glime\"
:type (symbol-value
(read-from-string \"glisp:*fasl-extension*\")))
(funcall (symbol-function (read-from-string \"glisp:temporary-folder\")))))))
(when (find-package :gendl) (funcall (symbol-function (read-from-string \"gendl::startup-banner\"))))
(let ((gendl-loaded? (find-package :gendl)) (genworks-gdl-loaded? (find-package :genworks-gdl)))
(cond (genworks-gdl-loaded? (funcall (symbol-function (read-from-string \"gdl:start-gdl!\"))))
......
......@@ -140,16 +140,20 @@
(material-properties
()
(cl-who:with-html-output (*stream* nil :indent nil)
(:|Material| :|diffuseColor| (write-the (rgb-color (if (getf (the display-controls) :color)
(getf (the display-controls) :color)
:black)))
:|ambientIntensity| (getf (the display-controls) :ambient-intensity)
:|emissiveColor| (write-the (rgb-color (getf (the display-controls) :emissive-color)))
:|shininess| (getf (the display-controls) :shininess)
:|specularColor| (write-the (rgb-color (getf (the display-controls) :specular-color)))
:|transparency| (getf (the display-controls) :transparency)
)))
(let* ((display-controls (find-in-hash self *display-controls*))
(color (getf display-controls :color))
(color (or color (getf (the display-controls) :color) :black)))
(print-variables display-controls color)
(cl-who:with-html-output (*stream* nil :indent nil)
(:|Material| :|diffuseColor| (write-the (rgb-color color))
:|ambientIntensity| (getf (the display-controls) :ambient-intensity)
:|emissiveColor| (write-the (rgb-color (getf (the display-controls) :emissive-color)))
:|shininess| (getf (the display-controls) :shininess)
:|specularColor| (write-the (rgb-color (getf (the display-controls) :specular-color)))
:|transparency| (getf (the display-controls) :transparency)
))))
(appearance
()
......
......@@ -62,12 +62,11 @@
((rgb-stroke-setting
()
(let* ((display-controls (find-in-hash self *display-controls*))
(color-decimal (getf display-controls :color-decimal))
(color-decimal (or color-decimal (coerce (or (the color-decimal)
(format-slot foreground-color)
(lookup-color (the color-decimal))) 'list)))
(color (or (getf display-controls :color)
(getf (the display-controls) :color)
:black))
(color-decimal (coerce (lookup-color (or color (format-slot foreground-color))) 'list))
(fill-color-decimal (coerce (lookup-color (getf (the display-controls) :fill-color)) 'list)))
(apply #'pdf:set-rgb-stroke color-decimal)
(apply #'pdf:set-rgb-fill (or fill-color-decimal color-decimal))))
......
......@@ -25,7 +25,7 @@
#+allegro excl:*fasl-default-type*
#+lispworks compiler:*fasl-extension-string*
#+sbcl sb-fasl:*fasl-file-type*
#+ccl (namestring ccl:*.fasl-pathname*)
#+ccl (pathname-type ccl:*.fasl-pathname*)
#+abcl "abcl"
#+clisp "fas"
#-(or allegro lispworks sbcl ccl abcl clisp) (error "Need fasl extension string for the currently running lisp.~%"))
......
......@@ -384,31 +384,31 @@ to call the :write-embedded-x3d-world function."))
(:big (:b "No Graphics Object Specified")))))))
(t
(with-cl-who ()
(:p
((:span :style "cursor: pointer;")
((:|X3D| :id "the_element"
:swfpath "/static/3rdpty/x3dom/x3dom.swf"
;;:width "100%"
;;:height "100%"
:width (the view-object page-width)
:height (the view-object page-length)
)
(:|Scene|
(with-format (x3d *stream*)
(let ((*onclick-function* (the onclick-function)))
(write-the view-object cad-output)))))))
(let ((*display-controls* (the display-controls-hash)))
(with-cl-who ()
(:p
((:span :style "cursor: pointer;")
((:|X3D| :id "the_element"
:swfpath "/static/3rdpty/x3dom/x3dom.swf"
;;:width "100%"
;;:height "100%"
:width (the view-object page-width)
:height (the view-object page-length)
)
(:|Scene|
(with-format (x3d *stream*)
(let ((*onclick-function* (the onclick-function)))
(write-the view-object cad-output)))))))
((:script :type "text/javascript")
"x3dom.reload();")
((:script :type "text/javascript")
"x3dom.reload();")
#+nil
(when (the x3dom-view-controls?)
(htm (:tr (:td ((:span :style "color: blue; cursor: pointer;"
:onclick "document.getElementById('the_element').runtime.showAll();")
"Show All")))))))
#+nil
(when (the x3dom-view-controls?)
(htm (:tr (:td ((:span :style "color: blue; cursor: pointer;"
:onclick "document.getElementById('the_element').runtime.showAll();")
"Show All"))))))))
......
......@@ -546,7 +546,8 @@ Defaults to nil. Use number-form-control to get a default of t."
(define-object number-form-control (text-form-control)
:input-slots ((min nil) (max nil) (step nil))
:input-slots ((min nil) (max nil) (step nil)
(domain :number))
:computed-slots ((number? t)))
......
o Get rid of tables
o Need submit-on-enter
o Fix arguments between publish and publish-shared
o Add natural way to have a child or descendant be the page which
answers the published URL.
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