Echo BASIC - Virtual Reality Quick Bas

Area:    Quik_Bas
  Msg:    #48
 Date:    07-14-92 17:28 (Public) 
 From:    Matt Hart                
 To:      Giovanni Palmiotto       
 Subject: Virtual Reality Quick Bas

     It's difficult to post code on exactly what you want.  
I know the background of what must be done to do it, but it 
is a matter of having time and wanting to take the effort 
to accomplish what appears to be a huge undertaking.
     Here's one routine I've posted before.  There are many 
advanced routines available in back issues of the QB News, 
available on most BBSs.

'
' GSAVES.BAS  by Matt Hart
' Save/Restore multiple graphics screens in
' any mode to a single file.
'
' Compile with /AH for huge arrays and
' /X for error trapping with RESUME NEXT
'
' The data is stored as follows:
'   1 Byte  :  Monitor Type
'   1 Byte  :  Screen Mode (0-13)
'   For VGA monitors, the palette (long integers)
'   is stored next for screens 11, 12, and 13
'
'    Screen Mode   Number of Bytes   Number of Attributes
'       11               8                   2
'       12              64                  16
'       13            1024                 256
' 
    DEFINT A-Z
    DECLARE FUNCTION CalcBytes&(X,Y,BPP,P)
    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
    '
    CONST False = 0
    CONST True  = NOT False
    '
    ON ERROR GOTO ErrorTrap
    '
    REDIM NumBytes&(0 TO 13)
    NumBytes&(0)  = 4000&
    NumBytes&(1)  = CalcBytes&(320,200,2,1)
    NumBytes&(2)  = CalcBytes&(640,200,1,1)
    NumBytes&(3)  = CalcBytes&(720,348,1,1)
    NumBytes&(7)  = CalcBytes&(320,200,1,4)
    NumBytes&(8)  = CalcBytes&(640,200,1,4)
    NumBytes&(9)  = CalcBytes&(640,350,1,4)
    NumBytes&(10) = CalcBytes&(640,350,1,2)
    NumBytes&(11) = CalcBytes&(640,480,1,1)
    NumBytes&(12) = CalcBytes&(640,480,1,4)
    NumBytes&(13) = CalcBytes&(320,200,8,1)
    '
    FileName$ = "SCREENS.BIN"
    ' Example 1 : Screen 0
    CLS : PRINT "This is Screen 0"
    COLOR 14 : PRINT "     This is Screen 0"
    Mon = 0 : ScrMode = 0 : ScreenNum = 1
    CALL SaveScreen(FileName$, Mon, ScrMode, ScreenNum, NumBytes&(), Ecode)
    CLS
    CALL RestoreScreen(FileName$, ScreenNum, NumBytes&(), Ecode)
    END
    ' Parameters are:
    '     FileName$  =  File to save the screen to
    '           Mon  =  Monitor Type
    '                     0 = Monochrome/Text Only
    '                     1 = Hercules
    '                     2 = CGA
    '                     3 = EGA
    '                     4 = VGA
    '       ScrMode  =  Current Screen Mode (0-13)
    '     ScreenNum  =  Screen Number to Save
    '                   Will return with the last screen
    '                   number in the file if ScreenNum
    '                   was greater than the last screen + 1
    '   NumBytes&()  =  Array containing the number of bytes
    '                   needed to save a screen
    '         Ecode  =  0 if no error, 1 if
    '                   ScreenNum already exists and
    '                   is not the same ScrMode and Mon,
    '                   or -1 if some other error.
    '
ErrorTrap:
    Ecode = True
    RESUME NEXT
    '
SUB SaveScreen(FileName$, Mon, ScrMode, ScreenNum, NumBytes&(), Ecode)
    Ecode = False
    Buf = FreeFile
    OPEN "B",Buf,FileName$ : IF Ecode THEN EXIT SUB
    CurScr = 1  :  CurPos& = 1
