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
  44     [ dup length 1 > [ string>number ] [ first ] if ]
  45     [
  46         "?" split1 [ "\t" glue ] when*
  47         "\r\n" append utf8 encode write flush contents
  48     ] bi* ;
  49
  50 PRIVATE>
  51
  52 ERROR: not-a-gopher-url url ;
  53
  54 : gopher ( url -- item-type byte-array )
  55     dup url? [ >url ] unless
  56     dup protocol>> "gopher" = [ not-a-gopher-url ] unless {
  57         [ host>> ]
  58         [ port>> 70 or <inet> binary ]
  59         [ path>> rest [ "1/" ] when-empty ]
  60         [ query>> [ assoc>query url-decode "?" glue ] when* ]
  61     } cleave '[
  62         1 minutes input-stream get set-timeout
  63         _ gopher-get
  64     ] with-client ;
  65
  66 <PRIVATE
  67
  68 TUPLE: gopher-link type name selector host port ;
  69
  70 M: gopher-link summary >url present ;
  71
  72 : <gopher-link> ( item -- gopher-link )
  73     unclip swap "\t" split first4 gopher-link boa ;
  74
  75 M: gopher-link >url
  76     dup type>> CHAR: h = [
  77         selector>> "URL:" ?head drop
  78     ] [
  79         {
  80             [ host>> ] [ port>> ] [ type>> ] [ selector>> ]
  81         } cleave "gopher://%s:%s/%s%s" sprintf
  82     ] if >url ;
  83
  84 : gopher-link. ( gopher-link -- )
  85     dup type>> CHAR: i = [
  86         name>> print
  87     ] [
  88         [ name>> ] keep [
  89             presented ,,
  90             COLOR: blue foreground ,,
  91         ] H{ } make format nl
  92     ] if ;
  93
  94 : gopher-text ( object -- lines )
  95     utf8 decode string-lines { "." } split1 drop ;
  96
  97 : gopher-text. ( object -- )
  98     gopher-text [ print ] each ;
  99
 100 : gopher-gif. ( object -- )
 101     "gif" (image-class) load-image* image. ;
 102
 103 : gopher-menu. ( object -- )
 104     gopher-text [
 105         [ nl ] [ <gopher-link> gopher-link. ] if-empty
 106     ] each ;
 107
 108 PRIVATE>
 109
 110 : gopher. ( url -- )
 111     gopher swap {
 112         { A_TEXT [ gopher-text. ] }
 113         { A_MENU [ gopher-menu. ] }
 114         { A_INDEX [ gopher-menu. ] }
 115         { A_GIF [ gopher-gif. ] }
 116         [ drop . ]
 117     } case ;