Echo BASIC - GSAVE.BAS

Area:    Quik_Bas
  Msg:    #285
 Date:    01-10-93 21:14 (Public) 
 From:    Matt Hart                
 To:      Keith Watkins            
 Subject: GSAVE.BAS

 KW> I like the idea of saving 64k of BSAVE to 8k and really need to be able

GSAVES.BAS is the wrong program.  It saves multiple screens 
to a single file, but doesn't compress them - and it has a 
bug too.  I'm going to work on it and add RLL compression 
to it.  For now, though, here's BSAVECP.BAS - the 
saver/restorer with compression.

' BSAVECP.BAS  by Matt Hart
' Compress a BSAVE/BLOAD file.  Requires enough far memory
' to temporarily store the compressed file.
'
' The example draws a picture in CGA, saves it, then restores it.
' With this example, the CGA screen saved very quickly AND only
' took 1700 bytes of disk space.  This was a much better result
' than I expected!  At 7.9 times the processor speed of an XT and
' 1.8 times the speed of an AT, the FindKey PLUS BSave took 1.2
' seconds.  At 35.2 times an XT, it took .55 seconds.
' The AsciiKey finder is included so you can use the best key - but
' it slows down the save routine some.
'
' Make sure NumBytes& is an even number.  Some modifications would
' be necessary for NumBytes& > 32K.  If one of the PEEK address'
' is > 32K, then add 2K to the segment and subtract 32K from the
' address.  Alternately add 1 to the segment and subtract 16 from the
' address after every 16 increments in the address.
'
    DEFINT A-Z
    SCREEN 1 : CLS
    LINE (0,0)-(319,199),1,B
    LINE (1,1)-(318,198),1,B
    CIRCLE (160,100),50,3
    PAINT (160,100),2,3
    BEEP : WHILE INKEY$="" : WEND       ' Ready to Save
    File$="EXAMPLE.BNC"
    StartSeg=&HB800 : StartAddr=0
    NumBytes&=16384&
    'AsciiKey = 1
    CALL FindKey(StartSeg,StartAddr,NumBytes&,AsciiKey)
    CALL BSaveCompress(File$,StartSeg,StartAddr,NumBytes&,AsciiKey)
    CLS
    BEEP : WHILE INKEY$="" : WEND       ' Saved - Ready to Re-load
    CALL BLoadCompress(File$,StartSeg,StartAddr)
    BEEP : WHILE INKEY$="" : WEND       ' Re-loaded - ready to end
    SCREEN 0 : WIDTH 80
    END
'
SUB BSaveCompress(File$,StartSeg,StartAddr,NumBytes&,AsciiKey)
    DimSize = NumBytes& \ 2
    REDIM Temp(1 to DimSize)
    ToSeg = VARSEG(Temp(1)) : ToAddr = VARPTR(Temp(1))
    CALL MemCopyCP(StartSeg,StartAddr,ToSeg,ToAddr,NumBytes&,_
                   NewNumBytes&,AsciiKey)
    DEF SEG = ToSeg
        BSAVE File$,ToAddr,NewNumBytes&
    DEF SEG
END SUB
'
SUB BLoadCompress(File$,ToSeg,ToAddr)
    F=FreeFile
    OPEN "B",1,File$ : NumBytes& = LOF(F)-12
    AsciiK$=" " : GET 1,LOF(F),AsciiK$ : AsciiKey=ASC(Asciik$)
    CLOSE 1
    DimSize = NumBytes& \ 2
    REDIM Temp(1 to DimSize)
    StartSeg = VARSEG(Temp(1)) : StartAddr = VARPTR(Temp(1))
    DEF SEG = StartSeg
        BLOAD File$,StartAddr
    DEF SEG
    CALL MemCopyUNCP(StartSeg,StartAddr,ToSeg,ToAddr,_
                     NumBytes&,AsciiKey)
END SUB
'
SUB MemCopyCP(FromSeg,FromAddr,ToSeg,ToAddr,NumBytes&,_
              NewNumBytes&,AsciiKey)
    FS=FromSeg : TS=ToSeg
    FA&=FromAddr : TA&=ToAddr : CB&=1 : N=0
    DEF SEG = FS       ' Get rid of an IF/THEN/ELSE and make it
        Y=PEEK(FA&)    ' faster - get's rid of the "First=-1" flag
    DEF SEG
    NewNumBytes&=0
