Commit e032ccab authored by Dave Cooper's avatar Dave Cooper

starting to add scad support; refresh ta2 to work with all current implementations

parent 4594174e
......@@ -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)
......
......@@ -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
......
......@@ -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
"20140619"
"20140625"
:depends-on
(:gwl-graphics)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
......
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.
......@@ -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
"20140619"
"20140625"
:depends-on
(:tree :gwl-graphics)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
......
......@@ -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
"20140619"
"20140625"
:depends-on
(:gwl)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
......
......@@ -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
"20140619"
"20140625"
:depends-on
(:gwl-graphics)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
......
......@@ -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
"20140619"
"20140625"
:depends-on
(:gwl-graphics #-allegro :cl-html-parse)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
......
......@@ -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
"20140619"
"20140625"
:depends-on
nil
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
......
......@@ -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
......
......@@ -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
"20140619"
"20140625"
:depends-on
(:glisp)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
......
......@@ -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
"20140619"
"20140625"
:depends-on
(:gwl-graphics)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
......
......@@ -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
"20140619"
"20140625"
:depends-on
(#-gwl :gwl)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
......
......@@ -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
"20140619"
"20140625"
:depends-on
(:gwl-graphics)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
......
......@@ -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
"20140619"
"20140625"
:depends-on
(#-gwl-graphics :gwl-graphics)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
......
......@@ -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
"20140619"
"20140625"
:depends-on
(:gwl-graphics :surf)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
......
......@@ -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
"20140619"
"20140625"
: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")
......
;;
;; 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* "~&);~%")
())))
......@@ -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)
......
......@@ -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)
......
......@@ -147,7 +147,8 @@
(horizontal-increment-angle (/ (the horizontal-start-to-end-angle) (the number-of-horizontal-sections)))
(simple? (and (not (the inner-radius))
(simple? nil #+nil
(and (not (the inner-radius))
(near-to? (the start-horizontal-arc) 0)
(near-to? (the end-horizontal-arc) 2pi)
(near-to? (the start-vertical-arc) (- pi/2))
......@@ -173,7 +174,7 @@
(push inner-result result)))))
(polygons-for-ifs (unless (the simple?)
(polygons-for-ifs (unless nil ;;(the simple?)
(append
(apply #'append
(mapcar #'(lambda(list1 list2)
......
......@@ -5,13 +5,13 @@
:description
"The Gendl™ Common Lisp Portability"
:author
"Dave Cooper"
"Genworks International"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"20140619"
"20140625"
: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)
......
......@@ -5,13 +5,13 @@
:description
"The Gendl™ GWL embedded graphics support"
:author
"Dave Cooper"
"Genworks International"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"20140619"
"20140625"
:depends-on
(:geom-base :gwl)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
......
......@@ -5,13 +5,13 @@
:description
"The Gendl™ Generative Web Language (GWL)"
:author
"Dave Cooper"
"Genworks International"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"20140619"
"20140625"
:depends-on
(:glisp :aserve)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
......
......@@ -5,13 +5,13 @@
:description
"The Gendl™ regression Subsystem"
:author
"Dave Cooper"
"Genworks International"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"20140619"
"20140625"
:depends-on
(:lift :surf :tasty)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
......
......@@ -53,24 +53,24 @@
3d-point-list)))
(cl-who:with-html-output (*stream* nil :indent nil)
(:Shape
(:Appearance (progn (if (getf (the display-controls) :pixel-texture)
(write-the pixel-texture)