'
' A simple text-based Gopher client to browse archives in the GOPHER protocol.
'   http://en.wikipedia.org/wiki/Gopher_(protocol)
'
' Currently implementing methods:
' i - informational messages
' 0 - plain file
' 1 - directory
' 3 - error message from server
' 7 - search engine query
' 9 - binary files (using WGET)
' h - HTML link (using LINKS)
'
' January 2010, Peter van Eerten - GPL.
'
' Version 0.1: initial release
' Version 0.2: improved error handling, better history handling
' Version 0.3: fixed crash when no bookmarks are found
' Version 0.4: code cleaning, methods 7, 9, 'h'
' Version 0.5: adaptations for SPLIT
' Version 0.6: fixed bug when bookmark file does not exist
' Version 0.7: updated for BaCon 3.x
'--------------------------------------------------------------------------------

TRAP LOCAL

' How many actions are stored
CONST ACTIONHISTORY = 16
' Page size when printing text
CONST PAGESIZE = 30
' Menu in directory listings
CONST MENUTEXT$ = "<ESC> = exit <BS> = back <SPACE> = show bookmarks <ENTER> = add to bookmarks"
' Width of separator
CONST SEPARATORSIZE = 77

' Keep track of actions taken
GLOBAL Action_Sequence[ACTIONHISTORY]
GLOBAL Action_Query$[ACTIONHISTORY]
GLOBAL Action_Server$[ACTIONHISTORY]

' Bookmarks
GLOBAL Gopher_Bookmark$

'--------------------------------------------------------------------------------
' Browsing history

SUB Add_History

    LOCAL i

    FOR i = ACTIONHISTORY-2 TO 0 STEP -1
        Action_Sequence[i+1] = Action_Sequence[i]
        Action_Query$[i+1] = Action_Query$[i]
        Action_Server$[i+1] = Action_Server$[i]
    NEXT

    Action_Sequence[0] = -1
    Action_Query$[0] = ""
    Action_Server$[0] = ""

END SUB

'--------------------------------------------------------------------------------
' Browsing history

SUB Get_History

    LOCAL i

    IF LEN(Action_Server$[1]) > 0 THEN
        FOR i = 0 TO ACTIONHISTORY-2
            Action_Sequence[i] = Action_Sequence[i+1]
            Action_Query$[i] = Action_Query$[i+1]
            Action_Server$[i] = Action_Server$[i+1]
        NEXT
    ENDIF

    Action_Sequence[ACTIONHISTORY-1] = -1
    Action_Query$[ACTIONHISTORY-1] = ""
    Action_Server$[ACTIONHISTORY-1] = ""

END SUB

'--------------------------------------------------------------------------------
' Fetches the information from a Gopher server

FUNCTION Get_Data$ (STRING site$, NUMBER port, STRING query$)

    CATCH GOTO Handle_Error

    LOCAL data$, total$

    OPEN site$ & ":" & STR$(port) FOR NETWORK AS mynet

        SEND query$ TO mynet

        REPEAT
            RECEIVE data$ FROM mynet
            total$ = total$ & data$
        UNTIL ISFALSE(WAIT(mynet, 500)) OR LEN(data$) = 0

    CLOSE NETWORK mynet

    RETURN total$

    LABEL Handle_Error
        EPRINT " Error connecting to ", site$ , ":" , STR$(port), NL$
        RETURN ""

END FUNCTION

'--------------------------------------------------------------------------------
' Print textfile

