mirror of
https://github.com/justinethier/cyclone.git
synced 2025-05-23 20:15:05 +02:00
91 lines
3.2 KiB
Scheme
91 lines
3.2 KiB
Scheme
(define-library (example life)
|
|
(include-c-header "../write-png.h")
|
|
;Or, if you want angle brackets: (include-c-header "<stdio.h>")
|
|
(export life)
|
|
(import (scheme base) ;TODO: (except (scheme base) set!)
|
|
(scheme write)
|
|
(example grid))
|
|
(begin
|
|
(define (life-count grid i j)
|
|
(define (count i j)
|
|
(if (ref grid i j) 1 0))
|
|
(+ (count (- i 1) (- j 1))
|
|
(count (- i 1) j)
|
|
(count (- i 1) (+ j 1))
|
|
(count i (- j 1))
|
|
(count i (+ j 1))
|
|
(count (+ i 1) (- j 1))
|
|
(count (+ i 1) j)
|
|
(count (+ i 1) (+ j 1))))
|
|
(define (life-alive? grid i j)
|
|
(case (life-count grid i j)
|
|
((3) #t)
|
|
((2) (ref grid i j))
|
|
(else #f)))
|
|
(define (life-print grid iteration)
|
|
(let ((img (png:init (cols grid) (rows grid)))
|
|
(path (string-append
|
|
"life-"
|
|
(if (< iteration 10) "0" "")
|
|
(number->string iteration)
|
|
".png")))
|
|
(png:fill! img 255 255 255)
|
|
(each grid
|
|
(lambda (i j v)
|
|
(if v
|
|
(png:set! img i j 0 250 (* 3 iteration))) ; 250 0))
|
|
))
|
|
(png:save img path)
|
|
(png:free img)
|
|
))
|
|
(define (life grid iterations)
|
|
(do ((i 0 (+ i 1))
|
|
(grid0 grid grid1)
|
|
(grid1 (make (rows grid) (cols grid))
|
|
grid0))
|
|
((= i iterations))
|
|
(each grid0
|
|
(lambda (j k v)
|
|
(let ((a (life-alive? grid0 j k)))
|
|
(put! grid1 j k a))))
|
|
;(set! grid1 j k a))))
|
|
(life-print grid1 i)))
|
|
(define-c png:init
|
|
"(void *data, int argc, closure _, object k, object width, object height)"
|
|
" RGBBitmap *img = malloc(sizeof(RGBBitmap));
|
|
make_c_opaque(opq, (void *)img);
|
|
bitmap_init(img, (int)(unbox_number(width)), (int)(unbox_number(height)));
|
|
return_closcall1(data, k, &opq);
|
|
")
|
|
(define-c png:free
|
|
"(void *data, int argc, closure _, object k, object opq)"
|
|
" RGBBitmap *img = (RGBBitmap *)opaque_ptr(opq);
|
|
free(img->pixels);
|
|
free(img);
|
|
return_closcall1(data, k, boolean_t);
|
|
")
|
|
(define-c png:set!
|
|
"(void *data, int argc, closure _, object k, object opq, object x, object y, object r, object g, object b)"
|
|
" RGBBitmap *img = (RGBBitmap *)opaque_ptr(opq);
|
|
bitmap_set(img,
|
|
((int)(unbox_number(x))),
|
|
((int)(unbox_number(y))),
|
|
((int)(unbox_number(r))),
|
|
((int)(unbox_number(g))),
|
|
((int)(unbox_number(b))));
|
|
return_closcall1(data, k, boolean_t); ")
|
|
(define-c png:fill!
|
|
"(void *data, int argc, closure _, object k, object opq, object r, object g, object b)"
|
|
" RGBBitmap *img = (RGBBitmap *)opaque_ptr(opq);
|
|
bitmap_fill(img,
|
|
((int)(unbox_number(r))),
|
|
((int)(unbox_number(g))),
|
|
((int)(unbox_number(b))));
|
|
return_closcall1(data, k, boolean_t); ")
|
|
(define-c png:save
|
|
"(void *data, int argc, closure _, object k, object opq, object path)"
|
|
" RGBBitmap *img = (RGBBitmap *)opaque_ptr(opq);
|
|
bitmap_save_to_png(img, string_str(path));
|
|
return_closcall1(data, k, boolean_t);
|
|
")
|
|
))
|