From ccbe02760ef16046e631278bdc27f2e1d2caf2a9 Mon Sep 17 00:00:00 2001
From: Karl Ostmo <kostmo@gmail.com>
Date: Sun, 22 Oct 2023 18:29:46 -0700
Subject: [PATCH] beekeeping

---
 .../Challenges/Ranching/00-ORDER.txt          |   1 +
 .../Ranching/_beekeeping/queenbee.sw          | 186 +++++++++
 .../Ranching/_beekeeping/solution.sw          | 199 ++++++++++
 .../Challenges/Ranching/beekeeping.yaml       | 374 ++++++++++++++++++
 test/integration/Main.hs                      |   1 +
 5 files changed, 761 insertions(+)
 create mode 100644 data/scenarios/Challenges/Ranching/_beekeeping/queenbee.sw
 create mode 100644 data/scenarios/Challenges/Ranching/_beekeeping/solution.sw
 create mode 100644 data/scenarios/Challenges/Ranching/beekeeping.yaml

diff --git a/data/scenarios/Challenges/Ranching/00-ORDER.txt b/data/scenarios/Challenges/Ranching/00-ORDER.txt
index 95978ccd78..8bdbff6478 100644
--- a/data/scenarios/Challenges/Ranching/00-ORDER.txt
+++ b/data/scenarios/Challenges/Ranching/00-ORDER.txt
@@ -1,3 +1,4 @@
+beekeeping.yaml
 capture.yaml
 powerset.yaml
 gated-paddock.yaml
