Commit 4135136a authored by Dave Cooper's avatar Dave Cooper
Browse files

gdlajax working for blank-string newHTML

parent 551ddef9
...@@ -17,7 +17,7 @@ ...@@ -17,7 +17,7 @@
) )
:objects ((assembly :type 'assembly :objects ((assembly :type 'assembly
:input-link-angle-d (or nil ;;(the input-link-angle-d) :input-link-angle-d (or (the input-link-angle-d)
(if (the dropped-x-y) (if (the dropped-x-y)
(angle-between-vectors-d (the (face-normal-vector :right)) (angle-between-vectors-d (the (face-normal-vector :right))
(subtract-vectors (the dropped-x-y) (subtract-vectors (the dropped-x-y)
...@@ -29,12 +29,7 @@ ...@@ -29,12 +29,7 @@
:js-to-eval :parse :js-to-eval :parse
:inner-html (with-cl-who-string () :inner-html (with-cl-who-string ()
(str (defaulting (the main-area dropped-x-y))) (str (defaulting (the main-area dropped-x-y)))
(str (the input-link-angle-d)) (str (the input-link-angle-d))))
#+nil
(:script
(str (the (gdl-ajax-call :function-key :set-slot!
:arguments (list :input-link-angle-d (if (the input-link-angle-d)
(1+ (the input-link-angle-d)) 90 ))))))))
(main-area :type 'base-ajax-graphics-sheet (main-area :type 'base-ajax-graphics-sheet
:respondent self :respondent self
:vector-graphics-onclick? nil :vector-graphics-onclick? nil
......
...@@ -32,7 +32,9 @@ ...@@ -32,7 +32,9 @@
) )
:computed-slots :computed-slots
((ui-display-list-objects (remove-if ((respondent self)
(ui-display-list-objects (remove-if
#'(lambda (item) (typep item 'base-rule-object)) #'(lambda (item) (typep item 'base-rule-object))
(the :children))) (the :children)))
(frame-width (the :frame :width)) (frame-width (the :frame :width))
...@@ -140,6 +142,7 @@ ...@@ -140,6 +142,7 @@
:objects :objects
((knuckles :type 'knuckle ((knuckles :type 'knuckle
:pseudo-inputs (front-vector left-vector top-vector transformation-matrix)
:sequence (:size 2) :sequence (:size 2)
:side (ecase (the-child :index) (0 :left) (1 :right)) :side (ecase (the-child :index) (0 :left) (1 :right))
:top-vector (getf (the (:axles 0) :kingpin-vectors) (the-child :side)) :top-vector (getf (the (:axles 0) :kingpin-vectors) (the-child :side))
...@@ -211,6 +214,7 @@ ...@@ -211,6 +214,7 @@
:display-controls (list :color :black :line-thickness 2)) :display-controls (list :color :black :line-thickness 2))
(wheels-front :type 'wheel (wheels-front :type 'wheel
:sequence (:size 2) :sequence (:size 2)
:pseudo-inputs (transformation-matrix)
:center (the (:knuckles (the-child :index)) :spindle-center) :center (the (:knuckles (the-child :index)) :spindle-center)
:transformation-matrix (alignment :front :transformation-matrix (alignment :front
(the (:knuckles (the-child :index)) (the (:knuckles (the-child :index))
...@@ -230,6 +234,7 @@ ...@@ -230,6 +234,7 @@
(ecase (the-child :index) (0 :left) (1 :right))) (ecase (the-child :index) (0 :left) (1 :right)))
(ecase (the-child :index) (0 :front) (1 :rear)) (ecase (the-child :index) (0 :front) (1 :rear))
(half (the-child :length))) (half (the-child :length)))
:pseudo-inputs (transformation-matrix)
:transformation-matrix (alignment :front :transformation-matrix (alignment :front
(the (:face-normal-vector (the (:face-normal-vector
(ecase (ecase
...@@ -265,6 +270,7 @@ ...@@ -265,6 +270,7 @@
(:right (the-child :front-vector)))) (:right (the-child :front-vector))))
:spindle-downward-pitch (+ (the :kingpin-inclination-angle) (the :camber-angle)) :spindle-downward-pitch (+ (the :kingpin-inclination-angle) (the :camber-angle))
:pass-down (:tie-rod-arm-length :tie-rod-arm-setting) :pass-down (:tie-rod-arm-length :tie-rod-arm-setting)
:pseudo-inputs (front-vector left-vector top-vector transformation-matrix)
:transformation-matrix (alignment :top (the-child :top-vector) :front :transformation-matrix (alignment :top (the-child :top-vector) :front
(rotate-vector-d (the-child :front-vector) (rotate-vector-d (the-child :front-vector)
(the :toe-in-angle) (the :toe-in-angle)
......
...@@ -195,6 +195,9 @@ ...@@ -195,6 +195,9 @@
:functions :functions
((respond! ((respond!
() ()
(when *debug?* (print-messages replace-lists))
(when (the mismatch?) (when (the mismatch?)
(warn "the js-to-eval-previous is not the same length as html-section-objects in ~s~%" (warn "the js-to-eval-previous is not the same length as html-section-objects in ~s~%"
(the respondent))) (the respondent)))
...@@ -209,12 +212,12 @@ ...@@ -209,12 +212,12 @@
(when (or inner-html js-to-eval?) (when (or inner-html js-to-eval?)
(htm (htm
(:html-section (:|replaceId| (str dom-id)) (:html-section (:|replaceId| (str dom-id))
(:|newHTML| (if inner-html (:|newHTML| (str (if inner-html
(str (wrap-cdata (if (the security-ok?) inner-html (wrap-cdata (if (the security-ok?) inner-html
(with-cl-who-string () (with-cl-who-string ()
(:i "Security Error"))))) "")) (:i "Security Error")))) "")))
(:|jsToEval| (if (and js-to-eval? (the security-ok?)) (:|jsToEval| (str (if (and js-to-eval? (the security-ok?))
(str (wrap-cdata js-to-eval)) "")))))))) (wrap-cdata js-to-eval) "")))))))))
(the replace-lists) (the js-to-eval-previi))))))))) (the replace-lists) (the js-to-eval-previi)))))))))
......
...@@ -261,6 +261,7 @@ checkbox-form-control." ...@@ -261,6 +261,7 @@ checkbox-form-control."
(register-html-section! (register-html-section!
(section) (section)
#+nil
(when *debug?* (when *debug?*
(format *trace-output* "~&Before:~%") (format *trace-output* "~&Before:~%")
(print-variables self) (print-variables self)
...@@ -273,6 +274,7 @@ checkbox-form-control." ...@@ -273,6 +274,7 @@ checkbox-form-control."
;;:remember? nil ;;:remember? nil
:warn-on-non-toplevel? nil))) :warn-on-non-toplevel? nil)))
#+nil
(when *debug?* (when *debug?*
(format *trace-output* "~&After:~%") (format *trace-output* "~&After:~%")
(print-messages %html-section-root-paths%))) (print-messages %html-section-root-paths%)))
......
...@@ -72,6 +72,15 @@ the object hierarchies rooted at the instances, as well as all associated publis ...@@ -72,6 +72,15 @@ the object hierarchies rooted at the instances, as well as all associated publis
(clear-instance key))) *instance-hash-table*)) (clear-instance key))) *instance-hash-table*))
(defparameter *instance-finalizer* nil
"CL Function of one argument. The argument is a keyword representing
a GWL Instance ID. This is an application-specific function (either a
symbol naming a function, or a lambda expression) which will be run
after an instance is cleared with the standard clear-instance
function. The default is nil which indicates that no finalizer
function will be run.")
(defun clear-instance (id) (defun clear-instance (id)
"Void. Clears the specified instance from GWL's master table of root-level instances. "Void. Clears the specified instance from GWL's master table of root-level instances.
The instance ID is the same number you see in published GWL URIs, and is available The instance ID is the same number you see in published GWL URIs, and is available
...@@ -89,7 +98,9 @@ the object hierarchy rooted at the instance, as well as all associated published ...@@ -89,7 +98,9 @@ the object hierarchy rooted at the instance, as well as all associated published
(when (not (keywordp id)) (setq id (make-keyword id))) (when (not (keywordp id)) (setq id (make-keyword id)))
(clear-instance-from-hash id) (clear-instance-from-hash id)
(unpublish-instance-urls id)) (unpublish-instance-urls id)
(when *instance-finalizer* (funcall *instance-finalizer* id)))
(defun unpublish-instance-urls (id &optional base-url) (defun unpublish-instance-urls (id &optional base-url)
......
...@@ -163,10 +163,8 @@ function gdlUpdate (request) { ...@@ -163,10 +163,8 @@ function gdlUpdate (request) {
if (child.getElementsByTagName('jsToEval')[0].firstChild != null) if (child.getElementsByTagName('jsToEval')[0].firstChild != null)
{jsToEval = child.getElementsByTagName('jsToEval')[0].firstChild.nodeValue} {jsToEval = child.getElementsByTagName('jsToEval')[0].firstChild.nodeValue}
if (myid && (newHTML != null))
if (myid && newHTML && (newHTML != ''))
{ {
myelem = document.getElementById(myid); myelem = document.getElementById(myid);
myelem.innerHTML = newHTML; myelem.innerHTML = newHTML;
......
...@@ -67,11 +67,17 @@ into a single curve." ...@@ -67,11 +67,17 @@ into a single curve."
("List of GDL NURBS curve objects. The curve segments in the right order for chaining together." ("List of GDL NURBS curve objects. The curve segments in the right order for chaining together."
ordered-curves (let ((tail (nreverse (mapcan #'list (list-elements (the straight-curves)) (list-elements (the fillet-curves)))))) ordered-curves (let ((tail (nreverse (mapcan #'list (list-elements (the straight-curves)) (list-elements (the fillet-curves))))))
(if (< (the fillet-curves number-of-elements) (the straight-curves number-of-elements)) (if (< (the fillet-curves number-of-elements) (the straight-curves number-of-elements))
(cons (the straight-curves last) tail) tail)))) (cons (the straight-curves last) tail) tail)))
(fillet-curve-types (mapcar #'(lambda(fillet-index)
(if (typep (the (fillets fillet-index)) 'geom-base::fillet)
'arc-curve 'null-part))
(list-of-numbers 0 (1- (the fillets number-of-elements))))))
:hidden-objects :hidden-objects
(("GDL Sequence of GDL NURBS curve objects. The arc-curves representing the fillets." (("GDL Sequence of GDL NURBS curve objects. The arc-curves representing the fillets."
fillet-curves :type 'arc-curve fillet-curves
:type (:sequence (the fillet-curve-types))
:sequence (:size (the fillets number-of-elements)) :sequence (:size (the fillets number-of-elements))
:pseudo-inputs (fillet) :pseudo-inputs (fillet)
:fillet (the (fillets (the-child :index))) :fillet (the (fillets (the-child :index)))
...@@ -100,10 +106,8 @@ into a single curve." ...@@ -100,10 +106,8 @@ into a single curve."
from a global-filleted-polyline-curves object") from a global-filleted-polyline-curves object")
:computed-slots :computed-slots
((curves (the ordered-curves)) ((curves (remove-if #'(lambda(item) (typep item 'null-part)) (the ordered-curves)))))
))
......
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