Commit 097a315d authored by David O'Toole's avatar David O'Toole

fix more stuff

parent b20a6b0e
......@@ -1458,7 +1458,7 @@ replace the original grid with this one."
(defmethod process-tap :after ((cell-sheet cell-sheet) (node node) x y)
(multiple-value-bind (cell row column) (cell-at cell-sheet x y)
(when cell
(follow-with-camera cell-sheet node))))
(glide-window-to-node cell-sheet node))))
;; Rendering cell sheets:1 ends here
;; Buffer list sheet
......
......@@ -95,8 +95,8 @@ Networking and Setup sections below.)
#+begin_src lisp
(defun show-copyright-notice ()
(dolist (line (split-string-on-lines *squareball-copyright-notice*))
(message line))
(show-terminal))
(message line)))
;;(show-terminal))
#+end_src
* Display properties
......@@ -2166,7 +2166,7 @@ These strings are segregated here for easier localization and editing.
(logging "~S" c))))
(defun show-prompt ()
(show-terminal)
;;(show-terminal)
(setf *prompt* (make-instance 'ip-prompt))
(move-to *prompt* *terminal-left* *terminal-bottom*))
......
......@@ -199,6 +199,15 @@
(show-help))
;; Showing a help box:1 ends here
;; Visiting buffers
;; [[file:~/xelf/gui.org::*Visiting%20buffers][Visiting buffers:1]]
(defmethod visit ((buffer buffer))
(when (shell-p buffer)
(close-menus *menubar*)))
;; Visiting buffers:1 ends here
;; Handling events
......@@ -220,6 +229,12 @@
(t (with-shell (shell-prompt))))))
(when (find-object node :noerror)
(handle-event (find-object node) event)))))))))
(defmethod handle-event :around ((self buffer) event)
(if (and (eq :escape (first (first event)))
(shell-p self))
(close-shell self)
(call-next-method)))
;; Handling events:1 ends here
;; Finding and indexing buffers by name
......@@ -1365,19 +1380,19 @@
;; scroll wheel (middle) click and shift click are equivalent
((or (= button 2)
(and (holding-shift) (= button 1)))
(scroll-tap it x y))
(scroll-tap self x y))
;; vertical scrolling with mousewheel
((= button 4)
(scroll-up it))
(scroll-up self))
((= button 5)
(scroll-down it))
(scroll-down self))
;; horizontal scrolling with shift-mousewheel
((and (= button 4)
(holding-shift))
(scroll-left it))
(scroll-left self))
((and (= button 5)
(holding-shift))
(scroll-right it))
(scroll-right self))
;; plain old click
(t
(process-tap self it x y)))))
......@@ -1396,13 +1411,39 @@
(with-shell (when *menubar* (close-menus *menubar*))
(let ((menus (find-instances self 'context-menu)))
(mapc #'destroy menus))))
(defmethod alternate-tap ((self buffer) x y)
(show-context-menu self))
(defmethod scroll-tap ((self buffer) x y))
(defmethod scroll-up ((self buffer)))
(defmethod scroll-down ((self buffer)))
(defmethod scroll-left ((self buffer)))
(defmethod scroll-right ((self buffer)))
(defmethod scroll-distance ((self buffer) direction) 10)
(defmethod scroll-position ((self buffer) x y direction)
(let ((distance (scroll-distance self direction)))
(ecase direction
(:up (values x (- y distance)))
(:down (values x (+ y distance)))
(:left (values (- x distance) y))
(:right (values (+ x distance) y)))))
(defmethod scroll-tap ((self buffer) x y)
(snap-window-to self 0 0))
(defmethod scroll ((self buffer) direction)
(multiple-value-bind (x y)
(scroll-position self (window-x) (window-y) direction)
(glide-window-to self x y)))
(defmethod scroll-up ((self buffer))
(scroll self :up))
(defmethod scroll-down ((self buffer))
(scroll self :down))
(defmethod scroll-left ((self buffer))
(scroll self :left))
(defmethod scroll-right ((self buffer))
(scroll self :right))
;; Focus and dragging:1 ends here
;; Basic help text
......
......@@ -245,6 +245,14 @@ See also "Command shell" below.
(show-help))
#+end_src
** Visiting buffers
#+begin_src lisp
(defmethod visit ((buffer buffer))
(when (shell-p buffer)
(close-menus *menubar*)))
#+end_src
** Handling events
#+begin_src lisp
......@@ -265,6 +273,12 @@ See also "Command shell" below.
(t (with-shell (shell-prompt))))))
(when (find-object node :noerror)
(handle-event (find-object node) event)))))))))
(defmethod handle-event :around ((self buffer) event)
(if (and (eq :escape (first (first event)))
(shell-p self))
(close-shell self)
(call-next-method)))
#+end_src
** Finding and indexing buffers by name
......@@ -1386,19 +1400,19 @@ This section is obsolete and will be removed in the future.
;; scroll wheel (middle) click and shift click are equivalent
((or (= button 2)
(and (holding-shift) (= button 1)))
(scroll-tap it x y))
(scroll-tap self x y))
;; vertical scrolling with mousewheel
((= button 4)
(scroll-up it))
(scroll-up self))
((= button 5)
(scroll-down it))
(scroll-down self))
;; horizontal scrolling with shift-mousewheel
((and (= button 4)
(holding-shift))
(scroll-left it))
(scroll-left self))
((and (= button 5)
(holding-shift))
(scroll-right it))
(scroll-right self))
;; plain old click
(t
(process-tap self it x y)))))
......@@ -1417,13 +1431,40 @@ This section is obsolete and will be removed in the future.
(with-shell (when *menubar* (close-menus *menubar*))
(let ((menus (find-instances self 'context-menu)))
(mapc #'destroy menus))))
(defmethod alternate-tap ((self buffer) x y)
(show-context-menu self))
(defmethod scroll-tap ((self buffer) x y))
(defmethod scroll-up ((self buffer)))
(defmethod scroll-down ((self buffer)))
(defmethod scroll-left ((self buffer)))
(defmethod scroll-right ((self buffer)))
(defmethod scroll-distance ((self buffer) direction) 10)
(defmethod scroll-position ((self buffer) x y direction)
(let ((distance (scroll-distance self direction)))
(ecase direction
(:up (values x (- y distance)))
(:down (values x (+ y distance)))
(:left (values (- x distance) y))
(:right (values (+ x distance) y)))))
(defmethod scroll-tap ((self buffer) x y)
(snap-window-to self 0 0))
(defmethod scroll ((self buffer) direction)
(multiple-value-bind (x y)
(scroll-position self (window-x) (window-y) direction)
(glide-window-to self x y)))
(defmethod scroll-up ((self buffer))
(scroll self :up))
(defmethod scroll-down ((self buffer))
(scroll self :down))
(defmethod scroll-left ((self buffer))
(scroll self :left))
(defmethod scroll-right ((self buffer))
(scroll self :right))
#+end_src
* Basic help text
......@@ -6038,7 +6079,7 @@ replace the original grid with this one."
(defmethod process-tap :after ((cell-sheet cell-sheet) (node node) x y)
(multiple-value-bind (cell row column) (cell-at cell-sheet x y)
(when cell
(follow-with-camera cell-sheet node))))
(glide-window-to-node cell-sheet node))))
#+end_src
** Buffer list sheet
......@@ -6070,8 +6111,6 @@ replace the original grid with this one."
(do-nodes (node buffer-list)
(destroy node))
(populate buffer-list)))
#+end_src
#+begin_src lisp :tangle commands.lisp
......
......@@ -57,8 +57,8 @@ directory included with this application.
;; [[file:~/xelf/doc/squareball.org::*Showing%20the%20copyright%20notice][Showing the copyright notice:2]]
(defun show-copyright-notice ()
(dolist (line (split-string-on-lines *squareball-copyright-notice*))
(message line))
(show-terminal))
(message line)))
;;(show-terminal))
;; Showing the copyright notice:2 ends here
;; Display properties
......@@ -2224,7 +2224,7 @@ directory included with this application.
(logging "~S" c))))
(defun show-prompt ()
(show-terminal)
;;(show-terminal)
(setf *prompt* (make-instance 'ip-prompt))
(move-to *prompt* *terminal-left* *terminal-bottom*))
......
* Demo
** TODO start with desktop
** TODO show cell sheet
** TODO show cell selection
** TODO show layout change in cells when opening/closing menu
** TODO show create buffer
** TODO show change class
** TODO show image browser
* Task list
** TODO close menus after buffer switch
** TODO fix weird buffer switches
** TODO fix ESC binding not being caught by open shell
** TODO cell cursor movement
** TODO cell scrolling
** TODO buffer scrolling with mouse wheel
** TODO context tool buttons on / above modeline
** TODO [#A] allow recursive buffer view and split views
**** TODO buffer-proxy class
......@@ -1314,3 +1308,18 @@
:ARCHIVE_CATEGORY: tasks
:ARCHIVE_TODO: DONE
:END:
** Demo
:PROPERTIES:
:ARCHIVE_TIME: 2017-04-27 Thu 08:45
:ARCHIVE_FILE: ~/xelf/tasks.org
:ARCHIVE_CATEGORY: tasks
:END:
*** TODO start with desktop
*** TODO show cell sheet
*** TODO show cell selection
*** TODO show layout change in cells when opening/closing menu
*** TODO show create buffer
*** TODO show change class
*** TODO show image browser
(in-package :plong)
(in-package :squareball)
(defclass plong-gui (plong) ())
;; (defclass plong-gui (plong) ())
(defmethod initialize-instance :after ((self plong-gui) &key)
(open-shell self))
;; (defmethod initialize-instance :after ((self plong-gui) &key)
;; (open-shell self))
(defmethod update :before ((self plong-gui))
;; (let ((ball (find-instances self 'ball)))
;; (when ball (destroy (first ball))))
(when (and xelf::*shell* (shell-p self))
(update xelf::*shell*)))
;; (defmethod update :before ((self plong-gui))
;; ;; (let ((ball (find-instances self 'ball)))
;; ;; (when ball (destroy (first ball))))
;; (when (and xelf::*shell* (shell-p self))
;; (update xelf::*shell*)))
(defun test-gui ()
(setf *screen-width* 800)
(setf *screen-height* 450)
(setf *resizable* t)
(setf *scale-output-to-window* nil)
(setf *debug-on-error* nil)
(setf *shell-enabled-p* t)
(setf xelf::*font* "sans-11")
(with-session
(open-project :plong)
(xelf::index-all-images)
(xelf::index-pending-resources)
(xelf::preload-resources)
(let ((plong (make-instance 'xelf::desktop)))
;; start the buffer running
(switch-to-buffer plong))))
;; (at-next-update
;; (add-node (current-buffer) (make-instance 'xelf::resize-buffer-dialog) 200 200)
;;(xelf::show-buffer-properties-dialog (current-buffer))
;; (bind-event (current-buffer) '(:f9) 'xelf::toggle-other-windows)
;; (start-game plong)))))
;; (defun test-gui ()
;; (setf *screen-width* 800)
;; (setf *screen-height* 450)
;; (setf *resizable* t)
;; (setf *scale-output-to-window* nil)
;; (setf *debug-on-error* nil)
;; (setf *shell-enabled-p* t)
;; (setf xelf::*font* "sans-11")
;; (with-session
;; (open-project :plong)
;; (xelf::index-all-images)
;; (xelf::index-pending-resources)
;; (xelf::preload-resources)
;; (let ((plong (make-instance 'xelf::desktop)))
;; ;; start the buffer running
;; (switch-to-buffer plong))))
;; ;; (at-next-update
;; ;; (add-node (current-buffer) (make-instance 'xelf::resize-buffer-dialog) 200 200)
;; ;;(xelf::show-buffer-properties-dialog (current-buffer))
;; ;; (bind-event (current-buffer) '(:f9) 'xelf::toggle-other-windows)
;; ;; (start-game plong)))))
(trace xelf::all-images)
(trace xelf::all-buffers)
......@@ -95,6 +95,14 @@
(trace xelf::add-node)
(trace xelf::index-all-images)
(trace xelf::glide-window-to)
(trace xelf::snap-windows-to)
(trace xelf::handle-event)
(trace xelf::scroll-tap)
(trace xelf::scroll-position)
(trace xelf::scroll-distance)
(trace xelf::scroll)
;; (untrace xelf::layout)
;; (trace xelf::draw-cell)
;; (trace xelf::cell-bounding-box)
......@@ -102,5 +110,5 @@
;; (trace xelf::draw-string-in-cell)
;; (trace xelf::draw-row-header)
;; (trace xelf::draw-column-header)
(test-gui)
(squareball:squareball)
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