graphgif/demo.scm
2024-10-11 17:57:45 -05:00

55 lines
1.1 KiB
Scheme

(use-modules (graphgif)
(srfi srfi-1))
(define my-graph
`(((10 . 10) (1) ,white)
((30 . 20) () ,red)))
(define more-complex-graph
`(((10 . 10) () ,white)
((40 . 10) (0) ,white)
((25 . 25) (0 1) ,white)
((10 . 40) (0 2 4) ,white)
((40 . 40) (1 2 3) ,white)))
(define (idx->x i w)
(modulo i w))
(define (idx->y i w)
(quotient i w))
(define (xy->idx x y w)
(+ (* y w) x))
(define (idx->edges i w)
(filter-map
(lambda (offset)
(let* ([x (idx->x i w)]
[y (idx->y i w)]
[ox (+ x (car offset))]
[oy (+ y (cdr offset))])
(and
(not (negative? ox))
(not (negative? oy))
(< ox w)
(xy->idx ox oy w))))
'(( 0 . -1)
(-1 . 0)
(-1 . -1)
(+1 . -1))))
(define (generate-web w h)
(define (make-node i)
(list
(cons (+ (* 30 (idx->x i w)) 10)
(+ (* 30 (idx->y i w)) 10))
(idx->edges i w)
white))
(let loop ([i 0]
[lst '()])
(if (>= i (* w h))
(reverse lst)
(loop (1+ i) (cons (make-node i) lst)))))
(write-graph-to-file (generate-web 5 5) (cadr (command-line)))