GNOME.org
 

sawfish r4372 - in trunk: . lisp/sawfish/wm lisp/sawfish/wm/animation lisp/sawfish/wm/commands lisp/sawfish/wm/util man

Author: chrisb
Date: Sun Jan 18 11:48:37 2009
New Revision: 4372
URL: http://svn.gnome.org/viewvc/sawfish?rev=4372&view=rev

Log:
added 3 new animators (cross, elliptical and draft)


Modified:
   trunk/ChangeLog
   trunk/OPTIONS
   trunk/lisp/sawfish/wm/animation/outline.jl
   trunk/lisp/sawfish/wm/autoload.jl
   trunk/lisp/sawfish/wm/commands/move-resize.jl
   trunk/lisp/sawfish/wm/util/window-outline.jl
   trunk/lisp/sawfish/wm/window-anim.jl
   trunk/man/news.texi

Modified: trunk/OPTIONS
==============================================================================
--- trunk/OPTIONS	(original)
+++ trunk/OPTIONS	Sun Jan 18 11:48:37 2009
@@ -26,12 +26,12 @@
 
 ;; window animation options
 
-;; sawfish-ui does use a treeview by default, if you prefer the 
+;; sawfish-ui does use a treeview by default, if you prefer the
 ;; notebook-style instead use: sawfish-ui --flatten
 
 ;;  (define-special-variable default-window-animator 'none
 ;;    "The default window animation mode. Options include none,
-;;wireframe and solid.")
+;;wireframe, solid, cross, elliptical and draft.")
 
 ;;  (define-special-variable anim-outline-icon-coords
 ;;    (cons (screen-width) (screen-height))
@@ -55,7 +55,7 @@
 ;;  (define-special-variable customize-command-classes '(default)
 ;;    "Also include commands of these classes the key bindings panel.
 ;;Add the `viewport' keyboard to make viewport commands show up.")
- 
+
 ;; focus options
 
 ;;  (define-special-variable focus-mode 'click
@@ -243,10 +243,10 @@
 ;; move/resize options
 
 ;;  (define-special-variable move-outline-mode 'opaque
-;;    "How windows being moved are animated, either `opaque' or `box'")
+;;    "How windows being moved are animated, either opaque, box, cross, elliptical or draft")
 
 ;;  (define-special-variable resize-outline-mode 'opaque
-;;    "How windows being resized are animated, either `opaque' or `box'")
+;;    "How windows being resized are animated, either opaque, box, cross, elliptical or draft")
 
 ;;  (define-special-variable move-resize-raise-window nil
 ;;    "Raise windows when they are moved or resized.")
@@ -363,7 +363,7 @@
 ;;    '(sticky ignored never-focus type maximized frame-style
 ;;      cycle-skip window-list-skip)
 ;;    "List of states in window-state-change-hook that should be tracked.")
-;;  
+;;
 ;;  (define-special-variable window-history-key-property 'WM_CLASS
 ;;    "Window property matched on.")
 

Modified: trunk/lisp/sawfish/wm/animation/outline.jl
==============================================================================
--- trunk/lisp/sawfish/wm/animation/outline.jl	(original)
+++ trunk/lisp/sawfish/wm/animation/outline.jl	Sun Jan 18 11:48:37 2009
@@ -75,7 +75,7 @@
 	(call-with-exception-handler fun (lambda (ex)
 					   (stop)
 					   (raise-exception ex))))
