'===========================================================================
' Subject: DEFINITIVE SCREEN SAVER           Date: 01/14/93 (00:00)       
' Author:  Matt Hart                         Code: QB, PDS                
' Keys:    DEFINITIVE,SCREEN,SAVER         Packet: GRAPHICS.ABC
'===========================================================================
' DEFSCRS.BAS  1-14-93  Matt Hart
'
' The definitive screen saver
' Works in any screen mode, compresses and saves
' multiple screens or screen portions per file.
' Screen portions can be restored to any part of
' the screen for window movement.
'
' Compile with /AH
'
' Storage method:
' --------------- Each Screen
'             x = Screen 1 data
'             x = Screen 2 data
'             .....
'             x = Screen (number of screens) data
'       4 bytes = Number of RLL bytes for screen
'       4 bytes = Number of actual bytes for screen
'       4 bytes = Offset into file for screen data
'       2 bytes = X1
'       2 bytes = Y1
'       2 bytes = X2
'       2 bytes = Y2
'       2 bytes = Screen mode number
'             ..... Continue for number of screens
' ---------------------------
'       Last 2 bytes is the number of screens
'
' The seemingly backward method of storing the screen info
' after the screen data is done so that offsets for screen
' data do not change, and a screen's data need not be moved
' when adding screens.
'
' RLL compression is:
'       Ascii 0 = RLL code follows
'           Ascii 0 = Just kidding - actually ascii 0
'             OR
'           Ascii 1-255 = Number of repeats
'           Ascii 0-255 = Character to repeat
'         OR
'       Ascii 1-255 = Character
'
' I use the backslash division (integer division) with rather
' than regular division to prevent linking with the floating
' point library - and it is faster anyway.
'
' Note that the compression and (especially important) the decompression
' can easily be done in assembly and would be, by some previous RLL stuff,
' about 27 times faster.
'
' All of these test screens took up only 18K in a disk file - but many
' contained repetitive colors, so actual compression will be less.
'
' MonType = 0 For MONO
' MonType = 1 For CGA
' MonType = 2 For EGA
' MonType = 3 For MCGA or VGA

DEFINT A-Z
DECLARE SUB HSSaveScreen (ScreenFile$, X1%, Y1%, X2%, Y2%, MonType%, ScrNum%)
DECLARE SUB HSRestoreScreen (ScreenFile$, X1%, Y1%, MonType%, ScrNum%)
DECLARE SUB HSRLLCompress (Store&(), RLL&(), ActualBytes&, RLLBytes&)
DECLARE SUB HSIncAddr (DSeg%, DAddr%, Num%)
DECLARE SUB HSRLLDeCompress (Store&(), RLL&(), RLLBytes&)

    TYPE RegTypeX
        AX    AS INTEGER
        BX    AS INTEGER
        CX    AS INTEGER
        DX    AS INTEGER
        BP    AS INTEGER
        SI    AS INTEGER
        DI    AS INTEGER
        Flags AS INTEGER
        DS    AS INTEGER
        ES    AS INTEGER
    END TYPE
    TYPE HSDefScrsType
        RLLBytes    AS LONG
        ActualBytes AS LONG
        Offset      AS LONG
        X1          AS INTEGER
        Y1          AS INTEGER
        X2          AS INTEGER
        Y2          AS INTEGER
        ScrMode     AS INTEGER
        MonType     AS INTEGER
    END TYPE

    MonType = 3