SUB Print_Data(STRING dat$)

    LOCAL dim, counter, next, key

    SPLIT dat$ BY NL$ TO line$ SIZE dim

    counter = 0
    next = 0

    IF EQUAL(LEFT$(dat$, 1), "3") THEN
        PRINT SPC$(5), MID$(dat$, 2, INSTR(dat$, CHR$(9)))
    ELSE
        WHILE counter < dim DO

            PRINT line$[counter]

            INCR next
            INCR counter

            IF next = PAGESIZE THEN
                next = 0
                REPEAT
                    PRINT NL$, "  ---------- Press <SPACE> to continue, <BACKSPACE> to get menu ----------";
                    key = GETKEY
                    IF key = 27 THEN
                        IF LEN(Gopher_Bookmark$) > 0 THEN CALL Save_Bookmarks
                        PRINT
                        END
                    END IF
                    IF key = 127 THEN BREAK
                UNTIL key = 32
                PRINT NL$
            ENDIF
            IF key = 127 THEN BREAK
        WEND
    ENDIF

END SUB

'--------------------------------------------------------------------------------
' Shows directory listing

SUB Directory_List (STRING total$)

    LOCAL dim, longest, i, item, no

    ' Split into separate lines
    SPLIT total$ BY CHR$(13) & CHR$(10) TO line$ SIZE dim

    IF dim = 0 OR LEN(total$) < 2 THEN
        PRINT SPC$(5), "*** NO DATA AVAILABLE***"
    ELSE
        ' Parse and print
        item = 97
        no = 48
        FOR i = 0 TO dim - 2
            SELECT LEFT$(line$[i], 1)
                ' Informational messages
                CASE "i"
                    IF INSTR(line$[i], CHR$(9)) THEN PRINT SPC$(5), MID$(line$[i], 2, INSTR(line$[i], CHR$(9)) - 2)
                    ELSE PRINT SPC$(5), MID$(line$[i], 2)
                ' Directories and files
                CASE "0";
                CASE "1";
                CASE "7";
                CASE "9";
                CASE "h"
                    PRINT "(", CHR$(item), CHR$(no), ") ", MID$(line$[i], 2, INSTR(line$[i], CHR$(9)) - 2)
                    ' PRINT "(", CHR$(item), CHR$(no), ") ", line$[i]
                    INCR no
                    IF no = 58 THEN
                        INCR item
                        no = 48
                    ENDIF
                ' Error message from server
                CASE "3"
                    PRINT SPC$(5), MID$(line$[i], 2, INSTR(line$[i], CHR$(9)))
                ' Do nothing with a '.'
                CASE "."
                DEFAULT
                    PRINT "<<< GOPHER method '", LEFT$(line$[i], 1),"' not yet supported by this client >>>"
            END SELECT
        NEXT
    ENDIF

END SUB

'--------------------------------------------------------------------------------
' Take action based on GOPHER method

SUB Perform_Action (STRING line$)

    LOCAL fields, key
    LOCAL search$

    ' Split line into pieces based on TAB
    SPLIT line$ BY CHR$(9) TO part$ SIZE fields

    ' Get type 0, 1 or 9
    SELECT LEFT$(line$, 1)
        ' File
        CASE "0"
            Add_History
            Action_Sequence[0] = 0
            Action_Query$[0] = part$[1] & CHR$(13) & CHR$(10)
            Action_Server$[0] = part$[2]
            Gopher_Port = VAL(part$[3])
        ' Directory, 3 fields or 4 fields?
        CASE "1"
            Add_History
            Action_Sequence[0] = 1
            IF fields = 3 THEN
                Action_Query$[0] = "\r\n"
                Action_Server$[0] = part$[1]
                Gopher_Port = VAL(part$[2])
            ELSE
                Action_Query$[0] = part$[1] & CHR$(13) & CHR$(10)
                Action_Server$[0] = part$[2]
                Gopher_Port = VAL(part$[3])
            END IF
        ' Search query
        CASE "7"
            INPUT "Enter your search string: ", search$
            Add_History
            Action_Sequence[0] = 1
            Action_Query$[0] = part$[1] & "?" & search$ & CHR$(13) & CHR$(10)
            Action_Server$[0] = part$[2]
            Gopher_Port = VAL(part$[3])
            PRINT
        ' Binary file, using WGET to download
        CASE "9"
            IF NOT(LEN(EXEC$("which wget 2>/dev/null"))) THEN
                PRINT "WGET not found, unable to download '", MID$(part$[0], 2), "'!", NL$
            ELSE
                REPEAT
                    PRINT "Download '",  MID$(part$[0], 2), "' (y/n)? ";
                    key = GETKEY
                UNTIL key = 121 OR key = 110
                PRINT NL$
                IF key = 121 THEN
                    SYSTEM "wget -O " & CHR$(34) & GETENVIRON$("HOME") & "/" & MID$(part$[1], INSTRREV(part$[1], "/") + 1) & CHR$(34) & " " & CHR$(34) & part$[2] & ":" & part$[3] & part$[1] & CHR$(34)
                    PRINT "File is downloaded to: ", GETENVIRON$("HOME"), "/", MID$(part$[1], INSTRREV(part$[1], "/") + 1), NL$
                END IF
            ENDIF
        ' Hyperlink, using LINKS to display it
        CASE "h"
            IF NOT(LEN(EXEC$("which links 2>/dev/null"))) THEN
                PRINT "LINKS not found, unable to display '", MID$(part$[0], 2), "'!", NL$
            ELSE
                IF INSTR(part$[1], "URL:") THEN SYSTEM "links " & CHR$(34) & MID$(part$[1], 5) & CHR$(34)
                ELSE SYSTEM "links " & CHR$(34) & part$[2] & ":" & part$[3] & part$[1] & CHR$(34)
            ENDIF
    ENDSELECT

