PasteRack.org
Paste # 16886
2022-06-12 15:51:19

Fork as a new paste.

Paste viewed 396 times.


Embed:

для критики

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

=>

image

image

image