src/clfswm-placement.lisp

   1 ;;; --------------------------------------------------------------------------
   2 ;;; CLFSWM - FullScreen Window Manager
   3 ;;;
   4 ;;; --------------------------------------------------------------------------
   5 ;;; Documentation: Placement functions
   6 ;;; --------------------------------------------------------------------------
   7 ;;;
   8 ;;; (C) 2010 Philippe Brochard <hocwp@free.fr>
   9 ;;;
  10 ;;; This program is free software; you can redistribute it and/or modify
  11 ;;; it under the terms of the GNU General Public License as published by
  12 ;;; the Free Software Foundation; either version 3 of the License, or
  13 ;;; (at your option) any later version.
  14 ;;;
  15 ;;; This program is distributed in the hope that it will be useful,
  16 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;;; GNU General Public License for more details.
  19 ;;;
  20 ;;; You should have received a copy of the GNU General Public License
  21 ;;; along with this program; if not, write to the Free Software
  22 ;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  23 ;;;
  24 ;;; --------------------------------------------------------------------------
  25
  26 (in-package :clfswm)
  27
  28 (defun get-placement-values (placement &optional (width 0) (height 0))
  29   (typecase placement
  30     (list (values (first placement)
  31                   (second placement)))
  32     (function (funcall placement width height))
  33     (symbol
  34      (if (fboundp placement)
  35          (funcall placement width height)
  36          (values 0 0)))
  37     (t (values 0 0))))
  38
  39 (defmacro with-placement ((placement x y &optional (width 0) (height 0)) &body body)
  40   `(multiple-value-bind (,x ,y)
  41        (get-placement-values ,placement ,width ,height)
  42      ,@body))
  43
  44 ;;;; Test functions
  45 ;;
  46 ;;(defun fun-placement (&optional width height)
  47 ;;  (declare (ignore width height))
  48 ;;  (values 30 40))
  49 ;;
  50 ;;(defparameter *placement-test* (list 10 20))
  51 ;;;;(defparameter *placement-test* #'fun-placement)
  52 ;;;;(defparameter *placement-test* 'fun-placement)
  53 ;;
  54 ;;(defun toto ()
  55 ;;  (with-placement (*placement-test* x y)
  56 ;;    (format t "X=~A  Y=~A~%" x y)))
  57
  58 ;;;
  59 ;;; Absolute placement
  60 ;;;
  61 (defun top-left-placement (&optional (width 0) (height 0))
  62   (declare (ignore width height))
  63   (values 0 0))
  64
  65 (defun top-middle-placement (&optional (width 0) (height 0))
  66   (declare (ignore height))
  67   (values (truncate (/ (- (xlib:screen-width *screen*) width) 2))
  68           0))
  69
  70 (defun top-right-placement (&optional (width 0) (height 0))
  71   (declare (ignore height))
  72   (values (- (xlib:screen-width *screen*) width 1)
  73           0))
  74
  75
  76
  77 (defun middle-left-placement (&optional (width 0) (height 0))
  78   (declare (ignore width))
  79   (values 0
  80           (truncate (/ (- (xlib:screen-height *screen*) height) 2))))
  81
  82 (defun middle-middle-placement (&optional (width 0) (height 0))
  83   (values (truncate (/ (- (xlib:screen-width *screen*) width) 2))
  84           (truncate (/ (- (xlib:screen-height *screen*) height) 2))))
  85
  86 (defun middle-right-placement (&optional (width 0) (height 0))
  87   (values (- (xlib:screen-width *screen*) width 1)
  88           (truncate (/ (- (xlib:screen-height *screen*) height) 2))))
  89
  90
  91 (defun bottom-left-placement (&optional (width 0) (height 0))
  92   (declare (ignore width))
  93   (values 0
  94           (- (xlib:screen-height *screen*) height 1)))
  95
  96 (defun bottom-middle-placement (&optional (width 0) (height 0))
  97   (values (truncate (/ (- (xlib:screen-width *screen*) width) 2))
  98           (- (xlib:screen-height *screen*) height 1)))
  99
 100 (defun bottom-right-placement (&optional (width 0) (height 0))
 101   (values (- (xlib:screen-width *screen*) width 1)
 102           (- (xlib:screen-height *screen*) height 1)))
 103
 104
 105 ;;;
 106 ;;; Current child placement
 107 ;;;
 108 (defun current-child-coord ()
 109   (typecase *current-child*
 110     (xlib:window (values (xlib:drawable-x *current-child*)
 111                          (xlib:drawable-y *current-child*)
 112                          (xlib:drawable-width *current-child*)
 113                          (xlib:drawable-height *current-child*)))
 114     (frame (values (frame-rx *current-child*)
 115                    (frame-ry *current-child*)
 116                    (frame-rw *current-child*)
 117                    (frame-rh *current-child*)))
 118     (t (values 0 0 10 10))))
 119
 120 (defmacro with-current-child-coord ((x y w h) &body body)
 121   `(multiple-value-bind (,x ,y ,w ,h)
 122        (current-child-coord)
 123      ,@body))
 124
 125
 126 (defun top-left-child-placement (&optional (width 0) (height 0))
 127   (declare (ignore width height))
 128   (with-current-child-coord (x y w h)
 129     (declare (ignore w h))
 130     (values (+ x 2)
 131             (+ y 2))))
 132
 133 (defun top-middle-child-placement (&optional (width 0) (height 0))
 134   (declare (ignore height))
 135   (with-current-child-coord (x y w h)
 136     (declare (ignore h))
 137     (values (+ x (truncate (/ (- w width) 2)))
 138             (+ y 2))))
 139
 140 (defun top-right-child-placement (&optional (width 0) (height 0))
 141   (declare (ignore height))
 142   (with-current-child-coord (x y w h)
 143     (declare (ignore h))
 144     (values (+ x (- w width 2))
 145             (+ y 2))))
 146
 147
 148
 149 (defun middle-left-child-placement (&optional (width 0) (height 0))
 150   (declare (ignore width))
 151   (with-current-child-coord (x y w h)
 152     (declare (ignore w))
 153     (values (+ x 2)
 154             (+ y (truncate (/ (- h height) 2))))))
 155
 156 (defun middle-middle-child-placement (&optional (width 0) (height 0))
 157   (with-current-child-coord (x y w h)
 158     (values (+ x (truncate (/ (- w width) 2)))
 159             (+ y (truncate (/ (- h height) 2))))))
 160
 161 (defun middle-right-child-placement (&optional (width 0) (height 0))
 162   (with-current-child-coord (x y w h)
 163     (values (+ x (- w width 2))
 164             (+ y (truncate (/ (- h height) 2))))))
 165
 166
 167 (defun bottom-left-child-placement (&optional (width 0) (height 0))
 168   (declare (ignore width))
 169   (with-current-child-coord (x y w h)
 170     (declare (ignore w))
 171     (values (+ x 2)
 172             (+ y (- h height 2)))))
 173
 174 (defun bottom-middle-child-placement (&optional (width 0) (height 0))
 175   (with-current-child-coord (x y w h)
 176     (values (+ x (truncate (/ (- w width) 2)))
 177             (+ y (- h height 2)))))
 178
 179 (defun bottom-right-child-placement (&optional (width 0) (height 0))
 180   (with-current-child-coord (x y w h)
 181     (values (+ x (- w width 2))
 182             (+ y (- h height 2)))))