contrib/osd.lisp

   1 ;;; --------------------------------------------------------------------------
   2 ;;; CLFSWM - FullScreen Window Manager
   3 ;;;
   4 ;;; --------------------------------------------------------------------------
   5 ;;; Documentation: OSD (On Screen Display) for presentations.
   6 ;;; --------------------------------------------------------------------------
   7 ;;;
   8 ;;; (C) 2011 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 ;; Uncomment the line above if you want to use the old OSD method
  29 ;;(pushnew :DISPLAY-OSD *features*)
  30
  31 #-DISPLAY-OSD
  32 (progn
  33   (defparameter *osd-window* nil)
  34   (defparameter *osd-gc* nil)
  35   (defparameter *osd-font* nil)
  36   (defparameter *osd-font-string* "-*-fixed-*-*-*-*-14-*-*-*-*-*-*-1"))
  37
  38
  39 ;;; A more complex example I use to record my desktop and show
  40 ;;; documentation associated to each key press.
  41 #+DISPLAY-OSD
  42 (defun display-doc (function code state)
  43   (let* ((modifiers (state->modifiers state))
  44          (keysym (keysym->keysym-name (xlib:keycode->keysym *display* code 0))))
  45     (do-shell "pkill osd_cat")
  46     (do-shell (format nil "( echo '~A~A' | osd_cat -d 3 -p bottom -c white -o -50 -f -*-fixed-*-*-*-*-14-*-*-*-*-*-*-1 ) &"
  47                       (if keysym
  48                           (format nil "~:(~{~A+~}~A~)" modifiers keysym)
  49                           "Menu")
  50                       (aif (documentation (first function) 'function)
  51                            (format nil ": ~A" it) "")))))
  52
  53 #-DISPLAY-OSD
  54 (defun is-osd-window-p (win)
  55   (xlib:window-equal win *osd-window*))
  56
  57 #-DISPLAY-OSD
  58 (defun display-doc (function code state)
  59   (unless *osd-window*
  60     (setf *osd-window* (xlib:create-window :parent *root*
  61                                            :x 0 :y (- (xlib:drawable-height *root*) 25)
  62                                            :width (xlib:drawable-width *root*) :height 25
  63                                            :background (get-color "black")
  64                                            :border-width 1
  65                                            :border (get-color "black")
  66                                            :colormap (xlib:screen-default-colormap *screen*)
  67                                            :event-mask '(:exposure))
  68           *osd-font* (xlib:open-font *display* *osd-font-string*)
  69           *osd-gc* (xlib:create-gcontext :drawable *osd-window*
  70                                          :foreground (get-color "white")
  71                                          :background (get-color "gray10")
  72                                          :font *osd-font*
  73                                          :line-style :solid))
  74     (map-window *osd-window*))
  75   (let* ((modifiers (state->modifiers state))
  76          (keysym (keysym->keysym-name (xlib:keycode->keysym *display* code 0))))
  77     (when (frame-p *current-child*)
  78       (push (list #'is-osd-window-p nil) *never-managed-window-list*))
  79     (raise-window *osd-window*)
  80     (rotatef (xlib:gcontext-foreground *osd-gc*) (xlib:gcontext-background *osd-gc*))
  81     (xlib:draw-rectangle *osd-window* *osd-gc*
  82                          0 0 (xlib:drawable-width *osd-window*) (xlib:drawable-height *osd-window*)
  83                          t)
  84     (rotatef (xlib:gcontext-foreground *osd-gc*) (xlib:gcontext-background *osd-gc*))
  85     (xlib:draw-glyphs *osd-window* *osd-gc* 20 15
  86                       (format nil "~A~A"
  87                               (if keysym
  88                                   (format nil "~:(~{~A+~}~A~)" modifiers keysym)
  89                                   "Menu")
  90                               (aif (documentation (first function) 'function)
  91                                    (format nil ": ~A" it) "")))
  92     (xlib:display-finish-output *display*)))
  93
  94
  95 (defun funcall-key-from-code (hash-table-key code state &rest args)
  96   (let ((function (find-key-from-code hash-table-key code state)))
  97     (when function
  98       (display-doc function code state)
  99       (apply (first function) (append args (second function)))
 100       t)))
 101
 102 ;;; CONFIG - Screen size
 103 (defun get-fullscreen-size ()
 104   "Return the size of root child (values rx ry rw rh)
 105 You can tweak this to what you want"
 106   (values -2 -2 (+ (xlib:screen-width *screen*) 2) (- (xlib:screen-height *screen*) 25)))
 107
 108
 109 ;;; Display menu functions
 110 (defun open-menu-do-action (action menu parent)
 111   (typecase action
 112     (menu (open-menu action (cons menu parent)))
 113     (null (awhen (first parent)
 114             (open-menu it (rest parent))))
 115     (t (when (fboundp action)
 116          (display-doc (list action) 0 0)
 117          (funcall action)))))
 118
 119
 120 (defun bottom-left-placement (&optional (width 0) (height 0))
 121   (declare (ignore width))
 122   (values 0
 123           (- (xlib:screen-height *screen*) height 26)))
 124
 125 (defun bottom-middle-placement (&optional (width 0) (height 0))
 126   (values (truncate (/ (- (xlib:screen-width *screen*) width) 2))
 127           (- (xlib:screen-height *screen*) height 26)))
 128
 129 (defun bottom-right-placement (&optional (width 0) (height 0))
 130   (values (- (xlib:screen-width *screen*) width 1)
 131           (- (xlib:screen-height *screen*) height 26)))