diff --git a/data/scenarios/Challenges/Ranching/_beekeeping/queenbee.sw b/data/scenarios/Challenges/Ranching/_beekeeping/queenbee.sw
new file mode 100644
index 0000000000..f9fae4085d
--- /dev/null
+++ b/data/scenarios/Challenges/Ranching/_beekeeping/queenbee.sw
@@ -0,0 +1,186 @@
+// Spawns worker bees when structures are detected
+
+def doN = \n. \f. if (n > 0) {f; doN (n - 1) f} {}; end;
+def mod : int -> int -> int = \a. \b. a - (a/b)*b end;
+def abs = \n. if (n < 0) {-n} {n} end;
+
+
+def sumTuples = \t1. \t2.
+    (fst t1 + fst t2, snd t1 + snd t2);
+    end;
+
+def mapTuple = \f. \t.
+    (f $ fst t, f $ snd t)
+    end;
+
+def negateTuple = \t.
+    mapTuple (\x. -x) t;
+    end;
+
+def subtractTuple = \t1. \t2.
+    sumTuples t1 $ negateTuple t2;
+    end;
+
+
+def watchForHoneycombRemoval = \dist.
+    if (dist > 0) {
+        move;
+        honeycombHere <- ishere "honeycomb";
+        if honeycombHere {
+            watch down;
+        } {};
+
+        watchForHoneycombRemoval $ dist - 1;
+    } {};
+
+    end;
+
+
+/**
+Tries to find an open cell to deposit
+the honeycomb. Gives up when distance
+threshold exceeded.
+*/
+def depositHoneycomb = \dist.
+
+    if (dist < 5) {
+            
+        emptyHere <- isempty;
+        if emptyHere {
+            place "honeycomb";
+        } {
+            move;
+            depositHoneycomb $ dist + 1;
+        };
+    } {
+        turn north;
+        watchForHoneycombRemoval dist;
+
+        // Hibernate
+        wait 2000;
+
+        // Alternative method to get rid of honeycomb
+        make "satisfaction";
+    };
+    end;
+
+def moveTuple = \tup.
+    let x = fst tup in
+    let y = snd tup in
+    turn $ if (x > 0) {east} {west};
+    doN (abs x) move;
+
+    turn $ if (y > 0) {north} {south};
+    doN (abs y) move;
+    end;
+
+def goToHive = \hiveLoc.
+    currLoc <- whereami;
+    let depositLoc = (fst hiveLoc - 1, snd hiveLoc) in
+    let delta = subtractTuple depositLoc currLoc in
+    moveTuple delta;
+    turn south;
+    depositHoneycomb 0;
+
+    end;
+
+/**
+Harvests an item when reached
+*/
+def takeStepTowardItem = \item.
+    direction <- chirp item;
+    if (direction == down) {
+        // Need a try block in case
+        // another bee gets here first
+        try {
+            harvest;
+            return ();
+        } {};
+    } {
+        turn direction;
+        move;
+        takeStepTowardItem item;
+    }
+    end;
+
+def workerProgram = \hiveIdx. \structureLoc.
+    foundStructure <- structure "beehive" hiveIdx;
+    let stillHasStructure = case foundStructure (\_. false) (\fs.
+        structureLoc == snd fs;
+    ) in
+
+    if (stillHasStructure) {
+
+        try {make "honeycomb";} {};
+        
+        hasHoneycomb <- has "honeycomb";
+        if hasHoneycomb {
+            goToHive structureLoc;
+        } {
+
+            takeStepTowardItem "wildflower";
+            return ();
+        };
+        workerProgram hiveIdx structureLoc;
+    } {
+        selfdestruct;
+    }
+    end;
+
+def workerProgramInit = \hiveIdx. \structureLoc.
+    appear "B";
+    if (mod hiveIdx 2 == 0) {turn left;} {};
+    workerProgram hiveIdx structureLoc;
+    end;
+
+def observeHives = \lastHiveCount.
+
+    foundStructure <- structure "beehive" lastHiveCount;
+    newHiveCount <- case foundStructure (\_. return lastHiveCount) (\fs. 
+        let newHiveCount = fst fs in
+
+        if (newHiveCount > lastHiveCount) {
+            // Build worker bee, assign ID, location
+            create "wax gland";
+            create "proboscis";
+
+            create "solar panel";
+            create "treads";
+            create "detonator";
+            create "harvester";
+            create "fast grabber";
+            create "workbench";
+            create "GPS receiver";
+            create "scanner";
+            create "rolex";
+            create "beaglepuss";
+            create "branch predictor";
+            create "comparator";
+            create "compass";
+            create "ADT calculator";
+            create "dictionary";
+            create "lambda";
+            create "strange loop";
+            create "hourglass";
+            create "net";
+
+            teleport self $ snd fs;
+            build {
+                require 1 "wax gland";
+                workerProgramInit lastHiveCount $ snd fs;
+            };
+            return ();
+        } {};
+
+        return newHiveCount;
+    );
+
+    wait 1;
+    observeHives newHiveCount;
+    end;
+
+def go =
+    observeHives 0;
+    end;
+
+go;
diff --git a/data/scenarios/Challenges/Ranching/_beekeeping/solution.sw b/data/scenarios/Challenges/Ranching/_beekeeping/solution.sw
new file mode 100644
index 0000000000..d0834f786a
--- /dev/null
+++ b/data/scenarios/Challenges/Ranching/_beekeeping/solution.sw
@@ -0,0 +1,199 @@
+
+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 nextRow = \d.
+    turn d;
+    move;
+    turn d;
+    end;
+
+def harvestTrees =
+    turn back;
+    doN 16 move;
+    turn left;
+    doN 5 move;
+
+    doN 20 (harvest; move;);
+    nextRow right;
+    doN 20 (harvest; move;);
+    end;
+
+def slatRow =
+    make "slat";
+    intersperse 3 move (place "slat");
+    end;
+
+def buildHive =
+    // Make 16 boards
+    doN 4 (make "log"; make "board");
+
+    // Make 9 slats
+    doN 3 $ make "log";
+    doN 3 (make "board"; make "slat");
+
+    doN 4 (intersperse 4 move (place "board"); turn right; move;);
+    turn right;
+    move;
+
+    slatRow;
+    nextRow left;
+    slatRow;
+    nextRow right;
+    slatRow;
+
+    end;
+
+def moveToNextHive =
+    turn left;
+    doN 7 move;
+    turn left;
+    doN 3 move;
+    turn right;
+    end;
+
+def buildTankSide = \item.
+    doN 3 (move; place item;);
+    move;
+    turn right;
+    move;
+    place item;
+    turn left;
+    move;
+    turn right;
+    end;
+
+def buildBreweryTank =
+    turn right;
+    doN 3 (place "copper pipe"; move;);
+    move;
+    turn right;
+    doN 3 move;
+    turn right;
+    move;
+    doN 4 $ buildTankSide "copper wall";
+    end;
+
+def buildBrewery =
+    buildBreweryTank;
+    turn back;
+    doN 5 move;
+    turn left;
+    doN 3 move;
+
+    buildBreweryTank;
+    end;
+
+/* Makes 8 staves */
+def makeStaveBatch =
+    // 1 per tree
+    make "log";
+
+    // 4 per log
+    make "board";
+
+    // 2 per board
+    doN 4 $ make "stave";
+    end;
+
+def buildCasks = \caskCount.
+    // 40 staves
+    doN 5 makeStaveBatch;
+
+    doN 4 $ make "steel hoop";
+
+    doN caskCount $ make "cask";
+    end;
+
+
+/*
+Moves forward until finding objective
+item, stops when a gap is reached.
+*/
+def collectContiguous = \maxdist. \item. \hadFound. \dist.
+    if (dist <= maxdist) {
+        honeycombHere <- ishere item;
+        if honeycombHere {
+            grab;
+            move;
+            collectContiguous maxdist item true $ dist + 1;
+        } {
+            if hadFound {
+                return dist;
+            } {
+                move;
+                collectContiguous maxdist item false $ dist + 1;
+            }
+        }
+    } {
+        return dist;
+    }
+    end;
+
+def collectHoneycomb =
+
+    distTravelled <- collectContiguous 10 "honeycomb" false 0;
+    turn back;
+    doN distTravelled move;
+    end;
+
+
+def collectAllHoneycombs = \targetCount.
+
+    watch down;
+    wait 2000;
+
+    intersperse 4 (turn left; doN 9 move; turn left;) collectHoneycomb;
+
+    currentCount <- count "honeycomb";
+    if (currentCount < targetCount) {
+        turn right;
+        doN 27 move;
+        turn right;
+
+        collectAllHoneycombs targetCount;
+    } {
+        return currentCount;
+    };
+    end;
+
+def loopHoneycombCollection =
+
+    turn west;
+    doN 20 move;
+    turn right;
+    doN 6 move;
+
+    finalCount <- collectAllHoneycombs 60;
+
+    doN finalCount $ make "honey";
+    let caskCount = finalCount / 30 in
+    buildCasks caskCount;
+    doN caskCount $ make "mead";
+
+    end;
+
+def go =
+    harvestTrees;
+
+    doN 5 move;
+    turn right;
+    doN 16 move;
+
+    intersperse 4 moveToNextHive buildHive;
+
+    doN 10 move;
+    buildBrewery;
+    
+    loopHoneycombCollection;
+    end;
+
+go;
\ No newline at end of file
diff --git a/data/scenarios/Challenges/Ranching/beekeeping.yaml b/data/scenarios/Challenges/Ranching/beekeeping.yaml
new file mode 100644
index 0000000000..40dde7f784
--- /dev/null
+++ b/data/scenarios/Challenges/Ranching/beekeeping.yaml
@@ -0,0 +1,374 @@
+version: 1
+name: Beekeeping
+author: Karl Ostmo
+description: |
+  Build an apiary
+creative: false
+seed: 2
+attrs:
+  - name: bee
+    fg: '#ffff00'
+    bg: '#000000'
+objectives:
+  - teaser: Construct hives
+    goal:
+      - |
+        Build a `beehive`{=entity}.
+      - |
+        This will attract bees, which will gather
+        nectar from nearby flowers.
+    condition: |
+      foundStructure <- structure "beehive" 0;
+      return $ case foundStructure (\_. false) (\_. true);
+  - teaser: Collect honeycomb
+    goal:
+      - |
+        Collect `honeycomb`{=entity} from the beehives
+    condition: |
+      as base {
+        has "honeycomb"
+      }
+  - teaser: Cooper
+    goal:
+      - |
+        Make a `cask`{=entity}
+    condition: |
+      as base {
+        has "cask"
+      }
+  - teaser: Brewmeister
+    goal:
+      - |
+        Make 2 barrels of `mead`{=entity}
+    condition: |
+      as base {
+        meadCount <- count "mead";
+        return $ meadCount >= 2;
+      }
+robots:
+  - name: base
+    dir: [1, 0]
+    devices:
+      - 3D printer
+      - branch predictor
+      - calculator
+      - clock
+      - comparator
+      - compass
+      - counter
+      - dictionary
+      - grabber
+      - GPS receiver
+      - harvester
+      - hearing aid
+      - honey extractor
+      - keyboard
+      - lambda
+      - logger
+      - rolex
+      - scanner
+      - strange loop
+      - treads
+      - welder
+      - workbench
+    inventory:
+      - [20, iron plate]
+      - [100, copper wall]
+      - [6, copper pipe]
+  - name: queenbee
+    dir: [1, 0]
+    system: true
+    display:
+      invisible: false
+      char: 'Q'
+      attr: bee
+    program:
+      run "scenarios/Challenges/Ranching/_beekeeping/queenbee.sw"
+solution: |
+   run "scenarios/Challenges/Ranching/_beekeeping/solution.sw"
+structures:
+  - name: beehive
+    recognize: true
+    structure:
+      palette:
+        '-': [dirt, slat]
+        'b': [dirt, board]
+      map: |
+        bbbbb
+        b---b
+        b---b
+        b---b
+        bbbbb
+  - name: brewery
+    recognize: true
+    structure:
+      palette:
+        '.': [dirt]
+      structures:
+        - name: tank
+          structure:
+            palette:
+              'p': [dirt, copper wall]
+              'I': [dirt, copper pipe]
+              '.': [dirt]
+            mask: 'x'
+            map: |
+              xxpppxx
+              xp...px
+              p.....p
+              p.III.p
+              p.....p
+              xp...px
+              xxpppxx
+      placements:
+        - src: tank
+          offset: [0, 0]
+        - src: tank
+          offset: [8, 0]
+      map: |
+        ...............
+        ...............
+        ...............
+        ...............
+        ...............
+        ...............
+        ...............
+  - name: mead hall
+    recognize: true
+    structure:
+      palette:
+        'w': [dirt, wall]
+        't': [dirt, table]
+        'h': [dirt, hearth]
+        'e': [dirt, archway]
+        '.': [stone, stone tile]
+      map: |
+        wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
+        w.............hhhh.............w
+        w..ttttttttt........ttttttttt..w
+        w..............................w
+        w..ttttttttt...ee...ttttttttt..w
+        wwwwwwwwwwwwwwweewwwwwwwwwwwwwww
+entities:
+  - name: wildflower
+    display:
+      attr: flower
+      char: '*'
+    description:
+    - A beautiful flower that grows wild in local meadows.
+      Produces `nectar`{=entity} when `harvest`ed.
+    properties: [known, portable, growable]
+    yields: nectar
+    growth: [80, 120]
+  - name: reed
+    display:
+      attr: plant
+      char: 'r'
+    description:
+    - Reeds, grow near water
+    properties: [known, portable, growable]
+  - name: honeycomb
+    display:
+      char: 'x'
+      attr: gold
+    description:
+    - Product of bees that have consumed nectar
+    properties: [known, portable]
+  - name: proboscis
+    display:
+      char: 'p'
+      attr: device
+    description:
+    - Senses direction to nectar-producing flowers
+    properties: [known, portable]
+    capabilities: [detectdirection, structure]
+  - name: honey
+    display:
+      char: 'h'
+      attr: gold
+    description:
+    - Pure liquid honey
+    properties: [known, portable]
+  - name: mead
+    display:
+      char: 'm'
+    description:
+    - Honey-based alcoholic beverage
+    properties: [known, portable]
+  - name: honey extractor
+    display:
+      char: 'e'
+      attr: device
+    description:
+    - Device for extracting honey from the comb
+    properties: [known, portable]
+  - name: satisfaction
+    display:
+      char: 's'
+    description:
+    - Result of a job well done; obtained by worker bees after dropping off honeycomb
+    properties: [known, portable]
+  - name: wax gland
+    display:
+      char: 'g'
+    description:
+    - Required to make honeycomb
+    properties: [known]
+  - name: nectar
+    display:
+      char: 'n'
+      attr: gold
+    description:
+    - Obtained from wildflowers
+    properties: [known, portable]
+  - name: slat
+    display:
+      char: '-'
+      attr: ice
+    description:
+    - Internal component of a beehive
+    properties: [known, portable]
+  - name: stave
+    display:
+      char: 'l'
+      attr: wood
+    description:
+    - Wooden plank comprising the sides of a cask
+    properties: [known, portable]
+  - name: cask
+    display:
+      char: 'c'
+      attr: wood
+    description:
+    - Binds staves into a cask
+    properties: [known, portable]    
+  - name: steel hoop
+    display:
+      char: 'o'
+      attr: iron
+    description:
+    - Binds staves into a cask
+    properties: [known, portable]
+  - name: copper wall
+    display:
+      char: 't'
+      attr: copper
+    description:
+    - Material for brewery tank
+    properties: [known, portable, unwalkable]
+  - name: wall
+    display:
+      char: 'w'
+      attr: wood
+    description:
+    - Outer walls of the building
+    properties: [known, unwalkable]
+  - name: table
+    display:
+      char: 't'
+      attr: wood
+    description:
+    - A segment of banquet table
+    properties: [known, unwalkable]
+  - name: hearth
+    display:
+      char: 'h'
+      attr: rock
+    description:
+    - Encloses a fire to warm the hall
+    properties: [known, unwalkable]
+  - name: archway
+    display:
+      char: 'a'
+      attr: rock
+    description:
+    - Grand entrance
+    properties: [known]
+  - name: stone tile
+    display:
+      char: '.'
+      attr: stone
+    description:
+    - Refined flooring
+    properties: [known]
+
+recipes:
+  - in:
+      - [1, board]
+    out:
+      - [3, slat]
+  - in:
+      - [1, board]
+    out:
+      - [2, stave]
+  - in:
+      - [2, iron plate]
+    out:
+      - [1, steel hoop]
+  - in:
+      - [20, stave]
+      - [2, steel hoop]
+    out:
+      - [1, cask]
+  - in:
+      - [12, nectar]
+    out:
+      - [1, honeycomb]
+    required:
+      - [1, wax gland]
+  - in:
+      - [1, cask]
+      - [30, honey]
+    out:
+      - [1, mead]
+  - in:
+      - [1, honeycomb]
+    out:
+      - [1, honey]
+    required:
+      - [1, honey extractor]
+  - in:
+      - [1, honeycomb]
+    out:
+      - [1, satisfaction]
+known: [tree, water]
+world:
+  dsl: |
+    let
+      flowerNoise = perlin seed 1 0.15 0.0,
+      lakeNoise = perlin seed 1 0.02 0.0,
+      forestNoise = perlin seed 1 0.08 0.0,
+      flowers = flowerNoise > 0.7,
+      shore = lakeNoise < -0.5,
+      lakes = lakeNoise < -0.6,
+      trees = forestNoise > 0.7
+    in
+      overlay
+      [ {grass}
+      , mask (flowers && (x + y) % 3 == 0) {wildflower}
+      , mask trees {tree}
+      , mask shore {reed}
+      , mask lakes {water}
+      ]
+  upperleft: [0, 0]
+  offset: false
+  palette:
+    'B': [grass, erase, base]
+    'Q': [grass, erase, queenbee]
+    '.': [grass, erase]
+  map: |
+    ..........Q.....
+    ................
+    ..B.............
+    ................
+    ................
+    ................
+    ................
+    ................
+    ................
+    ................
+    ................
+    ................
+
+
+    
\ No newline at end of file
diff --git a/test/integration/Main.hs b/test/integration/Main.hs
index 5af3545673..78ad5d3056 100644
--- a/test/integration/Main.hs
+++ b/test/integration/Main.hs
@@ -236,6 +236,7 @@ testScenarioSolutions rs ui =
         , testGroup
             "Ranching"
             [ testSolution Default "Challenges/Ranching/capture"
+            , testSolution (Sec 10) "Challenges/Ranching/beekeeping"
             , testSolution (Sec 10) "Challenges/Ranching/powerset"
             , testSolution (Sec 30) "Challenges/Ranching/gated-paddock"
             ]