Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
G
gendl
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
47
Issues
47
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
gendl
gendl
Commits
7075b337
Commit
7075b337
authored
Jun 17, 2016
by
Dave Cooper
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
added patches for 1590
parent
90f0231e
Changes
6
Hide whitespace changes
Inline
Side-by-side
Showing
6 changed files
with
254 additions
and
12 deletions
+254
-12
geom-base/wire/source/global-filleted-polyline.lisp
geom-base/wire/source/global-filleted-polyline.lisp
+14
-10
gwl-graphics/raphael/source/lenses.lisp
gwl-graphics/raphael/source/lenses.lisp
+1
-1
patches/1590/p006.lisp
patches/1590/p006.lisp
+118
-0
patches/1590/p007.lisp
patches/1590/p007.lisp
+45
-0
patches/1590/p008.lisp
patches/1590/p008.lisp
+75
-0
surf/source/blended-solid.lisp
surf/source/blended-solid.lisp
+1
-1
No files found.
geom-base/wire/source/global-filleted-polyline.lisp
View file @
7075b337
...
...
@@ -79,16 +79,20 @@ filleted-polyline."
(
%renderer-info%
(
list
:vrml?
t
:view-default
:top
))
(
path-info
(
let
((
first?
t
))
(
mapcan
#'
(
lambda
(
straight
curve-set
)
(
append
(
if
first?
(
progn
(
setq
first?
nil
)
(
list
:move
(
first
straight
)
:line
(
second
straight
)))
(
list
:line
(
second
straight
)))
(
apply
#'
append
(
mapcar
#'
(
lambda
(
curve
)
(
cons
:curve
(
rest
(
reverse
curve
))))
(
reverse
(
the-object
curve-set
%curves-to-draw%
))))))
(
the
straights
)
(
list-elements
(
the
fillets
)))))
(
path-info
(
append
(
let
((
first?
t
))
(
mapcan
#'
(
lambda
(
straight
curve-set
)
(
append
(
if
first?
(
progn
(
setq
first?
nil
)
(
list
:move
(
first
straight
)
:line
(
second
straight
)))
(
list
:line
(
second
straight
)))
(
apply
#'
append
(
mapcar
#'
(
lambda
(
curve
)
(
cons
:curve
(
rest
(
reverse
curve
))))
(
reverse
(
the-object
curve-set
%curves-to-draw%
))))))
(
the
straights
)
(
list-elements
(
the
fillets
))))
(
when
(
>
(
length
(
the
straights
))
(
the
fillets
number-of-elements
))
(
list
:line
(
second
(
lastcar
(
the
straights
)))))))
...
...
gwl-graphics/raphael/source/lenses.lisp
View file @
7075b337
...
...
@@ -311,7 +311,7 @@
(
number-round
(
get-y
end
)
4
)
)))
coords
)))))))
(
when
(
or
path-info
line-path-string
curve-path-string
)
(
who:with-html-output
(
*stream*
)
(
fmt
"var ~a;~%"
name
)
...
...
patches/1590/p006.lisp
0 → 100644
View file @
7075b337
;;
;; Copyright 2002-2011 Genworks International
;;
;; This source file is part of the General-purpose Declarative
;; Language project (GDL).
;;
;; This source file 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 License, or (at your option) any later version.
;;
;; This source file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public
;; License along with this source file. If not, see
;; <http://www.gnu.org/licenses/>.
;;
(
in-package
:surf
)
(
excl:without-package-locks
(
excl:without-redefinition-warnings
(
define-object
edge
(
curve
)
:documentation
(
:description
"Represents one edge in a brep. This object is a type of curve and answers all curve messages."
)
:input-slots
(
%native-edge%
%native-brep%
brep
)
:computed-slots
((
native-curve-iw
(
get-bspline-curve-from-edge
*geometry-kernel*
(
the
%native-edge%
)))
(
"List of GDL Face objects. The faces connected to this edge."
faces
(
let
((
faces-ht
(
the
brep
faces-ht
)))
(
mapcar
#'
(
lambda
(
native-face
)
(
gethash
native-face
faces-ht
))
(
the
%native-faces%
))))
(
%native-faces%
(
get-faces-from-edge
*geometry-kernel*
(
the
%native-edge%
)))
(
%unique-id%
(
get-long
*geometry-kernel*
self
)))
:functions
((
"GDL Curve object. This represents the UV curve for this edge on the given surface.
Note that you have to pass in the surface, which should be the basis-surface of a face connected
to this edge. The GDL edge object will be supplemented with a sequence of faces which are connected
with this edge."
uv-curve
(
surface
)
(
make-object
'curve
:native-curve-iw
(
get-uv-curve-from-edge
*geometry-kernel*
(
the
%native-edge%
)
(
the-object
surface
native-surface-iw
))))))
(
define-object-amendment
face
()
:computed-slots
((
brep-id
(
the
brep
%unique-id%
))))
(
define-object
geometry-kernel-object-mixin
()
:documentation
(
:description
"This mixin provides messages common to all NURBS-based objects whose underlying implementation
comes from a modular geometry kernel such as SMLib."
)
:input-slots
((
from-iges?
nil
))
:input-slots
(
(
"List of integers. The IGES-compatible levels (layers) on which this object resides. GDL does not currently support writing
out multiple levels (layers) through the IGES writer ; only the first of these will be output if the object is exported with
the IGES output-format (please contact Genworks if you need all levels (layers) to be written out)."
levels
(
get-levels
*geometry-kernel*
self
))
(
"Integer. The primary IGES-compatible level (layer) on which this object resides. Defaults to the first of the levels. This
slot can be overridden in user code to specify a new layer which will be written out when this object is exported with the IGES
output-format."
layer
(
first
(
the
levels
)))
(
"Integer. Synonym for the layer."
iges-level
(
the
layer
))
(
color-hex
(
lookup-color
(
the
color-decimal
)
:format
:hex
))
(
"Vector of three real numbers. The RGB color of this object as imported from an external format (e.g. IGES) or as specified in :display-controls.
Defaults to the foreground color specified in <tt>*colors-default*</tt>. This message should not normally be overridden in user application code."
color-decimal
(
let
((
color
(
when
(
the
from-iges?
)
(
get-color
*geometry-kernel*
self
))))
(
or
color
(
multiple-value-bind
(
result
found?
)
(
lookup-color
(
getf
(
the
display-controls
)
:color
))
(
when
found?
result
))))))
:computed-slots
((
%line-vertex-indices%
(
let
((
count
-1
))
(
mapcar
#'
(
lambda
(
line
)
(
declare
(
ignore
line
))
(
list
(
incf
count
)
(
incf
count
)))
(
the
%lines-to-draw%
))))
(
%vertex-array%
(
append
(
flatten-lines
(
the
%lines-to-draw%
))
(
flatten-curves
(
the
%curves-to-draw%
))))
(
%unique-id%
(
or
(
get-long
*geometry-kernel*
self
)
(
let
((
id
(
read-from-string
(
subseq
(
string
(
gensym
))
1
))))
(
format
t
"Setting object unique-id on-demand for object ~s.~%"
self
)
(
set-long
*geometry-kernel*
self
id
)
id
)))))))
patches/1590/p007.lisp
0 → 100644
View file @
7075b337
;;
;; Copyright 2002-2011 Genworks International
;;
;; This source file is part of the General-purpose Declarative
;; Language project (GDL).
;;
;; This source file 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 License, or (at your option) any later version.
;;
;; This source file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public
;; License along with this source file. If not, see
;; <http://www.gnu.org/licenses/>.
;;
(
in-package
:geom-base
)
(
#+
allegro
excl:without-package-locks
#-
allegro
progn
(
#+
allegro
excl:without-redefinition-warnings
#-
allegro
progn
(
define-object-amendment
global-filleted-polyline-mixin
()
:computed-slots
((
path-info
(
append
(
let
((
first?
t
))
(
mapcan
#'
(
lambda
(
straight
curve-set
)
(
append
(
if
first?
(
progn
(
setq
first?
nil
)
(
list
:move
(
first
straight
)
:line
(
second
straight
)))
(
list
:line
(
second
straight
)))
(
apply
#'
append
(
mapcar
#'
(
lambda
(
curve
)
(
cons
:curve
(
rest
(
reverse
curve
))))
(
reverse
(
the-object
curve-set
%curves-to-draw%
))))))
(
the
straights
)
(
list-elements
(
the
fillets
))))
(
when
(
>
(
length
(
the
straights
))
(
the
fillets
number-of-elements
))
(
list
:line
(
second
(
lastcar
(
the
straights
)))))))))))
patches/1590/p008.lisp
0 → 100644
View file @
7075b337
(
in-package
:geom-base
)
(
#+
allegro
excl:without-package-locks
#-
allegro
progn
(
#+
allegro
excl:without-redefinition-warnings
#-
allegro
progn
(
define-lens
(
pdf
view-object-cache
)()
:output-functions
((
pdf-command
(
mode
coords
)
(
ecase
mode
(
:move
(
let
((
coord
(
first
coords
)))
(
pdf:move-to
(
%get-x%
coord
)
(
%get-y%
coord
))))
(
:line
(
let
((
coord
(
first
coords
)))
(
pdf:line-to
(
%get-x%
coord
)
(
%get-y%
coord
))))
(
:curve
(
destructuring-bind
(
c1
c2
end
)
coords
(
pdf:bezier-to
(
%get-x%
c1
)
(
%get-y%
c1
)
(
%get-x%
c2
)
(
%get-y%
c2
)
(
%get-x%
end
)
(
%get-y%
end
))))))
(
lines-and-curves
()
(
when
(
typep
(
the
object
)
'gdl::gdl-basis
)
(
let
((
object
(
the
object
))
(
2d-vertices
(
the
vertex-array-2d-scaled
)))
(
let
((
line-index-pairs
(
the-object
object
%line-vertex-indices%
))
(
curve-index-quadruples
(
the-object
object
%curve-vertex-indices%
))
(
path-info
(
the
path-info-2d-scaled
)))
(
pdf:with-saved-state
(
write-the-object
object
line-thickness-setting
)
(
write-the-object
object
dash-pattern-setting
)
(
write-the-object
object
rgb-stroke-setting
)
(
if
path-info
(
let
(
mode
coords
)
(
dolist
(
item
path-info
)
(
if
(
keywordp
item
)
(
progn
(
print-variables
mode
coords
)
(
when
(
and
mode
coords
)
(
write-the
(
pdf-command
mode
(
nreverse
coords
))))
(
setq
mode
item
)
(
setq
coords
nil
))
(
push
item
coords
)))
(
write-the
(
pdf-command
mode
(
nreverse
coords
))))
(
progn
(
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
)))
(
pdf:move-to
(
%get-x%
start
)
(
%get-y%
start
))
(
pdf:line-to
(
%get-x%
end
)(
%get-y%
end
)))))
line-index-pairs
)
(
let
(
start
end
prev-end
)
(
mapc
#'
(
lambda
(
curve-index-quadruple
)
(
destructuring-bind
(
start-index
c1-index
c2-index
end-index
)
curve-index-quadruple
(
declare
(
ignorable
start-index
))
(
setq
prev-end
end
)
(
setq
start
(
svref
2d-vertices
start-index
)
end
(
svref
2d-vertices
end-index
))
(
let
((
c1
(
svref
2d-vertices
c1-index
))
(
c2
(
svref
2d-vertices
c2-index
)))
(
unless
(
and
start
prev-end
(
coincident-point?
start
prev-end
))
(
pdf:move-to
(
%get-x%
start
)
(
%get-y%
start
)))
(
pdf:bezier-to
(
%get-x%
c1
)
(
%get-y%
c1
)
(
%get-x%
c2
)
(
%get-y%
c2
)
(
%get-x%
end
)
(
%get-y%
end
)))))
curve-index-quadruples
))))
(
if
(
the-object
object
fill-color-decimal
)
(
pdf:fill-and-stroke
)
(
pdf:stroke
)))))))))))
surf/source/blended-solid.lisp
View file @
7075b337
...
...
@@ -72,7 +72,7 @@ means that all edges should be filleted."
))
#+
nil
(
define-object
test-blended-subtracted
(
test-blended-mixin
)
:computed-slots
((
specs
(
list
:edges
(
remove-if
#'
(
lambda
(
edge
)
(
the-object
edge
unique-id
))
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a 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