Qbasicnews.com

Qbasicnews.com > QbasicNews.Com > Challenges > 100% QB game
Full Version: 100% QB game
You're currently viewing a stripped down version of our content. View the full version with proper formatting.
Pages: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15

Spotted Cheetah

05-15-2004, 09:39 PM
If anyone still looks at this topic:

I worked on the sprite editor, now it can handle 2, 16, and 256 color BMP files, and can apply the currently used palette on them (it will do this with 2 and 256 color images, at 16 colors you still can use it's own colors). Now it is able to save in 16 color BMP files too.

You can download it from qb4all, from the Graphic section, if you are interested.

mddwebboy

06-06-2004, 09:41 PM
Hello. I am kinda new to this whole QBASIC thingy. Smile I know a fair bit about QBASIC, and I have made a few games. here is my newest one.... I hope it qualifies!


[EFINT A-Z
DECLARE SUB mouse (cx, dx, bx)
DECLARE SUB mousepointer (SW)
DIM SHARED a(9) 'Set up array for code
DEF SEG = VARSEG(a(0)) 'Get array segment (nnnn: )
' (two 8 bit)
FOR i = 0 TO 17 'length of DATA to
READ r 'read
POKE VARPTR(a(0)) + i, r 'into array/2 (nnnn:iiii) (one 8 bit)
NEXT i 'until 17

'**************************** Machine Code *********************************

DATA &HB8,&H00,&H00 : ' mov AX,[n] [Swap code-(L),(H)] in AX
DATA &H55 : ' push BP Save BP
DATA &H8B,&HEC : ' mov BP,SP Get BP to c Seg
DATA &HCD,&H33 : ' int 33 Interrupt 33
DATA &H92 : ' xchg AX,[reg] [Swap code-reg] in AX
DATA &H8B,&H5E,&H06 : ' mov BX,[BP+6] Point to (variable)
DATA &H89,&H07 : ' mov [BX],AX Put AX in (variable)
DATA &H5D : ' pop BP Restore BP
DATA &HCA,&H02,&H00 : ' ret 2 Far return

SCREEN 13
'****************************** Mouse set up ******************************

CALL mousepointer(0) 'Reset mouse and
CALL mousepointer(1) 'turn pointer off
CALL mousepointer(3) 'Get coordinates

'****************************** P R O G R A M ******************************

DIM ship(100, 100)
DIM c!(360), s!(360)

FOR i = 1 TO 360
c!(i) = COS(i * 3.14 / 180)
s!(i) = SIN(i * 3.14 / 180)
NEXT

cx = 160
cy = 100

SCREEN 13

FOR yer = 1 TO 15
FOR xer = 1 TO 30
READ ship(xer, yer)
NEXT xer
NEXT yer

DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,3,3,3,3,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,3,1,3,3,30,3,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,3,1,3,3,3,3,30,3,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,3,1,3,3,3,3,3,3,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0
DATA 0,0,0,0,1,1,1,24,25,25,25,25,26,26,26,26,27,27,28,28,29,29,30,1,1,1,0,0,0,0
DATA 0,0,0,1,23,23,24,24,25,25,25,26,26,26,26,27,27,27,28,28,28,29,29,29,30,30,1,0,0,0
DATA 0,3,1,3,1,1,3,1,1,3,1,1,1,1,3,1,1,1,1,3,1,1,3,1,1,3,1,3,1,0
DATA 3,1,3,1,1,3,1,1,1,3,1,1,1,1,3,1,1,1,1,3,1,1,1,3,1,1,3,1,3,1
DATA 0,1,1,1,22,22,23,23,24,24,24,25,25,25,26,26,26,27,27,27,28,28,28,29,29,29,1,1,1,0
DATA 0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0
DATA 0,0,0,0,0,0,0,1,21,21,22,22,23,23,23,23,24,24,25,25,26,27,1,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,3,3,3,3,3,3,30,3,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,3,3,3,3,30,3,0,0,0,0,0,0,0,0,0,0,0,0

x = 100
y = 100

angle = 1

DO
Key$ = INKEY$
CALL mouse(cx, dx, bx)

IF angle < 1 THEN angle = 359
IF angle > 359 THEN angle = 1

FOR yer = 1 TO 15
FOR xer = 1 TO 30
xx = (xer - 15) * c!(angle) + (yer - 7.5) * s!(angle)
yy = (yer - 7.5) * c!(angle) - (xer - 15) * s!(angle)
PSET ((xx + x), (yy + y)), ship(xer, yer)
NEXT xer
NEXT yer

LOOP UNTIL Key$ = "q"


'-------------------| THE END (Cut here)|----------------------------------

SUB mouse (cx, dx, bx)

POKE VARPTR(a(4)), &H92 'Swap code,Get CX setup
CALL absolute(cx, VARPTR(a(0))) 'Run Code
' cx = cx / 8 'Adjust 25x80
POKE VARPTR(a(4)), &H91 'Swap code,Get DX setup
CALL absolute(dx, VARPTR(a(0))) 'Run Code
dx = dx / 2 'Adjust 25x80
POKE VARPTR(a(4)), &H93 'Swap code,Get BX setup
CALL absolute(bx, VARPTR(a(0))) 'Run Code

'Note :
'Remove the /8
'for graphics modes.

END SUB

SUB mousepointer (SW)

POKE VARPTR(a(0)) + 1, SW 'Swap code,Set AX = (SW)
CALL absolute(c, VARPTR(a(0))) 'Run Code

'Note:
'SW = 0-reset
'SW = 1-on
'SW = 2-off
'SW = 3-coordinates


END SUB

][/code]

mddwebboy

06-06-2004, 09:46 PM
sorry about that. the other one is my first version. it only has a little rotating ship. this one is controlled by the mouse. I hope you like it. move the mouse to tip the ship, and press the left mouse button to go in that direction, and go higher. the right mouse button controls the beam.

If you hit a guy, they turn red and you cannot get them. if you get them with the beam, they turn green. if you hit a building, you die. oh, and the game over message is screwed up. :oops:


Code:
DEFINT A-Z
DECLARE SUB mouse (cx, dx, bx)
DECLARE SUB mousepointer (SW)
DIM SHARED a(9)                 'Set up array for code
DEF SEG = VARSEG(a(0))          'Get array segment (nnnn:    )
                                 '    (two 8 bit)
    FOR i = 0 TO 17                 'length of DATA to
       READ r                       'read
       POKE VARPTR(a(0)) + i, r     'into array/2 (nnnn:iiii) (one 8 bit)
    NEXT i                          'until 17

'**************************** Machine Code *********************************

DATA &HB8,&H00,&H00   :   ' mov  AX,[n]       [Swap code-(L),(H)] in AX
DATA &H55             :   ' push BP           Save BP
DATA &H8B,&HEC        :   ' mov  BP,SP        Get BP to c Seg
DATA &HCD,&H33        :   ' int  33           Interrupt 33
DATA &H92             :   ' xchg AX,[reg]     [Swap code-reg] in AX
DATA &H8B,&H5E,&H06   :   ' mov  BX,[BP+6]    Point to (variable)
DATA &H89,&H07        :   ' mov  [BX],AX      Put AX in (variable)
DATA &H5D             :   ' pop  BP           Restore BP
DATA &HCA,&H02,&H00   :   ' ret  2            Far return

SCREEN 13
'****************************** Mouse set up ******************************
          
                CALL mousepointer(0)      'Reset mouse and
                CALL mousepointer(1)      'turn pointer off
                CALL mousepointer(3)      'Get coordinates

'****************************** P R O G R A M ******************************

DIM guy(100, 100)
DIM ship(100, 100)
DIM c!(360), s!(360)
DIM px(1000)
DIM py(1000)
DIM b(100, 100)

FOR i = 1 TO 360
c!(i) = COS(i * 3.14 / 180)
s!(i) = SIN(i * 3.14 / 180)
NEXT

cx = 160
cy = 100

SCREEN 13

FOR yer = 1 TO 15
FOR xer = 1 TO 30
READ ship(xer, yer)
NEXT xer
NEXT yer

DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,3,3,3,3,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,3,1,3,3,30,3,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,3,1,3,3,3,3,30,3,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,3,1,3,3,3,3,3,3,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0
DATA 0,0,0,0,1,1,1,24,25,25,25,25,26,26,26,26,27,27,28,28,29,29,30,1,1,1,0,0,0,0
DATA 0,0,0,1,23,23,24,24,25,25,25,26,26,26,26,27,27,27,28,28,28,29,29,29,30,30,1,0,0,0
DATA 0,3,1,3,1,1,3,1,1,3,1,1,1,1,3,1,1,1,1,3,1,1,3,1,1,3,1,3,1,0
DATA 3,1,3,1,1,3,1,1,1,3,1,1,1,1,3,1,1,1,1,3,1,1,1,3,1,1,3,1,3,1
DATA 0,1,1,1,22,22,23,23,24,24,24,25,25,25,26,26,26,27,27,27,28,28,28,29,29,29,1,1,1,0
DATA 0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0
DATA 0,0,0,0,0,0,0,1,21,21,22,22,23,23,23,23,24,24,25,25,26,27,1,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,3,3,3,3,3,3,30,3,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,3,3,3,3,30,3,0,0,0,0,0,0,0,0,0,0,0,0

FOR yer = 1 TO 12
FOR xer = 1 TO 7
READ guy(xer, yer)
NEXT xer
NEXT yer

DATA 0,0,6,6,6,0,0
DATA 0,0,14,14,14,0,0
DATA 0,0,14,4,14,0,0
DATA 3,2,2,2,2,2,3
DATA 3,2,2,2,2,2,3
DATA 3,2,2,2,2,2,3
DATA 0,3,3,3,3,3,0
DATA 0,3,3,3,3,3,0
DATA 0,3,3,0,3,3,0
DATA 0,3,3,0,3,3,0
DATA 0,6,6,0,6,6,0
DATA 6,6,6,0,6,6,6

FOR yer = 0 TO 9
FOR xer = 0 TO 16
READ b(xer, yer)
FOR xe = 1 TO 20
FOR ye = 1 TO 20
PSET ((xe + (20 * xer)), (ye + (20 * yer))), b(xer, yer)
NEXT ye
NEXT xe
NEXT xer
NEXT yer

DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,2,0,0,0
DATA 0,0,0,4,4,0,0,0,0,0,0,0,0,1,0,0,0
DATA 0,0,0,6,6,0,0,0,0,0,0,0,0,1,0,0,0
DATA 0,0,0,6,6,0,0,0,2,0,2,0,0,1,1,0,0
DATA 0,0,6,6,6,6,0,0,1,0,1,0,0,1,1,1,1
DATA 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6

pnum = 3

FOR rer = 1 TO pnum
READ px(rer)
READ py(rer)
NEXT rer

DATA 1,168
DATA 135,168
DATA 302,148

x = 160
y = 70

angle = 1

DO
Key$ = INKEY$
CALL mouse(cx, dx, bx)

FOR rer = 1 TO pnum
IF (guy$(rer) <> "") THEN Key$ = "q" ELSE Key$ = INKEY$
NEXT rer

LOCATE 1, 1: PRINT Key$

IF (Key$ = "q") THEN
IF (guy$(rer) = "G") THEN
LOCATE 5, 15: PRINT "Game Over"
LOCATE 6, 16: PRINT "You Win"
ELSE
LOCATE 5, 15: PRINT "Game Over"
LOCATE 6, 15: PRINT "You loose"
END IF
END IF

FOR rer = 1 TO pnum
FOR yer = 1 TO 12
FOR xer = 1 TO 7
PSET (px(rer) + xer, py(rer) + yer), 0
NEXT xer
NEXT yer
FOR yer = 1 TO 12
FOR xer = 1 TO 7
IF (guy$(rer) <> "N" AND guy$(rer) <> "G") THEN
PSET (px(rer) + xer, py(rer) + yer), guy(xer, yer)
ELSEIF (guy$(rer) = "N") THEN
PSET (px(rer) + xer, py(rer) + yer), 4
ELSEIF (guy$(rer) = "G") THEN
PSET (px(rer) + xer, py(rer) + yer), 2
END IF
NEXT xer
NEXT yer
IF (px(rer) >= (x - 10) AND px(rer) <= (x + 10)) THEN
IF (las$ <> "Y") THEN
IF (py(rer) >= (y - 7) AND py(rer) <= (y + 7)) THEN
guy$(rer) = "N"
END IF
ELSE
IF (guy$(rer) <> "N") THEN
guy$(rer) = "G"
END IF
END IF
END IF
NEXT rer

FOR yer = 1 TO 15
FOR xer = 1 TO 30
xx = (xer - 15) * c!(angle) + (yer - 7.5) * s!(angle)
yy = (yer - 7.5) * c!(angle) - (xer - 15) * s!(angle)
PSET ((xx + x), (yy + y)), 0
NEXT xer
NEXT yer

IF (dx < 160) THEN
angle = (160 - dx) / 3
ELSEIF (dx > 160) THEN
angle = 360 - (dx - 160) / 3
END IF

IF (bx = 2) THEN
las$ = "Y"
IF (x > 2 OR x < -2) THEN
xs = xs / 3
END IF
LINE (x - 5, y)-((x + 5), 200), 0, BF
LINE (x - 2, y)-((x + 2), 200), 14, BF
END IF

IF (las$ = "Y") THEN
IF (x > 2 OR x < -2) THEN
xs = xs / 3
END IF
LINE (x - 5, y)-((x + 5), 200), 0, BF
LINE (x - 2, (y + 8))-((x + 2), 200), 14, BF
END IF

IF (bx <> 2 AND las$ = "Y") THEN
las$ = "N"
LINE (x - 5, y)-((x + 5), 200), 0, BF
LINE (x - 2, y)-((x + 2), 200), 0, BF
END IF

tr = tr + 1

IF (tr >= 15) THEN
tr = 0
IF (bx = 1) THEN
IF (dx < 160) THEN
xs = xs + (dx - 160) / 60
ELSEIF (dx > 160) THEN
xs = xs - (160 - dx) / 60
END IF
END IF
END IF

t = t + 1

IF (t >= 15) THEN
t = 0
IF (bx = 1) THEN
ys = ys - 1
END IF
END IF

at = at + 1
aat = aat + 1

IF (at >= 40) THEN
at = 0
ys = ys + 1
END IF

IF (aat >= 20) THEN
aat = 0
y = y + ys
x = x + xs
colr = (INT(RND * 16))
END IF

IF angle < 1 THEN angle = 359
IF angle > 359 THEN angle = 1

IF (b((x / 20), (y / 20)) <> 0) THEN
Key$ = "q"
END IF

FOR yer = 1 TO 15
FOR xer = 1 TO 30
xx = (xer - 15) * c!(angle) + (yer - 7.5) * s!(angle)
yy = (yer - 7.5) * c!(angle) - (xer - 15) * s!(angle)
ya = ship(xer, yer)
IF (ya = 3 AND bx = 2) THEN
PSET ((xx + x), (yy + y)), colr
ELSE
PSET ((xx + x), (yy + y)), ship(xer, yer)
END IF
NEXT xer
NEXT yer

LOOP UNTIL Key$ = "q"


'-------------------| THE END (Cut here)|----------------------------------

SUB mouse (cx, dx, bx)
        
           POKE VARPTR(a(4)), &H92           'Swap code,Get CX setup
          CALL absolute(cx, VARPTR(a(0)))     'Run Code
            '  cx = cx / 8                     'Adjust 25x80
           POKE VARPTR(a(4)), &H91           'Swap code,Get DX setup
          CALL absolute(dx, VARPTR(a(0)))     'Run Code
              dx = dx / 2                     'Adjust 25x80
           POKE VARPTR(a(4)), &H93           'Swap code,Get BX setup
          CALL absolute(bx, VARPTR(a(0)))     'Run Code

                                   'Note :
                                   'Remove the /8
                                   'for graphics modes.

END SUB

SUB mousepointer (SW)
        
           POKE VARPTR(a(0)) + 1, SW         'Swap code,Set AX = (SW)
          CALL absolute(c, VARPTR(a(0)))     'Run Code

                                          'Note:
                                             'SW = 0-reset
                                             'SW = 1-on
                                             'SW = 2-off
                                             'SW = 3-coordinates


END SUB

  [/code]

whitetiger0990

06-06-2004, 10:09 PM
er... whats that code supposed to do? for me it made a mouse and an inferno beep from hell that didn't stop... even when i closed qbasic. I had to restart the computer o.o;;

mddwebboy

06-11-2004, 04:06 AM
I tested that a ton on my computer. I may have messed it up when I copied and pasted. Cry Sorry about yur computer. I got the mouse code from the tutorials here. refer to whoever made those.

Nemesis

07-30-2004, 10:05 AM
Quote:If it works fine with pure QB code, and won't need GHzs, You can do it... This is like FFIX.

But if You can not do it without using external routines, You can not say that it is 100% QB...

I thought that the QB included in DOS was first, and only that was improved later... Thanks for the info. But anyway, interrupt handling is built in at a version of QB - so I think it can be used.

Ummm...
A .qlb (QuickBASIC4.5 library) can be coded with pure QB,
just because it's a library doesn't mean it wasn't coded in pure QB.
(In my opinion a pure QB program can be anything programed in QB, a .QLb, an .EXE or a .BAS which doesn't use any ASM calls, or uses any other languages called from QB, eg... CALL ABSOLUTE.
Also QB.QLB is legal in my opinion too.)

Anyways, one day if I happen to run across this challenge thread and have finished a GREAT pure QB game, I'll upload it.
But for now I've only been messing around with pure QB coded tools to help make pure QB games, like grahic libs, key handlers, fast bit operations, ect...

Here's a pure QB library soon will be a .QLB library for screen 13.
I'm currently working on v1.2, which isn't finished yet, I've still yet to add a few things like translucency, palette manipulation, rotozoomers, etc... and maybe some 3-D routines too.
VIDEO13h v1.2 also uses a routine similar to SUPERPUT, so the library can use fast PUT/GET and all of QB's original graphic commands for screen 13.
Plus it has some custom PUT routines too. (Very fast for PUREQB)
Check it out...


Code:
'''
' VIDEO13h v1.2, Pure QuickBASIC 4.5; SCREEN 13 manipulation routines.
'
' (C)opyright 2004, Pure QB Innovations
'
' Email any questions, comments, or suggestions to...
'  ESmemberNEMESIS@aol.com
'
' Visit the Pure QB Innovations web site at...
'  http://members.aol.com/esmembernemesis/index.htm
'
' THIS PROGRAM MAY BE DISTRIBUTED FREELY AS PUBLIC DOMAIN SOFTWARE
' AS LONG AS ANY PART OF THIS FILE IS NOT ALTERED IN ANY WAY.
' IF YOU DO WISH TO USE THESE ROUTINES IN YOUR OWN PROGRAMS
' THEN PLEASE GIVE CREDIT TO THE AUTHOR... Mario LaRosa.
'
'
''
'
'$DYNAMIC
'
DEFINT A-Z
'
TYPE REGXdata
AX    AS INTEGER
BX    AS INTEGER
CX    AS INTEGER
DX    AS INTEGER
BP    AS INTEGER
SI    AS INTEGER
DI    AS INTEGER
FL    AS INTEGER
DS    AS INTEGER
ES    AS INTEGER
END TYPE
'
TYPE PNTdata
switch AS INTEGER
frame AS INTEGER
lb AS INTEGER
rb AS INTEGER
xx AS INTEGER
yy AS INTEGER
minXX AS INTEGER
minYY AS INTEGER
maxXX AS INTEGER
maxYY AS INTEGER
END TYPE
'
TYPE PALdata
RED AS INTEGER
GRN AS INTEGER
BLU AS INTEGER
END TYPE
'
COMMON SHARED PAL() AS PALdata
'
COMMON SHARED REGX AS REGXdata
COMMON SHARED PNT AS PNTdata
COMMON SHARED SYS&
COMMON SHARED Vtarget, VGAlo, VGAhi, V13lo, V13hi
COMMON SHARED FONTScolour
COMMON SHARED clipXXleft, clipYYtop, clipXXright, clipYYbottom
'
DECLARE SUB DEMO ()
'
DECLARE SUB INTERRUPTX (INTNUM AS INTEGER, INREG AS REGXdata, OUTREG AS REGXdata)
'
DECLARE SUB V13hCLS (colour)
DECLARE SUB V13hCLP (XXleft, YYtop, XXright, YYbottom)
DECLARE SUB V13hPAL (file$)
DECLARE SUB V13hBLD (ARRAY(), file$)
DECLARE SUB V13hBSV (ARRAY(), file$)
DECLARE SUB V13hDEL (seconds!)
DECLARE SUB V13hFDE (fadeOUT, fadeINN, fadeSEC!)
DECLARE SUB V13hKEY ()
DECLARE SUB V13hPAN (direction, increment, wrap)
DECLARE SUB V13hPNT (ARRAY(), frame)
DECLARE SUB V13hPUT (ARRAY(), XXleft, YYtop, frame, mode$)
DECLARE SUB V13hSEE ()
DECLARE SUB V13hSET ()
DECLARE SUB V13hTXT (ARRAY(), XXcenter, XXleft, YYtop, colour, text$)
'
DECLARE FUNCTION V13hLOF& (file$)
'
DIM SHARED PAL(0 TO 255) AS PALdata
'
DIM SHARED VIDEO(0 TO 31999)
DIM SHARED FONTS(0 TO 3263)
DIM SHARED MOUSE(0 TO 129)
DIM SHARED BOARD(0 TO 127)
'
V13hSET
'
DEMO
'
KILL "video.tmp"
'
SYSTEM
'

SUB DEMO
'
' DRAW AND GET, (-3- 20*20) TILES. (DEMO)...
'
DIM TILES(0 TO 606)
V13hCLS 0
FOR x = 0 TO 40 STEP 20
  col = col + 1
  LINE (x, 0)-(x + 19, 19), col, BF
  LINE (x, 0)-(x + 19, 19), 15, B
  LINE (x + 5, 5)-(x + 14, 14), 0, BF
  GET (x, 0)-(x + 19, 19), TILES(stp)
  stp = stp + 202
NEXT
'
'GOTO PAN
'
'SCROLLING FONT DEMO...
'
FOR y = (clipYYbottom + 1) TO (clipYYtop - (34 * 8)) STEP -1
  V13hCLS 0
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 0), 15, "-WELCOME-"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 2), 7, "VIDEO13h v1.2, pure QuickBASIC 4.5,"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 4), 7, "SCREEN 13 manipulation routines."
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 8), 15, "-FEATURES-"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 10), 7, "320X200X256 resolution (VGA),"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 12), 7, "page flipping, sprite animation,"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 14), 7, "sprite clipping, font routines,"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 16), 7, "mouse and keyboard handlers."
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 18), 7, "Also supports most of QB's,"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 20), 7, "original graphic commands too!"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 24), 15, "-REQUIREMENTS-"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 26), 7, "100+ Mhz PC processor, a VGA monitor,"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 28), 7, "keyboard and mouse, QuickBASIC v4.5,"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 30), 7, "and a disk cache active."
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 34), 15, "-CREDITS-"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 36), 15, "...Programmer..."
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 38), 7, "Mario LaRosa, ESmemberNEMESIS@aol.com"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 42), 15, "...Special Thanks..."
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 44), 7, "Jonathan Dale Kirwan, JonKirwan@aol.com"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 46), 7, "Quinton Roberts, Eclipzer@aol.com"
  V13hTXT FONTS(), FALSE, 0, (8 * 24), 15, "(C)opyright 2004,"
  V13hTXT FONTS(), FALSE, (8 * 18), (8 * 24), 12, "Pure"
  V13hTXT FONTS(), FALSE, (8 * 23), (8 * 24), 10, "QB"
  V13hTXT FONTS(), FALSE, (8 * 26), (8 * 24), 9, "Innovations"
  V13hSEE
  '
  'WAIT &H3DA, 8
  '
  IF LEN(INKEY$) THEN EXIT FOR
NEXT
SLEEP
'
'FADE OUT/IN DEMO...
'
'
V13hFDE NOT FALSE, NOT FALSE, 1 / 32
'
'DELAY (1/2 SECONDS) DEMO...
'
DO: LOOP UNTIL TIMER <> TIMER
DO
  t! = TIMER
  V13hDEL 1 / 2
  PRINT TIMER - t!
LOOP UNTIL LEN(INKEY$)
'
'''
''' CLEAR SCREEN (256X) DEMO...
'''
'
t! = TIMER
FOR c = 0 TO 255
  V13hCLS c
  V13hSEE
NEXT
LOCATE 1, 1: PRINT "CLS, (256X):"; TIMER - t!
SLEEP
'
'''
''' (1O,OOO) RANDOM PIXELS DEMO...
'''
V13hCLS 0
t! = TIMER
FOR x = 1 TO 10000
  PSET (INT(RND(1) * 319 + 1), INT(RND(1) * 199 + 1)), INT(RND(1) * 255 + 1)
NEXT
V13hSEE
LOCATE 1, 1: PRINT "PSET, (1O,OOOX):"; TIMER - t!
SLEEP
'
'''
''' (1O,OOO) RANDOM LINES DEMO...
'''
'
V13hCLS 0
t! = TIMER
FOR x = 1 TO 10000
  x1 = INT(RND * 340) - 10: x2 = INT(RND * 340) - 10
  y1 = INT(RND * 220) - 10: y2 = INT(RND * 220) - 10
  LINE (x1, y1)-(x2, y2), INT(RND * 15) + 1
NEXT
V13hSEE
LOCATE 1, 1: PRINT "LINE, (1O,OOOX):"; TIMER - t!
SLEEP
'
'''
''' (1,OOO) RANDOM TILES DEMO...
'''
'
kind$ = "TRANSPARENT"
DO
  V13hCLS 0
  t! = TIMER
  FOR t = 1 TO 1000
   xx = INT(RND(1) * 341 + -20)
   yy = INT(RND(1) * 221 + -20)
   frame = INT(RND(1) * 3 + 1)
   V13hPUT TILES(), xx, yy, frame, kind$
  NEXT
  V13hSEE
  k$ = "PUT " + kind$ + ", (1,OOOX):"
  LOCATE 1, 1: PRINT k$; TIMER - t!
  SLEEP
  SELECT CASE kind$
   CASE "TRANSPARENT"
    kind$ = "BEHIND"
   CASE "BEHIND"
    kind$ = "PSET"
   CASE "PSET"
    kind$ = "PRESET"
   CASE "PRESET"
    kind$ = "AND"
   CASE "AND"
    kind$ = "OR"
   CASE "OR"
    kind$ = "XOR"
   CASE "XOR"
    EXIT DO
  END SELECT
LOOP
'
'PAN:
'
'''
'''PANNING SETUP...
'''
'
'FOR c = 1 TO 2
' IF c = 2 THEN V13hCLP 30, 20, 289, 179
' FOR yy = 0 TO 180 STEP 20
'  FOR xx = -20 TO 300 STEP 20
'   V13hPUT TILES(), xx, yy, c, "PSET"
'  NEXT
' NEXT
' V13hPUT TILES(), 150, 90, c + 1, "TRANSPARENT"
' V13hSEE
'NEXT
'
'V13hCLP 0, 0, 319, 199
'
'''
'''KEYBOARD (ARROWS) DEMO
'''
'
CLS
DO
  V13hKEY
  LOCATE 1, 1: PRINT "Arrow up:    "; BOARD(72); "   "
  LOCATE 2, 1: PRINT "Arrow down:  "; BOARD(80); "   "
  LOCATE 3, 1: PRINT "Arrow right: "; BOARD(77); "   "
  LOCATE 4, 1: PRINT "Arrow left:  "; BOARD(75); "   "
  LOCATE 6, 1: PRINT "Esc to exit."
LOOP UNTIL BOARD(1)
'
'''
'''KEYBOARD & PANNING DEMO
'''
'
'DO
  'V13hKEY
  'IF BOARD(80) THEN V13hPAN 8, 1, NOT FALSE
  'IF BOARD(75) THEN V13hPAN 6, 1, NOT FALSE
  'IF BOARD(77) THEN V13hPAN 4, 1, NOT FALSE
  'IF BOARD(72) THEN V13hPAN 2, 1, NOT FALSE
  'V13hTXT FONTS(), FALSE, 0, 0, 15, "Arrow up:    " + STR$(BOARD(80))
  'V13hTXT FONTS(), FALSE, 0, 8, 15, "Arrow down:  " + STR$(BOARD(72))
  'V13hTXT FONTS(), FALSE, 0, 16, 15, "Arrow right: " + STR$(BOARD(75))
  'V13hTXT FONTS(), FALSE, 0, 24, 15, "Arrow left:  " + STR$(BOARD(77))
  'V13hSEE
  'V13hCLS 0
'LOOP UNTIL BOARD(1)
'
END SUB

REM $STATIC
SUB V13hBLD (ARRAY(), file$)
'
length& = V13hLOF&(file$)
IF length& THEN
  Words = (length& \ 2) - 1
  REDIM ARRAY(0 TO Words)
  DEF SEG = VARSEG(ARRAY(0))
  BLOAD file$, 0
END IF
'
END SUB

SUB V13hBSV (ARRAY(), file$)
'
DEF SEG = VARSEG(ARRAY(0)): BSAVE file$, 0, (UBOUND(ARRAY) + 1) * 2
'
END SUB

SUB V13hCLP (XXleft, YYtop, XXright, YYbottom)
'
clipXXleft = XXleft
clipYYtop = YYtop
clipXXright = XXright
clipYYbottom = YYbottom
'
IF clipXXleft < 0 THEN clipXXleft = 0
IF clipXXright > 319 THEN clipXXright = 319
IF clipYYtop < 0 THEN clipYYtop = 0
IF clipYYbottom > 199 THEN clipYYbottom = 199
'
END SUB

SUB V13hCLS (colour)
'
IF colour THEN
  LINE (clipXXleft, clipYYtop)-(clipXXright, clipYYbottom), colour, BF
ELSE
  REDIM VIDEO(0 TO 31999)
END IF
'
END SUB

SUB V13hDEL (seconds!)
'
IF seconds! THEN
  '
  FOR inc& = 1 TO (SYS& * (seconds! * 18.6245)): NEXT
  '
ELSE
  '
  DEF SEG = &H40
  '
  DO: LOOP UNTIL PEEK(&H6C) <> PEEK(&H6C)
  '
  t = PEEK(&H6C)
  '
  DO
   FOR clc& = clc& TO clc& * 2: NEXT
  LOOP UNTIL t <> PEEK(&H6C)
  '
  SYS& = clc&
  '
  I& = 1
  '
  DO
   '
   I& = I& * 2
   d& = clc& \ I&
   '
   DO: LOOP UNTIL PEEK(&H6C) <> PEEK(&H6C)
   '
   t = PEEK(&H6C)
   '
   FOR inc& = 1 TO SYS&: NEXT
   '
   IF t <> PEEK(&H6C) THEN
    '
    SYS& = SYS& - d&
    '
   ELSE
    '
    SYS& = SYS& + d&
    '
   END IF
   '
  LOOP UNTIL I& >= clc&
  '
END IF
'

END SUB

SUB V13hFDE (fadeOUT, fadeINN, fadeSEC!)
'
OUT &H3C8, 0
'
IF fadeOUT THEN
  FOR y = 0 TO 63
   FOR x = 0 TO 255
    r = PAL(x).RED - y
    g = PAL(x).GRN - y
    b = PAL(x).BLU - y
    IF r < 0 THEN r = 0
    IF g < 0 THEN g = 0
    IF b < 0 THEN b = 0
    OUT &H3C9, r
    OUT &H3C9, g
    OUT &H3C9, b
   NEXT
   V13hDEL fadeSEC!
  NEXT
END IF
'
IF fadeINN THEN
  FOR y = 0 TO 63
   FOR x = 0 TO 255
    r = PAL(x).RED
    g = PAL(x).GRN
    b = PAL(x).BLU
    IF y < r THEN r = y
    IF y < g THEN g = y
    IF y < b THEN b = y
    OUT &H3C9, r
    OUT &H3C9, g
    OUT &H3C9, b
   NEXT
   V13hDEL fadeSEC!
  NEXT
END IF
'
END SUB

SUB V13hKEY STATIC
'
I = INP(&H60)
IF (I AND &H80) THEN
  BOARD(I XOR &H80) = FALSE
ELSE
  BOARD(I) = NOT FALSE
END IF
DEF SEG = &H40: POKE &H1C, PEEK(&H1A)
'
END SUB

REM $DYNAMIC
FUNCTION V13hLOF& (file$)
'
FileNum = FREEFILE
OPEN file$ FOR BINARY ACCESS READ AS FileNum
  V13hLOF& = LOF(FileNum) - 7
CLOSE FileNum
'
END FUNCTION

REM $STATIC
SUB V13hPAL (file$)
'
DEF SEG = VARSEG(PAL(0))
BLOAD file$, 0
OUT &H3C8, 0
FOR x = 0 TO 255
  OUT &H3C9, PAL(x).RED
  OUT &H3C9, PAL(x).GRN
  OUT &H3C9, PAL(x).BLU
NEXT
'
END SUB

SUB V13hPAN (direction, increment, wrap)
'
incw1 = increment - 1
DIM bufferX(0 TO incw1, clipXXleft TO clipXXright) AS INTEGER
DIM bufferY(0 TO incw1, clipYYtop TO clipYYbottom) AS INTEGER
segVIDEO = VARSEG(VIDEO(0))
SELECT CASE direction
  CASE 1
   IF wrap THEN
    FOR z = 0 TO incw1
     DEF SEG = segVIDEO + ((clipYYbottom - z) * 20)
     FOR x = clipXXleft TO clipXXright
      bufferX(z, x) = PEEK(x)
     NEXT
    NEXT
    FOR z = 0 TO incw1
     FOR y = clipYYtop TO clipYYbottom
      DEF SEG = segVIDEO + (y * 20)
      bufferY(z, y) = PEEK(clipXXleft + z)
     NEXT
    NEXT
   END IF
   inc1 = clipYYbottom - increment
   inc2 = clipXXleft + increment
   inc3 = 319 * increment
   FOR y = inc1 TO clipYYtop STEP -1
    DEF SEG = segVIDEO + (y * 20)
    FOR x = inc2 TO clipXXright
     POKE (x + inc3), PEEK(x)
    NEXT
   NEXT
   IF wrap THEN
    FOR z = 0 TO incw1
     incw2 = incw1 - z
     DEF SEG = segVIDEO + ((clipYYtop + z) * 20)
     FOR x = clipXXleft TO (clipXXright - increment)
      POKE x, bufferX(incw2, (x + increment))
     NEXT
     ninc = clipXXleft
     FOR x = (clipXXright - incw1) TO clipXXright
      POKE x, bufferX(incw2, ninc)
      ninc = ninc + 1
     NEXT
    NEXT
    FOR z = 0 TO incw1
     inc1 = (clipXXright - incw1) + z
     FOR y = (clipYYtop + increment) TO clipYYbottom
      DEF SEG = segVIDEO + (y * 20)
      POKE inc1, bufferY(z, (y - increment))
     NEXT
    NEXT
   END IF
  CASE 2
   IF wrap THEN
    FOR y = 0 TO incw1
     DEF SEG = segVIDEO + ((clipYYbottom - y) * 20)
     FOR x = clipXXleft TO clipXXright
      bufferX(y, x) = PEEK(x)
     NEXT
    NEXT
   END IF
   inc1 = clipYYbottom - increment
   inc2 = 320 * increment
   FOR y = inc1 TO clipYYtop STEP -1
    DEF SEG = segVIDEO + (y * 20)
    FOR x = clipXXleft TO clipXXright
     POKE (x + inc2), PEEK(x)
    NEXT
   NEXT
   IF wrap THEN
    FOR y = 0 TO incw1
     incw2 = incw1 - y
     DEF SEG = segVIDEO + ((clipYYtop + y) * 20)
     FOR x = clipXXleft TO clipXXright
      POKE x, bufferX(incw2, x)
     NEXT
    NEXT
   END IF
  CASE 3
   IF wrap THEN
    FOR z = 0 TO incw1
     DEF SEG = segVIDEO + ((clipYYbottom - z) * 20)
     FOR x = clipXXleft TO clipXXright
      bufferX(z, x) = PEEK(x)
     NEXT
    NEXT
    FOR z = 0 TO incw1
     inc1 = clipXXright - z
     FOR y = clipYYtop TO clipYYbottom
      DEF SEG = segVIDEO + (y * 20)
      bufferY(z, y) = PEEK(inc1)
     NEXT
    NEXT
   END IF
   inc1 = clipYYbottom - increment
   inc2 = clipXXright - increment
   inc3 = 321 * increment
   FOR y = inc1 TO clipYYtop STEP -1
    DEF SEG = segVIDEO + (y * 20)
    FOR x = inc2 TO clipXXleft STEP -1
     POKE (x + inc3), PEEK(x)
    NEXT
   NEXT
   IF wrap THEN
    FOR z = 0 TO incw1
     incw2 = incw1 - z
     DEF SEG = segVIDEO + ((clipYYtop + z) * 20)
     FOR x = (clipXXleft + increment) TO clipXXright
      POKE x, bufferX(incw2, (x - increment))
     NEXT
     ninc = clipXXright - incw1
     FOR x = clipXXleft TO clipXXleft + incw1
      POKE x, bufferX(incw2, ninc)
      ninc = ninc + 1
     NEXT
    NEXT
    FOR z = 0 TO incw1
     inc1 = (clipXXleft + incw1) - z
     FOR y = (clipYYtop + increment) TO clipYYbottom
      DEF SEG = segVIDEO + (y * 20)
      POKE inc1, bufferY(z, (y - increment))
     NEXT
    NEXT
   END IF
  CASE 4
   IF wrap THEN
    FOR y = clipYYtop TO clipYYbottom
     DEF SEG = segVIDEO + (y * 20)
     FOR x = 0 TO incw1
      bufferY(x, y) = PEEK(clipXXleft + x)
     NEXT
    NEXT
    END IF
   inc1 = clipXXright - increment
   FOR y = clipYYtop TO clipYYbottom
    DEF SEG = segVIDEO + (y * 20)
    FOR x = clipXXleft TO inc1
     POKE x, PEEK(x + increment)
    NEXT
   NEXT
   IF wrap THEN
    FOR y = clipYYtop TO clipYYbottom
     DEF SEG = segVIDEO + (y * 20)
     inc1 = (clipXXright - incw1)
     FOR x = 0 TO incw1
      POKE inc1 + x, bufferY(x, y)
     NEXT
    NEXT
   END IF
  CASE 6
   IF wrap THEN
    FOR y = clipYYtop TO clipYYbottom
     DEF SEG = segVIDEO + (y * 20)
     inc1 = (clipXXright - incw1)
     FOR x = 0 TO incw1
      bufferY(x, y) = PEEK(inc1 + x)
     NEXT
    NEXT
   END IF
   inc1 = clipXXleft + increment
   FOR y = clipYYtop TO clipYYbottom
    DEF SEG = segVIDEO + (y * 20)
    FOR x = clipXXright TO inc1 STEP -1
     POKE x, PEEK(x - increment)
    NEXT
   NEXT
   IF wrap THEN
    FOR y = clipYYtop TO clipYYbottom
     DEF SEG = segVIDEO + (y * 20)
     FOR x = 0 TO incw1
      POKE (clipXXleft + x), bufferY(x, y)
     NEXT
    NEXT
   END IF
  CASE 7
   IF wrap THEN
    FOR z = 0 TO incw1
     DEF SEG = segVIDEO + ((clipYYtop + z) * 20)
     FOR x = clipXXleft TO clipXXright
      bufferX(z, x) = PEEK(x)
     NEXT
    NEXT
    FOR z = 0 TO incw1
     FOR y = clipYYtop TO clipYYbottom
      DEF SEG = segVIDEO + (y * 20)
      bufferY(z, y) = PEEK(clipXXleft + z)
     NEXT
    NEXT
   END IF
   inc1 = clipYYbottom - increment
   inc2 = clipXXright - increment
   inc3 = (321 * increment)
   FOR y = clipYYtop TO inc1
    DEF SEG = segVIDEO + (y * 20)
    FOR x = clipXXleft TO inc2
     POKE x, PEEK(x + inc3)
    NEXT
   NEXT
   IF wrap THEN
    FOR z = 0 TO incw1
     incw2 = incw1 - z
     DEF SEG = segVIDEO + ((clipYYbottom - z) * 20)
     FOR x = clipXXleft TO (clipXXright - increment)
      POKE x, bufferX(incw2, (x + increment))
     NEXT
     ninc = 0
     FOR x = (clipXXright - incw1) TO clipXXright
      POKE x, bufferX(incw2, (clipXXleft + ninc))
      ninc = ninc + 1
     NEXT
    NEXT
    FOR z = 0 TO incw1
     inc1 = (clipXXright - incw1) + z
     FOR y = clipYYtop TO (clipYYbottom - increment)
      DEF SEG = segVIDEO + (y * 20)
      POKE inc1, bufferY(z, (y + increment))
     NEXT
    NEXT
   END IF
  CASE 8
   IF wrap THEN
    FOR y = 0 TO incw1
     DEF SEG = segVIDEO + ((clipYYtop + y) * 20)
     FOR x = clipXXleft TO clipXXright
      bufferX(y, x) = PEEK(x)
     NEXT
    NEXT
   END IF
   inc1 = clipYYbottom - increment
   inc2 = 320 * increment
   FOR y = clipYYtop TO inc1
    DEF SEG = segVIDEO + (y * 20)
    FOR x = clipXXleft TO clipXXright
     POKE x, PEEK(x + inc2)
    NEXT
   NEXT
   IF wrap THEN
    FOR y = incw1 TO 0 STEP -1
     incw2 = incw1 - y
     DEF SEG = segVIDEO + ((clipYYbottom - y) * 20)
     FOR x = clipXXleft TO clipXXright
      POKE x, bufferX(incw2, x)
     NEXT
    NEXT
   END IF
   '
  CASE 9
   '
   IF wrap THEN
    FOR z = 0 TO incw1
     DEF SEG = segVIDEO + ((clipYYtop + z) * 20)
     FOR x = clipXXleft TO clipXXright
      bufferX(z, x) = PEEK(x)
     NEXT
    NEXT
    FOR z = 0 TO incw1
     inc1 = (clipXXright - z)
     FOR y = clipYYtop TO clipYYbottom
      DEF SEG = segVIDEO + (y * 20)
      bufferY(z, y) = PEEK(inc1)
     NEXT
    NEXT
   END IF
   inc1 = clipYYbottom - increment
   inc2 = clipXXleft + increment
   inc3 = (319 * increment)
   FOR y = clipYYtop TO inc1
    DEF SEG = segVIDEO + (y * 20)
    FOR x = clipXXright TO inc2 STEP -1
     POKE x, PEEK(x + inc3)
    NEXT
   NEXT
   IF wrap THEN
    FOR z = 0 TO incw1
     incw2 = incw1 - z
     DEF SEG = segVIDEO + ((clipYYbottom - z) * 20)
     FOR x = (clipXXleft + increment) TO clipXXright
      POKE x, bufferX(incw2, (x - increment))
     NEXT
     ninc = incw1
     FOR x = clipXXleft TO clipXXleft + incw1
      POKE x, bufferX(incw2, (clipXXright - ninc))
      ninc = ninc - 1
     NEXT
    NEXT
    FOR z = 0 TO incw1
     inc1 = (clipXXleft + incw1) - z
     FOR y = clipYYtop TO (clipYYbottom - increment)
      DEF SEG = segVIDEO + (y * 20)
      POKE inc1, bufferY(z, (y + increment))
     NEXT
    NEXT
   END IF
END SELECT
'

END SUB

SUB V13hPNT (ARRAY(), frame)
'
IF PNT.switch THEN
  REGX.AX = 3
  INTERRUPTX &H33, REGX, REGX
  PNT.lb = ((REGX.BX AND 1) <> 0)
  PNT.rb = ((REGX.BX AND 2) <> 0)
  PNT.xx = REGX.CX \ 2
  PNT.yy = REGX.DX
  PNT.frame = frame
  IF PNT.xx < PNT.minXX THEN PNT.xx = PNT.minXX
  IF PNT.xx > PNT.maxXX THEN PNT.xx = PNT.maxXX
  IF PNT.yy < PNT.minYY THEN PNT.yy = PNT.minYY
  IF PNT.yy > PNT.maxYY THEN PNT.yy = PNT.maxYY
  '
  V13hPUT ARRAY(), PNT.xx, PNT.yy, PNT.frame, "TRANSPARENT"
  '
END IF
'
END SUB

SUB V13hPUT (ARRAY(), XXleft, YYtop, frame, mode$)
'
IF frame THEN
  '
  VIDEOseg = VARSEG(VIDEO(0))
  TILESseg = VARSEG(ARRAY(0))
  '
  TILESwidth = ARRAY(0) \ 8
  '
  TH = ARRAY(1) - 1
  TW = TILESwidth - 1
  TP = (TILESwidth * ARRAY(1)) + 4
  TF = frame - 1
  TL = XXleft + TW
  TT = YYtop + TH
  '
  'TI = (TP \ 2) * TF: IF TI > UBOUND(ARRAY) THEN EXIT SUB
  '
  IF XXleft < clipXXleft THEN
   CLIP = NOT FALSE
   XL = clipXXleft
   CLIPadd = clipXXleft - XXleft
   IF CLIPadd > TW THEN EXIT SUB
   IF CLIPadd < 0 THEN CLIPadd = -CLIPadd
   CL = CLIPadd
  ELSE
   XL = XXleft
  END IF
  '
  IF TL > clipXXright THEN
   CLIP = NOT FALSE
   XR = clipXXright
   CLIPadd = TL - clipXXright
   IF CLIPadd > TW THEN EXIT SUB
  ELSE
   XR = TL
  END IF
  '
  IF YYtop < clipYYtop THEN
   CLIP = NOT FALSE
   YT = VIDEOseg + (clipYYtop * 20)
   CT = clipYYtop - YYtop
   IF CT > TH THEN EXIT SUB
   IF CT < 0 THEN CT = -CT
   CT = CT * TILESwidth
  ELSE
   YT = VIDEOseg + (YYtop * 20)
  END IF
  '
  IF TT > clipYYbottom THEN
   CLIP = NOT FALSE
   YB = VIDEOseg + (clipYYbottom * 20)
   IF (TT - clipYYbottom) > TH THEN EXIT SUB
  ELSE
   YB = VIDEOseg + (TT * 20)
  END IF
  '
  t = ((TP * TF) + (CL + CT)) + 4
  '
  DIM c(XL TO XR)
  '
  SELECT CASE mode$
    '
   CASE "SOLID"
    '
    FOR y = YT TO YB STEP 20
     DEF SEG = TILESseg
     FOR x = XL TO XR
      c(x) = PEEK(t)
      t = t + 1
     NEXT
     t = t + CLIPadd
     DEF SEG = y
     FOR x = XL TO XR
      POKE x, c(x)
     NEXT
    NEXT
    '
   CASE "TRANSPARENT"
    '
    FOR y = YT TO YB STEP 20
     DEF SEG = TILESseg
     FOR x = XL TO XR
      c(x) = PEEK(t)
      t = t + 1
     NEXT
     t = t + CLIPadd
     DEF SEG = y
     FOR x = XL TO XR
      IF c(x) THEN POKE x, c(x)
     NEXT
    NEXT
    '
   CASE "BEHIND"
    '
    FOR y = YT TO YB STEP 20
     DEF SEG = TILESseg
     FOR x = XL TO XR
      c(x) = PEEK(t)
      t = t + 1
     NEXT
     t = t + CLIPadd
     DEF SEG = y
     FOR x = XL TO XR
      IF PEEK(x) THEN  ELSE POKE x, c(x)
     NEXT
    NEXT
    '
   CASE "PSET"
    '
    IF CLIP THEN
     FOR y = YT TO YB STEP 20
      DEF SEG = TILESseg
      FOR x = XL TO XR
       c(x) = PEEK(t)
       t = t + 1
      NEXT
      t = t + CLIPadd
      DEF SEG = y
      FOR x = XL TO XR
       POKE x, c(x)
      NEXT
     NEXT
    ELSE
     PUT (XXleft, YYtop), ARRAY((TP \ 2) * TF), PSET
    END IF
    '
   CASE "PRESET"
    '
    IF CLIP THEN
     FOR y = YT TO YB STEP 20
      DEF SEG = TILESseg
      FOR x = XL TO XR
       c(x) = PEEK(t)
       t = t + 1
      NEXT
      t = t + CLIPadd
      DEF SEG = y
      FOR x = XL TO XR
       POKE x, NOT c(x)
      NEXT
     NEXT
    ELSE
     PUT (XXleft, YYtop), ARRAY((TP \ 2) * TF), PRESET
    END IF
    '
   CASE "AND"
    '
    IF CLIP THEN
     FOR y = YT TO YB STEP 20
      DEF SEG = TILESseg
      FOR x = XL TO XR
       c(x) = PEEK(t)
       t = t + 1
      NEXT
      t = t + CLIPadd
      DEF SEG = y
      FOR x = XL TO XR
       POKE x, c(x) AND PEEK(x)
      NEXT
     NEXT
    ELSE
     PUT (XXleft, YYtop), ARRAY((TP \ 2) * TF), AND
    END IF
    '
   CASE "OR"
    '
    IF CLIP THEN
     FOR y = YT TO YB STEP 20
      DEF SEG = TILESseg
      FOR x = XL TO XR
       c(x) = PEEK(t)
       t = t + 1
      NEXT
      t = t + CLIPadd
      DEF SEG = y
      FOR x = XL TO XR
       POKE x, c(x) OR PEEK(x)
      NEXT
     NEXT
    ELSE
     PUT (XXleft, YYtop), ARRAY((TP \ 2) * TF), OR
    END IF
    '
   CASE "XOR"
    '
    IF CLIP THEN
     FOR y = YT TO YB STEP 20
     DEF SEG = TILESseg
      FOR x = XL TO XR
       c(x) = PEEK(t)
       t = t + 1
      NEXT
      t = t + CLIPadd
      DEF SEG = y
      FOR x = XL TO XR
       POKE x, c(x) XOR PEEK(x)
      NEXT
     NEXT
    ELSE
     PUT (XXleft, YYtop), ARRAY((TP \ 2) * TF), XOR
    END IF
    '
   CASE "FONT"
    '
    FOR y = YT TO YB STEP 20
     DEF SEG = TILESseg
     FOR x = XL TO XR
      c(x) = PEEK(t)
      t = t + 1
     NEXT
     t = t + CLIPadd
     DEF SEG = y
     FOR x = XL TO XR
      IF c(x) THEN POKE x, c(x) + FONTScolour
     NEXT
    NEXT
    '
  END SELECT
  '
END IF
'
END SUB

SUB V13hSEE
'
DEF SEG = VARSEG(VIDEO(0)): BSAVE "video.tmp", 0, &HFA00
DEF SEG = &HA000: BLOAD "video.tmp", 0
'
END SUB

SUB V13hSET
'
SCREEN 13: CLS : COLOR 255
'
'Capture current palette
'
OUT &H3C7, 0
'
FOR x = 0 TO 255
  PAL(x).RED = INP(&H3C9)
  PAL(x).GRN = INP(&H3C9)
  PAL(x).BLU = INP(&H3C9)
NEXT
'
REG.AX = 0
INTERRUPTX &H33, REGX, REGX
IF REGX.AX THEN PNT.switch = NOT FALSE
'
'put MOUSE
'
REGX.AX = 4
REGX.CX = 0
REGX.DX = 0
INTERRUPTX &H33, REGX, REGX
'
'show MOUSE
'
REGX.AX = 1
INTERRUPTX &H33, REGX, REGX
'
'capture MOUSE
'
GET (0, 0)-(15, 15), MOUSE
'
'hide MOUSE
'
REGX.AX = 2
INTERRUPTX &H33, REGX, REGX
'
PNT.minXX = 0
PNT.minYY = 0
PNT.maxXX = 319
PNT.maxYY = 199
'
FOR x = 1 TO 32
  LOCATE 1, x: PRINT CHR$(x + 31)
  LOCATE 2, x: PRINT CHR$(x + 63)
  LOCATE 3, x: PRINT CHR$(x + 95)
NEXT
'
FOR y = 0 TO 23 STEP 8
  FOR x = 0 TO 255 STEP 8
   GET (x, y)-(x + 7, y + 7), FONTS(e)
   e = e + 34
  NEXT
NEXT
'
CLS : PRESET (160, 100), 0
'
VIDEOseg = VARSEG(VIDEO(0))
DEF SEG : BSAVE "video.tmp", &H0, &HFA00
DEF SEG = VIDEOseg: BLOAD "video.tmp", 0
FOR I = LBOUND(VIDEO) TO (UBOUND(VIDEO) - 1)
  IF VIDEO(I) = &H7DA0 AND VIDEO(I + 1) = &HA000 THEN
   Vtarget = ((I + 1) * 2)
   V13lo = VIDEOseg AND &HFF
   IF (VIDEOseg AND &H8000) THEN
    V13hi = ((VIDEOseg AND &HFF00) \ &HFF) + &H100
   ELSE
    V13hi = (VIDEOseg AND &HFF00) \ &HFF
   END IF
   DEF SEG
   VGAlo = PEEK(Vtarget): VGAhi = PEEK(Vtarget + 1)
   POKE Vtarget, V13lo: POKE (Vtarget + 1), V13hi
  END IF
NEXT
'
V13hCLP 0, 0, 319, 199
'
COLOR 15
'
V13hDEL calibrate!
'
END SUB

SUB V13hTXT (ARRAY(), XXcenter, XXleft, YYtop, colour, text$)
'
FONTwidth = ARRAY(0) \ 8
FONTScolour = -255 + colour
FONTyy = YYtop
'
TL = LEN(text$)
'
IF XXcenter THEN
  CX = (clipXXleft + ((clipXXright - clipXXleft) + 1) \ 2)
  xx = CX - ((TL * FONTwidth) \ 2)
ELSE
  xx = XXleft
END IF
'
FOR x = 1 TO TL
  frame = (ASC(MID$(text$, x, 1)) - 31)
  FONTxx = xx + ((x - 1) * FONTwidth)
  V13hPUT ARRAY(), FONTxx, FONTyy, frame, "FONT"
NEXT
'
END SUB

Please don't distribute this program, I need to finish it first ;)

P.s...
let me know what you think, my goal here is to create the fastest pure QB screen 13 library on the internet!

Cya.

relsoft

07-30-2004, 02:03 PM
Cool Lib. :*).

http://rel.betterwebber.com/junk.php?id=4

na_th_an

07-30-2004, 05:28 PM
If you wanna this to be the fastest PQB lib, I suggest you to remove the disk usage for buffering.

Plasma

07-30-2004, 05:51 PM
Nice, but if something is copyrighted it cannot be public domain. You'll have to choose one or the other.

Nemesis

07-30-2004, 07:56 PM
THANX for trying the lib everyone, note that it's content is pretty bare compared to most of the current libs available, but I'm working on it :)
And Relsoft, I've seen your QBlib and it's very nice, with lots of routines, and pretty fast too!

Quote:If you wanna this to be the fastest PQB lib, I suggest you to remove the disk usage for buffering.

Yeah, I was thinking using the HD for the buffering (copying the VIDEO buffer to the VGA) might pose some problems, but on the systems I tested it on, using that method as opposed to blasting it using PUT was faster. So I might include an option allowing the user to choose the method he/she prefers.
(Thanx for pointing that out!)

Cya.
Pages: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
Qbasicnews.com > QbasicNews.Com > Challenges > 100% QB game