Remote agent/Agent logic/PicoLisp

From Rosetta Code

This is the client for Remote agent/Agent logic. For the server, see Remote agent/Simulation#PicoLisp.

# Global variables:
# '*Sock' is the TCP socket to the server
# '*Dir' is a circular list of direction structures
# '*World' holds the explored world
# '*Ball' is the ball found in current field
# '*Todo' is the list of mismatching fields and balls
 
(load "@lib/simul.l")
 
(de *Dir .
((north south . extendNorth) (east west . extendEast)
(south north . extendSouth) (west east . extendWest) . ) )
 
(de gameClient (Host Port)
(unless (setq *Sock (connect Host Port))
(quit "Can't connect to " (cons Host Port)) )
(in *Sock
(when (= "A" (char (rd 1))) # Greeting
(out *Sock (prin "A"))
(with (def (box) (cons (cons) (cons)))
# Explore the world
(setq *World (cons (cons This)))
(off *Ball *Todo)
(let (Turns 4 Color T) # Initially 4 turns, unknown color
(recur (This Turns Color)
(setThis Color)
(turnLeft)
(do Turns
(ifn (and (not (get This (caar *Dir))) (goForward))
(turnRight)
(let Next @
(unless ((caar *Dir) This)
((cddar *Dir)) ) # Extend world
(put This (caar *Dir) ((caar *Dir) This))
(put ((caar *Dir) This) (cadar *Dir) This)
(if (get ((caar *Dir) This) 'field)
(do 2 (turnRight))
(recurse ((caar *Dir) This) 3 Next) )
(setThis (goForward)) ) # Final color on return
(turnLeft) ) ) ) )
# Establish the walls
(for Col *World
(for This Col
(set This
(cons
(cons (: west) (: east))
(cons (: south) (: north)) ) ) ) )
(prinl "Initial state:")
(showWorld)
(prin "Moving balls ... ")
# Move balls to proper fields
(for X *Todo
(findField # Move to next field
(== This (car X)) )
(getBall) # Pick the ball
(findField # Find a suitable field
(unless (: ball)
(= (: field) (cdr X)) ) )
(prin (cdr X))
(flush)
(dropBall (cdr X)) ) # Drop the ball
(prinl "Final state:")
(showWorld) ) ) ) )
 
# Set color and ball in field
(de setThis (Color)
(=: field Color)
(=: ball *Ball)
(and
*Ball
(<> @ Color)
(push1 '*Todo (cons This *Ball)) ) )
 
# Commands to server
(de goForward ()
(out *Sock (prin "\^"))
(in *Sock
(let F (char (rd 1))
(cond
((= "|" F) (off *Ball F) (rd 1))
((= "." (setq *Ball (uppc (char (rd 1)))))
(off *Ball) )
(T (rd 1)) )
F ) ) )
 
(de turnRight ()
(out *Sock (prin ">"))
(pop '*Dir)
(rd 1) )
 
(de turnLeft ()
(out *Sock (prin "<"))
(do 3 (pop '*Dir))
(rd 1) )
 
(de getBall ()
(out *Sock (prin "@"))
(case (char (rd 1))
("s" (quit "No ball in sector"))
("A" (quit "Agent full"))
("." (=: ball NIL))
(T (quit "Unexpected event" @)) ) )
 
(de dropBall (Ball)
(out *Sock (prin "!"))
(case (char (rd 1))
("a" (quit "No ball in agent"))
("S" (quit "Sector full"))
("." (=: ball Ball))
("+" (rd 1) (prinl " ... Game over!"))
(T (quit "Unexpected event" @)) ) )
 
# Extend world to the north
(de extendNorth ()
(let Last NIL
(for Col *World
(let (Old (last Col) New (def (box) (cons (cons Last) (cons Old))))
(conc Col (cons New))
(and Last (con (car (val @)) New))
(setq Last (con (cdr (val Old)) New)) ) ) ) )
 
# Extend world to the east
(de extendEast ()
(conc *World
(cons
(let Last NIL
(mapcar
'((Old)
(let New (def (box) (cons (cons Old) (cons Last)))
(and Last (con (cdr (val @)) New))
(setq Last (con (car (val Old)) New)) ) )
(last *World) ) ) ) ) )
 
# Extend world to the south
(de extendSouth ()
(let Last NIL
(map
'((Lst)
(push Lst
(let
(Old (caar Lst)
New (def (box) (cons (cons Last) (cons NIL Old))) )
(and Last (con (car (val @)) New))
(setq Last (set (cdr (val Old)) New)) ) ) )
*World ) ) )
 
# Extend world to the west
(de extendWest ()
(push '*World
(let Last NIL
(mapcar
'((Old)
(let New (def (box) (cons (cons NIL Old) (cons Last)))
(and Last (con (cdr (val @)) New))
(setq Last (set (car (val Old)) New)) ) )
(car *World) ) ) ) )
 
# Find matching field
(de findField Prg
(setq This
(catch NIL
(recur (This)
(unless (: mark)
(and (run Prg) (throw NIL This))
(finally (=: mark NIL)
(=: mark T)
(do 4
(when ((caar *Dir) This)
(goForward)
(recurse ((caar *Dir) This))
(do 2 (turnRight))
(goForward)
(do 2 (turnRight)) )
(turnRight) ) ) ) )
(quit "Can't find field") ) ) )
 
# Visualize (debug)
(de showWorld ()
(disp *World 0
'((This)
(pack " "
(: field)
(if (: ball) (lowc @) " ") ) ) ) )

Output:

: (gameClient "picolisp.com" 54545)
Initial state:
   +---+---+---+---+---+---+---+---+
 8 | G   G   Y   Yr| Y   Yb  G   R |
   +   +---+---+   +   +---+---+   +
 7 | Y | Y | B   Gy  Bg  Y   B | Gg|
   +---+   +   +---+   +   +   +   +
 6 | Gb| Gy  G   R   B   Y | B   Bg|
   +   +---+   +   +---+---+---+   +
 5 | R | B   G | B | R | B   R   Yg|
   +   +---+   +   +   +   +   +   +
 4 | B   B | G | Y   B   Bg| Bg  R |
   +---+   +   +---+   +   +   +   +
 3 | G | Y   Gr  R | B   B   Br  B |
   +   +   +---+---+---+   +   +---+
 2 | G   Rr  B | Gy  Y | Bg| Bb  B |
   +---+   +---+   +   +   +   +   +
 1 | R   R   Gb| Bg| G   G   R | Yg|
   +---+---+---+---+---+---+---+---+
     a   b   c   d   e   f   g   h
Moving balls ... GBGRYYBBRGGGYGRGG ... Game over!
Final state:
   +---+---+---+---+---+---+---+---+
 8 | G   Gg  Y   Y | Y   Y   Gg  R |
   +   +---+---+   +   +---+---+   +
 7 | Y | Yy| B   Gg  B   Yy  B | Gg|
   +---+   +   +---+   +   +   +   +
 6 | G | Gg  Gg  R   Bb  Y | B   B |
   +   +---+   +   +---+---+---+   +
 5 | Rr| B   G | B | Rr| B   R   Y |
   +   +---+   +   +   +   +   +   +
 4 | Bb  Bb| G | Y   B   B | B   R |
   +---+   +   +---+   +   +   +   +
 3 | G | Y   G   Rr| B   B   B   B |
   +   +   +---+---+---+   +   +---+
 2 | G   Rr  B | G   Yy| B | Bb  B |
   +---+   +---+   +   +   +   +   +
 1 | R   R   G | B | Gg  Gg  R | Y |
   +---+---+---+---+---+---+---+---+
     a   b   c   d   e   f   g   h