--- /dev/null
+! Simple IRC bot written in Factor.
+
+IN: factorbot
+USING: hashtables http io kernel math namespaces prettyprint
+sequences strings words ;
+
+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 <client> irc-stream set ;
+
+: disconnect ( -- ) irc-stream get stream-close ;
+
+: join ( chan -- )
+ "JOIN " irc-write irc-print ;
+
+GENERIC: handle-irc
+PREDICATE: string privmsg "PRIVMSG" swap subseq? ;
+
+M: string handle-irc ( line -- )
+ drop ( print flush ) ;
+
+: parse-privmsg ( line -- text )
+ ":" ?head drop
+ "!" split1 swap speaker set
+ "PRIVMSG " split1 nip
+ " " split1 swap receiver set
+ ":" ?head drop ;
+
+M: privmsg handle-irc ( line -- )
+ parse-privmsg
+ " " split1 swap
+ [ "factorbot-commands" ] search dup
+ [ execute ] [ 2drop ] ifte ;
+
+: say ( line nick -- )
+ "PRIVMSG " irc-write irc-write " :" irc-write irc-print ;
+
+: respond ( line -- )
+ receiver get nickname get = speaker receiver ? get say ;
+
+: word-string ( word -- string )
+ [
+ "IN: " % dup word-vocabulary %
+ " " % dup definer word-name %
+ " " % dup word-name %
+ "stack-effect" word-prop [ " (" % % ")" % ] when*
+ ] make-string ;
+
+: word-url ( word -- url )
+ [
+ "http://factor.modalwebserver.co.nz/responder/browser/?vocab=" %
+ dup word-vocabulary url-encode %
+ "&word=" %
+ word-name url-encode %
+ ] make-string ;
+
+: irc-loop ( -- )
+ irc-stream get stream-readln
+ [ handle-irc irc-loop ] when* ;
+
+: factorbot
+ "irc.freenode.net" connect
+ "factorbot" login
+ "#concatenative" join
+ irc-loop ;
+
+IN: factorbot-commands
+
+: see ( text -- )
+ dup vocabs [ vocab ?hash ] map-with [ ] subset
+ dup empty? [
+ drop
+ "Sorry, I couldn't find anything for " swap append respond
+ ] [
+ nip [
+ dup word-string " -- " rot word-url append3 respond
+ ] each-with
+ ] ifte ;
+
+: quit ( text -- )
+ drop speaker "slava" = [ disconnect ] when ;
+
+factorbot
+++ /dev/null
-! A simple IRC client written in Factor.
-
-IN: irc
-USING: kernel lists math namespaces io strings threads words ;
-
-SYMBOL: irc-stream
-SYMBOL: channels
-SYMBOL: channel
-SYMBOL: nickname
-
-: 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 <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 stream-readln [ irc-display in-loop ] when* ;
-
-: input-thread ( -- ) [ in-loop ] in-thread ;
-: disconnect ( -- ) irc-stream get stream-close ;
-
-: 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 -- ) "/" ?string-head [ command ] [ say ] ifte ;
-: talk-loop ( -- ) read-line [ 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 ;
--- /dev/null
+IN: temporary
+USING: generic image kernel math namespaces parser test ;
+
+[
+ boot-quot off
+ "/library/bootstrap/boot-stage1.factor" run-resource
+] with-image drop
+
+[ fixnum ] [ 4 class ] unit-test
+IN: temporary
USE: test
USE: image
USE: namespaces
[
[ image-magic 8 >be write ] string-out
] unit-test
-
-[
- boot-quot off
- "/library/bootstrap/boot-stage1.factor" run-resource
-] with-image drop
-
-[ fixnum ] [ 4 class ] unit-test
"benchmark/continuations" "benchmark/ack"
"benchmark/hashtables" "benchmark/strings"
"benchmark/vectors" "benchmark/prettyprint"
+ "benchmark/image"
] run-tests ;
: compiler-tests
all-words swap subset word-sort ; inline
: word-subset-with ( obj pred -- list | pred: obj word -- ? )
- all-words swap subset-with ; inline
+ all-words swap subset-with word-sort ; inline
: recrossref ( -- )
#! Update word cross referencing information.
global [ <namespace> crossref set ] bind
[ add-crossref ] each-word ;
-: (search) ( name vocab -- word )
- vocab dup [ hash ] [ 2drop f ] ifte ;
-
: search ( name list -- word )
#! Search for a word in a list of vocabularies.
dup [
- 2dup car (search) [ nip ] [ cdr search ] ?ifte
+ 2dup car vocab ?hash [ nip ] [ cdr search ] ?ifte
] [
2drop f
] ifte ;
#! Create a new word in a vocabulary. If the vocabulary
#! already contains the word, the existing instance is
#! returned.
- 2dup (search) [
+ 2dup vocab ?hash [
nip
dup f "documentation" set-word-prop
dup f "stack-effect" set-word-prop