END SUB

'--------------------------------------------------------------------------------
' Parse input from user

SUB Parse_Input (STRING total$, NUMBER sel1, NUMBER sel2)

    LOCAL item, i, no, dim

    item = 97
    no = 47

    ' Split the fetched information into separate lines
    SPLIT total$ BY CHR$(13) & CHR$(10) TO line$ SIZE dim

    FOR i = 0 TO dim - 1

        ' Increase line numbering in case of 0, 1 or 9
        SELECT LEFT$(line$[i], 1)
            CASE "0";
            CASE "1";
            CASE "7";
            CASE "9";
            CASE "h"
                INCR no
                IF no = 58 THEN
                    INCR item
                    no = 48
                ENDIF

                ' Check selection by user
                IF item = sel1 AND no = sel2 THEN
                    Perform_Action(line$[i])
                    BREAK
                END IF
        END SELECT
    NEXT

END SUB

'--------------------------------------------------------------------------------
' Bookmark handling

SUB Handle_Bookmarks

    LOCAL site$
    LOCAL i, j, key, dim, action

    IF LEN(Gopher_Bookmark$) > 0 THEN
        WHILE TRUE DO
            SPLIT Gopher_Bookmark$ BY NL$ TO line$ SIZE dim
            FOR i = 0 TO dim - 2
                PRINT "(", CHR$(i+97), ") ", line$[i]
            NEXT
            PRINT NL$, "Goto bookmark or BS to delete... ";
            key = GETKEY
            IF key = 27 THEN
                PRINT
                IF LEN(Gopher_Bookmark$) > 0 THEN CALL Save_Bookmarks
                END
            END IF
            IF key = 127 THEN
                PRINT "delete which bookmark (0 to cancel): ";
                action = GETKEY
                PRINT CHR$(action), NL$
                IF action - 97 < dim THEN
                    Gopher_Bookmark$ = ""
                    FOR j = 0 TO dim - 1
                        IF j ISNOT action - 97 THEN Gopher_Bookmark$ = Gopher_Bookmark$ & line$[j] & NL$
                    NEXT
                END IF
            ELIF key < 97 OR key > 122 THEN
                PRINT "Wrong key! Choose a-z."
            ELIF key - 97 > dim - 1 THEN
                PRINT "No such choice!"
            ELSE
                Add_History
                Action_Sequence[0] = 1
                Action_Query$[0] = "\r\n"
                Action_Server$[0] = line$[key - 97]
                PRINT CHR$(key), NL$
                BREAK
            ENDIF
        WEND
    ELSE
        Action_Server$[0] = "gopher.floodgap.com"
        PRINT SPC$(11), "No bookmarks found!", NL$
    ENDIF

    PRINT FILL$(SEPARATORSIZE, 45), NL$

