Home Assignments Lecture Blog Resources Project

**91.301 Organization of Programming Languages** **Prof. F. Martin**

## Problem Set 4: Henderson Picture Language

### Scheme Settings

- Use PLT Scheme version 4.x
- Choose the "Module" language
- Put the following statement at the beginning of your buffer (after
`#lang scheme`

):

`(require (planet "sicp.ss" ("soegaard" "sicp.plt" 2 1)))`

## Overview

The goal of this problem set is to reinforce ideas about data abstraction and higher-order procedures, and to emphasize the expressive power that derives from appropriate primitives, means of combination, and means of abstraction.

*Proc. ACM Conference on Lisp and Functional Programming*, 1982). The image display code was designed and implemented by Daniel Coore. Modifications by Holly Yanco, Allyn Dimock, and Fred Martin.

## But First

Go back and do the problems on map, filter, and accumulate from Problem Set 3. This is problems 6, 8, 9, and 10. **Don't forget!**

## Reading for PS4

Before doing this problem set, read the following material:

- SICP 2.2.4 (pp. 126–141)
- Overview of Henderson Picture Language on PLT-Scheme web site

## 1. The Square-limit language

Remember from lecture that the key idea in the square-limit language
is to use *painter* procedures that take frames as inputs and
paint images that are scaled to fit the frames.

### Basic data structures

Vectors are represented as pairs of numbers.

(define make-vect cons) (define vector-xcor car) (define vector-ycor cdr)

Here are the operations of vector addition, subtraction, and scaling a vector by a number:

(define (vector-add v1 v2) (make-vect (+ (xcor v1) (xcor v2)) (+ (ycor v1) (ycor v2)))) (define (vector-sub v1 v2) (vector-add v1 (vector-scale -1 v2))) (define (vector-scale x v) (make-vect (* x (xcor v)) (* x (ycor v))))

A pair of vectors determines a directed line segment—the segment running from the endpoint of the first vector to the endpoint of the second vector:

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

**Frames**

A frame is represented by three vectors: an origin and two edge vectors.