-      
+
       (define (clear)
 	(unless (zerop step)
 	  (protect (lambda ()
@@ -126,7 +126,13 @@
 
   (define wireframe-animator (make-outline-animator 'box))
   (define solid-animator (make-outline-animator 'solid))
+  (define cross-animator (make-outline-animator 'cross))
+  (define elliptical-animator (make-outline-animator 'elliptical))
+  (define draft-animator (make-outline-animator 'draft))
 
   ;;###autoload
   (define-window-animator 'wireframe wireframe-animator)
-  (define-window-animator 'solid solid-animator))
+  (define-window-animator 'solid solid-animator)
+  (define-window-animator 'cross cross-animator)
+  (define-window-animator 'elliptical elliptical-animator)
+  (define-window-animator 'draft draft-animator))

Modified: trunk/lisp/sawfish/wm/autoload.jl
==============================================================================
--- trunk/lisp/sawfish/wm/autoload.jl	(original)
+++ trunk/lisp/sawfish/wm/autoload.jl	Sun Jan 18 11:48:37 2009
@@ -33,6 +33,9 @@
 (autoload-command (quote popup-apps-menu) (quote sawfish.wm.menus))
 (autoload-window-animator 'wireframe 'sawfish.wm.animation.outline)
 (autoload-window-animator 'solid 'sawfish.wm.animation.outline)
+(autoload-window-animator 'cross 'sawfish.wm.animation.outline)
+(autoload-window-animator 'elliptical 'sawfish.wm.animation.outline)
+(autoload-window-animator 'draft 'sawfish.wm.animation.outline)
 (autoload-command (quote next-workspace-window) (quote sawfish.wm.commands.cycle))
 (autoload-command (quote previous-workspace-window) (quote sawfish.wm.commands.cycle))
 (autoload-command (quote next-window) (quote sawfish.wm.commands.cycle))

Modified: trunk/lisp/sawfish/wm/commands/move-resize.jl
==============================================================================
--- trunk/lisp/sawfish/wm/commands/move-resize.jl	(original)
+++ trunk/lisp/sawfish/wm/commands/move-resize.jl	Sun Jan 18 11:48:37 2009
@@ -48,15 +48,15 @@
   ;; todo:
   ;;  * obey the aspect ratio size hints
 
- 
+
   (defcustom move-outline-mode 'opaque
     "How windows being moved are animated"
-    :type (choice opaque box)
+    :type (choice opaque box cross elliptical draft)
     :group (appearance animation))
 
   (defcustom resize-outline-mode 'opaque
     "How windows being resized are animated"
-    :type (choice opaque box)
+    :type (choice opaque box cross elliptical draft)
     :group (appearance animation))
 
   (defcustom move-resize-raise-window nil
@@ -68,30 +68,30 @@
     "Show current position of windows while moving."
     :group move
     :type boolean)
-  
+
   (defcustom resize-show-dimensions t
     "Show current dimensions of windows while resizing."
     :group move
     :type boolean)
- 
+
  (defcustom resize-edge-mode 'border-grab
    "How to choose window edges when resizing."
    :type (choice region border grab border-grab)
    :group move)
-  
+
   (defcustom move-snap-epsilon 12
     "Distance in pixels before window edges align with each other."
     :group move
     :type (number 0 64)
     :tooltip "When moving a window, this option lets you align one of its edges with an edge of another window.")
-  
+
   (defvar move-snap-mode 'resistance
     "How to snap together window edges, one of `magnetism', `resistance', or
 `attraction'.")
-  
+
   (defvar move-snap-ignored-windows nil
     "Snap to otherwise-ignored windows.")
-  
+
   (defvar move-resize-inhibit-configure nil
     "Only update window contents after it has stopped moving.")
 
@@ -319,7 +319,7 @@
 		  (y-inc (or (cdr (assq 'height-inc move-resize-hints)) 1))
 		  (min-aspect (assq 'min-aspect move-resize-hints))
 		  (max-aspect (assq 'max-aspect move-resize-hints)))
-               
+
 	       (when (memq resize-edge-mode '(grab border-grab))
 		 (add-edges ptr-x ptr-y))
 	       (cond
@@ -334,7 +334,7 @@
                          (constrain-aspect-to-hints
                           move-resize-width
                           move-resize-old-height 'x min-aspect max-aspect))))
-                
+
 		((memq 'left move-resize-moving-edges)
 		 (setq move-resize-width
 		       (constrain-dimension-to-hints

Modified: trunk/lisp/sawfish/wm/util/window-outline.jl
==============================================================================
--- trunk/lisp/sawfish/wm/util/window-outline.jl	(original)
+++ trunk/lisp/sawfish/wm/util/window-outline.jl	Sun Jan 18 11:48:37 2009
@@ -27,7 +27,8 @@
 	    autoload-window-outliner)
 
     (open rep
-	  rep.util.autoloader)
+	  rep.util.autoloader
+	  sawfish.wm.misc)
 
   (define-structure-alias window-outline sawfish.wm.util.window-outline)
 
@@ -94,4 +95,148 @@
       (x-fill-rectangle 'root gc (cons x y) (cons width height))
       (x-destroy-gc gc)))
 
-  (define-window-outliner 'solid draw-solid-outline))
+  (define-window-outliner 'solid draw-solid-outline)
+
+  (define (draw-cross-outline x y width height)
+    (require 'sawfish.wm.util.x)
+      (let
+        ((gc (x-create-root-xor-gc))
+         (ul (cons x y))                      ; upper left
+         (ur (cons (+ x width) y))            ; upper right
+         (ll (cons x (+ y height)))           ; lower left
+         (lr (cons (+ x width) (+ y height))) ; lower right
+        )
+      ; perimeter outline
+      (x-draw-line 'root gc ul ur)
+      (x-draw-line 'root gc ll lr)
+      (x-draw-line 'root gc ul ll)
+      (x-draw-line 'root gc ur lr)
+      ; cross
+      (x-draw-line 'root gc ul lr)
+      (x-draw-line 'root gc ur ll)
+      (x-destroy-gc gc)))
+
+  (define-window-outliner 'cross draw-cross-outline)
+
+  (define (draw-elliptical-outline x y width height)
+    (require 'sawfish.wm.util.x)
+    (let
+      ((gc (x-create-root-xor-gc))
+       (height-prime (inexact->exact (floor (* height 1.4142))))
+       (width-prime  (inexact->exact (floor (* width 1.4142))))
+      )
+    ; draw the circumscribed ellipse (the outside one)
+    (x-draw-arc 'root gc (cons (inexact->exact (- x (floor (/ width 4.8))))
+			       (inexact->exact (- y (floor (/ height 4.8)))))
+		(cons width-prime height-prime)
+		(cons 0 (* 360 64)))
+    ; draw the inscribed ellipse (the inside one)
+    (x-draw-arc 'root gc (cons x y)
+		(cons width height)
+		(cons 0 (* 360 64)))
+    (x-destroy-gc gc)))
+
+  (define-window-outliner 'elliptical draw-elliptical-outline)
+
+  (define (draw-draft-line rw gc pta ptb dim-p arrow-p)
+    (require 'sawfish.wm.util.x)
+    (let ((pta-x (car pta)) ; recover the components
+	(pta-y (cdr pta))
+	(ptb-x (car ptb))
+	(ptb-y (cdr ptb))
+	(delta-x (- (car ptb) (car pta))) ; figure out the difference
+	(delta-y (- (cdr ptb) (cdr pta)))
+	(xah 4)  ; cope with different window scales
+	(yah 3)  ; to ensure arrow heads look the same
+	(x-dim-offset 5) ; how far to offset the dimension from the
+	(y-dim-offset 5) ; draft line
+	)
+    ; first off, we know we are going to draw the line, always
+    (x-draw-line rw gc pta ptb)
+    ; now figure out if we drawing vertically or horizontally
+    (if (= pta-x ptb-x)
+	(progn ; vertical
+	 (if dim-p
+	     (x-draw-string rw gc (cons (+ pta-x x-dim-offset)
+					(+ pta-y (floor (/ delta-y 2)))
+					)
+			    (format nil "%d" delta-y)))
+	 (if arrow-p
+	     (progn
+	       (x-draw-line rw gc pta (cons (+ pta-x xah) (+ pta-y yah)))
+	       (x-draw-line rw gc pta (cons (- pta-x xah) (+ pta-y yah)))
+	       (x-draw-line rw gc ptb (cons (+ ptb-x xah) (- ptb-y yah)))
+	       (x-draw-line rw gc ptb (cons (- ptb-x xah) (- ptb-y yah)))
+	      ))
+	 )
+	(progn ; horizontal
+         (if dim-p
+	   (x-draw-string rw gc (cons (+ pta-x (floor (/ delta-x 2)))
+				      (- pta-y y-dim-offset)
+				      )
+			    (format nil "%d" delta-x)))
+         (if arrow-p
+	     (progn
+	       (x-draw-line rw gc pta (cons (+ pta-x xah) (+ pta-y yah)))
+	       (x-draw-line rw gc pta (cons (+ pta-x xah) (- pta-y yah)))
+	       (x-draw-line rw gc ptb (cons (- ptb-x xah) (+ ptb-y yah)))
+	       (x-draw-line rw gc ptb (cons (- ptb-x xah) (- ptb-y yah)))
+	       ))
+        ))))
+
+  (define (draw-draft-outline x y width height)
+    (require 'sawfish.wm.util.x)
+    (let
+      ((gc (x-create-root-xor-gc))
+       ; window Upper (Left Middle Right)
+       (ul (cons x y))
+       (um (cons (+ x (floor (/ width 2))) y))
+       (ur (cons (+ x width) y))
+
+       ; window Middle (Left Right)
+       (ml (cons x           (+ y (floor (/ height 2)))))
+       (mr (cons (+ x width) (+ y (floor (/ height 2)))))
+
+       ; window Lower (Left Middle Right)
+       (ll (cons x (+ y height)))
+       (lm (cons (+ x (floor (/ width 2))) (+ y height)))
+       (lr (cons (+ x width) (+ y height)))
+
+       ; window Screen (Left Right Top Bottom)
+       (sl (cons 0              (+ y (floor (/ height 2)))))
+       (sr (cons (screen-width) (+ y (floor (/ height 2)))))
+       (st (cons (+ x (floor (/ width 2))) 0))
+       (sb (cons (+ x (floor (/ width 2))) (screen-height)))
+
+       (offset 3) ; how much to offset the guidelines from the window
+       )
+    ; perimeter outline of window + frame
+    ; is there an x-draw-retangle ?
+    (x-draw-line 'root gc ul ur)
+    (x-draw-line 'root gc ll lr)
+    (x-draw-line 'root gc ul ll)
+    (x-draw-line 'root gc ur lr)
+    ; from screen left to left border
+    (x-draw-line 'root gc (cons 0 y)            (cons (- x offset) y))
+    (x-draw-line 'root gc (cons 0 (+ y height))
+		 (cons (- x offset) (+ y height)))
+    (draw-draft-line 'root gc sl ml t t)
+    ; from screen top to top border
+    (x-draw-line 'root gc (cons x 0) (cons x (- y offset)))
+    (x-draw-line 'root gc (cons (+ x width) 0) (cons (+ x width) (- y offset)))
+    (draw-draft-line 'root gc st um t t)
+    ; from screen right to right border
+    (x-draw-line 'root gc (cons (screen-width) y)
+		 (cons (+ x width offset) y))
+    (x-draw-line 'root gc (cons (screen-width) (+ y height))
+		 (cons (+ x width offset) (+ y height)))
+    (draw-draft-line 'root gc mr sr t t)
+    ; from screen bottom to bottom border
+    (x-draw-line 'root gc (cons x (screen-height))
+		 (cons x (+ y height offset)))
+    (x-draw-line 'root gc (cons (+ x width) (screen-height))
+		 (cons (+ x width) (+ y height offset)))
+    (draw-draft-line 'root gc lm sb 't 't)
+    (x-destroy-gc gc)))
+
+  (define-window-outliner 'draft draw-draft-outline))

Modified: trunk/lisp/sawfish/wm/window-anim.jl
==============================================================================
--- trunk/lisp/sawfish/wm/window-anim.jl	(original)
+++ trunk/lisp/sawfish/wm/window-anim.jl	Sun Jan 18 11:48:37 2009
@@ -41,7 +41,7 @@
 
   (defcustom default-window-animator 'none
     "The default window animation mode"
-    :type (choice none solid wireframe)
+    :type (choice none solid wireframe cross elliptical draft)
     :group (appearance animation))
 
 ;;; animator registration
@@ -59,7 +59,7 @@
       ))
 
   (define (getter name) (get name 'window-animator))
-  
+
   (define autoload-window-animator
     (make-autoloader getter define-window-animator))
 

Modified: trunk/man/news.texi
==============================================================================
--- trunk/man/news.texi	(original)
+++ trunk/man/news.texi	Sun Jan 18 11:48:37 2009
@@ -40,6 +40,8 @@
 @item Warp cursor to cycled windows, if warp-cursor is enabled [Christopher Bratusek]
 
 @item Warp cursor to unmaximied windows, if warp-cursor is enabled [Fernando Carmona Varo]
+
+ item 3 New Window-Animators: cross, elliptical and draft [Christopher Bratusek]
 @end itemize
 
 @item Other changes:
@@ -259,7 +261,7 @@
 @itemize @bullet
 
 @item The 1.3.1 version is released to let people know that Sawfish is being
-revived by the community, and we are awaiting patches to be submitted 
+revived by the community, and we are awaiting patches to be submitted
 for incoming 1.3.2 release
 
 @item John Harper resigns from Sawfish maintainership and Sawfish community takes
@@ -367,7 +369,7 @@
 Timar, Sava Chankov, Christian Neumair, Peteris Krisjanis, Gustavo
 Noronha Silva, Christian Meyer, Fatih Demir, Hasbullah Bin Pit,
 Christophe Fergeau)
- 
+
 @item Bug fixes:
 
 @itemize @minus
@@ -1227,7 +1229,7 @@
 @item Canonify @kbd{S-x} as @kbd{X} where possible
 
 @item Catch and handle errors when matching properties in the
- code{sawfish wm ext match-window} 
+ code{sawfish wm ext match-window}
 
 @item Escape underscores in menu items where they shouldn't introduce
 accelerators. (Added @code{quote-menu-item} function to help with this)
@@ -2163,7 +2165,7 @@
 
 @item Rewrote workspace handling---windows can now appear on multiple
 workspaces, with each instance having different properties (position,
-size, whatever dots{}) 
+size, whatever dots{})
 
 Create new window instances by using the @code{copy-to-next-workspace},
 @code{copy-to-previous-workspace}, and @code{copy-to-workspace:@var{n}}
@@ -2355,7 +2357,7 @@
 
 @item New command @code{raise-window-and-pass-through-click}; bind it
 to a mouse button in the @code{window-keymap} to get the ``raise window
-on click'' behaviour that seems popular 
+on click'' behaviour that seems popular
 
 @item New commands to move windows incrementally:
 @code{slide-window- var{x}} and @code{slide-group- var{x}} for @var{x}
[Date Prev][Date Next]   [Thread Prev][Thread Next]   [Thread Index] [Date Index] [Author Index]