extra/wordlet/wordlet.factor

   1 ! Copyright (C) 2022 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors arrays ascii assocs assocs.extras colors
   4 combinators hashtables io io.styles kernel math random ranges
   5 sequences sequences.extras sets sorting strings
   6 wordlet.word-list ;
   7 IN: wordlet
   8
   9 TUPLE: wordlet-game secret-word chances guesses ;
  10
  11 : <wordlet-game> ( secret-word chances -- wordlet-game )
  12     wordlet-game new
  13         swap >>chances
  14         swap >>secret-word
  15         V{ } clone >>guesses ; inline
  16
  17 : guess>chars ( secret guess -- seq )
  18     [ zip [ first2 = not ] filter keys [ 1string ] map ] 2keep
  19     [
  20         [ nip 1string ] [ = ] 2bi
  21         [ COLOR: green ]
  22         [
  23             2dup swap member?
  24             [ [ swap remove-first ] [ COLOR: yellow ] bi ]
  25             [ COLOR: gray ] if
  26         ] if
  27         background associate 2array
  28     ] { } 2map-as nip ;
  29
  30 : color>n ( color -- n )
  31     {
  32         { COLOR: gray [ 1 ] }
  33         { COLOR: yellow [ 2 ] }
  34         { COLOR: green [ 3 ] }
  35     } case ;
  36
  37 : reamining-chars ( game -- chars )
  38     [ secret-word>> ] [ guesses>> ] bi [
  39        guess>chars
  40     ] with map concat members
  41     [ background of ] assoc-map
  42     [ first ] collect-value-by
  43     [ [ color>n ] zip-with sort-values reverse first first ] assoc-map
  44     CHAR: a CHAR: z [a..b] [ 1string COLOR: white ] { } map>assoc [ or ] assoc-merge ;
  45
  46 : print-remaining-chars ( game -- )
  47     reamining-chars [ background associate format ] assoc-each nl ;
  48
  49 : print-guesses ( game -- )
  50     [ secret-word>> ] [ guesses>> ] bi [
  51         guess>chars [ format ] assoc-each nl
  52     ] with each nl ;
  53
  54 : read-guess ( -- guess )
  55     "guess: " write
  56     readln >lower dup length 5 =
  57     [ " needs to have 5 letters" append print read-guess ] unless
  58     dup word-hash-set in?
  59     [ " not in the word list" append print read-guess ] unless ;
  60
  61 : check-winner? ( game -- ? )
  62     [ secret-word>> ] [ guesses>> ?last ] bi = ;
  63
  64 : print-secret ( game color -- )
  65     [ secret-word>> ] [ background associate ] bi* format nl ;
  66
  67 : maybe-stop? ( game -- ? )
  68     [ guesses>> length ] [ chances>> ] bi >= ;
  69
  70 : play-wordlet ( game -- )
  71     dup maybe-stop? [
  72         COLOR: red print-secret
  73     ] [
  74         {
  75             [ print-guesses ]
  76             [ print-remaining-chars ]
  77             [ [ read-guess ] dip guesses>> push ]
  78             [
  79                 dup check-winner?
  80                 [ COLOR: green print-secret ]
  81                 [ play-wordlet ] if
  82             ]
  83         } cleave
  84     ] if ;
  85
  86 : play-random-wordlet-game ( -- )
  87     "wordlet Started" print
  88     word-list random 6 <wordlet-game> play-wordlet ;
  89
  90 MAIN: play-random-wordlet-game