From f44176d739eb3774e1b0369c79199247ffb192f6 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 scenario

---
 .../Challenges/Ranching/00-ORDER.txt          |   1 +
 .../Ranching/_beekeeping/queenbee.sw          | 186 ++++++++
 .../Ranching/_beekeeping/solution.sw          | 268 ++++++++++++
 .../Challenges/Ranching/beekeeping.yaml       | 414 ++++++++++++++++++
 test/integration/Main.hs                      |   1 +
 5 files changed, 870 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..cdb0a4b4d4
--- /dev/null
+++ b/data/scenarios/Challenges/Ranching/_beekeeping/solution.sw
@@ -0,0 +1,268 @@
+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 14 move;
+    turn left;
+
+    intersperse 4 (nextRow left;) (
+        intersperse 15 move harvest;
+        nextRow right;
+        intersperse 15 move harvest;
+    );
+    end;
+
+def slatRow =
+    make "honey frame";
+    intersperse 3 move (place "honey frame");
+    end;
+
+def buildHive =
+    // Make 16 boards
+    doN 4 (make "log"; make "board");
+
+    // Make 9 honey frames
+    doN 3 $ make "log";
+    doN 3 (make "board"; make "honey frame");
+
+    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;
+
+/* 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.
+
+    honeycombHere <- ishere "honeycomb";
+    if honeycombHere {} {
+        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 getLakewater = \caskCount.
+    turn right;
+    move;
+    turn left;
+    doN 46 move;
+    turn left;
+    doN 5 move;
+
+    doN caskCount $ use "siphon" forward;
+    end;
+
+def loopHoneycombCollection =
+
+    finalCount <- collectAllHoneycombs 60;
+    doN finalCount $ make "honey";
+    end;
+
+def pickRock =
+    isRock <- ishere "rock";
+    if isRock {
+        grab;
+        return ();
+    } {};
+    end;
+
+def collectRocks =
+    doN 24 move;
+    turn right;
+    doN 74 move;
+    turn left;
+
+    doN 7 (
+        intersperse 15 move pickRock;
+        nextRow right;
+        intersperse 15 move pickRock;
+        nextRow left;
+    );
+    end;
+
+def makeTables =
+    doN 12 (make "log"; make "board";);
+    doN 36 $ make "table";
+
+    turn right;
+    move;
+    turn right;
+    doN 2 move;
+    doN 9 (swap "table"; move);
+    doN 8 move;
+    doN 9 (swap "table"; move);
+    turn left;
+    doN 2 move;
+    turn left;
+    move;
+    doN 9 (swap "table"; move);
+    doN 8 move;
+    doN 9 (swap "table"; move);
+    end;
+
+def buildTavern =
+
+    // x16 per rock = 
+    doN 12 $ make "stone tile";
+
+    doN 2 (
+        intersperse 30 move $ place "stone tile";
+        nextRow left;
+        intersperse 30 move $ place "stone tile";
+        nextRow right;
+    );
+    intersperse 30 move $ place "stone tile";
+
+    makeTables;
+
+    // hearth
+    nextRow right;
+    doN 12 move;
+    intersperse 4 move (make "hearth"; swap "hearth");
+    turn right;
+    doN 6 move;
+    turn right;
+    intersperse 4 move (make "archway"; place "archway");
+    nextRow right;
+    intersperse 4 move (make "archway"; place "archway");
+    move;
+
+    // Make enough logs for 70 wall pieces
+    doN 70 $ make "log";
+    doN 35 $ make "wall";
+
+    
+    intersperse 14 move (place "wall");
+    turn left;
+    doN 6 (move; place "wall");
+    turn left;
+    doN 31 (move; place "wall";);
+    turn left;
+    doN 6 (move; place "wall");
+    turn left;
+    doN 13 (move; place "wall");
+    end;
+
+def go =
+    harvestTrees;
+
+    turn right;
+    doN 18 move;
+
+    intersperse 4 moveToNextHive buildHive;
+
+    buildCasks 2;
+    getLakewater 2;
+
+    turn left;
+
+
+    collectRocks;
+
+    doN 10 move;
+    turn left;
+    doN 80 move;
+    buildTavern;
+
+    nextRow right;
+    doN 26 move;
+    turn right;
+    doN 17 move;
+    
+
+    loopHoneycombCollection;
+
+    doN 2 $ make "mead";
+
+    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..bd4d5ed85b
--- /dev/null
+++ b/data/scenarios/Challenges/Ranching/beekeeping.yaml
@@ -0,0 +1,414 @@
+version: 1
+name: Beekeeping
+author: Karl Ostmo
+description: |
+  Develop an organic beverage industry.
+creative: false
+seed: 2
+attrs:
+  - name: bee
+    fg: '#ffff00'
+    bg: '#000000'
+  - name: water_cask
+    fg: '#4488ff'
+    bg: '#8B4513'
+objectives:
+  - teaser: Apiarist
+    goal:
+      - |
+        Build a `beehive`{=structure}.
+      - |
+        This will attract bees, which will gather
+        `nectar`{=entity} from nearby `wildflower`{=entity}s.
+      - |
+        Do not crowd hives; provide at least one cell margin
+        between them.
+      - |
+        Given that `wildflower`{=entity}s cannot be relocated,
+        judicious choice of location can expedite `honeycomb`{=entity}
+        production.
+    condition: |
+      foundStructure <- structure "beehive" 0;
+      return $ case foundStructure (\_. false) (\_. true);
+  - teaser: Collect honeycomb
+    goal:
+      - |
+        Collect `honeycomb`{=entity} from the `beehive`{=structure}s.
+      - |
+        After gathering a certain amount of nectar, a bee will return
+        to its hive and place honeycomb alongside it.
+        A finite amount of honeycomb may be accumulated before the
+        bee becomes dormant.
+    condition: |
+      as base {
+        has "honeycomb"
+      }
+  - teaser: Cooper
+    goal:
+      - |
+        Make a `cask`{=entity}.
+      - |
+        Utilize local timber and your on-hand supply of iron material.
+      - |
+        You may `use "siphon" forward` when positioned in front of
+        a lake to fill a `cask`{=entity} with `lakewater`{=entity}.
+    condition: |
+      as base {
+        has "cask"
+      }
+  - teaser: Brewmeister
+    goal:
+      - |
+        Ferment 2 barrels of `mead`{=entity}.
+    condition: |
+      as base {
+        meadCount <- count "mead";
+        return $ meadCount >= 2;
+      }
+  - teaser: Tavern keeper
+    optional: true
+    goal:
+      - |
+        Construct a `mead hall`{=structure}.
+    condition: |
+      foundStructure <- structure "mead hall" 0;
+      return $ case foundStructure (\_. false) (\_. true);
+robots:
+  - name: base
+    dir: [1, 0]
+    devices:
+      - 3D printer
+      - branch predictor
+      - calculator
+      - clock
+      - comparator
+      - compass
+      - counter
+      - dictionary
+      - fast grabber
+      - GPS receiver
+      - harvester
+      - hearing aid
+      - honey extractor
+      - keyboard
+      - lambda
+      - logger
+      - net
+      - rolex
+      - scanner
+      - siphon
+      - strange loop
+      - treads
+      - welder
+      - workbench
+    inventory:
+      - [20, iron plate]
+  - name: queenbee
+    dir: [1, 0]
+    system: true
+    display:
+      invisible: true
+      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, honey frame]
+        'b': [dirt, board]
+      map: |
+        bbbbb
+        b---b
+        b---b
+        b---b
+        bbbbb
+  - name: mead hall
+    recognize: true
+    structure:
+      palette:
+        'w': [dirt, wall]
+        't': [dirt, table]
+        'h': [dirt, hearth]
+        'a': [dirt, archway]
+        '.': [stone, stone tile]
+      mask: 'x'
+      map: |
+        wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
+        w.............hhhh.............w
+        w..ttttttttt........ttttttttt..w
+        w..............................w
+        w..ttttttttt........ttttttttt..w
+        w..............................w
+        wwwwwwwwwwwwwwaaaawwwwwwwwwwwwww
+        xxxxxxxxxxxxxxaaaaxxxxxxxxxxxxxx
+entities:
+  - name: wildflower
+    display:
+      attr: flower
+      char: '*'
+    description:
+    - A delicate flower that grows wild in local meadows.
+      Produces `nectar`{=entity} when `harvest`ed.
+    properties: [known, 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: honey frame
+    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:
+    - Wooden barrel for liquids
+    properties: [known, portable]
+  - name: water cask
+    display:
+      char: 'c'
+      attr: water_cask
+    description:
+    - Water-filled cask
+    properties: [known, portable]
+  - name: lakewater
+    display:
+      attr: water
+      char: ' '
+    description:
+    - Potable water from a lake
+    properties: [known, infinite, liquid]
+  - name: siphon
+    display:
+      char: 's'
+      attr: device
+    description:
+    - Used to fill a cask with water
+    properties: [known, portable]
+  - name: steel hoop
+    display:
+      char: 'o'
+      attr: iron
+    description:
+    - Binds staves into a cask
+    properties: [known, portable]
+  - 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, portable]
+  - 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, portable]
+  - name: stone tile
+    display:
+      char: '.'
+      attr: stone
+    description:
+    - Refined flooring
+    properties: [known, portable]
+recipes:
+  - in:
+      - [1, board]
+    out:
+      - [3, honey frame]
+  - in:
+      - [1, rock]
+    out:
+      - [16, stone tile]
+  - in:
+      - [2, rock]
+    out:
+      - [1, hearth]
+  - in:
+      - [4, rock]
+    out:
+      - [1, archway]
+  - in:
+      - [2, board]
+    out:
+      - [1, table]
+  - in:
+      - [1, rock]
+      - [1, log]
+    out:
+      - [2, wall]
+  - in:
+      - [1, board]
+    out:
+      - [2, stave]
+  - in:
+      - [2, iron plate]
+    out:
+      - [1, steel hoop]
+  - in:
+      - [20, stave]
+      - [2, steel hoop]
+    out:
+      - [1, cask]
+  - in:
+      - [1, cask]
+      - [1, lakewater]
+    out:
+      - [1, water cask]
+      - [1, lakewater]
+    required:
+      - [1, siphon]
+  - in:
+      - [12, nectar]
+    out:
+      - [1, honeycomb]
+    required:
+      - [1, wax gland]
+  - in:
+      - [1, water cask]
+      - [30, honey]
+    out:
+      - [1, mead]
+  - in:
+      - [1, honeycomb]
+    out:
+      - [1, honey]
+    required:
+      - [1, honey extractor]
+  - in:
+      - [1, honeycomb]
+    out:
+      - [1, satisfaction]
+    required:
+      - [1, wax gland]
+known: [tree, rock]
+world:
+  dsl: |
+    let
+      flowerNoise = perlin seed 1 0.15 0.0,
+      stoneNoise = perlin (seed + 1) 1 0.05 0.0,
+      lakeNoise = perlin seed 1 0.02 0.0,
+      forestNoise = perlin seed 2 0.04 1.0,
+      
+      flowers = flowerNoise > 0.65,
+      rubble = stoneNoise > 0.8,
+      rock = stoneNoise > 0.9,
+      outerShore = -0.55 <= lakeNoise && lakeNoise < -0.5,
+      innerShore = lakeNoise < -0.55,
+      lakes = lakeNoise < -0.6,
+      trees = forestNoise > 0.8
+    in
+      overlay
+      [ {grass}
+      , mask (flowers && (x + y) % 3 == 0) {wildflower}
+      , mask (rubble && (x + y) % 2 == 0) {rock}
+      , mask rock {rock}
+      , mask trees {tree}
+      , mask (outerShore && (x + y) % 2 == 0) {reed}
+      , mask innerShore {reed}
+      , mask lakes {lakewater}
+      ]
+  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..93c86b04dd 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 30) "Challenges/Ranching/beekeeping"
             , testSolution (Sec 10) "Challenges/Ranching/powerset"
             , testSolution (Sec 30) "Challenges/Ranching/gated-paddock"
             ]