Functional PostScript Examples
This program draws arrows recursively. It demonstrate the use of the composition procedure join and the transformation procedures translate, scale, and rotate.
The arrow is HEIGHT tall, the arrow-shaft/arrow-head angles are 45 degrees, and the recursive scale factor is 3/5. This makes it 1.3258 * HEIGHT wide (in the limit). It is positioned 10% of HEIGHT out from the origin -- the lower-left corner of the arrow's bounding box is at (HEIGHT/10, HEIGHT/10). [PostScript Output]
(define (fractal-arrow height depth) (let* ((s 3/5) (half-width (/ s ; Width of unit arrow / 2. (- 1 (* s s)))) (arrow1 (unit-arrow-path depth))) (stroke (translate (+ (/ (- (inch 8) height) 2) (* 1/2 height)) (/ (- (inch 10) height) 2) (scale height height arrow1)) (:line-join 'bevel))))Make a unit fractal-arrow path. The initial shaft of the arrow goes from (0,0) to (0,1), the shaft/head angles are 45 degrees, and the recursive scale factor is 3/5. This makes the arrow 1.3258 wide in the limit, centered on the Y axis. I.e., the arrow's bounding box is (-0.663, 0) (0.663, 1)
(define (unit-arrow-path depth) (let* ((stem (line (pt 0 0) (pt 0 1))) ; Basic line (cw (deg->rad -135)) ; Clockwise rot angle (ccw (- cw)) ; Counter clockwise rot angle (s 3/5)) ; Scale factor (let recur ((depth depth)) (if (<= depth 1) stem (let ((sub-arrow (scale s s (recur (- depth 1))))) (compose stem (translate 0 1 (rotate cw sub-arrow)) (translate 0 1 (rotate ccw sub-arrow))))))))
FPS Examples: Right-angle Fractal | Arrow Fractal | Headlines | Clipping Message | Turkey Bitmap | Sun | Bounding Box | Morphing Square to Circle | Text Along a Circle | Demo Driver