Media Share 9/MEDIASHARE_09.ISO/progmisc/postit61.zip/POSTIT61.BAS

BASIC Source File | 1993-07-04 | 25KB | 927 lines

DECLARE FUNCTION Analyze% (Filename$)
DECLARE FUNCTION CheckForFile& ()
DECLARE SUB ExtractFile ()
DECLARE FUNCTION GetInformation% ()
DECLARE FUNCTION GetInput$ (Prompt$, MaxLen%)
DECLARE SUB Initialize ()
DECLARE SUB JustDoIt ()
DECLARE SUB MrFilter ()
DECLARE SUB MsgSplit (Filename$, TheName$, OutN$, LPP%, Reserve%)
DECLARE FUNCTION Num2Str$ (a%)
DECLARE FUNCTION ParseFileName$ ()
DECLARE SUB PrepareFile ()
DECLARE SUB PrintDecoder ()
DECLARE SUB PrintLine (a$)
DECLARE SUB ProcessLine (In$)
DECLARE SUB PutByte (a%)
DECLARE SUB PutBytes (a%)
DECLARE SUB ShortCopyright ()
DECLARE SUB Twirl ()
'===========================================================================
'BBS: FliegWeg BBS
'Date: 06-01-93 (22:54)             Number: 864
'From: VICTOR YIU                   Refer#: NONE
'  To: ALL                           Recvd: NO
'Subj: PostIt! 6.1 --> 1/11           Conf: (19) QuickBasic
'---------------------------------------------------------------------------
'Hi, All!

'    I'm proud to present the new version of PostIt!  I've tried to make
'everything as painless as possible.  From now on, you can just run everything
'through PostIt!, to encode and to decode.  Messages and binary.  Enjoy!
'    By the way, the source code is only 22K, compared to 36K previously!

'Victor
'______O_/__________________| SNIP |__________________\_O______
'      O \                  | HERE |                  / O
'This file created by PostIt! v6.1.
'>>> Start of page 1.

'╔═══════════════════════════════════════════════════════╗
'║   PostIt! 6.1   THE Binary <-> BASIC Script Creator   ║
'╟───────────────────────────────────────────────────────╢
'║      Rich Geldreich, Jim Giordano, Mark H Butler,     ║
'║   Quinn Tyler Jackson, Scott Wunsch, and Victor Yiu.  ║
'╚═══════════════════════════════════════════════════════╝
'
'Purpose:
' To enable the posting of compressed listings on a text only net.
' This program takes a binary input file and converts it to a series
' of small, postable files which other people can capture and run to
' get the original binary file.  Do not post text files in binary
' PostIt! form, though.
'
' New 6.1 features:
'   o  Automatic decoding/filtering of text-scripts
'   o  Automatic extraction of binary scripts
'   o  Decreased source-code size
'
' New huge script capability to be added in a future version

DEFINT A-Z

CONST True = -1, False = NOT True
CONST LineLength = 65    ' please don't change this for safety

DIM SHARED Shift(6), Proplr$, BytesOut, TotalLinesOut, LinesOut
DIM SHARED PageLength, CurrentPage, FileLength, TabStops
DIM SHARED SourceFile$, DestFile$, RealSource$, aLength
DIM SHARED Row, Col, CheckSum, CurrentByte, CurrentBit, Char
DIM SHARED Work$, ComprChar$, Qt$, Prefix$, DefaultFile$

Good$ = "abcdefghijklmnopqrstuvwxyz"
Good$ = Good$ + UCASE$(Good$) + "0123456789#$"

Initialize
Func = GetInformation

SELECT CASE Func
    CASE 1
        ExtractFile
    CASE 2
        MrFilter
    CASE 3
        PrepareFile     ' open file, print header, etc.
        JustDoIt        ' do the binary stuff
        PrintDecoder    ' print decoder, close file

        LOCATE Row, Col
        PRINT "          "
        PRINT
        PRINT TotalLinesOut; "lines in"; CurrentPage;
        PRINT "file(s) written."
    CASE 4
        MsgSplit SourceFile$, RealSource$, DestFile$, PageLength, LinesOut
