Commit 97c98521 authored by Dave Cooper's avatar Dave Cooper

added onclick-function for vector graphics objects

parent 74a2ef2b
......@@ -96,7 +96,10 @@ gdl-user(53):
</pre>" )
(("Lambda function of zero arguments, or nil. If non-nil, this
function gets invoked when the user clicks the object in graphics
front-ends which support this functionality, e.g. SVG/Raphael and X3DOM."
onclick-function nil)
("Pathname or string. Points to a pre-existing image file to be displayed instead of actual geometry for this object. Defaults to nil" image-file nil)
......@@ -213,7 +213,8 @@ This is not tested to see if it is part of the same object tree as current self.
((view-object :type 'web-drawing
:pass-down (projection-vector immune-objects background-color field-of-view-default raphael-canvas-id
:pass-down (projection-vector immune-objects background-color
field-of-view-default raphael-canvas-id
:page-length (the length)
:page-width (the width)
......@@ -335,7 +336,7 @@ position: relative;
(if (the vector-graphics-onclick?)
"crosshair" "arrow")
(the view-object length)
(the view-object width)
(the view-object width)
......@@ -30,7 +30,7 @@
(&key width length)
(format *stream* "if (typeof paper === 'undefined') {var paper = Raphael('~a', ~a, ~a)};~%
(format *stream* "var paper = Raphael('~a', ~a, ~a);~%
if (typeof start === 'undefined') {
......@@ -189,8 +189,12 @@
(display-controls (or (geom-base::find-in-hash object *display-controls*)
(the object display-controls)))
(name (base64-encode-safe
(format nil "~s" (remove :root-object-object
(the-object object root-path)))))
(format nil "~s~s"
(remove :root-object-object
(the-object object root-path))
(remove :root-object-object
(the root-path)))))
;;(*read-default-float-format* 'single-float)
......@@ -293,12 +297,16 @@
;; FLAG -- do something better here than ignore-errors
(when (ignore-errors (and (the viewport) (eql (the viewport digitation-mode) :select-object)))
(fmt "~a.node.onclick = function (event) {~a};" name
(the viewport (gdl-ajax-call :function-key :set-object-to-inspect!
:arguments (list object)))))
(cond ((the object onclick-function)
(fmt "~a.node.onclick = function (event) {~a};" name
(the parent parent parent
(gdl-ajax-call :function-key :call-onclick-function!
:arguments (list object)))))
((ignore-errors (and (the viewport) (eql (the viewport digitation-mode) :select-object)))
(fmt "~a.node.onclick = function (event) {~a};" name
(the viewport (gdl-ajax-call :function-key :set-object-to-inspect!
:arguments (list object)))))
(t nil))
(write-the (drag-controls :name name :display-controls display-controls))
......@@ -419,7 +419,14 @@ running the Javascript interpreter to evaluate (the js-to-eval), if any.
(when arguments
(list :|arguments| arguments)))) ss))))
(toggle-view-toggle! () (the (set-slot! :view-toggle (not (the view-toggle)))))))
(toggle-view-toggle! () (the (set-slot! :view-toggle (not (the view-toggle)))))
(when (the-object object onclick-function)
(funcall (the-object object onclick-function))))))
(define-lens (html-format skeleton-ui-element)()
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment