|
|
@ -1,5 +1,5 @@
|
|
|
|
#lang br
|
|
|
|
#lang br
|
|
|
|
(require racket/file rackunit racket/dict)
|
|
|
|
(require racket/file rackunit racket/set)
|
|
|
|
|
|
|
|
|
|
|
|
(define edge-flipped
|
|
|
|
(define edge-flipped
|
|
|
|
(let ()
|
|
|
|
(let ()
|
|
|
@ -50,48 +50,16 @@
|
|
|
|
(define (edge-tile? tile) (matching-edge-count tile 3))
|
|
|
|
(define (edge-tile? tile) (matching-edge-count tile 3))
|
|
|
|
(define (corner-tile? tile) (matching-edge-count tile 2))
|
|
|
|
(define (corner-tile? tile) (matching-edge-count tile 2))
|
|
|
|
|
|
|
|
|
|
|
|
(check-equal? (apply * (map tile-num (filter corner-tile? tiles))) 15405893262491)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(define corners (filter corner-tile? tiles))
|
|
|
|
(define corners (filter corner-tile? tiles))
|
|
|
|
(define first-corner (car corners))
|
|
|
|
(check-equal? (apply * (map tile-num corners)) 15405893262491)
|
|
|
|
|
|
|
|
|
|
|
|
(require racket/set)
|
|
|
|
(define first-corner (car corners))
|
|
|
|
(define tileset (apply mutable-set (map tile-num tiles)))
|
|
|
|
|
|
|
|
(define tile-grid (make-hasheqv))
|
|
|
|
(define tile-grid (make-hasheqv))
|
|
|
|
|
|
|
|
|
|
|
|
(define (flip-css css) (map reverse css))
|
|
|
|
(define (flip-css css) (map reverse css))
|
|
|
|
|
|
|
|
(define (flip t) (tile (tile-num t) (tile-edges t) (flip-css (tile-css t))))
|
|
|
|
(define (flip t)
|
|
|
|
(define (rotate-css css) (map reverse (apply map list css)))
|
|
|
|
(tile (tile-num t) (tile-edges t) (flip-css (tile-css t))))
|
|
|
|
(define (rotate t) (tile (tile-num t) (tile-edges t) (rotate-css (tile-css t))))
|
|
|
|
|
|
|
|
|
|
|
|
(define (rotate-css css)
|
|
|
|
|
|
|
|
(map reverse (apply map list css)))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(define (rotate t)
|
|
|
|
|
|
|
|
(tile (tile-num t) (tile-edges t) (rotate-css (tile-css t))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
#;(define (place-line tile coord orientation)
|
|
|
|
|
|
|
|
(hash-set! tile-grid coord tile)
|
|
|
|
|
|
|
|
(set-remove! tileset (tile-num tile))
|
|
|
|
|
|
|
|
(for ([(edge idx) (in-indexed (tile-edges tile))]
|
|
|
|
|
|
|
|
[dir '(+i 1 -i -1)]
|
|
|
|
|
|
|
|
[matching-tile (matching-tiles tile)]
|
|
|
|
|
|
|
|
#:when (and matching-tile (= dir orientation)))
|
|
|
|
|
|
|
|
;; match polarity
|
|
|
|
|
|
|
|
(unless (memq edge (tile-edges matching-tile))
|
|
|
|
|
|
|
|
(flip! matching-tile))
|
|
|
|
|
|
|
|
;; match rotation
|
|
|
|
|
|
|
|
(let loop ()
|
|
|
|
|
|
|
|
(rotate! matching-tile)
|
|
|
|
|
|
|
|
(unless (eq? (list-ref (tile-edges tile) idx)
|
|
|
|
|
|
|
|
(list-ref (tile-edges matching-tile) idx))
|
|
|
|
|
|
|
|
(loop)))
|
|
|
|
|
|
|
|
;; rotate 180
|
|
|
|
|
|
|
|
(rotate! matching-tile)
|
|
|
|
|
|
|
|
(rotate! matching-tile)
|
|
|
|
|
|
|
|
;; invert polarity
|
|
|
|
|
|
|
|
(flip! matching-tile)
|
|
|
|
|
|
|
|
(place-line matching-tile (+ coord dir) orientation)))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(define (top tile) (first (tile-css tile)))
|
|
|
|
(define (top tile) (first (tile-css tile)))
|
|
|
|
(define (bottom tile) (last (tile-css tile)))
|
|
|
|
(define (bottom tile) (last (tile-css tile)))
|
|
|
@ -116,7 +84,6 @@
|
|
|
|
[#false (void)]
|
|
|
|
[#false (void)]
|
|
|
|
[joiner (hash-set! tile-grid (+ coord dir) joiner)])))
|
|
|
|
[joiner (hash-set! tile-grid (+ coord dir) joiner)])))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(hash-set! tile-grid 0 first-corner)
|
|
|
|
(hash-set! tile-grid 0 first-corner)
|
|
|
|
(for* ([imag (in-range 12)]
|
|
|
|
(for* ([imag (in-range 12)]
|
|
|
|
[real (in-range 0 -12 -1)])
|
|
|
|
[real (in-range 0 -12 -1)])
|
|
|
@ -132,8 +99,6 @@
|
|
|
|
(for/list ([real (in-range -11 1)])
|
|
|
|
(for/list ([real (in-range -11 1)])
|
|
|
|
(trim-edge (tile-css (hash-ref tile-grid (+ real (* imag +i))))))))))
|
|
|
|
(trim-edge (tile-css (hash-ref tile-grid (+ real (* imag +i))))))))))
|
|
|
|
|
|
|
|
|
|
|
|
#;(for-each (λ (x) (displayln (list->string x))) actual-image)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(define row-width (length (car actual-image)))
|
|
|
|
(define row-width (length (car actual-image)))
|
|
|
|
(define (css->vec css) (list->vector (apply append css)))
|
|
|
|
(define (css->vec css) (list->vector (apply append css)))
|
|
|
|
|
|
|
|
|
|
|
|