Artifact 81e160db9eb032a048db5d2a073fdf146bf3c7c6:
- File cells.scm — part of check-in [b2b8a3f26c] at 2011-11-05 18:11:11 on branch trunk — Got cells.scm and matrix.scm example files working. More steps stuff working Added tests for ezsteps and logpro l (user: matt size: 911)
0000: 28 72 65 71 75 69 72 65 2d 6c 69 62 72 61 72 79 (require-library 0010: 20 69 75 70 20 63 61 6e 76 61 73 2d 64 72 61 77 iup canvas-draw 0020: 20 63 61 6e 76 61 73 2d 64 72 61 77 2d 69 75 70 canvas-draw-iup 0030: 29 0a 0a 28 6d 6f 64 75 6c 65 20 63 65 6c 6c 73 )..(module cells 0040: 2d 74 65 73 74 0a 20 09 28 63 65 6c 6c 73 2d 64 -test. .(cells-d 0050: 69 61 6c 6f 67 29 0a 20 09 28 69 6d 70 6f 72 74 ialog). .(import 0060: 0a 20 09 20 73 63 68 65 6d 65 20 63 68 69 63 6b . . scheme chick 0070: 65 6e 20 65 78 74 72 61 73 0a 20 09 20 69 75 70 en extras. . iup 0080: 20 63 61 6e 76 61 73 2d 64 72 61 77 20 63 61 6e canvas-draw can 0090: 76 61 73 2d 64 72 61 77 2d 69 75 70 0a 20 09 20 vas-draw-iup. . 00a0: 28 6f 6e 6c 79 20 63 61 6e 76 61 73 2d 64 72 61 (only canvas-dra 00b0: 77 2d 62 61 73 65 20 70 6f 69 6e 74 65 72 2d 3e w-base pointer-> 00c0: 63 61 6e 76 61 73 29 29 0a 20 0a 28 64 65 66 69 canvas)). .(defi 00d0: 6e 65 20 6e 63 6f 6c 73 20 20 38 29 0a 28 64 65 ne ncols 8).(de 00e0: 66 69 6e 65 20 6e 6c 69 6e 73 20 20 38 29 0a 28 fine nlins 8).( 00f0: 64 65 66 69 6e 65 20 77 69 64 74 68 20 20 33 32 define width 32 0100: 29 0a 28 64 65 66 69 6e 65 20 68 65 69 67 68 74 ).(define height 0110: 20 20 33 32 29 0a 0a 28 64 65 66 69 6e 65 20 28 32)..(define ( 0120: 72 65 6e 64 65 72 2d 63 65 6c 6c 20 68 61 6e 64 render-cell hand 0130: 6c 65 20 69 20 6a 20 78 2d 6d 69 6e 20 78 2d 6d le i j x-min x-m 0140: 61 78 20 79 2d 6d 69 6e 20 79 2d 6d 61 78 20 63 ax y-min y-max c 0150: 61 6e 76 61 73 29 0a 20 20 28 73 65 74 21 20 28 anvas). (set! ( 0160: 63 61 6e 76 61 73 2d 66 6f 72 65 67 72 6f 75 6e canvas-foregroun 0170: 64 20 63 61 6e 76 61 73 29 0a 09 28 69 66 20 28 d canvas)..(if ( 0180: 6f 72 20 28 61 6e 64 20 28 6f 64 64 3f 20 69 29 or (and (odd? i) 0190: 20 28 6f 64 64 3f 20 6a 29 29 20 28 61 6e 64 20 (odd? j)) (and 01a0: 28 65 76 65 6e 3f 20 69 29 20 28 65 76 65 6e 3f (even? i) (even? 01b0: 20 6a 29 29 29 0a 09 20 20 20 20 23 78 66 66 66 j))).. #xfff 01c0: 66 66 66 0a 09 20 20 20 20 23 78 30 30 30 30 30 fff.. #x00000 01d0: 30 29 29 0a 20 20 28 63 61 6e 76 61 73 2d 62 6f 0)). (canvas-bo 01e0: 78 21 20 63 61 6e 76 61 73 20 78 2d 6d 69 6e 20 x! canvas x-min 01f0: 78 2d 6d 61 78 20 79 2d 6d 69 6e 20 79 2d 6d 61 x-max y-min y-ma 0200: 78 29 29 0a 0a 28 64 65 66 69 6e 65 20 63 65 6c x))..(define cel 0210: 6c 73 2d 64 69 61 6c 6f 67 0a 20 20 28 64 69 61 ls-dialog. (dia 0220: 6c 6f 67 0a 20 20 20 23 3a 74 69 74 6c 65 20 22 log. #:title " 0230: 43 65 6c 6c 73 20 54 65 73 74 22 0a 20 20 20 28 Cells Test". ( 0240: 63 65 6c 6c 73 0a 20 20 20 20 23 3a 72 61 73 74 cells. #:rast 0250: 65 72 73 69 7a 65 20 28 66 6f 72 6d 61 74 20 22 ersize (format " 0260: 7e 73 78 7e 73 22 20 28 2a 20 6e 63 6f 6c 73 20 ~sx~s" (* ncols 0270: 77 69 64 74 68 29 20 28 2a 20 6e 6c 69 6e 73 20 width) (* nlins 0280: 68 65 69 67 68 74 29 29 0a 20 20 20 20 23 3a 6e height)). #:n 0290: 63 6f 6c 73 2d 63 62 20 28 6c 61 6d 62 64 61 20 cols-cb (lambda 02a0: 5f 20 6e 63 6f 6c 73 29 20 23 3a 77 69 64 74 68 _ ncols) #:width 02b0: 2d 63 62 20 28 6c 61 6d 62 64 61 20 5f 20 77 69 -cb (lambda _ wi 02c0: 64 74 68 29 0a 20 20 20 20 23 3a 6e 6c 69 6e 65 dth). #:nline 02d0: 73 2d 63 62 20 28 6c 61 6d 62 64 61 20 5f 20 6e s-cb (lambda _ n 02e0: 6c 69 6e 73 29 20 23 3a 68 65 69 67 68 74 2d 63 lins) #:height-c 02f0: 62 20 28 6c 61 6d 62 64 61 20 5f 20 68 65 69 67 b (lambda _ heig 0300: 68 74 29 0a 20 20 20 20 23 3a 64 72 61 77 2d 63 ht). #:draw-c 0310: 62 0a 20 20 20 20 28 6d 61 6b 65 2d 63 65 6c 6c b. (make-cell 0320: 73 2d 64 72 61 77 2d 63 62 20 72 65 6e 64 65 72 s-draw-cb render 0330: 2d 63 65 6c 6c 29 29 29 29 0a 29 0a 0a 28 69 6d -cell)))).)..(im 0340: 70 6f 72 74 0a 20 28 6f 6e 6c 79 20 69 75 70 20 port. (only iup 0350: 73 68 6f 77 20 6d 61 69 6e 2d 6c 6f 6f 70 29 0a show main-loop). 0360: 20 20 63 65 6c 6c 73 2d 74 65 73 74 29 0a 0a 28 cells-test)..( 0370: 73 68 6f 77 20 63 65 6c 6c 73 2d 64 69 61 6c 6f show cells-dialo 0380: 67 29 0a 28 6d 61 69 6e 2d 6c 6f 6f 70 29 0a g).(main-loop).