END SELECT

END

ErrorRead:
    PRINT "Error reading script."
    END


'______O_/__________________| SNIP |__________________\_O______
'      O \                  | HERE |                  / O

'That's all, folks!  All you have to do to get PostIt! 6.1 working is to
'clump all the messages together, headers and all, and run them through
'Mr. Filter.  Fortunately (and unfortunately for me -- I've just killed another
'one of my programs <G>  i.e. MessageSplit), it will be the last time you'll
'have to use it.  Everything should be able to be automated with PostIt!.

'Comments and suggestions greatly welcome!

'Victor

'... To a cat, "NO!" means "Not while I am looking"
'--- Blue Wave/RA v2.12 [NR]
' * Origin: Hard Disc Cafe | Houston Texas | [phone] |  (1:106/30.0)

FUNCTION Analyze (Filename$)
' 1=PostIt! binary
' 2=PostIt! text
' 3=regular binary
' 4=regular text

a = 4096
IF LOF(1) < a THEN a = LOF(1)
a$ = INPUT$(a, 1)

a = INSTR(a$, "C" + "LS:?STRING$(50,178):DEFINT A-Z 'Created by" + " PostIt! 6.")
IF a THEN
    CheckSum = a   ' use it to pass the start to decoder
    Analyze = 1
    EXIT FUNCTION
END IF

a = INSTR(a$, "'" + ">>> Start of page")
IF a THEN
    Analyze = 2
    CheckSum = a    ' use to pass it to Mr. Filter
    EXIT FUNCTION
END IF

Analyze = 4
FOR a = 1 TO 20
    Ch$ = MID$(a$, a, 1)
    IF LEN(Ch$) THEN
        Ch = ASC(Ch$)
        SELECT CASE Ch
            CASE 10, 13
            CASE IS < 32
                Analyze = 3: EXIT FOR
            CASE IS > 127
                HiASCII = HiASCII + 1
        END SELECT
    ELSE EXIT FOR
    END IF
NEXT
IF HiASCII > 12 THEN Analyze = 3

END FUNCTION

FUNCTION CheckForFile&

OPEN SourceFile$ FOR BINARY AS #1
a& = LOF(1)
IF a& = 0 THEN
    CLOSE
    KILL SourceFile$
    COLOR 7: PRINT "   File not found."
END IF
CheckForFile& = a&

END FUNCTION

SUB ExtractFile
SHARED Good$

COLOR 7: PRINT : PRINT "Examining "; SourceFile$; "..."

ON ERROR GOTO ErrorRead

CLOSE : OPEN SourceFile$ FOR INPUT AS #1 LEN = 4096
SEEK #1, CheckSum
LINE INPUT #1, a$   'remove start line
LINE INPUT #1, a$

Temp = INSTR(a$, ",1,")
IF Temp = 0 THEN GOTO ErrorReading
NewFile$ = MID$(a$, Temp + 4)
OPEN NewFile$ FOR BINARY AS #2

PRINT "Loading "; SourceFile$; "..."

LINE INPUT #1, a$   'remove T$
DO
    IF EOF(1) THEN GOTO ErrorReading

    LINE INPUT #1, a$

    SELECT CASE LEFT$(a$, 1)
        CASE "G"
            IF NOT QuoteOn THEN
                a$ = MID$(a$, 3)
                IF RIGHT$(a$, 1) = Qt$ THEN a$ = LEFT$(a$, LEN(a$) - 1)

                FOR Q = 2 TO 9       ' expand the string
                    Look$ = MID$(ComprChar$, Q - 1, 1)
                    S = 1
                    DO
                        S = INSTR(S, a$, Look$)
                        IF S THEN
                            a$ = LEFT$(a$, S - 1) + STRING$(Q, 97) + MID$(a$, S + 1)
                        END IF
                    LOOP WHILE S
                NEXT

                Dat$ = Dat$ + RTRIM$(a$)
            END IF
        CASE "'"

            QuoteOn = NOT QuoteOn
        CASE ELSE                ' just comments or junk
            IF NOT QuoteOn THEN
                IF (MID$(a$, 2, 1) = "=") AND INSTR(a$, "Bad") THEN EXIT DO
            END IF
    END SELECT
