drawing button

scsh/scgame/README

@@ -1,7 +1,7 @@
 scgame is a drawing package a la Carbon.
 
 It is based on Xlib for scsh and thus needs scx-0.2.
-
+You can tune config.scm before you start.
 
 Another homebrewed library for the linux framebuffer :
 

scsh/scgame/scgame.scm

@@ -47,7 +47,8 @@
 (load "config.scm")
 (define (display-msg msg)
   (if SCGAMEDEBUG
-      (for-each display (list (aspectmsg) " " msg))))
+      (for-each display (list (aspectmsg) " " msg))
+      (newline)))
 
 ;; override for scx-0.2
 (define (putpixel x y colorname)
@@ -141,7 +142,7 @@
       (xputxpm filename))
 
     (define (load-xpm-image-scx filename)
-      (read-file-to-pixmap win filename '()));;FIXME xpm-attributes == '()
+      (read-file-to-pixmap win filename #()));;FIXME xpm-attributes == '()
 
     (define (load-xpm-image filename)
       (let ((in (open-input-file filename))
@@ -174,12 +175,12 @@
 
     (define (load-image filename)
       ;; FIXME read in xpm or png
-      (display-msg "loading image...")
+      (display-msg "loading image..")
       (cond ((string<=? ".xpm" filename)
              (display-msg "loading xpm suffixed file..")
 	     (load-xpm-image-scx filename)
 	     )
-            (else #f)))
+            (else (display-msg "no supported image format found"))))
 
     (lambda (msg)
       (cond ((eq? msg 'load-image) load-image)

scsh/scgame/scgamewidgets.scm

@@ -28,18 +28,107 @@
 
 (load "scgame.scm")
 
-(define (make-scgamewidget)
+;; for inits see scgame.scm
-    (lambda (msg)
-      (display "subclass responsability")))
 
-(define (make-button)
+(define (make-scgame-widget)
-  (let ((*widget (make-scgamewidget))
+  (define (draw)
-	(*image #f)) ;; pixel array
+    (display-msg "subclass responsability"))
+
+  (lambda (msg)
+    (cond ((eq? msg 'draw) draw)
+          (else
+           (display-msg "subclass responsability")))))
+
+(define (make-button-widget)
+  (let ((widget (make-scgame-widget))
+	(image #f) ;; pixel array
+        (pressed-image #f) ;; pixel array
+        (pressed #f)
+        (width 0)
+        (height 0))
 
     (define (set-image filename)
-      (((make-scimage2)'load-image) filename))
+      (set! image (((make-scimage2)'load-image) filename))
+      (let ((wh (vector-ref (list->vector image) 1)))
+        (set! width (car wh))
+        (set! height (cadr wh))
+        ))
+
+    (define (set-pressed-image filename)
+      (set! pressed-image (((make-scimage2)'load-image) filename))
+      (let ((wh (vector-ref (list->vector image) 1)))
+        (set! width (car wh))
+        (set! height (cadr wh))
+        ))
+
+    (define (draw-pressed-image dpy win gc)
+      (init-sync-x-events dpy)
+      (map-window dpy win)
+      (call-with-event-channel
+       dpy win (event-mask exposure button-press)
+       (lambda (channel)
+         (let loop ()
+           (if
+            (let ((e (receive channel)))
+              (cond
+               ((expose-event? e)
+                (clear-window dpy win)
+                (draw-points dpy win gc (* width height) 0 0
+                             (/ width 2) (/ height 2))
+                )
+
+               (else #f)))
+            (loop))))))
+
+    (define (draw-image dpy win gc)
+      (init-sync-x-events dpy)
+      (map-window dpy win)
+      (call-with-event-channel
+       dpy win (event-mask exposure button-press)
+       (lambda (channel)
+         (let loop ()
+           (if
+            (let ((e (receive channel)))
+              (cond
+               ((expose-event? e)
+                (clear-window dpy win)
+                (draw-points dpy win gc (* width height) 0 0
+                             (/ width 2) (/ height 2))
+                )
+
+               (else #f)))
+            (loop))))))
+
+    (define (draw-points dpy win gc count x y)
+      (if (zero? (modulo count 100))
+          (display-flush dpy))
+      (if (not (zero? count))
+          (let ((xf (floor (* (+ 1.2 x) width))) ; These lines center the picture
+                (yf (floor (* (+ 0.5 y) height))))
+            (draw-point dpy win gc (inexact->exact xf) (inexact->exact yf))
+            (draw-points dpy win gc ;; FIXME1
+                         (- count 1)
+                         (- (* y (+ 1 (sin (* 0.7 x))))
+                            (* 1.2 (sqrt (abs x))))
+                         (- 0.21 x)
+                         width height))))
+
+    (define (draw)
+      (if pressed
+          (draw-image)
+          (draw-pressed-image))
+      (map-window dpy win))
+
+    (define (press!)
+      (set! pressed #t))
+
+    (define (release!)
+      (set! pressed #f))
 
     (lambda (msg)
       (cond ((eq? 'set-image) set-image)
-	    (else (aspecterror)(display "make-button"))
+            ((eq? 'set-pressed-image) set-pressed-image)
+            ((eq? 'press!) press!)
+            ((eq? 'release!) release!)
+	    (widget msg)
 	    ))))