Back to notes -- Keyboard shortcut: 'u'              Slide 20 : 24
Program 1
 

 (let* ((x1 50) (x2 200) (x3 350) (x4 500) (x5 650) (x6 800)
        (y0 50) (y1 100) (y2 200) (y3 350)
        (step-new-node 1) (step-new-cons-cell 2)
        (step-node-cell-connect 3) (step-remember-tail 4)
        (step-connect-front 5) (step-connect-rear 6) 
       )
  (with-animation '(step-buttons-reveal)
   (let*
       ((c1 (cons-cell x1 y1 ""))
        (c2 (cons-cell x2 y1 ""))
        (c3 (cons-cell x3 y1 ""))
        (c4 (cons-cell x4 y1 ""))
        (c5 (cons-cell x5 y1 ""))
        (e1 (element-node x1 y2 "e1"))
        (e2 (element-node x2 y2 "e2"))
        (e3 (element-node x3 y2 "e3"))
        (e4 (element-node x4 y2 "e4"))
        (e5 (element-node x5 y2 "e5"))

        (e-new (element-node (+ x2 75)  y3 "e" 'step step-new-node 
                             'bg-color "red"))
        (c-new (cons-cell (+ x2 (- 75 20)) (- y3 75) "" 
                          'step step-new-cons-cell))
        (c-e-new (svg-edge c-new "cc" e-new "ct" 'stroke "black" 
                           'arrow "yes" 'step step-node-cell-connect))

        (link-to (svg-edge c2 "cc" c-new "ct" 'from-id "cdr-cell"
                           'stroke "black" 'arrow "yes" 'step step-connect-front))
        (link-back (svg-edge c-new "cc" c3 "lb" 'from-id "cdr-cell"
                           'stroke "black" 'arrow "yes" 'step step-connect-rear))
        (e1-edge (svg-edge c1 "cc" e1 "ct" 'stroke "black" 'arrow "yes"))
        (e2-edge (svg-edge c2 "cc" e2 "ct" 'stroke "black" 'arrow "yes"))
        (e3-edge (svg-edge c3 "cc" e3 "ct" 'stroke "black" 'arrow "yes"))
        (e4-edge (svg-edge c4 "cc" e4 "ct" 'stroke "black" 'arrow "yes"))
        (e5-edge (svg-edge c5 "cc" e5 "ct" 'stroke "black" 'arrow "yes"))
        (var-tail (svg-node rectangular (+ x2 70) y0  "" 'bg-color "yellow" 'stroke "black" 
                            'step-from step-remember-tail 'step-to step-connect-rear 
                            'min-width 40 'min-height 40 ))
        (link-from-var-tail (svg-edge var-tail "cc" c3 "lt" 'stroke "black" 'arrow "yes" 
                               'step-from step-remember-tail 'step-to step-connect-rear))
        (c-empty (svg-node rectangular x6 y1 "( )" 'stroke "none" ))
        (r1 (cons-ref c1 c2 "lc"))
        (r2 (cons-ref c2 c3 "lc" 'step-to step-connect-front))
        (r3 (cons-ref c3 c4 "lc"))
        (r4 (cons-ref c4 c5 "lc"))
        (r-ept (cons-ref c5 c-empty  "lc"))
        )
     (svg-graph 'from-step 1 'to-step 6
                (list c1 c2 c3 c4 c5 c-empty  e1 e2 e3 e4 e5 
                      e-new c-new var-tail)
                (list r1 r2 r3 r4 r-ept
                      e1-edge e2-edge e3-edge e4-edge e5-edge
                      c-e-new link-to link-back link-from-var-tail)
                (explanations 'x 10 'y 430 'width 600 'height 100 'font-size 25
                  (explanation 'step 0 "The start situation. We see a list with five elements e1 ... e5.")
                  (explanation 'step step-new-node "We want to insert element e after e2")
                  (explanation 'step step-new-cons-cell "A new cons cell is allocated")
                  (explanation 'step step-node-cell-connect "The new cons cell now references the element e")
                  (explanation 'step step-remember-tail "In order not to loose the tail, we remember a pointer to the third cons cell")
                  (explanation 'step step-connect-front "The new cons cell is linked into the existing link.")
                  (explanation 'step step-connect-rear "The new cons cell connects to the tail of the existing list")
                )         
     )
    )
   )
 )


(define (cons-cell x y car-txt . attributes)
 (let* ((wd 40)
        (default-svg-node-attributes (list 'font-size 22 'min-height wd 
                                           'min-width wd 'stroke-width 1))
        (effective-attributes (append attributes default-svg-node-attributes)))
  (let ((car-box (svg-node rectangular x y car-txt 'id "car-cell" 
                           'lc "cc" 'text-align "cc" effective-attributes))
        (cdr-box (svg-node rectangular (+ x wd) y "" 
                           'id "cdr-cell" 'lc "cc" effective-attributes)))
   (g car-box cdr-box ))))

(define (element-node x y label . attributes)
 (let* ((default-attributes (list 'min-width 50 'min-height 50 'font-size 22  'rx 25 'ry 25
                                  'step 0 'bg-color (rgb-color-encoding 157 198 140)))
        (effective-attributes (append attributes default-attributes)))
   (svg-node rectangular x y label effective-attributes)))

; A reference from the cdr part of cons cell-1 to cons cell-2. 
; to-locator determines the edge attachment in cell-2.
; attributes are fused into the svg-edge. 
(define (cons-ref cell-1 cell-2 to-locator . attributes)
 (let* ((default-attributes (list 'stroke "black" 'arrow "yes"))
        (effective-attributes (append attributes default-attributes)))
  (svg-edge cell-1 "cc" cell-2 to-locator 'from-id "cdr-cell"
            'to-id "car-cell" effective-attributes)))