' ----------------------------- Sample Code
    RANDOMIZE TIMER
    ScreenFile$ = "DEFSCRS.BIN"

    CLS : PRINT "Test Screen 0"                         ' Any type
    COLOR 14, 4: PRINT "     Test Screen 0"
    COLOR 6, 4: LOCATE 25, 1: PRINT SPACE$(80);
    X1 = 1: Y1 = 1: X2 = 80: Y2 = 25
    CALL HSSaveScreen(ScreenFile$, X1, Y1, X2, Y2, MonType, ScrNum)

    CLS : C = 1: A$ = "Second Test 0  "                 ' Any type
    COLOR 7, 0
    FOR Y = 1 TO 25
        COLOR C: LOCATE Y, 1
        PRINT A$ + A$ + A$ + A$ + A$; Y;
        C = C + 1: IF C = 16 THEN C = 1
    NEXT
    X1 = 1: Y1 = 1: X2 = 80: Y2 = 25
    CALL HSSaveScreen(ScreenFile$, X1, Y1, X2, Y2, MonType, ScrNum)
        
    SCREEN 1: LINE (0, 0)-(80, 80), 1, BF               ' CGA +
    PRINT "Screen 1"
    X1 = 0: Y1 = 0: X2 = 80: Y2 = 80
    CALL HSSaveScreen(ScreenFile$, X1, Y1, X2, Y2, MonType, ScrNum)

    SCREEN 7: LINE (0, 0)-(100, 100), 10, BF            ' EGA +
    PRINT "Screen 7"
    X1 = 0: Y1 = 0: X2 = 100: Y2 = 100
    CALL HSSaveScreen(ScreenFile$, X1, Y1, X2, Y2, MonType, ScrNum)

    SCREEN 9: LINE (0, 0)-(639, 349), 12, BF            ' EGA +
    PRINT "Screen 9"
    X1 = 0: Y1 = 0: X2 = 639: Y2 = 349
    CALL HSSaveScreen(ScreenFile$, X1, Y1, X2, Y2, MonType, ScrNum)

    SCREEN 11: Red& = 50: Green& = 30: Blue& = 10       ' VGA +
    Colr& = 65536 * Blue& + 256& * Green& + Red&
    PALETTE 1, Colr&: LINE (0, 0)-(100, 100), 1, BF
    PRINT "Screen 11"
    X1 = 0: Y1 = 0: X2 = 100: Y2 = 100
    CALL HSSaveScreen(ScreenFile$, X1, Y1, X2, Y2, MonType, ScrNum)

    SCREEN 13: Pal = 0                                  ' VGA +
    FOR X = 0 TO 318 STEP 20
        Red& = RND(1) * 63: Green& = RND(1) * 63: Blue& = RND(1) * 63
        Colr& = 65536 * Blue& + 256& * Green& + Red&
        PALETTE Pal, Colr&
        LINE (X, 0)-(X + 19, 75), Pal, BF
        Pal = Pal + 1
    NEXT
    FOR X = 0 TO 318 STEP 20
        Red& = RND(1) * 63: Green& = RND(1) * 63: Blue& = RND(1) * 63
        Colr& = 65536 * Blue& + 256& * Green& + Red&
        PALETTE Pal, Colr&
        LINE (X, 76)-(X + 19, 150), Pal, BF
        Pal = Pal + 1
    NEXT
    FOR X = 0 TO 318 STEP 20
        Red& = RND(1) * 63: Green& = RND(1) * 63: Blue& = RND(1) * 63
        Colr& = 65536 * Blue& + 256& * Green& + Red&
        PALETTE Pal, Colr&
        LINE (X, 151)-(X + 19, 199), Pal, BF
        Pal = Pal + 1
    NEXT
    PRINT "Screen 13"
    X1 = 0: Y1 = 0: X2 = 319: Y2 = 199
    CALL HSSaveScreen(ScreenFile$, X1, Y1, X2, Y2, MonType, ScrNum)
    NumScreens = ScrNum
    CLS : SCREEN 1: SCREEN 0: WIDTH 80

    ScrNum = 3: CALL HSRestoreScreen(ScreenFile$, 80, 80, MonType, ScrNum)
    DO: A$ = INKEY$: LOOP UNTIL LEN(A$)
    ScrNum = 6: CALL HSRestoreScreen(ScreenFile$, 80, 80, MonType, ScrNum)
    DO: A$ = INKEY$: LOOP UNTIL LEN(A$)

    DO
        CLS
        ScrNum = INT(RND * NumScreens) + 1: X1 = 0: Y1 = 0
        CALL HSRestoreScreen(ScreenFile$, X1, Y1, MonType, ScrNum)

        DO: A$ = INKEY$: LOOP UNTIL LEN(A$)
    LOOP UNTIL A$ = CHR$(27)

    SCREEN 0: WIDTH 80: CLS : END

    ' Good candidate for assembly
SUB HSIncAddr (DSeg, DAddr, Num)
    IF CLNG(DAddr) + Num > 32751& THEN
        DAddr = DAddr - 32752& + Num
        DSeg = DSeg + 2047
        DEF SEG = DSeg
    ELSE
        DAddr = DAddr + Num
    END IF
END SUB

