demo: clclock demo compiles and loads without opening a display

sharplispers · Jun 25, 2020 · f6624a1 · f6624a1
1 parent 7b133e8
commit f6624a1
Showing 1 changed file with 51 additions and 54 deletions.
diff --git 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))))