2009/04/09

A Picture Language on BiwaScheme


I am playing on BiwaScheme these days. BiwaScheme is the hotest implementation of Scheme on JavaScript. It run on your web browser!
It has no functional references, specifications, and less runtime debug information, but maybe it could fix soon, and it almost works along to R6RS!
Because of its famility of JavaScript, it is easy to use DHTML. So I decidede to make "A Picture Language" in SICP 2.2.4. It was easy job. I wrote a little Scheme code, and a little HTML. Got it!

A Picture Language


It's run on full scheme feature, so you can make any image that you want. If you want to draw a picture of mandara, just put code and push 'draw' button:

(define (transform-painter painter origin corner1 corner2)
(lambda (frame)
(let ((m (frame-coord-map frame)))
(let ((new-origin (m origin)))
(painter
(make-frame new-origin
(sub-vect (m corner1) new-origin)
(sub-vect (m corner2) new-origin)))))))

(define (flip-vert painter)
(transform-painter painter
(make-vect 0.0 1.0)
(make-vect 1.0 1.0)
(make-vect 0.0 0.0)))

(define (flip-horiz painter)
(transform-painter painter
(make-vect 1.0 0.0)
(make-vect 0.0 0.0)
(make-vect 1.0 1.0)))

(define (compose-painters . painters)
(lambda (frame)
(for-each (lambda (painter)
(painter frame))
painters)))

(define (beside painter1 painter2)
(let ((split-point (make-vect 0.5 0.0)))
(let ((paint-left
(transform-painter painter1
(make-vect 0.0 0.0)
split-point
(make-vect 0.0 1.0)))
(paint-right
(transform-painter painter2
split-point
(make-vect 1.0 0.0)
(make-vect 0.5 1.0))))
(compose-painters paint-left paint-right))))

(define (below painter1 painter2)
(let ((split-point (make-vect 0.0 0.5)))
(let ((paint-top
(transform-painter painter1
(make-vect 0.0 0.0)
(make-vect 1.0 0.0)
split-point))
(paint-bottom
(transform-painter painter2
split-point
(make-vect 1.0 0.5)
(make-vect 0.0 1.0))))
(compose-painters paint-top paint-bottom))))

(define (split f1 f2)
(define (recur painter n)
(if (= n 0)
painter
(let ((smaller (recur painter (- n 1))))
(f1 painter (f2 smaller smaller)))))
recur)

(define right-split (split beside below))
(define up-split (split below beside))

(define (corner-split painter n)
(if (= n 0)
painter
(let ((up (up-split painter (- n 1)))
(right (right-split painter (- n 1))))
(let ((top-left (beside up up))
(bottom-right (below right right))
(corner (corner-split painter (- n 1))))
(beside (below painter top-left)
(below bottom-right corner))))))

(define (mirror painter)
(below (flip-vert (beside (flip-horiz painter) painter))
(beside (flip-horiz painter) painter)))

(mirror (corner-split %image 2))


You want to use BiwaScheme? Check github's master repository and pull it!

No comments: