From 61e110bb75df16bfdfe98200985e23a832179861 Mon Sep 17 00:00:00 2001
From: "chris.double" <chris.double@double.co.nz>
Date: Wed, 29 Mar 2006 10:00:57 +0000
Subject: [PATCH] add while-no-messages to concurrency

while-no-messages will run a quotation while there is no messages in the processes mailbox. This is useful for game loops.
---
 contrib/concurrency/concurrency.factor | 17 ++++++++++++++++-
 1 file changed, 16 insertions(+), 1 deletion(-)

diff --git a/contrib/concurrency/concurrency.factor b/contrib/concurrency/concurrency.factor
index 010e6844da..5315d4713a 100644
--- a/contrib/concurrency/concurrency.factor
+++ b/contrib/concurrency/concurrency.factor
@@ -116,7 +116,16 @@ TUPLE: mailbox threads data ;
   #! The thread then resumes, leaving the item on the stack.
   (mailbox-block-if-empty)
   mailbox-data dlist-pop-front ;
- 
+
+: while-mailbox-empty ( mailbox quot -- )
+  #! Run the quotation until there is an item in the mailbox.
+  #! Quotation should have stack effect ( -- ).
+  over mailbox-empty? [
+    dup >r swap >r call r> r> while-mailbox-empty
+  ] [
+    2drop
+  ] if ; inline
+
 : mailbox-get? ( pred mailbox -- obj )
   #! Get the first item in the mailbox which satisfies the predicate.
   #! 'pred' will be called with each item on the stack. When pred returns
@@ -177,6 +186,12 @@ init-main-process
 
 TUPLE: linked-exception error ;
 
+: while-no-messages ( quot -- )
+  #! Run the quotation in a loop while no messages are in
+  #! the processes mailbox. The quot should have stack effect
+  #! ( -- ).
+  >r self process-mailbox r> while-mailbox-empty ; inline
+
 : send ( message process -- )
   #! Send the message to the process by placing it in the
   #! processes mailbox.