'***********************************************************************'
'  PG-CODE - Written by Peter Gonzalez <pbgonz@mail.wm.edu>, 1994       '
'                                                                       '
'                                                                       '
'  This works just like MIME or UUENCODE; it converts binary files into '
' Email-suitable text files.  It's slow and cheap, but it's a great way '
' to send a UUENCODE translator to a friend who doesn't have one!       '
'***********************************************************************'

REM Making this larger may improve performance, but the program will require
REM more memory to run.
CONST BufferSize = 5000
CONST CharsPerLine = 65    ' Changing this will be problematic

DIM Buffer(BufferSize) AS STRING * 1
DIM JK AS STRING * 1
DIM JK2 AS STRING * 1
DIM Delim AS STRING * 1
DIM FileCount AS LONG
DIM FileCount2 AS LONG
DIM FileSize AS LONG
DIM CheckSum AS INTEGER

ON ERROR GOTO ErrorHandler

'***********************************************************************'
'                                Main Menu                              '
'***********************************************************************'
MainMenu:

DO
  COLOR 15, 1: CLS
  PRINT "Welcome to PG-CODE!    By Pete Gonzalez <pbgonz@mail.wm.edu>"
  PRINT "-------------------": PRINT
  PRINT "This is one of those things provided 'as-is'."
  PRINT "Make backups of your originals, since things tend to get"
  PRINT "overwritten when you mistype the name.": PRINT
  PRINT "[E]ncode"
  PRINT "[D]ecode"
  PRINT "[Q]uit": PRINT
  PRINT "Your choice: ";

   Choice$ = INPUT$(1): Choice$ = UCASE$(Choice$)
  IF Choice$ = "E" THEN GOTO Encode
  IF Choice$ = "D" THEN GOTO Decode
LOOP UNTIL Choice$ = "Q"
PRINT "Quit"
COLOR 7, 0: PRINT : PRINT
END

'***********************************************************************'
'                                 Encode                                '
'***********************************************************************'
Encode:
PRINT "Encode": PRINT : PRINT

REM All files are called FileName$ when being open so the Error Handler
REM can know their name

INPUT "File to start with: ", FileName$: OriginalFile$ = UCASE$(FileName$)
OPEN FileName$ FOR INPUT AS #1: CLOSE #1  ' Avoid overwriting something
OPEN FileName$ FOR BINARY AS #1

FileSize = LOF(1)

INPUT "Output (encoded) filename: (I will add the .PG) ", FileName$
FileName$ = FileName$ + ".PG"
OPEN FileName$ FOR OUTPUT AS #2

FileName$ = "~"

' First, write the header:
PRINT #2, "Copy the text below this line into your Email message:"
PRINT #2, STRING$(75, "-"): PRINT #2, "&&&&&"
PRINT #2, "PG-CODE Version 1.0"
PRINT #2, "File Name: *"; OriginalFile$; "^"
PRINT #2, "File Size: #"; FileSize; "^"
PRINT #2, "["; : PRINT : PRINT

ColumnCount = 1  ' so we know when to go to the next line
CheckSum = 0  ' Check for errors

FOR X = 0 TO FileSize - 1
  IF X MOD 300 = 0 OR FileSize - X < 3 THEN
    LOCATE CSRLIN - 1, 1
    PRINT "Working... "; INT(100 * X / (FileSize - 1)); "% "
  END IF
  ' Read bytes into buffer
  GET #1, X + 1, Buffer(X MOD (BufferSize - 1))

  ' After buffer fills up, dump it
  IF ((X + 1) MOD (BufferSize - 1) = 0) THEN
    FOR Y = 0 TO BufferSize - 2
      B = ASC(Buffer(Y)): CheckSum = ((CheckSum * 2) + 256 - B) MOD 10000
     
      ' Write HI and LO nibble of B:
      PRINT #2, CHR$(ASC("A") + INT(B / 16)); CHR$(ASC("a") + (B MOD 16));
      
      ColumnCount = ColumnCount + 2
      IF ColumnCount > CharsPerLine THEN
        ColumnCount = 1
        PRINT #2, "]"; CheckSum MOD 1000; "^": PRINT #2, "[";
      END IF
    NEXT Y
  END IF
NEXT X

'Write the rest, if there is any
IF ((X - 1) MOD (BufferSize - 1) <> 0) THEN
  FOR Y = 0 TO ((X - 1) MOD (BufferSize - 1))
    B = ASC(Buffer(Y)): CheckSum = ((CheckSum * 2) + 256 - B) MOD 10000
    PRINT #2, CHR$(ASC("A") + INT(B / 16)); CHR$(ASC("a") + (B MOD 16));
    ColumnCount = ColumnCount + 2
    IF ColumnCount > CharsPerLine THEN
      ColumnCount = 1
      PRINT #2, "]"; CheckSum MOD 1000; "^": PRINT #2, "[";
    END IF
  NEXT Y
END IF

PRINT #2, "/]"; CheckSum MOD 1000; "^": PRINT #2, STRING$(75, "-")
PRINT #2, "End of PG-encoded file.": CLOSE #1: CLOSE #2
PRINT : PRINT "Press a key...": A$ = INPUT$(1)
GOTO MainMenu

