108 lines
2.1 KiB
Racket
108 lines
2.1 KiB
Racket
#lang slideshow
|
|
|
|
; From ppk's talk
|
|
|
|
;; Zebra crossing
|
|
|
|
; Building blocks. Too lazy to define over and over again. :-)
|
|
(define black-bar
|
|
(filled-rectangle 20 100))
|
|
(define white-bar
|
|
(colorize black-bar "white"))
|
|
|
|
; Seeing some patterns.
|
|
(define z1
|
|
(hc-append white-bar black-bar))
|
|
(define z2
|
|
(hc-append z1 z1))
|
|
(define z3
|
|
(hc-append z1 z2))
|
|
(define z4
|
|
(hc-append z1 z3))
|
|
|
|
; Ah.. so that's how it works!
|
|
(define (zebra n)
|
|
(if (<= n 1) z1
|
|
(hc-append z1 (zebra (- n 1)))))
|
|
|
|
;; Chess board
|
|
|
|
; Building blocks
|
|
(define black-cell
|
|
(filled-rectangle 20 20))
|
|
(define white-cell
|
|
(colorize black-cell "white"))
|
|
|
|
; Experimenting
|
|
(define b1
|
|
(vc-append
|
|
(hc-append white-cell black-cell)
|
|
(hc-append black-cell white-cell)))
|
|
|
|
(define b2
|
|
(vc-append
|
|
(hc-append b1 b1)
|
|
(hc-append b1 b1)))
|
|
|
|
(define b3
|
|
(vc-append
|
|
(hc-append b2 b2)
|
|
(hc-append b2 b2)))
|
|
|
|
; General version
|
|
(define (board n)
|
|
(if (<= n 1) b1
|
|
(vc-append
|
|
(hc-append (board (- n 1)) (board (- n 1)))
|
|
(hc-append (board (- n 1)) (board (- n 1))))))
|
|
|
|
|
|
;; Sierpinski carpet
|
|
(define (square n)
|
|
(rectangle n n))
|
|
|
|
(define (filled-square n)
|
|
(filled-rectangle n n))
|
|
|
|
(define (black-sq z) (filled-square 20))
|
|
(define (white-sq z)
|
|
(colorize (black-sq z) "white"))
|
|
|
|
|
|
;(define (sierpinski n z)
|
|
; (if (<= n 1)
|
|
; (white-sq z)
|
|
; (vc-append
|
|
; (black-sq z))))
|
|
|
|
|
|
(define (sierpinski n z)
|
|
(if (<= n 1)
|
|
(white-sq z)
|
|
(let ([sub-patt (sierpinski (- n 1) (quotient z 3))])
|
|
(vc-append
|
|
(hc-append sub-patt sub-patt sub-patt)
|
|
(hc-append sub-patt (square z) sub-patt)
|
|
(hc-append sub-patt sub-patt sub-patt)))))
|
|
|
|
(define (sq side)
|
|
(colorize (filled-rectangle side side) "white"))
|
|
|
|
(define (foo side lvl)
|
|
(if (not (= (remainder side 3) 0)) (blank 0)
|
|
(if (<= lvl 1)
|
|
(sq side)
|
|
(let*
|
|
([sub-side (quotient side 3)]
|
|
[sub-patt (foo sub-side (- lvl 1))]
|
|
[removed (rectangle sub-side sub-side)])
|
|
(vc-append
|
|
(hc-append sub-patt sub-patt sub-patt)
|
|
(hc-append sub-patt removed sub-patt)
|
|
(hc-append sub-patt sub-patt sub-patt))))))
|
|
|
|
(define pi 3.14)
|
|
|
|
(define (area r)
|
|
(* pi r r))
|