{-
    A bounce demo.
    np c.pi -trader <host_address> -tport <port_number>
-}

import "Nstd/Map"
import "Graphics/Graphics"

type AgentOpt= [None>[] Some>Agent]

program foo : [] = 
(
new regist   : ^[String Agent]
new summon   : ^[String Site Agent]
new go       : ^[Site Agent]
new notFound : ^String
new c        : ^[Int Int Int Int Color]
new lock     : ^Agent
new unlock   : ^[]
new done     : ^[]
new ack      : ^[]
new getName  : ^[String Agent /Agent]

agent top =
(

def err s:String = print!(+$ "Error:" s) 
val none = [None>[]]


def subscribe_ (s:String a:Agent) : Dyn = 
  (dynamic [top regist summon go notFound c])


val [ok server regist summon go notFound c lock unlock done ack getName] =
  typecase (subscribe_ "server" top) of 
    [server   : Agent
     regist   : ^[String Agent]
     summon   : ^[String Site Agent]
     go       : ^[Site Agent]
     notFound : ^String
     c        : ^[Int Int Int Int Color]
     lock     : ^Agent
     unlock   : ^[]
     done     : ^[]
     ack      : ^[]
     getName  : ^[String Agent /Agent]
    ] -> [true server regist summon go notFound c lock unlock done ack getName]
  else [false top regist summon go notFound c lock unlock done ack getName]


if (not ok) then 
  ((prNL "Fatal error: wrong type from trader.");())
else
(
def spawnDaemon [s:Site host:String dim:String r:/[Site Agent]] = 
(
  agent daemon =
  ( 
    def main[] = 
    (
      val key = (sys.read "Summon box : ")
      (summon@server![key s daemon]
      | notFound?key= (print!(+$ key " not found!") | main![])
      | done?_ = main![])
    )
    migrate to s
    ((open_graph (+$ host dim) err); (pr "Daemon installed.");
     (lock?*a=unlock?_=ack@a![]
     | unlock![]
     | main![]))
  )
  in r![s daemon]
)

def spawnBox [key:String [s:Site daemon:Agent] left:AgentOpt right:AgentOpt 
                      max_x:Int max_y:Int offset_x:Int offset_y:Int color:Color ball:Bool r:/Agent] =
(
  agent box = 
  (

    def get [key:String a:Agent r:/Agent] = getName@server![key a r]
    val left = switch left of (Get>key:String->[Some>(get key box)] 
                               Some>a:Agent->left None>_:[]->none)
    val right = switch right of (Get>key:String-> [Some>(get key box)] 
                                 Some>a:Agent->right None>_:[]->none)

    migrate to s

    new localdaemon:^Agent 
    run localdaemon!daemon

    val x = (div max_x 2)
    val y = (div max_y 3)
    val dx = 3
    val dy = 10
    val radius = 10
    val extra = 15  {- = radius+5 -} 
    val extra1 = 16 {- = extra+1 -}   

    def drawbox [color:Color r:Sig] = 
      ((set_color color); (moveto (- offset_x 8) (- offset_y extra1)); 
       (set_text_size 16); (draw_string key);
       r!(draw_rect (- offset_x extra) (- offset_y extra) (+ max_x (* 2 extra)) (+ max_y (* 2 extra))))

    def cleanbox [r:Sig] = 
      ((set_color foreground);
       r!(fill_rect (- offset_x extra1)(- offset_y extra1)(+ max_x (* 2 extra1))(+ max_y (* 2 extra1))))
      
    def dopaint (x:Int y:Int color:Color):[] =
      ((set_color color);(fill_circle (+ offset_x x) (+ offset_y y) radius);[])

    {- synchronise with a *local* daemon -}
    def block [r:/Agent] = localdaemon?d = (lock@d!box | ack?_=r!d)
    def unblock [d:Agent r:Sig] = (localdaemon!d | unlock@d![] | r![])

    def y_bouncing (y:Int dy:Int) : [Int Int] = 
      if (<< y 0) then 
        [(* (+ y dy) -1) (* dy -1)]
      else if (>= y max_y) then 
        [(- (* max_y 2) y) (* dy -1)]
      else [y dy]

    def x_bouncing_and_handover ([x:Int y:Int dx:Int dy:Int color:Color]) : [Int Int Int Int Color] =
    (
      def sleep [i:Int r:/[]] = if (== i 0) then r![] else sleep![(dec i) r]

      val [x y] = [(+ x dx) (+ y dy)] 
      val [y dy] = (y_bouncing y dy)

      {- Dopaint must be in a critical section so that other boxes can't mess with colours. -} 
      (val d = (block) (dopaint x y color);(unblock d);(sleep 40);
       val d = (block) (dopaint x y foreground);(unblock d);

      {- compute coordinates and handon if required -}
      if (<< x 0) then
        switch left of 
        (

          None>_:[]    -> (x_bouncing_and_handover [(* x -1) y (* dx -1) dy color])
          Some>a:Agent -> (run c@a![(+ x max_x) y dx dy color]
                           [x y dx dy color])
        )
      else if (>= x max_x) then
        switch right of 
        (
          None>_:[] -> (x_bouncing_and_handover [(- (* 2 max_x) x) y (* dx -1) dy color])
          Some>a:Agent -> (run c@a![(- x max_x) y dx dy color]
                           [x y dx dy color])
        )
      else 
        (x_bouncing_and_handover [x y dx dy color]))
    )
    (((drawbox black); if ball then (val _ = (x_bouncing_and_handover [x y dx dy color])()) else ())
    | go?*[s d]= 
        (val old = (block) 
         (cleanbox); migrate to s
         run unlock@old![]  {- daemon handover -}
	 run localdaemon!d 
         val _ = (block) (drawbox black); (unblock d);
         (prNL (+$ key " box migrated.")); done@d![])
    | regist@server![key box]
    | c?*[x y dx dy color]= ((x_bouncing_and_handover [x y dx dy color]); ()))
  )
  r!box
)

val sd = (spawnDaemon (this_site) " " " 385x390+10-200")

{-
val c = (spawnBox "c" sd none [Get>"d"] 100 70 180 180 magenta true)
val d = (spawnBox "d" sd [Some>c] none 100 70 220 300 red)  
-}

()
)   {- else -}
)   {- agent top -}
()) {- program -}


{-*********************************************************************
  *   Copyright (c) 1998-2001 Pawel T. Wojciechowski                  *
  *   Channel-based Central Server (doesn't use maps just channels)   *
  *********************************************************************-}

{- 
new _migrating : ^[Agent ^Site]
new _message   : ^[#X [Agent ^Site] !X X]
new _deliver   : ^[#X !X X Site]
new _ack       : ^[] 
new _done      : ^^Site
-}


{Agent} = [Agent ^Site]
{Site} = Site


{ toplevel P hosts }[Agent ^Site Agent Site
    ^[Agent ^Site]  ^[#X [Agent ^Site] !X X]
    ^[#X !X X Site] ^[]  ^^Site] = 
(
val s0 = (this_site)


{- version without 'case' 

agent a =
(
  new currentloc : ^Site
  val [ok D SD migrating message deliver ack done] = 
    typecase (subscribe "infradaemon" a) of 
       [d   : Agent 
        sd  : Site
        mi  : ^[Agent ^Site]
        me  : ^[#X [Agent ^Site] !X X]
        de  : ^[#X !X X Site]
        ack : ^[]
        done: ^^Site
       ] -> [true d sd mi me de ack done]
    else [false a s0 _migrating _message _deliver _ack _done]
  if ok then 
    ( currentloc!s0 | <D@SD>currentloc!s0
    | deliver?*[#X c:!X v:X s:Site] = (<D@SD>currentloc!s | c!v)
    | { P }[a currentloc D SD migrating message deliver ack done])
  else print!"Fatal error: wrong type."
)
())
-}


{- version with 'case' -}

agent a =
(
  new currentloc : ^Site
  val v = typecase (subscribe "infradaemon" a) of 
            [d   : Agent 
             sd  : Site
             mi  : ^[Agent ^Site]
             me  : ^[#X [Agent ^Site] !X X]
             de  : ^[#X !X X Site]
             ack : ^[]
             done: ^^Site
            ] -> (opt.yes [d sd mi me de ack done])
          else (opt.no)
  (opt.case v 
     \[r:Sig] = r!(prNL "Fatal error: wrong type.")
     \[v:[Agent Site ^[Agent ^Site] ^[#X [Agent ^Site] !X X] ^[#X !X X Site] ^[] ^^Site] r:Sig] = 
            (val [D SD migrating message deliver ack done] = v
             run (currentloc!s0 | <D@SD>currentloc!s0
                 | deliver?*[#X c:!X v:X s:Site] = (<D@SD>currentloc!s | c!v)
                 | { P }[a currentloc D SD migrating message deliver ack done])
             r![])
  ); 
  ()
)
())



{ agent b=P in Q }e = 
(
  val [a loc D SD migrating message deliver ack done] = e 
  loc?s= 
    (agent B = 
     (
       new currentloc : ^Site
       val !b = [B currentloc]
       ( <D@SD>currentloc!s
       | iflocal <a>done!currentloc then
           ( currentloc!s
           | {P}[B currentloc D SD migrating message deliver ack done])
         else ()
       | deliver?*[#X c:!X v:X s:Site] = (<D@SD>currentloc!s | c!v))
     )
     in 
       done?c = (loc!s 
         | (val !b = [B c] 
           {Q}e)))
)


{ migrate to s P }e = 
( 
  val [a currentloc D SD migrating message deliver ack done] = e
  currentloc?_= 
    ( <D@SD>migrating![a currentloc]
    | ack?_ = (migrate to s 
               ( <D@SD>currentloc!s 
               | currentloc!s 
               | {P}e
               )))
)


{ c@b!v }e =
 (val [_ _ D SD migrating message deliver ack done] = e
  val [B _] = b
  iflocal <B>c!v then
    ()
  else
    <D@SD>message![b c v])


{ def subscribe_ }e (s:String a:[Agent ^Site]) : Dyn = 
  (val [A:Agent _:^Site] = a (subscribe s A))