#lang racket (require (rename-in graphics/turtles (split turtle-split))) (provide (all-defined-out)) ;; Code for integrating Racket's turtle graphics library (define turtle-x -1) (define turtle-y -1) (define turtle-pen-down #f) (define (cs) (turtles #t) (clear) (set! turtle-x (/ turtle-window-size 2)) (set! turtle-y (/ turtle-window-size 2)) (set! turtle-pen-down #f)) (define (penup) (set! turtle-pen-down #f)) (define (pendown) (set! turtle-pen-down #t)) (define (setxy x y) (let ((relative-x (- x turtle-x)) (relative-y (* -1 (- y turtle-y)))) (begin (if turtle-pen-down (draw-offset relative-x relative-y) (move-offset relative-x relative-y)) (set! turtle-x x) (set! turtle-y y)))) (define (draw-line v1 v2) (penup) (setxy (- (* (xcor-vect v1) turtle-window-size) (/ turtle-window-size 2)) (- (* (ycor-vect v1) turtle-window-size) (/ turtle-window-size 2))) (pendown) (setxy (- (* (xcor-vect v2) turtle-window-size) (/ turtle-window-size 2)) (- (* (ycor-vect v2) turtle-window-size) (/ turtle-window-size 2)))) (define (export filename) (save-turtle-bitmap (string->path filename) 'png)) ;; Code for the picture language (define (flipped-pairs painter) (let ((painter2 (beside painter (flip-vert painter)))) (below painter2 painter2))) (define (right-split painter n) (if (= n 0) painter (let ((smaller (right-split painter (- n 1)))) (beside painter (below smaller smaller))))) (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 (square-limit painter n) (let ((quarter (corner-split painter n))) (let ((half (beside (flip-horiz quarter) quarter))) (below (flip-vert half) half)))) (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 (identity x) x) (define (frame-coord-map frame) (lambda (v) (add-vect (origin-frame frame) (add-vect (scale-vect (xcor-vect v) (edge1-frame frame)) (scale-vect (ycor-vect v) (edge2-frame frame)))))) (define (segments->painter segment-list) (lambda (frame) (for-each (lambda (segment) (draw-line ((frame-coord-map frame) (start-segment segment)) ((frame-coord-map frame) (end-segment segment)))) segment-list))) (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 (shrink-to-upper-right painter) (transform-painter painter (make-vect 0.5 0.5) (make-vect 1.0 0.5) (make-vect 0.5 1.0))) (define (rotate90 painter) (transform-painter painter (make-vect 1.0 0.0) (make-vect 1.0 1.0) (make-vect 0.0 0.0))) (define (squash-inwards painter) (transform-painter painter (make-vect 0.0 0.0) (make-vect 0.65 0.35) (make-vect 0.35 0.65))) (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)))) (lambda (frame) (paint-left frame) (paint-right frame))))) ;; End of picture language code ;; ;; Your code goes below ;; ;; Exercise 1 (define (up-split painter n) (error "not yet implemented")) ;; Exercise 2 (define (split major minor) (error "not yet implemented")) ;; Exercise 3 (define (make-vect major minor) (void "not yet implemented")) (define xcor-vect "not yet implemented") (define ycor-vect "not yet implemented") (define (add-vect v1 v2) (error "not yet implemented")) (define (sub-vect v1 v2) (error "not yet implemented")) (define (scale-vect s v) (error "not yet implemented")) ;; Execise 4 ; First definition of make-frame (define (make-frame origin edge1 edge2) (list origin edge1 edge2)) (define origin-frame "not yet implemented") (define edge1-frame "not yet implemented") (define edge2-frame "not yet implemented") ; Second definition of make-frame (define (make-frame-2 origin edge1 edge2) (cons origin (cons edge1 edge2))) (define origin-frame-2 "not yet implemented") (define edge1-frame-2 "not yet implemented") (define edge2-frame-2 "not yet implemented") ;; Exercise 5 (define make-segment "not yet implemented") (define start-segment "not yet implemented") (define end-segment "not yet implemented") ;; Exercise 6 (define outline-painter "not yet implemented") (define x-painter "not yet implemented") (define diamond-painter "not yet implemented") (define wave-painter "not yet implemented") ;; Exercise 7 (define (flip-horiz painter) (error "not yet implemented")) (define (rotate180 painter) (error "not yet implemented")) (define (rotate270 painter) (error "not yet implemented")) ;; Exercise 8 (define (below painter1 painter2) (error "not yet implemented")) (define (below-2 painter1 painter2) (error "not yet implemented")) ;; Exercise 9 ; Modify wave-painter above (Exercise 6) ; Modify me! (define (corner-split-2 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-2 painter (- n 1)))) (beside (below painter top-left) (below bottom-right corner)))))) ; Modify me! (define (square-limit-2 painter n) (let ((combine4 (square-of-four flip-horiz identity rotate180 flip-vert))) (combine4 (corner-split painter n)))) ;; End of project ;; Don't touch anything below this (define full-frame (make-frame (make-vect 0.5 0.5) (make-vect 1 0) (make-vect 0 1)))