extra/gopher/gopher.factor

   1 ! Copyright (C) 2014 John Benediktsson
   2 ! See http://factorcode.org/license.txt for BSD license
   3
   4 USING: accessors byte-arrays calendar colors combinators
   5 formatting fry images images.loader images.loader.private
   6 images.viewer io io.encodings.binary io.encodings.string
   7 io.encodings.utf8 io.sockets io.styles io.timeouts kernel make
   8 math math.parser namespaces present prettyprint sequences
   9 splitting summary urls urls.encoding vocabs ;
  10
  11 IN: gopher
  12
  13 <PRIVATE
  14
  15 CONSTANT: A_TEXT CHAR: 0
  16 CONSTANT: A_MENU CHAR: 1
  17 CONSTANT: A_CSO CHAR: 2
  18 CONSTANT: A_ERROR CHAR: 3
  19 CONSTANT: A_MACBINHEX CHAR: 4
  20 CONSTANT: A_PCBINHEX CHAR: 5
  21 CONSTANT: A_UUENCODED CHAR: 6
  22 CONSTANT: A_INDEX CHAR: 7
  23 CONSTANT: A_TELNET CHAR: 8
  24 CONSTANT: A_BINARY CHAR: 9
  25 CONSTANT: A_DUPLICATE CHAR: +
  26 CONSTANT: A_SOUND CHAR: s
  27 CONSTANT: A_EVENT CHAR: e
  28 CONSTANT: A_CALENDAR CHAR: c
  29 CONSTANT: A_HTML CHAR: h
  30 CONSTANT: A_TN3270 CHAR: T
  31 CONSTANT: A_MIME CHAR: M
  32 CONSTANT: A_IMAGE CHAR: I
  33 CONSTANT: A_WHOIS CHAR: w
  34 CONSTANT: A_QUERY CHAR: q
  35 CONSTANT: A_GIF CHAR: g
  36 CONSTANT: A_WWW CHAR: w
  37 CONSTANT: A_PLUS_IMAGE CHAR: :
  38 CONSTANT: A_PLUS_MOVIE CHAR: ;
  39 CONSTANT: A_PLUS_SOUND CHAR: <
  40
  41 : gopher-get ( selector -- item-type byte-array )
  42     "/" split1 "" or [ first ] dip
  43     "?" split1 [ "\t" glue ] when*
  44     "\r\n" append utf8 encode write flush read-contents ;
  45
  46 PRIVATE>
  47
  48 ERROR: not-a-gopher-url url ;
  49
  50 : gopher ( url -- item-type byte-array )
  51     >url dup protocol>> "gopher" = [ not-a-gopher-url ] unless {
  52         [ host>> ]
  53         [ port>> 70 or <inet> binary ]
  54         [ path>> rest url-encode [ "1/" ] when-empty ]
  55         [ query>> [ assoc>query url-decode "?" glue ] when* ]
  56     } cleave '[
  57         1 minutes input-stream get set-timeout
  58         _ gopher-get
  59     ] with-client ;
  60
  61 <PRIVATE
  62
  63 TUPLE: gopher-link type name selector host port ;
  64
  65 M: gopher-link summary >url present ;
  66
  67 : <gopher-link> ( item -- gopher-link )
  68     unclip swap "\t" split first4 gopher-link boa ;
  69
  70 M: gopher-link >url
  71     dup type>> CHAR: h = [
  72         selector>> "URL:" ?head drop
  73     ] [
  74         {
  75             [ host>> ] [ port>> ] [ type>> ] [ selector>> ]
  76         } cleave "gopher://%s:%s/%c%s" sprintf
  77     ] if >url ;
  78
  79 : gopher-link. ( gopher-link -- )
  80     dup type>> CHAR: i = [
  81         name>> print
  82     ] [
  83         [ name>> ] keep [
  84             presented ,,
  85             COLOR: blue foreground ,,
  86         ] H{ } make format nl
  87     ] if ;
  88
  89 : gopher-text ( object -- lines )
  90     utf8 decode split-lines { "." } split1 drop ;
  91
  92 : gopher-text. ( object -- )
  93     gopher-text [ print ] each ;
  94
  95 : gopher-gif. ( object -- )
  96     "gif" (image-class) load-image* image. ;
  97
  98 : gopher-image. ( path object -- path )
  99     over image-class load-image* image. ;
 100
 101 : gopher-menu. ( object -- )
 102     gopher-text [
 103         [ nl ] [ <gopher-link> gopher-link. ] if-empty
 104     ] each ;
 105
 106 PRIVATE>
 107
 108 : gopher. ( url -- )
 109     >url [ path>> ] [ gopher swap ] bi {
 110         { A_TEXT [ gopher-text. ] }
 111         { A_MENU [ gopher-menu. ] }
 112         { A_INDEX [ gopher-menu. ] }
 113         { A_GIF [ gopher-gif. ] }
 114         { A_IMAGE [ gopher-image. ] }
 115         [ drop . ]
 116     } case drop ;