'=========================================================================== ' Subject: SVGA Demo Date: 12-22-02 ( : ) ' Author: Michael Webster Code: Qbasic, QB, PDS ' Origin: mfwebster@pdq.net Packet: EGAVGA.ABC '=========================================================================== 'Michael Webster 'SVGADEMO 'QB, PDS ' mfwebster@pdq.net ' SVGADEMO.BAS ' ' Copyright (C) 2002 Michael Webster ' ' This program is free software; you can redistribute it and/or ' modify it under the terms of the GNU General Public License as ' published by the Free Software Foundation; either version 2 of ' the License, or (at your option) any later version. ' ' This program is distributed in the hope that it will be useful, ' but WITHOUT ANY WARRANTY; without even the implied warranty of ' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ' GNU General Public License for more details. ' ' You should have received a copy of the GNU General Public ' License along with this program; if not, write to the Free ' Software Foundation, Inc., 59 Temple Place, Suite 330, ' Boston, MA 02111-1307 USA DEFINT A-Z ' This is a quick and dirty SVGA panning, scrolling, ' and page flipping demo for QBasic. It is [b]code[/b]d for ' the VESA defined packed pixel (256 color) modes: ' 100h = 640x400x256 ' 101h = 640x480x256 ' 103h = 800x600x256 ' 105h = 1024x768x256 ' 107h = 1280x1024x256 ' ' To run this program under QuickBasic, you must ' remove all the InterruptX components and load ' the default Quick library (QB.QLB or QBX.QLB) ' when the programming environment is started. 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 DECLARE SUB InterruptX (intnum%, inRegs AS RegTypeX, outRegs AS RegTypeX) ' Define a data type for information returned by ' the Return VBE Mode Information function. TYPE ModeInfoBlockType modeAttributes AS INTEGER winAattributes AS STRING * 1 winBattributes AS STRING * 1 winGranularity AS INTEGER winSize AS INTEGER winAsegment AS INTEGER winBsegment AS INTEGER winFuncOffset AS INTEGER winFuncSegment AS INTEGER bytesPerScanLine AS INTEGER xResolution AS INTEGER yResolution AS INTEGER xCharSize AS STRING * 1 yCharSize AS STRING * 1 numberOfPlanes AS STRING * 1 bitsPerPixel AS STRING * 1 numberOfBanks AS STRING * 1 memoryModel AS STRING * 1 bankSize AS STRING * 1 numberOfImagePages AS STRING * 1 reserved1 AS STRING * 1 redMaskSize AS STRING * 1 redFieldPosition AS STRING * 1 greenMaskSize AS STRING * 1 greenFieldPosition AS STRING * 1 blueMaskSize AS STRING * 1 blueFieldPosition AS STRING * 1 reservedMaskSize AS STRING * 1 reservedFieldPosition AS STRING * 1 directColorModeInfo AS STRING * 1 reserved2 AS STRING * 216 END TYPE DECLARE SUB PutPixel (x&, y&, pixelColor%) DECLARE SUB SetBank (bank%) DECLARE SUB SetLogicalWidth (logicalWidth%, maxLogicalScanLines%, fError%) DECLARE SUB SetVbeMode (mode%, fError%) DECLARE SUB GetVbeModeInfo (mode%, modeInfo AS ModeInfoBlockType, fError%) DECLARE SUB SetDisplayStart (startPixel%, startScanLine%, fError%) CLS ' *** Select mode here: CONST cVbeMode = &H101 CONST cFalse = 0, cTrue = NOT cFalse CONST cScreenSeg = &HA000 DIM SHARED sXResolution, sYResolution DIM SHARED sWinGranularity&, sCurrentBank DIM SHARED sLogicalWidth, sLogicalScanLines DIM SHARED sfWinBsupported sLogicalWidth = cLogicalWidth DIM regX AS RegTypeX DIM modeInfo AS ModeInfoBlockType GetVbeModeInfo cVbeMode, modeInfo, fError IF fError THEN PRINT "GetVbeModeInfo returned an error" END END IF IF (modeInfo.modeAttributes AND 1) = 0 THEN PRINT "Mode not supported by hardware" END END IF sXResolution = modeInfo.xResolution sYResolution = modeInfo.yResolution ' Assume logical screen dimensions of ' twice the visible screen dimensions. sLogicalWidth = 2 * sXResolution sLogicalScanLines = 2 * sYResolution sWinGranularity& = 1024& * modeInfo.winGranularity sCurrentBank = -1 IF ASC(modeInfo.winBattributes) AND 1 THEN sfWinBsupported = cTrue PRINT PRINT "After the first beep, you can pan and scroll" PRINT "with the arrow keys, flip the page with Home" PRINT "End, PageUp, or PageDown, or press Esc to exit." PRINT "Will beep if SetDisplayStart returns an error." PRINT "Press any key to continue..." PRINT DO LOOP UNTIL INKEY$ <> "" SetVbeMode cVbeMode, fError IF fError THEN PRINT "SetVbeMode returned an error" END END IF SetLogicalWidth sLogicalWidth, maxLogicalScanLines, fError IF fError THEN PRINT "SetLogicalWidth returned an error" END END IF ' Adjust the logical scan lines as necessary. IF sLogicalScanLines > maxLogicalScanLines THEN sLogicalScanLines = maxLogicalScanLines END IF ' Fill logical screen with strange pattern. FOR y& = 0 TO sLogicalScanLines - 1 FOR x& = 0 TO sLogicalWidth - 1 pixelColor = x& * y& \ 10000 MOD 255 PutPixel x&, y&, pixelColor NEXT NEXT BEEP ' Pan and scroll, flip screen, or exit. DO k$ = RIGHT$(INKEY$, 1) SELECT CASE k$ CASE CHR$(&H48) ' UP y = y - 3 IF y < 0 THEN y = 0 CASE CHR$(&H50) ' DOWN y = y + 3 yLimit = sLogicalScanLines - sYResolution IF y > yLimit THEN y = yLimit CASE CHR$(&H4B) ' LEFT x = x - 4 IF x < 0 THEN x = 0 CASE CHR$(&H4D) ' RIGHT x = x + 4 xLimit = sLogicalWidth - sXResolution IF x > xLimit THEN x = xLimit CASE CHR$(&H47) ' HOME x = 0 CASE CHR$(&H4F) ' END x = sLogicalWidth - sXResolution CASE CHR$(&H49) ' PGUP y = 0 CASE CHR$(&H51) ' PGDN y = sLogicalScanLines - sYResolution CASE CHR$(27) EXIT DO END SELECT SetDisplayStart x, y, fError IF fError THEN BEEP LOOP ' Force a mode set. SCREEN 12 SCREEN 0 END QBasicIxData: ' QBASICIX.BIN v1.1, length = 182 bytes, checksum = 16925 DATA &H55, &H89, &HE5, &H9C, &H56, &H57, &H1E, &H55, &H0E, &H1F DATA &HB8, &H24, &H35, &HCD, &H21, &H89, &H1E, &HB2, &H00, &H8C DATA &H06, &HB4, &H00, &HB8, &H24, &H25, &HBA, &HAF, &H00, &HCD DATA &H21, &H8B, &H5E, &H0A, &H36, &H8B, &H07, &HA2, &H6A, &H00 DATA &H16, &H1F, &H8B, &H5E, &H08, &HFF, &H37, &HFF, &H77, &H02 DATA &H8B, &H4F, &H04, &HFF, &H77, &H06, &H8B, &H6F, &H08, &H8B DATA &H77, &H0A, &H8B, &H7F, &H0C, &H8B, &H47, &H12, &H3D, &HFF DATA &HFF, &H74, &H02, &H8E, &HC0, &H8B, &H47, &H10, &H3D, &HFF DATA &HFF, &H74, &H02, &H8E, &HD8, &H36, &H8B, &H47, &H0E, &H25 DATA &HD5, &H08, &H9C, &H5A, &H81, &HE2, &H2A, &HF7, &H09, &HD0 DATA &H50, &H9D, &H5A, &H5B, &H58, &HCD, &H00, &H1E, &H55, &H53 DATA &H89, &HE5, &H8B, &H6E, &H06, &H16, &H1F, &H8B, &H5E, &H06 DATA &H89, &H07, &H8F, &H47, &H02, &H89, &H4F, &H04, &H89, &H57 DATA &H06, &H8F, &H47, &H08, &H89, &H77, &H0A, &H89, &H7F, &H0C DATA &H9C, &H8F, &H47, &H0E, &H8F, &H47, &H10, &H06, &H8F, &H47 DATA &H12, &HB8, &H24, &H25, &H2E, &H8E, &H1E, &HB4, &H00, &H2E DATA &H8B, &H16, &HB2, &H00, &HCD, &H21, &H5D, &H1F, &H5F, &H5E DATA &H9D, &H5D, &HCA, &H06, &H00, &HB0, &H03, &HCF, &H00, &H00 DATA &H00, &H00 SUB GetVbeModeInfo (mode%, modeInfo AS ModeInfoBlockType, fError%) ' Calls the Return VBE Mode Information function ' to load the information for the mode specified ' by into the elements of . ' Sets to true if the function is not ' supported or the call failed. DIM regX AS RegTypeX regX.ax = &H4F01 regX.cx = mode regX.es = VARSEG(modeInfo) regX.di = VARPTR(modeInfo) InterruptX &H10, regX, regX IF regX.ax <> &H4F THEN fError = cTrue END SUB SUB InterruptX (intnum%, inRegs AS RegTypeX, outRegs AS RegTypeX) STATIC ' Loads and calls QBASICIX.BIN. CONST cLength = 182 CONST cCheckSum = 16925 IF NOT fLoaded THEN i = cLength \ 2 - 1 DIM QBASICIX(0 TO i) DEF SEG = VARSEG(QBASICIX(0)) RESTORE QBasicIxData FOR offset = 0 TO cLength - 1 READ byte POKE VARPTR(QBASICIX(0)) + offset, byte checksum& = checksum& + byte checksum& = checksum& AND &HFFFF NEXT IF checksum& <> cCheckSum THEN PRINT "Bad checksum." END END IF DEF SEG fLoaded = cTrue END IF DEF SEG = VARSEG(QBASICIX(0)) CALL ABSOLUTE(intnum, inRegs, outRegs, VARPTR(QBASICIX(0))) DEF SEG END SUB SUB PutPixel (x&, y&, pixelColor%) STATIC ' Set the color of the pixel at , on ' the logical screen to the color specified by ' , switching banks as necessary. logicalOffset& = y& * sLogicalWidth + x& bank = logicalOffset& \ sWinGranularity& SetBank bank offsetInBank& = logicalOffset& AND &HFFFF& DEF SEG = cScreenSeg POKE offsetInBank&, pixelColor DEF SEG END SUB SUB SetBank (bank%) STATIC ' Calls the VBE Display Window Control function ' to map the area of the frame buffer memory ' specified by into the host memory ' window(s). Note that the value in ' must be in window granularity units. DIM regX AS RegTypeX IF bank = sCurrentBank THEN EXIT SUB sCurrentBank = bank regX.ax = &H4F05 regX.bx = 0 regX.dx = bank InterruptX &H10, regX, regX IF sfWinBsupported THEN InterruptX &H10, regX, regX regX.ax = &H4F05 regX.bx = 1 regX.dx = bank InterruptX &H10, regX, regX END IF END SUB SUB SetDisplayStart (startPixel%, startScanLine%, fError%) STATIC ' Calls the VBE Set/Get Display Start function to ' set the first displayed scan line to the value ' specified by and the leftmost ' displayed pixel in the first scan line to the ' value specified by . Sets ' to true if the function is not supported or the ' call failed. Setting BL to 80h causes the ' function to set the display start during vertical ' retrace. DIM regX AS RegTypeX regX.ax = &H4F07 regX.bx = &H80 regX.cx = startPixel regX.dx = startScanLine InterruptX &H10, regX, regX IF regX.ax <> &H4F THEN fError = cTrue END SUB SUB SetLogicalWidth (logicalWidth%, maxLogicalScanLines%, fError%) ' Calls the VBE Set/Get Logical Scan Line Length ' function to set the length to an achievable ' length >= the value in . Returns ' the actual value set in and the ' resulting maximum number of logical scan lines ' in . Sets to ' true if the function is not supported or the ' call failed. DIM regX AS RegTypeX regX.ax = &H4F06 regX.bx = 2 regX.cx = logicalWidth InterruptX &H10, regX, regX logicalWidth = regX.bx maxLogicalScanLines = regX.dx IF regX.ax <> &H4F THEN fError = cTrue END SUB SUB SetVbeMode (mode%, fError%) ' Calls the Set VBE Mode function to initialize ' the mode specified by . Sets ' to true if the function is not supported or ' the call failed. Set bit 15 of to ' avoid clearing the display memory. DIM regX AS RegTypeX regX.ax = &H4F02 regX.bx = mode InterruptX &H10, regX, regX IF regX.ax <> &H4F THEN fError = cTrue END SUB