;;;; -*- Scheme -*-
;;
;; Beacons example for HLSIM
;;
;; David DeRoure June 12 1997, revised Sep 10 1997
;; dder@martigny.ai.mit.edu
;;
;; This file should be compiled with (cps "beacons1") followed by
;; (cbf "beacons1").  It uses definitions in beacons1d.scm.  See
;; beacons1s.scm for simulation setup.  See the HLSIM documentation
;; for further details.
;;
;; "Source" processors each transmit a message with an id, a color
;; and a hop count.  Each waits for a period of time and then transmits 
;; another message with a different id, color and smaller hop count.
;;
;; All of the processors rebroadcast (propagate) received messages, with 
;; the same id and color but with the hop count decremented by 1, UNLESS
;; (a) the element has already rebroadcast that message, or (b) the hop 
;; count in the received message is 0.  The color of the element changes 
;; to the color of the message it is rebroadcasting.  When a processor 
;; detects a collision, it flashes white.
;;
;; The result is a series of colored regions emanating from the originating
;; processors, of decreasing size.  If the average neighborhood density 
;; is high enough (e.g. > 10), a predictable "target" pattern emerges.  
;; With lower density the behavior is less predictable, especially if 
;; the time interval is such that one message can catch up with the 
;; previous one.
;;
;; To see the neighborhood density effects in one simulation, try using 
;; a simulation with mean neighborhood density that varies across the 
;; space, e.g. by using (expt (random 1.0) 0.4) in place of (random 1.0) 
;; for X and/or Y in make-sim/1 (you can do this with make-sim/f).

(declare (usual-integrations))

;; Every processor has an id (not the processor number, as that would
;; be cheating)

(define my-processor-id (random 1000000))

;; The make-new-message-id procedure, used only by sources, generates the
;; next message id.  On any one source, each id returned by this procedure
;; must be unique, and this is achieved here with a sequence of contiguous 
;; integers.  Instead of making id "global" (as with my-processor-id above
;; or messages-received below), a closure is used (to show this works too).

(define make-new-message-id          
  (let ((id 0))
    (lambda ()
      (set! id (1+ id))
      id)))

;; When a message arrives, the messages-received table is
;; checked by new-message? to see if a message from the same 
;; source and with the same id has arrived before.

(define messages-received (make-table))

;; This processor should originate messages if its processor
;; number is in the list of source processors.  This list
;; is kept in a slot in the simulation, so that the numbers can 
;; be set outside this file (where the simulation is set up) - see
;; comments at end for example.

(define (source?)
  (member (processor-number) 
	  (simulation.get (the-simulation) 'source-processors)))

;; The initial color of this processor depends whether it's a source.
;; (If sources are also propagators, they will often lose their color
;; during the simulation.)

(define my-color (if (source?) "cyan" "blue"))

;; The code for sources.  It sends 4 messages, each
;; 5000 time units apart, with hop counts of 36, 25, 16 and 9.

(define (source)
  (broadcast (make-message my-processor-id (make-new-message-id) 36 "orange"))
  (wait (make-timeout-event 5000))
  (broadcast (make-message my-processor-id (make-new-message-id) 25 "green"))
  (wait (make-timeout-event 5000))
  (broadcast (make-message my-processor-id (make-new-message-id) 16 "red"))
  (wait (make-timeout-event 5000))
  (broadcast (make-message my-processor-id (make-new-message-id) 9 "yellow")))

;; The loop for propagators (which will be every processor, including the
;; sources).  Increasing the delay after a collision to more that 100
;; can cause some subsequent messages to be ignored; using a random
;; number can avoid the pulsating effect.

(define primitive-message-event (make-event))

(define (propagator-loop)
  (select
    (global-timeout 'done)
    (primitive-message-event
     => (lambda (message)
          (event.clear! primitive-message-event)
          (if (eq? message 'collision)
              (begin (color-me "white") 
		     (wait (make-timeout-event (random 300)))
		     (color-me my-color))
	      (if (and (new-message? message messages-received)
		       (> (message-ttl message) 0))
		  (begin
		    (broadcast (make-message (message-source message)
					     (message-id message)
					     (-1+ (message-ttl message))
					     (message-color message)))
		    (set! my-color (message-color message))
		    (color-me my-color))))
          (propagator-loop)))))

;; Run the loop

(define global-timeout (make-timeout-event 25000))

(color-me my-color)

;(if (source?)
;    (source)
;    (propagator-loop))

;; To make the sources behave as propagators also, use

(if (source?)
    (parallel (source) (propagator-loop))
    (propagator-loop))

;; end of beacons1.scm