[Scsh-checkins] CVS: scx/scheme/examples hello.scm,NONE,1.1

[David Frese <frese@users.sourceforge.net>]

Update of /cvsroot/scsh/scx/scheme/examples
In directory usw-pr-cvs1:/tmp/cvs-serv21186/scheme/examples

Added Files:
        hello.scm 
Log Message:
- basic "Hello World" example.


--- NEW FILE ---
#!/bin/sh

../../scxvm <<EOF

,config ,load ../xlib/xlib-type-interfaces.scm ../xlib/xlib-type-package.scm 
../xlib/xlib-interfaces.scm ../xlib/xlib-packages.scm
,batch on

,open xlib
,batch off

(define (hello text)
  (let* ((dpy (open-display))
         (cm (copy-colormap-and-free (display-default-colormap dpy)))

         ;; many ways to get color in your progs.
         (black (black-pixel dpy))
         (white (white-pixel dpy))
         (blue (alloc-color! cm (make-color 0 0 1)))
         (green (alloc-named-color cm "#00FF00"))
         (red (alloc-named-color cm 'red))
         
         (win (create-window (display-default-root-window dpy)
                             300 200
                             'event-mask '(exposure button-press)
                             'background-pixel white
                             'colormap cm))
         (gc (create-gcontext win
                              'background white
                              'foreground black
                              ))
         (font (open-font dpy "*-new century schoolbook-bold-r*24*"))
         (font2 (open-font dpy "*times*18*")))
    (set-wm-name! win '("scx Hello World Program"))
    (map-window win)

    (let event-loop ()
      (display-flush-output dpy)
      (let ((e (wait-event dpy)))
        (if
         (case (event-type e)
           ((expose)
            (set-gcontext-font! gc font)
            (set-gcontext-foreground! gc black)
            (draw-poly-text win gc 10 25 text '1-byte)
            (set-gcontext-foreground! gc blue)
            (draw-poly-text win gc 20 50 (list font text) '1-byte)
            (set-gcontext-foreground! gc red)
            (set-gcontext-font! gc font2)
            (draw-image-text win gc 30 75 text '1-byte)
            #t)
           (else #f))
         (event-loop)
         #f)))
    (close-display dpy)))

(hello "Hello World!")

,exit
y
EOF