factor/examples/irc.factor

106 lines
2.4 KiB
Factor

! A simple IRC client written in Factor.
IN: irc
USE: generic
USE: stdio
USE: namespaces
USE: streams
USE: kernel
USE: threads
USE: lists
USE: strings
USE: words
USE: math
SYMBOL: irc-stream
SYMBOL: channels
SYMBOL: channel
SYMBOL: nickname
: irc-write ( s -- ) irc-stream get fwrite ;
: irc-print ( s -- ) irc-stream get fprint irc-stream get fflush ;
: 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 <client> irc-stream set ;
: write-highlighted ( line -- )
dup nickname get index-of -1 =
f [ [ "ansi-fg" | "3" ] ] ? write-attr ;
: extract-nick ( line -- nick )
"!" split1 drop ;
: write-nick ( line -- )
"!" split1 drop [ [ "bold" | t ] ] write-attr ;
GENERIC: irc-display
PREDICATE: string privmsg "PRIVMSG" index-of -1 > ;
PREDICATE: string action "ACTION" index-of -1 > ;
M: string irc-display ( line -- )
print ;
M: privmsg irc-display ( line -- )
"PRIVMSG" split1 >r write-nick r>
write-highlighted terpri flush ;
! Doesn't look good
! M: action irc-display ( line -- )
! " * " write
! "ACTION" split1 >r write-nick r>
! write-highlighted terpri flush ;
: in-loop ( -- )
irc-stream get freadln [ irc-display in-loop ] when* ;
: input-thread ( -- ) [ in-loop ] in-thread ;
: disconnect ( -- ) irc-stream get fclose ;
: command ( line -- )
#! IRC /commands are just words.
" " split1 swap [
"irc" "listener" "parser" "scratchpad"
] search execute ;
: (msg) ( line nick -- )
"PRIVMSG " irc-write irc-write " :" irc-write irc-print ;
: say ( line -- )
channel get [ (msg) ] [ "No channel." print ] ifte* ;
: talk ( input -- ) "/" ?str-head [ command ] [ say ] ifte ;
: talk-loop ( -- ) read [ talk talk-loop ] when* ;
: irc ( nick server -- )
[
channels off
channel off
connect
login
input-thread
talk-loop
disconnect
] with-scope ;
! /commands
: join ( chan -- )
dup channels [ cons ] change
dup channel set
"JOIN " irc-write irc-print ;
: leave ( chan -- )
dup channels [ remove ] change
channels get dup [ car ] when channel set
"PART " irc-write irc-print ;
: msg ( line -- ) " " split1 swap (msg) ;
: me ( line -- ) "\u0001ACTION " swap "\u0001" cat3 say ;
: quit ( line -- ) drop disconnect ;