53 lines
1.0 KiB
Scheme
53 lines
1.0 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 (x y)
|
|
(if (or (negative? (+ (idx->x i w) x))
|
|
(negative? (+ (idx->y i w) y))
|
|
(>= (+ (idx->x i w) x) w))
|
|
#f
|
|
(xy->idx
|
|
(+ (idx->x i w) x)
|
|
(+ (idx->y i w) y)
|
|
w)))
|
|
'(+0 -1 -1 +1)
|
|
'(-1 +0 -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))
|
|
(reverse
|
|
(let loop ([i 0]
|
|
[lst '()])
|
|
(if (>= i (* w h))
|
|
lst
|
|
(loop (1+ i) (cons (make-node i) lst))))))
|
|
|
|
(write-graph-to-file (generate-web 5 5) (cadr (command-line)))
|