Screen Saver

Area:    Quik_Bas
  Msg:    #323
 Date:    01-18-93 11:37 (Public) 
 From:    Matt Hart                
 To:      All                      
 Subject: Screen Saver             

Continued from previous... 

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
    ENDIF
    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
    ENDIF

    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

    ' 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
        ENDIF
    NEXT
    ERASE Store&
END SUB

    ' 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
    ENDIF
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
-end-