'===========================================================================
' Subject: SVGA IN BASIC                     Date: 02-25-96 (14:06)       
' Author:  Peter Cooper                      Code: QB, PDS, VBDOS         
' Origin:  comp.lang.basic.misc            Packet: GRAPHICS.ABC
'===========================================================================
'<Someone's address>  (or similar) was asking for code that would go into
'800x600x256 col mode. People suggested tricking the card or going and getting
'libraries (maybe shareware - which you have to pay for remember)
'Well if you have no money then you need this code I just wrote. It goes into
'800x600x256 col mode on most cards. It works in QuickBasic 4.5, VBDOS and
'PDS7.0+.1 . You should load it  by going:   QB /L   or VBDOS /L  or QBX /L
'to enable interrupts. Then run this code:

'$INCLUDE: 'qbx.bi'             'change to QB.BI for QB4.5

DIM SHARED inregs AS RegType
DIM SHARED outregs AS RegType

SCREEN 0
CLS
COLOR 15
PRINT "SVGA in Basic by Peter Cooper"
COLOR 12
PRINT "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
PRINT "I will not be held responsible for any malfunctions in this source. It has"
PRINT "been tested on a Trident and a Vesa card. If it doesnt work then wait about"
PRINT "10 seconds and then press SPACE. It should return to normal."
PRINT
PRINT "If all of your text goes monochrome then please turn off the machine and"
PRINT "restart."
COLOR 7
PRINT
PRINT "1 - Trident card   - 800x600x256cls"
PRINT "2 - VESA(or unsure)- 800x600x16cls"
PRINT "3 - Tseng          - 800x600x256cls"
PRINT "4 - ATI            - 800x600x256cls"
a$ = INPUT$(1)
IF a$ < "1" OR a$ > "4" THEN SYSTEM
a% = VAL(a$)
IF a% = 1 THEN m% = &H5E
IF a% = 2 THEN m% = &H6A
IF a% = 3 THEN m% = &H30
IF a% = 4 THEN m% = &H63


inregs.ax = m%                                       ' Set for screen mode
CALL Interrupt(&H10, inregs, outregs)                ' Change mode
FOR y% = 1 TO 480 STEP 9                             ' go down in intervals
	FOR x% = 1 TO 640                            ' Go all-way cross screen
		inregs.ax = &HC0D                    ' set up function+color
		inregs.bx = 1                        ' select page 1
		inregs.cx = x%                       ' select x coord
		inregs.dx = y%                       ' select y coord
		CALL Interrupt(&H10, inregs, outregs)' set pixel
	NEXT x%
NEXT y%

inregs.ax = &H200                                    ' This sets cursor pos
inregs.bx = &H100
inregs.dx = &H505
CALL Interrupt(&H10, inregs, outregs)                ' call interrupt

inregs.ax = &HA48                                    ' this writes chars
inregs.bx = &H10E
inregs.cx = 20
CALL Interrupt(&H10, inregs, outregs)                ' call interrupt

a$ = INPUT$(1)

inregs.ax = &H3                                      ' change back to text mode
CALL Interrupt(&H10, inregs, outregs)                ' call interrupt

CLS

SUB mousecommand (ax%, bx%, cx%, dx%)
inregs.ax = ax%
inregs.bx = bx%
inregs.cx = cx%
inregs.dx = dx%
CALL Interrupt(&H33, inregs, outregs)
ax% = outregs.ax
bx% = outregs.bx
cx% = outregs.cx
dx% = outregs.dx
END SUB