|
=={{header|TXR}}==
See [[Window_creation#TXR_X11]].
{{trans|C}}
This simply uses the FFI capability in TXR to clone what the C program is doing. The external behavior is exactly the same.
One difference is that the XLib macros for direct structure access, like <code>DefaultGC</code>, <code>DefaultScreen</code> or <code>WhitePixel</code> are not used; rather the correspoding C functinos rae used via FFI: <code>XDefaultScreen</code> and so on. The macro approach can be mimiced in detail, at the cost of a significant increase in verbosity (cloning the full declaration of the <code>_XDisplay</code> struct declaration, and reproducing the macros).
<lang txrlisp>(typedef XID uint32)
(typedef Window XID)
(typedef Drawable XID)
(typedef Display (cptr Display))
(typedef GC (cptr GC))
(typedef XEvent (union _XEvent
(type int)
(pad (array 24 long))))
(defvarl NULL cptr-null)
(defvarl KeyPressMask (ash 1 0))
(defvarl ExposureMask (ash 1 15))
(defvarl KeyPress 2)
(defvarl Expose 12)
(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)
(caseql* (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)))</lang>
{{omit from|ACL2}}
|