SUB HSRestoreScreen (ScreenFile$, X1, Y1, MonType, ScrNum)
    F = FREEFILE
    OPEN ScreenFile$ FOR BINARY AS F
    IF LOF(F) = 0 THEN CLOSE F: EXIT SUB
    SEEK F, LOF(F) - 1
    Z$ = "  ": GET F, , Z$: NumScreens = CVI(Z$)
    REDIM Scrs(1 TO NumScreens) AS HSDefScrsType
    SeekPos& = LOF(F) - LEN(Scrs(1)) * NumScreens - 1
    SEEK F, SeekPos&
    FOR i = 1 TO ScrNum
        GET F, , Scrs(i)
    NEXT

    SEEK F, Scrs(ScrNum).Offset
    DimSize = Scrs(ScrNum).RLLBytes \ 4 + 1
    REDIM RLL&(1 TO DimSize)
    Z$ = "    "
    FOR i = 1 TO DimSize
        GET F, , Z$: RLL&(i) = CVL(Z$)
    NEXT

    IF Scrs(ScrNum).ScrMode = 0 THEN WIDTH 80
    SCREEN Scrs(ScrNum).ScrMode
    IF Scrs(ScrNum).ScrMode > 10 THEN
        SELECT CASE Scrs(ScrNum).ScrMode
            CASE 11: NumPal = 2
            CASE 12: NumPal = 16
            CASE 13: NumPal = 256
        END SELECT
        DIM Pal(1 TO NumPal) AS STRING * 3
        FOR i = 1 TO NumPal
            GET F, , Pal(i)
        NEXT
        DIM InRegs AS RegTypeX
        DIM OutRegs AS RegTypeX
        InRegs.AX = &H1012
        InRegs.BX = 0
        InRegs.CX = NumPal
        InRegs.ES = VARSEG(Pal(1))
        InRegs.DX = VARPTR(Pal(1))
        CALL INTERRUPTX(&O10, InRegs, OutRegs)
    END IF
    CLOSE F

    DimSize = Scrs(ScrNum).ActualBytes \ 4 + 1
    REDIM Store&(1 TO DimSize)

    ' Good candidate for assembly
    CALL HSRLLDeCompress(Store&(), RLL&(), Scrs(ScrNum).RLLBytes)
    ' Actually, the array could be decompressed directly to the screen
    ' without the need for the incremental Store&() array

    IF X1 = 0 THEN X1 = Scrs(ScrNum).X1
    IF Y1 = 0 THEN Y1 = Scrs(ScrNum).Y1
    XDiff = Scrs(ScrNum).X2 - Scrs(ScrNum).X1
    YDiff = Scrs(ScrNum).Y2 - Scrs(ScrNum).Y1
    X2 = X1 + XDiff
    Y2 = Y1 + YDiff

    IF Scrs(ScrNum).ScrMode > 0 THEN GOSUB RestoreGraphics: EXIT SUB

    IF MonType THEN TSeg = &HB800 ELSE TSeg = &HB000

    FSeg = VARSEG(Store&(1)): FAddr = VARPTR(Store&(1))

    ' Good candidate for assembly
    NumCols = X2 - X1
    FOR l = Y1 TO Y2
        Addr = (X1 - 1) * 2 + (l - 1) * 160
        FOR i = Addr TO Addr + (NumCols * 2) STEP 2
            DEF SEG = FSeg
            Char = PEEK(FAddr): FAddr = FAddr + 1
            DEF SEG = TSeg
            POKE i, Char
        NEXT
    NEXT
    FOR l = Y1 TO Y2
        Addr = (X1 - 1) * 2 + 1 + (l - 1) * 160
        FOR i = Addr TO Addr + (NumCols * 2) STEP 2
            DEF SEG = FSeg
            Attr = PEEK(FAddr): FAddr = FAddr + 1
            DEF SEG = TSeg
            POKE i, Attr
        NEXT
    NEXT
    EXIT SUB

RestoreGraphics:
    PUT (X1, Y1), Store&(1)
RETURN
END SUB

    ' Good candidate for assembly
