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 ;
 |