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
01d32a0e
Commit
01d32a0e
authored
Oct 07, 2015
by
Dave Cooper
Browse files
tentative implementation of detached-tasty
parent
95fd97be
Changes
5
Hide whitespace changes
Inline
Side-by-side
apps/tasty/source/assembly.lisp
View file @
01d32a0e
...
...
@@ -61,7 +61,15 @@ o allow input of required input-slots.
(
uri-style-sheet
(
when
(
the
use-jquery?
)
(
string-append
(
the
uri-static-gwl-styles
)
"tasty-layout.css"
)))
#+
nil
(
tatu-update-function
#'
(
lambda
()
(
format
t
"~%~%At 1~%~%"
)
(
the
root-object
update!
)
(
mapsend
(
list
(
the
tree
)
(
the
inspector
)
(
the
viewport
))
:update!
)))
#+
nil
(
tatu-update-function
#'
(
lambda
()
(
the
(
set-slot!
:root-object
(
the
root-object
)))
...
...
@@ -167,9 +175,13 @@ o allow input of required input-slots.
;;:show-onmouseover-buttons? nil
:onclick-function
#'
(
lambda
(
object
)
(
the
(
gdl-ajax-call
(
the
(
gdl-ajax-call
;;:bashee (list :%rp% '(:root-object))
:function-key
:perform-action!
:arguments
(
list
object
)))))
:arguments
(
list
nil
:tasty-root
self
:root-object-rootpath
(
the-object
object
root-path
))))))
(
viewport
:type
'viewport
...
...
@@ -180,12 +192,14 @@ o allow input of required input-slots.
:length
(
getf
(
the
viewport-dimensions
)
:length
(
getf
(
the
viewport-dimensions
)
:height
))
:width
(
getf
(
the
viewport-dimensions
)
:width
)
:onclick-function
#'
(
lambda
(
object
)
(
the
(
gdl-ajax-call
:function-key
:perform-action!
:arguments
(
list
object
)
:null-event?
(
member
(
the-child
image-format
)
(
list
:x3d
:x3dom
))
)))
:onclick-function
#'
(
lambda
(
object
)
(
the
(
gdl-ajax-call
:function-key
:perform-action!
:arguments
(
list
nil
:tasty-root
self
:root-object-rootpath
(
the-object
object
root-path
))
:null-event?
(
member
(
the-child
image-format
)
(
list
:x3d
:x3dom
)))))
:tatu-root
self
)
(
inspector
:type
'inspector
...
...
@@ -270,15 +284,32 @@ o allow input of required input-slots.
(
update-root-object!
()
(
the
root-object
update!
)
(
the
tree
update!
)
(
the
refresh-tasty-panes!
)
;;(the root-object update!)
;;(the tree update!)
)
(
refresh-tasty-panes!
()
(
mapsend
(
list
(
the
tree
)
(
the
inspector
)
(
the
viewport
))
:update!
))
#+
nil
(
make-root-instance
(
type
)
(
the
(
set-slot!
:root-object-type
(
let
((
*package*
(
find-package
(
the
package-default
))))
(
read-safe-string
type
)))))
(
make-root-instance
(
type
)
(
let*
((
type
(
let
((
*package*
(
find-package
(
the
package-default
))))
(
read-safe-string
type
)))
(
object
(
make-object
type
:strings-for-display
(
format
nil
"~s"
type
))))
(
the
(
set-root!
object
))))
(
set-root!
(
object
)
(
when
(
typep
object
'base-html-sheet
)
...
...
@@ -314,35 +345,51 @@ o allow input of required input-slots.
(
the
(
set-slot!
:root-object
(
the
root-object-object
)))))
(
perform-action!
(
object
&key
kids-error
(
click-mode
(
the
click-mode
value
)))
(
&optional
object
&key
tasty-root
root-object-rootpath
kids-error
(
click-mode
(
the
click-mode
value
)))
(
when
*debug?*
(
print-variables
(
the-object
object
root-path
)
click-mode
))
(
ecase
click-mode
(
:inspect
(
the
inspector
(
set-object!
object
)))
(
:reset-root
(
the
(
reset-root!
object
)))
(
:set-root
(
the
(
set-root!
object
)))
(
:update-node
(
the
(
update-node!
object
)))
(
:draw-leaves
(
the
viewport
(
draw-leaves!
object
)))
(
:draw-node
(
the
viewport
(
draw-node!
object
)))
(
:add-leaves
(
the
viewport
(
add-leaves!
object
)))
(
:add-leaves*
(
the
viewport
(
add-leaves*!
object
)))
(
:delete-leaves
(
the
viewport
(
delete-leaves!
object
)))
(
:add-node
(
the
viewport
(
add-node!
object
)))
(
let
((
object
(
or
object
(
the-object
tasty-root
root-object
(
follow-root-path
root-object-rootpath
)))))
(
print-variables
object
click-mode
)
(
print-variables
(
the
inspector
node-root-path
)
(
the
inspector
node
))
(
ecase
click-mode
(
:inspect
(
the
inspector
(
set-object!
object
)))
(
:reset-root
(
the
(
reset-root!
object
)))
(
:set-root
(
the
(
set-root!
object
)))
(
:update-node
(
the
(
update-node!
object
)))
(
:draw-leaves
(
the
viewport
(
draw-leaves!
object
)))
(
:draw-node
(
the
viewport
(
draw-node!
object
)))
(
:add-leaves
(
the
viewport
(
add-leaves!
object
)))
(
:add-leaves*
(
the
viewport
(
add-leaves*!
object
)))
(
:delete-leaves
(
the
viewport
(
delete-leaves!
object
)))
(
:add-node
(
the
viewport
(
add-node!
object
)))
(
:break
(
set-self
object
)
(
let
((
*package*
(
symbol-package
(
the-object
object
root
type
))))
(
:break
(
set-self
object
)
(
let
((
*package*
(
symbol-package
(
the-object
object
root
type
))))
(
format
t
"~&
(
format
t
"~&
~aSelf is now set to to ~s, you may use command-line interaction....~%~%"
(
if
kids-error
(
format
nil
"~&
(
if
kids-error
(
format
nil
"~&
NOTE: Children cannot expand -- evaluate (the children) to reproduce the error.
The error was: ~a
"
kids-error
)
""
)
object
)))
kids-error
)
""
)
object
)))
;;(:uh (the viewport (set-sheet-object! object)))
;;(:uh (the viewport (set-sheet-object! object)))
)
(
print-variables
(
the
inspector
node-root-path
)
(
the
inspector
node
))
))))
...
...
apps/tasty/source/inspector.lisp
View file @
01d32a0e
...
...
@@ -142,6 +142,7 @@
(
definition
)
(
declare
(
ignore
definition
))
(
error
"Sorry! This is supposed to do 'lisp-find-definition' in emacs, but not working yet... Please send email to support@genworks.com"
))
#+
nil
(
visit-definition-in-emacs
...
...
@@ -150,7 +151,8 @@
(
print-variables
emacs-lisp-command
)
#+
allegro
(
lep::eval-in-emacs
emacs-lisp-command
)))
#+
nil
(
perform-action!
(
object
)
(
the
tatu-root
(
perform-action!
object
)))
...
...
@@ -262,7 +264,7 @@
(
typecase
(
the
value
)
(
list
(
when
(
consp
(
the
value
))
:list
))
(
gdl::quantification
:gdl-sequence
)
(
gdl::gdl-basis
:gdl-atom
))))
(
gdl::gdl-basis
(
when
(
eql
(
the
value
root
)
(
the
node
root
))
:gdl-atom
))))
)
(
value-cardinality
(
case
(
the
value-type
)
...
...
@@ -305,9 +307,13 @@
(
if
(
the
clickable?
)
"cursor: pointer;"
""
))
:onclick
(
case
(
the
value-type
)
(
:gdl-atom
(
the
(
gdl-ajax-call
(
the
(
gdl-ajax-call
:bashee
(
the
tatu-root
)
:function-key
:perform-action!
:arguments
(
list
value
))))
:arguments
(
list
nil
:tasty-root
(
the
tatu-root
)
:root-object-rootpath
(
the
value
root-path
)))))
(
:gdl-3d-point
(
when
(
the
clickable?
)
...
...
@@ -451,6 +457,9 @@
(
progn
(
the
node
(
set-slot-if-needed!
(
the-child
keyword
)
value
:infer-types?
nil
))
(
the
tatu-root
refresh-tasty-panes!
)
t
))
;;
...
...
apps/tree/source/newertree.lisp
View file @
01d32a0e
...
...
@@ -212,8 +212,7 @@ Converting to a string to avoid error."
(
the
child-nodes
)))))))))
:functions
(
(
toggle-state!
()
((
toggle-state!
()
(
the
(
set-slot!
:closed?
(
not
(
the
closed?
))))
(
the
propogate-toggle!
))
...
...
demos/robot/source/assembly.lisp
View file @
01d32a0e
...
...
@@ -48,7 +48,7 @@ to the src/ directory distributed with GDL.
(
torso-type
'box
:settable
)
(
height
10
:settable
)
(
head-angle
0
:settable
)
(
body-angle
0
:settable
)
(
body-angle
2
0
:settable
)
(
arm-angle-right
0
:settable
)
(
arm-angle-left
0
:settable
)
(
pincer-distance-right
(
number-round
(
*
.15
3/5
(
the
width
))
3
)
:settable
)
...
...
gwl/ajax/source/ajax.lisp
View file @
01d32a0e
...
...
@@ -23,6 +23,8 @@
(
defparameter
*ajax-snap-restore?*
nil
)
(
defparameter
*self*
nil
)
(
defun
quick-save
(
self
&key
(
snap-folder
(
glisp:snap-folder
)))
(
when
*ajax-snap-restore?*
(
let
((
snap-file
...
...
@@ -100,6 +102,7 @@
(
self
(
or
self
(
restore-from-snap
iid
)))
(
plist-raw
plist
)
(
plist
(
decode-from-ajax
plist
self
))
(
bashee
(
getf
plist
:|bashee|
))
(
respondent
(
progn
(
when
*debug?*
(
print-variables
plist
))
...
...
@@ -110,11 +113,14 @@
(
arguments
(
getf
plist
:|arguments|
)))
(
setq
*self*
self
)
(
when
*debug?*
(
let
((
bashee-root
(
the-object
bashee
root-path
))
(
respondent-root
(
the-object
respondent
root-path
)))
(
print-variables
raw-fields
bashee-root
respondent-root
fields
function
)))
(
print-variables
plist-raw
plist
raw-fields
bashee-root
respondent-root
fields
function
)
))
(
let
((
*clicked-x*
(
let
((
string
(
getf
query-plist
:|x|
)))
...
...
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