Qbasicnews.com
December 10, 2019, 11:30:44 AM *
Welcome, Guest. Please login or register.

Login with username, password and session length
News: Back to Qbasicnews.com | QB Online Help | FAQ | Chat | All Basic Code | QB Knowledge Base
 
   Home   Help Search Login Register  
Pages: 1 ... 7 8 [9] 10
  Print  
Author Topic: 100% QB game  (Read 44976 times)
Mac
Senior Member
**
Posts: 243


WWW
« Reply #120 on: January 20, 2005, 11:35:05 AM »

http://www.network54.com/Forum/273951

Don't laugh. It's harder than you think!

But not impossible. I've reached Guru level before (and lost it - back to Master)

Mac
Logged
Z!re
*/-\*
*****
Posts: 4599


« Reply #121 on: January 20, 2005, 03:20:13 PM »

Mac, wtf are you talking about?


http://forum.qbasicnews.com/viewtopic.php?t=8021
Logged
Mac
Senior Member
**
Posts: 243


WWW
« Reply #122 on: January 23, 2005, 01:41:08 PM »

John,

Nice program, but it doesn't seem to work on faster computers.

I put in some WAIT &H3DA, 8, 8: : WAIT &H3DA, 8
to slow things down.

Also fixed the program so it can cope with lack of the hiscore file

Got a hiscore of 280. The changes are posted in the QBasic Forum Challenges subforum.

Mac

http://www.network54.com/Forum/message?forumid=202193&messageid=1106492553
Logged
Spotted Cheetah
Ancient QBer
****
Posts: 400



WWW
« Reply #123 on: January 28, 2005, 08:19:06 PM »

Nemesis:

For pixel plotting i believe that POKEing is faster. But i think in a 3D engine nothing can beat my HLine routine in pure QB. In optimal case it updates 2 pixels in just one instruction while your code always need to call two functions to achieve the same! So i think both of us did not win... Smiley Use everything in it's proper place...

At sprite drawing if the programmer can solve that his sprites will always start at odd locations, my code will be faster again. Simply executing less QB statements. Possibly HLine can be boosted too with some bit manipulation mechanisms to use LONGs for the screen page array, but it might only help if using many larger triangles.

I think i will do some speed tests too, but as i said i am focusing on 16 color screens, i only use screen 13 for just this challenge.

The other programs: I will look in them when i will have time. I still think that Barrack is a very good idea Smiley
Logged

fter 60 million years a civilization will search for a meteorite destroying most of the living creatures around this age...

There must be a better future for the Cheetahs!

http://rcs.fateback.com/
Nemesis
Forum Regular
**
Posts: 118



« Reply #124 on: February 02, 2005, 12:02:52 AM »

Quote

For pixel plotting i believe that POKEing is faster. But i think in a 3D engine nothing can beat my HLine routine in pure QB. In optimal case it updates 2 pixels in just one instruction while your code always need to call two functions to achieve the same! So i think both of us did not win...


Well, like I mentioned in my last post, we can't determine winners
or loosers if we don't even know what the competition is  :wink:
Anyways, I'll check out your HLINE routine but, I'm not convinced,
YET  Cheesy Now about updating 2 pixels in just one instruction, ummm... where is this code? Maybe you're refering to updating 2 pixels per call to a subroutine??? If this is the case then maybe I should post a sprite routine I made a while ago which does just that...(blits more than 1 pixel per call).

Quote

At sprite drawing if the programmer can solve that his sprites will always start at odd locations, my code will be faster again.


Sure but, probablly wouldn't be very pratical unless it was something you're specifically using for your own projects.
Heh, I can make a similar routine myself in about 5 min.
just blit whole integers  :roll:

Quote

HLine can be boosted too with some bit manipulation mechanisms to use LONGs for the screen page array, but it might only help if using many larger triangles.


Yeah, actually using LONG integer manipulation, something I've already mucked with is pretty fast. It's a bit more complicated though. (Give it a shot though, I'd like to see what you come up with!)

Quote

I think i will do some speed tests too, but as i said i am focusing on 16 color screens, i only use screen 13 for just this challenge.


Well since we're talking about transfering, moving, blitting, whatever... data, than these routines can be used in any screen resolution. (With of course minor modifications.)

So, anyways dude, I'm not trying too be an arse or anything but,
until I see some hard proof...  :barf:  :rotfl:

J/K

Hey, we should chat sometime.... you got AIM?
Maybe just E-mail would be cool too.
I'd like to discuss some more stuff with you, exchange ideas, etc...

Cya!

Nemesis
Logged
barok
Na_th_an
*****
Posts: 1727


How about a tasty lead sandwich?


« Reply #125 on: February 02, 2005, 12:29:54 AM »

Nemesis:  You ARE competitive, are you?  Your really sure and are trying your best that you have the BEST put routine out there, aren'tcha?  Wink  First me, now Spotted Cheetah.  Keep this up, and i may have to go and rewrite my blitter and make it faster. Wink  

Still, i'll do a few tests for you two.  Cheesy
Logged

Jumping Jahoolipers!
Nemesis
Forum Regular
**
Posts: 118



« Reply #126 on: February 02, 2005, 04:40:50 AM »

Quote from: "barok"
Nemesis:  You ARE competitive, are you?  Your really sure and are trying your best that you have the BEST put routine out there, aren'tcha?  Wink  First me, now Spotted Cheetah.  Keep this up, and i may have to go and rewrite my blitter and make it faster. Wink  

Still, i'll do a few tests for you to.  Cheesy


Heh... I've always been competitive my whole life, usually physical
type things but, yes very competitive  :king:
Best PUT routine out there? Naww, Ive seen alot better but,
as far as pure QB, I'd say it's probablly one of the fastest around though, you or I could make it faster. I kinda leaned towards making it not only fast but flexible, which usually sacrafices speed but, it makes for a more rounded routine. As of now, it really dosen't even have that many features yet. (I'll be adding more features here and there, I'm in no hurry though.)
Basically the PUT routine is part of my screen 13 gfx lib, which I'll use to make a few games that I have planned. I just started adding the rotozooming features for it, and as soon as I finish that
(really busy with other stuff at this time though), I'll release it to the public just so perhaps someone can learn from it or whatever.
Anyways, as far as it being one of the fastest pure QB put routines on the net, I'd say yes, (as far as what I've seen), but ofcourse, who's really writing QB PUT rutines anymore? It's like so obsolete, if I were to brag about it I'd be the biggest laughing stck on these forums  :rotfl:
I suppose I'll post the latest build later tonight so you and Cheetah can check it out, and if anyone makes a faster one then cool, I'd love to see it. If that were the case though, don't think you got me beat cause I'd tweak, optimize, or whatever, my routine and make it even faster  Cheesy  Smiley  :lol:

Laters.

Nemesis
Logged
Nemesis
Forum Regular
**
Posts: 118



« Reply #127 on: February 02, 2005, 11:19:54 AM »

Alright... here's my screen 13 lib, VIDEO13h v1.5...

Please don't distribute since this is not the official public release  :lol:

Feel free to beta this version, and this should be my last non-public release, so I suspect version 1.6 will be the official public release  8) And it will include all source, ofcourse, and also a .QLB version too!

Anyways check out the PUT routine which still doesn't include roto-zooming but, I did optimize it a bit, and it should be able to handle those large sprites, up to 320X200 in size even.
I also squashed some minor bugs here and there, so check it out!!!

Let me know what you think, and if you want to talk  :barf:
about it and tell me something like this should've been released like 5+ yrs. ago, then go ahead, let it out  :cry:
(Then in another 5 years when I finish some games with it you can
appologize, hehhh!!!)

Cya!

Nemesis

:::EDIT #1:::

Code:


