Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
gendl
gendl
Commits
42a8c2ab
Commit
42a8c2ab
authored
Jan 10, 2016
by
Dave Cooper
Browse files
added some debug statements. Issue with respondent in skeleton-ui-element. Added graph application
parent
d21b35bf
Changes
4
Hide whitespace changes
Inline
Side-by-side
apps/graphs/source/assembly.lisp
0 → 100644
View file @
42a8c2ab
(
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
))
))
apps/graphs/source/package.lisp
0 → 100644
View file @
42a8c2ab
(
gwl:define-package
:graph-plot
(
:export
#:ui
#:assembly
))
apps/graphs/source/ui.lisp
0 → 100644
View file @
42a8c2ab
(
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
)))
gwl/ajax/source/skeleton-ui-element.lisp
View file @
42a8c2ab
...
...
@@ -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%
)))
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment