! Copyright (C) 2008 William Schlieper ! See http://factorcode.org/license.txt for BSD license. USING: accessors kernel threads combinators concurrency.mailboxes sequences strings hashtables splitting fry assocs hashtables colors sorting unicode.collation math.order ui ui.gadgets ui.gadgets.panes ui.gadgets.editors ui.gadgets.scrollers ui.commands ui.gadgets.frames ui.gestures ui.gadgets.tabs ui.gadgets.grids ui.gadgets.packs ui.gadgets.labels io io.styles namespaces calendar calendar.format models continuations irc.client irc.client.private irc.messages irc.ui.commandparser irc.ui.load vocabs.loader classes prettyprint ; RENAME: join sequences => sjoin IN: irc.ui SYMBOL: chat SYMBOL: client TUPLE: ui-window < tabbed client ; M: ui-window ungraft* client>> terminate-irc ; TUPLE: irc-tab < frame chat client window ; : write-color ( str color -- ) foreground associate format ; CONSTANT: dark-red T{ rgba f 0.5 0.0 0.0 1 } CONSTANT: dark-green T{ rgba f 0.0 0.5 0.0 1 } CONSTANT: dark-blue T{ rgba f 0.0 0.0 0.5 1 } : dot-or-parens ( string -- string ) [ "." ] [ "(" prepend ")" append ] if-empty ; GENERIC: write-irc ( irc-message -- ) M: ping write-irc drop "* Ping" blue write-color ; M: privmsg write-irc "<" dark-blue write-color [ irc-message-sender write ] keep "> " dark-blue write-color trailing>> write ; M: notice write-irc [ type>> dark-blue write-color ] keep ": " dark-blue write-color trailing>> write ; TUPLE: own-message message nick timestamp ; : ( message nick -- own-message ) now own-message boa ; M: own-message write-irc "<" dark-blue write-color [ nick>> bold font-style associate format ] keep "> " dark-blue write-color message>> write ; M: join write-irc "* " dark-green write-color irc-message-sender write " has entered the channel." dark-green write-color ; M: part write-irc "* " dark-red write-color [ irc-message-sender write ] keep " has left the channel" dark-red write-color trailing>> dot-or-parens dark-red write-color ; M: quit write-irc "* " dark-red write-color [ irc-message-sender write ] keep " has left IRC" dark-red write-color trailing>> dot-or-parens dark-red write-color ; M: kick write-irc "* " dark-red write-color [ irc-message-sender write ] keep " has kicked " dark-red write-color [ who>> write ] keep " from the channel" dark-red write-color trailing>> dot-or-parens dark-red write-color ; M: mode write-irc "* " dark-blue write-color [ name>> write ] keep " has applied mode " dark-blue write-color [ mode>> write ] keep " to " dark-blue write-color parameter>> write ; M: nick write-irc "* " dark-blue write-color [ irc-message-sender write ] keep " is now known as " blue write-color trailing>> write ; M: unhandled write-irc "UNHANDLED: " write line>> dark-blue write-color ; M: irc-end write-irc drop "* You have left IRC" dark-red write-color ; M: irc-disconnected write-irc drop "* Disconnected" dark-red write-color ; M: irc-connected write-irc drop "* Connected" dark-green write-color ; M: irc-chat-end write-irc drop ; M: irc-message write-irc "UNIMPLEMENTED" write [ class pprint ] keep ": " write line>> dark-blue write-color ; GENERIC: time-happened ( message -- timestamp ) M: irc-message time-happened timestamp>> ; M: object time-happened drop now ; : print-irc ( irc-message -- ) [ time-happened timestamp>hms write " " write ] [ write-irc nl ] bi ; : send-message ( message -- ) [ print-irc ] [ chat get speak ] bi ; GENERIC: handle-inbox ( tab message -- ) : value-labels ( assoc val -- seq ) '[ nip _ = ] assoc-filter keys sort-strings [