sicp-ex-2.44

I am really uncomfortable writing code that I can't run ... it would be nice if the authors could have come up with an example that didn't assume the presence of other code or libraries. As it is, I'm having a bit of trouble figuring out how this works.

  
 (define (up-split painter n) 
   (cond ((= n 0) painter) 
         (else 
          (let ((smaller (up-split painter (- n 1)))) 
            (below painter (beside smaller smaller)))))) 
  

The gimp comes with a scheme interpreter. Perhaps you can try it there. For me print was good enough.

Hello,

If you are using DrRacket, follow these steps:

1) Install the package sicp.plt (Go to file>Install Package, type 'sicp.plt' in package source)

2) Paste this code '(require (planet "sicp.ss" ("soegaard" "sicp.plt" 2 1)))' in your rkt file.

3) Test the file with the code '(paint einstein)'. You should see a picture of Einstein in your command line.

If you want to test your code, do this:

 (require (planet "sicp.ss" ("soegaard" "sicp.plt" 2 1))) 
  
 (define (right-split painter n) 
    (if (= n 0) 
        painter 
        (let ((smaller (right-split painter (- n 1)))) 
          (beside painter (below smaller smaller))))) 
  
 (paint (right-split einstein 3)) 
  
 (define (up-split painter n) 
   (if (= n 0) 
       painter 
       (let ((smaller (up-split painter (- n 1)))) 
         (below painter (beside smaller smaller))))) 
  
 (paint (up-split einstein 3)) 

Now is 2019-07-23 09:29:32