END SUB

'--------------------------------------------------------------------------------

SUB Save_Bookmarks

    LOCAL bm TYPE FILE*

    IF LEN(Gopher_Bookmark$) > 0 THEN
        OPEN GETENVIRON$("HOME") & "/.gopher.txt" FOR WRITING AS bm
            WRITELN Gopher_Bookmark$ TO bm
        CLOSE FILE bm
    ENDIF

END SUB

'--------------------------------------------------------------------------------

' Initialize action sequence
FOR i = 0 TO ACTIONHISTORY - 1
    Action_Sequence[i] = -1
    Action_Query$[i] = ""
    Action_Server$[i] = ""
NEXT

' Read bookmarks
IF FILEEXISTS(GETENVIRON$("HOME") & "/.gopher.txt") THEN
    IF FILELEN(GETENVIRON$("HOME") & "/.gopher.txt") >= 0 THEN
        OPEN GETENVIRON$("HOME") & "/.gopher.txt" FOR READING AS bm
            WHILE NOT(ENDFILE(bm)) DO
                READLN txt$ FROM bm
                IF NOT(ENDFILE(bm)) AND LEN(txt$) > 0 THEN Gopher_Bookmark$ = Gopher_Bookmark$ & txt$ & NL$
            WEND
        CLOSE FILE bm
    WEND
END IF

PRINT FILL$(SEPARATORSIZE, 45), NL$
PRINT SPC$(5), "*** BaCon Gopher Client 0.7 ***", NL$

Gopher_Port = 70

' 0 = file, 1 = listing
Action_Sequence[0] = 1
Action_Query$[0] = "\r\n"
Handle_Bookmarks

' Endless loop
WHILE TRUE DO

    data$ = Get_Data$(Action_Server$[0], Gopher_Port, Action_Query$[0])

    IF Action_Sequence[0] = 0 THEN
        Print_Data(data$)
    ELIF Action_Sequence[0] = 1 THEN
        Directory_List(data$)
    END IF

    ' Print user menu
    PRINT NL$, FILL$(SEPARATORSIZE, 45)
    PRINT MENUTEXT$
    PRINT FILL$(SEPARATORSIZE, 45)

    ' Input from user
    WHILE TRUE DO
        PRINT "Action: ";
        key1 = GETKEY
        SELECT key1
            CASE 27
                PRINT
                IF LEN(Gopher_Bookmark$) > 0 THEN Save_Bookmarks
                END
            CASE 127
                PRINT "BackSpace", NL$, FILL$(SEPARATORSIZE, 45), NL$
                Get_History
                BREAK
            CASE 32
                PRINT "Space", NL$, FILL$(SEPARATORSIZE, 45), NL$
                Handle_Bookmarks
                BREAK
            CASE 10
                IF NOT(INSTR(Gopher_Bookmark$, Action_Server$[0])) THEN
                    Gopher_Bookmark$ = Gopher_Bookmark$ & Action_Server$[0] & NL$
                    PRINT "Bookmark added!", NL$, FILL$(SEPARATORSIZE, 45), NL$
                ELSE
                    PRINT "Bookmark already exists!", NL$, FILL$(SEPARATORSIZE, 45), NL$
                FI
                BREAK
        ENDSELECT

        IF key1 < 97 OR key1 > 122 THEN
                PRINT "Wrong key! Start with a-z."
            ELSE
                PRINT CHR$(key1);
                ' Check input
                key2 = GETKEY
            IF key2 < 48 OR key2 > 57 THEN
                PRINT "Second key should be 0-9."
            ELSE
                PRINT CHR$(key2), NL$, FILL$(SEPARATORSIZE, 45), NL$
                Parse_Input (data$, key1, key2)
                BREAK
            END IF
        ENDIF
    WEND
WEND