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
b62ea2f2
Commit
b62ea2f2
authored
Apr 21, 2016
by
Dave Cooper
Browse files
Merge branch 'devo' of gitlab.common-lisp.net:gendl/gendl into devo
parents
0929cb3e
2ebddf1e
Changes
2
Hide whitespace changes
Inline
Side-by-side
patches/1590/merged.txt
View file @
b62ea2f2
...
@@ -69,4 +69,31 @@ default for merged-solid."
...
@@ -69,4 +69,31 @@ default for merged-solid."
"Cleaned up redundant and outdated jquery files."
"Cleaned up redundant and outdated jquery files."
"Added 3d-point and 3d-vector data types"
"Fixed outdated features in *features* list."
"Added query-slots to *allowed-define-object-toplevel-keywords"
"Added define-object-macro-toplevel facility"
"Added user-selectable continuation for existing destination directory in make-gdl-app"
"Added point-on-plane? and point-on-vector? functions"
"Added *bias-to-double-float?* parameter to determine whether half
and twice always return double-floats."
"Added args argument to not-handled error functions, so that wrappers
can be added which have access to the arguments passed to the
not-handled message."
"Applied Allegro CL patch to fix memory leak where repeated compiles
of same define-object would continually consume more heap."
)
)
surf/source/normally-projected-curve.lisp
0 → 100644
View file @
b62ea2f2
(
in-package
:surf
)
(
define-object
normally-projected-curve
(
curve
)
:input-slots
(
from-surface
curve
to-surface
(
number-of-points
200
))
:computed-slots
((
sample-points
(
the
curve
uv-curve
(
equi-spaced-points
(
the
number-of-points
))))
(
normals
(
mapcar
#'
(
lambda
(
point
)
(
the
from-surface
(
normal
(
get-u
point
)
(
get-v
point
))))
(
the
sample-points
)))
(
projected-points
(
mapcar
#'
(
lambda
(
point
normal
)
(
the
to-surface
(
projected-point
(
the
from-surface
(
point
(
get-u
point
)
(
get-v
point
)))
normal
)))
(
the
sample-points
)
(
the
normals
)))
(
projected-points-3d
(
mapcar
#'
get-3d-point-of
(
the
projected-points
)))
(
projected-points-uv
(
mapcar
#'
get-uv-point-of
(
the
projected-points
))))
:objects
((
fitted
:type
'fitted-curve
:points
(
the
projected-points-3d
))
(
fitted-uv
:type
'fitted-curve
:points
(
mapcar
#'
(
lambda
(
point
)
(
make-point
(
get-x
point
)
(
get-y
point
)
0
))
(
the
projected-points-uv
)))
(
approximated
:type
'approximated-curve
:curve-in
(
the
fitted-uv
)
:tolerance
0.00001
)
(
fitted-3d
:type
'b-spline-curve
:knot-vector
(
the
approximated
knot-vector
)
:degree
(
the
approximated
degree
)
:weights
(
the
approximated
weights
)
:control-points
(
mapcar
#'
(
lambda
(
point
)
(
the
to-surface
(
point
(
get-u
point
)
(
get-v
point
))))
(
the
approximated
control-points
)))))
#+
nil
(
define-object
normally-projected-curve-test
(
normally-projected-curve
)
:computed-slots
((
from-surface
(
the
test-fitted-surface
))
(
curve
(
the
projected
))
(
to-surface
(
the
offset-surface
)))
:objects
((
test-fitted-surface
:type
'test-fitted-surface
:grid-height
1
)
(
offset-surface
:type
'rectangular-surface
:length
5
:width
5
:center
(
make-point
2
2
1.5
))
(
projected
:type
'projected-curve
:curve-in
(
the
segment
)
:surface
(
the
test-fitted-surface
)
:projection-vector
(
the
(
face-normal-vector
:bottom
)))
(
segment
:type
'linear-curve
:start
(
make-point
1
1
3
)
:end
(
make-point
3
3
3
))))
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