Commit 9badfad4 authored by Dave Cooper's avatar Dave Cooper

added beginnings of plain SVG output-format.

fixed resizing of graphics in tasty and growlr.

Added FontAwesome CSS and any-resize.
parent d81b318f

Too many changes to show.

To preserve performance only 1000 of 1000+ files are displayed.

......@@ -448,7 +448,7 @@ The error was: ~a
((:div :class "inner-center ui-widget pane")
((:div :class "header ui-widget-header")"Viewport")
((:div :class "ui-widget-content")(str (the viewport main-div)))
((:div :class "ui-widget-content" :id "viewport")(str (the viewport main-div)))
((:div :class "footer ui-widget-header")
(str (the footer-ui-widget-header main-div))))
......
......@@ -320,6 +320,7 @@
(with-cl-who ()
(let ((*display-controls* (the display-controls-hash)))
(let ((image-format (if (the 2d-boxes?) (the image-format) :png)))
(ecase image-format
(:links (the (write-geometry-links)))
(:raphael (write-the vector-graphics))
......@@ -334,3 +335,4 @@
......@@ -442,7 +442,9 @@ If you are interested in this effort we would love to hear from you at open-sour
(:export #:keyed-transform*vector
#:with-translated-state
#:raphael
#:svg
#:*raphael-translation*
#:*svg-translation*
#:make-vector
#:make-point
#:apply-make-point
......
......@@ -36,7 +36,10 @@
(:pdf `(pdf:with-saved-state (pdf:translate (get-x ,center) (get-y ,center)) ,@body))
(:dxf `(let ((*dxf-translation* (add-vectors (subseq ,center 0 2) *dxf-translation*)))
,@body))
(:raphael `(let ((*raphael-translation* (add-vectors (subseq ,center 0 2) *raphael-translation*))) ,@body))))
(:raphael `(let ((*raphael-translation* (add-vectors (subseq ,center 0 2) *raphael-translation*))) ,@body))
(:svg `(let ((*svg-translation* (add-vectors (subseq ,center 0 2) *svg-translation*))) ,@body))
))
......
......@@ -26,3 +26,8 @@
(define-format raphael (vector-graphics)
:documentation (:author "David J Cooper Jr [Genworks]"
:description "Raphael is a small JavaScript library for vector graphics"))
(define-format svg (vector-graphics)
:documentation (:author "David J Cooper Jr [Genworks]"
:description "Direct SVG for inline inclusion in a web page or application"))
......@@ -165,6 +165,7 @@ the value of this parameter at your own risk.")
(defparameter *dxf-translation* (make-vector 0 0))
(defparameter *raphael-translation* (make-vector 0 0))
(defparameter *svg-translation* (make-vector 0 0))
(glisp:define-constant +rear-vector+ (make-vector 0 1 0))
(glisp:define-constant +top-vector+ (make-vector 0 0 1))
......
......@@ -151,6 +151,15 @@ value of the image-format-selector, which itself defaults to :raphael."
:background-color (the background-color)
:foreground-color (the foreground-color))
(write-the view-object cad-output))))))
(svg-string (unless (the no-graphics?)
(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
......@@ -325,6 +334,18 @@ The <tt>view-object</tt> child should exist and be of type <tt>web-drawing</tt>.
(with-cl-who ()
((:table :border (the viewport-border-default))
(:tr (:td (str (the graphics)))))))
(svg-vector-graphics
()
(with-cl-who ()
(when (typep (the :view-object) 'null-part)
(error "A valid :view-object of type web-drawing is
required in the sheet to call the :raphael-canvas method."))
(str (the svg-string))))
(vector-graphics
()
......@@ -342,7 +363,8 @@ required in the sheet to call the :raphael-canvas method."))
width: ~apx; */
overflow:hidden;
clip: rect(0px ~apx ~apx 0px);
position: relative;
z-index: 1;
/* position: relative; */
"
(if (the vector-graphics-onclick?)
"crosshair" "arrow")
......@@ -361,9 +383,10 @@ position: relative;
((:td :width (the :view-object :width) :height (the :view-object :length)
:align :center :valign :center)
(:big (:b "No Graphics Object Specified"))))))
(let ((raphael-string (the raphael-string)))
(htm ((:script :type "text/javascript")
(str raphael-string))))))))))
(let ((raphael-string (the raphael-string)))
(htm ((:script :type "text/javascript")
(str raphael-string))))))))))
("Void. Writes an embedded X3D tag and included content for the <tt>view-object</tt> child of this object.
......
......@@ -379,21 +379,28 @@ Default is <tt>:zoom-and-center</tt>"
(:zoom-and-center
(when *debug?* (format t "we are on zoom-and-center...~%"))
(when (member (the zoom-mode) (list :in :out))
(when *debug?* (format t "we are on zoom-and-center...~%"))
(when *debug?* (print-variables (the view-object width)
(the view-object length)))
(let ((out-of-bounds? (and (> x (- (the view-object width) 30))
(> y (- (the view-object length) 30)))))
(print-variables out-of-bounds?)
(when (and (not out-of-bounds?) (member (the zoom-mode) (list :in :out)))
(when *debug?* (format t "Zooming in the graphics...~%"))
(when *debug?* (format t "Zooming in the graphics...~%"))
(let ((zoom-factor (if (eql (the zoom-mode) :in)
(the zoom-factor)
(/ (the zoom-factor)))))
(let ((zoom-factor (if (eql (the zoom-mode) :in)
(the zoom-factor)
(/ (the zoom-factor)))))
(the view-object
(set-slot! :user-center (make-point (get-x digitized-point)
(get-y digitized-point))))
(set-slot! :user-center (make-point (get-x digitized-point)
(get-y digitized-point))))
(the view-object
(set-slot! :user-scale
(* (the view-object user-scale) zoom-factor)))))))))))
(set-slot! :user-scale
(* (the view-object user-scale) zoom-factor))))))))))))
("Void. Process the points selected by digitizing in the graphics. You can override this
......
;;
;; Copyright 2002-2011 Genworks International and Genworks BV
;;
;; 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/>.
;;
("package")
This diff is collapsed.
;;
;; 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 :gdl-user)
(gwl:define-package :svg (:use :geom-base))
......@@ -177,6 +177,10 @@ Default is nil."
("String of Javascript or nil. This Javascript will go into the :onpageshow event of the body.
Default is nil."
body-onpageshow nil)
("String of Javascript or nil. This Javascript will go into the :onresize event of the body.
Default is nil."
body-onresize nil)
("String or nil. Contains the string for the doctype at the top of the document.
Default is the standard doctype for HTML5 and later."
......@@ -315,7 +319,8 @@ from a saved snapshot file."
((:body :class (the body-class)
:onpageshow (the body-onpageshow)
:onload (the body-onload))
:onload (the body-onload)
:onresize (the body-onresize))
(the reset-html-sections!)
(str (the main-sheet-body))
......@@ -370,7 +375,7 @@ from a saved snapshot file."
()
(with-cl-who ()
((:span :style "color: blue; cursor: pointer;"
:onclick (string-append (the (gdl-sjax-call :function-key :update-root!))
:onclick (string-append (the (gdl-ajax-call :function-key :update-root!))
" location.reload(true);"
))
"Update!")))
......@@ -408,7 +413,7 @@ from a saved snapshot file."