| changeset 128: | ec406bcb6fa0 |
| parent: | 1fe149ef1213 |
| author: | Dmitry Dzhus <dima@sphinx.net.ru> |
| date: | Sun Oct 26 21:30:42 2008 +0300 (3 weeks ago) |
| permissions: | -rw-r--r-- |
| description: | Comment |
1(load "2.46.scm")2(load "2.47.scm")3(load "2.48.scm")4(load "cairo.scm")6(define (frame-coord-map frame)7 (lambda (vector)8 (add-vect9 (origin frame)10 (add-vect11 (scale-vect (edge1 frame) (x-vect vector))12 (scale-vect (edge2 frame) (y-vect vector))))))14;; Fun(ky)ctional painter production!15(define (segments->painter segment-list)16 (lambda (frame)17 (lambda (drawing)18 (if (null? segment-list)19 drawing20 (((segments->painter (cdr segment-list))21 frame)22 ((draw-segment23 (let ((segment (car segment-list)))24 (make-segment25 ((frame-coord-map frame) (start-segment segment))26 ((frame-coord-map frame) (end-segment segment)))))27 drawing))))))29(define stroke-border30 (segments->painter31 (make-path32 (make-vect 0 0)33 (make-vect 1 0)34 (make-vect 1 1)35 (make-vect 0 1)36 (make-vect 0 0))))38(define draw-cross39 (segments->painter40 (list41 (make-segment (make-vect 0 0)42 (make-vect 1 1))43 (make-segment (make-vect 1 0)44 (make-vect 0 1)))))46(define rhombus47 (segments->painter48 (make-path49 (make-vect 0 0.5)50 (make-vect 0.5 0)51 (make-vect 1 0.5)52 (make-vect 0.5 1)53 (make-vect 0 0.5))))55(define wave56 (segments->painter57 (make-path58 (make-vect 0 0.75)59 (make-vect 0.50 0.25)60 (make-vect 0.75 0.75)61 (make-vect 1 0.25))))