[wip] work on 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;
+    log "reprogramming...";
+    reprogram fire { selfdestruct };  // XXX WHY WON'T THIS WORK
+    log "reprogrammed";
+  } {};
+  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 judge =
+  numFlowers <- resonate "flower" ((-58,-19),(61,20));
+  judgeCount numFlowers;
+end;
+
+judge

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

@@ -0,0 +1,51 @@
+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 location, assuming we start at (0,0).  End facing east.
+def goto : Int * Int -> Cmd Unit = \loc.
+  let x = fst loc in
+  let y = snd loc in
+  if (x < 0) {turn west} {turn east};
+  doN (abs x) move;
+  if (y < 0) {turn south} {turn north};
+  doN (abs y) 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 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.
+  for (w-1) (\_. countCell
+
+// 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
+  countRow w
+end

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;

data/scenarios/Challenges/_telephone/solution.sw

@@ -0,0 +1,77 @@
+def x : Int -> Cmd a -> Cmd Unit = \n. \c.
+  if (n == 0) {} {c; x (n-1) c}
+end
+
+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 for : Int -> (Int -> Cmd a) -> Cmd Unit = \n. \k.
+  if (n == 0) {} {k n; for (n-1) k}
+end
+
+def harvestMay =
+  e <- isempty;
+  if e {} {harvest; return ()}
+end
+
+def harvestTrees =
+  turn back; move; turn left; x 5 move;
+  turn left;
+  x 5 (x 10 (harvestMay; move); turn back; x 10 move; turn left; move; turn left);
+  turn left; x 10 move; turn right; move
+end
+
+def getWater =
+  turn back; x 3 move; turn left; move;
+  x 32 grab;
+  turn back; move; turn right; x 3 move
+end
+
+def getPaper =
+  harvestTrees;
+  while (has "tree") {make "log"};
+  x 2 (make "board"); make "boat"; equip "boat";
+  getWater; x 4 (make "paper")
+end
+
+def scanAt : Int -> Int -> Cmd (Unit + Text) = \h. \v.
+  x h move; turn right; x v move;
+  s <- scan down;
+  turn back; x v move; turn left; x h move; turn back;
+  return s
+end
+
+def atTerminal : Cmd a -> Cmd a = \c.
+  x 12 move; turn left; x 2 move;
+  a <- c;
+  turn back; x 2 move; turn right; x 12 move; turn back;
+  return a
+end
+
+def waitToPlace : Text -> Cmd Unit = \t.
+  success <- atomic (b <- isempty; if b {place t} {}; return b);
+  if success {} { watch down; wait 1024; waitToPlace t }
+end
+
+def go =
+  getPaper;
+  x 2 move; turn left; x 4 move;
+  for 8 (\h.
+    for 4 (\v.
+      res <- scanAt (h-1) (v-1);
+      case res
+        (\_. return ())
+        (\t. atTerminal (p <- print (format ((h-1,v-1),t)); waitToPlace p))
+    )
+  )
+end
+
+go;