(define (make-frame origin edge1 edge2) (list 'frame origin edge1 edge2)) (define frame-origin cadr) (define frame-edge1 caddr) (define frame-edge2 cadddr)

The frame's origin is given as a vector with respect to the origin of the graphics-window coordinate system. The edge vectors specify the offsets of the corners of the frame from the origin of the frame. If the edges are perpendicular, the frame will be a rectangle; otherwise it will be a more general parallelogram. Figure 2.15 on page 135 of SICP shows a frame and its associated vectors.

Each frame determines a system of “frame coordinates” ** (x,y)** where

**is the origin of the frame,**

*(0,0)***represents the displacement along the first edge (as a fraction of the length of the edge) and**

*x***is the displacement along the second edge. For example, the origin of the frame has frame coordinates**

*y***and the vertex diagonally opposite the origin has frame coordinates**

*(0,0)***.**

*(1,1)*Another way to express this idea is to say that each frame has an
associated *frame coordinate map* that transforms the frame
coordinates of a point into the Cartesian plane coordinates of the
point. That is, ** (x,y)** gets mapped onto the Cartesian
coordinates of the point given by the vector sum

*x** Edge1(Frame) +

*y** Edge2(Frame)

We can represent the frame coordinate map by the following procedure:

(define (frame-coord-map frame) (lambda (point-in-frame-coords) (vector-add (frame-origin frame) (vector-add (vector-scale (vector-xcor point-in-frame-coords) (frame-edge1 frame)) (vector-scale (vector-ycor point-in-frame-coords) (frame-edge2 frame))))))

For example, `((frame-coord-map a-frame) (make-vect 0 0))`

will return the same value as `(frame-origin a-frame)`

.

The procedure `make-relative-frame`

provides a convenient way to transform frames. Given a frame and three points `origin`

, `corner1`

, and `corner2`

(expressed in frame coordinates), it returns a new frame with those corners:

(define (make-relative-frame origin corner1 corner2) (lambda (frame) (let ((m (frame-coord-map frame))) (let ((new-origin (m origin))) (make-frame new-origin (vector-sub (m corner1) new-origin) (vector-sub (m corner2) new-origin))))))

For example,

(make-frame-relative (make-vect .5 .5) (make-vect 1 .5) (make-vect .5 1))

returns the procedure that transforms a frame into the upper-right quarter of the frame.

**Painters**

As described in Section 2.2.4 of SICP, a painter is a procedure that, given a frame as argument, “paints” a picture in the frame. That is to say, if `p`

is a painter and `f`

is a frame, then evaluating `(p f)`

will cause an image to appear in the frame. The image will be scaled and stretched to fit the frame.

The language you will be working with includes four ways to create primitive painters.

The simplest painters are created with `number->painter`

, which takes a number as argument. These painters fill a frame with a solid shade of gray. The number specifies a gray level: 0 is black, 255 is white, and numbers in between are increasingly lighter shades of gray. Here are some examples:

(define black (number->painter 0)) (define white (number->painter 255)) (define gray (number->painter 150))

You can also specify a painter using `procedure->painter`

, which takes a procedure as argument. The procedure determines a gray level (0 to 255) as a function of ** (x,y)** position, for example:

(define diagonal-shading (procedure->painter (lambda (x y) (* 100 (+ x y)))))

The ** x** and

**coordinates run from 0 to 1 and specify the fraction that each point is offset from the frame's origin along the frame's edges. (See Figure 2.15 in SICP.) Thus, the frame is filled out by the set of points**

*y***such that**

*(x,y)***and**

*0 <= x <= 1***.**

*0 <= y <= 1*A third kind of painter is created by `segments->painter`

, which takes a list of line segments as argument. This paints the line drawing specified by the list segments. The ** (x,y)** coordinates of the line segments are specified as above. For example, you can make the “Z” shape shown below as:

(define mark-of-zorro (let ((v1 (make-vect .1 .9)) (v2 (make-vect .8 .9)) (v3 (make-vect .1 .2)) (v4 (make-vect .9 .3))) (segments->painter (list (make-segment v1 v2) (make-segment v2 v3) (make-segment v3 v4)))))

*Please note: the*

`mark-of-zorro`

procedure is already defined in the starter code associated with the problem set.The final way to create a primitive painter is from a stored image. The procedure `load-painter`

loads a GIF image from disk. Note—it must be a 128x128 pixel grayscale GIF. For example:

(define bonsai (load-painter "/Users/fredm/Documents/uml/301/ps/henderson/bonsai.gif"))

will create a painter that will display an image of a bonsai tree:

### Transforming and combining painters

We can transform a painter to produce a new painter which, when given a frame, calls the original painter on the transformed frame. For example, if `p`

is a painter and `f`

is a frame, then

(p ((make-frame-relative (make-vect .5 .5) (make-vect 1 .5) (make-vect .5 1)) f))

will paint in the upper-right-hand corner of the frame.

We can abstract this idea with the following procedure:

(define (transform-painter origin corner1 corner2) (lambda (painter) (compose painter (make-relative-frame origin corner1 corner2))))

Note: The definition of `transform-painter`

differs from the one in SICP on page 138. Look at the definition of the procedure in the book and the one above; convince yourself that they do the same thing.

Calling `transform-painter`

with an origin and two corners, returns a procedure that transforms a painter into one that paints relative to a new frame with the specified origin and corners. For example, we could define:

(define (shrink-to-upper-left painter) ((transform-painter (make-vect .5 .5) (make-vect 1 .5) (make-vect .5 1)) painter))

Note that this can be written equivalently as

(define shrink-to-upper-left (transform-painter (make-vect .5 .5) (make-vect 1 .5) (make-vect .5 1)))

Other transformed frames will flip images horizontally:

(define flip-horiz (transform-painter (make-vect 1 0) (make-vect 0 0) (make-vect 1 1)))

or rotate images counterclockwise by 90 degrees:

(define rotate90 (transform-painter (make-vect 1 0) (make-vect 1 1) (make-vect 0 0)))

By repeating rotations, we can create painters whose images are rotated through 180 or 270 degrees:

(define rotate180 (repeated rotate90 2)) (define rotate270 (repeated rotate90 3))

We can combine the results of two painters a single frame by calling each painter on the frame:

(define (superpose painter1 painter2) (lambda (frame) (painter1 frame) (painter2 frame)))

To draw one image beside another, we combine one in the left half of the frame with one in the right half of the frame:

(define (beside painter1 painter2) (let ((split-point (make-vect .5 0))) (superpose ((transform-painter zero-vector split-point (make-vect 0 1)) painter1) ((transform-painter split-point (make-vect 1 0) (make-vect .5 1)) painter2))))

We can also define painters that combine painters vertically, by using `rotate`

together with `beside`

. The painter produced by `below`

shows the image for `painter1`

below the image for `painter2`

:

(define (below painter1 painter2) (rotate270 (beside (rotate90 painter2) (rotate90 painter1))))

## Exercises

In DrScheme version 4.x, set the language to **Modular** and put the following code after `#lang scheme`

at the top of your buffer:

(require (planet "sicp.ss" ("soegaard" "sicp.plt" 2 1)))

To paint a picture, use the procedure `paint`

; e.g.:

(paint einstein)

should work. You can also display more detail with `paint-hires`

:

(paint-hires mark-of-zorro)

You can print out your work with File:Print Interactions... .

## Exercises

**Exercise 1.** With the current implementation of the Henderson picture language, this question is not relevant and is no longer part of the problem set.

**Exercise 2.** Describe the patterns drawn by

(procedure->painter (lambda (x y) (* x y))) (procedure->painter (lambda (x y) (* 255 x y)))

**Exercise 3.** Describe the effect of

(transform-painter (make-vect 0 .5) (make-vect .5 1) (make-vect .1 0))

Try this on paper first, before typing it in.

**Exercise 4.** Make a collection of primitive painters to use in the rest of this
lab. In addition to the ones predefined for you (and listed in section 1), define at least one new painter of each of the four primitive types: a uniform gray level made with `number->painter`

, something defined with `procedure->painter`

, a line-drawing made with `segments->painter`

, and an image of your choice (remember, it must be a 128x128 pixel grayscale GIF).

Turn in a list of your definitions: `my-number-painter`

, `my-procedure-painter`

, `my-segments-painter`

, `my-image-painter`

. Include your GIF file(s) in your electronic submission.

**Exercise 5.** Experiment with some combinations of your primitive painters, using `beside`

, `below`

, `superpose`

, flips, and rotations, to get a feel for how these means of combination work. You needn't turn in anything for this exercise.

**Exercise 6.** The “diamond” of a frame is defined to be the smaller frame created by joining the midpoints of the original frame's sides. Define a procedure `diamond`

that transforms a painter into one that paints its image in the diamond of the specified frame, as shown in below. Try some examples, and turn in a listing of your procedure.

**Exercise 7.** The “diamond” transformation has the property that, if you start with a square frame, the diamond frame is still square (although rotated).

Define a procedure `make-non-square-diamond`

which takes 3 parameters: the first is the y coordinate of the origin (the x coordinate of the origin will always be 0); the second is the x coordinate of edge1 (y will always be 0); and the third is the x coordinate of edge2 (y will always be 1).

Use your procedure `make-non-square-diamond`

to define `non-square-diamond-1`

with the first parameter equal to 0.2, the second equal to 0.1 and the third equal to 0.9. Write at least one other transform that uses `make-non-square-diamond`

to define it. Try your transformation(s) on some images to get some nice effects. Turn in a listing of your procedures.

**Exercise 8.** The following recursive `right-split`

procedure was demonstrated in lecture:

(define (right-split painter n) (if (= n 0) painter (let ((smaller (right-split painter (- n 1)))) (beside painter (below smaller smaller)))))

Try this with some of the painters you've previously defined, both primitives and combined ones. Now define an analogous `up-split`

procedure as demonstrated below on the `mark-of-zorro`

painter. Make sure to test it on a variety of painters. Turn in a listing of your procedure. (In defining your procedure, remember that `(below painter1 painter2)`

produces `painter1`

below `painter2`

.)

` (up-split mark-of-zorro 4)`

`up-split`

procedure places a picture below two (recursively) up-split copies of itself.
**Exercise 9.** *Before working on this problem, add the following two procedure definitions to your buffer:*

(define (identity x) x) (define (repeated f n) (cond ((= n 0) identity) ((= n 1) f) (else (compose f (repeated f (- n 1))))))

`Right-split`

and `up-split`

are both examples of a common pattern that begins with a means of combining two painters and applies this over and over in a recursive pattern. We can capture this idea in a procedure called `keep-combining`

, which takes as argument a `combiner`

(which combines two painters). For instance, we should be able to give an alternative definition of `right-split`

as

(define new-right-split (keep-combining (lambda (p1 p2) (beside p1 (below p2 p2)))))

Complete the following definition of `keep-combining`

:

(define (keep-combining combine-2) ;; combine-2 = (lambda (painter1 painter2) ...) (lambda (painter n) ((repeated <fill in missing expression> n) painter)))

Show that you can indeed define `right-split`

using your procedure, and give an analogous definition of `up-split`

.

**Exercise 10.** Once you have `keep-combining`

, you can use it to define lots of recursive means of combination. Here are three examples:

(define nest-diamonds (keep-combining (lambda (p1 p2) (superpose p1 (diamond p2))))) (nest-diamonds diagonal-shading 4) (define new-comb (keep-combining (lambda (p1 p2) (square-limit (below p1 p2) 2)))) (new-comb mark-of-zorro 1) (define mix-with-einstein (keep-combining (lambda (p1 p2) (below (beside p1 einstein) (beside p2 p2))))) (mix-with-einstein logo 3)

**Exercise 11.** The procedures you have implemented give you a wide choice of things to experiment with. Invent some new means of combination, both simple ones like `beside`

and complex higher-order ones like `keep-combining`

and see what kinds of interesting images you can create. Turn in the code and one or two images: procedure `painter-11a`

, optionally `painter-11b`

, ...

**Optional/Grad/Honors/Extra Credit.** Hopefully, you generated some interesting designs in doing this assignment. Enter images of your best designs in the OPL PS4 design contest!

Turn in your designs on the wiki at this URL:

http://www.cs.uml.edu/ecg/index.php/OrganizationProgrammingLanguagesFall2008/PS4contest

The password for editing the wiki will be posted to the class Google group.

Designs will be judged by the 6.001 staff and other paragons of design expertise (Fred and Jane), and fabulous prizes will be awarded in lecture. There is a limit of five entries per student. Make sure to turn in not only the pictures, but also the procedure(s) that generated them.