/[cmucl]/src/clx/xinerama.lisp
ViewVC logotype

Contents of /src/clx/xinerama.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (show annotations)
Wed Jun 17 18:22:46 2009 UTC (4 years, 10 months ago) by rtoy
Branch: MAIN
CVS Tags: GIT-CONVERSION, cross-sol-x86-base, sparc-tramp-assem-base, post-merge-intl-branch, snapshot-2010-12, snapshot-2010-11, cross-sol-x86-merged, snapshot-2011-09, snapshot-2011-06, snapshot-2011-07, snapshot-2011-04, intl-2-branch-base, snapshot-2011-02, snapshot-2011-03, snapshot-2011-01, release-20a-pre1, snapshot-2009-11, snapshot-2010-06, pre-merge-intl-branch, intl-branch-working-2010-02-19-1000, unicode-string-buffer-impl-base, intl-branch-working-2010-02-11-1000, release-20b-pre1, release-20b-pre2, unicode-string-buffer-base, cross-sparc-branch-base, intl-branch-base, snapshot-2010-05, snapshot-2010-04, snapshot-2010-07, sparc-tramp-assem-2010-07-19, snapshot-2010-01, snapshot-2010-03, snapshot-2010-02, snapshot-2010-08, snapshot-2009-08, release-20a-base, snapshot-2009-07, RELEASE_20b, RELEASE_20a, cross-sol-x86-2010-12-20, amd64-dd-start, intl-branch-2010-03-18-1300, snapshot-2009-12, HEAD
Branch point for: RELEASE-20A-BRANCH, unicode-string-buffer-branch, cross-sol-x86-branch, cross-sparc-branch, sparc-tramp-assem-branch, amd64-dd-branch, unicode-string-buffer-impl-branch, intl-2-branch, RELEASE-20B-BRANCH, intl-branch
Changes since 1.1: +93 -0 lines
Merge portable-clx (2009-06-16) to main branch.  Tested by running
src/contrib/games/feebs and hemlock which works (in non-unicode
builds).
1 ;;; -*- Mode: Lisp -*-
2 ;;;
3 ;;; Copyright (C) 2008, Julian Stecklina
4 ;;;
5 ;;; ((
6 ;;; )) This file is COFFEEWARE. As long as you retain this notice
7 ;;; | |o) you can do whatever you want with this code. If you think,
8 ;;; |___|jgs it's worth it, you may buy the author a coffee in return.
9 ;;;
10 ;;; Description:
11 ;;;
12 ;;; This is an implementation of the XINERAMA extension. It does not
13 ;;; include the obsolete PanoramiX calls.
14
15 (defpackage "XLIB.XINERAMA"
16 (:use "COMMON-LISP" "XLIB")
17 (:nicknames "XINERAMA")
18 (:import-from "XLIB"
19 "WITH-BUFFER-REQUEST"
20 "WITH-BUFFER-REQUEST-AND-REPLY"
21 "DATA"
22 "BOOLEAN" "BOOLEAN-GET"
23 "CARD8" "CARD8-GET"
24 "CARD16" "CARD16-GET"
25 "CARD32" "CARD32-GET"
26 "INT16" "INT16-GET")
27 (:export "SCREEN-INFO"
28 "SCREEN-INFO-NUMBER"
29 "SCREEN-INFO-X"
30 "SCREEN-INFO-Y"
31 "SCREEN-INFO-WIDTH"
32 "SCREEN-INFO-HEIGHT"
33 "XINERAMA-QUERY-VERSION"
34 "XINERAMA-IS-ACTIVE"
35 "XINERAMA-QUERY-SCREENS"))
36 (in-package "XINERAMA")
37
38 (define-extension "XINERAMA")
39
40 (defun xinerama-opcode (display)
41 (extension-opcode display "XINERAMA"))
42
43 (defconstant +major-version+ 1)
44 (defconstant +minor-version+ 1)
45
46 (defconstant +get-version+ 0)
47 (defconstant +get-state+ 1)
48 (defconstant +get-screen-count+ 2)
49 (defconstant +get-screen-size+ 3)
50 (defconstant +is-active+ 4)
51 (defconstant +query-screens+ 5)
52
53 (defstruct screen-info
54 (number 0 :type (unsigned-byte 32))
55 (x 0 :type (signed-byte 16))
56 (y 0 :type (signed-byte 16))
57 (width 0 :type (unsigned-byte 16))
58 (height 0 :type (unsigned-byte 16)))
59
60 (defun xinerama-query-version (display)
61 (with-buffer-request-and-reply (display (xinerama-opcode display) nil)
62 ((data +get-version+)
63 (card8 +major-version+)
64 (card8 +minor-version+))
65 (values
66 (card16-get 8) ; server major version
67 (card16-get 10)))) ; server minor version
68
69 (defun xinerama-is-active (display)
70 "Returns T, iff Xinerama is supported and active."
71 (with-buffer-request-and-reply (display (xinerama-opcode display) nil)
72 ((data +is-active+))
73 (values
74 ;; XCB says this is actually a CARD32, but why?!
75 (boolean-get 8))))
76
77 (defun xinerama-query-screens (display)
78 "Returns a list of screen-info structures."
79 (with-buffer-request-and-reply (display (xinerama-opcode display) nil)
80 ((data +query-screens+))
81 (values
82 (loop
83 with index = 32
84 for number from 0 below (card32-get 8)
85 collect (prog1
86 (make-screen-info :number number
87 :x (int16-get index)
88 :y (int16-get (+ index 2))
89 :width (card16-get (+ index 4))
90 :height (card16-get (+ index 6)))
91 (incf index 8))))))
92
93 ;;; EOF

  ViewVC Help
Powered by ViewVC 1.1.5