flower count scenario

data/entities.yaml

@@ -884,8 +884,9 @@
     attr: device
     char: 'Д'
   description:
-    - A typewriter is used to inscribe symbols on paper, thus reifying pure, platonic information into a physical form.
+    - A typewriter is used to inscribe symbols on `paper`{=entity}, thus reifying pure, platonic information into a physical form.
   properties: [pickable]
+  capabilities: [print, erase]
 - name: 3D printer
   display:
     attr: device

data/scenarios/Challenges/00-ORDER.txt

@@ -20,7 +20,8 @@ dna.yaml
 friend.yaml
 pack-tetrominoes.yaml
 dimsum.yaml
+telephone.yaml
 Mazes
 Ranching
 Sokoban
-Sliding Puzzles
+Sliding Puzzles

data/scenarios/Challenges/_flower-count/judge.sw

@@ -0,0 +1,35 @@
+def win =
+  try {
+    firestarter <- robotNamed "firestarter";
+    halt firestarter
+  } {};
+  try {
+    fire <- robotNamed "fire";
+    halt fire;
+    reprogram fire { selfdestruct };  // XXX WHY WON'T THIS WORK
+  } {};
+  create "gold"
+end
+
+def judgeCount : Int -> Cmd Unit = \actual.
+  watch down;
+  wait 1024;
+  s <- scan down;
+  case s
+    (\_. return ())
+    (\p.
+      try {
+        let c = (read p : Int) in
+        if (c == actual) { win } {}
+      } {}
+    )
+end
+
+def forever = \c. c; forever c end
+
+def judge =
+  numFlowers <- resonate "flower" ((-59,-19),(60,20));
+  forever (judgeCount numFlowers);
+end;
+
+judge

data/scenarios/Challenges/_flower-count/solution.sw

@@ -0,0 +1,114 @@
+def doN : Int -> Cmd a -> Cmd Unit = \n. \c.
+  if (n == 0) {} {c; doN (n-1) c}
+end
+
+def abs : Int -> Int = \n.
+  if (n < 0) {-n} {n}
+end
+
+// Go to the given absolute coordinates.  End facing east.
+def goto : Int * Int -> Cmd Unit = \dest.
+  cur <- whereami;
+  let x = fst cur in
+  let y = snd cur in
+  let dx = fst dest - x in
+  let dy = snd dest - y in
+  if (dx < 0) {turn west} {turn east};
+  doN (abs dx) move;
+  if (dy < 0) {turn south} {turn north};
+  doN (abs dy) move;
+  turn east;
+end
+
+def liftA2 : (a -> b -> c) -> Cmd a -> Cmd b -> Cmd c = \f. \ca. \cb.
+  a <- ca;
+  b <- cb;
+  return (f a b)
+end
+
+def add : Cmd Int -> Cmd Int -> Cmd Int = liftA2 (\x. \y. x + y) end
+
+def countCell : Cmd Int =
+  s <- scan down;
+  return $ case s
+    (\_. 0)
+    (\t. if (t == "flower") {1} {0})
+end
+
+tydef List a = rec l. Unit + (a * l) end
+
+def sum : List Int -> Int = \l.
+  case l
+    (\_. 0)
+    (\cons. fst cons + sum (snd cons))
+end
+
+def for : Int -> (Int -> Cmd a) -> Cmd (List a) = \n. \k.
+  if (n == 0) {return (inl ())} {a <- k n; b <- for (n-1) k; return (inr (a,b))}
+end
+
+def countRow : Int -> Cmd Int = \w.
+  ns <- for (w-1) (\_. n <- countCell; move; return n);
+  last <- countCell;
+  return (sum ns + last)
+end
+
+def isEven : Int -> Bool = \n. (n / 2) * 2 == n end
+
+def around : Dir -> Cmd Unit = \d. turn d; move; turn d end
+
+// countFlowers (w,h) (x,y) counts the number of flowers
+// in the w by h rectangle with lower-left corner at (x,y)
+def countFlowers : Int * Int -> Int * Int -> Cmd Int = \size. \ll.
+  goto ll;
+  let w = fst size in
+  let h = snd size in
+  cnts <- for (h-1) (\i.
+    cnt <- countRow w;
+    if (isEven i) { around right } { around left };
+    return cnt
+  );
+  last <- countRow w;
+  return (sum cnts + last)
+end
+
+def acquire : Cmd Text =
+  thing <- atomic (b <- isempty; if b {return ""} {grab});
+  if (thing == "") {acquire} {return thing}
+end
+
+def countAndReport : Int * Int -> Int * Int -> Cmd Unit = \size. \ll.
+  cnt <- countFlowers size ll;
+  goto (0,0);
+  paper <- acquire;
+  let soFar = (read paper : Int) in
+  erase paper;
+  newPaper <- print (format (soFar + cnt));
+  place newPaper;
+end
+
+def until : Cmd Bool -> Cmd a -> Cmd Unit = \test. \body.
+  b <- test; if b {} {body; until test body}
+end
+
+def acquireFlower : Cmd Unit =
+  until (ishere "flower") move; grab; return ()
+end
+
+def go =
+  for 4 (\r.
+    for 3 (\c.
+      build {countAndReport (40,10) (-59 + 40*(c-1), -19 + 10*(r-1))}
+    )
+  );
+  print "0";
+  turn left; move; place "paper: 0";
+  wait 1024;
+  acquireFlower;
+  turn back;
+  goto (20,0);
+  res <- meet;
+  case res (\_. return ()) (\truelove. give truelove "flower")
+end;
+
+go;

