Commit 42a8c2ab authored by Dave Cooper's avatar Dave Cooper

added some debug statements. Issue with respondent in skeleton-ui-element. Added graph application

parent d21b35bf
(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))
))
(gwl:define-package :graph-plot (:export #:ui #:assembly))
(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)))
......@@ -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%)))
......
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