SUB HSRLLCompress (Store&(), RLL&(), ActualBytes&, RLLBytes&)
    RLLBytes& = 0&
    FSeg = VARSEG(Store&(1)): FAddr = VARPTR(Store&(1))
    TSeg = VARSEG(RLL&(1)): TAddr = VARPTR(RLL&(1))
    FOR i& = 1& TO ActualBytes&
        DEF SEG = FSeg
        Z = PEEK(FAddr)
        CALL HSIncAddr(FSeg, FAddr, 1)
        IF i& < ActualBytes& - 2 AND PEEK(FAddr) = Z AND PEEK(FAddr + 1) = Z AND PEEK(FAddr + 2) = Z THEN
            Num = 4
            i& = i& + 3
            CALL HSIncAddr(FSeg, FAddr, 3)
            DO UNTIL PEEK(FAddr) <> Z OR i& > ActualBytes&
                IF Num = 255 THEN EXIT DO
                Num = Num + 1
                i& = i& + 1
                CALL HSIncAddr(FSeg, FAddr, 1)
            LOOP
            RLLBytes& = RLLBytes& + 3
            DEF SEG = TSeg
            POKE TAddr, 0: CALL HSIncAddr(TSeg, TAddr, 1)
            POKE TAddr, Num: CALL HSIncAddr(TSeg, TAddr, 1)
            POKE TAddr, Z: CALL HSIncAddr(TSeg, TAddr, 1)
        ELSEIF Z = 0 THEN
            DEF SEG = TSeg
            POKE TAddr, 0: CALL HSIncAddr(TSeg, TAddr, 1)
            POKE TAddr, 0: CALL HSIncAddr(TSeg, TAddr, 1)
            RLLBytes& = RLLBytes& + 2
        ELSE
            DEF SEG = TSeg
            POKE TAddr, Z: CALL HSIncAddr(TSeg, TAddr, 1)
            RLLBytes& = RLLBytes& + 1
        END IF

    NEXT
    ERASE Store&
END SUB

    ' Good candidate for assembly
SUB HSRLLDeCompress (Store&(), RLL&(), RLLBytes&)
    FSeg = VARSEG(RLL&(1)): FAddr = VARPTR(RLL&(1))
    TSeg = VARSEG(Store&(1)): TAddr = VARPTR(Store&(1))
    FOR i& = 1 TO RLLBytes&
        DEF SEG = FSeg
        Z = PEEK(FAddr): CALL HSIncAddr(FSeg, FAddr, 1)
        IF Z = 0 THEN
            Z = PEEK(FAddr): CALL HSIncAddr(FSeg, FAddr, 1)
            i& = i& + 1&
            IF Z = 0 THEN
                DEF SEG = TSeg
                POKE TAddr, Z: CALL HSIncAddr(TSeg, TAddr, 1)
            ELSE
                Char = PEEK(FAddr): CALL HSIncAddr(FSeg, FAddr, 1)
                i& = i& + 1&
                DEF SEG = TSeg
                FOR j = 1 TO Z
                    POKE TAddr, Char: CALL HSIncAddr(TSeg, TAddr, 1)
                NEXT
            END IF
        ELSE
            DEF SEG = TSeg
            POKE TAddr, Z: CALL HSIncAddr(TSeg, TAddr, 1)
        END IF
    NEXT
    ERASE RLL&
END SUB

