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