Commit b091fadd authored by Dave Cooper's avatar Dave Cooper
Browse files

tagged for build 2012081900

parent ac3cf0f6
......@@ -24,6 +24,8 @@
:destination (format nil "~a" (merge-pathnames "downloads/" glisp:*gdl-home*)))
;;
;; Initialize SMLib here if available.
;;
......@@ -204,8 +204,7 @@ to the src/ directory distributed with GDL.
:objects
((base :type 'robot-base
:display-controls (append (merge-display-controls (list :color :blue-sky))
(list :billboard t))
:display-controls (merge-display-controls (list :color :blue-sky))
:height (* (the height) 0.4)
:width (* (the :width) 0.2)
:length (* (the :length) 0.2)
......
......@@ -34,6 +34,8 @@
((column-center :type 'sheet-section
:inner-html
(with-cl-who-string ()
(:p "Preview our upcoming " ((:a :href "http://www.genworks.com/newsite") (:i "New Site here")) ".")
((:p :id "genworks_title")
((:img :src "/site-static/images/icons/Genworks_title.gif" :alt "Genworks")))
(:p
......
......@@ -2,6 +2,6 @@
(defparameter *data-pathname*
(make-pathname :directory (append (butlast (pathname-directory excl:*source-pathname*))
(make-pathname :directory (append (butlast (pathname-directory (glisp:source-pathname)))
(list "data"))
:device (pathname-device excl:*source-pathname*)))
:device (pathname-device (glisp:source-pathname))))
;;
;; Copyright 2002-2011 Genworks International and Genworks BV
;; Copyright 20012 Genworks International
;;
;; This source file is part of the General-purpose Declarative
;; Language project (GDL).
......@@ -106,6 +106,8 @@
(set-format-slot view nil))))
(define-lens (raphael geom-base::view-object-cache)()
:output-functions
((lines-and-curves
......@@ -132,42 +134,48 @@
(*read-default-float-format* 'single-float))
(mapc
#'(lambda(line-index-pair)
(destructuring-bind (start-index end-index) line-index-pair
(let ((start (svref 2d-vertices start-index))
(end (svref 2d-vertices end-index))
(name (base64-encode-safe
(format nil "~s" (remove :root-object-object
(the-object object root-path))))))
(with-cl-who ()
(str
(format
nil
"var ~a_lines = paper.path('M ~a ~a L ~a ~a').attr({stroke: '~a'});~%"
(let (prev-end
(move? t))
(declare (ignore prev-end))
(mapc
#'(lambda(line-index-pair)
(destructuring-bind (start-index end-index) line-index-pair
(let ((start (svref 2d-vertices start-index))
(end (svref 2d-vertices end-index))
(name (base64-encode-safe
(format nil "~s" (remove :root-object-object
(the-object object root-path))))))
(when nil ;;(and prev-end (coincident-point? start prev-end))
(setq move? nil))
(setq prev-end end)
(with-cl-who ()
(str
(format
nil
"var ~a_lines = paper.path('~aL ~a ~a').attr({stroke: '~a'});~%"
name
name
(to-single-float (get-x start))
(to-single-float (get-y start))
(to-single-float (get-x end))
(to-single-float (get-y end))
(if move? (format nil "M ~a ~a "
(to-single-float (get-x start))
(to-single-float (get-y start)))
"")
(to-single-float (get-x end))
(to-single-float (get-y end))
(or (when (getf display-controls :color)
(lookup-color (getf display-controls :color) :format :hex))
(the-object object color-hex))))
(or (when (getf display-controls :color)
(lookup-color (getf display-controls :color) :format :hex))
(the-object object color-hex))))
(let ((stroke-width-string
(let* ((line-thickness (getf display-controls :line-thickness))
(line-thickness (or line-thickness (the object line-thickness)))
(line-thickness (if (zerop line-thickness) 1 line-thickness)))
(if line-thickness
(format nil "~a_lines.attr('stroke-width','~a');"
name (to-single-float line-thickness)) ""))))
(htm (str stroke-width-string)))))))
line-index-pairs)
(let ((stroke-width-string
(let* ((line-thickness (getf display-controls :line-thickness))
(line-thickness (or line-thickness (the object line-thickness)))
(line-thickness (if (zerop line-thickness) 1 line-thickness)))
(if line-thickness
(format nil "~a_lines.attr('stroke-width','~a');"
name (to-single-float line-thickness)) ""))))
(htm (str stroke-width-string)))))))
line-index-pairs))
(let (result)
(mapc #'(lambda(curve-index-quadruple)
......@@ -182,10 +190,8 @@
(setq result (nreverse result))
(when result
(let* ((name (base64-encode-safe
(format nil "~s" (remove :root-object-object
(the-object object root-path)))))
......@@ -198,22 +204,29 @@
(format nil "var ~a_curves = paper.path('~{~a~}').attr({stroke: '~a'});~%"
name
(let ((curve-strings
(mapcar
#'(lambda(curve)
(destructuring-bind (start c1 c2 end) curve
(format nil "M ~a ~a C ~a ~a ~a ~a ~a ~a "
(to-single-float (get-x start))
(to-single-float (get-y start))
(to-single-float (get-x c1) )
(to-single-float (get-y c1))
(to-single-float (get-x c2) )
(to-single-float (get-y c2))
(to-single-float (get-x end) )
(to-single-float (get-y end))
(let* (prev-end
(move? t)
(curve-strings
(mapcar
#'(lambda(curve)
(destructuring-bind (start c1 c2 end) curve
(when (and prev-end (coincident-point? start prev-end))
(setq move? nil))
(setq prev-end end)
(format nil "~aC ~a ~a ~a ~a ~a ~a "
(if move? (format nil "M ~a ~a "
(to-single-float (get-x start))
(to-single-float (get-y start)))
"")
(to-single-float (get-x c1) )
(to-single-float (get-y c1))
(to-single-float (get-x c2) )
(to-single-float (get-y c2))
(to-single-float (get-x end) )
(to-single-float (get-y end))
))) result)))
))) result)))
curve-strings)
(let ((color (or (when (getf display-controls :color)
(lookup-color (getf display-controls :color) :format :hex))
......@@ -235,16 +248,21 @@
(onmouseover-string
(format nil
" ~a_curves.node.onmouseover = function (){~a_curves.attr({'stroke-width': '~a'});};"
name name
(floor (to-single-float (* (or line-thickness 1) 3)))
))
nil
#+nil
(format nil
" ~a_curves.node.onmouseover = function (){~a_curves.attr({'stroke-width': '~a'});};"
name name
(floor (to-single-float (* (or line-thickness 1) 3)))
))
(onmouseout-string
(format nil " ~a_curves.node.onmouseout = function (){~a_curves.attr({'stroke-width': '~a'});};"
name name (to-single-float (or line-thickness 1))))
nil
#+nil
(format nil " ~a_curves.node.onmouseout = function (){~a_curves.attr({'stroke-width': '~a'});};"
name name (to-single-float (or line-thickness 1))))
(fill-string
(let ((color (or (when (getf display-controls :fill-color)
......@@ -268,8 +286,8 @@
;; of the object.
;;
(when onclick-string (str onclick-string))
(str onmouseover-string)
(str onmouseout-string)
(when onmouseover-string (str onmouseover-string))
(when onmouseout-string (str onmouseout-string))
(str fill-string)
(str stroke-width-string)
)))
......@@ -279,8 +297,6 @@
(define-lens (raphael text-line)()
:output-functions
......@@ -331,9 +347,54 @@
(define-lens (raphael global-polyline)()
:output-functions
((cad-output
()
(with-format-slots (view)
(let ((line-index-pairs (the %%line-vertex-indices%%))
(2d-vertices (map 'vector
(if view
#'(lambda(point)
(let ((p (add-vectors (let ((point (subseq (the-object view (view-point point)) 0 2)))
point)
geom-base:*raphael-translation*)))
(make-point (get-x p) (- (the-object view length) (get-y p)))
))
#'identity) (the %%vertex-array%%)))
(name (base64-encode-safe
(format nil "~s" (remove :root-object-object
(the root-path))))))
(with-cl-who ()
(let ((*read-default-float-format* 'single-float)
(start (aref 2d-vertices (first (first line-index-pairs)))))
(str
(format
nil
"var ~a_polyline = paper.path('M ~a ~a ~{~a~^ ~}').attr({stroke: '~a'});~%"
;; FLAG -- add fill-color
name
(to-single-float (get-x start))
(to-single-float (get-y start))
(mapcar #'(lambda(line-index-pair)
(destructuring-bind (start-index end-index) line-index-pair
(declare (ignore start-index))
(let ((end (svref 2d-vertices end-index)))
(format nil "L ~a ~a"
(to-single-float (get-x end))
(to-single-float (get-y end))))))
line-index-pairs)
(the color-hex))))))))))
;;
;; FLAG -- this is not working - sort it out.
;;
#+nil
(define-lens (raphael global-polyline)()
:output-functions
(
......
......@@ -11,3 +11,83 @@ o REMOVED :mysql client support -- this will be included only in
be installed.
Release Notes for Build Stamp 2012080200 w.r.t. previous 2012052101
===================================================================
o ADDED billboard support for x3d/x3dom. Use :billboard
:billboard-vector keyword in :display-controls.
o ADDED partial text-line support for x3d, added anchor support for
x3d and x3dom. Bind gdl:*onclick-function* dynamically around call
to (with-format (x3d ...)) to apply an onclick function to the
anchor.
o ADDED STEP assembly output with names and colors.
Produce assembly with
(with-format (step <path>.stp :assembly? t) (write-the ...))
Still missing: nested coordinate system transforms at
subassemblies.
o ADDED sections to documentation/training/g102-tud/
o ADDED ability to have gpl/ directory (with gnu-emacs and
ghostscript) as a sibling directory of Gendl application directory,
in addition to the old style of having it be within the Gendl
directory.
o ADDED M-x gendl as startup equivalent to M-x slime
o ADDED M-x quit-gendl as shutdown equivalent to M-x slime-quit-lisp
o ADDED ability to use .gdl or .gendl as file extension, instead of
.lisp. This will work with Slime-mode, cl-lite, and asdf/quicklisp.
o ADDED surf:spiral-curve primitive (documented).
o ADDED surf:non-rational-curve primitive (documented).
Note that the driver for this was the fact that it appears that
lofted-surface will not work properly with a mixture of rational
and non-rational profile curves, so this primitive provides a
workaround. We will be confirming that this is indeed a limitation
of lofted-surface.
o ADDED Allegro :mysql client module to this release. Requires
installation of OpenSSL libraries on windows.
o FIXED bug with nested orientations in x3d lens.
o FIXED weight issues with rational b-spline-curve, b-spline-surface,
boxed-curve, boxed-surface.
o FIXED x3d display of left-handed coordinate systems (equivalent to
patch-003 in 2012052101)
o FIXED base-ajax-sheet to respect the specified doc-type-string.
Known Bugs:
===========
approximated-curve is still not functional in the SMLib included with
this release. This should be resolved in the next release which has
an SMLib update.
Other Notes:
============
smlib::assembly-import is still available on experimental basis, not
documented. Accepts file-name as the main input-slot. Will
automatically choose the reader to use (step or iges) based on file
extension (.stp, .step, .igs, or .iges).
See the README.txt for important installation information.
Release Notes for Build Stamp 2012081900 w.r.t. previous 2012080300
===================================================================
o REMOVED :agraph built-in support -- want to be able to load the
Franz Lisp client for Agraph 4.2x.
o ADDED :pxml support.
o ADDED :mysql client support -- this will be included in TU Delft
releases. We are trying to figure out how to include optional
support for this module, i.e. not to have it pre-loaded but to have
it available. This might not be possible in Gendl Professional
editions; it might be that Pro editions are limited to the
additional Franz commercial modules which are built-in by Genworks
at build time.
Release Notes for Build Stamp 2012080300 w.r.t. previous 2012080200
===================================================================
o FIXED glisp:set-gs-path to look in level up for gpl/ directory as
well, since Slime etc. work with it there now.
o REMOVED :mysql client support -- this will be included only in
special releases. The normal release will not include it, to
simplify installation by avoiding the need for additional .dll's to
be installed.
Release Notes for Build Stamp 2012080200 w.r.t. previous 2012052101
===================================================================
o ADDED billboard support for x3d/x3dom. Use :billboard
:billboard-vector keyword in :display-controls.
o ADDED partial text-line support for x3d, added anchor support for
x3d and x3dom. Bind gdl:*onclick-function* dynamically around call
to (with-format (x3d ...)) to apply an onclick function to the
anchor.
o ADDED STEP assembly output with names and colors.
Produce assembly with
(with-format (step <path>.stp :assembly? t) (write-the ...))
Still missing: nested coordinate system transforms at
subassemblies.
o ADDED sections to documentation/training/g102-tud/
o ADDED ability to have gpl/ directory (with gnu-emacs and
ghostscript) as a sibling directory of Gendl application directory,
in addition to the old style of having it be within the Gendl
directory.
o ADDED M-x gendl as startup equivalent to M-x slime
o ADDED M-x quit-gendl as shutdown equivalent to M-x slime-quit-lisp
o ADDED ability to use .gdl or .gendl as file extension, instead of
.lisp. This will work with Slime-mode, cl-lite, and asdf/quicklisp.
o ADDED surf:spiral-curve primitive (documented).
o ADDED surf:non-rational-curve primitive (documented).
Note that the driver for this was the fact that it appears that
lofted-surface will not work properly with a mixture of rational
and non-rational profile curves, so this primitive provides a
workaround. We will be confirming that this is indeed a limitation
of lofted-surface.
o ADDED Allegro :mysql client module to this release. Requires
installation of OpenSSL libraries on windows.
o FIXED bug with nested orientations in x3d lens.
o FIXED weight issues with rational b-spline-curve, b-spline-surface,
boxed-curve, boxed-surface.
o FIXED x3d display of left-handed coordinate systems (equivalent to
patch-003 in 2012052101)
o FIXED base-ajax-sheet to respect the specified doc-type-string.
Known Bugs:
===========
approximated-curve is still not functional in the SMLib included with
this release. This should be resolved in the next release which has
an SMLib update.
Other Notes:
============
smlib::assembly-import is still available on experimental basis, not
documented. Accepts file-name as the main input-slot. Will
automatically choose the reader to use (step or iges) based on file
extension (.stp, .step, .igs, or .iges).
See the README.txt for important installation information.
......@@ -25,7 +25,7 @@
;;
;; FLAG -- remove this package definition and move all low-level stuff to smlib layer.
;;
(eval-when (:compile-toplevel :load-toplevel :execute) (defpackage :smlib))
(eval-when (:compile-toplevel :load-toplevel :execute) (defpackage :smlib (:use)))
(define-format nurbs (base-format)
......
......@@ -89,14 +89,17 @@ into a single curve."
;;
;; FLAG clean up use of nth
;;
:pseudo-inputs (pair)
:pair (nth (the-child index) (the straights))
:start (second (the-child pair))
:end (first (the-child pair)))))
(define-object global-filleted-polyline-curve (global-filleted-polyline-curves composed-curve)
(define-object global-filleted-polyline-curve
(global-filleted-polyline-curves composed-curve)
:documentation (:description "Provides a singular composed curve made from a global-filleted-polyline-curves object")
:documentation (:description "Provides a singular composed curve made
from a global-filleted-polyline-curves object")
:computed-slots
((curves (the ordered-curves))))
......
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