LOOP

n = VAL(MID$(a$, 3))             ' extract size of file

Temp = INSTR(a$, "$)<>")
IF Temp = 0 THEN GOTO ErrorReading
IF LEN(Dat$) <> VAL(MID$(a$, Temp + 4)) THEN GOTO ErrorReading
LINE INPUT #1, a$
LINE INPUT #1, a$
LINE INPUT #1, a$
CheckVal = VAL(MID$(a$, 8))
CLOSE #1

PRINT "Decoding "; SourceFile$; "..."
PRINT STRING$(50, 178);     ' print initial bar
LOCATE , , 0

k = 255: V! = 50 / n

FOR a = 1 TO n          ' decode file
    IF L = 0 THEN
        GOSUB G: L = 6
        LOCATE , 1: PRINT STRING$(V! * a, 177);
    END IF

    W = T \ Shift(6 - L): GOSUB G: W = W OR T * Shift(L)
    L = L - 2: B$ = CHR$(W AND k)
    PUT 2, , B$
NEXT

PRINT
PRINT
IF (C = CheckVal) AND (LOF(2) = n) THEN
    PRINT NewFile$; " successfully extracted."
ELSE
    PRINT "Bad checksum or incomplete script!"
END IF

CLOSE
END

G:
    I = I + 1: T = INSTR(Good$, MID$(Dat$, I, 1)) - 1
    C = (C + T) * 2: C = C \ 256 + (C AND 255)
RETURN

ErrorReading:
    PRINT "Error reading script."
    END
END SUB

FUNCTION GetInformation

    '**** Remark the below for QBasic ***
Temp$ = LTRIM$(RTRIM$(COMMAND$))

ShortCopyright

DO
    IF LEN(Temp$) = 0 THEN
        SourceFile$ = UCASE$(GetInput$("Input filename" + " (text/binary)? ", -1))
    ELSE
        SourceFile$ = Temp$: Temp$ = ""
    END IF

    IF LEN(SourceFile$) THEN a& = CheckForFile ELSE END
LOOP UNTIL a&
PRINT : DefaultFile$ = ParseFileName$

Recommend = Analyze(SourceFile$)
IF Recommend <= 2 THEN GetInformation = Recommend: EXIT FUNCTION

COLOR 15: PRINT "I recommend using the ";
COLOR 13
IF Recommend = 3 THEN
    PRINT "binary script (Y)";
    R$ = "Y"
ELSE

    PRINT "message wrapper (N)";
    R$ = "N"
END IF
COLOR 15: PRINT " on this file."

WhatFmt$ = UCASE$(GetInput$("Which format [" + R$ + "]? ", 1))
IF (WhatFmt$ <> "Y") AND (WhatFmt$ <> "N") THEN WhatFmt$ = R$
LOCATE CSRLIN - 1, 19
PRINT WhatFmt$

IF WhatFmt$ = "Y" THEN
    IF a& > 24000 THEN
        COLOR 7: PRINT
        PRINT "Sorry -- PostIt! doesn't support huge scripts" + " yet."
        END
    END IF
    Recommend = 3
    FileLength = a&
ELSE
    Recommend = 4
END IF

a$ = "What is the destination prefix (max. 6 chars.) ["
DestFile$ = UCASE$(GetInput$(a$ + DefaultFile$ + "]? ", 6))
IF LEN(DestFile$) = 0 THEN
    DestFile$ = DefaultFile$
    LOCATE CSRLIN - 1, 52 + LEN(DefaultFile$)
    PRINT DefaultFile$
END IF

