67 lines
2.3 KiB
Plaintext
67 lines
2.3 KiB
Plaintext
(typedef XID uint32)
|
|
|
|
(typedef Window XID)
|
|
|
|
(typedef Drawable XID)
|
|
|
|
(typedef Display (cptr Display))
|
|
|
|
(typedef GC (cptr GC))
|
|
|
|
(typedef XEventType (enum _XEventType
|
|
(KeyPress 2)
|
|
(Expose 12)))
|
|
|
|
(defvarl KeyPressMask (ash 1 0))
|
|
(defvarl ExposureMask (ash 1 15))
|
|
|
|
(typedef XEvent (union _XEvent
|
|
(type XEventType)
|
|
(pad (array 24 long))))
|
|
|
|
(defvarl NULL cptr-null)
|
|
|
|
(with-dyn-lib "libX11.so"
|
|
(deffi XOpenDisplay "XOpenDisplay" Display (bstr))
|
|
(deffi XCloseDisplay "XCloseDisplay" int (Display))
|
|
(deffi XDefaultScreen "XDefaultScreen" int (Display))
|
|
(deffi XRootWindow "XRootWindow" Window (Display int))
|
|
(deffi XBlackPixel "XBlackPixel" ulong (Display int))
|
|
(deffi XWhitePixel "XWhitePixel" ulong (Display int))
|
|
(deffi XCreateSimpleWindow "XCreateSimpleWindow" Window (Display
|
|
Window
|
|
int int
|
|
uint uint uint
|
|
ulong ulong))
|
|
(deffi XSelectInput "XSelectInput" int (Display Window long))
|
|
(deffi XMapWindow "XMapWindow" int (Display Window))
|
|
(deffi XNextEvent "XNextEvent" int (Display (ptr-out XEvent)))
|
|
(deffi XDefaultGC "XDefaultGC" GC (Display int))
|
|
(deffi XFillRectangle "XFillRectangle" int (Display Drawable GC
|
|
int int uint uint))
|
|
(deffi XDrawString "XDrawString" int (Display Drawable GC
|
|
int int bstr int)))
|
|
|
|
(let* ((msg "Hello, world!")
|
|
(d (XOpenDisplay nil)))
|
|
(when (equal d NULL)
|
|
(put-line "Cannot-open-display" *stderr*)
|
|
(exit 1))
|
|
|
|
(let* ((s (XDefaultScreen d))
|
|
(w (XCreateSimpleWindow d (XRootWindow d s) 10 10 100 100 1
|
|
(XBlackPixel d s) (XWhitePixel d s))))
|
|
(XSelectInput d w (logior ExposureMask KeyPressMask))
|
|
(XMapWindow d w)
|
|
|
|
(while t
|
|
(let ((e (make-union (ffi XEvent))))
|
|
(XNextEvent d e)
|
|
(caseq (union-get e 'type)
|
|
(Expose
|
|
(XFillRectangle d w (XDefaultGC d s) 20 20 10 10)
|
|
(XDrawString d w (XDefaultGC d s) 10 50 msg (length msg)))
|
|
(KeyPress (return)))))
|
|
|
|
(XCloseDisplay d)))
|