1 ;;; --------------------------------------------------------------------------
2 ;;; CLFSWM - FullScreen Window Manager
4 ;;; --------------------------------------------------------------------------
5 ;;; Documentation: OSD (On Screen Display) for presentations.
6 ;;; --------------------------------------------------------------------------
8 ;;; (C) 2011 Philippe Brochard <hocwp@free.fr>
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.
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.
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.
24 ;;; --------------------------------------------------------------------------
28 ;; Uncomment the line above if you want to use the old OSD method
29 ;;(pushnew :DISPLAY-OSD *features*)
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.
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 ) &"
48 (format nil
"~:(~{~A+~}~A~)" modifiers keysym
)
50 (aif (documentation (first function
) 'function
)
51 (format nil
": ~A" it
) "")))))
54 (defun is-osd-window-p (win)
55 (xlib:window-equal win
*osd-window
*))
59 (defun display-doc (function code state
&optional button-p
)
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")
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")
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
88 (cond (button-p (format nil
"~:(~{~A+~}Button-~A~)" modifiers code
))
89 (keysym (format nil
"~:(~{~A+~}~A~)" modifiers keysym
))
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
)))
100 (display-doc function code state
)
101 (apply (first function
) (append args
(second function
)))
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
))
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
))))
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
)
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)
140 (fmakunbound 'bottom-left-placement
)
141 (defun bottom-left-placement (&optional
(width 0) (height 0))
142 (declare (ignore width
))
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)))