PRINT
IF Recommend = 4 THEN
    TabStops = VAL(GetInput$("Expand tabs to how many spaces" + " [4]? ", 1))
    IF TabStops <= 0 THEN
        TabStops = 4
        LOCATE CSRLIN - 1, 36
        PRINT TabStops
    END IF
END IF

PageLength = VAL(GetInput$("Page length [85]? ", 3))
IF PageLength < 5 THEN
    PageLength = 85
    LOCATE CSRLIN - 1, 19
    PRINT "85 "
END IF

LinesOut$ = GetInput$("Lines to reserve on first message [5]? ", 2)
LinesOut = VAL(LinesOut$)
IF (LEN(LinesOut$) = 0) OR (LinesOut < 0) THEN
    LinesOut = 5
    LOCATE CSRLIN - 1, 40
    PRINT "5 "
END IF

LOCATE , , 0
GetInformation = Recommend

END FUNCTION

FUNCTION GetInput$ (Prompt$, MaxLen)

Null$ = CHR$(0): SpaceBar$ = " "
IF MaxLen < 1 THEN MaxLen = 80 - LEN(Prompt$) - POS(0)

COLOR 14: PRINT Prompt$;
StartX = POS(0): Cursor = 1
COLOR 7

DO
    IF Updt THEN
        LOCATE , StartX, 0
        PRINT OutS$; SpaceBar$;
        Updt = False
    END IF

    LOCATE , Cursor + StartX - 1, 1, 0, 16
    DO: I$ = INKEY$
    LOOP UNTIL LEN(I$)

    IF LEN(I$) = 1 THEN
        Updt = True

        SELECT CASE ASC(I$)
        CASE IS >= 32
            IF (LEN(OutS$) < MaxLen) OR (NOT Insrt AND (Cursor <= MaxLen)) THEN
                IF Cursor > 0 THEN
                    OutS$ = LEFT$(OutS$, Cursor - 1) + I$ + MID$(OutS$, Cursor - (NOT Insrt))
                ELSE
                    OutS$ = I$
                END IF
                Cursor = Cursor + 1
            ELSE
                Updt = False
            END IF
        CASE 8
            IF LEN(OutS$) AND (Cursor > 1) THEN
                OutS$ = LEFT$(OutS$, Cursor - 2) + MID$(OutS$, Cursor)
                Cursor = Cursor - 1
            ELSE
                Updt = False
            END IF
        CASE 13
            EXIT DO
        CASE 27
            IF LEN(OutS$) > 0 THEN
                LOCATE , StartX, 0
                PRINT SPACE$(LEN(OutS$) + 1);

                OutS$ = ""
                Cursor = 1
                Updt = False
            ELSE
                EXIT DO
            END IF
        END SELECT
    END IF
LOOP

LOCATE , , 1, 0, 16: PRINT
GetInput$ = LTRIM$(RTRIM$(OutS$))

END FUNCTION

SUB Initialize

LOCATE , , 0
FOR DefShift = 0 TO 6: Shift(DefShift) = 2 ^ DefShift: NEXT

ComprChar$ = "()*+,-./": Proplr$ = CHR$(179) + "/-\"
Qt$ = CHR$(34): a$ = " "

CurrentPage = 1: CurrentBit = 0: Char = 0

END SUB

SUB JustDoIt

SEEK #1, 1
LinesOut = LinesOut + 2     ' compensate for header
TotalLinesOut = 3
DO
    CurrentByte = SEEK(1)
    L& = FileLength - CurrentByte + 1 ' what's left?
    SELECT CASE L&
        CASE IS > 4096
            Block$ = SPACE$(4096)
        CASE IS <= 0
            EXIT DO
        CASE ELSE
            Block$ = SPACE$(L&)     ' rest of it
    END SELECT
    GET #1, , Block$

    FOR Pointr = 1 TO LEN(Block$)
        IF (Pointr AND 15) = 0 THEN
            CurrentByte = CurrentByte + 16
            Twirl
        END IF
        PutBytes ASC(MID$(Block$, Pointr, 1))
    NEXT
