diff --git a/apps/graphs/source/assembly.lisp b/apps/graphs/source/assembly.lisp new file mode 100644 index 0000000000000000000000000000000000000000..6bd7e4b541a37e24068f9ebcce8f41321abb4389 --- /dev/null +++ b/apps/graphs/source/assembly.lisp @@ -0,0 +1,73 @@ +(in-package :graph-plot) + +(define-object assembly (base-object) + + :input-slots + ((grid-increment 1) + (function #'identity) (range-min -5) (range-max 5) (increment 0.1) + (show-axes? t) + (show-grid? (the show-axes?)) + + (domain-min (apply #'min (the y-samples))) + (domain-max (apply #'max (the y-samples)))) + + + :computed-slots + ((range-interval (- (the range-max) (the range-min))) + + (domain-interval (- (the domain-max) (the domain-min))) + + (x-samples (list-of-numbers (the range-min) (the range-max) (the increment))) + (y-samples (mapcar #'(lambda(x) (funcall (the function) x)) (the x-samples))) + + (curve-sample-points (mapcar #'(lambda(x y) (make-point x y 0)) + (the x-samples) (the y-samples)))) + + + :objects + ( + (points-display :type 'points-display + :hidden? t + :points (the curve-sample-points)) + + (curve :type 'fitted-curve + :points (the curve-sample-points)) + + (x-axis :type (if (the show-axes?) 'line 'null-object) + :start (make-point (the range-min) 0 0) + :end (make-point (the range-max) 0 0) + :display-controls (list :color :green :line-style :dashed)) + + (x-grid :type (if (the show-grid?) 'line 'null-object) + :sequence (:size (floor (/ (the domain-interval) (the grid-increment)))) + :display-controls (list :line-thickness 0.5 :color :grey) + :start (make-point (1+ (the range-min)) + (+ (* (the-child index) (the grid-increment)) + (floor (the domain-min)) + (if (evenp (floor (the domain-min))) 0 1)) 0) + :end (make-point (1+ (the range-max)) + (+ (* (the-child index) (the grid-increment)) + (floor (the domain-min)) + (if (evenp (floor (the domain-min))) 0 1)) 0)) + + (y-axis :type (if (the show-axes?) 'line 'null-object) + :start (make-point 0 (the domain-min) 0) + :end (make-point 0 (the domain-max) 0) + :display-controls (list :color :red :line-style :dashed)) + + (y-grid :type (if (the show-grid?) 'line 'null-object) + :sequence (:size (floor (/ (the range-interval) (the grid-increment)))) + :display-controls (list :line-thickness 0.5 :color :grey) + :start (make-point (+ (* (the-child index) (the grid-increment)) + (floor (the range-min)) 1) + (1- (the domain-min)) + 0) + :end (make-point (+ (* (the-child index) (the grid-increment)) + (floor (the range-min)) 1) + (1- (the domain-max)) + 0)) + + )) + + + diff --git a/apps/graphs/source/package.lisp b/apps/graphs/source/package.lisp new file mode 100644 index 0000000000000000000000000000000000000000..ea245a2eb42f07f76f758cc375aa677ba3ec205b --- /dev/null +++ b/apps/graphs/source/package.lisp @@ -0,0 +1 @@ +(gwl:define-package :graph-plot (:export #:ui #:assembly)) diff --git a/apps/graphs/source/ui.lisp b/apps/graphs/source/ui.lisp new file mode 100644 index 0000000000000000000000000000000000000000..04d982c3afcd16ce1468b0dbe6389bb99dc78e56 --- /dev/null +++ b/apps/graphs/source/ui.lisp @@ -0,0 +1,79 @@ +(in-package :graph-plot) + +(setq *developing?* t) + +(define-object ui (base-ajax-sheet) + + :computed-slots + ((use-raphael? t) + (use-x3dom? t) + + (function-specs (list (list :function-body + (the (function-bodies 0) value) + :domain-min -5 :domain-max 5))) + + + (number-of-functions 1) + + #+nil + (html-sections (list (the inputs-section) + (the results-section) + (the viewport))) + + (main-sheet-body + (with-cl-who-string () + (:p (when *developing?* (str (the development-links)))) + (:p (str (the inputs-section main-div))) + (:p (str (the results-section main-div))) + (:p (str (the viewport main-div))))) + + (range-min (apply #'min (mapsend (the graphs) :range-min))) + (range-max (apply #'max (mapsend (the graphs) :range-max))) + + (domain-min (apply #'min (mapsend (the graphs) :domain-min))) + (domain-max (apply #'max (mapsend (the graphs) :domain-max))) + ) + + + :hidden-objects + ((graphs :type 'assembly + :sequence (:size (length (the function-specs))) + :pseudo-inputs (specs) + :specs (nth (the-child index) (the function-specs)) + :function (let ((form (getf (the-child specs) :function-body))) + `(lambda (gdl-user::x) ,(let ((*package* (find-package :graph-plot))) form))) + :parameters (remove-plist-key (the-child specs) :function-body)) + + + (function-bodies :type 'text-form-control + :sequence (:size (the number-of-functions)) + :ajax-submit-on-change? t + :domain :pass-thru + :default '(* gdl-user::x 2))) + + + :objects + ((inputs-section :type 'sheet-section + :inner-html (with-cl-who-string () + (dolist (function (list-elements (the function-bodies))) + (htm (str (the-object function html-string)) :br)))) + + (results-section :type 'sheet-section + :inner-html (with-cl-who-string () + (fmt "~s" (the (graphs 0) function)))) + + (box :type 'box + :width (twice (apply #'max (mapcar #'abs (list (the range-min) (the range-max))))) + :length (twice (apply #'max (mapcar #'abs (list (the domain-min) (the domain-max)))))) + + (viewport :type 'base-ajax-graphics-sheet + :respondent self + :view-direction-default :top + :image-format-default :raphael + :display-list-object-roots (list-elements (the graphs)) + :display-list-objects (unless (eql (the-child image-format) :x3dom) + (list (the box))) + :length 500 + :width 500))) + + diff --git a/gwl/ajax/source/skeleton-ui-element.lisp b/gwl/ajax/source/skeleton-ui-element.lisp index 36fd393c3cd9ab8d69b7239c561b501ef2149c7c..2429a32a49d99f2e26de1ea6252c3a9e7aa5b27d 100644 --- a/gwl/ajax/source/skeleton-ui-element.lisp +++ b/gwl/ajax/source/skeleton-ui-element.lisp @@ -269,9 +269,8 @@ form-controls (default of these is also nil) will be respected. Default is nil." (register-html-section! (section) - - #+nil - (when *debug?* + + (progn (format *trace-output* "~&Before:~%") (print-variables self) (print-messages %html-section-root-paths%)) @@ -282,9 +281,8 @@ form-controls (default of these is also nil) will be respected. Default is nil." :test #'equalp) ;;:remember? nil :warn-on-non-toplevel? nil))) - - #+nil - (when *debug?* + + (when t (format *trace-output* "~&After:~%") (print-messages %html-section-root-paths%)))