USING: accessors assocs continuations debugger destructors
fry irc.bot irc.client irc.client.private irc.messages kernel
memoize namespaces random sequences sequences.lib soundex
make splitting threads ;
IN: irc.bot.butt-head

: butt-head-profile ( -- obj )
    "irc.freenode.org" 6667 "butt-head" f <irc-profile> ;

: channels ( -- seq ) { "#concatenative" "#forth" } ;

MEMO: funny-words ( -- hash )
    {
        "anus" "ball" "balls" "bone" "boob" "boobs" "butt"
        "cleave" "foreskin" "head" "hole" "monad"
        "log" "logged" "penis" "score" "spread"
        "wood" "poker"
    }
    [ [ soundex ] keep ] H{ } map>assoc ;

: sender ( privmsg -- string ) prefix>> "!" split1 drop ;

: line>soundex ( string -- seq )
    "!@#$%^&*()+=-_[]{}|\\/?<>,.:;\"'~`\n\r " split
    [ soundex ] map ;

: assoc-find-all ( seq assoc -- seq' )
    [ at ] curry map sift ;

: funny-response ( seq -- )
    first
    "uh huh-huh-huh, huh-huh-huh, you said '"
    swap "'" 3append bot-write ;

! : log-off ( -- )
    ! "uh huh-huh-huh, uh huh-huh, uh-huh-huh-huh" quit
    ! irc> stream>> dispose ;

GENERIC: butt-head ( message -- ? )

M: privmsg butt-head ( privmsg -- ? )
    [ trailing>> ] [ sender ] bi

    2dup [ "quit" = ] [ "erg" = ] bi* and [
        2drop f ! log-off f
    ] [
        drop line>soundex funny-words assoc-find-all
        [ ] [ funny-response ] if-empty t
    ] if ;

M: object butt-head ( obj -- ? )
    drop t ;

: butt-head-loop ( -- )
    [
        current-listener get read-message
        butt-head [ butt-head-loop ] when
    ] [ error. ] recover ;

: bot-the-channel ( string -- )
    [
        dup
        '[
            _
            <irc-channel-listener>
            [ irc> add-listener ]
            [ current-listener [ butt-head-loop ] with-variable ] bi
        ]
        swap "-butt-head-bot" append spawn drop
    ] with-scope ;

: do-it ( -- )
    butt-head-profile <irc-client>
    dup connect-irc current-irc-client set
    channels [ bot-the-channel ] each ;