SUB HSSaveScreen (ScreenFile$, X1, Y1, X2, Y2, MonType, ScrNum)
    F = FREEFILE
    OPEN ScreenFile$ FOR BINARY AS F
    IF LOF(F) THEN
        SEEK F, LOF(F) - 1
        Z$ = "  ": GET F, , Z$: NumScreens = CVI(Z$) + 1
        REDIM Scrs(1 TO NumScreens) AS HSDefScrsType
        SeekPos& = LOF(F) - LEN(Scrs(1)) * (NumScreens - 1) - 1
        SEEK F, SeekPos&
        FOR i = 1 TO NumScreens - 1
            GET F, , Scrs(i)
        NEXT
    ELSE
        NumScreens = 1
        REDIM Scrs(1 TO NumScreens) AS HSDefScrsType
        SeekPos& = 1
    END IF
    ScrNum = NumScreens

    DEF SEG = 0: BIOSMode = PEEK(&H449): DEF SEG
    SELECT CASE BIOSMode
        CASE 3
            ScrMode = 0: NumBytes& = (X2 - X1 + 1) * 2 * (Y2 - Y1 + 1)
        CASE 4
            ScrMode = 1: BPP = 2: P = 1: GOSUB CalcBytes
        CASE 6
            ScrMode = 2: BPP = 1: P = 1: GOSUB CalcBytes
        CASE 13
            ScrMode = 7: BPP = 1: P = 4: GOSUB CalcBytes
        CASE 14
            ScrMode = 8: BPP = 1: P = 4: GOSUB CalcBytes
        CASE 16
            ScrMode = 9: BPP = 1: P = 4
            GOSUB CalcBytes  ' P = 2 for 64K EGA
        CASE 15
            ScrMode = 10: BPP = 1: P = 2: GOSUB CalcBytes
        CASE 17
            ScrMode = 11: BPP = 1: P = 1
            GOSUB CalcBytes: NumPal = 2
        CASE 18
            ScrMode = 12: BPP = 1: P = 4
            GOSUB CalcBytes: NumPal = 16
        CASE 19
            ScrMode = 13: BPP = 8: P = 1
            GOSUB CalcBytes: NumPal = 256
    END SELECT

    DimSize = NumBytes& \ 4 + 1
    REDIM Store&(1 TO DimSize)
    TSeg = VARSEG(Store&(1)): TAddr = VARPTR(Store&(1))
    ActualBytes& = 0&

    IF ScrMode > 0 THEN GOSUB GetGraphics: GOTO SaveIt

    IF MonType THEN FSeg = &HB800 ELSE FSeg = &HB000

    ' Good candidate for assembly
    NumCols = X2 - X1
    FOR l = Y1 TO Y2
        Addr = (X1 - 1) * 2 + (l - 1) * 160
        FOR i = Addr TO Addr + (NumCols * 2) STEP 2
            DEF SEG = FSeg
            Char = PEEK(i)
            DEF SEG = TSeg
            POKE TAddr, Char
            TAddr = TAddr + 1
            ActualBytes& = ActualBytes& + 1&
        NEXT
    NEXT
    FOR l = Y1 TO Y2
        Addr = (X1 - 1) * 2 + 1 + (l - 1) * 160
        FOR i = Addr TO Addr + (NumCols * 2) STEP 2
            DEF SEG = FSeg
            Attr = PEEK(i)
            DEF SEG = TSeg
            POKE TAddr, Attr
            TAddr = TAddr + 1
            ActualBytes& = ActualBytes& + 1&
        NEXT
    NEXT

SaveIt:
    DimSize = ActualBytes& \ 4& + 4096      ' Extra 4K just in case
    REDIM RLL&(1 TO DimSize)
    CALL HSRLLCompress(Store&(), RLL&(), ActualBytes&, RLLBytes&)

    Scrs(NumScreens).RLLBytes = RLLBytes&
    Scrs(NumScreens).ActualBytes = ActualBytes&
    Scrs(NumScreens).Offset = SeekPos&
    Scrs(NumScreens).X1 = X1
    Scrs(NumScreens).Y1 = Y1
    Scrs(NumScreens).X2 = X2
    Scrs(NumScreens).Y2 = Y2
    Scrs(NumScreens).ScrMode = ScrMode
    Scrs(NumScreens).MonType = MonType

    FSeg = VARSEG(RLL&(1))
    FAddr = VARPTR(RLL&(1))

    SEEK F, SeekPos&

    SaveSize = RLLBytes& \ 4 + 1
    FOR i = 1 TO SaveSize
        Z$ = MKL$(RLL&(i))
        PUT F, , Z$
    NEXT

    IF ScrMode > 10 THEN
        DIM Pal(1 TO NumPal) AS STRING * 3
        DIM InRegs AS RegTypeX
        DIM OutRegs AS RegTypeX
        InRegs.AX = &H1017
        InRegs.BX = 0
        InRegs.CX = NumPal
        InRegs.ES = VARSEG(Pal(1))
        InRegs.DX = VARPTR(Pal(1))
        CALL INTERRUPTX(&H10, InRegs, OutRegs)
        FOR i = 1 TO NumPal
            PUT F, , Pal(i)
        NEXT
    END IF

    FOR i = 1 TO NumScreens
        PUT F, , Scrs(i)
    NEXT

    Z$ = MKI$(NumScreens): PUT F, , Z$
    CLOSE F
    EXIT SUB

GetGraphics:
    GET (X1, Y1)-(X2, Y2), Store&(1)
    ActualBytes& = NumBytes&
RETURN
CalcBytes:
    N& = ((X2 - X1 + 1) * BPP): NumBytes& = N& \ 8 - ((N& MOD 8) > 0)
    NumBytes& = NumBytes& * P * (Y2 - Y1 + 1) + 4
RETURN
END SUB