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
e032ccab
Commit
e032ccab
authored
Jul 25, 2014
by
Dave Cooper
Browse files
starting to add scad support; refresh ta2 to work with all current implementations
parent
4594174e
Changes
28
Hide whitespace changes
Inline
Side-by-side
apps/ta2/source/ajax.lisp
View file @
e032ccab
...
...
@@ -45,7 +45,7 @@
(
plist
(
gwl::assoc-list-to-plist
query
))
(
object
(
the
root-object
(
follow-root-path
(
read-safe-string
(
base64-decode-safe
(
getf
plist
:rootPath
)))))))
(
base64-decode-safe
(
getf
plist
:
|
rootPath
|
)))))))
(
the
(
perform-action!
object
))
...
...
@@ -63,7 +63,7 @@
(
self
(
first
(
gethash
(
make-keyword
iid
)
gwl:*instance-hash-table*
)))
(
self
(
reset-self
self
))
(
plist
(
gwl::assoc-list-to-plist
query
)))
(
let
((
root-path
(
getf
plist
:rootPath
)))
(
let
((
root-path
(
getf
plist
:
|
rootPath
|
)))
(
setq
root-path
(
base64-decode-safe
root-path
))
(
when
*debug?*
(
print-variables
self
root-path
))
...
...
@@ -85,8 +85,8 @@
(
self
(
first
(
gethash
(
make-keyword
iid
)
gwl:*instance-hash-table*
)))
(
self
(
reset-self
self
))
(
plist
(
gwl::assoc-list-to-plist
query
))
(
message
(
make-keyword
(
base64-decode-safe
(
getf
plist
:message
)))))
(
print-variables
plist
message
)
(
message
(
make-keyword
(
base64-decode-safe
(
getf
plist
:
|
message
|
)))))
(
with-http-response
(
req
ent
:content-type
"text/xml"
)
(
with-http-body
(
req
ent
)
(
with-html-output
(
*html-stream*
nil
)
...
...
@@ -106,9 +106,10 @@
(
self
(
first
(
gethash
(
make-keyword
iid
)
gwl:*instance-hash-table*
)))
(
self
(
reset-self
self
))
(
plist
(
gwl::assoc-list-to-plist
query
))
(
slot
(
make-keyword
(
getf
plist
:control
)))
(
value
(
getf
plist
:value
)))
(
slot
(
make-keyword
(
getf
plist
:
|
control
|
)))
(
value
(
getf
plist
:
|
value
|
)))
(
if
(
eql
(
read-safe-string
value
)
'gdl::restore-default
)
(
the
click-mode
(
restore-slot-default!
slot
))
(
the
click-mode
(
set-slot-if-needed!
slot
value
)))
...
...
@@ -126,13 +127,13 @@
(
self
(
first
(
gethash
(
make-keyword
iid
)
gwl:*instance-hash-table*
)))
(
self
(
reset-self
self
))
(
plist
(
gwl::assoc-list-to-plist
query
))
(
root-path
(
base64-decode-list
(
getf
plist
:rootPath
)))
(
root-path
(
base64-decode-list
(
getf
plist
:
|
rootPath
|
)))
(
object
(
the
root-object
(
follow-root-path
root-path
)))
(
plist
(
remove-plist-key
(
remove-plist-key
plist
:iid
)
:rootPath
)))
(
plist
(
remove-plist-key
(
remove-plist-key
plist
:
|
iid
|
)
:
|
rootPath
|
)))
(
let
((
keys
(
read-safe-string
(
getf
plist
:keys
)))
(
values
(
base64-decode-list
(
getf
plist
:values
))))
(
let
((
keys
(
read-safe-string
(
getf
plist
:
|
keys
|
)))
(
values
(
base64-decode-list
(
getf
plist
:
|
values
|
))))
(
mapc
#'
(
lambda
(
key
value
)
(
the-object
object
(
set-slot-if-needed!
key
value
:infer-types?
nil
)))
keys
values
))
...
...
@@ -156,10 +157,10 @@
(
self
(
first
(
gethash
(
make-keyword
iid
)
gwl:*instance-hash-table*
)))
(
self
(
reset-self
self
))
(
plist
(
gwl::assoc-list-to-plist
query
))
(
root-path
(
read-safe-string
(
getf
plist
:rootPath
)))
(
root-path
(
read-safe-string
(
getf
plist
:
|
rootPath
|
)))
(
object
(
the
(
follow-root-path
root-path
)))
(
slot
(
read-safe-string
(
getf
plist
:control
)))
(
value
(
getf
plist
:value
)))
(
slot
(
read-safe-string
(
getf
plist
:
|
control
|
)))
(
value
(
getf
plist
:
|
value
|
)))
(
if
(
eql
(
read-safe-string
value
)
'gdl::restore-default
)
...
...
@@ -185,7 +186,7 @@
(
self
(
first
(
gethash
(
make-keyword
iid
)
gwl:*instance-hash-table*
)))
(
self
(
reset-self
self
))
(
plist
(
gwl::assoc-list-to-plist
query
))
(
mode
(
make-keyword
(
getf
plist
:mode
))))
(
mode
(
make-keyword
(
getf
plist
:
|
mode
|
))))
(
the
tree
(
set-slot!
:expand-mode
mode
))
...
...
@@ -203,7 +204,7 @@
(
self
(
first
(
gethash
(
make-keyword
iid
)
gwl:*instance-hash-table*
)))
(
self
(
reset-self
self
))
(
plist
(
gwl::assoc-list-to-plist
query
))
(
mode
(
getf
plist
:mode
)))
(
mode
(
getf
plist
:
|
mode
|
)))
(
setq
self
(
the
click-mode
))
...
...
@@ -275,14 +276,15 @@
(
self
(
first
(
gethash
(
make-keyword
iid
)
gwl:*instance-hash-table*
)))
(
self
(
reset-self
self
))
(
plist
(
gwl::assoc-list-to-plist
query
))
(
self
(
the
(
follow-root-path
(
read-safe-string
(
getf
plist
:rootPath
))))))
(
self
(
the
(
follow-root-path
(
read-safe-string
(
getf
plist
:
|
rootPath
|
))))))
;;
;; FLAG -- this is internal stuff, should be handled by a simple function on the self object.
;;
(
let
((
local-point
(
make-point
(
-
(
parse-integer
(
getf
plist
:x
))
(
half
(
the
view-object
width
)))
(
let
((
y
(
-
(
the
view-object
length
)
(
parse-integer
(
getf
plist
:y
)))))
(
let
((
local-point
(
make-point
(
-
(
parse-integer
(
getf
plist
:|x|
))
(
half
(
the
view-object
width
)))
(
let
((
y
(
-
(
the
view-object
length
)
(
parse-integer
(
getf
plist
:|y|
)))))
(
-
y
(
half
(
the
view-object
length
)))))))
(
let
((
digitized-point
(
add-vectors
(
the
view-object
user-center
)
...
...
apps/ta2/source/click-mode.lisp
View file @
e032ccab
...
...
@@ -177,17 +177,17 @@
((
:img
:border
nil
:src
(
format
nil
"/images/gwl/~a"
image-file
))))))))
(
:td
((
:table
:border
0
:cellpadding
0
:cellspacing
0
)
(
mapc
#'
(
lambda
(
selector
image
)
(
html
(
:tr
(
:td
((
:span
:style
"cursor: pointer;"
:title
"Set Line Thickness"
:onclick
(
format
nil
"return ta2setcontrol('~a', '~s', '~a');"
(
the
instance-id
)
:line-thickness
(
the-object
selector
line-thickness
)))
((
:img
:border
0
:src
(
format
nil
"/images/gwl/~a"
image
)))))))
)
(
:tr
(
mapc
#'
(
lambda
(
selector
image
)
(
html
(
:td
((
:span
:style
"cursor: pointer;"
:title
"Set Line Thickness"
:onclick
(
format
nil
"return ta2setcontrol('~a', '~s', '~a');"
(
the
instance-id
)
:line-thickness
(
the-object
selector
line-thickness
)))
((
:img
:border
0
:src
(
format
nil
"/images/gwl/~a"
image
)))))))
(
list-elements
(
the
line-thickness-selectors
))
(
list
"line-1.gif"
"line-1.gif"
"line-2.gif"
"line-3.gif"
"line-4.gif"
))))
(
list
"line-1.gif"
"line-1.gif"
"line-2.gif"
"line-3.gif"
"line-4.gif"
))))
)
(
:td
...
...
apps/ta2/ta2.asd
View file @
e032ccab
...
...
@@ -5,13 +5,13 @@
:description
"The Gendl™ (legacy) Testing and Tracking Utility, version 2 (using Ajax but pre-gdlAjax, and no JQuery or CSS)"
:author
"
Dave Cooper
"
"
Genworks International
"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"201406
19
"
"201406
25
"
:depends-on
(
:gwl-graphics
)
#-
asdf-unicode
:defsystem-depends-on
#-
asdf-unicode
(
:asdf-encodings
)
...
...
apps/ta2/to-do.txt
deleted
100755 → 0
View file @
4594174e
1. Why do some slots and the tree get unevaluated when doing a refresh and/or update?
2. Make inspector values which are GDL objects be selectable.
3. Make slot values which are sequences be selectable, and replace
with scrolling area with elements from sequence.
4. Make each area easily resizeable.
5. Make the areas reconfigurable/rearrangeable.
6. In general: add professional design look to ta2.
7. Trap errors in geometry display-list.
8. Wrap names in inspector column (shrink its width somehow).
9. Handle updates after an object is removed from the tree.
to replicate:
1. add a new child to the tree
2. update and draw the leaves
3. remove the object in the code
4. update the ta2/tatu browser
10. More robust error message for non-expanding nodes in tree, which
work in IE.
11. Add the measure-distance capability in a friendly way.
apps/tasty/tasty.asd
View file @
e032ccab
...
...
@@ -5,13 +5,13 @@
:description
"The Gendl™ Web-based Development Environment (tasty)"
:author
"
Dave Cooper
"
"
Genworks International
"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"201406
19
"
"201406
25
"
:depends-on
(
:tree
:gwl-graphics
)
#-
asdf-unicode
:defsystem-depends-on
#-
asdf-unicode
(
:asdf-encodings
)
...
...
apps/translators/translators.asd
View file @
e032ccab
...
...
@@ -5,13 +5,13 @@
:description
"The Gendl™ Translators to/from XML and potentially other high-level KBE and Knowledge formats"
:author
"
Dave Cooper
"
"
Genworks International
"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"201406
19
"
"201406
25
"
:depends-on
(
:gwl
)
#-
asdf-unicode
:defsystem-depends-on
#-
asdf-unicode
(
:asdf-encodings
)
...
...
apps/tree/tree.asd
View file @
e032ccab
...
...
@@ -5,13 +5,13 @@
:description
"The Gendl™ Tree component used by Tasty and potentially as a UI component on its own"
:author
"
Dave Cooper
"
"
Genworks International
"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"201406
19
"
"201406
25
"
:depends-on
(
:gwl-graphics
)
#-
asdf-unicode
:defsystem-depends-on
#-
asdf-unicode
(
:asdf-encodings
)
...
...
apps/yadd/yadd.asd
View file @
e032ccab
...
...
@@ -5,13 +5,13 @@
:description
"The Gendl™ Yet Another Definition Documenter (yadd)"
:author
"
Dave Cooper
"
"
Genworks International
"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"201406
19
"
"201406
25
"
:depends-on
(
:gwl-graphics
#-
allegro
:cl-html-parse
)
#-
asdf-unicode
:defsystem-depends-on
#-
asdf-unicode
(
:asdf-encodings
)
...
...
base/base.asd
View file @
e032ccab
...
...
@@ -5,13 +5,13 @@
:description
"The Gendl™ Base Core Kernel Engine"
:author
"
Dave Cooper
"
"
Genworks International
"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"201406
19
"
"201406
25
"
:depends-on
nil
#-
asdf-unicode
:defsystem-depends-on
#-
asdf-unicode
(
:asdf-encodings
)
...
...
base/source/package.lisp
View file @
e032ccab
...
...
@@ -564,6 +564,7 @@ If you are interested in this effort we would love to hear from you at open-sour
#:jpeg
#:vrml
#:x3d
#:scad
#:vector-graphics
...
...
cl-lite/cl-lite.asd
View file @
e032ccab
...
...
@@ -5,13 +5,13 @@
:description
"The Gendl™ Compile-and-Load Lite Utility"
:author
"
Dave Cooper
"
"
Genworks International
"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"201406
19
"
"201406
25
"
:depends-on
(
:glisp
)
#-
asdf-unicode
:defsystem-depends-on
#-
asdf-unicode
(
:asdf-encodings
)
...
...
demos/bus/bus.asd
View file @
e032ccab
...
...
@@ -5,13 +5,13 @@
:description
"The Gendl™ Wireframe School Bus Demo"
:author
"
Dave Cooper
"
"
Genworks International
"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"201406
19
"
"201406
25
"
:depends-on
(
:gwl-graphics
)
#-
asdf-unicode
:defsystem-depends-on
#-
asdf-unicode
(
:asdf-encodings
)
...
...
demos/ledger/ledger.asd
View file @
e032ccab
...
...
@@ -5,13 +5,13 @@
:description
"The Gendl™ Ledger Bookkeeping Demo"
:author
"
Dave Cooper
"
"
Genworks International
"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"201406
19
"
"201406
25
"
:depends-on
(
#-
gwl
:gwl
)
#-
asdf-unicode
:defsystem-depends-on
#-
asdf-unicode
(
:asdf-encodings
)
...
...
demos/robot/robot.asd
View file @
e032ccab
...
...
@@ -5,13 +5,13 @@
:description
"The Gendl™ Simplified Android Robot example "
:author
"
Dave Cooper
"
"
Genworks International
"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"201406
19
"
"201406
25
"
:depends-on
(
:gwl-graphics
)
#-
asdf-unicode
:defsystem-depends-on
#-
asdf-unicode
(
:asdf-encodings
)
...
...
demos/wire-world/wire-world.asd
View file @
e032ccab
...
...
@@ -5,13 +5,13 @@
:description
"The Gendl™ Wire-World demo and test-case for wireframe tessellation and X3D output"
:author
"
Dave Cooper
"
"
Genworks International
"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"201406
19
"
"201406
25
"
:depends-on
(
#-
gwl-graphics
:gwl-graphics
)
#-
asdf-unicode
:defsystem-depends-on
#-
asdf-unicode
(
:asdf-encodings
)
...
...
documentation/training/g102-tud/examples/examples.asd
View file @
e032ccab
...
...
@@ -5,13 +5,13 @@
:description
"The Gendl™ examples Subsystem"
:author
"
Dave Cooper
"
"
Genworks International
"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"201406
19
"
"201406
25
"
:depends-on
(
:gwl-graphics
:surf
)
#-
asdf-unicode
:defsystem-depends-on
#-
asdf-unicode
(
:asdf-encodings
)
...
...
geom-base/geom-base.asd
View file @
e032ccab
...
...
@@ -5,13 +5,13 @@
:description
"The Gendl™ Wireframe Geometry"
:author
"
Dave Cooper
"
"
Genworks International
"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"201406
19
"
"201406
25
"
:depends-on
(
:glisp
)
#-
asdf-unicode
:defsystem-depends-on
#-
asdf-unicode
(
:asdf-encodings
)
...
...
@@ -83,6 +83,7 @@
(
:file
"graphs/source/graph"
)
(
:file
"graphs/source/legend"
)
(
:file
"graphs/source/pie-chart"
)
(
:file
"lenses/source/scad"
)
(
:file
"lenses/source/vrml"
)
(
:file
"lenses/source/x3d"
)
(
:file
"math/source/polynomial"
)
...
...
geom-base/lenses/source/scad.lisp
0 → 100644
View file @
e032ccab
;;
;; Copyright 2012 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
)
(
define-format
scad
(
base-format
))
(
defparameter
*scad-path*
(
cond
((
member
:macosx
*features*
)
"/Applications/OpenSCAD.app/Contents/MacOS/OpenSCAD"
)
((
member
:windows
*features*
)
"c:/program files/openscad/openscad.exe"
)))
(
defun
scad-to-png
(
scad-file
&key
(
png-file
(
make-pathname
:type
"png"
:defaults
scad-file
))
camera-point
center-point
image-width
image-height
(
projection
:ortho
))
(
unless
(
probe-file
*scad-path*
)
(
error
"OpenSCAD executable not found at ~s. Please set geom-base::*scad-path*.~%"
*scad-path*
))
(
uiop:run-program
(
remove
nil
(
list
*scad-path*
"--preview=throwntogether"
"-o"
(
namestring
png-file
)
(
when
(
and
camera-point
center-point
)
(
format
nil
"--camera=eye~a,~a,~a,center~a,~a,~a"
(
get-x
camera-point
)
(
get-y
camera-point
)
(
get-z
camera-point
)
(
get-x
center-point
)
(
get-y
center-point
)
(
get-z
center-point
)))
(
when
(
and
image-width
image-height
)
(
format
nil
"--imgsize=~a,~a"
image-width
image-height
))
(
when
projection
(
format
nil
"--projection=~a"
(
ecase
projection
(
:ortho
"o"
)
(
:perspective
"p"
))))
(
namestring
(
translate-logical-pathname
scad-file
)))))
png-file
)
(
define-lens
(
scad
base-object
)()
:output-functions
((
transform
())
(
rgb-color
()
(
let
((
decimal
(
lookup-color
(
getf
(
the
display-controls
)
:color
)
:format
:decimal
))
(
transparency
(
getf
(
the
display-controls
)
:transparency
)))
(
let
((
*read-default-float-format*
'single-float
))
(
format
*stream*
"~&color([~a,~a,~a,~a])~%"
(
svref
decimal
0
)
(
svref
decimal
1
)
(
svref
decimal
2
)
(
-
1
(
or
transparency
0
))))))
(
cad-output
()
(
write-the
(
cad-output-tree
)))
(
cad-output-tree
()
(
write-the
rgb-color
)
(
format
*stream*
"~&{~%"
)
(
if
(
null
(
the
children
))
(
write-the
shape
)
(
mapc
#'
(
lambda
(
child
)
(
write-the-object
child
(
cad-output-tree
:from-root?
nil
)))
(
the
children
)))
(
format
*stream*
"~&}~%"
))))
(
define-lens
(
scad
ifs-output-mixin
)()
:output-functions
((
shape
()
(
format
*stream*
"~&polyhedron(~%"
)
(
format
*stream*
"~&points = [~{[~{~a~^,~}]~^,~}],~%"
(
map
'list
#'
(
lambda
(
point
)
(
list
(
get-x
point
)
(
get-y
point
)
(
get-z
point
)))
(
the
ifs-array
)))
(
format
*stream*
"~&faces = [~{[~{~a~^,~}]~^,~}]~%"
;;(mapcar #'reverse (the ifs-indices))
(
the
ifs-indices
)
)
(
format
*stream*
"~&);~%"
)
())))
geom-base/lenses/source/x3d.lisp
View file @
e032ccab
...
...
@@ -450,8 +450,8 @@
(
cl-who:with-html-output
(
*stream*
nil
:indent
nil
)
((
:|Shape|
(
:|Appearance|
(
write-the
material-properties
)))
((
:|IndexedLineSet|
:coordIndex
(
format
nil
"~{~a ~}-1"
indices
))
((
:|Coordinate|
:point
(
format
nil
"~{~a~^ ~}"
((
:|IndexedLineSet|
:
|
coordIndex
|
(
format
nil
"~{~a ~}-1"
indices
))
((
:|Coordinate|
:
|
point
|
(
format
nil
"~{~a~^ ~}"
(
mapcar
#'
(
lambda
(
point
)
(
format
nil
"~a ~a ~a"
(
get-x
point
)
(
get-y
point
)
...
...
geom-base/wire/source/global-polygon-projection.lisp
View file @
e032ccab
...
...
@@ -155,7 +155,7 @@ each direction.</li>
(
dolist
(
polygon
(
the
polygons-for-ifs
)
ht
)
(
dolist
(
vertex
polygon
)
(
let
((
current
(
gethash
vertex
ht
)))
(
unless
current
(
unless
current
(
setf
(
gethash
vertex
ht
)
(
incf
count
)))))))))
(
ifs-array
(
when
(
the
polygons-for-ifs
)
...
...
Prev
1
2
Next
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