Commit 01d32a0e authored by Dave Cooper's avatar Dave Cooper
Browse files

tentative implementation of detached-tasty

parent 95fd97be
......@@ -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))
))))
......
......@@ -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))
;;
......
......@@ -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!))
......
......@@ -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 20 :settable)
(arm-angle-right 0 :settable)
(arm-angle-left 0 :settable)
(pincer-distance-right (number-round (* .15 3/5 (the width)) 3) :settable)
......
......@@ -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|)))
......
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