File: hello.scm

package info (click to toggle)
elk 3.99.8-10
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid
  • size: 5,204 kB
  • sloc: ansic: 22,346; lisp: 6,208; makefile: 775; sh: 171; awk: 154; cpp: 92
file content (32 lines) | stat: -rw-r--r-- 1,032 bytes parent folder | download | duplicates (11)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
;;; -*-Scheme-*-

(require 'xlib)

(define (hello-world)
  (let* ((dpy (open-display))
	 (black (black-pixel dpy)) (white (white-pixel dpy))
	 (font (open-font dpy "*-new century schoolbook-bold-r*24*"))
	 (text (translate-text "Hello world!"))
	 (width (+ 2 (text-width font text '1-byte)))
	 (height (+ 2 (max-char-ascent font) (max-char-descent font)))
	 (win (create-window 'parent (display-root-window dpy)
			   'width width 'height height
			   'background-pixel white
			   'event-mask '(exposure button-press)))
	 (gc (create-gcontext 'window win 'background white
			    'foreground black 'font font)))
    (map-window win)
    (unwind-protect
     (handle-events dpy #t #f
       (button-press
	(lambda ignore #t))
       (expose
	(lambda ignore
	  (let ((x (truncate (/ (- (window-width win) width) 2)))
		(y (truncate (/ (- (+ (window-height win)
				      (max-char-ascent font))
				   (max-char-descent font)) 2))))
	    (draw-poly-text win gc x y text '1-byte)) #f)))
     (close-display dpy))))
		  
(hello-world)