License date update
[clfswm.git] / contrib / osd.lisp
blobd1ffd9699aa765931e36ab2898805e6772534cbb
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 ;;; --------------------------------------------------------------------------
26 (in-package :clfswm)
28 ;; Uncomment the line above if you want to use the old OSD method
29 ;;(pushnew :DISPLAY-OSD *features*)
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"))
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) "")))))
53 #-DISPLAY-OSD
54 (defun is-osd-window-p (win)
55 (xlib:window-equal win *osd-window*))
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*)
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*)))
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)))
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))))
118 nil))))
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)))
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)))))
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)))
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)))
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)))