From 69a9c425dd2215f5f600c79b72f0ca7fa7bd32bb Mon Sep 17 00:00:00 2001
From: Helmut Merz <helmutm@cy55.de>
Date: Tue, 4 Aug 2026 10:46:20 +0200
Subject: [PATCH] csys: program basic-1 (2 sensors, 2 effectors) working

---
 core/message.lisp   |  6 ++++--
 csys/csys.lisp      |  3 ++-
 csys/environ.lisp   | 10 ++++++++--
 csys/program.lisp   |  2 +-
 test/test-csys.lisp | 10 ++++++++++
 5 files changed, 25 insertions(+), 6 deletions(-)

diff --git a/core/message.lisp b/core/message.lisp
index a815a93..83dec7a 100644
--- a/core/message.lisp
+++ b/core/message.lisp
@@ -40,8 +40,10 @@
     (list (car head) (cadr head))))
 
 (defun addr (msg)
-  (let ((head (shape:head msg)))
-    (cons (car head) (cddr head))))
+  (let* ((head (shape:head msg)))
+    (if (caddr head)
+      (cons (car head) (cddr head))
+      nil)))
 
 (defun categ (msg)
   (let ((head (shape:head msg)))
diff --git a/csys/csys.lisp b/csys/csys.lisp
index 88a57bf..fb7efd3 100644
--- a/csys/csys.lisp
+++ b/csys/csys.lisp
@@ -183,7 +183,8 @@
 
 ;;;; public shortcuts
 
-(defun send-create (cell &rest args &key (domain :csys) (cat :c00) loc connect op)
+(defun send-create (cell &rest args &key (domain :csys) 
+                         (cat :c00) loc connect op &allow-other-keys)
   (let ((args+ (if loc 
                  `(:addr ,(list domain cat loc))
                  `(:categ ,(list domain cat)))))
diff --git a/csys/environ.lisp b/csys/environ.lisp
index 2057442..a68c427 100644
--- a/csys/environ.lisp
+++ b/csys/environ.lisp
@@ -28,7 +28,7 @@
         :notify (csys:no-op)
         :effect (csys:no-op)
         :value #'forward
-        :connect #'forward
+        :connect #'forward-connect
         :default (csys:no-op :no-forward t)))
 
 (defun cell-created (msg scope)
@@ -53,6 +53,12 @@
           (util:lgw "no addr and no :to field in message" msg scope)))))
   nil)
 
+(defun forward-connect (msg scope)
+  (let* ((data (shape:data msg))
+         (tgt (car (find-cells (cells scope) (getf data :target)))))
+    (setf (getf data :target) tgt)
+    (forward (message:create (shape:head msg) :data data) scope)))
+
 ;;;; public shortcuts
 
 (defun send-value (env val &key (domain :csys) (cat :c00) (loc ""))
@@ -61,7 +67,7 @@
 
 (defun send-connect (env &rest args &key (domain :csys) addr to target op)
   (let ((head (list domain :connect))) 
-    (actor:send env (message:create head args))))
+    (actor:send env (message:create head :data args))))
  
 ;;;; internal helpers
 
diff --git a/csys/program.lisp b/csys/program.lisp
index 15996b7..5c4d5d3 100644
--- a/csys/program.lisp
+++ b/csys/program.lisp
@@ -60,7 +60,7 @@
 (defun b1-next-one-basic ()
   (lambda (msg scope) 
     (let ((self actor:*self*)
-          (env (env scope)))
+          (env (csys:environ scope)))
       (environ:send-connect env :to self :target '(:csys :e00 "1-0") 
                             :op (csys:multiply -1))
       (environ:send-connect env :to self :target '(:csys :e00 "1-1"))
diff --git a/test/test-csys.lisp b/test/test-csys.lisp
index 7c225e6..101d846 100644
--- a/test/test-csys.lisp
+++ b/test/test-csys.lisp
@@ -31,6 +31,7 @@
 (defun setup-config ()
   (config:add :test-receiver :setup #'tc:setup)
   (config:add-action '(:csys :effect :e01) (value-in '(1 2)))
+  (config:add-action '(:csys :effect :e00) (value-in '(1 2)))
   ;(config:add-action '(:csys :effect) #'tc:check-message)
   (config:add-action '(:csys) (constantly nil)))
 
@@ -48,6 +49,7 @@
     (async:init)
     (unwind-protect
       (test-basic-0)
+      (test-basic-1)
       (sleep 0.1)
       (tc:check-expected)
       (t:show-result))))
@@ -72,3 +74,11 @@
     (environ:send-value env 2 :cat :s01 :loc "0-1")
     (sleep 0.1)
     (core:shutdown)))
+
+(deftest test-basic-1 ()
+  (let ((env (setup-test (program:basic-1) :zero-cat :s00)))
+    (sleep 0.1)
+    (environ:send-value env 1 :cat :s00 :loc "0-1")
+    ;(environ:send-value env 2 :cat :s00 :loc "0-1")
+    (sleep 0.1)
+    (core:shutdown)))