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
33
34
35
36
37
38
39
40
41
42
43
44
45
|
;; (require-library iup canvas-draw)
;;
;; (module cells-test
;; (cells-dialog)
;; (import
;; scheme chicken extras
;; iup canvas-draw
;; (only canvas-draw-base pointer->canvas))
;;
(use iup canvas-draw canvas-draw-base)
;; (make-cells-draw-cb render-cell))))
(let ([wrap (pointer->canvas #t)])
(lambda (handle i j x-min x-max y-min y-max canvas)
(render-cell handle i j x-min x-max y-min y-max (wrap canvas)))))))
;; )
;; (import
;; (only iup show main-loop)
;; cells-test)
|
|
|
|
|
|
|
|
|
<
|
<
|
|
<
<
<
<
<
|
|
|
|
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
33
34
35
36
37
38
|
(require-library iup canvas-draw canvas-draw-iup)
(module cells-test
(cells-dialog)
(import
scheme chicken extras
iup canvas-draw canvas-draw-iup
(only canvas-draw-base pointer->canvas))
(define ncols 8)
(define nlins 8)
(define width 32)
(define height 32)
(define (render-cell handle i j x-min x-max y-min y-max canvas)
(set! (canvas-foreground canvas)
(if (or (and (odd? i) (odd? j)) (and (even? i) (even? j)))
#xffffff
#x000000))
(canvas-box! canvas x-min x-max y-min y-max))
(define cells-dialog
(dialog
#:title "Cells Test"
(cells
#:rastersize (format "~sx~s" (* ncols width) (* nlins height))
#:ncols-cb (lambda _ ncols) #:width-cb (lambda _ width)
#:nlines-cb (lambda _ nlins) #:height-cb (lambda _ height)
#:draw-cb
(make-cells-draw-cb render-cell))))
)
(import
(only iup show main-loop)
cells-test)
(show cells-dialog)
(main-loop)
|