From 0f45dc64290225af5c8e6b16a1a67982666c8b00 Mon Sep 17 00:00:00 2001
From: Karl Ostmo <kostmo@gmail.com>
Date: Mon, 4 Mar 2024 22:33:01 -0800
Subject: [PATCH] palanquin scenario

---
 .../Challenges/_palanquin/emperor.sw          |  78 +++++++
 .../Challenges/_palanquin/solution.sw         | 118 ++++++++++
 data/scenarios/Challenges/palanquin.yaml      | 206 ++++++++++++++++++
 3 files changed, 402 insertions(+)
 create mode 100644 data/scenarios/Challenges/_palanquin/emperor.sw
 create mode 100644 data/scenarios/Challenges/_palanquin/solution.sw
 create mode 100644 data/scenarios/Challenges/palanquin.yaml

diff --git a/data/scenarios/Challenges/_palanquin/emperor.sw b/data/scenarios/Challenges/_palanquin/emperor.sw
new file mode 100644
index 000000000..6988a84be
--- /dev/null
+++ b/data/scenarios/Challenges/_palanquin/emperor.sw
@@ -0,0 +1,78 @@
+def goDir = \f. \r.
+  let d = fst r in
+  if (d == down) {
+    grapesHere <- ishere "grapes";
+    if grapesHere {
+        grab; return ()
+    } {};
+    return ();
+  } {
+    turn d;
+
+    // An obstruction might arise after
+    // navigation direction is determined
+    // but before we move.
+    try {
+      move;
+    } {};
+    f;
+  }
+  end;
+
+def followRoute = \item.
+    nextDir <- path (inL ()) (inR item);
+    case nextDir return $ goDir $ followRoute item;
+    end;
+
+def getGrapes =
+    let targetItem = "grapes" in
+    emperorHasThem <- has targetItem;
+    if emperorHasThem {
+        say "Tally ho!";
+    } {
+        grapesDropped <- as base {
+            baseHasThem <- has targetItem;
+            return $ not baseHasThem;
+        };
+
+        if grapesDropped {
+            followRoute targetItem;
+        } {
+            wait 10;
+            getGrapes;
+        };
+    }
+    end;
+
+def avoidSides =
+
+    toLeft <- scan back;
+    case toLeft return (\_.
+        turn right;
+    );
+
+    toRight <- scan back;
+    case toRight return (\_.
+        turn left;
+    );
+
+    behind <- scan back;
+    case behind return (\_.
+        isBlocked <- blocked;
+        if isBlocked {} {move;}
+    );
+    
+    watch forward;
+    watch back;
+    watch left;
+    watch right;
+    wait 1000;
+    end;
+
+def go =
+    getGrapes;
+    avoidSides;
+    go;
+    end;
+
+go;
\ No newline at end of file
diff --git a/data/scenarios/Challenges/_palanquin/solution.sw b/data/scenarios/Challenges/_palanquin/solution.sw
new file mode 100644
index 000000000..9e39b5401
--- /dev/null
+++ b/data/scenarios/Challenges/_palanquin/solution.sw
@@ -0,0 +1,118 @@
+def doN = \n. \f. if (n > 0) {f; doN (n - 1) f} {}; end;
+
+def intersperse = \n. \f2. \f1. if (n > 0) {
+        f1;
+        if (n > 1) {
+            f2;
+        } {};
+        intersperse (n - 1) f2 f1;
+    } {};
+    end;
+
+def shiftRightForPush =
+    turn back;
+    move;
+    turn left;
+    move;
+    turn left;
+    end;
+
+/*
+Precondition:
+Positioned behind the wall, facing it, on the leftmost cell.
+*/
+def pushWall =
+    intersperse 3 shiftRightForPush push;
+    end;
+
+def moveToBackWall =
+    turn back;
+    doN 5 move;
+    turn right;
+    doN 2 move;
+    turn right;
+    end;
+
+def moveRightSide =
+    turn right;
+    push;
+    turn right;
+    move;
+    turn left;
+    move;
+    turn left;
+    doN 5 push;
+    turn right;
+    move;
+    turn left;
+    move;
+    turn left;
+    push;
+    end;
+
+def moveLeftSide =
+    doN 4 move;
+    turn left;
+    doN 5 move;
+    turn right;
+    push;
+    turn left;
+    move;
+    turn right;
+    move;
+    turn right;
+    doN 5 push;
+    turn left;
+    move;
+    turn right;
+    move;
+    turn right;
+    push;
+    end;
+
+def initialSetup =
+    turn south;
+    doN 3 move;
+    turn right;
+    move;
+    turn right;
+    end;
+
+def waitUntilGrapesGrabbed =
+    itemHere <- scan forward;
+    case itemHere return (\_.
+        watch forward;
+        wait 1000;
+        waitUntilGrapesGrabbed;
+    );
+    end;
+
+def placeGrapes =
+
+    doN 4 move;
+    place "grapes";
+    turn back;
+    move;
+    doN 2 push;
+    turn back;
+    doN 2 move;
+    waitUntilGrapesGrabbed;
+
+    turn back;
+    doN 4 move;
+    turn back;
+    doN 2 push;
+    end;
+
+def go =
+    placeGrapes;
+
+    // initialSetup;
+    // pushWall;
+    // moveToBackWall;
+    // pushWall;
+    // moveRightSide;
+    // moveLeftSide;
+    end;
+
+go;
diff --git a/data/scenarios/Challenges/palanquin.yaml b/data/scenarios/Challenges/palanquin.yaml
new file mode 100644
index 000000000..746b09bbf
--- /dev/null
+++ b/data/scenarios/Challenges/palanquin.yaml
@@ -0,0 +1,206 @@
+version: 1
+name: Royal outing
+creative: false
+description: Transport the emperor
+attrs:
+  - name: purple
+    fg: "#dd44dd"
+objectives:
+  - id: inside_palanquin
+    teaser: Boarding
+    goal:
+      - Inside palanquin
+    condition: |
+      def locIsInsideEnclosure = \loc. \dims.
+        foundBox <- structure "palanquin" 0;
+        case foundBox (\_. return false) (\enclosure.
+          let boxPos = snd enclosure in
+          return $ snd loc >= snd boxPos
+            && snd loc < snd dims + snd boxPos
+            && fst loc >= fst boxPos
+            && fst loc < fst dims + fst boxPos;
+        );
+        end;
+
+      dims <- floorplan "palanquin";
+
+      emperor <- robotnamed "emperor";
+      as emperor {
+        loc <- whereami;
+        insidePalanquin <- locIsInsideEnclosure loc dims;
+        return insidePalanquin;
+      }
+  - teaser: Joyride
+    goal:
+      - The pieces of the `palanquin`{=structure} are `push`able.
+      - Avoid introducing gaps in the `palanquin`{=structure} walls that would expose the emperor to the outside.
+    condition: |
+      return false;
+    prerequisite:
+      logic:
+        not:
+          or:
+            - id: expose_gap
+            - id: encroached_emperor
+  - id: expose_gap
+    teaser: Opened
+    goal:
+      - Exposed the emperor!
+    hidden: true
+    optional: true
+    prerequisite: inside_palanquin
+    condition: |
+      emperor <- robotnamed "emperor";
+      as emperor {
+        let targetVolume = 25 in
+        vol <- volume targetVolume;
+        return $ case vol (\_. true) (\_. false);
+      }
+  - id: encroached_emperor
+    teaser: Encroached
+    goal:
+      - Encroached upon the emperor!
+    hidden: true
+    optional: true
+    prerequisite: inside_palanquin
+    condition: |
+      emperor <- robotnamed "emperor";
+      as emperor {
+        blockHere <- ishere "block";
+        return blockHere;
+      }
+solution: |
+  run "scenarios/Challenges/_palanquin/solution.sw"
+structures:
+  - name: palanquin
+    recognize: [north]
+    description: "Palanquin"
+    structure:
+      mask: '.'
+      palette:
+        'b': [stone, block]
+      map: |
+        bbbbb
+        b...b
+        b...b
+        b...b
+        bbbbb
+  - name: column
+    recognize: [north]
+    description: "Palatial column"
+    structure:
+      mask: '.'
+      palette:
+        'b': [stone, boulder]
+      map: |
+        .bb.
+        bbbb
+        bbbb
+        .bb.
+robots:
+  - name: base
+    loc: [0, 0]
+    dir: south
+    devices:
+      - branch predictor
+      - ADT calculator
+      - compass
+      - comparator
+      - dictionary
+      - grabber
+      - hearing aid
+      - lambda
+      - rolex
+      - logger
+      - net
+      - scanner
+      - strange loop
+      - treads
+      - dozer blade
+    inventory:
+      - [1, grapes]
+  - name: emperor
+    dir: north
+    loc: [-5, 5]
+    system: true
+    display:
+      invisible: false
+      attr: red
+    walkable:
+      never:
+        - block
+    devices:
+      - ADT calculator
+      - branch predictor
+      - comparator
+      - dictionary
+      - lambda
+      - logger
+      - scanner
+    program: |
+      run "scenarios/Challenges/_palanquin/emperor.sw"
+entities:
+  - name: grapes
+    display:
+      attr: purple
+      char: 'g'
+    description:
+      - Fit for a king
+    properties: [known, pickable]
+  - name: block
+    display:
+      attr: wood
+      char: 'b'
+    description:
+      - Pushable block
+    properties: [known, pushable]
+known: [boulder]
+world:
+  placements:
+    - src: palanquin
+      offset: [19, -2]
+    - src: column
+      offset: [10, -9]
+    - src: column
+      offset: [28, -9]
+  dsl: |
+    overlay
+    [ {grass}
+    , mask (x < -2 && x > -16 && y > -30 && y < 30) (
+        overlay [
+          if (x/4 + y/4) % 2 == 0
+          then {terrain: dirt}
+          else {terrain: ice}
+        ]
+      )
+    ]
+  palette:
+    '+': [stone, erase]
+    '.': [grass, erase]
+  upperleft: [-21, 0]
+  map: |
+    ..........................................
+    .++++++++++++++++++++++++++++++++++++++++.
+    .++++++++++++++++++++++++++++++++++++++++.
+    .++++++++++++++++++++++++++++++++++++++++.
+    .++++++++++++++++++++++++++++++++++++++++.
+    .++++++++++++++++++++++++++++++++++++++++.
+    .++++++++++++++++++++++++++++++++++++++++.
+    .++++++++++++++++++++++++++++++++++++++++.
+    .+++++++..........................+++++++.
+    .+++++++..........................+++++++.
+    .+++++++..........................+++++++.
+    .+++++++..........................+++++++.
+    .+++++++..........................+++++++.
+    .+++++++..........................+++++++.
+    .+++++++..........................+++++++.
+    .+++++++..........................+++++++.
+    .+++++++..........................+++++++.
+    .++++++++++++++++++++++++++++++++++++++++.
+    .++++++++++++++++++++++++++++++++++++++++.
+    .++++++++++++++++++++++++++++++++++++++++.
+    .++++++++++++++++++++++++++++++++++++++++.
+    .++++++++++++++++++++++++++++++++++++++++.
+    .++++++++++++++++++++++++++++++++++++++++.
+    .++++++++++++++++++++++++++++++++++++++++.
+    ..........................................