;;;; -*- Scheme -*-
;;
;; npot example for HLSIM
;;
;; David DeRoure June 12 1997, revised Sep 11 1997
;; dder@martigny.ai.mit.edu
;;
;; This definition file is used by npot1.scm.  It should be compiled 
;; with (cf "npot1d") and loaded with (load "npot1d").  See npot1s.scm 
;; for the simulation setup.  See the HLSIM documentation for further 
;; details.

(declare (usual-integrations))

;; The message constructor and accessors.  The data structure is
;; trivial (just a cons cell) but this abstraction is useful later.
;; Note that (define message-source car) in the Gunk program
;; would fail, because the Gunk compiler requires that car appear 
;; in operator position.

(define make-message cons)
(define message-source car)
(define message-potential cdr)

;; To keep track of messages that have already been rebroadcast by the 
;; propagators, the procedure new-maximum? checks for the message source
;; and potential in a table which is updated when new messages arrive:
;; if a potential the same or higher is alraedy recorded in the table,
;; new-maximum? returns #F, else it updates the table and returns #T 
;; (indicating that the rebroadcast should occur).

(define (make-table) (make-eqv-hash-table 3))

(define (new-maximum? message potential-table)
  (let ((v (hash-table/get potential-table (message-source message) 0)))
    (if (> (message-potential message) v)
	    (begin
	      (hash-table/put! potential-table 
			       (message-source message)
			       (message-potential message))
	      #T)
	    #F)))

;; The total-potential? procedure returns the sum of the recorded potentials

(define (total-potential potential-table)
  (apply + (hash-table/datum-list potential-table)))

;; The mapping from potentials to colors.  The color-me procedure (in 
;; club5d.scm) maps integers from 0 thru 6 to different colors, with 7 
;; and above mapped to white.  This procedure simply scales the potential
;; appropriately, using a constant that can be overridden in the
;; simulation set-up.

(define white-potential 7)

(define (potential->color v)
  (truncate (/ (* 7 v) white-potential)))

;; end of npot1d.scm