Commits

Anonymous committed 8180356

Reduced CPU usage by trying to only flush the console when necessary.
Show mouse status in the bottom line in the GUI demo.

  • Participants
  • Parent commits 4a574cf

Comments (0)

Files changed (2)

             (window-changed? win))
        (prepare-window win)
        (redraw-window-area win :draw-window t)
-       (console-flush)
+       (dirty-window win)   ; (console-flush)
        (setf (window-changed? win) nil))
       (*focus-changed?*
        (redraw-window-area win :draw-window t)))))
 
 
+(defmethod dirty-window ((win <Window>))
+  (console-set-dirty (window-tlx win) (window-tly win)
+                     (window-width win) (window-height win)))
+
 
 (defmethod window-parent ((win <Window>))
   ;; TODO inefficient
     (prepare-window win))
   (console-clear *root*)
   (copy-windows-to-console *window-stack* *root*)
-  (console-flush))
+  (console-set-dirty 0 0 (screen-width) (screen-height)))
 
 
 (defun copy-windows-to-console (window-list con)
   (setf (window-hidden? win) nil)
   (setf (window-changed? win) t)
   (push win *window-stack*)
+  (dirty-window win)
   (when (window-children win)
     (dolist (child  (window-children win))
       (when (or (window-raise-children-with-parent? win)
   (dolist (w (nreverse (windows-overlapping win :include-window? draw-window)))
     (redraw-window-intersection w win
                                 :fade (fade-for-window w)))
-  (console-flush))
+  (dirty-window win))
 
 
 (defun redraw-all-at (rootx rooty)
 			 winx winy))
 	(otherwise
          (let ((matching (find-if #'(lambda (item)
-                                      (same-keys? (list-item-hotkey item) k))
+                                      (and (key-p (list-item-hotkey item))
+                                           (same-keys? (list-item-hotkey item) k)))
                                   (window-items win))))
            (cond 
              (matching
   (unless (window-hidden? win)
     (when (or (/= *mouse-x* (last-mousex win))
 	      (/= *mouse-y* (last-mousey win)))
-;;    (unless (eql (top-window-at *mouse-x* *mouse-y*) (window-owner win))
-    (hide-window win))
+      ;;    (unless (eql (top-window-at *mouse-x* *mouse-y*) (window-owner win))
+      (dirty-window win)
+      (hide-window win))
     (setf (last-mousex win) *mouse-x*
 	  (last-mousey win) *mouse-y*)))
 
 The loop runs until the global variable [[*exit-gui?*]] is non-nil.
 "
   (let ((k (make-key))
-	    (rodent (make-mouse))
-	    (last-rodent (make-mouse))
-	    (topwin nil) (last-topwin nil))
+        (rodent (make-mouse))
+        (last-rodent (make-mouse))
+        (topwin nil) (last-topwin nil))
     (redraw-all-windows)
     (setf *exit-gui?* nil)
-    (break)
     ;; Main loop
     (iterate
       (until *exit-gui?*)
-      (console-flush)
+      (console-flush) 
       (iterate
-        (until (setf k (console-check-for-keypress
-                        '(:key-pressed :key-released))))
-	(process-windows)
+        (setf k (console-check-for-keypress
+                 '(:key-pressed :key-released)))
+        (if k (leave))
+	(process-windows) 
 	(setf rodent (mouse-get-status))
-        ;(break)
 	(unless (equal rodent last-rodent)
 	  ;; Deal with mouse events
 	  (setf *mouse-x* (mouse-cx rodent)
 					(- *mouse-x* (window-tlx topwin))
 					(- *mouse-y* (window-tly topwin)))))
 		     (return))))))
-		 ;; (unless dragged?
-		 ;;   ;; Just click
-		 ;;   (send-to-window topwin :left nil
-		 ;;        	   (- *mouse-x* (window-tlx topwin))
-		 ;;        	   (- *mouse-y* (window-tly topwin)))))))
+            ;; (unless dragged?
+            ;;   ;; Just click
+            ;;   (send-to-window topwin :left nil
+            ;;        	   (- *mouse-x* (window-tlx topwin))
+            ;;        	   (- *mouse-y* (window-tly topwin)))))))
             
 	    
 	    (t				; mouse "just hovering"
-             ;(break)
+                                        ;(break)
 	     (when topwin
 	       (send-to-window topwin :hover :unspecified ;(mouse-flags rodent)
 			       (- *mouse-x* (window-tlx topwin))
 			       (- *mouse-y* (window-tly topwin))))))
-	  (console-flush)))
-      
+          ;; CONSOLE-FLUSH should not be done every iteration, which
+          ;; is what was happening below.
+          ;; This has been changed so now we only flush the console if the
+          ;; mouse moves/mouse status changes, or a key is pressed.
+          ;; It seems to work.
+          ;;
+          ;; Alternative plan could be to time since last flush, limit to
+          ;; < 20 fps.
+          (unless (equal rodent last-rodent)
+            (setf last-rodent rodent)
+            (console-flush))
+          ))
+
       (case (key-vk k)
 	(:shift (setf *shift* (key-pressed k)))
 	(:control (setf *ctrl* (key-pressed k)))
 (defpackage :tcod.gui-demo
   (:nicknames :gui-demo)
   (:use :cl :tcod :dormouse)
-  (:export #:gui-demo))
+  (:export #:gui-demo
+           #:resume-gui))
 
 (in-package :tcod.gui-demo)
 
 
 (defmethod send-to-window ((win <MyViewport>) (data (eql :hover)) parm winx winy)
   (declare (ignore parm))
-  (bottom-message "~4D fps  [~C~C~C] MAP POSITION = ~3D ~3D"
+  (bottom-message "~4D fps  [~C~C~C] [~C~C~C] [~C~C~C] MAP POSITION = ~3D ~3D"
                   (sys-get-fps)
-		  (if *shift* #\S #\space)
-		  (if *ctrl* #\C #\space)
-		  (if *alt* #\A #\space)
-		  (winx->mapx win winx)
-		  (winy->mapy win winy)))
+                  (if *shift* #\S #\space)
+                  (if *ctrl* #\C #\space)
+                  (if *alt* #\A #\space)
+                  (if (plusp (mouse-get-lbutton)) #\L #\space)
+                  (if (plusp (mouse-get-mbutton)) #\M #\space)
+                  (if (plusp (mouse-get-rbutton)) #\R #\space)
+                  (if (plusp (mouse-get-lbutton-pressed)) #\l #\space)
+                  (if (plusp (mouse-get-mbutton-pressed)) #\m #\space)
+                  (if (plusp (mouse-get-rbutton-pressed)) #\r #\space)
+                  (winx->mapx win winx)
+                  (winy->mapy win winy)))
 
 
 (defclass <MyDialog-Window> (<Dialog-Window>)