'''
' VIDEO13h v1.5, QuicKBASIC 4.5; SCREEN 13 manipulation routines.
'
' (C)opyright 2005, Pure QB Innovations
'
' Email any questions, comments, or suggestions to...
'  Nemesis2473@yahoo.com
'
' THIS PROGRAM IS BEING RELEASED AS FREEWARE SOFTWARE AND MAY BE DISTRIBUTED
' FREELY AS LONG AS ANY PART OF THIS FILE IS NOT ALTERED IN ANY WAY.
' THE AUTHOR OF THIS PROGRAM IS BY NO MEANS RESPONSIBLE FOR ANY DAMMAGES
' THAT HAVE EITHER OCCURED OR MAY OCCUR WHILE USING ANY PART OF THIS PROGRAM.
' 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 PUTcolour, PUTscale, PUTrotate
COMMON SHARED WXL, WYT, WXR, WYB
COMMON SHARED SYS&
'
DECLARE FUNCTION V13hKEY (scan)
DECLARE FUNCTION V13hLOF& (FILE$)
'
DECLARE SUB INTERRUPTX (INTNUM AS INTEGER, INREG AS REGXdata, OUTREG AS REGXdata)
'
DECLARE SUB V13hCLS (colour)
DECLARE SUB V13hWIN (xxLEFT, yyTOP, xxRIGHT, yyBOTTOM)
DECLARE SUB V13hCPY (Tsegm&, Toffs, Dsegm&, Doffs, BYTES&, Blits$)
DECLARE SUB V13hGRD (colour, gradient)
DECLARE SUB V13hPAL (FILE$)
DECLARE SUB V13hBLN (FILE$)
DECLARE SUB V13hBLD (ARRAY(), FILE$)
DECLARE SUB V13hBND (ARRAY(), FILE$)
DECLARE SUB V13hBSV (ARRAY(), FILE$)
DECLARE SUB V13hDLY (seconds!)
DECLARE SUB V13hFDE (fadeOUT, fadeINN, fadeSEC!)
DECLARE SUB V13hPNT (ARRAY(), FRAME, colour, SKIN$)
DECLARE SUB V13hPUT (ARRAY(), xxLEFT, yyTOP, FRAME, SKIN$)
DECLARE SUB V13hSEE ()
DECLARE SUB V13hSET ()
DECLARE SUB V13hTXT (ARRAY(), XXcenter, xxLEFT, yyTOP, colour, text$, SKIN$)
'
DECLARE SUB DEMO ()
'
DIM SHARED PAL(255) AS PALdata
'
DIM SHARED BLN&(255)
'
DIM SHARED VIDEO(32007)
DIM SHARED BLEND(16447)
DIM SHARED FONTS(3263)
DIM SHARED MOUSE(129)
DIM SHARED MASK(129)
DIM SHARED BOARD(127)
 '
 V13hSET
 '
 DEMO
 '
 SYSTEM
 '

REM $STATIC
SUB DEMO
 '
 'DRAW AND GET, (-1- 64*64) TILE. (DEMO)...
 '
 DIM BALL(2049)
 FOR S = 31 TO 1 STEP -1
  CIRCLE (32, 32), S, 31 - S \ 2
  PAINT (32, 32), 31 - S \ 2
 NEXT S
 GET (0, 0)-(63, 63), BALL(0)
 '
 CLS
 '
 ' DRAW AND GET, (-3- 20*20) TILES. (DEMO)...
 '
 DIM TILES(605)
 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
 '
 'Scaling test demo...
 '
 'CLS
 'PUTscale = 25
 'V13hPUT TILES(), 0, 0, 1, "SCALE"
 '
 'Gradient search test demo...
 '
 'CLS
 'FOR c = 1 TO 15
 ' FOR x = 0 TO 0
 '  V13hGRD c, x
 '  LINE (20, x)-(120, x)
 '  V13hSEE
 '  SLEEP
 ' NEXT
 'NEXT
 '
 'SCROLLING FONT DEMO...
 '
 FOR y = (WYB + 1) TO (WYT - (32 * 8)) STEP -1
  V13hCLS 0
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 0), 15, "-WELCOME-", "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 2), 7, "VIDEO13h v1.5, (Pure QB v4.5),", "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 4), 7, "SCREEN 13; manipulation routines.", "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 8), 15, "-FEATURES-", "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 10), 7, "320X200X256 resolution (VGA),", "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 12), 7, "page/sprite/font buffering,", "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 14), 7, "mouse/keyboard handlers,", "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 16), 7, "file i/o, and memory routines.", "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 18), 7, "All while still supporting QB's", "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 20), 7, "original graphical commands too!", "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 24), 15, "-REQUIREMENTS-", "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 26), 7, "100+ Mhz PC processor, VGA monitor,", "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 28), 7, "keyboard or mouse, and QuickBASIC v4.5", "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 32), 15, "-CREDITS-", "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 34), 15, "...Programmer...", "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 36), 7, "Nemesis@qbasicnews.com", "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 40), 15, "...Special Thanks...", "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 42), 7, "Jonkirwan@aol.com", "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 44), 7, "Eclipzer@aol.com", "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 46), 7, "KingJayIII@aol.com", "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 48), 7, "Barok@qbasicnews.com", "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 50), 7, "Spotted Cheetah@qbasicnews.com", "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 52), 7, "Adigun A. Polack@qbasicnews.com", "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 54), 7, "na_th_an@qbasicnews.com", "TRANSPARENT"
  V13hTXT FONTS(), FALSE, 0, (8 * 24), 15, "(C)opyright 2005,", "BLEND"
  V13hTXT FONTS(), FALSE, (8 * 18), (8 * 24), 12, "Pure", "BLEND"
  V13hTXT FONTS(), FALSE, (8 * 23), (8 * 24), 10, "QB", "BLEND"
  V13hTXT FONTS(), FALSE, (8 * 26), (8 * 24), 9, "Innovations", "BLEND"
  V13hSEE
  'WAIT &H3DA, 8
  IF LEN(INKEY$) THEN EXIT FOR
  '
 NEXT
 '
 'FADE OUT/IN DEMO...
 '
 V13hFDE NOT FALSE, NOT FALSE, 1 / 32
 '
 DO: LOOP UNTIL LEN(INKEY$)
 '
 '''
 '''MOUSE MASKING DEMO...
 '''
 '
 DO
  '
  V13hPNT MOUSE(), 1, 15, "MASK"
  '
  V13hSEE
  '
  V13hPUT MASK(), PNT.xx, PNT.yy, PNT.FRAME, "PSET"
  '
 LOOP UNTIL LEN(INKEY$)
 '
 '''
 '''NO-MASK MOUSE DEMO...
 '''
 '
 DO
  '
  V13hCLS 0
  '
  V13hTXT FONTS(), NOT FALSE, 0, 14, 2, "PNT.xx = " + STR$(PNT.xx), "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, 22, 2, "PNT.yy = " + STR$(PNT.yy), "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, 169, 4, "PNT.lb = " + STR$(PNT.LB), "TRANSPARENT"
  V13hTXT FONTS(), NOT FALSE, 0, 177, 4, "PNT.rb = " + STR$(PNT.rb), "TRANSPARENT"
  '
  V13hPNT MOUSE(), 1, 15, "TRANSPARENT"
  '
  V13hSEE
  '
 LOOP UNTIL LEN(INKEY$)
 '
 'DELAY DEMO...
 '
 CLS
 LOCATE 1, 1: PRINT "V13hDLY 1/4 seconds..."
 PRINT
 DO: LOOP UNTIL TIMER <> TIMER
 DO
  t! = TIMER
  V13hDLY 1 / 4
  PRINT TIMER - t!
 LOOP UNTIL LEN(INKEY$)
 '
 CLS
 LOCATE 1, 1: PRINT "V13hDLY 1/8 seconds..."
 PRINT
 DO: LOOP UNTIL TIMER <> TIMER
 DO
  t! = TIMER
  V13hDLY 1 / 8
  PRINT TIMER - t!
 LOOP UNTIL LEN(INKEY$)
 '
 CLS
 LOCATE 1, 1: PRINT "V13hDLY 1/32 seconds..."
 PRINT
 DO: LOOP UNTIL TIMER <> TIMER
 DO
  t! = TIMER
  V13hDLY 1 / 32
  PRINT TIMER - t!
 LOOP UNTIL LEN(INKEY$)
 '
 '''
 ''' CLEAR SCREEN (256X) DEMO...
 '''
 '
 DO: LOOP UNTIL TIMER <> TIMER
 t! = TIMER
 FOR c = 0 TO 255
  V13hCLS c
  V13hSEE
 NEXT
 t! = TIMER - t!
 LOCATE 1, 1: PRINT "V13hCLS (256X):"; t!
 DO: LOOP UNTIL LEN(INKEY$)
 '
 '''
 ''' MEMORY COPY DEMO...
 '''
 '
 DO: LOOP UNTIL TIMER <> TIMER
 FOR y = 0 TO 255
  IF y > 127 THEN
   z = ((-256 + y) * 256) + y
  ELSE
   z = (y * 256) + y
  END IF
  FOR x = 8 TO 32007
   VIDEO(x) = z
  NEXT
  c! = TIMER
  V13hCPY VARSEG(VIDEO(0)), 16, &HA000, 0, 64000, "SOLID"
  t! = t! + ABS(TIMER - c!)
 NEXT
 B& = (y - 1) * 64000
 CLS : COLOR 7
 PRINT B&; "bytes in..."; t!; "sec."
 PRINT
 PRINT "That was SOLID copy, which copies data"
 PRINT "from one point in memory to another."
 PRINT "TRANSPARENT copy, copies data from"
 PRINT "one point in memory to another,"
 PRINT "except for all 0 (null bytes)."
 DO: LOOP UNTIL LEN(INKEY$)
 '
 '''
 ''' (1O,OOO) RANDOM PIXELS DEMO...
 '''
 V13hCLS 0
 DO: LOOP UNTIL TIMER <> TIMER
 t! = TIMER
 FOR x = 1 TO 10000
  PSET (INT(RND(1) * 319 + 1), INT(RND(1) * 199 + 1)), INT(RND(1) * 255 + 1)
 NEXT
 t! = TIMER - t!
 V13hSEE
 LOCATE 1, 1: PRINT "PSET (1O,OOOX):"; t!
 DO: LOOP UNTIL LEN(INKEY$)
 '
 '''
 ''' (1O,OOO) RANDOM LINES DEMO...
 '''
 '
 V13hCLS 0
 DO: LOOP UNTIL TIMER <> TIMER
 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
 t! = TIMER - t!
 V13hSEE
 LOCATE 1, 1: PRINT "LINE (1O,OOOX):"; t!
 DO: LOOP UNTIL LEN(INKEY$)
 '
 '''
 ''' (1O,OOO) RANDOM TILES DEMO...
 '''
 '
 kind$ = "ANDXOR"
 DO
  V13hCLS 0
  DO: LOOP UNTIL TIMER <> TIMER
  t! = TIMER
  FOR x = 1 TO 2500
   xx = -63 + INT(RND(1) * 383 + 1)
   yy = -63 + INT(RND(1) * 263 + 1)
   V13hPUT BALL(), xx, yy, 1, kind$
   '
   '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
  t! = TIMER - t!
  V13hSEE
  K$ = "V13hPUT " + kind$ + " (2,5OOX):"
  LOCATE 1, 1: PRINT K$; t!
  DO: LOOP UNTIL LEN(INKEY$)
  SELECT CASE kind$
   CASE "ANDXOR"
    kind$ = "TRANSPARENT"
   CASE "TRANSPARENT"
    kind$ = "BLEND"
   CASE "BLEND"
    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
   CASE ELSE
  END SELECT
 LOOP
 '
 '''
 '''KEYBOARD & SCROLLING DEMO
 '''
 '
 t! = TIMER
 DO
  S = S + 1
  IF ABS(TIMER - t!) >= 1 THEN FPS = S: S = 0: t! = TIMER
  FOR yy = -20 TO 200 STEP 20
   FOR xx = -20 TO 320 STEP 20
    V13hPUT TILES(), (xx + ZX), (yy + ZY), 1, "PSET"
   NEXT
  NEXT
  '
  V13hPUT TILES(), 149, 89, 2, "TRANSPARENT"
  '
  IF V13hKEY(80) THEN ZY = ZY - 1: AD = NOT FALSE ELSE AD = FALSE
  IF V13hKEY(75) THEN ZX = ZX + 1: AL = NOT FALSE ELSE AL = FALSE
  IF V13hKEY(77) THEN ZX = ZX - 1: AR = NOT FALSE ELSE AR = FALSE
  IF V13hKEY(72) THEN ZY = ZY + 1: AU = NOT FALSE ELSE AU = FALSE
  IF ZY > 19 OR ZY < -19 THEN ZY = 0
  IF ZX > 19 OR ZX < -19 THEN ZX = 0
  V13hTXT FONTS(), FALSE, 0, 0, 10, "FPS:" + STR$(FPS), "TRANSPARENT"
  V13hTXT FONTS(), FALSE, 0, 16, 11, "Arrow up:   " + STR$(AU), "TRANSPARENT"
  V13hTXT FONTS(), FALSE, 0, 24, 11, "Arrow down: " + STR$(AD), "TRANSPARENT"
  V13hTXT FONTS(), FALSE, 0, 32, 11, "Arrow right:" + STR$(AR), "TRANSPARENT"
  V13hTXT FONTS(), FALSE, 0, 40, 11, "Arrow left: " + STR$(AL), "TRANSPARENT"
  V13hTXT FONTS(), FALSE, 0, 56, 12, "Esc to exit.", "TRANSPARENT"
  V13hSEE
 LOOP UNTIL INKEY$ = CHR$(27)
 '
 EXIT SUB
'
END SUB

SUB V13hBLD (ARRAY(), FILE$)
 '
 LENGTH& = V13hLOF&(FILE$)
 IF LENGTH& THEN
  Words = ((LENGTH& + 1) \ 2) - 1
  REDIM ARRAY(Words)
  DEF SEG = VARSEG(ARRAY(0))
  BLOAD FILE$, 0
 END IF
 '
END SUB

SUB V13hBLN (FILE$)
 '
 DEF SEG = VARSEG(BLEND(0))
 '
 IF V13hLOF&(FILE$) > 0 THEN
  BLOAD FILE$, 0
 ELSE
  FOR P = 0 TO 254
   FOR B = P TO 255
    '
    max = 11907
    '
    rt = (PAL(P).Red + PAL(B).Red) \ 2
    gt = (PAL(P).Grn + PAL(B).Grn) \ 2
    BT = (PAL(P).Blu + PAL(B).Blu) \ 2
    '
    FOR c = 0 TO 255
     rd = rt - PAL(c).Red
     gd = gt - PAL(c).Grn
     BD = BT - PAL(c).Blu
     v = (rd * rd) + (gd * gd) + (BD * BD)
     IF v < max THEN
      max = v
      tag = c
      IF v THEN  ELSE EXIT FOR
     END IF
    NEXT
    POKE incb&, tag
    incb& = incb& + 1
   NEXT
  NEXT
  '
  BSAVE FILE$, 0, (incb& + 1)
  '
 END IF
 '
END SUB

SUB V13hBND (ARRAY(), FILE$)
 '
 LENGTH& = V13hLOF&(FILE$)
 IF LENGTH& THEN
  Words = (LENGTH& \ 2)
  U = UBOUND(ARRAY)
  IF U THEN
   V13hBSV ARRAY(), "buffer.tmp"
   REDIM ARRAY(U + Words)
   DEF SEG = VARSEG(ARRAY(0)): BLOAD "buffer.tmp", 0
   KILL "buffer.tmp"
   BLOAD FILE$, (U + 1) * 2
  ELSE
   REDIM ARRAY(Words - 1)
   DEF SEG = VARSEG(ARRAY(0))
   BLOAD FILE$, 0
  END IF
 END IF
 '
END SUB

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

SUB V13hCLS (colour)
 '
 LINE (WXL, WYT)-(WXR, WYB), colour, BF
 '
END SUB

SUB V13hCPY (Tsegm&, Toffs, Dsegm&, Doffs, BYTES&, Blits$)
'
TS& = Tsegm&
DS& = Dsegm&
'
DIM BT(&HF)
DIM BD(&HF)
'
FOR x = &H0 TO &HF
 BT(x) = (x + Toffs)
 BD(x) = (x + Doffs)
NEXT
'
SELECT CASE Blits$
 '
 CASE "SOLID"
  '
  FOR x = &H1 TO (BYTES& \ &H10)
   DEF SEG = TS&
   '
tBF: BF = PEEK(BT(&HF))
tBE: BE = PEEK(BT(&HE))
tBD: BD = PEEK(BT(&HD))
tBC: BC = PEEK(BT(&HC))
tBB: BB = PEEK(BT(&HB))
tBA: BA = PEEK(BT(&HA))
tB9: B9 = PEEK(BT(&H9))
tB8: B8 = PEEK(BT(&H8))
tB7: B7 = PEEK(BT(&H7))
tB6: B6 = PEEK(BT(&H6))
tB5: B5 = PEEK(BT(&H5))
tB4: B4 = PEEK(BT(&H4))
tB3: B3 = PEEK(BT(&H3))
tB2: B2 = PEEK(BT(&H2))
tB1: B1 = PEEK(BT(&H1))
tB0: B0 = PEEK(BT(&H0))
   '
   IF GSR THEN RETURN
   '
   DEF SEG = DS&
   '
dBF: POKE BD(&HF), BF
dBE: POKE BD(&HE), BE
dBD: POKE BD(&HD), BD
dBC: POKE BD(&HC), BC
dBB: POKE BD(&HB), BB
dBA: POKE BD(&HA), BA
dB9: POKE BD(&H9), B9
dB8: POKE BD(&H8), B8
dB7: POKE BD(&H7), B7
dB6: POKE BD(&H6), B6
dB5: POKE BD(&H5), B5
dB4: POKE BD(&H4), B4
dB3: POKE BD(&H3), B3
dB2: POKE BD(&H2), B2
dB1: POKE BD(&H1), B1
dB0: POKE BD(&H0), B0
   '
   IF GSR THEN RETURN
   '
   TS& = TS& + &H1
   DS& = DS& + &H1
  NEXT
  '
  GSR = NOT FALSE
  '
  SELECT CASE (BYTES& MOD &H10)
   CASE &H1
    DEF SEG = TS&
    GOSUB tB0
    DEF SEG = DS&
    GOSUB dB0
   CASE &H2
    DEF SEG = TS&
    GOSUB tB1
    DEF SEG = DS&
    GOSUB dB1
   CASE &H3
    DEF SEG = TS&
    GOSUB tB2
    DEF SEG = DS&
    GOSUB dB2
   CASE &H4
    DEF SEG = TS&
    GOSUB tB3
    DEF SEG = DS&
    GOSUB dB3
   CASE &H5
    DEF SEG = TS&
    GOSUB tB4
    DEF SEG = DS&
    GOSUB dB4
   CASE &H6
    DEF SEG = TS&
    GOSUB tB5
    DEF SEG = DS&
    GOSUB dB5
   CASE &H7
    DEF SEG = TS&
    GOSUB tB6
    DEF SEG = DS&
    GOSUB dB6
   CASE &H8
    DEF SEG = TS&
    GOSUB tB7
    DEF SEG = DS&
    GOSUB dB7
   CASE &H9
    DEF SEG = TS&
    GOSUB tB8
    DEF SEG = DS&
    GOSUB dB8
   CASE &HA
    DEF SEG = TS&
    GOSUB tB9
    DEF SEG = DS&
    GOSUB dB9
   CASE &HB
    DEF SEG = TS&
    GOSUB tBA
    DEF SEG = DS&
    GOSUB dBA
   CASE &HC
    DEF SEG = TS&
    GOSUB tBB
    DEF SEG = DS&
    GOSUB dBB
   CASE &HD
    DEF SEG = TS&
    GOSUB tBC
    DEF SEG = DS&
    GOSUB dBC
   CASE &HE
    DEF SEG = TS&
    GOSUB tBD
    DEF SEG = DS&
    GOSUB dBD
   CASE &HF
    DEF SEG = TS&
    GOSUB tBE
    DEF SEG = DS&
    GOSUB dBE
  END SELECT
  '
 CASE "TRANSPARENT"
  '
  FOR x = &H1 TO (BYTES& \ &H10)
   DEF SEG = TS&
   '
   BF = PEEK(BT(&HF))
   BE = PEEK(BT(&HE))
   BD = PEEK(BT(&HD))
   BC = PEEK(BT(&HC))
   BB = PEEK(BT(&HB))
   BA = PEEK(BT(&HA))
   B9 = PEEK(BT(&H9))
   B8 = PEEK(BT(&H8))
   B7 = PEEK(BT(&H7))
   B6 = PEEK(BT(&H6))
   B5 = PEEK(BT(&H5))
   B4 = PEEK(BT(&H4))
   B3 = PEEK(BT(&H3))
   B2 = PEEK(BT(&H2))
   B1 = PEEK(BT(&H1))
   B0 = PEEK(BT(&H0))
   '
   DEF SEG = DS&
   '
dTF: IF BF THEN POKE BD(&HF), BF
dTE: IF BE THEN POKE BD(&HE), BE
dTD: IF BD THEN POKE BD(&HD), BD
dTC: IF BC THEN POKE BD(&HC), BC
dTB: IF BB THEN POKE BD(&HB), BB
dTA: IF BA THEN POKE BD(&HA), BA
dT9: IF B9 THEN POKE BD(&H9), B9
dT8: IF B8 THEN POKE BD(&H8), B8
dT7: IF B7 THEN POKE BD(&H7), B7
dT6: IF B6 THEN POKE BD(&H6), B6
dT5: IF B5 THEN POKE BD(&H5), B5
dT4: IF B4 THEN POKE BD(&H4), B4
dT3: IF B3 THEN POKE BD(&H3), B3
dT2: IF B2 THEN POKE BD(&H2), B2
dT1: IF B1 THEN POKE BD(&H1), B1
dT0: IF B0 THEN POKE BD(&H0), B0
   '
   IF GSR THEN RETURN
   '
   TS& = TS& + &H1
   DS& = DS& + &H1
   '
  NEXT
  '
  GSR = NOT FALSE
  '
  SELECT CASE (BYTES& MOD &H10)
   CASE &H1
    DEF SEG = TS&
    GOSUB tB0
    DEF SEG = DS&
    GOSUB dT0
   CASE &H2
    DEF SEG = TS&
    GOSUB tB1
    DEF SEG = DS&
    GOSUB dT1
   CASE &H3
    DEF SEG = TS&
    GOSUB tB2
    DEF SEG = DS&
    GOSUB dT2
   CASE &H4
    DEF SEG = TS&
    GOSUB tB3
    DEF SEG = DS&
    GOSUB dT3
   CASE &H5
    DEF SEG = TS&
    GOSUB tB4
    DEF SEG = DS&
    GOSUB dT4
   CASE &H6
    DEF SEG = TS&
    GOSUB tB5
    DEF SEG = DS&
    GOSUB dT5
   CASE &H7
    DEF SEG = TS&
    GOSUB tB6
    DEF SEG = DS&
    GOSUB dT6
   CASE &H8
    DEF SEG = TS&
    GOSUB tB7
    DEF SEG = DS&
    GOSUB dT7
   CASE &H9
    DEF SEG = TS&
    GOSUB tB8
    DEF SEG = DS&
    GOSUB dT8
   CASE &HA
    DEF SEG = TS&
    GOSUB tB9
    DEF SEG = DS&
    GOSUB dT9
   CASE &HB
    DEF SEG = TS&
    GOSUB tBA
    DEF SEG = DS&
    GOSUB dTA
   CASE &HC
    DEF SEG = TS&
    GOSUB tBB
    DEF SEG = DS&
    GOSUB dTB
   CASE &HD
    DEF SEG = TS&
    GOSUB tBC
    DEF SEG = DS&
    GOSUB dTC
   CASE &HE
    DEF SEG = TS&
    GOSUB tBD
    DEF SEG = DS&
    GOSUB dTD
   CASE &HF
    DEF SEG = TS&
    GOSUB tBE
    DEF SEG = DS&
    GOSUB dTE
  END SELECT
  '
END SELECT
'
END SUB

SUB V13hDLY (seconds!) STATIC
 '
 IF seconds! THEN
  FOR inc& = 1 TO (SYS& * (seconds! * 18.2065)): 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
   IF fadeSEC! <> 0 THEN V13hDLY 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
   IF faseSEC! <> 0 THEN V13hDLY fadeSEC!
  NEXT
 END IF
 '
END SUB

SUB V13hGRD (colour, gradient)
 '
 RGB = colour
 GSG = 15 + gradient
 '
 DEF SEG = VARSEG(BLEND(0))
 '
 IF RGB > GSG THEN
  GSC = PEEK(BLN&(GSG) + (RGB - GSG))
 ELSE
  GSC = PEEK(BLN&(RGB) + (GSG - RGB))
 END IF
 '
 COLOR GSC
 '
END SUB

FUNCTION V13hKEY (scan)
 '
 DEF SEG = &H0
 POKE &H41C, PEEK(&H41A)
 POKE &H417, 0
 '
 I = INP(&H60)
 '
 IF (I AND &H80) THEN
  BOARD(I XOR &H80) = FALSE
 ELSE
  BOARD(I) = NOT FALSE
 END IF
 '
 IF BOARD(scan) THEN
  V13hKEY = NOT FALSE
 ELSE
  V13hKEY = FALSE
 END IF
 '
END FUNCTION

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

SUB V13hPAL (FILE$)
 '
 DEF SEG = VARSEG(PAL(0))
 '
 IF V13hLOF&(FILE$) > 0 THEN
  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
 ELSE
  OUT &H3C7, 0
  FOR x = 0 TO 255
   PAL(x).Red = INP(&H3C9)
   PAL(x).Grn = INP(&H3C9)
   PAL(x).Blu = INP(&H3C9)
  NEXT
  BSAVE FILE$, 0, 1536
 END IF
 '
END SUB

SUB V13hPNT (ARRAY(), FRAME, colour, SKIN$)
 '
 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
  '
  IF SKIN$ = "MASK" THEN
   '
   TEXTURE$ = "TRANSPARENT"
   '
   MR = (PNT.xx + MOUSE(0) \ 8) - 1
   MB = (PNT.yy + MOUSE(1)) - 1
   '
   IF MR > 319 THEN MR = 319
   IF MB > 199 THEN MB = 199
   '
   GET (PNT.xx, PNT.yy)-(MR, MB), MASK
   '
  ELSE
   '
   TEXTURE$ = SKIN$
   '
  END IF
  '
  PUTcolour = -1 + colour
  '
  V13hPUT ARRAY(), PNT.xx, PNT.yy, PNT.FRAME, TEXTURE$
  '
  PUTcolour = FALSE
  '
 END IF
 '
END SUB

SUB V13hPUT (ARRAY(), xxLEFT, yyTOP, FRAME, SKIN$)
 '
 IF FRAME THEN
  '
  segVIDEO& = 1& + VARSEG(VIDEO(0))
  segARRAY& = VARSEG(ARRAY(0))
  '
  TW = ARRAY(0) \ 8
  TH = ARRAY(1)
  TP& = TW * TH
  TI = ((5 + TP&) \ 2) * (FRAME - 1)
  '
  XR = (xxLEFT + TW) - 1
  YB = (yyTOP + TH) - 1
  '
  IF xxLEFT < WXL THEN
   IF XR < WXL THEN EXIT SUB
   CLIP = NOT FALSE
   LD = (WXL - xxLEFT): XD = LD
   XL = WXL
  ELSE
   XL = xxLEFT
  END IF
  '
  IF yyTOP < WYT THEN
   IF YB < WYT THEN EXIT SUB
   CLIP = NOT FALSE
   YD = WYT - yyTOP
   YT = WYT
  ELSE
   YT = yyTOP
  END IF
  '
  IF XR > WXR THEN
   IF XL > WXR THEN EXIT SUB
   CLIP = NOT FALSE
   XD = XD + (XR - WXR)
   XR = WXR
  END IF
  '
  IF YB > WYB THEN
   IF YT > WYB THEN EXIT SUB
   CLIP = NOT FALSE
   YB = WYB
  END IF
  '
  AB& = (4 + (TI * 2&)) + ((YD * TW) + LD)
  '
  DIM AC(XL TO XR)
  '
  SELECT CASE SKIN$
   '
   CASE "ANDXOR"
    '
    B = TW - XD
    R = TW - DR
    '
    DIM BT(&H0 TO &HF)
    DIM BD(&H0 TO &HF)
    '
    FOR x = &H0 TO &HF
     BD(x) = (x + XL)
    NEXT
    '
    FOR VY = (YT * 20) TO (YB * 20) STEP 20
     '
     TS& = segARRAY&
     DS& = segVIDEO& + VY
     '
     FOR x = &H0 TO &HF
      BT(x) = (x + AB&)
     NEXT
     '
     GSR = FALSE
     '
     FOR x = &H1 TO (B \ &H10)
      '
      DEF SEG = TS&
      '
aBF:  BF = PEEK(BT(&HF))
aBE:  BE = PEEK(BT(&HE))
aBD:  BD = PEEK(BT(&HD))
aBC:  BC = PEEK(BT(&HC))
aBB:  BB = PEEK(BT(&HB))
aBA:  BA = PEEK(BT(&HA))
aB9:  B9 = PEEK(BT(&H9))
aB8:  B8 = PEEK(BT(&H8))
aB7:  B7 = PEEK(BT(&H7))
aB6:  B6 = PEEK(BT(&H6))
aB5:  B5 = PEEK(BT(&H5))
aB4:  B4 = PEEK(BT(&H4))
aB3:  B3 = PEEK(BT(&H3))
aB2:  B2 = PEEK(BT(&H2))
aB1:  B1 = PEEK(BT(&H1))
aB0:  B0 = PEEK(BT(&H0))
      '
      IF GSR THEN RETURN
      '
      DEF SEG = DS&
      '
aTF:  IF BF THEN POKE BD(&HF), BF + PUTcolour
aTE:  IF BE THEN POKE BD(&HE), BE + PUTcolour
aTD:  IF BD THEN POKE BD(&HD), BD + PUTcolour
aTC:  IF BC THEN POKE BD(&HC), BC + PUTcolour
aTB:  IF BB THEN POKE BD(&HB), BB + PUTcolour
aTA:  IF BA THEN POKE BD(&HA), BA + PUTcolour
aT9:  IF B9 THEN POKE BD(&H9), B9 + PUTcolour
aT8:  IF B8 THEN POKE BD(&H8), B8 + PUTcolour
aT7:  IF B7 THEN POKE BD(&H7), B7 + PUTcolour
aT6:  IF B6 THEN POKE BD(&H6), B6 + PUTcolour
aT5:  IF B5 THEN POKE BD(&H5), B5 + PUTcolour
aT4:  IF B4 THEN POKE BD(&H4), B4 + PUTcolour
aT3:  IF B3 THEN POKE BD(&H3), B3 + PUTcolour
aT2:  IF B2 THEN POKE BD(&H2), B2 + PUTcolour
aT1:  IF B1 THEN POKE BD(&H1), B1 + PUTcolour
aT0:  IF B0 THEN POKE BD(&H0), B0 + PUTcolour
      '
      IF GSR THEN RETURN
      '
      TS& = TS& + &H1
      DS& = DS& + &H1
      '
     NEXT
     '
     GSR = NOT FALSE
     '
     SELECT CASE (B MOD &H10)
      CASE &H1
       DEF SEG = TS&
       GOSUB aB0
       DEF SEG = DS&
       GOSUB aT0
      CASE &H2
       DEF SEG = TS&
       GOSUB aB1
       DEF SEG = DS&
       GOSUB aT1
      CASE &H3
       DEF SEG = TS&
       GOSUB aB2
       DEF SEG = DS&
       GOSUB aT2
      CASE &H4
       DEF SEG = TS&
       GOSUB aB3
       DEF SEG = DS&
       GOSUB aT3
      CASE &H5
       DEF SEG = TS&
       GOSUB aB4
       DEF SEG = DS&
       GOSUB aT4
      CASE &H6
       DEF SEG = TS&
       GOSUB aB5
       DEF SEG = DS&
       GOSUB aT5
      CASE &H7
       DEF SEG = TS&
       GOSUB aB6
       DEF SEG = DS&
       GOSUB aT6
      CASE &H8
       DEF SEG = TS&
       GOSUB aB7
       DEF SEG = DS&
       GOSUB aT7
      CASE &H9
       DEF SEG = TS&
       GOSUB aB8
       DEF SEG = DS&
       GOSUB aT8
      CASE &HA
       DEF SEG = TS&
       GOSUB aB9
       DEF SEG = DS&
       GOSUB aT9
      CASE &HB
       DEF SEG = TS&
       GOSUB aBA
       DEF SEG = DS&
       GOSUB aTA
      CASE &HC
       DEF SEG = TS&
       GOSUB aBB
       DEF SEG = DS&
       GOSUB aTB
      CASE &HD
       DEF SEG = TS&
       GOSUB aBC
       DEF SEG = DS&
       GOSUB aTC
      CASE &HE
       DEF SEG = TS&
       GOSUB aBD
       DEF SEG = DS&
       GOSUB aTD
      CASE &HF
       DEF SEG = TS&
       GOSUB aBE
       DEF SEG = DS&
       GOSUB aTE
     END SELECT
     '
     AB& = AB& + R
     '
    NEXT
   '
   CASE "TRANSPARENT"
    '
    FOR VY = (YT * 20) TO (YB * 20) STEP 20
     DEF SEG = segARRAY&
     FOR HX = XL TO XR
      AC(HX) = PEEK(AB&)
      AB& = AB& + 1
     NEXT
     AB& = AB& + XD
     DEF SEG = segVIDEO& + VY
     IF PUTcolour THEN
      FOR HX = XL TO XR
       IF AC(HX) THEN POKE HX, AC(HX) + PUTcolour
      NEXT
     ELSE
      FOR HX = XL TO XR
       IF AC(HX) THEN POKE HX, AC(HX)
      NEXT
     END IF
    NEXT
    '
   CASE "BLEND"
    '
    segBLEND& = VARSEG(BLEND(0))
    '
    FOR VY = (YT * 20) TO (YB * 20) STEP 20
     DEF SEG = segARRAY&
     FOR HX = XL TO XR
      AC(HX) = PEEK(AB&)
      AB& = AB& + 1
     NEXT
     AB& = AB& + XD
     DEF SEG = segVIDEO& + VY
     FOR HX = XL TO XR
      IF AC(HX) THEN
       IF PUTcolour THEN AC(HX) = AC(HX) + PUTcolour
       VC = PEEK(HX)
       DEF SEG = segBLEND&
       IF VC > AC(HX) THEN
        BC = PEEK(BLN&(AC(HX)) + (VC - AC(HX)))
       ELSE
        BC = PEEK(BLN&(VC) + (AC(HX) - VC))
       END IF
       DEF SEG = segVIDEO& + VY
       POKE HX, BC
      END IF
     NEXT
    NEXT
    '
   CASE "BEHIND"
    '
    FOR VY = (YT * 20) TO (YB * 20) STEP 20
     DEF SEG = segARRAY&
     FOR HX = XL TO XR
      AC(HX) = PEEK(AB&)
      AB& = AB& + 1
     NEXT
     AB& = AB& + XD
     DEF SEG = segVIDEO& + VY
     IF PUTcolour THEN
      FOR HX = XL TO XR
       IF PEEK(HX) THEN  ELSE POKE HX, AC(HX) + PUTcolour
      NEXT
     ELSE
      FOR HX = XL TO XR
       IF PEEK(HX) THEN  ELSE POKE HX, AC(HX)
      NEXT
     END IF
    NEXT
   '
   CASE "SCALE"
    '
    'SW = (TW * PUTscale) \ 100
    'SH = (TH * PUTscale) \ 100
    'DW = TW - SW
    'DH = TH - SH
    '
    'PRINT "TW: "; TW
    'PRINT "TH: "; TH
    'PRINT "SW: "; SW
    'PRINT "SH: "; SH
    'PRINT "DW: "; DW
    'PRINT "DH: "; DH
    '
    'SLEEP: STOP
    '
   CASE "PSET"
    '
    IF CLIP THEN
     '
     FOR VY = (YT * 20) TO (YB * 20) STEP 20
      DEF SEG = segARRAY&
      FOR HX = XL TO XR
       AC(HX) = PEEK(AB&)
       AB& = AB& + 1
      NEXT
      AB& = AB& + XD
      DEF SEG = segVIDEO& + VY
      FOR HX = XL TO XR
       POKE HX, AC(HX)
      NEXT
     NEXT
    ELSE
     PUT (xxLEFT, yyTOP), ARRAY(TI), PSET
    END IF
    '
   CASE "PRESET"
    '
    IF CLIP THEN
     '
     FOR VY = (YT * 20) TO (YB * 20) STEP 20
      DEF SEG = segARRAY&
      FOR HX = XL TO XR
       AC(HX) = PEEK(AB&)
       AB& = AB& + 1
      NEXT
      AB& = AB& + XD
      DEF SEG = segVIDEO& + VY
      FOR HX = XL TO XR
       POKE HX, NOT AC(HX)
      NEXT
     NEXT
    ELSE
     PUT (xxLEFT, yyTOP), ARRAY(TI), PRESET
    END IF
    '
   CASE "AND"
    '
    IF CLIP THEN
     '
     FOR VY = (YT * 20) TO (YB * 20) STEP 20
      DEF SEG = segARRAY&
      FOR HX = XL TO XR
       AC(HX) = PEEK(AB&)
       AB& = AB& + 1
      NEXT
      AB& = AB& + XD
      DEF SEG = segVIDEO& + VY
      FOR HX = XL TO XR
       POKE HX, AC(HX) AND PEEK(HX)
      NEXT
     NEXT
    ELSE
     PUT (xxLEFT, yyTOP), ARRAY(TI), AND
    END IF
    '
   CASE "OR"
    '
    IF CLIP THEN
     '
     FOR VY = (YT * 20) TO (YB * 20) STEP 20
      DEF SEG = segARRAY&
      FOR HX = XL TO XR
       AC(HX) = PEEK(AB&)
       AB& = AB& + 1
      NEXT
      AB& = AB& + XD
      DEF SEG = segVIDEO& + VY
      FOR HX = XL TO XR
       POKE HX, AC(HX) OR PEEK(HX)
      NEXT
     NEXT
    ELSE
     PUT (xxLEFT, yyTOP), ARRAY(TI), OR
    END IF
    '
   CASE "XOR"
    '
    IF CLIP THEN
     '
     FOR VY = (YT * 20) TO (YB * 20) STEP 20
      DEF SEG = segARRAY&
      FOR HX = XL TO XR
       AC(HX) = PEEK(AB&)
       AB& = AB& + 1
      NEXT
      AB& = AB& + XD
      DEF SEG = segVIDEO& + VY
      FOR HX = XL TO XR
       POKE HX, AC(HX) XOR PEEK(HX)
      NEXT
     NEXT
    ELSE
     PUT (xxLEFT, yyTOP), ARRAY(TI), XOR
    END IF
    '
  END SELECT
  '
 END IF
 '
END SUB

SUB V13hSEE
 '
 DEF SEG
 POKE VIDEO(0), VIDEO(2)
 POKE VIDEO(1), VIDEO(3)
 PUT (0, 0), VIDEO(6), PSET
 POKE VIDEO(0), VIDEO(4)
 POKE VIDEO(1), VIDEO(5)
 '
END SUB

SUB V13hSET
 '
 SCREEN 13: CLS
 '
 FOR x = 0 TO 254
  BLN&(x + 1) = (BLN&(x) + (256 - x))
 NEXT
 '
 V13hPAL "palette.pal"
 V13hBLN "palette.bln"
 '
 REGX.AX = 0: INTERRUPTX &H33, REGX, REGX  'check mouse
 IF REGX.AX THEN
  PNT.switch = NOT FALSE
  REGX.AX = 1: INTERRUPTX &H33, REGX, REGX 'show mouse
  REGX.AX = 4: INTERRUPTX &H33, REGX, REGX 'put mouse
  GET (1, 1)-(16, 16), MOUSE               'get mouse
  REGX.AX = 2: INTERRUPTX &H33, REGX, REGX 'hide mouse
  DEF SEG = VARSEG(MOUSE(0))               'color mouse
  FOR x = 4 TO 258
   IF PEEK(x) = 15 THEN
    POKE x, 1
    IF PEEK(x - 1) THEN  ELSE POKE x, 250  'shade mouse
   END IF
  NEXT
  PNT.minXX = 0                            'bound mouse
  PNT.minYY = 0
  PNT.maxXX = 319
  PNT.maxYY = 199
 END IF
 '
 COLOR 1
 '
 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
 VIDEOseg& = 1 + VARSEG(VIDEO(0))
 DEF SEG : BSAVE "buffer.tmp", &H0, &HFA00
 DEF SEG = VIDEOseg&: BLOAD "buffer.tmp", 0
 KILL "buffer.tmp"
 FOR I = 8 TO 32007 - 1
  IF VIDEO(I) = &H7DA0 AND VIDEO(I + 1) = &HA000 THEN
   VIDEO(0) = ((I + 1) * 2) - 16
   VIDEO(1) = VIDEO(0) + 1
   VIDEO(4) = VIDEOseg& AND &HFF
   IF (VIDEOseg& AND &H8000) THEN
    VIDEO(5) = ((VIDEOseg& AND &HFF00) \ &HFF) + &H100
   ELSE
    VIDEO(5) = (VIDEOseg& AND &HFF00) \ &HFF
   END IF
   DEF SEG
   VIDEO(2) = PEEK(VIDEO(0)): VIDEO(3) = PEEK(VIDEO(1))
   POKE VIDEO(0), VIDEO(4): POKE VIDEO(1), VIDEO(5)
   EXIT FOR
  END IF
 NEXT
 '
 VIDEO(6) = 2560
 VIDEO(7) = 200
 '
 V13hWIN 0, 0, 319, 199
 V13hDLY calibrate!
 V13hCLS 0
 COLOR 15
 '
END SUB

SUB V13hTXT (ARRAY(), XXcenter, xxLEFT, yyTOP, colour, text$, SKIN$)
 '
 FONTwidth = ARRAY(0) \ 8
 PUTcolour = -1 + colour
 FONTyy = yyTOP
 '
 TL = LEN(text$)
 '
 IF XXcenter THEN
  cx = (WXL + ((WXR - WXL) + 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, SKIN$
 NEXT
 '
 PUTcolour = FALSE
 '
END SUB

SUB V13hWIN (xxLEFT, yyTOP, xxRIGHT, yyBOTTOM)
 '
 WXL = xxLEFT
 WYT = yyTOP
 WXR = xxRIGHT
 WYB = yyBOTTOM
 '
 IF WXL < 0 THEN WXL = 0
 IF WXR > 319 THEN WXR = 319
 IF WYT < 0 THEN WYT = 0
 IF WYB > 199 THEN WYB = 199
 '
END SUB

Logged
barok
Na_th_an
*****
Posts: 1727


How about a tasty lead sandwich?


« Reply #128 on: February 02, 2005, 11:30:08 AM »

hmm... competitive physically, huh?  I'll have to take you up on your challenge someday.  Some ice hockey, maybe? Smiley  

Maybe you, I and Cheetah should work on this lib together.  It'd be done way faster, and of course since we all have (or had) a desire for fast pure qb, i think it'd work. Cheesy  

A rotozooming sprite routine?  Why not just make two seperate routines?  One for rotating, and one for zooming.  If someone wants rotozooming, they can combine those routines to make it.  It'd save space, for sure.

Btw, two things...  

1. Can your routine put a sprite that's inside a PUT array that has like 5 sprites already inside it?

2. your buffer goes to 32007.  Do you do this in case you want to use setvideoseg someday?
Logged

Jumping Jahoolipers!
Nemesis
Forum Regular
**
Posts: 118



« Reply #129 on: February 02, 2005, 01:53:17 PM »

Quote from: "barok"
hmm... competitive physically, huh?  I'll have to take you up on your challenge someday.  Some ice hockey, maybe? Smiley

Ice hockey? Nah, I'd get creamed  Shocked

How about track? (100 meter dash in 10.6, 24' 2'' long jump)
Maybe some football? (Can't remember my time in the 40 though.)
Basketball? (Shots not always acurate, but can dunk on regulation rim, plus have great D!!!)
MMA? Ummm, I won't go there...but...(look for Mario LaRosa)...
http://www.team-roc.com/events/fkf2000.html
http://www.team-roc.com/events/evt02.html
(Was robbed with a DQ in that title fight. Clearly knocked the guy out though.)
http://martialartsradio.com/home.htm
My last fight... sucked, fight was stopped prematurely  :cry:
The guy didn't even leave a mark on me, the sold out crowd booed and were very dissapointed.  :roll: Oh well, I'm still ranked #2 light heavy weight... (Check out the Kick Down rankings, light heavy weight division)
Currently I'm inactive but, I will get back into it some day.
I actually had one pro fight in N.C, which I won with rear-naked-choke! in round 2. (I want to get back into it but, unfortunatelly there's very little money in it. Maybe 1K to 5K a fight, but you can easily spend that in the ER, or on a insurance policy.)


Anyways, back to my true love... COMPUTERS  :bounce:

Quote

Maybe you, I and Cheetah should work on this lib together.  It'd be done way faster, and of course since we all have (or had) a desire for fast pure qb, i think it'd work. Cheesy

Sure why not, shoot me an E-mail!
Quote

A rotozooming sprite routine?  Why not just make two seperate routines?  One for rotating, and one for zooming.  If someone wants rotozooming, they can combine those routines to make it.  It'd save space, for sure.

Ummm, I was thinking just the opposite that it would save space just to have it combined all in one routine, and use a few variables
that the user can set for the scaling and zooming amounts.

Quote

Btw, two things...  

1. Can your routine put a sprite that's inside a PUT array that has like 5 sprites already inside it?

2. your buffer goes to 32007.  Do you do this in case you want to use setvideoseg someday?


1. Not directly but, adding this feature wouldn't be any problem at all, or the user could PUT the sprites, and then capture it. (Would be kinda sloppy though.)

2. Well I've used my own setvideoseg routine for some time now.
Was suprised when I seen Plasmas version, heh, mine is similar and is generally the same concept but, my code and approach is slightly different than SETVIDEOSEG. (Before I knew any ASM, I'd do silly things like scan memory and look for ways I could actually manipulate QB itself. Actually found some really cool things... (Man, those sure were the good 'ole days  Smiley)

Cya later!

Nemesis
Logged
na_th_an
*/-\*
*****
Posts: 8244



WWW
« Reply #130 on: February 02, 2005, 03:19:03 PM »

Nemesis, your code would be even faster if you replace every GOSUB by the actual subroutine they are calling in the Put sub. GOSUB takes time Wink
Logged

SCUMM (the band) on Myspace!
ComputerEmuzone Games Studio
underBASIC, homegrown musicians
[img]http://www.ojodepez-fanzine.net/almacen/yoghourtslover.png[/i
Nemesis
Forum Regular
**
Posts: 118



« Reply #131 on: February 02, 2005, 10:15:08 PM »

Quote from: "na_th_an"
Nemesis, your code would be even faster if you replace every GOSUB by the actual subroutine they are calling in the Put sub. GOSUB takes time Wink


Sorry na_th_an, I wasn't aware of any GOSUBS in the PUT subroutine. Maybe you were thinking something different than what
you worte/posted?

Glad to see you took the time to look at my lib.

To let you know, there are many things that could be done to increase the speed but, I'm not going to spend the time to incorporate these things currently. I might decide to one of these days though  :wink:
Feel free to post any suggestions, if I use your idea, Ill add you to the credits, yipeeee!!!!  :bounce:

Umm... bye.

Nemesis
Logged
na_th_an
*/-\*
*****
Posts: 8244



WWW
« Reply #132 on: February 03, 2005, 05:45:46 AM »

I meant this:

Code:
[...]
  CASE &H1
    DEF SEG = TS&
    GOSUB tB0
    DEF SEG = DS&
    GOSUB dB0
[...]


I dunno where it belongs. I suggest to paste the actual code instead of the GOSUBs. You gain the time took by four jumps.
Logged

SCUMM (the band) on Myspace!
ComputerEmuzone Games Studio
underBASIC, homegrown musicians
[img]http://www.ojodepez-fanzine.net/almacen/yoghourtslover.png[/i
Nemesis
Forum Regular
**
Posts: 118



« Reply #133 on: February 04, 2005, 12:08:34 PM »

Quote from: "na_th_an"
I meant this:

Code:
[...]
  CASE &H1
    DEF SEG = TS&
    GOSUB tB0
    DEF SEG = DS&
    GOSUB dB0
[...]


I dunno where it belongs. I suggest to paste the actual code instead of the GOSUBs. You gain the time took by four jumps.


True na_th_an, it would be faster but, I'm not sure if
you are fully aware of the actual structure of this routine.
The GOSUB you are refering to is only called once if the
number of bytes it's transfering is not a multiple of 16.
IF it's a multiple of 16 then there's no execution of this
part of the routine. Also, if I were too, (hard code sort of speaking)
the actual routine it calls via. GOSUB then I would be using
precious string space which is probablly one of QB's biggest
limitation. This lib is geared towards speed but, it also focuses
on preserving memory, and other important aspects needed when
using a limited language such as QB Smiley
 
eg #1:(Taking out the GOSUBS)...
 
Code:

  '
  SELECT CASE (BYTES& MOD &H10)
   CASE &H1
    DEF SEG = TS&
    b0 = PEEK(bt(&H0))
    DEF SEG = DS&
    POKE bd(&H0), b0
   CASE &H2
    DEF SEG = TS&
    b1 = PEEK(bt(&H1))
    b0 = PEEK(bt(&H0))
    DEF SEG = DS&
    POKE bd(&H1), b1
    POKE bd(&H0), b0
   CASE &H3
    DEF SEG = TS&
    b2 = PEEK(bt(&H2))
    b1 = PEEK(bt(&H1))
    b0 = PEEK(bt(&H0))
    DEF SEG = DS&
    POKE bd(&H2), b2
    POKE bd(&H1), b1
    POKE bd(&H0), b0
   CASE &H4
    DEF SEG = TS&
    b3 = PEEK(bt(&H3))
    b2 = PEEK(bt(&H2))
    b1 = PEEK(bt(&H1))
    b0 = PEEK(bt(&H0))
    DEF SEG = DS&
    POKE bd(&H3), b3
    POKE bd(&H2), b2
    POKE bd(&H1), b1
    POKE bd(&H0), b0
   CASE &H5
    DEF SEG = TS&
    b4 = PEEK(bt(&H4))
    b3 = PEEK(bt(&H3))
    b2 = PEEK(bt(&H2))
    b1 = PEEK(bt(&H1))
    b0 = PEEK(bt(&H0))
    DEF SEG = DS&
    POKE bd(&H4), b4
    POKE bd(&H3), b3
    POKE bd(&H2), b2
    POKE bd(&H1), b1
    POKE bd(&H0), b0
   CASE &H6
    DEF SEG = TS&
    b5 = PEEK(bt(&H5))
    b4 = PEEK(bt(&H4))
    b3 = PEEK(bt(&H3))
    b2 = PEEK(bt(&H2))
    b1 = PEEK(bt(&H1))
    b0 = PEEK(bt(&H0))
    DEF SEG = DS&
    POKE bd(&H5), b5
    POKE bd(&H4), b4
    POKE bd(&H3), b3
    POKE bd(&H2), b2
    POKE bd(&H1), b1
    POKE bd(&H0), b0
   CASE &H7
    DEF SEG = TS&
    b6 = PEEK(bt(&H6))
    b5 = PEEK(bt(&H5))
    b4 = PEEK(bt(&H4))
    b3 = PEEK(bt(&H3))
    b2 = PEEK(bt(&H2))
    b1 = PEEK(bt(&H1))
    b0 = PEEK(bt(&H0))
    DEF SEG = DS&
    POKE bd(&H6), b6
    POKE bd(&H5), b5
    POKE bd(&H4), b4
    POKE bd(&H3), b3
    POKE bd(&H2), b2
    POKE bd(&H1), b1
    POKE bd(&H0), b0
   CASE &H8
    DEF SEG = TS&
    b7 = PEEK(bt(&H7))
    b6 = PEEK(bt(&H6))
    b5 = PEEK(bt(&H5))
    b4 = PEEK(bt(&H4))
    b3 = PEEK(bt(&H3))
    b2 = PEEK(bt(&H2))
    b1 = PEEK(bt(&H1))
    b0 = PEEK(bt(&H0))
    DEF SEG = DS&
    POKE bd(&H7), b7
    POKE bd(&H6), b6
    POKE bd(&H5), b5
    POKE bd(&H4), b4
    POKE bd(&H3), b3
    POKE bd(&H2), b2
    POKE bd(&H1), b1
    POKE bd(&H0), b0
   CASE &H9
    DEF SEG = TS&
    b8 = PEEK(bt(&H8))
    b7 = PEEK(bt(&H7))
    b6 = PEEK(bt(&H6))
    b5 = PEEK(bt(&H5))
    b4 = PEEK(bt(&H4))
    b3 = PEEK(bt(&H3))
    b2 = PEEK(bt(&H2))
    b1 = PEEK(bt(&H1))
    b0 = PEEK(bt(&H0))
    DEF SEG = DS&
    POKE bd(&H8), b8
    POKE bd(&H7), b7
    POKE bd(&H6), b6
    POKE bd(&H5), b5
    POKE bd(&H4), b4
    POKE bd(&H3), b3
    POKE bd(&H2), b2
    POKE bd(&H1), b1
    POKE bd(&H0), b0
   CASE &HA
    DEF SEG = TS&
    b9 = PEEK(bt(&H9))
    b8 = PEEK(bt(&H8))
    b7 = PEEK(bt(&H7))
    b6 = PEEK(bt(&H6))
    b5 = PEEK(bt(&H5))
    b4 = PEEK(bt(&H4))
    b3 = PEEK(bt(&H3))
    b2 = PEEK(bt(&H2))
    b1 = PEEK(bt(&H1))
    b0 = PEEK(bt(&H0))
    DEF SEG = DS&
    POKE bd(&H9), b9
    POKE bd(&H8), b8
    POKE bd(&H7), b7
    POKE bd(&H6), b6
    POKE bd(&H5), b5
    POKE bd(&H4), b4
    POKE bd(&H3), b3
    POKE bd(&H2), b2
    POKE bd(&H1), b1
    POKE bd(&H0), b0
   CASE &HB
    DEF SEG = TS&
    ba = PEEK(bt(&HA))
    b9 = PEEK(bt(&H9))
    b8 = PEEK(bt(&H8))
    b7 = PEEK(bt(&H7))
    b6 = PEEK(bt(&H6))
    b5 = PEEK(bt(&H5))
    b4 = PEEK(bt(&H4))
    b3 = PEEK(bt(&H3))
    b2 = PEEK(bt(&H2))
    b1 = PEEK(bt(&H1))
    b0 = PEEK(bt(&H0))
    DEF SEG = DS&
    POKE bd(&HA), ba
    POKE bd(&H9), b9
    POKE bd(&H8), b8
    POKE bd(&H7), b7
    POKE bd(&H6), b6
    POKE bd(&H5), b5
    POKE bd(&H4), b4
    POKE bd(&H3), b3
    POKE bd(&H2), b2
    POKE bd(&H1), b1
    POKE bd(&H0), b0
   CASE &HC
    DEF SEG = TS&
    bb = PEEK(bt(&HB))
    ba = PEEK(bt(&HA))
    b9 = PEEK(bt(&H9))
    b8 = PEEK(bt(&H8))
    b7 = PEEK(bt(&H7))
    b6 = PEEK(bt(&H6))
    b5 = PEEK(bt(&H5))
    b4 = PEEK(bt(&H4))
    b3 = PEEK(bt(&H3))
    b2 = PEEK(bt(&H2))
    b1 = PEEK(bt(&H1))
    b0 = PEEK(bt(&H0))
    DEF SEG = DS&
    POKE bd(&HB), bb
    POKE bd(&HA), ba
    POKE bd(&H9), b9
    POKE bd(&H8), b8
    POKE bd(&H7), b7
    POKE bd(&H6), b6
    POKE bd(&H5), b5
    POKE bd(&H4), b4
    POKE bd(&H3), b3
    POKE bd(&H2), b2
    POKE bd(&H1), b1
    POKE bd(&H0), b0
   CASE &HD
    DEF SEG = TS&
    bc = PEEK(bt(&HC))
    bb = PEEK(bt(&HB))
    ba = PEEK(bt(&HA))
    b9 = PEEK(bt(&H9))
    b8 = PEEK(bt(&H8))
    b7 = PEEK(bt(&H7))
    b6 = PEEK(bt(&H6))
    b5 = PEEK(bt(&H5))
    b4 = PEEK(bt(&H4))
    b3 = PEEK(bt(&H3))
    b2 = PEEK(bt(&H2))
    b1 = PEEK(bt(&H1))
    b0 = PEEK(bt(&H0))
    DEF SEG = DS&
    POKE bd(&HC), bc
    POKE bd(&HB), bb
    POKE bd(&HA), ba
    POKE bd(&H9), b9
    POKE bd(&H8), b8
    POKE bd(&H7), b7
    POKE bd(&H6), b6
    POKE bd(&H5), b5
    POKE bd(&H4), b4
    POKE bd(&H3), b3
    POKE bd(&H2), b2
    POKE bd(&H1), b1
    POKE bd(&H0), b0
   CASE &HE
    DEF SEG = TS&
    bd = PEEK(bt(&HD))
    bc = PEEK(bt(&HC))
    bb = PEEK(bt(&HB))
    ba = PEEK(bt(&HA))
    b9 = PEEK(bt(&H9))
    b8 = PEEK(bt(&H8))
    b7 = PEEK(bt(&H7))
    b6 = PEEK(bt(&H6))
    b5 = PEEK(bt(&H5))
    b4 = PEEK(bt(&H4))
    b3 = PEEK(bt(&H3))
    b2 = PEEK(bt(&H2))
    b1 = PEEK(bt(&H1))
    b0 = PEEK(bt(&H0))
    DEF SEG = DS&
    POKE bd(&HD), bd
    POKE bd(&HC), bc
    POKE bd(&HB), bb
    POKE bd(&HA), ba
    POKE bd(&H9), b9
    POKE bd(&H8), b8
    POKE bd(&H7), b7
    POKE bd(&H6), b6
    POKE bd(&H5), b5
    POKE bd(&H4), b4
    POKE bd(&H3), b3
    POKE bd(&H2), b2
    POKE bd(&H1), b1
    POKE bd(&H0), b0
   CASE &HF
    DEF SEG = TS&
    be = PEEK(bt(&HE))
    bd = PEEK(bt(&HD))
    bc = PEEK(bt(&HC))
    bb = PEEK(bt(&HB))
    ba = PEEK(bt(&HA))
    b9 = PEEK(bt(&H9))
    b8 = PEEK(bt(&H8))
    b7 = PEEK(bt(&H7))
    b6 = PEEK(bt(&H6))
    b5 = PEEK(bt(&H5))
    b4 = PEEK(bt(&H4))
    b3 = PEEK(bt(&H3))
    b2 = PEEK(bt(&H2))
    b1 = PEEK(bt(&H1))
    b0 = PEEK(bt(&H0))
    DEF SEG = DS&
    POKE bd(&HF), bf
    POKE bd(&HE), be
    POKE bd(&HD), bd
    POKE bd(&HC), bc
    POKE bd(&HB), bb
    POKE bd(&HA), ba
    POKE bd(&H9), b9
    POKE bd(&H8), b8
    POKE bd(&H7), b7
    POKE bd(&H6), b6
    POKE bd(&H5), b5
    POKE bd(&H4), b4
    POKE bd(&H3), b3
    POKE bd(&H2), b2
    POKE bd(&H1), b1
    POKE bd(&H0), b0
  END SELECT
  '
 


eg #2:The current structure...
 
Code:

  '
  SELECT CASE (BYTES& MOD &H10)
   CASE &H1
    DEF SEG = TS&
    GOSUB tB0
    DEF SEG = DS&
    GOSUB dB0
   CASE &H2
    DEF SEG = TS&
    GOSUB tB1
    DEF SEG = DS&
    GOSUB dB1
   CASE &H3
    DEF SEG = TS&
    GOSUB tB2
    DEF SEG = DS&
    GOSUB dB2
   CASE &H4
    DEF SEG = TS&
    GOSUB tB3
    DEF SEG = DS&
    GOSUB dB3
   CASE &H5
    DEF SEG = TS&
    GOSUB tB4
    DEF SEG = DS&
    GOSUB dB4
   CASE &H6
    DEF SEG = TS&
    GOSUB tB5
    DEF SEG = DS&
    GOSUB dB5
   CASE &H7
    DEF SEG = TS&
    GOSUB tB6
    DEF SEG = DS&
    GOSUB dB6
   CASE &H8
    DEF SEG = TS&
    GOSUB tB7
    DEF SEG = DS&
    GOSUB dB7
   CASE &H9
    DEF SEG = TS&
    GOSUB tB8
    DEF SEG = DS&
    GOSUB dB8
   CASE &HA
    DEF SEG = TS&
    GOSUB tB9
    DEF SEG = DS&
    GOSUB dB9
   CASE &HB
    DEF SEG = TS&
    GOSUB tBA
    DEF SEG = DS&
    GOSUB dBA
   CASE &HC
    DEF SEG = TS&
    GOSUB tBB
    DEF SEG = DS&
    GOSUB dBB
   CASE &HD
    DEF SEG = TS&
    GOSUB tBC
    DEF SEG = DS&
    GOSUB dBC
   CASE &HE
    DEF SEG = TS&
    GOSUB tBD
    DEF SEG = DS&
    GOSUB dBD
   CASE &HF
    DEF SEG = TS&
    GOSUB tBE
    DEF SEG = DS&
    GOSUB dBE
   END SELECT
tBF: BF = PEEK(bt(&HF))
tBE: BE = PEEK(bt(&HE))
tBD: bd = PEEK(bt(&HD))
tBC: BC = PEEK(bt(&HC))
tBB: bb = PEEK(bt(&HB))
tBA: BA = PEEK(bt(&HA))
tB9: b9 = PEEK(bt(&H9))
tB8: b8 = PEEK(bt(&H8))
tB7: b7 = PEEK(bt(&H7))
tB6: b6 = PEEK(bt(&H6))
tB5: b5 = PEEK(bt(&H5))
tB4: b4 = PEEK(bt(&H4))
tB3: b3 = PEEK(bt(&H3))
tB2: B2 = PEEK(bt(&H2))
tB1: B1 = PEEK(bt(&H1))
tB0: B0 = PEEK(bt(&H0))
     '
     RETURN
     '
dBF: POKE bd(&HF), BF
dBE: POKE bd(&HE), BE
dBD: POKE bd(&HD), bd
dBC: POKE bd(&HC), BC
dBB: POKE bd(&HB), bb
dBA: POKE bd(&HA), BA
dB9: POKE bd(&H9), b9
dB8: POKE bd(&H8), b8
dB7: POKE bd(&H7), b7
dB6: POKE bd(&H6), b6
dB5: POKE bd(&H5), b5
dB4: POKE bd(&H4), b4
dB3: POKE bd(&H3), b3
dB2: POKE bd(&H2), B2
dB1: POKE bd(&H1), B1
dB0: POKE bd(&H0), B0
     '
     RETURN
     '


Cya,

Nemesis
Logged
Z!re
*/-\*
*****
Posts: 4599


« Reply #134 on: February 04, 2005, 12:30:00 PM »

Use real SUBS/FUNCTIONS.

Works just fine, although it doesent really matter that much.
Logged
Pages: 1 ... 7 8 [9] 10
  Print  
 
Jump to:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2015, Simple Machines Valid XHTML 1.0! Valid CSS!