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