'***********************************************************************'
'                                 Decode                                '
'***********************************************************************'
Decode:
PRINT "Decode": PRINT : PRINT

INPUT "File to decode: (I will add the .PG) "; FileName$
FileName$ = FileName$ + ".PG"
OPEN FileName$ FOR INPUT AS #1: CLOSE #1
OPEN FileName$ FOR BINARY AS #1: FileCount = 1
       
'''' First, find the "&&&&&" header
Delim = "&": X = 1  ' X = Count of &'s
GOSUB ReadJunkUntilDelim

DO
  GET #1, FileCount, JK: FileCount = FileCount + 1
  IF JK = "&" THEN X = X + 1 ELSE GOSUB ReadJunkUntilDelim: X = 1
LOOP UNTIL X > 4

'''' Then, read file name and size
Delim = "*": GOSUB ReadJunkUntilDelim   ' Name
GOSUB ReadChunk: FileName$ = Chunk$
Delim = "#": GOSUB ReadJunkUntilDelim   ' Size
GOSUB ReadChunk: FileSize = VAL(Chunk$): PRINT

PRINT "Would you like to extract '" + FileName$ + "' of size"; FileSize; "? ";
DO
  Choice$ = INPUT$(1): Choice$ = UCASE$(Choice$)
  IF Choice$ = "N" THEN RETURN
LOOP UNTIL Choice$ = "Y"

'''' Delete old file:
ON ERROR GOTO SkipErr  ' disable for the kill
KILL FileName$
SkipErr:
PRINT : PRINT : ON ERROR GOTO ErrorHandler  ' reenable

'''' Open the new one
OPEN FileName$ FOR BINARY AS #2: FileCount2 = 1: FileName$ = "~"

'''' Write out the data
CheckSum = 0: Delim = "[": GOSUB ReadJunkUntilDelim

DO
TryAgain:
 
  IF FileCount2 MOD 300 = 0 OR FileSize - FileCount2 < 3 THEN
    LOCATE CSRLIN - 1, 1
    PRINT "Working... "; INT(100 * (FileCount2 - 1) / FileSize); "% "
  END IF

  GET #1, FileCount, JK: FileCount = FileCount + 1

  IF JK = "]" THEN  ' end of line symbol
    GOSUB ReadChunk
    IF VAL(Chunk$) <> CheckSum MOD 1000 THEN
      PRINT "ERROR: Checksum error at file offset "; FileCount
      COLOR 7, 0: END
    END IF
    Delim = "[": GOSUB ReadJunkUntilDelim: GOTO TryAgain
  END IF
  IF JK = "/" THEN  ' end of file symbol
    ' do the final checksum
    Delim = "]": GOSUB ReadJunkUntilDelim: GOSUB ReadChunk
    IF VAL(Chunk$) <> CheckSum MOD 1000 THEN
      PRINT "ERROR: Checksum error at file offset "; FileCount
      COLOR 7, 0: END
    END IF
    GOTO Okay
  END IF

  GET #1, FileCount, JK2: FileCount = FileCount + 1

  ' assemble the original byte
  B1 = ASC(JK) - ASC("A"): B2 = ASC(JK2) - ASC("a")
  IF B1 < 0 OR B1 > 15 OR B2 < 0 OR B2 > 15 THEN
    PRINT "ERROR: Error in input file at offset "; FileCount
    COLOR 7, 0: END
  END IF
  JK = CHR$(B1 * 16 + B2)
  CheckSum = ((CheckSum * 2) + 256 - ASC(JK)) MOD 10000
 
  ' write it
  PUT #2, FileCount2, JK: FileCount2 = FileCount2 + 1
LOOP UNTIL FileCount2 > FileSize + 1

PRINT "ERROR: Error in file size; output file truncated."

Okay: CLOSE #1: CLOSE #2
PRINT : PRINT "Okay.": PRINT "Press a key...": A$ = INPUT$(1)
GOTO MainMenu

'***********************************************************************'
'                                Error Handler                          '
'***********************************************************************'
ErrorHandler:
  IF FileName$ <> "~" THEN
    PRINT "ERROR: Unable to access "; CHR$(34); UCASE$(FileName$); CHR$(34)
  ELSE
    PRINT "ERROR: Problems accessing one of the files"
  END IF
END

'*************
' Subroutines

ReadJunkUntilDelim:
DO
  GET #1, FileCount, JK: FileCount = FileCount + 1
  IF ASC(JK) = 26 OR ASC(JK) = 0 THEN
    IF Delim = "&" THEN
      PRINT "ERROR: This file contains no PG-encoded information"
      COLOR 7, 0: END
    ELSE
      PRINT "ERROR: Unexpected end of file": COLOR 7, 0: END
    END IF
  END IF
LOOP UNTIL JK = Delim
RETURN

ReadChunk:
Chunk$ = ""
DO
  GET #1, FileCount, JK: FileCount = FileCount + 1
  IF JK <> "^" THEN Chunk$ = Chunk$ + JK
LOOP UNTIL JK = "^"
RETURN