;;; A SCIX version of Hello, World! Hakan Huss, KTH and Johan Ihren, KTH

;;; $Header: /nfs/deneb/src0/johani/scix-0.95/demo/RCS/hello.sc,v 1.3 90/03/20 23:36:40 johani Exp $

(define (demo-hello scr)
  (let* ((w (make-window 400 400 (scr 'root-depth) 0 0 (scr 'root)
			 0 'CopyFromParent 'CopyFromParent scr))
	 (f1 (make-font "8x13bold" scr))
	 (view (make-view))
	 (gc (make-gc (make-gc-value-mask `(foreground ,(scr 'blackpixel))
					  `(background ,(scr 'whitepixel))
					  `(font ,f1) )
		      (scr 'root)))
	 (hello (make-imagetext8 100 50 "Hello world!"))
	 (keybd (scr 'keyboard))
	 (terminate #f) )

    (view 'add! (list hello))
    (w 'add-callback! 'Expose (lambda (event window)
				(if (zero? (event 'count))
				    (begin
				      (w 'draw (list view) gc)
				      (scr 'flush!) ))))
    (w 'add-callback! 'ButtonPress
       (lambda (event window)
	 (let ((x (event 'event-x))
	       (y (event 'event-y)))
	   (let ((hi (list (make-imagetext8 x y "Hi!"))))
	     (view 'add! hi)
	     (w 'draw hi gc)
	     (scr 'flush!) ))))

    (w 'add-callback! 'KeyPress
       (lambda (event window)
	 (let* ((key (event 'detail))
		(keysym ((keybd 'getkeyboardmapping key 1) 'keysyms)) )
	   (if (= (char->integer #\Q) (caar keysym))
	       (begin
		 (w 'destroywindow)
		 (gc 'freegc)
		 (f1 'closefont)
		 (scr 'flush!)
		 (set! terminate #t) )))))
    (w 'createwindow
       (make-window-value-mask `(background-pixel ,(scr 'whitepixel))
			       `(event-mask
				 ,(make-event-mask 'ButtonPress
						   'KeyPress
						   'Exposure))))
    (w 'changeproperty 'replace 'wm_name 'string 8 "SCIX Hello, world!")
    (w 'mapwindow)
    (scr 'flush!)
    (msg-handler 'mainloop (lambda () terminate) (list scr)) ))