Skip to content

Commit

Permalink
update picts
Browse files Browse the repository at this point in the history
  • Loading branch information
jwilliamson1 committed Jan 22, 2018
1 parent 5425774 commit 1dab6c9
Show file tree
Hide file tree
Showing 2 changed files with 91 additions and 18 deletions.
46 changes: 33 additions & 13 deletions pict.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -59,8 +59,8 @@

;(paint(square-limit einstein 5))

(define (make-vect x y)
(cons x y))
;(define (make-vect x y)
; (cons x y))

(define (xcor-vect v)
(car v))
Expand Down Expand Up @@ -103,8 +103,8 @@
(xcor-vect(scale-vect 10 a-vect))
(ycor-vect(scale-vect 10 a-vect))

(define (make-frame origin edge1 edge2)
(list origin edge1 edge2))
;(define (make-frame origin edge1 edge2)
; (list origin edge1 edge2))

(define frame1 (make-frame (make-vect 0 0)(make-vect 0 1)(make-vect 1 0)))

Expand Down Expand Up @@ -145,18 +145,18 @@
; segment-list)))

;; heh
(define make-segment cons)
; (define make-segment cons)
(define start-segment car)
(define end-segment cdr)

(define outline-segments (list (make-segment (make-vect .02 .02)
(make-vect .02 .98))
(make-segment (make-vect .02 .98)
(make-vect .98 .98))
(make-segment (make-vect .98 .02)
(make-vect .98 .98))
(make-segment (make-vect .02 .02)
(make-vect .98 .02))))
(define outline-segments (list (make-segment (make-vect .01 .01)
(make-vect .01 .99))
(make-segment (make-vect .01 .99)
(make-vect .99 .99))
(make-segment (make-vect .99 .01)
(make-vect .99 .99))
(make-segment (make-vect .01 .01)
(make-vect .99 .01))))

(define x-segments (list(make-segment (make-vect 0 0)
(make-vect 1 1))
Expand All @@ -170,3 +170,23 @@

(paint (segments->painter outline-segments))
(paint (segments->painter x-segments))

(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)))

(paint (flip-vert einstein))
63 changes: 58 additions & 5 deletions pict2.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -128,9 +128,14 @@
(make-segment (make-vect .75 0) (make-vect .6 0))
(make-segment (make-vect .6 0) (make-vect .5 .3))
(make-segment (make-vect .5 .3) (make-vect .4 0))
(make-segment (make-vect .4 0) (make-vect .25 0))
(make-segment (make-vect .4 0) (make-vect .25 0))
;smile
(make-segment (make-vect .48 .75)(make-vect .52 .75))
(make-segment (make-vect .45 .78)(make-vect .48 .75))
(make-segment (make-vect .55 .78)(make-vect .52 .75))
)))
;George!
;(wave unit-frame)

(define (flip-vert painter)
(transform-painter
Expand Down Expand Up @@ -216,9 +221,57 @@
(define (below-rot painter1 painter2)
(rotate90 (beside (rotate270 painter2)(rotate270 painter1))))

((below-rot wave wave)unit-frame)

;((below-rot wave wave)unit-frame)
(define (split op1 op2)
(define (split-iter painter n)
(if (= n 0)
painter
(let ((smaller (split-iter painter
(- n 1))))
(op1 painter
(op2 smaller smaller)))))
split-iter
)
;((below wave wave)unit-frame)

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

(define (repeat-painter transform painter n)
(cond ((< n 1) painter)
((= n 1)(transform painter painter))
(else(transform (repeat-painter transform painter (- n 1))
(repeat-painter transform painter (- n 1))))))

;((repeat-painter beside wave 2)unit-frame)

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


((corner-split wave 3 3) unit-frame)

(define (square-of-four tl tr bl br)
(lambda (painter)
(let ((top (beside (tl painter)
(tr painter)))
(bottom (beside (bl painter)
(br painter))))
(below bottom top))))

(define (square-limit painter n)
(let ((combine4
(square-of-four flip-horiz
identity
rotate180
flip-vert)))
(combine4 (corner-split painter n))))

0 comments on commit 1dab6c9

Please sign in to comment.