Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
gendl
gendl
Commits
b091fadd
Commit
b091fadd
authored
Aug 19, 2012
by
Dave Cooper
Browse files
tagged for build 2012081900
parent
ac3cf0f6
Changes
9
Hide whitespace changes
Inline
Side-by-side
demos/gdlinit.cl
View file @
b091fadd
...
...
@@ -24,6 +24,8 @@
:destination
(
format
nil
"~a"
(
merge-pathnames
"downloads/"
glisp:*gdl-home*
)))
;;
;; Initialize SMLib here if available.
;;
demos/robot/source/assembly.lisp
View file @
b091fadd
...
...
@@ -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
)
...
...
demos/site/source/index.lisp
View file @
b091fadd
...
...
@@ -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
...
...
demos/wind-demo-1/source/parameters.lisp
View file @
b091fadd
...
...
@@ -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
)
)))
gdl/gwl-graphics/raphael/source/lenses.lisp
View file @
b091fadd
;;
;; Copyright 200
2-201
1 Genworks International
and Genworks BV
;; Copyright 2001
2
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
(
...
...
release-notes/2012080300.txt
View file @
b091fadd
...
...
@@ -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/20120819.txt
0 → 100644
View file @
b091fadd
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.
surf/source/formats.lisp
View file @
b091fadd
...
...
@@ -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
)
...
...
surf/source/global-filleted-polyline-curves.lisp
View file @
b091fadd
...
...
@@ -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
))))
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment