{-
A bounce demo.
np s.pi
-}
import "Nstd/Map"
import "Graphics/Graphics"
type AgentOpt= [None>[] Some>Agent Get>String]
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]
def err s:String = print!(+$ "Error:" s)
val none = [None>[]]
agent server =
((publish "server" (dynamic [server regist summon go notFound c lock unlock done ack getName]));
new names : ^(Map String Agent)
new queue : ^Agent
def eq (a:String b:String) : Bool = (==$ a b)
( names!(map.make eq)
| regist?*[key box] = names?m = (names!(map.add m key box) | queue!box)
| summon?*[key s d] = names?m =
switch (map.lookup m key) of (
Found> box:Agent -> (go@box![s d] | names!m)
NotFound> _:[] -> (notFound@d!key | names!m))
| c?*[x:Int y:Int dx:Int dy:Int color:Color]=
queue?box=(c@box![x y dx dy color] | queue!box)
| getName?*[key a res] = names?m =
switch (map.lookup m key) of (
Found> box:Agent -> (res@a!box | names!m)
NotFound> _:[] -> (getName![key a res] {-res@a!a-} | names!m))
))
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 = 6
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]
{- 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 [x' y'] = [(+ x dx) (+ y dy)]
val [y' dy] = (y_bouncing y' dy)
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+405-200")
val a = (spawnBox "a" sd none [Get>"b"] 100 70 30 30 blue true)
val b = (spawnBox "b" sd [Some>a] none 100 70 180 30 green true)
())
{-*********************************************************************
* 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 foo }[Agent ^Site Agent Site] =
(
val s0 = (this_site)
agent a =
(
new currentloc : ^Site
agent D =
(print!"Server installed."
| ack![] | currentloc!s0
| migrating?*[a:Agent loc:^Site]=
loc?s= ack![]
| message?*[#X [a:Agent loc:^Site] c:!X v:X]=
loc?s= deliver![c v s])
in
val SD = s0
(publish "infradaemon" (dynamic [D SD migrating message deliver ack done]));
ack?_=
( currentloc!s0
| deliver?*[#X c:!X v:X s:Site] = (currentloc!s | c!v)
| { P }[a currentloc D SD])
)
())
{ agent b=P in Q }e =
(
val [a loc D SD] = e
loc?s=
(agent B =
(
new currentloc : ^Site
val !b = [B currentloc]
( currentloc!s
| iflocal done!currentloc then
( currentloc!s
| {P}[B currentloc D SD])
else ()
| deliver?*[#X c:!X v:X s:Site] = (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] = e
currentloc?_=
( migrating![a currentloc]
| ack?_ = (migrate to s
( currentloc!s
| currentloc!s
| {P}e
)))
)
{ c@b!v }e =
(val [_ _ D SD] = e
val [B _] = b
iflocal c!v then
()
else
message![b c v])