From f6624a133cdfc2d7dcc7027260b19e1568b93203 Mon Sep 17 00:00:00 2001 From: Jan Moringen Date: Sat, 16 May 2020 17:06:18 +0200 Subject: [PATCH] demo: clclock demo compiles and loads without opening a display --- demo/clclock.lisp | 105 ++++++++++++++++++++++------------------------ 1 file changed, 51 insertions(+), 54 deletions(-) diff --git a/demo/clclock.lisp b/demo/clclock.lisp index c5413da..c519261 100644 --- a/demo/clclock.lisp +++ b/demo/clclock.lisp @@ -4,46 +4,8 @@ (in-package #:xlib-demo/clclock) -(defvar *display* (xlib:open-default-display)) -(defvar *screen* (xlib:display-default-screen *display*)) -(defvar *colormap* (xlib:screen-default-colormap *screen*)) - -(defvar *font* (xlib:open-font *display* "fixed")) -(defvar *win*) - -(multiple-value-bind (width ascent) - (xlib:text-extents *font* "XVIIII XXXVIIII XXXVIIII") - (setq *win* - (xlib:create-window - :parent (xlib:screen-root *screen*) - :x 512 - :y 512 - :width (+ 20 width) - :height (+ 20 ascent) - :background (xlib:alloc-color *colormap* - (xlib:lookup-color *colormap* - "midnightblue"))))) - -(defvar *gcontext* (xlib:create-gcontext - :drawable *win* - :fill-style :solid - :background (xlib:screen-white-pixel *screen*) - :foreground (xlib:alloc-color *colormap* - (xlib:lookup-color - *colormap* - "yellow")) - :font *font*)) - -(defvar *background* (xlib:create-gcontext - :drawable *win* - :fill-style :solid - :background (xlib:screen-white-pixel *screen*) - :foreground (xlib:alloc-color *colormap* - (xlib:lookup-color *colormap* - "midnightblue")) - :font *font*)) -(defvar *palette* nil) -(defvar *black* (xlib:screen-black-pixel *screen*)) +(declaim (special *display* *screen* *colormap* *font* *win* *gcontext* + *background* *palette* *black*)) (defun romanize (arg) (if (zerop arg) @@ -58,21 +20,56 @@ (let ((string (clock-string))) (let ((string-width (xlib:text-width *gcontext* string))) (xlib:draw-rectangle *win* *background* - 0 0 - (xlib:drawable-width *win*) - (xlib:drawable-height *win*) - :fill-p) + 0 0 + (xlib:drawable-width *win*) + (xlib:drawable-height *win*) + :fill-p) (xlib:draw-glyphs *win* *gcontext* - (- (truncate - (- (xlib:drawable-width *win*) string-width) - 2) - 10) - (- (xlib:drawable-height *win*) 10) - string))) + (- (truncate + (- (xlib:drawable-width *win*) string-width) + 2) + 10) + (- (xlib:drawable-height *win*) 10) + string))) (xlib:display-force-output *display*)) (defun clock () - (xlib:map-window *win*) - (loop - (update-clockface) - (sleep 1))) + (let* ((*display* (xlib:open-default-display)) + (*screen* (xlib:display-default-screen *display*)) + (*colormap* (xlib:screen-default-colormap *screen*)) + + (*font* (xlib:open-font *display* "fixed"))) + (multiple-value-bind (width ascent) + (xlib:text-extents *font* "XVIIII XXXVIIII XXXVIIII") + (setq *win* (xlib:create-window + :parent (xlib:screen-root *screen*) + :x 512 + :y 512 + :width (+ 20 width) + :height (+ 20 ascent) + :background (xlib:alloc-color *colormap* + (xlib:lookup-color *colormap* + "midnightblue"))) + *gcontext* (xlib:create-gcontext + :drawable *win* + :fill-style :solid + :background (xlib:screen-white-pixel *screen*) + :foreground (xlib:alloc-color *colormap* + (xlib:lookup-color + *colormap* + "yellow")) + :font *font*) + *background* (xlib:create-gcontext + :drawable *win* + :fill-style :solid + :background (xlib:screen-white-pixel *screen*) + :foreground (xlib:alloc-color *colormap* + (xlib:lookup-color *colormap* + "midnightblue")) + :font *font*) + *palette* nil + *black* (xlib:screen-black-pixel *screen*))) + (xlib:map-window *win*) + (loop + (update-clockface) + (sleep 1))))