gopher: initial commit of gopher lib.
parent
f6af1da32f
commit
cba72871c9
|
@ -0,0 +1 @@
|
|||
John Benediktsson
|
|
@ -0,0 +1,117 @@
|
|||
! Copyright (C) 2014 John Benediktsson
|
||||
! See http://factorcode.org/license.txt for BSD license
|
||||
|
||||
USING: accessors byte-arrays colors.constants combinators
|
||||
formatting fry images images.loader images.loader.private
|
||||
images.viewer io io.encodings.binary io.encodings.string
|
||||
io.encodings.utf8 io.sockets io.styles kernel make math
|
||||
math.parser namespaces prettyprint sequences splitting strings
|
||||
urls vocabs ;
|
||||
|
||||
IN: gopher
|
||||
|
||||
<PRIVATE
|
||||
|
||||
CONSTANT: A_TEXT CHAR: 0
|
||||
CONSTANT: A_MENU CHAR: 1
|
||||
CONSTANT: A_CSO CHAR: 2
|
||||
CONSTANT: A_ERROR CHAR: 3
|
||||
CONSTANT: A_MACBINHEX CHAR: 4
|
||||
CONSTANT: A_PCBINHEX CHAR: 5
|
||||
CONSTANT: A_UUENCODED CHAR: 6
|
||||
CONSTANT: A_INDEX CHAR: 7
|
||||
CONSTANT: A_TELNET CHAR: 8
|
||||
CONSTANT: A_BINARY CHAR: 9
|
||||
CONSTANT: A_DUPLICATE CHAR: +
|
||||
CONSTANT: A_SOUND CHAR: s
|
||||
CONSTANT: A_EVENT CHAR: e
|
||||
CONSTANT: A_CALENDAR CHAR: c
|
||||
CONSTANT: A_HTML CHAR: h
|
||||
CONSTANT: A_TN3270 CHAR: T
|
||||
CONSTANT: A_MIME CHAR: M
|
||||
CONSTANT: A_IMAGE CHAR: I
|
||||
CONSTANT: A_WHOIS CHAR: w
|
||||
CONSTANT: A_QUERY CHAR: q
|
||||
CONSTANT: A_GIF CHAR: g
|
||||
CONSTANT: A_WWW CHAR: w
|
||||
CONSTANT: A_PLUS_IMAGE CHAR: :
|
||||
CONSTANT: A_PLUS_MOVIE CHAR: ;
|
||||
CONSTANT: A_PLUS_SOUND CHAR: <
|
||||
|
||||
: get-binary ( selector -- binary )
|
||||
"\r\n" append utf8 encode write flush
|
||||
input-stream get (stream-contents-by-block) ;
|
||||
|
||||
: get-gif ( selector -- image )
|
||||
get-binary "gif" (image-class) load-image* ;
|
||||
|
||||
: get-text ( selector query/f -- lines )
|
||||
[ "\t" glue ] when* "\r\n" append
|
||||
utf8 encode write flush
|
||||
input-stream get (stream-contents-by-block)
|
||||
utf8 decode string-lines
|
||||
"." over index [ head ] when* ;
|
||||
|
||||
TUPLE: gopher-link type name selector host port ;
|
||||
|
||||
: <gopher-link> ( item -- gopher-link )
|
||||
[ "" ] [
|
||||
unclip swap "\t" split first4 gopher-link boa
|
||||
] if-empty ;
|
||||
|
||||
M: gopher-link >url
|
||||
dup type>> CHAR: h = [
|
||||
selector>> "URL:" ?head drop
|
||||
] [
|
||||
{
|
||||
[ host>> ] [ port>> ] [ type>> ] [ selector>> ]
|
||||
} cleave "gopher://%s:%s/%s%s" sprintf
|
||||
] if >url ;
|
||||
|
||||
: get-menu ( selector -- lines )
|
||||
f get-text [ <gopher-link> ] map ;
|
||||
|
||||
: get-selector ( selector -- stuff )
|
||||
"/" split1 "" or swap
|
||||
dup length 1 > [ string>number ] [ first ] if
|
||||
{
|
||||
{ A_TEXT [ f get-text ] }
|
||||
{ A_MENU [ get-menu ] }
|
||||
{ A_INDEX [ get-menu ] }
|
||||
{ A_GIF [ get-gif ] }
|
||||
[ drop get-binary ]
|
||||
} case ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
ERROR: not-a-gopher-url url ;
|
||||
|
||||
: gopher ( url -- object )
|
||||
dup url? [ >url ] unless
|
||||
dup protocol>> "gopher" = [ not-a-gopher-url ] unless {
|
||||
[ host>> ]
|
||||
[ port>> 70 or <inet> binary ]
|
||||
[ path>> rest ]
|
||||
} cleave '[ _ get-selector ] with-client ;
|
||||
|
||||
: gopher. ( url -- )
|
||||
gopher {
|
||||
{ [ dup byte-array? ] [ . ] }
|
||||
{ [ dup image? ] [ image. ] }
|
||||
[
|
||||
[
|
||||
dup gopher-link? [
|
||||
dup type>> CHAR: i = [
|
||||
name>> print
|
||||
] [
|
||||
[ name>> ] keep [
|
||||
presented ,,
|
||||
COLOR: blue foreground ,,
|
||||
] H{ } make format nl
|
||||
] if
|
||||
] [
|
||||
print
|
||||
] if
|
||||
] each
|
||||
]
|
||||
} cond ;
|
|
@ -0,0 +1 @@
|
|||
Gopher client
|
|
@ -0,0 +1 @@
|
|||
network
|
Loading…
Reference in New Issue