LOOP

    'flush the input buffer if it contains any bits
IF CurrentBit > 0 THEN
    CurrentBit = -1: PutByte Char

END IF

IF aLength > 0 THEN
    IF aLength = 1 THEN
        Work$ = Work$ + "a"
    ELSE
        Work$ = Work$ + MID$(ComprChar$, aLength - 1, 1)
    END IF
END IF

IF LEN(Work$) > 2 THEN
    'flush the line buffer if it contains any characters
    PrintLine Work$ + Qt$
END IF

END SUB

SUB MrFilter

Temp = INSTR(DefaultFile$, ".")
IF Temp THEN
    D$ = LEFT$(DefaultFile$, Temp) + ".OUT"
ELSE
    D$ = DefaultFile$ + ".OUT"
END IF

DestFile$ = UCASE$(GetInput$("Output filename [" + D$ + "]? ", 6))
IF LEN(DestFile$) = 0 THEN
    DestFile$ = D$
    LOCATE CSRLIN - 1, 21 + LEN(D$), 0
    PRINT D$
END IF

CLOSE : OPEN SourceFile$ FOR INPUT AS #1
OPEN DestFile$ FOR OUTPUT AS #2
SEEK #1, CheckSum

PRINT : PRINT "Working...";

Flip = 1
ChopOut = False

DO WHILE NOT EOF(1)
    LINE INPUT #1, L$
    L$ = RTRIM$(L$)

    IF LEN(L$) THEN
        IF ASC(L$) = 39 THEN
            IF LEFT$(L$, 22) = "'>>> Continued on page" THEN
                ChopOut = True
                SEEK #2, SEEK(2) - 2
            ELSEIF LEFT$(L$, 18) = "'>>> Start of page" THEN
                ChopOut = False
                IF SEEK(1) <> Start THEN SEEK #1, SEEK(1) + 2
            ELSEIF LEFT$(L$, 12) = "'________O_/" THEN
                ChopOut = True
            ELSE
                IF NOT ChopOut THEN ProcessLine L$
            END IF
        ELSEIF NOT ChopOut THEN
            IF NOT ChopOut THEN ProcessLine L$
        END IF
    ELSE
        IF NOT ChopOut THEN PRINT #2,
    END IF
LOOP
CLOSE                       ' close the files

LOCATE , 1
PRINT "Complete!      "
END

END SUB

SUB MsgSplit (Filename$, TheName$, OutN$, LPP, Reserve)

CLOSE : OPEN Filename$ FOR INPUT AS #1

Tab$ = CHR$(9)
LinesOut = Reserve + 1
FileOutNum = 1: OnMsgNumber = 1
LPP = LPP - 4               ' lines per page
LOFile& = LOF(1)

Base$ = LEFT$(OutN$, 6)

COLOR 7, 0: PRINT
DO
    OutN$ = Base$ + Num2Str$(FileOutNum)

    IF Row THEN LOCATE Row, Col: PRINT "         "
    PRINT "Now writing: "; OutN$; ".PI ";
    Row = CSRLIN: Col = POS(0)

    OPEN OutN$ + ".PI" FOR OUTPUT AS #2

    IF OnMsgNumber > 1 THEN
        PRINT #2, "'>>> Start of page"; STR$(OnMsgNumber); "."
        PRINT #2,
    ELSE
        GOSUB Snip
        PRINT #2, "'This file created by PostIt! v6.1."
        PRINT #2, "'>>> Start of page"; STR$(OnMsgNumber); "."
        PRINT #2,
    END IF

    TooLong = False
    FOR Trans = LinesOut TO LPP
        IF (Trans AND 3) = 0 THEN
            Percent = (100& * SEEK(1)) \ LOFile&
            Twirler$ = MID$(Proplr$, (Percent AND 3) + 1, 1)
            LOCATE Row, Col: PRINT USING "! ###%"; Twirler$; Percent;
        END IF

        IF NOT EOF(1) THEN
            IF Trans = LinesOut THEN
                DO
                    IF EOF(1) THEN
                        CLOSE
                        KILL OutN$ + ".PI"
                        OutN$ = Base$ + Num2Str$(FileOutNum - 1)
                        OPEN OutN$ + ".PI" FOR APPEND AS #2
                        SEEK #2, LOF(2) - 26 - (FileOutNum > 9)
                        GOSUB Snip
                        CLOSE
                        EXIT DO
                    END IF
                    LINE INPUT #1, Buf$
                LOOP WHILE LEN(Buf$) = 0
                IF LEN(Buf$) = 0 THEN EXIT DO
            ELSE
                LINE INPUT #1, Buf$
                Buf$ = RTRIM$(Buf$)
            END IF

            Tb = INSTR(Buf$, Tab$)  'remove chr$(8)s (tabs)
            IF Tb THEN
                DO
                    Temp = (Tb - 1) MOD TabStops
                    IF Temp = 0 THEN Temp = TabStops
                    Buf$ = LEFT$(Buf$, Tb - 1) + SPACE$(TabStops - Temp) + MID$(Buf$, Tb + 1)
                    Tb = INSTR(Tb, Buf$, Tab$)
                LOOP WHILE Tb
            END IF

