1 ;; The first three lines of this file were inserted by DrScheme. They record metadata
2 ;; about the language level of this file in a form that our tools can easily process.
3 #reader(lib "htdp-advanced-reader.ss" "lang")((modname |32.3|) (read-case-sensitive #t) (teachpacks ((lib "draw.ss" "teachpack" "htdp") (lib "arrow.ss" "teachpack" "htdp") (lib "gui.ss" "teachpack" "htdp"))) (htdp-settings #(#t constructor repeating-decimal #t #t none #f ((lib "draw.ss" "teachpack" "htdp") (lib "arrow.ss" "teachpack" "htdp") (lib "gui.ss" "teachpack" "htdp")))))
4 ;A solitaire board (board) is a (vectorof (vectorof booleans)), where true represents a filled square, false an empty square.  In particular, for any given board, the n-th element is a vector containing n booleans.  We call a triangular board with n-pegs to a side a size-n triangle.  For example, the representation of a size-4 equilaterial triangular board:
5 
6 ;(vector (vector false)
7 ;        (vector true true)
8 ;        (vector true true true)
9 ;        (vector true true true true))
10 
11 ;enabled? : posn board -> boolean
12 ;Determines whether or not the peg specified by aposn is enabled in aboard (enabled means that the peg is capable of jumping).  The top position of the board has the index (make-posn 1 1).  The vertical axis is denoted by y, the horizontal by x.
13 
14 ;next-peg-x represents the x-index where the peg will jump to if it jumps to the right
15 ;next-peg-y represents the y-index where the peg will jump to if it jumps down
16 ;prev-peg-x represents the x-index ... if the peg jumps to the left
17 ;prev-peg-x represents the y-index ... if the peg jumps up
18 ;need-length-x represents the necessary horizontal length of the board to jump to the right
19 ;need-length-y represents the necessary vertical length of the board to jump down
20 ;next-peg-x-removes represents the x-index of the peg that will be removed if the peg is jumped, etc.
21 
22 (define (enabled? aposn aboard)
23   (local ((define peg-x (sub1 (posn-x aposn)))
24           (define peg-y (sub1 (posn-y aposn)))
25           (define next-peg-x-removes (+ peg-x 1))
26           (define next-peg-y-removes (+ peg-y 1))
27           (define prev-peg-x-removes (- peg-x 1))
28           (define prev-peg-y-removes (- peg-y 1))
29           (define next-peg-x (+ peg-x 2))
30           (define next-peg-y (+ peg-y 2))
31           (define prev-peg-x (- peg-x 2))
32           (define prev-peg-y (- peg-y 2))
33           (define need-length-x (+ peg-x 3))
34           (define need-length-y (+ peg-y 3)))
35     (cond
36       ;;is there even a peg?
37       [(not (vector-ref (vector-ref aboard peg-y) peg-x)) false]
38       ;;jumping down
39       [(and (>= (vector-length aboard) need-length-y)
40             (not (vector-ref (vector-ref aboard next-peg-y) peg-x))
41             (vector-ref (vector-ref aboard next-peg-y-removes) peg-x)) true]
42       ;;jumping right
43       [(and (>= (vector-length (vector-ref aboard peg-y)) need-length-x)
44             (not (vector-ref (vector-ref aboard peg-y) next-peg-x))
45             (vector-ref (vector-ref aboard peg-y) next-peg-x-removes)) true]
46       ;;jumping up
47       [(and (not (negative? prev-peg-y))
48             (not (vector-ref (vector-ref aboard prev-peg-y) peg-x))
49             (vector-ref (vector-ref aboard prev-peg-y-removes) peg-x)) true]
50       ;;jumping left
51       [(and (not (negative? prev-peg-x))          
52             (not (vector-ref (vector-ref aboard peg-y) prev-peg-x))
53             (vector-ref (vector-ref aboard peg-y) prev-peg-x-removes)) true]
54       ;;jumping diagonal (up)
55       [(and (not (negative? prev-peg-x))
56             (not (negative? prev-peg-y))
57             (not (vector-ref (vector-ref aboard prev-peg-y) prev-peg-x))
58             (vector-ref (vector-ref aboard prev-peg-y-removes) prev-peg-x-removes)) true]
59       ;;jumping diagonal (down)
60       [(and (>= (vector-length aboard) need-length-y)
61             (>= (vector-length (vector-ref aboard next-peg-y)) need-length-x)
62             (not (vector-ref (vector-ref aboard next-peg-y) next-peg-x))
63             (vector-ref (vector-ref aboard next-peg-y-removes) next-peg-x-removes)) true]
64       [else false])))