USING: accessors arrays ascii assocs assocs.extras colors
combinators hashtables io io.styles kernel math math.order qw
random ranges sequences sequences.extras sets sorting
sorting.slots strings ;
IN: wardle

CONSTANT: wardles qw{
    cigar rebut sissy humph awake blush focal evade naval serve
}

TUPLE: wardle-game secret-word chances guesses ;

: <wardle-game> ( secret-word chances -- wardle-game )
    wardle-game new
        swap >>chances
        swap >>secret-word
        V{ } clone >>guesses ; inline

: guess>chars ( secret guess -- seq )
    [ zip [ first2 = not ] filter keys [ 1string ] map ] 2keep
    [
        [ nip 1string ] [ = ] 2bi
        [ COLOR: green ]
        [
            2dup swap member?
            [ [ swap remove-first ] [ COLOR: yellow ] bi ]
            [ COLOR: gray ] if
        ] if
        background associate 2array
    ] { } 2map-as nip ;

: color>n ( color -- n )
    {
        { COLOR: gray [ 1 ] }
        { COLOR: yellow [ 2 ] }
        { COLOR: green [ 3 ] }
    } case ;

: reamining-chars ( game -- chars )
    [ secret-word>> ] [ guesses>> ] bi [
       guess>chars
    ] with map concat members
    [ background of ] assoc-map
    [ first ] collect-value-by
    [ [ color>n ] zip-with sort-values reverse first first ] assoc-map
    CHAR: a CHAR: z [a..b] [ 1string COLOR: white ] { } map>assoc [ or ] assoc-merge ;

: print-remaining-chars ( game -- )
    reamining-chars [ background associate format ] assoc-each nl ;

: print-guesses ( game -- )
    [ secret-word>> ] [ guesses>> ] bi [
        guess>chars [ format ] assoc-each nl
    ] with each nl ;

: read-guess ( -- guess )
    "guess: " write
    readln >lower dup length 5 =
    [ " needs to have 5 letters" append print read-guess ] unless ;

: check-winner? ( game -- ? )
    [ secret-word>> ] [ guesses>> ?last ] bi = ;

: print-secret ( game color -- )
    [ secret-word>> ] [ background associate ] bi* format nl ;

: maybe-stop? ( game -- ? )
    [ guesses>> length ] [ chances>> ] bi >= ;

: play-wardle ( game -- )
    dup maybe-stop? [
        COLOR: red print-secret
    ] [
        {
            [ print-guesses ]
            [ print-remaining-chars ]
            [ [ read-guess ] dip guesses>> push ]
            [
                dup check-winner?
                [ COLOR: green print-secret ]
                [ play-wardle ] if
            ]
        } cleave
    ] if ;

: play-random-wardle-game ( -- )
    "Wardle Started" print
    wardles random 6 <wardle-game> play-wardle ;

MAIN: play-random-wardle-game