Loading geom-base/formats/source/vector-graphics.lisp +3 −1 Original line number Diff line number Diff line Loading @@ -30,4 +30,6 @@ (define-format svg (vector-graphics) :documentation (:author "David J Cooper Jr [Genworks]" :description "Direct SVG for inline inclusion in a web page or application")) :description "Direct SVG for inline inclusion in a web page or application") :slots ((id (string (gensym))))) gwl-graphics/gwl/source/viewport-html-div.lisp +48 −22 Original line number Diff line number Diff line Loading @@ -31,18 +31,27 @@ (height 300) (image-format-default :svg) (vector-graphics-onclick? nil) (projection-vector (getf *standard-views* :trimetric))) (projection-vector (getf *standard-views* :trimetric)) :computed-slots (;; FLAG drive this with a UI form-control (background-color (lookup-color (getf *colors-default* :background) :format :decimal)) (foreground-color (lookup-color (getf *colors-default* :foreground) :format :decimal)) ;; FLAG drive this with a UI form-control (image-format (the image-format-default)) (inner-html (ecase (the image-format) ) :computed-slots ((div-style (format nil "width: ~apx; height: ~apx;" (the width) (the height))) (inner-html (with-cl-who-string () (str (ecase (the image-format) (:svg (the svg-content)) (:png (the png-content)) (:jpeg (the jpeg-content)) (:x3dom (the x3dom-content)) (:a-frame (the a-frame-content)))) (:script (str (the viewport-js-text))))) (svg-content (if (the no-graphics?) (with-cl-who-string () Loading @@ -50,14 +59,12 @@ (:p "No graphics objects specified"))) (with-error-handling () (with-cl-who-string () ((:div :id (format nil "svg-viewport-~a" (the base64-encoded-root-path)) :style (format nil "width: ~apx; height: ~apx;" (the width) (the height))) (str (with-output-to-string (ss) (with-format (svg ss :id (the svg-id) :background-color (the background-color) :foreground-color (the foreground-color)) (write-the view-object cad-output))))))))) (write-the view-object cad-output)))))))) (png-content "<p>PNG graphics not implemented yet</p>") (jpeg-content "<p>JPEG graphics not implemented yet</p>") Loading @@ -69,8 +76,24 @@ (no-graphics? (and (null (the display-list-objects)) (null (the display-list-object-roots)))) (background-color (lookup-color (getf *colors-default* :background) :format :decimal)) (foreground-color (lookup-color (getf *colors-default* :foreground) :format :decimal))) (svg-id (string-append (the dom-id) "-svg-section")) (viewport-js-text (ecase (the image-format) (:svg (format nil " if (document.getElementById('~a')) { panZoomSVG~a = svgPanZoom('#~a', { zoomEnabled: true, controlIconsEnabled: true, preventMouseEventsDefault: false, fit: true, minZoom: 0.01, maxZoom: 100, center: true }); };" (the svg-id) (the dom-id) (the svg-id))) ((:png :jpeg :x3dom :a-frame) "")))) :objects ((view-object :type 'web-drawing Loading @@ -91,7 +114,8 @@ (objects (list (the box-1)))) :computed-slots ((body (with-lhtml-string () ((use-svgpanzoom? t) (body (with-lhtml-string () (:h1 "Test Page with Viewport") (:p "This page demonstrates the new viewport-html-div component:") (str (the view-1 div)) Loading @@ -106,5 +130,7 @@ :display-list-objects (the objects)))) (publish-gwl-app "/test-view" 'test-viewport-page) (with-all-servers (server) (publish-gwl-app "/test-view" 'test-viewport-page :server server)) gwl-graphics/svg/source/lenses.lisp +1 −1 Original line number Diff line number Diff line Loading @@ -42,7 +42,7 @@ (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) ((:svg :id (format-slot id) :viewBox (format nil "0 0 ~a ~a" width length) :width width :class (the svg-class) :height length Loading Loading
geom-base/formats/source/vector-graphics.lisp +3 −1 Original line number Diff line number Diff line Loading @@ -30,4 +30,6 @@ (define-format svg (vector-graphics) :documentation (:author "David J Cooper Jr [Genworks]" :description "Direct SVG for inline inclusion in a web page or application")) :description "Direct SVG for inline inclusion in a web page or application") :slots ((id (string (gensym)))))
gwl-graphics/gwl/source/viewport-html-div.lisp +48 −22 Original line number Diff line number Diff line Loading @@ -31,18 +31,27 @@ (height 300) (image-format-default :svg) (vector-graphics-onclick? nil) (projection-vector (getf *standard-views* :trimetric))) (projection-vector (getf *standard-views* :trimetric)) :computed-slots (;; FLAG drive this with a UI form-control (background-color (lookup-color (getf *colors-default* :background) :format :decimal)) (foreground-color (lookup-color (getf *colors-default* :foreground) :format :decimal)) ;; FLAG drive this with a UI form-control (image-format (the image-format-default)) (inner-html (ecase (the image-format) ) :computed-slots ((div-style (format nil "width: ~apx; height: ~apx;" (the width) (the height))) (inner-html (with-cl-who-string () (str (ecase (the image-format) (:svg (the svg-content)) (:png (the png-content)) (:jpeg (the jpeg-content)) (:x3dom (the x3dom-content)) (:a-frame (the a-frame-content)))) (:script (str (the viewport-js-text))))) (svg-content (if (the no-graphics?) (with-cl-who-string () Loading @@ -50,14 +59,12 @@ (:p "No graphics objects specified"))) (with-error-handling () (with-cl-who-string () ((:div :id (format nil "svg-viewport-~a" (the base64-encoded-root-path)) :style (format nil "width: ~apx; height: ~apx;" (the width) (the height))) (str (with-output-to-string (ss) (with-format (svg ss :id (the svg-id) :background-color (the background-color) :foreground-color (the foreground-color)) (write-the view-object cad-output))))))))) (write-the view-object cad-output)))))))) (png-content "<p>PNG graphics not implemented yet</p>") (jpeg-content "<p>JPEG graphics not implemented yet</p>") Loading @@ -69,8 +76,24 @@ (no-graphics? (and (null (the display-list-objects)) (null (the display-list-object-roots)))) (background-color (lookup-color (getf *colors-default* :background) :format :decimal)) (foreground-color (lookup-color (getf *colors-default* :foreground) :format :decimal))) (svg-id (string-append (the dom-id) "-svg-section")) (viewport-js-text (ecase (the image-format) (:svg (format nil " if (document.getElementById('~a')) { panZoomSVG~a = svgPanZoom('#~a', { zoomEnabled: true, controlIconsEnabled: true, preventMouseEventsDefault: false, fit: true, minZoom: 0.01, maxZoom: 100, center: true }); };" (the svg-id) (the dom-id) (the svg-id))) ((:png :jpeg :x3dom :a-frame) "")))) :objects ((view-object :type 'web-drawing Loading @@ -91,7 +114,8 @@ (objects (list (the box-1)))) :computed-slots ((body (with-lhtml-string () ((use-svgpanzoom? t) (body (with-lhtml-string () (:h1 "Test Page with Viewport") (:p "This page demonstrates the new viewport-html-div component:") (str (the view-1 div)) Loading @@ -106,5 +130,7 @@ :display-list-objects (the objects)))) (publish-gwl-app "/test-view" 'test-viewport-page) (with-all-servers (server) (publish-gwl-app "/test-view" 'test-viewport-page :server server))
gwl-graphics/svg/source/lenses.lisp +1 −1 Original line number Diff line number Diff line Loading @@ -42,7 +42,7 @@ (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) ((:svg :id (format-slot id) :viewBox (format nil "0 0 ~a ~a" width length) :width width :class (the svg-class) :height length Loading