contrib/osd.lisp

   1 ;;; --------------------------------------------------------------------------
   2 ;;; CLFSWM - FullScreen Window Manager
   3 ;;;
   4 ;;; --------------------------------------------------------------------------
   5 ;;; Documentation: OSD (On Screen Display) for presentations.
   6 ;;; --------------------------------------------------------------------------
   7 ;;;
   8 ;;; (C) 2015 Philippe Brochard <pbrochard@common-lisp.net>
   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
  58 #-DISPLAY-OSD
  59 (defun display-doc (function code state &optional button-p)
  60   (unless *osd-window*
  61     (setf *osd-window* (xlib:create-window :parent *root*
  62                                            :x 0 :y (- (xlib:drawable-height *root*) 25)
  63                                            :width (xlib:drawable-width *root*) :height 25
  64                                            :background (get-color "black")
  65                                            :border-width 1
  66                                            :border (get-color "black")
  67                                            :colormap (xlib:screen-default-colormap *screen*)
  68                                            :event-mask '(:exposure))
  69           *osd-font* (xlib:open-font *display* *osd-font-string*)
  70           *osd-gc* (xlib:create-gcontext :drawable *osd-window*
  71                                          :foreground (get-color "white")
  72                                          :background (get-color "gray10")
  73                                          :font *osd-font*
  74                                          :line-style :solid))
  75     (map-window *osd-window*))
  76   (let* ((modifiers (state->modifiers state))
  77          (keysym (keysym->keysym-name (xlib:keycode->keysym *display* code 0))))
  78     (when (frame-p (current-child))
  79       (push (list #'is-osd-window-p nil) *never-managed-window-list*))
  80     (raise-window *osd-window*)
  81     (rotatef (xlib:gcontext-foreground *osd-gc*) (xlib:gcontext-background *osd-gc*))
  82     (xlib:draw-rectangle *osd-window* *osd-gc*
  83                          0 0 (xlib:drawable-width *osd-window*) (xlib:drawable-height *osd-window*)
  84                          t)
  85     (rotatef (xlib:gcontext-foreground *osd-gc*) (xlib:gcontext-background *osd-gc*))
  86     (xlib:draw-glyphs *osd-window* *osd-gc* 20 15
  87                       (format nil "~A~A"
  88                               (cond (button-p (format nil "~:(~{~A+~}Button-~A~)" modifiers code))
  89                                     (keysym (format nil "~:(~{~A+~}~A~)" modifiers keysym))
  90                                     (t "Menu"))
  91                               (aif (documentation (first function) 'function)
  92                                    (format nil ": ~A" (substitute #\Space #\Newline it)) "")))
  93     (xlib:display-finish-output *display*)))
  94
  95
  96 (fmakunbound 'funcall-key-from-code)
  97 (defun funcall-key-from-code (hash-table-key code state &rest args)
  98   (let ((function (find-key-from-code hash-table-key code state)))
  99     (when function
 100       (display-doc function code state)
 101       (apply (first function) (append args (second function)))
 102       t)))
 103
 104
 105 (fmakunbound 'funcall-button-from-code)
 106 (defun funcall-button-from-code (hash-table-key code state window root-x root-y
 107                                  &optional (action *fun-press*) args)
 108   (let ((state (modifiers->state (set-difference (state->modifiers state)
 109                                                  '(:button-1 :button-2 :button-3 :button-4 :button-5)))))
 110     (multiple-value-bind (function foundp)
 111         (gethash (list code state) hash-table-key)
 112       (if (and foundp (funcall action function))
 113           (progn
 114             (unless (equal code 'motion)
 115               (display-doc function code state t))
 116             (apply (funcall action function) `(,window ,root-x ,root-y ,@(append args (third function))))
 117             t)
 118           nil))))
 119
 120
 121 (fmakunbound 'get-fullscreen-size)
 122 ;;; CONFIG - Screen size
 123 (defun get-fullscreen-size ()
 124   "Return the size of root child (values rx ry rw rh)
 125 You can tweak this to what you want"
 126   (values -2 -2 (+ (xlib:screen-width *screen*) 2) (- (xlib:screen-height *screen*) 25)))
 127
 128
 129 (fmakunbound 'open-menu-do-action)
 130 ;;; Display menu functions
 131 (defun open-menu-do-action (action menu parent)
 132   (typecase action
 133     (menu (open-menu action (cons menu parent)))
 134     (null (awhen (first parent)
 135             (open-menu it (rest parent))))
 136     (t (when (fboundp action)
 137          (display-doc (list action) 0 0)
 138          (funcall action)))))
 139
 140 (fmakunbound 'bottom-left-placement)
 141 (defun bottom-left-placement (&optional (width 0) (height 0))
 142   (declare (ignore width))
 143   (values 0
 144           (- (xlib:screen-height *screen*) height 26)))
 145
 146 (fmakunbound 'bottom-middle-placement)
 147 (defun bottom-middle-placement (&optional (width 0) (height 0))
 148   (values (truncate (/ (- (xlib:screen-width *screen*) width) 2))
 149           (- (xlib:screen-height *screen*) height 26)))
 150
 151 (fmakunbound 'bottom-right-placement)
 152 (defun bottom-right-placement (&optional (width 0) (height 0))
 153   (values (- (xlib:screen-width *screen*) width 1)
 154           (- (xlib:screen-height *screen*) height 26)))