extra/gopher/gopher.factor

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