Wrapping:
            IF (LEN(Buf$) > LineLength) AND (LEFT$(Buf$, 1) <> "'") THEN
                Trans = Trans + 1
                CommentOn = False
                FOR a = LineLength TO 40 STEP -1
                    IF MID$(Buf$, a, 1) = " " THEN
                        WrapPoint = a
                        EXIT FOR
                    END IF
                NEXT
                IF WrapPoint = 0 THEN WrapPoint = LineLength

                QuotesOn = False
                FOR a = 1 TO WrapPoint
                    Temp$ = MID$(Buf$, a, 1)
                    IF Temp$ = Qt$ THEN
                        QuotesOn = NOT QuotesOn
                    ELSEIF NOT QuotesOn THEN
                        IF (Temp$ = "'") OR (UCASE$(MID$(Buf$, a, 4)) = "REM ") THEN
                            CommentOn = True
                            EXIT FOR
                        END IF
                    END IF

                NEXT

                Long$ = Buf$
                IF CommentOn THEN
                    Buf$ = LEFT$(Buf$, WrapPoint - 1)
                ELSE
                    IF QuotesOn THEN
                        Buf$ = LEFT$(Buf$, WrapPoint - 1) + Qt$ + "+_"
                    ELSE
                        Buf$ = LEFT$(Buf$, WrapPoint - 1) + "_"
                    END IF
                END IF

                IF NOT ((Trans = LPP) AND LEN(Buf$) = 0) THEN
                    PRINT #2, Buf$
                END IF

                Buf$ = MID$(Long$, WrapPoint)
                IF CommentOn THEN Buf$ = "'" + Buf$
                IF QuotesOn THEN Buf$ = Qt$ + Buf$

                GOTO Wrapping
            END IF

            IF NOT ((Trans = LPP) AND LEN(Buf$) = 0) THEN
                PRINT #2, Buf$
            END IF
        END IF
    NEXT
    IF NOT EOF(1) THEN
        PRINT #2,
        PRINT #2, "'>>> Continued on page"; OnMsgNumber + 1

        OnMsgNumber = OnMsgNumber + 1
        FileOutNum = FileOutNum + 1
        LinesOut = 1
    ELSE
        PRINT #2,
        GOSUB Snip
        PRINT #2,
    END IF

    CLOSE #2
LOOP UNTIL EOF(1)
CLOSE

LOCATE Row, Col
PRINT "         "
PRINT
PRINT "Complete!"
END

Snip:
    PRINT #2, "'______O_/__________________| SNIP" + " |__________________\_O______"
    PRINT #2, "'      O \                  | HERE |             " + "     / O"
RETURN

END SUB

FUNCTION Num2Str$ (a)
    Num2Str$ = MID$(STR$(a), 2)
END FUNCTION

