0. #lang racket
1.  
2. (require 2htdp/image)
3. (require racket/math)
4.  
5. (define-struct place [name x y])
6.  
7. (define positions (list
8.                    (make-place 'f6 -100.0 0.0)
9.                    (make-place 'f7 -87.0 -50.0)
10.                    (make-place 'f5 -87.0 50.0)
11.                    (make-place 'f8 -50.0 -87.0)
12.                    (make-place 'f4 -50.0 87.0)
13.                    (make-place 'f9 -0.0 -100.0)
14.                    (make-place 'f3 0.0 100.0)
15.                    (make-place 's6 0.0 0.0)
16.                    (make-place 's7 13.0 -50.0)
17.                    (make-place 's5 13.0 50.0)
18.                    (make-place 's8 50.0 -87.0) ;
19.                    (make-place 's4 50.0 87.0)  ;
20.                    (make-place 'f11 87.0 -50.0)
21.                    (make-place 'f1 87.0 50.0)
22.                    (make-place 'f12 100.0 -0.0)
23.                    (make-place 's9 100.0 -100.0)
24.                    (make-place 's3 100.0 100.0)
25.                    (make-place 's10 150.0 -87.0)
26.                    (make-place 's2 150.0 87.0)
27.                    (make-place 's11 187.0 -50.0)
28.                    (make-place 's1 187.0 50.0)
29.                    (make-place 's12 200.0 -0.0)
30.                    ))
31.  
32. (define smoves (list
33.                 (list 's1 's2)
34.                 (list 's2 's3)
35.                 (list 's3 's4)
36.                 (list 's4 's5)
37.                 (list 's5 's6)
38.                 (list 's6 's7)
39.                 (list 's8 's9)
40.                 (list 's9 's10)
41.                 (list 's10 's11)
42.                 (list 's11 's12)
43.                 (list 's12 's1)))
44.  
46. (define fmoves (list
47.                 (list 'f1 's4)
48.                 (list 's4 'f3)
49.                 (list 'f3 'f4)
50.                 (list 'f4 'f5)
51.                 (list 'f5 'f6)
52.                 (list 'f6 'f7)
53.                 (list 'f8 'f9)
54.                 (list 'f9 's8)
55.                 (list 's8 'f11)
56.                 (list 'f11 'f12)
57.                 (list 'f12 'f1)))
58.  
59. (define hash-color (make-hash  (list
60.                                 (cons 's1 'red) (cons 's2 'red) (cons 's3 'red)
61.                                 (cons 's4 'red) (cons 's5 'red) (cons 's6 'red)
62.                                 (cons 's7 'red) (cons 's8 'red) (cons 's9 'red)
63.                                 (cons 's10 'red) (cons 's11 'red) (cons 's11 'red)
64.                                 (cons 's12 'red) (cons 'f1 'blue) (cons 'f3 'blue)
65.                                 (cons 'f4 'blue) (cons 'f5 'blue) (cons 'f6 'blue)
66.                                 (cons 'f7 'blue) (cons 'f8 'blue) (cons 'f9 'blue)
67.                                 (cons 'f11 'blue) (cons 'f12 'blue))))
68.  
70. (define size 100)
71.  
72. (define (draw-places collection)
73.   (let loop ([wrk collection])
74.     (cond
75.       [(null? wrk)  (empty-scene (* 4 size) (* 2 size))]
76.       [else
77.        (overlay/offset
78.         (text (symbol->string (place-name (first wrk))) 12 "black")
79.         (place-x (first wrk)) (place-y (first wrk))
80.         (overlay/offset
81.          (circle 10 "solid" (hash-ref hash-color (place-name (first wrk))))
82.          (place-x (first wrk)) (place-y (first wrk))
83.          (loop (cdr wrk))))])))
84.  
86. (define (move-forward move-list )
87.   (let ([lastcolor (hash-ref hash-color (first (last move-list)))])
88.     (for [(moves move-list)]
89.       (let ([savecolor (hash-ref hash-color (last moves))])
90.         (hash-set! hash-color (last moves) lastcolor)
91.         (set! lastcolor savecolor)))))
92.  
94. (draw-places positions)
95. (move-forward fmoves )
96. (draw-places positions)
97. (move-forward smoves )
98. (draw-places positions)

=>