Turtle-Geometry-Book/chapter-2/animal.scm

(import
  (scheme base))

(define (rand bot top)
  (+ bot (random-integer (+ 1 (- top bot)))))

(define-operation (set-strategy! t new-strat))
(define-operation (set-food! t new-food))
(define-operation (get-food-pos t))
(define-operation (step! t spd trn))

(define (out-of-bounds? t)
  (define box-size 150)
  (or (> (abs (get-xcor t)) box-size)
      (> (abs (get-ycor t)) box-size)))

(define (check-forward! t dist)
  (define old-position (get-pos t))
  (define stuck-strategy 'wriggle)
  (pen-up! t)
  (hide! t)
  (forward! t dist)
  (let ((forward-failed? (out-of-bounds? t)))
    (set-pos! t old-position)
    (pen-down! t)
    (show! t)
    (if forward-failed?
        (cond
         ((eq? stuck-strategy 'reflect)
           (right! t 180))
         ((eq? stuck-strategy 'wriggle)
          (right! t 1)
          (check-forward! t 1))
         (else
          (error "Stuck strategy not recognized" stuck-strategy)))
        (forward! t dist))))

(define (smell t)
  (define dist 1)
  (define food-position (get-food-pos t))
  (define old-position (get-pos t))
  (pen-up! t)
  (hide! t)
  (forward! t dist)
  (let ((new-position (get-pos t)))
    (set-pos! t old-position)
    (pen-down! t)
    (show! t)
    (if (> (vector-distance new-position food-position)
           (vector-distance old-position food-position))
        'weaker
        'stronger)))

(define (find-by-smell-1 t stop-at)
  (let loop ((i 0))
    (when (< i stop-at)
      (forward! t 1)
      (when (eq? (smell t) 'weaker)
        (right! t 1))
      (loop (+ i 1)))))

(define (find-by-smell-2 t trn stop-at)
  (let loop ((i 0))
    (when (< i stop-at)
      (forward! t 1)
      (when (eq? (smell t) 'weaker)
        (right! t trn))
      (loop (+ i 1)))))

(define (find-by-smell-2.5 t d1 d2 smell-trn rand-trn stop-at)
  (let loop ((i 0))
    (when (< i stop-at)
      (forward! t (rand d1 d2))
      (left! t (rand (- rand-trn) rand-trn))
      (when (eq? (smell t) 'weaker)
        (right! t smell-trn))
      (loop (+ i 1)))))

(define (make-strategy-circle d a)
  (lambda (turt spd trn)
    (left! turt (* trn a))
    (forward! turt (* spd d))))

(define (make-strategy-random d1 d2 a1 a2)
  (lambda (turt spd trn)
    (left! turt (* trn (rand a1 a2)))
    (check-forward! turt (* trn (rand d1 d2)))))

(define (make-strategy-smell-3 d1 d2 smell-trn rand-trn)
  (lambda (turt spd trn)
    (forward! turt (* spd (rand d1 d2)))
    (left! turt (* trn (rand (- rand-trn) rand-trn)))
    (when (eq? (smell turt) 'weaker)
      (right! turt (* trn smell-trn)))))

(define (make-strategy-direct d)
  ;; directly face the food source
  (lambda (turt spd trn)
    (face! turt (get-food-pos turt))
    (forward! turt (* spd d))))

(define (make-hungry-turtle)
  (define strategy #f)
  (define food-pos #f)
  (object-with-ancestors ((p (make-turtle)))
    ((set-strategy! self new-strat)
     (set! strategy new-strat))
    ((set-food! self new-food)
     (set! food-pos new-food))
    ((get-food-pos self)
     (food-pos self))
    ((step! self spd trn)
     (strategy self spd trn))))