109 lines
		
	
	
		
			2.5 KiB
		
	
	
	
		
			Factor
		
	
	
			
		
		
	
	
			109 lines
		
	
	
		
			2.5 KiB
		
	
	
	
		
			Factor
		
	
	
! Simple IRC bot written in Factor.
 | 
						|
 | 
						|
REQUIRES: apps/http-server ;
 | 
						|
 | 
						|
USING: errors generic hashtables help html http io kernel math
 | 
						|
memory namespaces parser prettyprint sequences strings threads
 | 
						|
words inspector network ;
 | 
						|
IN: factorbot
 | 
						|
 | 
						|
SYMBOL: irc-stream
 | 
						|
SYMBOL: nickname
 | 
						|
SYMBOL: speaker
 | 
						|
SYMBOL: receiver
 | 
						|
 | 
						|
: irc-write ( s -- ) irc-stream get stream-write ;
 | 
						|
: irc-print ( s -- )
 | 
						|
    irc-stream get stream-print
 | 
						|
    irc-stream get stream-flush ;
 | 
						|
 | 
						|
: nick ( nick -- )
 | 
						|
    dup nickname set  "NICK " irc-write irc-print ;
 | 
						|
 | 
						|
: login ( nick -- )
 | 
						|
    dup nick
 | 
						|
    "USER " irc-write irc-write
 | 
						|
    " hostname servername :irc.factor" irc-print ;
 | 
						|
 | 
						|
: connect ( server -- ) 6667 <inet> <client> irc-stream set ;
 | 
						|
 | 
						|
: disconnect ( -- ) irc-stream get stream-close ;
 | 
						|
 | 
						|
: join ( chan -- )
 | 
						|
    "JOIN " irc-write irc-print ;
 | 
						|
 | 
						|
GENERIC: handle-irc ( line -- )
 | 
						|
PREDICATE: string privmsg " " split1 nip "PRIVMSG" head? ;
 | 
						|
PREDICATE: string ping "PING" head? ;
 | 
						|
 | 
						|
M: object handle-irc ( line -- )
 | 
						|
    drop ;
 | 
						|
 | 
						|
: parse-privmsg ( line -- text )
 | 
						|
    " " split1 nip
 | 
						|
    "PRIVMSG " ?head drop
 | 
						|
    " " split1 swap receiver set
 | 
						|
    ":" ?head drop ;
 | 
						|
 | 
						|
M: privmsg handle-irc ( line -- )
 | 
						|
    parse-privmsg
 | 
						|
    " " split1 swap
 | 
						|
    "factorbot-commands" lookup dup
 | 
						|
    [ execute ] [ 2drop ] if ;
 | 
						|
 | 
						|
M: ping handle-irc ( line -- )
 | 
						|
    "PING " ?head drop "PONG " swap append irc-print ;
 | 
						|
 | 
						|
: parse-irc ( line -- )
 | 
						|
    ":" ?head [ "!" split1 swap speaker set ] when handle-irc ;
 | 
						|
 | 
						|
: say ( line nick -- )
 | 
						|
    "PRIVMSG " irc-write irc-write " :" irc-write irc-print ;
 | 
						|
 | 
						|
: respond ( line -- )
 | 
						|
    receiver get nickname get = speaker receiver ? get say ;
 | 
						|
 | 
						|
: irc-loop ( -- )
 | 
						|
    irc-stream get stream-readln
 | 
						|
    [ dup print flush parse-irc irc-loop ] when* ;
 | 
						|
 | 
						|
: factorbot
 | 
						|
    "irc.freenode.net" connect
 | 
						|
    "factorbot" login
 | 
						|
    "#concatenative" join
 | 
						|
    [ irc-loop ] [ irc-stream get stream-close ] cleanup ;
 | 
						|
 | 
						|
: factorbot-loop [ factorbot ] try 30000 sleep factorbot-loop ;
 | 
						|
 | 
						|
: multiline-respond ( string -- )
 | 
						|
    string-lines [ respond ] each ;
 | 
						|
 | 
						|
: object-href
 | 
						|
    "http://factorcode.org" swap browser-link-href append ;
 | 
						|
 | 
						|
: not-found ( str -- )
 | 
						|
    "Sorry, I couldn't find anything for " swap append respond ;
 | 
						|
 | 
						|
IN: factorbot-commands
 | 
						|
 | 
						|
: see ( text -- )
 | 
						|
    dup words-named dup empty? [
 | 
						|
        drop
 | 
						|
        not-found
 | 
						|
    ] [
 | 
						|
        nip [
 | 
						|
            dup summary " -- " 
 | 
						|
            rot object-href 3append respond
 | 
						|
        ] each
 | 
						|
    ] if ;
 | 
						|
 | 
						|
: memory ( text -- )
 | 
						|
    drop [ room. ] with-string-writer multiline-respond ;
 | 
						|
 | 
						|
: quit ( text -- )
 | 
						|
    drop speaker get "slava" = [ disconnect ] when ;
 | 
						|
 | 
						|
PROVIDE: apps/factorbot ;
 | 
						|
 | 
						|
MAIN: apps/factorbot factorbot ;
 |