Megatest

Check-in [f319171913]
Login
Overview
Comment:Added cells example code
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: f31917191357fea9e2accdd2fa4eddddcc6968fb
User & Date: mrwellan on 2011-11-04 23:25:05
Other Links: manifest | tags
Context
2011-11-05
18:11
Got cells.scm and matrix.scm example files working. More steps stuff working Added tests for ezsteps and logpro l check-in: b2b8a3f26c user: matt tags: trunk
2011-11-04
23:25
Added cells example code check-in: f319171913 user: mrwellan tags: trunk
2011-11-03
22:59
Added test placeholders check-in: 5868dd5b31 user: matt tags: trunk
Changes

Added cells.scm version [92e5ab296a].



























































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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)
(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))))

    (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)

(show cells-dialog)
(main-loop)