'===========================================================================
' Subject: SVGA Routines (2/2)                Date: 06-14-02 (  :  )       
'  Author: Mike                               Code: Qbasic                 
'  Origin: mstechcae@webcity.ca             Packet: EGAVGA.ABC
'===========================================================================
'===========================================================================
' Subject: SVGA routines II                   Date: 05-21-03
'  Author: /\/\ | |< 3                        Code: QB, QBasic
'  Origin: mstechcae@webcity.ca             Packet: EGAVGA.ABC
'===========================================================================
'
'                   [S]uper [V]ideo [G]raphics [A]rray
'
' This is part II of the SVGA routines. This part utilizes machine code for
' most of the work. The only thing Q(uick)Basic does is to make calculations.
' This code is optimized because you can take a strip of raw bitmap data and
' the data gets displayed in one second. In part I, it took at least three
' seconds to make a line. In the next sequel, data transfer will be faster.
'
' The commands are now easier to use. use them as ordinary Qbasic commands.
' Always stick "v." in front of each command or else unpredictable results
' will occur. call v.start() to load SuperVGA Bios extensions which is
' required for SVGA mode. If your hardware supports SuperVGA, then no files
' are required. If it doesn't then download UNIVBE.
'===========================================================================
DEFINT A-Z
DECLARE SUB v.print (char$, c%)
DECLARE SUB i.asm (id$)
DECLARE SUB i.mem (e$, o%, pln%)
DECLARE SUB demo ()
DECLARE SUB v.pset (x%, y%, c%, s%)
DECLARE SUB v.start ()
DECLARE FUNCTION i.unsigned% (n&)
DECLARE SUB pal (i%, r%, g%, b%)
CALL demo '<-- The code for the demo is in that sub
END

DEFSNG A-Z
SUB demo
CALL v.start '<- set-up 640*480 mode at 256 colours
CALL pal(80, 0, 0, 63)
CALL pal(95, 63, 0, 0)
LOCATE 1, 1: v.print "You are running a sample program from SVGA part II", 55
LOCATE 2, 1: v.print "This program will flood the screen with colour", 65
LOCATE 3, 1: v.print "one by one", 75
LOCATE 5, 1: v.print "Press any key to continue.", 80
LOCATE 6, 1: v.print "To exit, press a key again.", 95
csn% = 0
DO
start# = TIMER
csn% = csn% + 2
CALL pal(95, 62 - csn%, csn%, 0)
CALL pal(80, csn%, 0, 62 - csn%)
DO: LOOP UNTIL ABS(TIMER - start#) >= .1
LOOP UNTIL csn% >= 62
DO: LOOP UNTIL INKEY$ <> ""
c% = 1
DO
FOR n% = 1 TO 480
CALL v.pset(0, n%, c%, 640)
d$ = INKEY$: IF d$ <> "" THEN EXIT DO
NEXT n%
c% = c% + 1
LOOP
CALL v.start
SCREEN 0
WIDTH 80, 25
LOCATE 1, 1, 1
PRINT "Good bye"
END
END SUB

SUB i.asm (id$)
DEF SEG = VARSEG(id$)
CALL absolute(SADD(id$))
'
' Did QuickBasic stop you here and give you the "subprogram not defined"
' message? That is because you need to use a library (QB.QLB) when calling
' this function. In QBasic 1.1, you dont have to worry about this.
'
' To solve the problem, exit QuickBasic, and type in the same command as
' before to use QuickBasic, but this time, add the /L switch. This will
' load the libraries. If it asks you to find them, type in the path where
' QuickBasic is installed followed by a \.
'
' If you STILL get the error, then the library, the system, or Q(uick)Basic
' may be corrupt. Check your disk for errors just to make sure.
'
END SUB

SUB i.mem (e$, o%, pln%)
'
'Did you get an error around here?
'Press F2 and choose asm for details.
'
s% = &HA000: s2% = VARSEG(e$): o2% = SADD(e$)
d$ = MKL$(&HB8E58955) + MKL$(&HBB4F05) + MKL$(&H10568B00) + MKL$(&H570610CD) + MKL$(&H768B561E) + MKL$(&H85E8E06) + MKL$(&H8E0A7E8B) + MKL$(&H4E8B0C46) + MKL$(&HFF83A40E) + MKI$(&H75FF) + CHR$(&HF) + MKL$(&H4F05B842) + CHR$(&HBB) + MKI$(0) + MKL$(&H468E10CD) + MKI$(&HBF0C) + MKL$(&HE9E20000) + MKL$(&H75F1F5E) + MKI$(&HCB5D)
DEF SEG = VARSEG(d$)
CALL absolute(BYVAL pln%, BYVAL LEN(e$), BYVAL s%, BYVAL o%, BYVAL s2%, BYVAL o2%, SADD(d$))
END SUB

FUNCTION i.unsigned% (n&)
i.unsigned% = CVI(LEFT$(MKL$(n&), 2))
END FUNCTION

DEFINT A-Z
SUB pal (id%, r%, g%, b%)
d$ = MKI$(&H8955) + CHR$(&HE5) + MKL$(&H8A03C8BA) + MKL$(&HBAEE0C46) + MKL$(&H468A03C9) + MKL$(&H468AEE0A) + MKL$(&H468AEE08) + MKL$(&HCB5DEE06)
DEF SEG = VARSEG(d$)
CALL absolute(BYVAL id%, BYVAL r%, BYVAL g%, BYVAL b%, SADD(d$))
END SUB

DEFSNG A-Z
SUB v.print (char$, c%)
IF c% >= 0 AND c% <= 255 THEN
FOR ct% = 1 TO LEN(char$)
cha$ = MID$(char$, ct%, 1)
CALL i.asm(MKL$(&HB8E58955) + cha$ + MKI$(&HBB09) + CHR$(c%) + MKL$(&H1B900) + MKL$(&HCB5D10CD))
IF POS(0) < 80 THEN LOCATE CSRLIN, POS(0) + 1
NEXT ct%
ELSE
ERROR 99
END IF
END SUB

SUB v.pset (x%, y%, c%, s%)
o& = y% * 640& + x%
os% = i.unsigned%(o& MOD 65536)
pln% = i.unsigned%(o& \ 65535)
CALL i.mem(STRING$(s%, c%), os%, pln%)
END SUB

SUB v.start
SCREEN 12
CALL i.asm(MKL$(&HB8E58955) + MKL$(&H1BB4F02) + MKL$(&H5D10CD01) + CHR$(&HCB))
END SUB