Here is Racket-lang code.

  
 #lang sicp 
  
 (#%require sicp-pict) 
  
 (define (up-split painter n) 
   (if (= n 0) 
       painter 
       (let ((smaller (up-split painter (- n 1)))) 
         (below painter (beside smaller smaller))))) 
  
 (paint (up-split einstein 4)) 
  

2019-12-30: Using Racket 7.5. First install sicp using file/package manager and 'sicp'. Having trouble using (load), so using #lang racket and (require)

  
 #lang racket 
 ;; file: par2.2.4.scm 
  
 (provide (all-defined-out)) 
  
 (require sicp-pict) 
  
 ;; (paint einstein) 
  
 ;; use zorro instead of wave 
 (define wave mark-of-zorro) 
  
 (define wave2 (beside wave (flip-vert wave))) 
 (define wave4 (below wave2 wave2)) 
  
 (define (flipped-pairs painter) 
   (let ((painter2 (beside painter (flip-vert painter)))) 
     (below painter2 painter2))) 
  
 ;; cannot redefine procedures 
 (define wave4a (flipped-pairs wave)) 
  
 (define (right-split painter n) 
   (if (= n 0) 
       painter 
       (let ((smaller (right-split painter (- n 1)))) 
         (beside painter (below smaller smaller))))) 
  
 ;; up-split also here. 
 (define (up-split painter n) 
   (if (= n 0) 
       painter 
       (let ((smaller (up-split painter (- n 1)))) 
         (below painter (beside 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)))) 
  

  
 #lang racket 
 ;; file: ex2.44.scm 
  
 (require sicp-pict) 
  
 (require "par2.2.4.scm") 
  
 (define (up-split painter n) 
   (if (= n 0) 
       painter 
       (let ((smaller (up-split painter (- n 1)))) 
         (below painter (beside smaller smaller))))) 
  
 ;; (paint (up-split einstein 3)) 
 ;; (paint (corner-split einstein 2)) 
  

If you are using guile with emacs geiser, I DON'T recommend this guile-picture-language.

Eventually I managed do the png painting with Guile-Cairo, it's rather simple to draw an png with cairo.

 (define-module (chapter2_2_4) 
   #:use-module (assert) 
   #:use-module (cairo) 
   #:use-module (srfi srfi-9)            ;for record defination 
   #:use-module (srfi srfi-9 gnu)        ;for record printer 
   #:use-module (exercise2_38) 
   #:use-module ((chapter2_2_3) 
                 #:select (flatmap)) 
   #:export (make-canvas)) 
  
 (define-record-type <canvas-printer> 
   (make-canvas-printer file) 
   canvas-printer? 
   (file canvas-print-file)) 
  
 (set-record-type-printer! 
  <canvas-printer> 
  (lambda (record port) 
    (format port "#<Image: ~a>" (canvas-print-file record)))) 
  
 (define (make-canvas width height) 
   (let* ((width width) 
          (height height) 
          (surface (cairo-image-surface-create 'argb32 width height)) 
          (cr (cairo-create surface))) 
     (define (set-default) 
       ;; background 
       ;; (cairo-save cr) 
       ;; (cairo-set-source-rgb cr 1 1 1) 
       ;; (cairo-paint cr) 
       ;; (cairo-restore cr) 
       ;; default cairo context setting 
       (cairo-set-source-rgb cr 0 0 0) 
       (cairo-select-font-face cr "Sans" 'normal 'normal) 
       (cairo-set-font-size cr 14.0) 
       (cairo-set-line-width cr 1.0)) 
     (define (destroy) 
       (cairo-destroy cr) 
       (cairo-surface-destroy surface)) 
     ;; emacs caches image, so we use a new name everytime 
     ;; the image changes. 
     (define (png-name) 
       (string-append "/tmp/geiser-" 
                      (number->string (random 10000)) 
                      "-" 
                      (number->string (random 10000)) 
                      ".png")) 
     (define (save) 
       (let ((filename (png-name))) 
         (cairo-surface-write-to-png surface filename) 
         (make-canvas-printer filename))) 
     (set-default) 
     (lambda* (cmd 
               #:optional x y 
               #:key file (w width) (h height) text) 
       (case cmd 
         ((reset) 
          (destroy) 
          (when w (set! width w)) 
          (when h (set! height h)) 
          (set! surface (cairo-image-surface-create 'argb32 w h)) 
          (set! cr (cairo-create surface)) 
          (set-default) 
          (save)) 
         ((save) 
          (cairo-surface-write-to-png surface file) 
          (make-canvas-printer file)) 
         ((destroy) 
          (destroy)) 
         ((move-to) 
          (cairo-move-to cr x y)) 
         ((line-to) 
          (cairo-line-to cr x y) 
          (cairo-stroke cr)) 
         ((text) 
          (cairo-show-text cr text) 
          (save)) 
         ((width) 
          width) 
         ((height) 
          height) 
         ((printer) 
          (save)) 
         (else (error "unsurpported cmd:" cmd))) 
       ))) 
  
 (define (canvas->frame canvas) 
   (make-frame (make-vector 0 0) 
               (make-vector (canvas 'width) 0) 
               (make-vector 0 (canvas 'height)) 
               canvas)) 
  
 (define (draw-line sg eg canvas) 
   (canvas 'move-to (xcor-vector sg) (ycor-vector sg)) 
   (canvas 'line-to (xcor-vector eg) (ycor-vector eg))) 
  
 (define (segments->painter segs) 
   (lambda (frame) 
     (for-each 
      (lambda (seg) 
        (draw-line 
         ((frame-coord-map frame) (start-segment seg)) 
         ((frame-coord-map frame) (end-segment seg)) 
         (canvas-frame frame))) 
      segs) 
     ((canvas-frame frame) 'printer))) 
  
 (define wave-lt '((0 . 28) (29 . 73) (56 . 64) (74 . 64) (64 . 28) (69 . 15) (74 . 0))) 
 (define wave-rt '((110 . 0) (119 . 28) (110 . 64) (137 . 64) (182 . 118))) 
 (define wave-rb '((137 . 182) (109 . 99) (182 . 154))) 
 (define wave-cb '((110 . 182) (92 . 127) (74 . 182))) 
 (define wave-lb '((46 . 182) (65 . 91) (55 . 73) (29 . 109) (0 . 64))) 
  
 ;; ((110 . 182) (92 . 127)) 
 (define (shrink-to-1x1 seg base) 
   (let ((sg (start-segment seg)) 
         (eg (end-segment seg))) 
     (list (cons (exact->inexact (/ (xcor-vector sg) base)) 
                 (exact->inexact (/ (ycor-vector sg) base))) 
           (cons (exact->inexact (/ (xcor-vector eg) base)) 
                 (exact->inexact (/ (ycor-vector eg) base)))))) 
 (assert (shrink-to-1x1 '((110 . 182) (92 . 127)) 182) 
         '((0.6043956043956044 . 1.0) (0.5054945054945055 . 0.6978021978021978))) 
  
 (define (wave-lines->segment-list lines) 
   (map 
    (lambda (seg) 
      (shrink-to-1x1 seg 182)) 
    (foldr append '() 
           (map 
            (lambda (line) 
              (foldr 
               (lambda (point result) 
                 (cond ((null? result) 
                        (list point)) 
                       ((and (null? (cdr result)) 
                             (not (list? (car result)))) 
                        (list (list point (car result)))) 
                       (else 
                        (cons (list point (caar result)) 
                              result)))) 
               '() 
               line)) 
            lines)))) 
  
 (define (make-wave) 
   (segments->painter 
    (wave-lines->segment-list (list wave-cb wave-lb wave-rb wave-rt wave-lt)))) 
  
 (define c (make-canvas 500 500)) 
 (define p (make-wave)) 
 (p (make-frame (make-vector 200 10) 
                (make-vector 0 300) 
                (make-vector 100 0) 
                c)) 
 (p (canvas->frame c)) 
 (c 'printer) 
 (c 'destroy) 

the picture comes from sicp online booksicp online book