FUNCTION ParseFileName$

FOR S = LEN(SourceFile$) TO 1 STEP -1
    IF INSTR("\:", MID$(SourceFile$, S, 1)) THEN EXIT FOR
NEXT
RealSource$ = MID$(SourceFile$, S + 1)

Ext = INSTR(RealSource$, ".")
IF Ext <> 0 THEN
    DestTemp$ = LEFT$(RealSource$, Ext - 1)
ELSE
    DestTemp$ = RealSource$
END IF

ParseFileName = UCASE$(LEFT$(DestTemp$, 7))

END FUNCTION

SUB PrepareFile


F$ = UCASE$(DestFile$ + Num2Str$(CurrentPage) + ".BAS")
CheckSum = 0

COLOR 7: PRINT
PRINT "Now writing: "; F$; " ";
Row = CSRLIN: Col = POS(0)

OPEN F$ FOR OUTPUT AS #2 LEN = 8192     ' use 8K buffer

PRINT #2, "C";
PRINT #2, "LS:?STRING$(50,178):DEFINT A-Z 'Created by PostIt!" + " 6.1"
PRINT #2, "FOR A=0 TO 6:P(A)=2^A:NEXT:OPEN "; Qt$; "B"; Qt$; ",1,"; Qt$; RealSource$
PRINT #2, "T$="; Qt$; "abcdefghijklmnopqrstuvwxyz"; Qt$; ":T$=T$+UCASE$(T$)+"; Qt$; "0123456789#$"

Prefix$ = "G" + Qt$
Work$ = Prefix$

END SUB

SUB PrintDecoder

PrintLine "N=" + Num2Str$(FileLength) + ":K=255:IF LEN(C$)<>" + Num2Str$(BytesOut) + " THEN ?" + Qt$ + "Bad script!" + Qt$ + ":END"
PrintLine "FOR A=1 TO N:LOCATE 1:?STRING$(50/N*A,177):IF L=0" + " THEN GOSUB G:L=6"
PrintLine "W=T\P(6-L):GOSUB G:W=W OR T*P(L):L=L-2:B$=CHR$(W AND" + " K):PUT 1,,B$:NEXT"
PrintLine "?:IF C=" + Num2Str$(CheckSum) + " THEN ?" + Qt$ + "Ok" + Qt$ + ":END ELSE ?" + Qt$ + "Bad checksum!" + Qt$ + ":END"
PrintLine "G:I=I+1:T=INSTR(T$,MID$(C$,I,1))-1:C=(C+T)*2:C=C" + "\256+(C AND 255):RETURN"
PrintLine "SUB G(A$):SHARED C$:FOR Q=2 TO" + " 9:DO:S=INSTR(A$,CHR$(Q+38))"
PrintLine "IF S THEN A$=LEFT$(A$,S-1)+STRING$(Q,97)+MID$(A$,S+1)"
PrintLine "LOOP WHILE S:NEXT:C$=C$+A$:END SUB"
CLOSE

END SUB

'Outputs one line to the output file, and opens another output file
'if the page length is exceeded.
SUB PrintLine (a$)
STATIC NewFileFlag

IF NewFileFlag THEN
    LOCATE Row, Col: PRINT "          "

    NewFileFlag = False
    CurrentPage = CurrentPage + 1
    B$ = Num2Str$(CurrentPage)
    PRINT #2, "'>> Continued on pg. "; B$
    CLOSE #2

    F$ = UCASE$(DestFile$ + B$ + ".BAS")

    PRINT "Now writing: "; F$; " ";
    Row = CSRLIN: Col = POS(0)

    OPEN F$ FOR OUTPUT AS #2 LEN = 8192

    PRINT #2, "'>> Start: pg. "; B$
    LinesOut = 1
END IF

PRINT #2, a$

TotalLinesOut = TotalLinesOut + 1
LinesOut = LinesOut + 1
IF LinesOut >= PageLength THEN NewFileFlag = True

END SUB

SUB ProcessLine (In$) STATIC   ' belongs to MrFilter

