scsh-conservatory
/
sunterlib
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

*** empty log message ***

This commit is contained in:
Johan Ceuppens 2012-01-17 00:52:04 +00:00
parent a3ed282a27
commit 2f1534d80e
2 changed files with 13 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
scsh/scgame/scgame.scm
View File

@ -141,7 +141,7 @@
(define (load-xpm-image-native filename) (define (load-xpm-image-native filename)
(xputxpm filename)) (xputxpm filename))
(define (load-xpm-image-scx filename) (define (load-xpm-image-scx win filename)
(read-file-to-pixmap win filename #()));;FIXME xpm-attributes == '() (read-file-to-pixmap win filename #()));;FIXME xpm-attributes == '()
(define (load-xpm-image filename) (define (load-xpm-image filename)
@ -173,12 +173,12 @@
;; public methods ;; public methods
(define (load-image filename) (define (load-image win filename)
;; FIXME read in xpm or png ;; FIXME read in xpm or png
(display-msg "loading image..") (display-msg "loading image..")
(cond ((string<=? ".xpm" filename) (cond ((string<=? ".xpm" filename)
(display-msg "loading xpm suffixed file..") (display-msg "loading xpm suffixed file..")
(load-xpm-image-scx filename) (load-xpm-image-scx win filename)
) )
(else (display-msg "no supported image format found")))) (else (display-msg "no supported image format found"))))

15
scsh/scgame/scgamewidgets.scm
View File

@ -49,15 +49,15 @@
(width 0) (width 0)
(height 0)) (height 0))
(define (set-image filename) (define (set-image win filename)
(set! image (((make-scimage2)'load-image) filename)) (set! image (((make-scimage2)'load-image) win filename))
(let ((wh (vector-ref (list->vector image) 1))) (let ((wh (vector-ref (list->vector image) 1)))
(set! width (car wh)) (set! width (car wh))
(set! height (cadr wh)) (set! height (cadr wh))
)) ))
(define (set-pressed-image filename) (define (set-pressed-image win filename)
(set! pressed-image (((make-scimage2)'load-image) filename)) (set! pressed-image (((make-scimage2)'load-image) win filename))
(let ((wh (vector-ref (list->vector image) 1))) (let ((wh (vector-ref (list->vector image) 1)))
(set! width (car wh)) (set! width (car wh))
(set! height (cadr wh)) (set! height (cadr wh))
@ -84,11 +84,14 @@
(else #f))) (else #f)))
(loop)))))) (loop))))))
(define (release-button dpy win gc)
(press-button dpy win gc))
(define (draw-pressed-image dpy win gc) (define (draw-pressed-image dpy win gc)
(init-sync-x-events dpy) (init-sync-x-events dpy)
(map-window dpy win) (map-window dpy win)
(call-with-event-channel (call-with-event-channel
dpy win (event-mask exposure) dpy win (event-mask exposure map)
(lambda (channel) (lambda (channel)
(let loop () (let loop ()
(if (if
@ -143,9 +146,11 @@
(map-window dpy win)) (map-window dpy win))
(define (press!) (define (press!)
(press-button dpy win gc)
(set! pressed #t)) (set! pressed #t))
(define (release!) (define (release!)
(release-button dpy win gc)
(set! pressed #f)) (set! pressed #f))
(lambda (msg) (lambda (msg)