diff --git a/data/entities.yaml b/data/entities.yaml index f8a164280..cb7d43355 100644 --- a/data/entities.yaml +++ b/data/entities.yaml @@ -69,7 +69,7 @@ char: '■' description: - A flat material made of pressed and dried wood fibers, used as a surface on which to inscribe symbols. - properties: [pickable, combustible] + properties: [pickable, combustible, printable] combustion: ignition: 0.5 duration: [10, 20] @@ -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 diff --git a/data/scenarios/Challenges/00-ORDER.txt b/data/scenarios/Challenges/00-ORDER.txt index c1c1f6c3b..453eee71d 100644 --- a/data/scenarios/Challenges/00-ORDER.txt +++ b/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 \ No newline at end of file +Sliding Puzzles diff --git a/data/scenarios/Challenges/_telephone/judge.sw b/data/scenarios/Challenges/_telephone/judge.sw new file mode 100644 index 000000000..62812932e --- /dev/null +++ b/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 (53, -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}; diff --git a/data/scenarios/Challenges/_telephone/photocopier.sw b/data/scenarios/Challenges/_telephone/photocopier.sw new file mode 100644 index 000000000..7683a95ce --- /dev/null +++ b/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; diff --git a/data/scenarios/Challenges/_telephone/shuttle.sw b/data/scenarios/Challenges/_telephone/shuttle.sw new file mode 100644 index 000000000..4ee877f90 --- /dev/null +++ b/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; diff --git a/data/scenarios/Challenges/_telephone/solution.sw b/data/scenarios/Challenges/_telephone/solution.sw new file mode 100644 index 000000000..5d60722f2 --- /dev/null +++ b/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 "paper" (format ((h-1,v-1),t)); waitToPlace p)) + ) + ) +end + +go; diff --git a/data/scenarios/Challenges/telephone.yaml b/data/scenarios/Challenges/telephone.yaml new file mode 100644 index 000000000..5b3a60412 --- /dev/null +++ b/data/scenarios/Challenges/telephone.yaml @@ -0,0 +1,223 @@ +version: 1 +name: Telephone +author: Brent Yorgey +description: | + Give another robot instructions to duplicate a pattern. +creative: false +objectives: + - id: 'paper' + teaser: Make some paper + goal: + - | + As part of a scheme to prove your intelligence to anyone + watching from space, the mystical geoglyph of X's and O's in the + blue square needs to be copied into the square across the + mountains. + - | + One small problem is that the mountains are too high for you + to cross! However, there is a shuttle service, running on a + regular schedule through a tunnel, that can deliver small + packages to the terminal on the other side of the mountains. + At the other terminal is a general-purpose utility robot; you + will have to send it instructions so it can recreate the + design for you. + - | + As a first step, you will need `paper`{=entity} on which to + write the instructions; make at least 8 sheets of + `paper`{=entity}. + condition: | + as base { + pcount <- count "paper"; + return $ pcount >= 8; + }; + - teaser: Duplicate the design + prerequisite: 'paper' + goal: + - | + Now that you have some `paper`{=entity}, you can use your + `typewriter`{=entity} to `print` on it. If you `format` a + value, `print` it on some paper, and send it via the shuttle, + the utility robot will be able to read the value. + - | + In particular, the utility robot is expecting to read values + of type `(Int * Int) * Text`{=type}, where the + `(Int * Int)`{=type} tuple is an x- and y-offset from the lower right + corner of the blue box, and the `Text`{=type} is the name of + the entity (either `X`{=entity} or `O`{=entity}) to place + there. For example, if you printed `((3,1), "O")` then the + utility robot would place an `O`{=entity} 3 units to the left + and 1 unit above the bottom-right corner of the blue square. + - | + To send something via the shuttle, just place the item you + wish to send on the purple cell at the center of the eastern + terminal, that is, the cell with coordinates `(88, -10)`. The + next time the shuttle arrives, it will notice the item and + pick it up for delivery. + condition: | + judge <- robotNamed "judge"; + as judge { has "X" } +solution: | + run "scenarios/Challenges/_telephone/solution.sw" +robots: + - name: base + dir: north + devices: + - branch predictor + - treads + - antenna + - comparator + - ADT calculator + - workbench + - harvester + - dictionary + - lambda + - logger + - welder + - scanner + - strange loop + - solar panel + - string + - typewriter + - rolex + - rubber band + - tweezers + inventory: [] + - name: shuttle + system: true + dir: east + display: + invisible: false + char: 'Ξ' + priority: 8 + program: | + run "scenarios/Challenges/_telephone/shuttle.sw" + - name: photocopier + system: true + dir: east + display: + invisible: false + char: '*' + inventory: + - [100, 'O'] + - [100, 'X'] + program: | + run "scenarios/Challenges/_telephone/photocopier.sw" + - name: judge + system: true + dir: east + devices: + - logger + program: | + run "scenarios/Challenges/_telephone/judge.sw" +attrs: + - name: greyborder + fg: '#cccccc' + bg: '#002f00' + - name: blueborder + fg: '#4287f5' + bg: '#002f00' + - name: purpleborder + fg: '#d885ff' + bg: '#002f00' + - name: purplebg + bg: '#d885ff' + - name: yg + fg: '#ffff8f' + bg: '#002f00' + - name: rg + fg: '#ff8f8f' + bg: '#002f00' +entities: + - name: mountain + display: + attr: snow + char: 'A' + priority: 9 + description: + - An impassably tall mountain. + properties: [unwalkable, opaque] + - name: blueborder + display: + char: '%' + attr: 'blueborder' + description: + - Decorative border + properties: [known, boundary] + - name: purpleborder + display: + char: '&' + attr: 'purpleborder' + description: + - Decorative border + properties: [known, boundary] + - name: track + display: + char: '=' + attr: entity + description: + - Narrow-gauge track. + properties: [known] + - name: O + display: + char: 'O' + attr: rg + description: + - O + properties: [known] + - name: X + display: + char: 'X' + attr: yg + description: + - X + properties: [known] +terrains: + - name: terminal + attr: purplebg + description: Shuttle terminal +known: [mountain, tree, water, wavy water] +world: + dsl: | + overlay + [ {grass} + , if (x >= 53 && x <= 60 && y >= -8 && y <= -5) then + (if (hash % 7 <= 1) then {X} else if (hash % 7 <= 3) then {O} else {grass}) + else {grass} + ] + upperleft: [0, 0] + offset: false + palette: + '.': [grass] + '#': [grass, wall] + '%': [grass, blueborder] + 'A': [stone, mountain] + 'T': [grass, tree] + 'W': [stone, water] + '~': [stone, wavy water] + '^': [grass, null, base] + '&': [grass, purpleborder] + '=': [grass, track] + 'S': [grass, track, shuttle] + 'P': [grass, null, photocopier] + 'J': [grass, null, judge] + 't': [terminal] + map: | + ################################################################################ + #..............................AA..............................................# + #.............................AAA......................................T.......# + #............................AAA......................................TT.......# + #....%%%%%%%%%%...............AAAA..................%%%%%%%%%%.........TTT.....# + #....%........%................AAAAA................%........%.......TTT.......# + #....%........%...................AA................%........%.....TTTT........# + #....%........%...............AAAAA.................%........%.......TTT.......# + #....%J.......%..............AAA....................%........%.........T.......# + #....%%%%%%%%%%..&&&........AAAAA..............&&&..%%%%%%%%%%.......TTTT......# + #................&P===========AA========S=======t&..............^.....TTTT.....# + #................&&&.........AAAA..............&&&.....................TT......# + #..............................AAA.............................................# + #...............................AAAA.............................WWW...........# + #..............................AAAAAA............................WW~W..........# + #...............................AAAA...........................WW~WW...........# + #..............................AAAA..............................WW............# + #.............................AAA..............................................# + ################################################################################ diff --git a/editors/emacs/swarm-mode.el b/editors/emacs/swarm-mode.el index 60120084d..36b0ced8f 100644 --- a/editors/emacs/swarm-mode.el +++ b/editors/emacs/swarm-mode.el @@ -118,6 +118,8 @@ "run" "return" "try" + "print" + "erase" "swap" "atomic" "instant" diff --git a/editors/vim/swarm.vim b/editors/vim/swarm.vim index ab06c8bbe..aa3a9a7a2 100644 --- a/editors/vim/swarm.vim +++ b/editors/vim/swarm.vim @@ -1,6 +1,6 @@ syn keyword Keyword def tydef rec end let in require syn keyword Builtins self parent base if inl inr case fst snd force undefined fail not format read chars split charat tochar key -syn keyword Command noop wait selfdestruct move backup volume path push stride turn grab harvest sow ignite place ping give equip unequip make has equipped count drill use build salvage reprogram say listen log view appear create halt time scout whereami locateme waypoint structure floorplan hastag tagmembers detect resonate density sniff chirp watch surveil heading blocked scan upload ishere isempty meet meetall whoami setname random run return try swap atomic instant installkeyhandler teleport warp as robotnamed robotnumbered knows +syn keyword Command noop wait selfdestruct move backup volume path push stride turn grab harvest sow ignite place ping give equip unequip make has equipped count drill use build salvage reprogram say listen log view appear create halt time scout whereami locateme waypoint structure floorplan hastag tagmembers detect resonate density sniff chirp watch surveil heading blocked scan upload ishere isempty meet meetall whoami setname random run return try print erase swap atomic instant installkeyhandler teleport warp as robotnamed robotnumbered knows syn keyword Direction east north west south down forward left back right syn match Type "\<[A-Z][a-zA-Z_]*\>" syn match Operators "[-=!<>|&+*/^$:]" diff --git a/editors/vscode/syntaxes/swarm.tmLanguage.yaml b/editors/vscode/syntaxes/swarm.tmLanguage.yaml index ecee58ad9..6cd7b56e7 100644 --- a/editors/vscode/syntaxes/swarm.tmLanguage.yaml +++ b/editors/vscode/syntaxes/swarm.tmLanguage.yaml @@ -46,7 +46,7 @@ repository: keyword: name: keyword.other match: >- - \b(self|parent|base|if|inl|inr|case|fst|snd|force|undefined|fail|not|format|read|chars|split|charat|tochar|key|noop|wait|selfdestruct|move|backup|volume|path|push|stride|turn|grab|harvest|sow|ignite|place|ping|give|equip|unequip|make|has|equipped|count|drill|use|build|salvage|reprogram|say|listen|log|view|appear|create|halt|time|scout|whereami|locateme|waypoint|structure|floorplan|hastag|tagmembers|detect|resonate|density|sniff|chirp|watch|surveil|heading|blocked|scan|upload|ishere|isempty|meet|meetall|whoami|setname|random|run|return|try|swap|atomic|instant|installkeyhandler|teleport|warp|as|robotnamed|robotnumbered|knows)\b + \b(self|parent|base|if|inl|inr|case|fst|snd|force|undefined|fail|not|format|read|chars|split|charat|tochar|key|noop|wait|selfdestruct|move|backup|volume|path|push|stride|turn|grab|harvest|sow|ignite|place|ping|give|equip|unequip|make|has|equipped|count|drill|use|build|salvage|reprogram|say|listen|log|view|appear|create|halt|time|scout|whereami|locateme|waypoint|structure|floorplan|hastag|tagmembers|detect|resonate|density|sniff|chirp|watch|surveil|heading|blocked|scan|upload|ishere|isempty|meet|meetall|whoami|setname|random|run|return|try|print|erase|swap|atomic|instant|installkeyhandler|teleport|warp|as|robotnamed|robotnumbered|knows)\b require: name: keyword.control.require match: \b(require)\b diff --git a/src/swarm-engine/Swarm/Game/Step/Const.hs b/src/swarm-engine/Swarm/Game/Step/Const.hs index e7bf82c7e..e263527db 100644 --- a/src/swarm-engine/Swarm/Game/Step/Const.hs +++ b/src/swarm-engine/Swarm/Game/Step/Const.hs @@ -1214,6 +1214,31 @@ execConst runChildProg c vs s k = do Nothing -> raise Read ["Could not read", showT txt, "at type", prettyText ty] Just v -> return (mkReturn v) _ -> badConst + Print -> case vs of + [VText printableName, VText txt] -> do + printable <- ensureItem printableName "print" + (printable `hasProperty` Printable) + `holdsOrFail` ["You cannot print on", indefinite printableName <> "!"] + let newEntityName = printableName <> ": " <> txt + robotInventory %= delete printable + robotInventory %= insert (printable & entityName .~ newEntityName) + return $ mkReturn newEntityName + _ -> badConst + Erase -> case vs of + [VText printableName] -> do + toErase <- ensureItem printableName "erase" + let (baseName, _) = T.break (== ':') printableName + em <- use $ landscape . terrainAndEntities . entityMap + erased <- + lookupEntityName baseName em + `isJustOrFail` ["I've never heard of", indefiniteQ baseName <> "."] + (erased `hasProperty` Printable) + `holdsOrFail` ["You cannot erase", indefinite baseName <> "!"] + + robotInventory %= delete toErase + robotInventory %= insert erased + return $ mkReturn baseName + _ -> badConst Chars -> case vs of [VText t] -> return $ mkReturn $ T.length t _ -> badConst diff --git a/src/swarm-lang/Swarm/Language/Parser/Value.hs b/src/swarm-lang/Swarm/Language/Parser/Value.hs index f9be8aa7c..07f320cee 100644 --- a/src/swarm-lang/Swarm/Language/Parser/Value.hs +++ b/src/swarm-lang/Swarm/Language/Parser/Value.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE OverloadedStrings #-} + -- | -- SPDX-License-Identifier: BSD-3-Clause -- @@ -9,6 +11,7 @@ module Swarm.Language.Parser.Value (readValue) where import Control.Lens ((^.)) import Data.Either.Extra (eitherToMaybe) import Data.Text (Text) +import Data.Text qualified as T import Swarm.Language.Context qualified as Ctx import Swarm.Language.Key (parseKeyComboFull) import Swarm.Language.Parser (readNonemptyTerm) @@ -20,7 +23,24 @@ import Text.Megaparsec qualified as MP readValue :: Type -> Text -> Maybe Value readValue ty txt = do - s <- eitherToMaybe $ readNonemptyTerm txt + -- Try to strip off a prefix representing a printable entity. Look + -- for the first colon or double quote. We will ignore a colon if a + -- double quote comes before it, because a colon could legitimately + -- occur in a formatted Text value, e.g. "\"hi: there\"". Otherwise, + -- strip off anything occurring before the first colon. + -- + -- Note, this would break if we ever had a printable entity whose + -- name contains a colon; printing on such an entity would yield + -- entity names like "Magic: The Gathering: 6" for which `read`, as + -- implemented here, would not work correctly. However, that seems + -- unlikely. + let firstUnquotedColon = T.dropWhile (\c -> c /= ':' && c /= '"') txt + let txt' = case T.uncons firstUnquotedColon of + Nothing -> txt + Just ('"', _) -> txt + Just (':', t) -> t + _ -> txt + s <- eitherToMaybe $ readNonemptyTerm txt' _ <- eitherToMaybe $ checkTop Ctx.empty Ctx.empty Ctx.empty s ty toValue $ s ^. sTerm diff --git a/src/swarm-lang/Swarm/Language/Syntax/Constants.hs b/src/swarm-lang/Swarm/Language/Syntax/Constants.hs index 6d15f7cc9..dcde43417 100644 --- a/src/swarm-lang/Swarm/Language/Syntax/Constants.hs +++ b/src/swarm-lang/Swarm/Language/Syntax/Constants.hs @@ -273,6 +273,10 @@ data Const Format | -- | Try to turn a string into a value Read + | -- | Print a string onto a printable surface + Print + | -- | Erase a printable surface + Erase | -- | Concatenate string values Concat | -- | Count number of characters. @@ -816,6 +820,25 @@ constInfo c = case c of Geq -> binaryOp ">=" 4 N $ shortDoc Set.empty "Check that the left value is greater or equal to the right one." Format -> function 1 $ shortDoc Set.empty "Turn an arbitrary value into a string." Read -> function 2 $ shortDoc Set.empty "Try to read a string into a value of the expected type." + Print -> + command 2 short + . doc + (Set.singleton $ Mutation $ RobotChange InventoryChange) + "Print text onto an entity." + $ [ "`print p txt` Consumes one printable `p` entity from your inventory, and produces an entity" + , "whose name is concatenated with a colon and the given text." + , "In conjunction with `format`, this can be used to print values onto entities such as `paper`{=entity}" + , "and give them to other robots, which can reconstitute the values with `read`." + ] + Erase -> + command 1 short + . doc + (Set.singleton $ Mutation $ RobotChange InventoryChange) + "Erase an entity." + $ [ "Consumes the named printable entity from your inventory, which must have something" + , "printed on it, and produces an erased entity. This can be used to undo" + , "the effects of a `print` command." + ] Concat -> binaryOp "++" 6 R $ shortDoc Set.empty "Concatenate the given strings." Chars -> function 1 $ shortDoc Set.empty "Counts the number of characters in the text." Split -> diff --git a/src/swarm-lang/Swarm/Language/Typecheck.hs b/src/swarm-lang/Swarm/Language/Typecheck.hs index 49c7bda68..106655986 100644 --- a/src/swarm-lang/Swarm/Language/Typecheck.hs +++ b/src/swarm-lang/Swarm/Language/Typecheck.hs @@ -1100,6 +1100,8 @@ inferConst c = run . runReader @TVCtx Ctx.empty . quantify $ case c of Exp -> arithBinT Format -> [tyQ| a -> Text |] Read -> [tyQ| Text -> a |] + Print -> [tyQ| Text -> Text -> Cmd Text |] + Erase -> [tyQ| Text -> Cmd Text |] Concat -> [tyQ| Text -> Text -> Text |] Chars -> [tyQ| Text -> Int |] Split -> [tyQ| Int -> Text -> (Text * Text) |] diff --git a/src/swarm-scenario/Swarm/Game/Entity.hs b/src/swarm-scenario/Swarm/Game/Entity.hs index 18ddeb75b..e7ec9051d 100644 --- a/src/swarm-scenario/Swarm/Game/Entity.hs +++ b/src/swarm-scenario/Swarm/Game/Entity.hs @@ -170,6 +170,10 @@ data EntityProperty Liquid | -- | Robots automatically know what this is without having to scan it. Known + | -- | Text can be printed on this entity with the + -- 'Swarm.Language.Syntax.Print' command (and erased with + -- 'Swarm.Language.Syntax.Erase') + Printable deriving (Eq, Ord, Show, Read, Enum, Bounded, Generic, Hashable) instance ToJSON EntityProperty where diff --git a/src/swarm-tui/Swarm/TUI/View.hs b/src/swarm-tui/Swarm/TUI/View.hs index 0c738ddc0..8cd065865 100644 --- a/src/swarm-tui/Swarm/TUI/View.hs +++ b/src/swarm-tui/Swarm/TUI/View.hs @@ -1122,6 +1122,7 @@ displayProperties = displayList . mapMaybe showProperty -- in challenge scenarios and not really something the player needs -- to know. showProperty Known = Nothing + showProperty Printable = Just "printable" displayList [] = emptyWidget displayList ps = diff --git a/test/integration/Main.hs b/test/integration/Main.hs index 517f8a016..7d1546c09 100644 --- a/test/integration/Main.hs +++ b/test/integration/Main.hs @@ -249,6 +249,7 @@ testScenarioSolutions rs ui key = , testSolution Default "Challenges/pack-tetrominoes" , testSolution (Sec 10) "Challenges/dimsum" , testSolution (Sec 15) "Challenges/gallery" + , testSolution (Sec 10) "Challenges/telephone" , testGroup "Mazes" [ testSolution Default "Challenges/Mazes/easy_cave_maze" diff --git a/test/unit/TestEval.hs b/test/unit/TestEval.hs index 34164a7fd..3ae51b058 100644 --- a/test/unit/TestEval.hs +++ b/test/unit/TestEval.hs @@ -383,6 +383,24 @@ testEval g = ( "read \"inr (3, inr (5, inl ()))\" : rec l. Unit + (Int * l)" `evaluatesToV` [3 :: Integer, 5] ) + , testCase + "read paper with int" + ("read \"paper: 52\" : Int" `evaluatesToV` (52 :: Integer)) + , testCase + "read paper with tuple" + ( "read \"paper: (3, false, ())\" : Int * Bool * Unit" + `evaluatesToV` (3 :: Integer, (False, ())) + ) + , testCase + "read random entity with tuple" + ( "read \"foo: (3, false, ())\" : Int * Bool * Unit" + `evaluatesToV` (3 :: Integer, (False, ())) + ) + , testCase + "read Text value containing colon" + ( "read \"\\\"hi: there\\\"\" : Text" + `evaluatesToV` ("hi: there" :: Text) + ) ] , testGroup "records - #1093"