data/scenarios/Challenges/_telephone/judge.sw

@@ -0,0 +1,80 @@
+def forever: ∀ a b. {Cmd a} -> Cmd b = \c. force c; forever c end
+
+def x : Int -> Cmd a -> Cmd Unit = \n. \c.
+  if (n == 0) {} {c; x (n-1) c}
+end
+
+def andC : Cmd Bool -> Cmd Bool -> Cmd Bool = \c1. \c2.
+  b1 <- c1;
+  if b1 {c2} {return false}
+end
+
+tydef List a = rec l. Unit + a * l end
+
+def for : Int -> (Int -> Cmd a) -> Cmd (List a) = \n. \k.
+  if (n == 0)
+    { return $ inl () }
+    { x <- k (n-1);
+      xs <- for (n-1) k;
+      return (inr (x,xs))
+    }
+end
+
+def readRow : Cmd (List (Unit + Text)) =
+  r <- for 8 (\_. s <- scan down; move; return s);
+  turn back; x 8 move; turn right; move; turn right;
+  return r
+end
+
+tydef Rect = List (List (Unit + Text)) end
+
+def readRect : Cmd Rect =
+  lst <- for 4 (\_. readRow);
+  turn right; x 4 move; turn left;
+  return lst
+end
+
+def checkCell : Unit + Text -> Cmd Bool = \pat.
+  actual <- scan down;
+  move;
+  return (actual == pat)
+end
+
+def checkRow : List (Unit + Text) -> Cmd Bool = \row.
+  case row
+    (\_. turn back; x 8 move; turn right; move; turn right; return true)
+    (\cons. andC (checkCell (fst cons)) (checkRow (snd cons)))
+end
+
+def checkRect : Rect -> Cmd Bool = \rect.
+  case rect
+    (\_. return true)
+    (\cons. andC (checkRow (fst cons)) (checkRect (snd cons)))
+end
+
+def check : Rect -> Cmd Unit = \rect.
+  log "check!";
+  origLoc <- whereami;
+  teleport self (93, -8);
+  b <- checkRect rect;
+  if b {create "X"} {};
+  teleport self origLoc; turn east;
+end
+
+def judge =
+  instant (
+    loc <- whereami;
+    for 4 (\y.
+      for 8 (\x.
+        surveil (fst loc + x, snd loc + y)
+      )
+    );
+  );
+  wait 1024;
+  instant (
+    rect <- readRect;
+    check rect;
+  )
+end
+
+forever {judge};

data/scenarios/Challenges/_telephone/photocopier.sw

@@ -0,0 +1,34 @@
+def forever: ∀ a b. {Cmd a} -> Cmd b = \c. force c; forever c end
+
+def X : Int -> Cmd Unit -> Cmd Unit = \n. \c.
+  if (n == 0) {} {c; X (n-1) c}
+end
+
+def pixel : (Int * Int) * Text -> Cmd Unit = \instr.
+  let loc = fst instr in
+  let x = fst loc in
+  let y = snd loc in
+  let ty = snd instr in
+  turn back; X 5 move; turn right; X 2 move;
+  turn west; X x move; turn north; X y move;
+  place ty;
+  turn south; X y move; turn east; X x move;
+  X 5 move; turn right; X 2 move; turn east
+end
+
+def followInstructions : Text -> Cmd Unit = \paper.
+  try {
+    let res = (read paper : ((Int * Int) * Text))
+    in  pixel res
+  } {}
+end
+
+def copy : Cmd Unit =
+  watch down; wait 1024;
+  p <- atomic (b <- isempty; if b {return ""} {grab});
+  if (p == "") {} {followInstructions p}
+end
+
+def go = forever {copy} end
+
+go;

data/scenarios/Challenges/_telephone/shuttle.sw

@@ -0,0 +1,47 @@
+def ifC: ∀ a. Cmd Bool -> {Cmd a} -> {Cmd a} -> Cmd a
+  = \test. \then. \else.
+  b <- test;
+  if b then else
+end
+
+def while: ∀ a. Cmd Bool -> {Cmd a} -> Cmd Unit
+  = \test. \body.
+  ifC test {force body; while test body} {}
+end
+
+def forever: ∀ a b. {Cmd a} -> Cmd b = \c. force c; forever c end
+
+def notC : Cmd Bool -> Cmd Bool = \c.
+  b <- c; return (not b)
+end
+
+def or : Cmd Bool -> Cmd Bool -> Cmd Bool = \c1. \c2.
+  ifC c1 {return true} {c2}
+end
+
+def followTrack : Cmd Unit =
+  move;
+  while (or (isHere "track") (isHere "mountain")) { move };
+  turn back;
+end
+
+def pickup : Cmd Text =
+  atomic (b <- isempty; if b {return ""} {grab});
+end
+
+def dropoff : Text -> Cmd Bool = \thing.
+  atomic (b <- isempty; if b {place thing} {}; return b)
+end
+
+def deliver : Text -> Cmd Unit = \thing.
+  move;
+  followTrack;
+  if (thing == "") {}
+  {
+    while (notC (dropoff thing)) { followTrack; followTrack }
+  };
+end
+
+def go = forever {followTrack; thing <- pickup; deliver thing} end
+
+go;