--- /dev/null
+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
--- /dev/null
+! 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
+
+<PRIVATE
+
+: split-text ( str -- seq )
+ [ blank? ] split-when harvest ;
+
+: parse-section-attr ( seq -- section )
+ [ name>> "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 ;
projects / factor.git / commitdiff