(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)))