From 027053b11a3a5d861ed2fa2db245388bd95ac246 Mon Sep 17 00:00:00 2001
From: Gene Pasquet <dev@etenil.net>
Date: Sun, 5 Apr 2026 19:47:05 +0100
Subject: Progress

---
 ai.scm | 135 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 135 insertions(+)
 create mode 100644 ai.scm

(limited to 'ai.scm')

diff --git a/ai.scm b/ai.scm
new file mode 100644
index 0000000..e6c1ec1
--- /dev/null
+++ b/ai.scm
@@ -0,0 +1,135 @@
+(module downstroke/ai *
+  (import scheme
+          (chicken base)
+          (chicken keyword)
+          (only srfi-1 find)
+          states
+          downstroke/entity
+          downstroke/world)
+
+  ;; Patrol speed in pixels per frame
+  (define *patrol-speed* 1)
+
+  ;; Chase behavior constants
+  (define *chase-speed* 2)
+  (define *detect-range-x* 80)
+  (define *detect-range-y* 16)
+  (define *chase-max-distance* 96)
+  (define *blind-spot-x* 16)
+  (define *attack-range-x* 20)
+  (define *attack-duration* 10)
+
+  ;; ---- Geometry helpers ----
+
+  (define (entity-center-x e)
+    (+ (entity-ref e #:x 0) (/ (entity-ref e #:width 0) 2)))
+
+  (define (entity-center-y e)
+    (+ (entity-ref e #:y 0) (/ (entity-ref e #:height 0) 2)))
+
+  (define (direction-to entity target)
+    (if (>= (entity-center-x target) (entity-center-x entity)) 1 -1))
+
+  ;; ---- Entity update helpers ----
+
+  ;; Find player by #:tags list (tag-based lookup, Milestone 10)
+  (define (find-player entities)
+    (find (lambda (e) (member 'player (entity-ref e #:tags '()))) entities))
+
+  ;; Set both facing fields in the same direction
+  (define (face-toward entity dir)
+    (entity-set (entity-set entity #:ai-facing dir) #:facing dir))
+
+  ;; Face a direction and set horizontal velocity
+  (define (move-toward entity dir speed)
+    (entity-set (face-toward entity dir) #:vx (* speed dir)))
+
+  ;; ---- Detection predicates ----
+
+  (define (player-in-range? entity entities)
+    (let ((player (find-player entities)))
+      (and player
+           (let ((dx (abs (- (entity-center-x player) (entity-center-x entity))))
+                 (dy (abs (- (entity-center-y player) (entity-center-y entity)))))
+             (and (<= dx *detect-range-x*)
+                  (<= dy *detect-range-y*)
+                  (not (and (< (entity-center-y player) (entity-center-y entity))
+                            (<= dx *blind-spot-x*))))))))
+
+  (define (player-in-attack-range? entity entities)
+    (let ((player (find-player entities)))
+      (and player
+           (<= (abs (- (entity-center-x player) (entity-center-x entity))) *attack-range-x*)
+           (<= (abs (- (entity-center-y player) (entity-center-y entity))) *detect-range-y*))))
+
+  ;; ---- State machine ----
+
+  (define (idle-trigger) #f)
+  (define (patrol-trigger) #f)
+  (define (chase-trigger) #f)
+
+  (define (make-enemy-ai-machine)
+    (state-machine idle
+      (idle-trigger   ! idle   -> patrol)
+      (patrol-trigger ! patrol -> chase)
+      (chase-trigger  ! chase  -> patrol)))
+
+  ;; ---- Per-state handlers ----
+
+  (define (ai-state-idle entity sm)
+    (%make-transition sm 'patrol)
+    (entity-set entity #:vx (* *patrol-speed* (entity-ref entity #:ai-facing 1))))
+
+  (define (patrol-wall-flip entity)
+    (let ((new-facing (- (entity-ref entity #:ai-facing 1))))
+      (move-toward entity new-facing *patrol-speed*)))
+
+  (define (ai-state-patrol entity entities sm)
+    (if (player-in-range? entity entities)
+        (let* ((player (find-player entities))
+               (dir    (direction-to entity player)))
+          (%make-transition sm 'chase)
+          (move-toward (entity-set entity #:chase-origin-x (entity-ref entity #:x 0))
+                       dir *chase-speed*))
+        (if (zero? (entity-ref entity #:vx 0))
+            (patrol-wall-flip entity)
+            entity)))
+
+  (define (chase-give-up? entity entities)
+    (let ((distance-chased (abs (- (entity-ref entity #:x 0)
+                                   (entity-ref entity #:chase-origin-x 0)))))
+      (or (not (player-in-range? entity entities))
+          (> distance-chased *chase-max-distance*))))
+
+  (define (ai-state-chase entity entities sm)
+    (if (player-in-attack-range? entity entities)
+        (let* ((player  (find-player entities))
+               (dir     (direction-to entity player))
+               (stopped (entity-set (face-toward entity dir) #:vx 0)))
+          (if (= (entity-ref stopped #:attack-timer 0) 0)
+              (entity-set stopped #:attack-timer *attack-duration*)
+              stopped))
+        (if (chase-give-up? entity entities)
+            (begin
+              (%make-transition sm 'patrol)
+              (entity-set entity #:vx (* *patrol-speed* (entity-ref entity #:ai-facing 1))))
+            (move-toward entity
+                         (direction-to entity (find-player entities))
+                         *chase-speed*))))
+
+  ;; ---- Top-level dispatcher ----
+
+  ;; Update AI for a single enemy entity.
+  ;; entities: all entities in the current scene (used for player detection).
+  (define (update-enemy-ai entity entities)
+    (if (entity-ref entity #:disabled #f)
+        entity
+        (let ((sm (entity-ref entity #:ai-machine #f)))
+          (if (not sm)
+              entity
+              (case (machine-state sm)
+                ((idle)   (ai-state-idle   entity sm))
+                ((patrol) (ai-state-patrol entity entities sm))
+                ((chase)  (ai-state-chase  entity entities sm))
+                (else     entity))))))
+)
-- 
cgit v1.2.3