ant.rkt

#lang racket
(require (except-in 2htdp/universe left right)
         2htdp/image)

(struct pos (x y) #:transparent)
(struct ant (pos dir) #:transparent)
(struct world (a b n) #:transparent)

(define dirs
  (let* ([i (overlay (triangle 8 "solid" "black")
                     (rectangle 10 10 'solid 'green))]
         [ph (make-placeholder #f)]
         [x `((up ,i 0 -1)
              (left ,(rotate 90 i) -1 0)
              (down ,(rotate 180 i) 0 1)
              (right ,(rotate 270 i) 1 0)
              . ,ph)])
    (placeholder-set! ph x)
    (make-reader-graph x)))

(define left cdr)
(define right cdddr)

(define (move-ant a)
  (match-define (ant (pos x y) d) a)
  (match (car d)
    ((list _ _ dx dy) (ant (pos (+ x dx) (+ y dy)) d))))

(define (step w)
  (match w
    ((world a b 'move) (move a b))
    ((world a b 'turn) (turn a b))))

(define (move a b)
  (world (move-ant a)
         b
         'turn))

(define (turn a b)
  (match-define (ant p d) a)
  (define-values (dir add/remove) 
    (if (set-member? b p)
        (values left set-remove)
        (values right set-add)))
  (world (ant p (dir d))
         (add/remove b p)
         'move))

(define (draw w)
  (match-define (world (ant (pos x y) d) b _) w)
  (define i (draw-colors b (empty-scene 400 400)))
  (place-image (cadar d)
               (* x 10)
               (* y 10)
               i))

(define (draw-colors b scene)
  (for/fold ([i scene])
            ([bpos b])
    (place-image (rectangle 10 10 'solid 'black)
                 (* (pos-x bpos) 10)
                 (* (pos-y bpos) 10)
                 i)))

(big-bang (world (ant (pos 20 20) (right dirs))
                 (set (pos 23 19)
                      (pos 23 20)
                      (pos 23 21))
                 'move)
          (on-tick step 1/4)
          (to-draw draw))