CONST Blank = " ", Plus = "+"

    IF Shave THEN
        In$ = MID$(In$, 2)
        Shave = False
    END IF


    In$ = Previous$ + In$
    Previous$ = ""
    IF ASC(RIGHT$(In$, 1)) = 95 THEN
        IF LEN(In$) > 2 THEN
            SELECT CASE LEFT$(RIGHT$(In$, 2), 1)
                CASE Blank
                CASE Plus
                    Previous$ = LEFT$(In$, LEN(In$) - 3)
                    Shave = True
                CASE ELSE
                    Previous$ = LEFT$(In$, LEN(In$) - 1)
            END SELECT
        END IF
    END IF

    IF LEN(Previous$) = 0 THEN
        PRINT #2, In$
    END IF

    LOCATE , 12
    PRINT MID$(Proplr$, Flip + 1, 1);
    Flip = (Flip + 1) AND 3

END SUB

'Adds a character to the output string.
SUB PutByte (a)
    SHARED Good$

IF CurrentBit < 0 THEN LastOne = True

BytesOut = BytesOut + 1

    'calculate a checksum on the encoded data stream
CheckSum = (CheckSum + a) * 2
CheckSum = CheckSum \ 256 + (CheckSum AND 255)

IF (a = 0) AND (LastOne = False) THEN
    IF aLength = 9 THEN
        aLength = 1
        Work$ = Work$ + "/"
    ELSE
        aLength = aLength + 1
    END IF
ELSE
    SELECT CASE aLength
    CASE 0
        'translate the output character into something safe
        Work$ = Work$ + MID$(Good$, a + 1, 1)
    CASE 1
        Work$ = Work$ + "a" + MID$(Good$, a + 1, 1)
        aLength = 0
    CASE ELSE
        Work$ = Work$ + MID$(ComprChar$, aLength - 1, 1) + MID$(Good$, a + 1, 1)
        aLength = 0
   END SELECT
END IF

IF LEN(Work$) >= LineLength THEN
    IF LEN(Work$) = LineLength THEN
        PrintLine Work$
        Work$ = Prefix$
    ELSE
        PrintLine LEFT$(Work$, LineLength)
        Work$ = Prefix$ + MID$(Work$, LineLength + 1)
    END IF
END IF

END SUB

SUB PutBytes (a)

    'shift the 8 bit character into the work buffer
Char = Char + a * Shift(CurrentBit)

    'we've got 8 more bits now
CurrentBit = CurrentBit + 8

    'write the 6 bit codes now
DO WHILE CurrentBit > 5          'have at least 6 bits left?
    PutByte Char AND 63          'write out the first 6 bits
    Char = Char \ 64             'shift it right 6 places
    CurrentBit = CurrentBit - 6  '6 bits less now
LOOP


END SUB

SUB ShortCopyright

COLOR 15, 0
CLS

PRINT "╔═══════════════════════════════════════════════════════╗"
PRINT "║   PostIt! 6.1   THE Binary <-> BASIC Script Creator   ║"
PRINT "╟───────────────────────────────────────────────────────╢"
PRINT "║      Rich Geldreich, Jim Giordano, Mark H Butler,     ║"
PRINT "║   Quinn Tyler Jackson, Scott Wunsch, and Victor Yiu.  ║"
PRINT "╚═══════════════════════════════════════════════════════╝"
PRINT
COLOR 12
PRINT "PostIt! 6.1 can:"
COLOR 13
PRINT "  o  Encode binary files as text"
PRINT "  o  Split messages and wrap lines"
PRINT "  o  Extract binary scripts"
PRINT "  o  Filter split messages to original state"
PRINT

END SUB

SUB Twirl STATIC

LOCATE Row, Col
PRINT MID$(Proplr$, Turn + 1, 1);
Turn = (Turn + 1) AND 3

IF Turn = 0 THEN
    PRINT USING " ###%"; 100& * CurrentByte \ FileLength;
END IF

END SUB