diff --git a/extra/geekcode/authors.txt b/extra/geekcode/authors.txt new file mode 100644 index 0000000000..e091bb8164 --- /dev/null +++ b/extra/geekcode/authors.txt @@ -0,0 +1 @@ +John Benediktsson diff --git a/extra/geekcode/geekcode-tests.factor b/extra/geekcode/geekcode-tests.factor new file mode 100644 index 0000000000..b011e6fe76 --- /dev/null +++ b/extra/geekcode/geekcode-tests.factor @@ -0,0 +1,89 @@ +USING: tools.test ; +IN: geekcode + +{ + { + { + "Dress" + "My t-shirts go a step further and have a trendy political message on them." + } + { "Age" "20-24" } + { + "Perl" + "I know of Perl. I like Perl. I just haven't learned much Perl, but it is on my agenda." + } + { + "Linux" + "I use Linux ALMOST exclusively on my system. I've given up trying to achieve Linux.God status, but welcome the OS as a replacement for DOS. I only boot to DOS to play games." + } + { "Emacs" "Emacs sucks! pico forever!!!" } + { + "USENET News" + "I read so many newsgroups that the next batch of news comes in before I finish reading the last batch, and I have to read for about 2 hours straight before I'm caught up on the morning's news. Then there's the afternoon..." + } + { "USENET Oracle" "I have been incarnated at least once." } + { "Kibo" "I've gotten mail from Kibo" } + { + "Microsoft Windows" + "Windows has set back the computing industry by at least 10 years. Bill Gates should be drawn, quartered, hung, shot, poisoned, disembowelled, and then REALLY hurt." + } + { "OS/2" "Tried it, didn't like it." } + { + "Macintosh" + "A Mac has it's uses and I use it quite often." + } + { + "VMS" + "I would rather smash my head repeatedly into a brick wall than suffer the agony of working with VMS. It's reminiscent of a dead and decaying pile of moose droppings. Unix rules the universe." + } + { + "Cypherpunks" + "I am on the cypherpunks mailing list and active around Usenet. I never miss an opportunity to talk about the evils of Clipper and ITAR and the NSA. Orwell's 1984 is more than a story, it is a warning to our's and future generations. I'm a member of the EFF." + } + { + "PGP" + "I have the most recent version and use it regularly" + } + { + "Star Trek" + "Maybe it is just me, but I have no idea what the big deal with Star Trek is. Perhaps I'm missing something but I just think it is bad drama." + } + { + "Babylon 5" + "I am a True Worshipper of the Church of Joe who lives eats breathes and thinks Babylon 5, and has Evil thoughts about stealing Joe's videotape archives just to see episodes earlier. I am planning to break into the bank and steal the triple-encoded synopsis of the 5-year arc." + } + { + "X-Files" + "This is one of the better shows I've seen. I wish I'd taped everything from the start at SP, because I'm wearing out my EP tapes. I'll periodically debate online. I've Converted at least 5 people. I've gotten a YAXA." + } + { "Television" "I watch some tv every day." } + { + "Books" + "I enjoy reading, but don't get the time very often." + } + { "Dilbert" "I am a Dilbert prototype" } + { + "DOOM!" + "I crank out PWAD files daily, complete with new monsters, weaponry, sounds and maps. I'm a DOOM God. I can solve the original maps in nightmare mode with my eyes closed." + } + { "The Geek Code" "I am Robert Hayden" } + { "Education" "Got a Bachelors degree" } + { + "Housing" + "Friends come over to visit every once in a while to talk about Geek things. There is a place for them to sit." + } + { + "Relationships" + "People just aren't interested in dating me." + } + } +} [ + """ + -----BEGIN GEEK CODE BLOCK----- + Version: 3.1 + GED/J d-- s:++>: a-- C++(++++) ULU++ P+ L++ E---- W+(-) N+++ o+ K+++ w--- + O- M+ V-- PS++>$ PE++>$ Y++ PGP++ t- 5+++ X++ R+++>$ tv+ b+ DI+++ D+++ + G+++++ e++ h r-- y++** + ------END GEEK CODE BLOCK------ + """ geekcode +] unit-test diff --git a/extra/geekcode/geekcode.factor b/extra/geekcode/geekcode.factor new file mode 100644 index 0000000000..ed685fd9bb --- /dev/null +++ b/extra/geekcode/geekcode.factor @@ -0,0 +1,60 @@ +! Copyright (C) 2015 John Benediktsson +! See http://factorcode.org/license.txt for BSD license + +USING: accessors arrays assocs combinators.short-circuit +grouping hashtables html.parser html.parser.analyzer +html.parser.printer http.client io io.styles kernel memoize +sequences splitting unicode.categories wrap.strings ; +FROM: sequences => change-nth ; + +IN: geekcode + +> "dt" = ] split-when [ + [ name>> "dd" = ] split-when + [ html-text split-text " " join ] map harvest + ] map harvest ; + +: parse-section-attrs ( seq -- specs ) + [ name>> "dl" = ] find-between-all 2 tail 2 head* + [ parse-section-attr ] map 0 over [ + first [ " " split1 " " split1 nip 2array ] map + ] change-nth [ >hashtable ] map ; + +: parse-section-names ( seq -- names ) + [ + { [ name>> "hr" = ] [ "size" attribute not ] } 1&& + ] split-when 4 tail [ + "h2" find-between-first first text>> + ] map "Type" prefix ; + +: parse-spec ( seq -- spec ) + [ parse-section-names ] [ parse-section-attrs ] bi zip ; + +MEMO: geekcode-spec ( -- obj ) + "http://www.geekcode.com/geek.html" http-get nip + parse-html parse-spec ; + +: lookup-code ( code -- result/f ) + geekcode-spec [ second at ] with map-find + [ first swap 2array ] [ drop f ] if* ; + +PRIVATE> + +: geekcode ( geekcode -- str ) + split-text [ lookup-code ] map harvest ; + +: geekcode. ( geekcode -- ) + geekcode standard-table-style [ + [ + [ + [ [ write ] with-cell ] + [ [ 60 wrap-string write ] with-cell ] bi* + ] with-row + ] assoc-each + ] tabular-output nl ; diff --git a/extra/geekcode/summary.txt b/extra/geekcode/summary.txt new file mode 100644 index 0000000000..abb32e78c3 --- /dev/null +++ b/extra/geekcode/summary.txt @@ -0,0 +1 @@ +The Code of the Geeks