Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Support
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
G
gendl
Project overview
Project overview
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
45
Issues
45
List
Boards
Labels
Milestones
Merge Requests
0
Merge Requests
0
Wiki
Wiki
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Commits
Issue Boards
Open sidebar
gendl
gendl
Commits
71d5acb9
Commit
71d5acb9
authored
Oct 11, 2018
by
Dave Cooper
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
merged patches to support growlr.
parent
8120c87c
Changes
12
Hide whitespace changes
Inline
Side-by-side
Showing
12 changed files
with
135 additions
and
121 deletions
+135
-121
base/source/package.lisp
base/source/package.lisp
+1
-0
base/source/utilities.lisp
base/source/utilities.lisp
+13
-1
geom-base/drawing/source/renderer-mixin.lisp
geom-base/drawing/source/renderer-mixin.lisp
+6
-1
glisp/source/genworks.lisp
glisp/source/genworks.lisp
+2
-1
gwl-graphics/gwl/source/base-ajax-graphics-sheet.lisp
gwl-graphics/gwl/source/base-ajax-graphics-sheet.lisp
+70
-80
gwl-graphics/svg/source/lenses.lisp
gwl-graphics/svg/source/lenses.lisp
+23
-18
gwl/depends-on.isc
gwl/depends-on.isc
+1
-1
gwl/gwl.asd
gwl/gwl.asd
+1
-1
regression/data/round-trip-2.igs
regression/data/round-trip-2.igs
+3
-3
regression/data/round-trip.igs
regression/data/round-trip.igs
+3
-3
regression/data/round-trip.stp
regression/data/round-trip.stp
+11
-11
regression/source/separated-solid.lisp
regression/source/separated-solid.lisp
+1
-1
No files found.
base/source/package.lisp
View file @
71d5acb9
...
...
@@ -121,6 +121,7 @@ If you are interested in this effort we would love to hear from you at open-sour
#:+kappa+
#:+phi+
#:2pi
#:add-godparent
#:alist2plist
#:always
#:append-elements
...
...
base/source/utilities.lisp
View file @
71d5acb9
...
...
@@ -383,8 +383,20 @@ You have a dependency on caffeine. Your children are your dependants.
#+
nil
(
defun
same-tree?
(
obj1
obj2
)
(
eql
(
gdl-acc::%root%
obj1
)
(
gdl-acc::%root%
obj2
)))
(
defun
same-tree?
(
obj1
obj2
)
(
or
(
eql
(
gdl-acc::%root%
obj1
)
(
gdl-acc::%root%
obj2
))
(
let
((
root-1
(
gdl-acc::%root%
obj1
))
(
root-2
(
gdl-acc::%root%
obj2
)))
(
let
((
god-parents-1
(
gdl-acc::%god-parents%
root-1
))
(
god-parents-2
(
gdl-acc::%god-parents%
root-2
)))
(
member
root-1
god-parents-2
)
(
member
root-2
god-parents-1
)))))
(
defun
add-godparent
(
target
new
)
(
pushnew
new
(
gdl-acc::%god-parents%
target
)))
(
defun
merge-common-keys
(
plist
)
;; FLAG - call recursively until no more non-standard keywords remain.
...
...
geom-base/drawing/source/renderer-mixin.lisp
View file @
71d5acb9
...
...
@@ -31,10 +31,15 @@
:documentation
(
:description
"Object mixed into the base-view to compute required values to provide
a rendered perspective view, as in VRML."
)
:computed-slots
((
camera-distance-discount
0.8
))
:input-slots
(
(
camera-distance-discount
0.8
)
;;(camera-distance-discount 0.8)
"List of GDL Objects. Roots of the leaf objects to be displayed in this renderer view."
object-roots
...
...
glisp/source/genworks.lisp
View file @
71d5acb9
...
...
@@ -43,7 +43,8 @@
(
warn
"~&Please implement concatenate-fasls for the currently running lisp.~%"
)
;;
;; FLAG -- OBSOLETED by asdf/bundle:fasl-op and asdf/bundle:monolithic-fasl-op
;; FLAG -- OBSOLETED by asdf/bundle:compile-bundle-op and asdf/bundle:monolithic-compile-bundle-op
;; (except for current apparent bug where it leaves out a depended-upon uiop).
;;
(
defun
concatenate-fasls
(
files
dest
)
#-
(
or
allegro
lispworks
sbcl
ccl
)
(
declare
(
ignore
files
dest
))
...
...
gwl-graphics/gwl/source/base-ajax-graphics-sheet.lisp
View file @
71d5acb9
...
...
@@ -133,10 +133,30 @@ value of the image-format-selector, which itself defaults to :raphael."
(
on-drop-function
nil
)
(
on-touchmove-function
nil
))
(
on-touchmove-function
nil
)
(
viewport-js-text
(
format
nil
"
function x3draw ()
{
if (x3dom.type != 'undefined') x3dom.reload();
var elem = document.getElementById('view-~(~a~)');
if (elem) elem.setAttribute('set_bind', 'true');
var x3dom1 = document.getElementById('x3dom-1');
if (x3dom1) xruntime= x3dom1.runtime;
xruntime.resetView();
}
x3draw();
"
(
the
view-selector
value
)))
)
:computed-slots
((
js-to-eval
:parse
:settable
)
(
js-always-to-eval
nil
)
...
...
@@ -158,14 +178,14 @@ value of the image-format-selector, which itself defaults to :raphael."
(
svg-string
(
if
(
the
no-graphics?
)
(
with-cl-who-string
()
((
:div
:id
"empty-viewport"
:class
"empty-viewport"
)
(
:p
(
:h2
(
str
(
the
empty-display-list-message
))
))))
(
str
(
the
empty-display-list-message
))))
(
with-error-handling
()
(
with-output-to-string
(
ss
)
(
with-format
(
svg
ss
:background-color
(
the
background-color
)
:foreground-color
(
the
foreground-color
))
(
write-the
view-object
cad-output
))))))
(
"String of valid HTML. This can be used to
include the PNG or JPG raster-graphics of the geometry."
...
...
@@ -226,6 +246,7 @@ bottom of the graphics inside a table."
This is not tested to see if it is part of the same object tree as current self."
dropped-object
nil
:settable
)
(
viewport-script
(
progn
...
...
@@ -234,25 +255,7 @@ This is not tested to see if it is part of the same object tree as current self.
(
with-cl-who-string
()
(
:div
((
:script
:type
"text/javascript"
)
(
fmt
"
function x3draw ()
{
if (x3dom.type != 'undefined') x3dom.reload();
var elem = document.getElementById('view-~(~a~)');
if (elem) elem.setAttribute('set_bind', 'true');
var x3dom1 = document.getElementById('x3dom-1');
if (x3dom1) xruntime= x3dom1.runtime;
//xruntime.resetView();
}
x3draw();
"
(
the
view-selector
value
)
)))))
(
str
(
the
viewport-js-text
))))))
(
t
""
)))))
...
...
@@ -420,74 +423,61 @@ z-index: 1;
(
"Void. Writes an embedded X3D tag and included content for the <tt>view-object</tt> child of this object.
The <tt>view-object</tt> child should exist and be of type <tt>web-drawing</tt>."
embedded-x3dom-world
(
&key
(
include-view-controls?
nil
))
embedded-x3dom-world
(
&key
(
include-view-controls?
nil
))
(
declare
(
ignore
include-view-controls?
))
(
declare
(
ignore
include-view-controls?
))
;; (the (restore-slot-default! :js-to-eval))
;; (the (restore-slot-default! :js-to-eval))
(
cl-who:with-html-output
(
*stream*
)
(
with-cl-who
(
)
(
when
(
typep
(
the
:view-object
)
'null-part
)
(
error
"A valid :view-object of type web-drawing is required in the sheet
(
when
(
typep
(
the
:view-object
)
'null-part
)
(
error
"A valid :view-object of type web-drawing is required in the sheet
to call the :write-embedded-x3d-world function."
))
(
cond
((
the
no-graphics?
)
#+
nil
(
and
(
null
(
the
:view-object
:object-roots
))
(
null
(
the
:view-object
:objects
)))
(
html-stream
*stream*
((
:table
:cellspacing
0
:cellpadding
0
:bgcolor
:white
)
(
:tr
((
:td
:width
(
the
:view-object
:width
)
:height
(
the
:view-object
:height
)
:align
:center
:valign
:center
)
(
:big
(
:b
"No Graphics Object Specified"
)))))))
(
t
(
let
((
*display-controls*
(
the
display-controls-hash
)))
(
with-cl-who
()
(
:span
((
:|X3D|
:id
"x3dom-1"
:style
"background: #d3d3d3"
:width
(
format
nil
"~apx"
(
the
view-object
page-width
))
:height
(
format
nil
"~apx"
(
the
view-object
page-length
))
)
(
:|Scene|
(
cond
((
the
no-graphics?
)
(
htm
((
:div
:id
"empty-viewport"
:class
"empty-viewport"
)
(
str
(
the
empty-display-list-message
)))))
(
t
(
let
((
*display-controls*
(
the
display-controls-hash
)))
(
htm
(
:span
((
:|X3D|
:id
"x3dom-1"
:style
"background: #d3d3d3"
:width
(
format
nil
"~apx"
(
the
view-object
page-width
))
:height
(
format
nil
"~apx"
(
the
view-object
page-length
))
)
(
:|Scene|
((
:|navigationinfo|
:|id|
"navi"
:|transitionTime|
"0.0"
))
((
:|navigationinfo|
:|id|
"navi"
:|transitionTime|
"0.0"
))
(
with-format
(
x3d
*stream*
)
(
let
((
*onclick-function*
(
the
onclick-function
)))
(
write-the
view-object
cad-output
))))))))))))
(
with-format
(
x3d
*stream*
)
(
let
((
*onclick-function*
(
the
onclick-function
)))
(
write-the
view-object
cad-output
))))))))))))
(
raster-graphics
()
(
when
(
typep
(
the
:view-object
)
'null-part
)
(
error
"A valid :view-object of type web-drawing is
()
(
when
(
typep
(
the
:view-object
)
'null-part
)
(
error
"A valid :view-object of type web-drawing is
required in the sheet to call the :write-geometry method."
))
(
with-cl-who
()
(
cond
((
and
(
null
(
the
:view-object
:object-roots
))
(
null
(
the
:view-object
:objects
)))
(
htm
((
:table
:border
1
:cellspacing
0
:cellpadding
0
:bgcolor
:white
)
(
:tr
((
:td
:width
(
the
:view-object
:width
)
:height
(
the
:view-object
:length
)
:align
:center
:valign
:center
)
(
:big
(
:b
"No Graphics Object Specified"
)))))))
(
with-cl-who
()
(
cond
((
the
no-graphics?
)
(
htm
((
:div
:id
"empty-viewport"
:class
"empty-viewport"
)
(
str
(
the
empty-display-list-message
)))))
((
typep
(
the
image-url
)
'error
)
(
the
(
set-slot!
:view-toggle
nil
))
(
write-the
geometry-error
))
((
typep
(
the
image-url
)
'error
)
(
the
(
set-slot!
:view-toggle
nil
))
(
write-the
geometry-error
))
(
t
(
let
((
image-url
(
the
image-url
)))
(
htm
((
:table
:border
0
:cellspacing
0
:cellpadding
0
)
(
:tr
((
:td
)
;;:bgcolor :yellow) --FLAG! -- SvdE @ 13-08-09 -- removed bgcolor to blend in with viewport
((
:img
:id
"myimage"
:style
"cursor: crosshair;"
:src
image-url
:onclick
(
the
(
gdl-ajax-call
:function-key
:dig-point
))
:border
0
:width
(
the
:view-object
:page-width
)
:height
(
the
:view-object
:page-length
))))))))))))))
(
t
(
let
((
image-url
(
the
image-url
)))
(
htm
((
:img
:id
"myimage"
:style
"cursor: crosshair;"
:src
image-url
:onclick
(
the
(
gdl-ajax-call
:function-key
:dig-point
))
:border
0
:width
(
the
:view-object
:page-width
)
:height
(
the
:view-object
:page-length
)))))))))))
gwl-graphics/svg/source/lenses.lisp
View file @
71d5acb9
...
...
@@ -28,7 +28,7 @@
()
(
let
((
view-center
(
if
(
the
user-center
)
(
scalar*vector
(
the
user-scale
)
(
the
user-center
))
(
make-point
0
0
0
))))
(
make-point
0
0
0
))))
(
with-format-slots
(
view
)
(
let
((
parent-scale
(
when
view
(
the-object
view
view-scale-total
))))
(
mapc
#'
(
lambda
(
child-view
)
...
...
@@ -36,21 +36,26 @@
(
when
parent-scale
(
the-object
child-view
(
set-slot!
:user-scale
parent-scale
)))
(
let
((
width
(
the-object
child-view
width
))
(
length
(
the-object
child-view
length
)))
(
with-html-output
(
*stream*
)
((
:div
:onmousedown
(
when
(
the
parent
vector-graphics-onclick?
)
(
the
parent
(
gdl-ajax-call
:function-key
:dig-point
:bashee
(
the
parent
)
:respondent
(
the
parent
:respondent
)))))
((
:svg
:id
"svg-1"
:viewBox
(
format
nil
"0 0 ~a ~a"
width
length
)
:width
width
:height
length
)
(
with-translated-state
(
:svg
(
make-point
(
-
(
get-x
view-center
))
(
-
(
get-y
view-center
))))
(
write-the-object
child-view
cad-output
)))
((
:script
:type
"text/javascript"
)
"
var panZoomSVG1 = svgPanZoom('#svg-1', {
(
with-html-output
(
*stream*
)
((
:div
:width
"100%"
:height
"100%"
:onmousedown
(
when
(
the
parent
vector-graphics-onclick?
)
(
the
parent
(
gdl-ajax-call
:function-key
:dig-point
:bashee
(
the
parent
)
:respondent
(
the
parent
:respondent
)))))
((
:svg
:id
"svg-1"
:viewBox
(
format
nil
"0 0 ~a ~a"
width
length
)
:width
width
:height
length
)
(
with-translated-state
(
:svg
(
make-point
(
-
(
get-x
view-center
))
(
-
(
get-y
view-center
))))
(
write-the-object
child-view
cad-output
)))
((
:script
:type
"text/javascript"
)
"
panZoomSVG1 = svgPanZoom('#svg-1', {
zoomEnabled: true,
controlIconsEnabled: true,
preventMouseEventsDefault: false,
...
...
@@ -58,8 +63,8 @@
minZoom: 0.01,
maxZoom: 100,
center: true});"
))))
(
when
parent-scale
(
the-object
child-view
(
set-slot!
:user-scale
old-scale
)))))
(
when
parent-scale
(
the-object
child-view
(
set-slot!
:user-scale
old-scale
)))))
(
the
views
))))))))
...
...
gwl/depends-on.isc
View file @
71d5acb9
;;"(:bordeaux-threads :drakma :glisp #+zacl :aserve #-zacl :paserve :yason)"
(:bordeaux-threads
:drakma
:glisp #-allegro :zacl-aserve #+allegro :aserve :yason)
(:bordeaux-threads:glisp #-allegro :zacl-aserve #+allegro :aserve :yason)
gwl/gwl.asd
View file @
71d5acb9
...
...
@@ -5,7 +5,7 @@
"Dave Cooper, Genworks International"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"20170802"
:depends-on
(
:bordeaux-threads
:
drakma
:
glisp
#-
allegro
:zacl-aserve
#+
allegro
:aserve
:yason
)
(
:bordeaux-threads
:glisp
#-
allegro
:zacl-aserve
#+
allegro
:aserve
:yason
)
#-
asdf-unicode
:defsystem-depends-on
#-
asdf-unicode
(
:asdf-encodings
)
#+
asdf-unicode
:defsystem-depends-on
#+
asdf-unicode
()
#+
asdf-encodings
:encoding
#+
asdf-encodings
:utf-8
...
...
regression/data/round-trip-2.igs
View file @
71d5acb9
S 1
1H,,1H;,2
7H/Users/dcooper8/tmp/g257508,27H/Users/dcooper8/tmp/g257508,
G 1
1H,,1H;,2
8H/Users/dcooper8/tmp/g2151696,28H/Users/dcooper8/tmp/g2151696,
G 1
23HHarmonyWare Translators,23HHarmonyWare IGES v2.0.5,32,38,6,308,15,, G 2
1.,1,2HIN,1,1.,15H2018
0805.120734,1.D-6,21.3205116838006,,,11,0,15H20180
G 3
805.12073
4; G 4
1.,1,2HIN,1,1.,15H2018
1010.133004,1.D-6,21.3205116838006,,,11,0,15H20181
G 3
010.13300
4; G 4
502 1 0 0 0 0 0 000010000D 1
502 0 0 16 1 0D 2
124 17 0 0 0 0 0 000000000D 3
...
...
regression/data/round-trip.igs
View file @
71d5acb9
S 1
1H,,1H;,2
7H/Users/dcooper8/tmp/g257498,27H/Users/dcooper8/tmp/g257498,
G 1
1H,,1H;,2
8H/Users/dcooper8/tmp/g2151686,28H/Users/dcooper8/tmp/g2151686,
G 1
23HHarmonyWare Translators,23HHarmonyWare IGES v2.0.5,32,38,6,308,15,, G 2
1.,1,2HIN,1,1.,15H2018
0805.120730,1.D-6,20.7712135760006,,,11,0,15H20180
G 3
805.12073
0; G 4
1.,1,2HIN,1,1.,15H2018
1010.133000,1.D-6,20.7712135760006,,,11,0,15H20181
G 3
010.13300
0; G 4
502 1 0 0 0 0 0 000010000D 1
502 0 0 442 1 0D 2
110 443 0 0 0 0 0 000010000D 3
regression/data/round-trip.stp
View file @
71d5acb9
ISO-10303-21;
HEADER;
FILE_DESCRIPTION ((), '1');
FILE_NAME ('/Users/dcooper8/tmp/g2
57940', '2018-08-05T12:09:02
', ('Unknown'), ('Unknown'), 'HarmonyWare STEP v2.0.5', 'HarmonyWare Translators', '');
FILE_NAME ('/Users/dcooper8/tmp/g2
151873', '2018-10-10T13:30:20
', ('Unknown'), ('Unknown'), 'HarmonyWare STEP v2.0.5', 'HarmonyWare Translators', '');
FILE_SCHEMA (('CONFIG_CONTROL_DESIGN'));
ENDSEC;
...
...
@@ -26462,9 +26462,9 @@ DATA;
#264330 = PRODUCT_DEFINITION_FORMATION_WITH_SPECIFIED_SOURCE ('', '', #264260, .NOT_KNOWN.);
#264340 = APPROVAL_STATUS ('approved');
#264350 = APPROVAL (#264340, '');
#264360 = CALENDAR_DATE (2018,
5, 8
);
#264360 = CALENDAR_DATE (2018,
10, 10
);
#264370 = COORDINATED_UNIVERSAL_TIME_OFFSET (0, $, .AHEAD.);
#264380 = LOCAL_TIME (1
2, 9, 2
., #264370);
#264380 = LOCAL_TIME (1
3, 30, 20
., #264370);
#264390 = DATE_AND_TIME (#264360, #264380);
#264400 = APPROVAL_DATE_TIME (#264390, #264350);
#264410 = APPROVAL_ROLE ('');
...
...
@@ -26487,9 +26487,9 @@ DATA;
#264580 = SECURITY_CLASSIFICATION ('', '', #264570);
#264590 = APPROVAL_STATUS ('approved');
#264600 = APPROVAL (#264590, '');
#264610 = CALENDAR_DATE (2018,
5, 8
);
#264610 = CALENDAR_DATE (2018,
10, 10
);
#264620 = COORDINATED_UNIVERSAL_TIME_OFFSET (0, $, .AHEAD.);
#264630 = LOCAL_TIME (1
2, 9, 2
., #264620);
#264630 = LOCAL_TIME (1
3, 30, 20
., #264620);
#264640 = DATE_AND_TIME (#264610, #264630);
#264650 = APPROVAL_DATE_TIME (#264640, #264600);
#264660 = APPROVAL_ROLE ('');
...
...
@@ -26499,9 +26499,9 @@ DATA;
#264700 = APPROVAL_PERSON_ORGANIZATION (#264690, #264600, #264660);
#264710 = CC_DESIGN_APPROVAL (#264600, (#264580));
#264720 = DATE_TIME_ROLE ('classification_date');
#264730 = CALENDAR_DATE (2018,
5, 8
);
#264730 = CALENDAR_DATE (2018,
10, 10
);
#264740 = COORDINATED_UNIVERSAL_TIME_OFFSET (0, $, .AHEAD.);
#264750 = LOCAL_TIME (1
2, 9, 2
., #264740);
#264750 = LOCAL_TIME (1
3, 30, 20
., #264740);
#264760 = DATE_AND_TIME (#264730, #264750);
#264770 = CC_DESIGN_DATE_AND_TIME_ASSIGNMENT (#264760, #264720, (#264580));
#264780 = PERSON_AND_ORGANIZATION_ROLE ('classification_officer');
...
...
@@ -26514,9 +26514,9 @@ DATA;
#264850 = PRODUCT_DEFINITION ('', '', #264330, #264840);
#264860 = APPROVAL_STATUS ('approved');
#264870 = APPROVAL (#264860, '');
#264880 = CALENDAR_DATE (2018,
5, 8
);
#264880 = CALENDAR_DATE (2018,
10, 10
);
#264890 = COORDINATED_UNIVERSAL_TIME_OFFSET (0, $, .AHEAD.);
#264900 = LOCAL_TIME (1
2, 9, 2
., #264890);
#264900 = LOCAL_TIME (1
3, 30, 20
., #264890);
#264910 = DATE_AND_TIME (#264880, #264900);
#264920 = APPROVAL_DATE_TIME (#264910, #264870);
#264930 = APPROVAL_ROLE ('');
...
...
@@ -26526,9 +26526,9 @@ DATA;
#264970 = APPROVAL_PERSON_ORGANIZATION (#264960, #264870, #264930);
#264980 = CC_DESIGN_APPROVAL (#264870, (#264850));
#264990 = DATE_TIME_ROLE ('creation_date');
#265000 = CALENDAR_DATE (2018,
5, 8
);
#265000 = CALENDAR_DATE (2018,
10, 10
);
#265010 = COORDINATED_UNIVERSAL_TIME_OFFSET (0, $, .AHEAD.);
#265020 = LOCAL_TIME (1
2, 9, 2
., #265010);
#265020 = LOCAL_TIME (1
3, 30, 20
., #265010);
#265030 = DATE_AND_TIME (#265000, #265020);
#265040 = CC_DESIGN_DATE_AND_TIME_ASSIGNMENT (#265030, #264990, (#264850));
#265050 = PERSON_AND_ORGANIZATION_ROLE ('creator');
regression/source/separated-solid.lisp
View file @
71d5acb9
...
...
@@ -57,4 +57,4 @@
)))
;;
(register-test-definition 'separated-solid-test)
(
register-test-definition
'separated-solid-test
)
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