DO
    DEF SEG = FS                ' Read the byte from memory
        Z=PEEK(FA&)
        FA&=FA&+1               ' If the From Address is over
        IF FA&>32767& THEN      ' 32K, then increase the segment
            FS=FS+2048          ' by 32K ( increase is actually
            FA&=FA&-32768&      ' 32K \ 16).
        ENDIF                   '
    DEF SEG
    IF Z <> Y THEN              ' A sequence of characters has ended
        DO UNTIL N < 256        ' Put in multiple codes for greater than
            DEF SEG = TS        ' 255 sequential bytes
                POKE TA&,AsciiKey : TA&=TA&+1
                POKE TA&,255      : TA&=TA&+1
                POKE TA&,Y        : TA&=TA&+1
                IF TA&>30719& THEN
                    TS=TS+1920
                    TA&=TA&-30720&
                ENDIF
            DEF SEG
            N=N-255
        LOOP
        IF N > 4 OR Y = AsciiKey THEN   ' so Put the Code
            DEF SEG = TS
                POKE TA&,AsciiKey : TA&=TA&+1
                POKE TA&,N        : TA&=TA&+1
                POKE TA&,Y        : TA&=TA&+1
            DEF SEG
            NewNumBytes&=NewNumBytes&+4
        ELSE
            FOR i=1 TO N               ' Otherwise, put the characters
                DEF SEG = TS
                    POKE TA&,Y : TA&=TA&+1
                DEF SEG
                NewNumBytes&=NewNumBytes&+1
            NEXT i
        ENDIF
        IF TA&>30719& THEN             ' Increment the ToAddress
            TS=TS+1920                 ' and check it's size.
            TA&=TA&-30720&
        ENDIF
        N=0                            ' Reset number of sequential
    ENDIF                              ' characters to zero
    Y=Z                                ' Current character
    N=N+1                              ' Current count
    CB&=CB&+1                          ' Counting the number of
LOOP UNTIL CB&>NumBytes&               ' bytes read so far
    IF N > 4 OR Y = AsciiKey THEN      ' Catch the last character or
        DEF SEG = TS                   ' character sequence
            POKE TA&,AsciiKey : TA&=TA&+1
            POKE TA&,N : TA&=TA&+1
            POKE TA&,Y : TA&=TA&+1
        DEF SEG
        NewNumBytes&=NewNumBytes&+4
    ELSE
        FOR i=1 TO N
            DEF SEG = TS
                POKE TA&,Y : TA&=TA&+1
            DEF SEG
            NewNumBytes&=NewNumBytes&+1
        NEXT i
    ENDIF
    DEF SEG = TS                          ' Here, the ASCIIKEY is
        POKE TA&,AsciiKey : TA&=TA&+1     ' stored at the end of
    DEF SEG                               ' the file
    NewNumBytes& = NewNumBytes& + NewNumBytes& MOD 2
    NewNumBytes& = NewNumBytes& + 1       ' This is done so that
END SUB                                   ' NewNumBytes& will make an
'                                         ' even DimSize in UNCP
'
'
SUB MemCopyUNCP(FromSeg,FromAddr,ToSeg,ToAddr,NumBytes&,_
                AsciiKey)
    FA=FromAddr : TA=ToAddr : CB=0
DO
    DEF SEG = FromSeg
        Z=PEEK(FA)
        FA=FA+1
    DEF SEG
    IF Z=AsciiKey THEN
        DEF SEG = FromSeg
            N=PEEK(FA)
            FA=FA+1
        DEF SEG
        DEF SEG = FromSeg
            Y=PEEK(FA)
            FA=FA+1
        DEF SEG
        FOR I=1 to N
            DEF SEG = ToSeg
                POKE TA,Y
                TA=TA+1
            DEF SEG
        NEXT I
    ELSE
        DEF SEG = ToSeg
            POKE TA,Z
            TA=TA+1
        DEF SEG
    ENDIF
    CB=CB+1
LOOP UNTIL CB>NumBytes&
END SUB
'
SUB FindKey(FromSeg,FromAddr,NumBytes&,AsciiKey)
    DIM Temp(0 to 255)
    FA=FromAddr
    FOR i&=1 TO NumBytes&
        DEF SEG = FromSeg
            Z = PEEK(FA) : FA=FA+1
        DEF SEG
        Temp(Z) = Temp(Z) + 1
    NEXT i&
    AsciiKey=256
    FOR i=0 to 255
        IF Temp(i)<AsciiKey THEN AsciiKey=Temp(i)
    NEXT i
END SUB
-end-