Data commit

Task/24-game/Quackery/24-game.quackery

@@ -0,0 +1,74 @@
+  [ stack ]                                       is operators       (   --> s )
+
+  0 $ "*/+-" witheach [ bit | ]
+  operators put
+
+  [ stack ]                                       is numbers         (   --> s )
+
+  [ 0 swap
+    witheach [ bit | ]
+    numbers put ]                                 is putnumbers      ( $ -->   )
+
+  [ $ "123456789" shuffle 4 split drop sort ]     is choosenumbers   (   --> $ )
+
+  [ say "Using any of the operators * / + -" cr
+    say "and each of the numbers "
+    witheach [ emit sp ] say "once," cr
+    say "enter an RPN expression equal to 24." cr
+    $ "Spaces between characters are optional: "
+    input ]                                       is getexpression   ( $ --> $ )
+
+  [ $ "" swap witheach
+      [ dup space = iff drop else join ] ]        is stripspaces     ( $ --> $ )
+
+  [ stack ]                                       is opcount         (   --> s )
+  [ stack ]                                       is numcount        (   --> s )
+  [ stack ]                                       is numsused        (   --> s )
+
+  [ true swap
+    0 opcount put
+    0 numcount put
+    0 numsused put
+    witheach
+      [ bit dup numbers share & iff
+          [ 1 numcount tally
+            numsused take | numsused put ]
+        else
+          [ operators share & if
+              [ 1 opcount tally ] ]
+        opcount share numcount share < not if
+          [ drop false conclude ] ]
+    numsused take
+    numbers share != if [ drop false ]
+    numcount take 4 != if [ drop false ]
+    opcount take 3 != if [ drop false ] ]         is checkexpression ( $ --> b )
+
+  [ $ "" swap
+    witheach
+      [ dup char 0 char 9 1+ within iff
+          [ join $ " n->v " join ] done
+        [ switch
+          char * case [ $ "v* " join ]
+          char / case [ $ "v/ " join ]
+          char + case [ $ "v+ " join ]
+          char - case [ $ "v- " join ]
+          otherwise [ $ "Error!" fail ] ] ] ]     is quackerise      ( $ --> [ )
+
+    [ choosenumbers
+      dup putnumbers
+      [ dup getexpression
+        stripspaces
+        dup checkexpression not while
+        cr
+        say "Badly formed expression. Try again."
+        cr cr
+        drop again ]
+      nip
+      quackerise
+      quackery
+      cr
+      say "Your expression is equal to "
+      2dup 10 point$ echo$
+      24 n->v v- v0= iff
+      [ say ". :-)" ] else [ say ". :-(" ]
+      numbers release ]                           is game            (   -->   )