DO
    IF EOF(Buf) THEN EXIT DO
    M$=" " : S$=" " : GET Buf,,M$ : GET Buf,,S$
    M=ASC(M$) : S=ASC(S$) : CurPos& = CurPos& + 2
    IF CurScr = ScreenNum THEN
        IF M=Mon AND S=ScrMode THEN
            SEEK #Buf, CurPos& - 2
            EXIT DO
        ELSE
            Ecode = 1
            EXIT DO
        ENDIF
    ELSE
        IF M=4 THEN
            SELECT CASE S
                CASE 11 : CurPos& = CurPos& + 8&
                CASE 12 : CurPos& = CurPos& + 64&
                CASE 13 : CurPos& = CurPos& + 1024&
            END SELECT
        ENDIF
        CurPos& = CurPos& + NumBytes&(S)
        SEEK #Buf, CurPos&
        IF Ecode THEN EXIT DO       ' a DOS Error
        CurScr = CurScr + 1
    ENDIF
LOOP
    IF Ecode <> 0 THEN GOTO SS.Ending
    ScreenNum = CurScr
    A$=CHR$(Mon)+CHR$(ScrMode) : PUT #Buf,,A$
    IF Ecode THEN GOTO SS.Ending        ' DOS Error
    REDIM Saver&(1 TO NumBytes&(ScrMode))
    SaveSeg = VARSEG(Saver&(1))
    SaveAdd& = VARPTR(Saver&(1))
    SELECT CASE ScrMode
        CASE 0
            FOR P=0 TO 3999
                DEF SEG = &HB000 : Z=PEEK(P)
                DEF SEG = SaveSeg : POKE SaveAdd&+P,Z
            NEXT P
            DEF SEG
        CASE 1,7,13 : GET (0,0)-(319,199),Saver&
        CASE 2,8    : GET (0,0)-(639,199),Saver&
        CASE 3      : GET (0,0)-(719,347),Saver&
        CASE 9,10   : GET (0,0)-(639,349),Saver&
        CASE 11,12  : GET (0,0)-(639,479),Saver&
    END SELECT
    IF Ecode THEN GOTO SS.Ending        ' Wrong Screen mode probably
    IF Mon = 4 THEN
        SELECT CASE S
            CASE 11 : NumPal = 2
            CASE 12 : NumPal = 16
            CASE 13 : NumPal = 256
            CASE ELSE : NumPal = 0
        END SELECT
        IF NumPal > 0 THEN
            DIM InRegs AS RegTypeX
            DIM OutRegs AS RegTypeX
            REDIM PalInfo&(0 TO NumPal-1)
            FOR i = 0 TO NumPal-1
                InRegs.ax = &H1015
                InRegs.bx = i
                CALL INTERRUPTX (&H10, InRegs, OutRegs)
                A& = (OutRegs.cx AND &HFF00) \ &HFF
                B& = (OutRegs.cx AND &HFF)
                C& = (OutRegs.dx AND &HFF00) \ &HFF
                PalInfo&(i) = 65536& * B& + 256& * A& + C&
            NEXT i
            PSeg = VARSEG(PalInfo&(0)) : PAdd& = VARPTR(PalInfo&(0))
            FOR i = 0 TO NumPal*4-1
                DEF SEG = PSeg
                A$=CHR$(PEEK(PAdd&)) : DEF SEG
                PUT Buf,,A$
                PAdd& = PAdd& + 1
                IF PAdd& > (16*1024) THEN
                    PAdd& = PAdd& - (16*1024)
                    PSeg = PSeg + (16*1024\64)
                ENDIF
            NEXT
        ENDIF
    ENDIF
    FOR i=0 TO NumBytes&(ScrMode)-1
        DEF SEG = SaveSeg
        A$=CHR$(PEEK(SaveAdd&)) : DEF SEG
        PUT Buf,,A$
        IF Ecode THEN EXIT FOR
        SaveAdd& = SaveAdd& + 1
        IF SaveAdd& > (16*1024) THEN
            SaveAdd& = SaveAdd& - (16*1024)
            SaveSeg = SaveSeg + (16*1024\64)
        ENDIF
    NEXT i
    IF Ecode THEN GOTO SS.Ending        ' DOS Error
    CLOSE Buf
    EXIT SUB
SS.Ending:
    CLOSE Buf
END SUB


SUB RestoreScreen(FileName$, ScreenNum, NumBytes&(), Ecode)
    Ecode = False
-end-