Commit c2a30bba authored by Dave Cooper's avatar Dave Cooper
Browse files

added graph generating app

parent 4ab564f9
......@@ -6,7 +6,7 @@
;; not be there) this parameter must be set at initialization/startup
;; time to the correct location.
(defparameter *system-home* (glisp:system-home :gorg))
(defparameter *system-home* "~dcooper8/genworks/gendl/apps/gorg/")
(defparameter *templates-folder*
;;;; -*- coding: utf-8 -*-
(asdf:defsystem #:graphs :description
"The Gendl™ graphs Subsystem" :author "Dave Cooper" :license
"Affero Gnu Public License (" :serial t
:version "20160110" :depends-on (:gwl-graphics)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-encodings :encoding #+asdf-encodings :utf-8
((:file "source/package") (:file "source/assembly")
(:file "source/publish") (:file "source/ui")))
......@@ -53,7 +53,7 @@
(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))
:display-controls (list :color :green :line-style :dashed))
(y-grid :type (if (the show-grid?) 'line 'null-object)
:sequence (:size (floor (/ (the range-interval) (the grid-increment))))
\ No newline at end of file
(in-package :graph-plot)
(publish-gwl-app "/graph-plot" 'ui)
(in-package :graph-plot)
(setq *developing?* t)
;;(setq *developing?* t)
(define-object ui (base-ajax-sheet)
......@@ -10,10 +10,12 @@
(function-specs (list (list :function-body
(the (function-bodies 0) value)
:domain-min -5 :domain-max 5)
(list :function-body
(the (function-bodies 1) value)
:domain-min -5 :domain-max 5)))
(number-of-functions 1)
(number-of-functions 2)
(html-sections (list (the inputs-section)
......@@ -32,12 +34,17 @@
(domain-min (apply #'min (mapsend (the graphs) :domain-min)))
(domain-max (apply #'max (mapsend (the graphs) :domain-max)))
(solutions (the (graphs 0) curve (curve-intersection-points (the (graphs 1) curve))))
((graphs :type 'assembly
:sequence (:size (length (the function-specs)))
:display-controls (list :color (if (zerop (the-child index)) :black :magenta))
:pseudo-inputs (specs)
:specs (nth (the-child index) (the function-specs))
:function (let ((form (getf (the-child specs) :function-body)))
......@@ -46,10 +53,11 @@
(function-bodies :type 'text-form-control
:prompt (format nil "Function ~a" (the-child index))
:sequence (:size (the number-of-functions))
:ajax-submit-on-change? t
:domain :pass-thru
:default '(* gdl-user::x 2)))
:default 'gdl-user::x))
......@@ -60,14 +68,24 @@
(results-section :type 'sheet-section
:inner-html (with-cl-who-string ()
(fmt "~s" (the (graphs 0) function))))
(unless (equalp (the (graphs 0) function)
(the (graphs 1) function))
(fmt "Solutions: ~{~a~^, ~}"
(mapcar #'(lambda(3d-point)
(format nil "[~a, ~a]" (get-x 3d-point) (get-y 3d-point)))
(mapcar #'(lambda(point)
(make-point (number-round (get-x point) 3)
(number-round (get-y point) 3)))
(mapcar #'(lambda(point)
(get-3d-point-of point))
(the solutions))))))))
(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
;;:respondent self
:view-direction-default :top
:image-format-default :raphael
:display-list-object-roots (list-elements (the graphs))
......@@ -34,7 +34,9 @@ Raphael vector graphics."
:examples "FLAG -- Fill in!!!")
(("Number. Thickness of default border around graphics viewport.
((respondent (the bashee) :defaulting)
("Number. Thickness of default border around graphics viewport.
Default is 1." viewport-border-default 1)
(vector-graphics-onclick? t)
Supports Markdown
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