Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
G
gendl
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
45
Issues
45
List
Board
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
1409b24f
Commit
1409b24f
authored
Dec 08, 2016
by
Dave Cooper
Browse files
Options
Browse Files
Download
Plain Diff
merging feature/zacl which adds support for zacl.
parents
0272a167
609ad61c
Changes
45
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
45 changed files
with
297316 additions
and
4829 deletions
+297316
-4829
parameters.lisp
base/rest/source/parameters.lisp
+5
-0
utilities.lisp
base/rest/source/utilities.lisp
+4
-2
genworks.lisp
base/source/genworks.lisp
+10
-10
package.lisp
base/source/package.lisp
+2
-0
start.lisp
base/source/start.lisp
+14
-25
initialize.lisp
base/zzinit/source/initialize.lisp
+8
-2
drilled-block.lisp
...entation/training/g105/examples/source/drilled-block.lisp
+1
-1
assembly.gendl
documentation/training/slide-show/source/assembly.gendl
+1
-3
depends-on.isc
glisp/depends-on.isc
+1
-1
glisp.asd
glisp/glisp.asd
+12
-13
genworks.lisp
glisp/source/genworks.lisp
+47
-25
skeleton-ui-element.lisp
gwl/ajax/source/skeleton-ui-element.lisp
+1
-1
depends-on.isc
gwl/depends-on.isc
+1
-1
primitives.lisp
gwl/form-elements/source/primitives.lisp
+4
-2
gwl.asd
gwl/gwl.asd
+7
-7
base-html-sheet.lisp
gwl/source/base-html-sheet.lisp
+2
-2
cl-pdf-patches.lisp
gwl/source/cl-pdf-patches.lisp
+0
-85
remote-object.lisp
gwl/source/remote-object.lisp
+1
-5
x3dom-dev.js
gwl/static/3rdpty/x3dom-1.6.2/x3dom-dev.js
+0
-0
x3dom.css
gwl/static/3rdpty/x3dom-1.6.2/x3dom.css
+232
-0
x3dom.js
gwl/static/3rdpty/x3dom-1.6.2/x3dom.js
+4407
-0
x3dom.swf
gwl/static/3rdpty/x3dom-1.6.2/x3dom.swf
+0
-0
AUTHORS
gwl/static/3rdpty/x3dom/AUTHORS
+41
-0
CHANGELOG
gwl/static/3rdpty/x3dom/CHANGELOG
+6576
-0
LICENSE
gwl/static/3rdpty/x3dom/LICENSE
+42
-0
README.md
gwl/static/3rdpty/x3dom/README.md
+124
-0
ammo.js
gwl/static/3rdpty/x3dom/ammo.js
+21351
-0
BVHRefiner.js
gwl/static/3rdpty/x3dom/components/BVHRefiner.js
+225
-0
CADGeometry.js
gwl/static/3rdpty/x3dom/components/CADGeometry.js
+96
-0
Geometry2D.js
gwl/static/3rdpty/x3dom/components/Geometry2D.js
+57
-0
Geometry3DExt.js
gwl/static/3rdpty/x3dom/components/Geometry3DExt.js
+195
-0
Geospatial.js
gwl/static/3rdpty/x3dom/components/Geospatial.js
+164
-0
H-Anim.js
gwl/static/3rdpty/x3dom/components/H-Anim.js
+2
-0
Layout.js
gwl/static/3rdpty/x3dom/components/Layout.js
+7
-0
VolumeRendering.js
gwl/static/3rdpty/x3dom/components/VolumeRendering.js
+175
-0
dash.all.js
gwl/static/3rdpty/x3dom/dash.all.js
+4843
-0
x3dom-full-physics.debug.js
gwl/static/3rdpty/x3dom/x3dom-full-physics.debug.js
+95529
-0
x3dom-full-physics.js
gwl/static/3rdpty/x3dom/x3dom-full-physics.js
+26955
-0
x3dom-full.debug.js
gwl/static/3rdpty/x3dom/x3dom-full.debug.js
+71021
-0
x3dom-full.js
gwl/static/3rdpty/x3dom/x3dom-full.js
+5408
-0
x3dom.css
gwl/static/3rdpty/x3dom/x3dom.css
+226
-232
x3dom.debug.js
gwl/static/3rdpty/x3dom/x3dom.debug.js
+54996
-0
x3dom.js
gwl/static/3rdpty/x3dom/x3dom.js
+4502
-4407
initialize.lisp
gwl/zzinit/source/initialize.lisp
+19
-3
remote.lisp
regression/dgdl/source/remote.lisp
+2
-2
No files found.
base/rest/source/parameters.lisp
View file @
1409b24f
...
...
@@ -367,3 +367,8 @@ set to nil to improve memory performance.")
(
defparameter
*with-format-element-type*
nil
"Element-type. The default for the :element-type format-slot
for the base format. Defaults to nil. Needs a better default."
)
(
defparameter
*allow-nil-list-of-numbers?*
nil
"Boolean. If set to t,
allows list-of-numbers function to return nil instead of error
when num1 is greater than num2 with positive increment or vice-versa.
Default is nil."
)
base/rest/source/utilities.lisp
View file @
1409b24f
...
...
@@ -136,8 +136,10 @@ was contributed by Reinier van Dijk.
(tolerance (/ increment 10)) \"Number. tolerance for increment.\")"
(
cond
((
zerop
increment
)
(
error
"increment of zero is not allowed"
))
((
and
(
<
increment
0.0
)
(
>
num2
num1
))
(
error
"increment is negative, while difference between num2 and num1 is positive."
))
((
and
(
>
increment
0.0
)
(
<
num2
num1
))
(
error
"increment is positive, while difference between num2 and num1 is negative."
))
((
and
(
<
increment
0.0
)
(
>
num2
num1
))
(
unless
*allow-nil-list-of-numbers?*
(
error
"increment is negative, while difference between num2 and num1 is positive."
)))
((
and
(
>
increment
0.0
)
(
<
num2
num1
))
(
unless
*allow-nil-list-of-numbers?*
(
error
"increment is positive, while difference between num2 and num1 is negative."
)))
(
t
(
let
((
predicate
(
if
(
>
increment
0.0
)
#'
>=
#'
<=
))
(
result-list
nil
))
(
do
((
num
num1
(
+
num
increment
)))
...
...
base/source/genworks.lisp
View file @
1409b24f
...
...
@@ -30,16 +30,16 @@
(
eval-when
(
:compile-toplevel
:load-toplevel
:execute
)
(
defun
set-genworks-source-home-if-known
()
(
when
(
find-package
:asdf
)
(
multiple-value-bind
(
base-home
error
)
(
ignore-errors
(
funcall
(
read-from-string
"asdf:system-source-directory"
)
"base"
))
(
if
(
typep
error
'error
)
(
warn
"~&ASDF is loaded, but :base is not registered. glisp:*genworks-source-home* remains unknown and set to nil.~%"
)
(
setq
*genworks-source-home*
(
make-pathname
:name
nil
:type
nil
:directory
(
butlast
(
butlast
(
pathname-directory
base-home
)))
:defaults
base-home
)))))))
(
when
(
find-package
:asdf
)
(
multiple-value-bind
(
base-home
error
)
(
ignore-errors
(
funcall
(
read-from-string
"asdf:system-source-directory"
)
"base"
))
(
if
(
typep
error
'error
)
(
warn
"~&ASDF is loaded, but :base is not registered. glisp:*genworks-source-home* remains unknown and set to nil.~%"
)
(
setq
*genworks-source-home*
(
make-pathname
:name
nil
:type
nil
:directory
(
butlast
(
butlast
(
pathname-directory
base-home
)))
:defaults
base-home
)))))))
(
set-genworks-source-home-if-known
)
...
...
base/source/package.lisp
View file @
1409b24f
...
...
@@ -193,6 +193,7 @@ If you are interested in this effort we would love to hear from you at open-sour
#:list-elements
#:list-hash
#:list-of-numbers
#:*allow-nil-list-of-numbers?*
#:list-of-n-numbers
#:lookup-color
#:load-glime
...
...
@@ -397,6 +398,7 @@ If you are interested in this effort we would love to hear from you at open-sour
#:patches-dir
#:process-run-function
#:remote-host
#:local-host
#:replace-regexp
#:room-report
#:slot-definition-name
...
...
base/source/start.lisp
View file @
1409b24f
...
...
@@ -67,35 +67,24 @@
(
defun
quicklisp-copyright-string
()
(
let
((
ql-libs
(
safe-sort
(
set-difference
*already-loaded-systems*
(
append
(
list
"asdf"
"crypt"
"quicklisp"
"base"
"ent"
"validate"
"glisp"
"monofasl"
"pro"
"enterprise"
)
*packages-to-lock*
)
:key
#'
string
:test
#'
string-equal
)
#'
string-lessp
))
(
ql-version
(
with-open-file
(
in
(
or
(
probe-file
(
merge-pathnames
"quicklisp/dists/quicklisp/distinfo.txt"
glisp:*gdl-home*
))
(
probe-file
(
merge-pathnames
"genworks/quicklisp/dists/quicklisp/distinfo.txt"
glisp:*gdl-home*
))
(
probe-file
(
merge-pathnames
"quicklisp/dists/quicklisp/distinfo.txt"
glisp:*genworks-source-home*
))
(
probe-file
(
merge-pathnames
"../distinfo.txt"
glisp:*genworks-source-home*
))))
(
read-line
in
)
(
string-trim
(
list
#\space
)
(
second
(
glisp:split-regexp
":"
(
read-line
in
)))))))
(
format
nil
"Also contains the following Common Lisp libraries
(
when
*already-loaded-systems*
(
let
((
ql-libs
(
safe-sort
(
set-difference
*already-loaded-systems*
(
append
(
list
"asdf"
"crypt"
"quicklisp"
"base"
"ent"
"validate"
"glisp"
"monofasl"
"pro"
"enterprise"
)
*packages-to-lock*
)
:key
#'
string
:test
#'
string-equal
)
#'
string-lessp
))
(
ql-version
(
with-open-file
(
in
(
or
(
probe-file
(
merge-pathnames
"dists/quicklisp/distinfo.txt"
*quicklisp-home*
))
(
error
"Quicklisp directory not found in gendl:*quicklisp-home*,
which is set to: ~a.~%"
*quicklisp-home*
)))
(
read-line
in
)
(
string-trim
(
list
#\space
)
(
second
(
glisp:split-regexp
":"
(
read-line
in
)))))))
(
format
nil
"Also contains the following Common Lisp libraries
from Quicklisp version ~a, whose source files are available in the
Quicklisp repository at http://quicklisp.org, Copyright© their
respective authors:
~{~a~^, ~}.~%"
ql-version
ql-libs
)))
~{~a~^, ~}.~%"
ql-version
ql-libs
))))
(
defun
startup-banner
()
...
...
base/zzinit/source/initialize.lisp
View file @
1409b24f
...
...
@@ -30,8 +30,14 @@
:directory
(
butlast
(
pathname-directory
glisp:*gdl-program-home*
))
:defaults
glisp:*gdl-program-home*
))
(
setq
glisp:*gendl-home*
glisp:*gdl-home*
)
(
setq
*quicklisp-home*
(
or
(
probe-file
(
merge-pathnames
"quicklisp/"
glisp:*gendl-home*
))
(
probe-file
(
merge-pathnames
"genworks/quicklisp/"
glisp:*gendl-home*
))))
(
setq
*quicklisp-home*
(
or
(
when
(
and
(
find-package
:ql
)
(
boundp
(
read-from-string
"ql:*quicklisp-home*"
)))
(
symbol-value
(
read-from-string
"ql:*quicklisp-home*"
)))
(
probe-file
(
merge-pathnames
"quicklisp/"
glisp:*gendl-home*
))
(
probe-file
(
merge-pathnames
"genworks/quicklisp/"
glisp:*gendl-home*
))
(
probe-file
(
merge-pathnames
"quicklisp/"
glisp:*genworks-source-home*
))
(
probe-file
(
merge-pathnames
"genworks/quicklisp/dists/quicklisp/distinfo.txt"
glisp:*gdl-home*
))
))
(
pushnew
(
make-keyword
(
format
nil
"gendl-~a"
*gendl-version*
))
*features*
)
(
glisp:set-genworks-source-home-if-known
)
(
glisp:set-default-float-format
)
...
...
documentation/training/g105/examples/source/drilled-block.lisp
View file @
1409b24f
;;
;; Copyright 2002, 2009 Genworks International
and Genworks BV
;; Copyright 2002, 2009 Genworks International
;;
;; This source file is part of the General-purpose Declarative
;; Language project (GDL).
...
...
documentation/training/slide-show/source/assembly.gendl
View file @
1409b24f
...
...
@@ -370,10 +370,8 @@
((:div :id "copyright")
(when gwl:*developing?*
(the write-development-links))
"Copyright © 201
2
"
"Copyright © 201
6
"
((:a :href "http://www.genworks.com") "Genworks" (:sup "®") "International")
" and "
((:a :href "http://home.tudelft.nl/en/") "Delft University of Technology")
"."
)))))
...
...
glisp/depends-on.isc
View file @
1409b24f
"(:base :uiop :cl-typesetting :cl-ppcre :cl-who #-allegro :cl-base64 #-allegro :babel #-
allegro :acl-compat
)"
"(:base :uiop :cl-typesetting :cl-ppcre :cl-who #-allegro :cl-base64 #-allegro :babel #-
(or allegro ccl) :acl-compat #+ccl :zacl
)"
glisp/glisp.asd
View file @
1409b24f
;;;; -*- coding: utf-8 -*-
(
asdf:defsystem
#:glisp
:description
"The Gendl\" Common Lisp Portability"
:author
"John McCarthy"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"20160828"
:depends-on
(
:base
:uiop
:cl-typesetting
:cl-ppcre
:cl-who
#-
allegro
:cl-base64
#-
allegro
:babel
#-
allegro
:acl-compat
)
#-
asdf-unicode
:defsystem-depends-on
#-
asdf-unicode
(
:asdf-encodings
)
#+
asdf-encodings
:encoding
#+
asdf-encodings
:utf-8
:components
((
:file
"source/presets"
)
(
:file
"source/parameters"
)
(
:file
"source/genworks"
)
(
:file
"source/initialize"
)
(
:file
"source/zzinit"
)))
;;;; -*- coding: utf-8 -*-
(
asdf:defsystem
#:glisp
:description
"The Gendl® Common Lisp Portability"
:author
b
:license
"Genworks Proprietary"
:serial
t
:version
"20161127"
:depends-on
(
:base
:uiop
:cl-typesetting
:cl-ppcre
:cl-who
#-
allegro
:cl-base64
#-
allegro
:babel
#-
(
or
allegro
ccl
)
:acl-compat
#+
ccl
:zacl
)
#-
asdf-unicode
:defsystem-depends-on
#-
asdf-unicode
(
:asdf-encodings
)
#+
asdf-encodings
:encoding
#+
asdf-encodings
:utf-8
:components
((
:file
"source/presets"
)
(
:file
"source/parameters"
)
(
:file
"source/genworks"
)
(
:file
"source/initialize"
)
(
:file
"source/zzinit"
)))
glisp/source/genworks.lisp
View file @
1409b24f
...
...
@@ -268,23 +268,6 @@ The command line was: ~%~%~s~%" command result error command-line)))))
(
unless
(
zerop
result
)
(
error
"Ghostscript threw error"
))))
#+
nil
(
defun
run-gs
(
command
)
"Shell out a ghostscript command and handle errors."
(
format
t
"~a"
command
)
(
let
((
result
(
#+
allegro
excl:run-shell-command
#-
allegro
acl-compat.excl:run-shell-command
command
;;:show-window :hide
)))
(
when
result
(
unless
(
zerop
result
)
(
error
"Ghostscript threw error"
)))))
(
defun
run-program
(
command
&rest
keys
&key
ignore-error-status
force-shell
...
...
@@ -439,11 +422,34 @@ the \"current\" error."
)
(
defun
local-port
(
socket
)
(
#+
(
or
allegro
zacl
)
socket:local-port
#-
(
or
allegro
zacl
)
acl-compat.socket:local-port
socket
))
#+
nil
(
defun
local-port
(
socket
)
(
#+
allegro
socket:local-port
#-
allegro
acl-compat.socket:local-port
socket
))
(
defun
match-regexp
(
string-or-regexp
string-to-match
&key
newlines-special
case-fold
return
(
start
0
)
end
shortest
)
(
when
(
or
newlines-special
case-fold
return
shortest
)
(
error
"keyword arguments :newlines-special, :case-fold, :return, and :shortest
are no longer supported by glisp:match-regexp.~%"
))
#+
allegro
(
excl:match-regexp
string-or-regexp
string-to-match
:start
start
:end
end
)
#-
allegro
(
let
((
end-default
(
or
end
(
length
string-to-match
))))
(
cl-ppcre:scan
string-or-regexp
string-to-match
:start
start
:end
end-default
)))
#+
nil
(
defun
match-regexp
(
string-or-regexp
string-to-match
&key
newlines-special
case-fold
return
(
start
0
)
end
shortest
)
...
...
@@ -459,6 +465,16 @@ the \"current\" error."
(
defun
patches-dir
()
nil
)
#+
nil
(
defun
process-run-function
(
name-or-options
preset-function
&rest
args
)
#-
allegro
(
when
args
(
error
"args not supported for glisp:process-run-function on ~a.~%"
(
lisp-implementation-type
)))
(
apply
#+
allegro
#'
mp:process-run-function
#-
allegro
#'
bt:make-thread
preset-function
name-or-options
))
#+
nil
(
defun
process-run-function
(
name-or-options
preset-function
&rest
args
)
(
apply
#+
allegro
#'
mp:process-run-function
#-
allegro
#'
acl-compat.mp:process-run-function
...
...
@@ -471,8 +487,13 @@ the \"current\" error."
(
defun
remote-host
(
socket
)
#+
allegro
(
socket:remote-host
socket
)
#-
allegro
(
acl-compat.socket:remote-host
socket
))
#+
(
or
allegro
zacl
)
(
socket:remote-host
socket
)
#-
(
or
allegro
zacl
)
(
acl-compat.socket:remote-host
socket
))
(
defun
local-host
(
socket
)
#+
(
or
allegro
zacl
)
(
socket:local-host
socket
)
#-
(
or
allegro
zacl
)
(
acl-compat.socket:local-host
socket
))
(
defun
replace-regexp
(
string
regexp
to-string
)
(
cl-ppcre:regex-replace-all
regexp
string
to-string
))
...
...
@@ -651,16 +672,17 @@ please find implementation for the currently running lisp.~%")
#-
allegro
`
(
let
((
*print-case*
:downcase
))
,@
body
)
#+
allegro
`
(
progn
,@
body
))
(
defun
with-timeout-sym
()
"Returns the appropriate symbol for with-timeout, for substitution within macros."
#+
allegro
'sys:with-timeout
#-
allegro
'acl-compat.mp:with-timeout
)
#+
(
or
allegro
zacl
)
'sys:with-timeout
#-
(
or
allegro
zacl
)
'acl-compat.mp:with-timeout
)
(
defmacro
with-timeout
((
seconds
&body
timeout-body
)
&body
body
)
#+
allegro
`
(
mp:with-timeout
(
,
seconds
,@
timeout-body
)
,@
body
)
#-
allegro
`
(
acl-compat.mp:with-timeout
(
,
seconds
,@
timeout-body
)
,@
body
))
#+
(
or
allegro
zacl
)
`
(
sys:with-timeout
(
,
seconds
,@
timeout-body
)
,@
body
)
#-
(
or
allegro
zacl
)
`
(
acl-compat.mp:with-timeout
(
,
seconds
,@
timeout-body
)
,@
body
))
(
defmacro
without-redefinition-warnings
(
&rest
body
)
#+
allegro
...
...
gwl/ajax/source/skeleton-ui-element.lisp
View file @
1409b24f
...
...
@@ -409,7 +409,7 @@ running the Javascript interpreter to evaluate (the js-to-eval), if any.
js-vals
(
glisp:replace-regexp
js-vals
"\\"
"\\\\\\\\"
))
(
format
nil
"gdlAjax(~a, 'args=~a~a~a, ~a);"
(
format
nil
"gdlAjax(~a, 'args=~a~a~a, ~a);
return(false);
"
(
if
null-event?
"null"
"event"
)
string-1
string-2
(
or
js-vals
""
)
string-3
)))
...
...
gwl/depends-on.isc
View file @
1409b24f
(:bordeaux-threads :glisp :aserve :yason)
"(:bordeaux-threads :drakma :glisp #+ccl :aserve #-ccl :paserve :yason)"
gwl/form-elements/source/primitives.lisp
View file @
1409b24f
...
...
@@ -39,6 +39,9 @@ Defaults to nil."
(
"Keyword symbol. The ID attribute for this tag. Defaults to (the field-name)."
id
(
the
field-name
))
(
"Keyword symbol. The name of this field. Computed from the object name within the tree."
field-name
(
make-keyword-sensitive
(
the
base64-encoded-root-path
)))
)
:computed-slots
...
...
@@ -66,8 +69,7 @@ Previously known as form-control-string. Default is the form-control-string."
(
with-format
(
html-format
*stream*
)
(
write-the
string
))))
(
"Keyword symbol. The name of this field. Computed from the object name within the tree."
field-name
(
make-keyword-sensitive
(
the
base64-encoded-root-path
)))
...
...
gwl/gwl.asd
View file @
1409b24f
...
...
@@ -3,9 +3,10 @@
(
asdf:defsystem
#:gwl
:description
"The Gendl® Generative Web Language (GWL)"
:author
"John McCarthy"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"20161025"
:depends-on
(
:bordeaux-threads
:glisp
:aserve
:yason
)
#-
asdf-unicode
:defsystem-depends-on
#-
asdf-unicode
(
:asdf-encodings
)
:serial
t
:version
"20161125"
:depends-on
(
:bordeaux-threads
:drakma
:glisp
#+
ccl
:aserve
#-
ccl
:paserve
:yason
)
#-
asdf-unicode
:defsystem-depends-on
#-
asdf-unicode
(
:asdf-encodings
)
#+
asdf-unicode
:defsystem-depends-on
#+
asdf-unicode
()
#+
asdf-encodings
:encoding
#+
asdf-encodings
:utf-8
:components
((
:file
"source/package"
)
(
:file
"source/with-all-servers"
)
...
...
@@ -16,10 +17,9 @@
(
:file
"source/utilities"
)
(
:file
"source/answer"
)
(
:file
"source/accessories"
)
(
:file
"source/gdl-remote"
)
(
:file
"source/vanilla-remote"
)
(
:file
"source/base64-utils"
)
(
:file
"source/cl-pdf-patches"
)
(
:file
"source/color-palette"
)
(
:file
"source/crawler"
)
(
:file
"source/log-utils"
)
(
:file
"source/new-urls"
)
(
:file
"source/publish"
)
(
:file
"source/remote-object"
)
(
:file
"source/color-palette"
)
(
:file
"source/crawler"
)
(
:file
"source/log-utils"
)
(
:file
"source/new-urls"
)
(
:file
"source/publish"
)
(
:file
"source/remote-object"
)
(
:file
"source/security-check-failed"
)
(
:file
"form-elements/source/grid-form-element"
)
(
:file
"form-elements/source/macros"
)
...
...
gwl/source/base-html-sheet.lisp
View file @
1409b24f
...
...
@@ -104,8 +104,8 @@ object.")
:input-slots
(
;;
(respondent (the bashee) :defaulting)
(
respondent
(
the
bashee
))
(
respondent
(
the
bashee
)
:defaulting
)
;;
(respondent (the bashee))
(
"GDL object. Default object to which control will return with the write-back-link method"
return-object
(
the
:parent
))
...
...
gwl/source/cl-pdf-patches.lisp
deleted
100644 → 0
View file @
0272a167
;;; cl-pdf copyright 2002-2005 Marc Battyani see license.txt for the details
;;; You can reach me at marc.battyani@fractalconcept.com or marc@battyani.net
;;; The homepage of cl-pdf is here: http://www.fractalconcept.com/asp/html/cl-pdf.html
(
in-package
:pdf
)
#+
nil
(
defmethod
write-object
((
obj
indirect-object
)
&optional
root-level
)
(
gdl:print-variables
*pdf-stream*
)
(
if
root-level
(
progn
(
vector-push-extend
(
format
nil
"~10,'0d ~5,'0d n "
;;FLAG -- DJC added conditional for allegro to handle aserve streams
#+
allegro
(
typecase
*pdf-stream*
((
excl::hiper-socket-stream
net.aserve::chunking-stream
)
(
force-output
*pdf-stream*
)
(
excl::socket-bytes-written
*pdf-stream*
))
(
otherwise
(
file-position
*pdf-stream*
)))
#+
lispworks
(
if
(
typep
*pdf-stream*
'acl-compat.socket::bidirectional-binary-socket-stream
)
(
progn
(
force-output
*pdf-stream*
)
(
acl-compat.socket::stream-file-position
*pdf-stream*
))
(
file-position
*pdf-stream*
))
#-
(
or
allegro
lispworks
)
(
file-position
*pdf-stream*
)
(
gen-number
obj
))
*xrefs*
)
(
format
*pdf-stream*
"~d ~d obj~%"
(
obj-number
obj
)(
gen-number
obj
))
(
when
(
content
obj
)(
write-object
(
content
obj
)))
(
write-string
"endobj"
*pdf-stream*
)
(
write-char
#\Newline
*pdf-stream*
))
(
format
*pdf-stream*
"~d ~d R"
(
obj-number
obj
)(
gen-number
obj
))))
#+
nil
(
defmethod
write-document
((
s
stream
)
&optional
(
document
*document*
))
(
gdl:print-variables
s
)
(
let
((
*xrefs*
(
make-array
10
:adjustable
t
:fill-pointer
0
))
startxref
(
*pdf-stream*
s
))
;;(with-standard-io-syntax
#+
lispworks
(
if
(
typep
s
'acl-compat.socket::bidirectional-binary-socket-stream
)
(
setf
acl-compat.socket::*socket-bytes-written*
0
))
(
let
((
*read-default-float-format*
'double-float
))
(
process-outlines
document
)
(
vector-push-extend
"0000000000 65535 f "
*xrefs*
)
(
write-line
+pdf-header+
*pdf-stream*
)
(
loop
for
obj
across
(
objects
document
)
for
first
=
t
then
nil
if
obj
do
(
write-object
obj
t
)
else
do
(
unless
first
(
vector-push-extend
"0000000000 00001 f "
*xrefs*
)))
;;(setf startxref (file-position s))
(
setf
startxref
#+
allegro
(
typecase
*pdf-stream*
((
excl::hiper-socket-stream
net.aserve::chunking-stream
)
(
force-output
*pdf-stream*
)
(
excl::socket-bytes-written
*pdf-stream*
))
(
otherwise
(
file-position
*pdf-stream*
)))
#+
lispworks
(
if
(
typep
s
'acl-compat.socket::bidirectional-binary-socket-stream
)
(
progn
(
force-output
s
)
(
acl-compat.socket::stream-file-position
s
))
(
file-position
s
))
#-
(
or
allegro
lispworks
)
(
file-position
s
))
(
unless
startxref
(
setf
startxref
(
file-position
s
)))
(
format
*pdf-stream*
"xref~%0 ~d~%"
(
length
*xrefs*
))
(
loop
for
xref
across
*xrefs*
do
(
write-line
xref
s
))
(
format
s
"trailer~%<< /Size ~d~%/Root "
(
length
*xrefs*
))
;(1- (length (objects document))))
(
write-object
(
catalog
document
))
(
when
(
docinfo
document
)
(
format
s
" /Info "
)
(
write-object
(
docinfo
document
)))
(
format
s
"~%>>~%startxref~%~d~%%%EOF~%"
startxref
))))
gwl/source/remote-object.lisp
View file @
1409b24f
...
...
@@ -282,11 +282,7 @@
;; FIXME: better way to get this ?
(
when
(
boundp
'*wserver*
)
(
let
((
sock
(
wserver-socket
*wserver*
)))
(
when
sock
#+
allegro
(
socket:local-host
sock
)
#-
allegro
(
acl-compat.socket:local-host
sock
)))))
(
when
sock
(
glisp:local-host
sock
)))))
(
defun
encode-object-for-http
(
item
id
)
(
list
:remote-gdl-instance
...
...
gwl/static/3rdpty/x3dom/x3dom-dev.js
→
gwl/static/3rdpty/x3dom
-1.6.2
/x3dom-dev.js
View file @
1409b24f
File moved
gwl/static/3rdpty/x3dom-1.6.2/x3dom.css
0 → 100644
View file @
1409b24f
/*
* X3DOM JavaScript Library
* http://www.x3dom.org
*
* (C)2009 Fraunhofer IGD, Darmstadt, Germany
* Dual licensed under the MIT and GPL
*
* Based on code originally provided by
* Philip Taylor: http://philip.html5.org
*/
body
{
background-color
:
white
;
font-family
:
Helvetica
,
sans-serif
;
font-size
:
12px
;
}
X3D
,
x3d
{
position
:
relative
;
/* in order to be able to position stat-div within X3D */
float
:
left
;
/* float the element so it has the same size like the canvas */
cursor
:
pointer
;
margin
:
0
;
padding
:
0
;
border
:
1px
solid
#000
;
}
object
{
margin
:
0
;
padding
:
0
;
border
:
none
;
z-index
:
0
;
width
:
100%
;
height
:
100%
;
float
:
left
;
}
X3D
:hover
,
x3d
:hover
,
.x3dom-canvas
:hover
{
-webkit-user-select
:
none
;
-webkit-touch-callout
:
none
;
}
.x3dom-canvas
{
border
:
none
;
cursor
:
pointer
;
cursor
:
-webkit-grab
;
cursor
:
grab
;
width
:
100%
;
height
:
100%
;
float
:
left
;
}
.x3dom-canvas-mousedown
{
cursor
:
-webkit-grabbing
;
cursor
:
grabbing
;
}
.x3dom-canvas
:focus
{
outline
:
none
;
}
.x3dom-progress
{
margin
:
0
;
padding
:
6px
8px
0px
26px
;
left
:
0px
;
top
:
0px
;
position
:
absolute
;
color
:
#0f0
;
font-family
:
Helvetica
,
sans-serif
;
line-height
:
10px
;
font-size
:
10px
;
min-width
:
45px
;
min-height
:
20px
;
border
:
0px
;
background-position
:
4px
4px
;
background-repeat
:
no-repeat
;
background-color
:
#333
;
background-color
:
rgba
(
51
,
51
,
51
,
0.9
);
z-index
:
100
;
background-image
:
url('data:image/gif;base64,R0lGODlhEAAQAPQAADMzM////z4+Po+Pj0pKSsbGxpycnP///7e3t+Hh4XR0dGZmZu7u7oGBgfr6+tLS0qqqqgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH/C05FVFNDQVBFMi4wAwEAAAAh/hpDcmVhdGVkIHdpdGggYWpheGxvYWQuaW5mbwAh+QQJCgAAACwAAAAAEAAQAAAFdyAgAgIJIeWoAkRCCMdBkKtIHIngyMKsErPBYbADpkSCwhDmQCBethRB6Vj4kFCkQPG4IlWDgrNRIwnO4UKBXDufzQvDMaoSDBgFb886MiQadgNABAokfCwzBA8LCg0Egl8jAggGAA1kBIA1BAYzlyILczULC2UhACH5BAkKAAAALAAAAAAQABAAAAV2ICACAmlAZTmOREEIyUEQjLKKxPHADhEvqxlgcGgkGI1DYSVAIAWMx+lwSKkICJ0QsHi9RgKBwnVTiRQQgwF4I4UFDQQEwi6/3YSGWRRmjhEETAJfIgMFCnAKM0KDV4EEEAQLiF18TAYNXDaSe3x6mjidN1s3IQAh+QQJCgAAACwAAAAAEAAQAAAFeCAgAgLZDGU5jgRECEUiCI+yioSDwDJyLKsXoHFQxBSHAoAAFBhqtMJg8DgQBgfrEsJAEAg4YhZIEiwgKtHiMBgtpg3wbUZXGO7kOb1MUKRFMysCChAoggJCIg0GC2aNe4gqQldfL4l/Ag1AXySJgn5LcoE3QXI3IQAh+QQJCgAAACwAAAAAEAAQAAAFdiAgAgLZNGU5joQhCEjxIssqEo8bC9BRjy9Ag7GILQ4QEoE0gBAEBcOpcBA0DoxSK/e8LRIHn+i1cK0IyKdg0VAoljYIg+GgnRrwVS/8IAkICyosBIQpBAMoKy9dImxPhS+GKkFrkX+TigtLlIyKXUF+NjagNiEAIfkECQoAAAAsAAAAABAAEAAABWwgIAICaRhlOY4EIgjH8R7LKhKHGwsMvb4AAy3WODBIBBKCsYA9TjuhDNDKEVSERezQEL0WrhXucRUQGuik7bFlngzqVW9LMl9XWvLdjFaJtDFqZ1cEZUB0dUgvL3dgP4WJZn4jkomWNpSTIyEAIfkECQoAAAAsAAAAABAAEAAABX4gIAICuSxlOY6CIgiD8RrEKgqGOwxwUrMlAoSwIzAGpJpgoSDAGifDY5kopBYDlEpAQBwevxfBtRIUGi8xwWkDNBCIwmC9Vq0aiQQDQuK+VgQPDXV9hCJjBwcFYU5pLwwHXQcMKSmNLQcIAExlbH8JBwttaX0ABAcNbWVbKyEAIfkECQoAAAAsAAAAABAAEAAABXkgIAICSRBlOY7CIghN8zbEKsKoIjdFzZaEgUBHKChMJtRwcWpAWoWnifm6ESAMhO8lQK0EEAV3rFopIBCEcGwDKAqPh4HUrY4ICHH1dSoTFgcHUiZjBhAJB2AHDykpKAwHAwdzf19KkASIPl9cDgcnDkdtNwiMJCshACH5BAkKAAAALAAAAAAQABAAAAV3ICACAkkQZTmOAiosiyAoxCq+KPxCNVsSMRgBsiClWrLTSWFoIQZHl6pleBh6suxKMIhlvzbAwkBWfFWrBQTxNLq2RG2yhSUkDs2b63AYDAoJXAcFRwADeAkJDX0AQCsEfAQMDAIPBz0rCgcxky0JRWE1AmwpKyEAIfkECQoAAAAsAAAAABAAEAAABXkgIAICKZzkqJ4nQZxLqZKv4NqNLKK2/Q4Ek4lFXChsg5ypJjs1II3gEDUSRInEGYAw6B6zM4JhrDAtEosVkLUtHA7RHaHAGJQEjsODcEg0FBAFVgkQJQ1pAwcDDw8KcFtSInwJAowCCA6RIwqZAgkPNgVpWndjdyohACH5BAkKAAAALAAAAAAQABAAAAV5ICACAimc5KieLEuUKvm2xAKLqDCfC2GaO9eL0LABWTiBYmA06W6kHgvCqEJiAIJiu3gcvgUsscHUERm+kaCxyxa+zRPk0SgJEgfIvbAdIAQLCAYlCj4DBw0IBQsMCjIqBAcPAooCBg9pKgsJLwUFOhCZKyQDA3YqIQAh+QQJCgAAACwAAAAAEAAQAAAFdSAgAgIpnOSonmxbqiThCrJKEHFbo8JxDDOZYFFb+A41E4H4OhkOipXwBElYITDAckFEOBgMQ3arkMkUBdxIUGZpEb7kaQBRlASPg0FQQHAbEEMGDSVEAA1QBhAED1E0NgwFAooCDWljaQIQCE5qMHcNhCkjIQAh+QQJCgAAACwAAAAAEAAQAAAFeSAgAgIpnOSoLgxxvqgKLEcCC65KEAByKK8cSpA4DAiHQ/DkKhGKh4ZCtCyZGo6F6iYYPAqFgYy02xkSaLEMV34tELyRYNEsCQyHlvWkGCzsPgMCEAY7Cg04Uk48LAsDhRA8MVQPEF0GAgqYYwSRlycNcWskCkApIyEAOwAAAAAAAAAAAA==')
;
}
.x3dom-progress.bar
span
{
position
:
absolute
;
left
:
0
;
top
:
0
;
line-height
:
20px
;
background-color
:
red
;
}
.x3dom-statdiv
{
margin
:
0
;
padding
:
0
;
right
:
10px
;
top
:
10px
;
position
:
absolute
;
color
:
#0f0
;
font-family
:
Helvetica
,
sans-serif
;
line-height
:
10px
;
font-size
:
10px
;
width
:
75px
;
height
:
70px
;
border
:
0px
;
}
#x3dom-state-canvas
{
margin
:
2px
;
padding
:
0
;
right
:
0%
;
top
:
0%
;
position
:
absolute
;
}
#x3dom-state-viewer
{
position
:
absolute
;
margin
:
2px
;
padding
:
5px
;
width
:
135px
;
top
:
0%
;
right
:
0%
;
opacity
:
0.9
;
background-color
:
#323232
;
z-index
:
1000
;
font-family
:
Arial
,
sans-serif
;
color
:
#C8C8C8
;
font-weight
:
bold
;
text-transform
:
uppercase
;
cursor
:
help
;
}
.x3dom-states-head
{
display
:
block
;
font-size
:
26px
;
}
.x3dom-states-rendermode-software
{
font-size
:
10px
;
margin
:
0
0
2px
2px
;
}
.x3dom-states-rendermode-hardware
{
font-size
:
10px
;
margin
:
0
0
2px
2px
;
}
.x3dom-states-head2
{
font-size
:
10px
;
}
.x3dom-states-list
{
float
:
left
;
width
:
100%
;
border-top
:
1px
solid
#C8C8C8
;
list-style
:
none
;
font-size
:
9px
;
line-height
:
16px
;
margin
:
0
;
padding
:
0
;
padding-top
:
2px
;
}
.x3dom-states-item
{
width
:
100%
;
float
:
left
;
}
.x3dom-states-item-title
{
float
:
left
;
margin-left
:
2px
;
}
.x3dom-states-item-value
{
float
:
right
;
margin-right
:
2px
;
}
.x3dom-touch-marker
{
display
:
inline
;
padding
:
5px
;
border-radius
:
10px
;
position
:
absolute
;
font-family
:
Helvetica
,
sans-serif
;
line-height
:
10px
;
font-size
:
10px
;
color
:
darkorange
;
background
:
cornsilk
;
opacity
:
0.6
;
border
:
2px
solid
orange
;
z-index
:
200
;
}
.x3dom-logContainer
{
border
:
2px
solid
olivedrab
;
height
:
200px
;
padding
:
4px
;
overflow
:
auto
;
white-space
:
pre-wrap
;
font-family
:
sans-serif
;
font-size
:
x-small
;
color
:
#00ff00
;
background-color
:
black
;
margin-right
:
10px
;
}
.x3dom-nox3d
{
font-family
:
Helvetica
,
sans-serif
;
font-size
:
14px
;
background-color
:
#eb7a7a
;
padding
:
1em
;
opacity
:
0.75
;
}
.x3dom-nox3d
p
{
color
:
#fff
;
font-size
:
14px
;
}
.x3dom-nox3d
a
{
color
:
#fff
;
font-size
:
14px
;
}
/* self-clearing floats */
.group
:after
{
content
:
"."
;
display
:
block
;
height
:
0
;
clear
:
both
;
visibility
:
hidden
;