'/***AFLIB '/***DEV(January 5,2003) '/ASM code: Richard Eric M. Lope BSN RN(RelSoft) '/ScratchX: Achmad Aulia(L_O_J) '/***DESCRIPTION: '/ A call absolute based QB library that is "probably" the easiest to use '/of all the libs out there. You don't need any global variables, messy '/shared arrays, no need for initialization routine and this is very fast. '/All SUBS/FUNCTIONS are standalone so you could use as many or as few as you '/want depending pn your needs. Just delete what you don't need. '/***HOW TO USE: '/Just load QB with the /L option an you're good to go. Ie. type: "QB/L" '/and that's all there is to it. You could now use any sub functions that '/is packaged in this lib. You could load this as a separate module, make '/a QLB/LIB out of it or just type your code in this module and it would '/run fine. '/***INSTRUCTIONS: '/The description on how to use each SUB/FUNCTION is inside the procedures '/themselves. '/***NOTES: '/I took the liberty to add Milo's MULTIKEY and 2 PP256 subs by Chris Chadwick '/***SITES: ' Http://RelSoft.Ath.CX ' Http://Auraflow.curvehead.com ' Http://Polacka.xepher.net DECLARE FUNCTION MULTIKEY% (t%) DECLARE FUNCTION AF.Collide% (Layer%, X%, Y%, SPRSEG%, SPROFF%) DECLARE FUNCTION AF.CollideSpr% (X1%, Y1%, SprSeg1%, SprOff1%, X2%, Y2%, SprSeg2%, SprOff2%) DECLARE FUNCTION AF.Point% (DestSeg%, X%, Y%) DECLARE SUB AF.Pset (DestSeg%, X%, Y%, C%) DECLARE SUB AF.Sprite (DestSeg%, X%, Y%, SPRITESEGMENT%, SPRITEOFFSET%) DECLARE SUB AF.Box (DestSeg%, X1%, Y1%, X2%, Y2%, C%) DECLARE SUB AF.BoxF (DestSeg%, X1%, Y1%, X2%, Y2%, C%) DECLARE SUB AF.BoxTrans (DestSeg%, X1%, Y1%, X2%, Y2%, C%) DECLARE SUB AF.BoxTransF (DestSeg%, X1%, Y1%, X2%, Y2%, C%) DECLARE SUB AF.Get (Layer%, X1%, Y1%, X2%, Y2%, SPRSEG%, SPROFF%) DECLARE SUB AF.LoadPalPp256 (File$) DECLARE SUB AF.Pcopy (DestSeg%, SRCSEG%) DECLARE SUB AF.PsetTrans (DestSeg%, X%, Y%, C%) DECLARE SUB AF.SpriteColor (DestSeg%, X%, Y%, SPRITESEGMENT%, SPRITEOFFSET%, CLR%) DECLARE SUB AF.SpriteGamma (DestSeg%, X%, Y%, SPRITESEGMENT%, SPRITEOFFSET%, GAMMADISP%) DECLARE SUB AF.SpriteSolid (DestSeg%, X%, Y%, SPRITESEGMENT%, SPRITEOFFSET%) DECLARE SUB AF.SpriteTrans (DestSeg%, X%, Y%, SPRITESEGMENT%, SPRITEOFFSET%) DEFINT A-Z REM $DYNAMIC '/===============Start code Here============================================= '***SAMPLE PROGRAM: '***Delete all of this if you make your own proggie. '/==================CUT HERE=============== RANDOMIZE TIMER TYPE SpriteType X AS INTEGER Y AS INTEGER XV AS INTEGER YV AS INTEGER ID AS INTEGER Plotmode AS INTEGER '1=normal,2=trans,3=gamma+,4=gamma-1,5=color END TYPE 'QB code Starts here....... DIM SHARED Vpage(31999) DIM SHARED Vpage2(31999) DIM SHARED Layer DIM SHARED Layer2 DIM SHARED Sprite(20) AS SpriteType Layer = VARSEG(Vpage(0)) Layer2 = VARSEG(Vpage2(0)) CLS SCREEN 13 RESTORE FJPALDATA AF.LoadPalPp256 "" 'Init FOR I = 0 TO UBOUND(Sprite) Sprite(I).X = INT(RND * 320) Sprite(I).Y = INT(RND * 200) Sprite(I).XV = -5 + INT(RND * 10) Sprite(I).YV = -5 + INT(RND * 10) Sprite(I).ID = INT(RND * 2) Sprite(I).Plotmode = 1 + INT(RND * 5) NEXT I Size2 = ((20 * 20) + 4) \ 2 REDIM Spr(129) 'Our sprite REDIM Spr2(Size2) 'Our little demo FOR I = 0 TO 8 LINE (I, I)-(15 - I, 15 - I), 150 + I, BF NEXT I AF.Get &HA000, 0, 0, 15, 15, VARSEG(Spr(0)), VARPTR(Spr(0)) CLS C = 199 FOR R = 9 TO 1 STEP -1 CIRCLE (100, 100), R, C PAINT (100, 100), C C = C + 1 NEXT R X1 = 91 Y1 = 91 AF.Get &HA000, X1, Y1, X1 + 19, Y1 + 19, VARSEG(Spr2(0)), VARPTR(Spr2(0)) DO AF.Sprite &HA000, -50 + INT(RND * 400), -50 + INT(RND * 290), VARSEG(Spr(0)), VARPTR(Spr(0)) AF.SpriteTrans &HA000, -50 + INT(RND * 400), -50 + INT(RND * 290), VARSEG(Spr(0)), VARPTR(Spr(0)) AF.SpriteSolid &HA000, -50 + INT(RND * 400), -50 + INT(RND * 290), VARSEG(Spr(0)), VARPTR(Spr(0)) AF.SpriteColor &HA000, -50 + INT(RND * 400), -50 + INT(RND * 290), VARSEG(Spr(0)), VARPTR(Spr(0)), INT(RND * 255) AF.SpriteGamma &HA000, -50 + INT(RND * 400), -50 + INT(RND * 290), VARSEG(Spr(0)), VARPTR(Spr(0)), 4 AF.SpriteGamma &HA000, -50 + INT(RND * 400), -50 + INT(RND * 290), VARSEG(Spr(0)), VARPTR(Spr(0)), -4 X = INT(RND * 320): Y = INT(RND * 200) X2 = INT(RND * 320): Y2 = INT(RND * 200) AF.Box &HA000, X, Y, X2, Y2, INT(RND * 255) X = INT(RND * 320): Y = INT(RND * 200) X2 = INT(RND * 320): Y2 = INT(RND * 200) AF.BoxTrans &HA000, X, Y, X2, Y2, INT(RND * 255) X = INT(RND * 320): Y = INT(RND * 200) X2 = INT(RND * 320): Y2 = INT(RND * 200) AF.BoxF &HA000, X, Y, X2, Y2, INT(RND * 255) X = INT(RND * 320): Y = INT(RND * 200) X2 = INT(RND * 320): Y2 = INT(RND * 200) AF.BoxTransF &HA000, X, Y, X2, Y2, INT(RND * 255) X = INT(RND * 320): Y = INT(RND * 200) AF.Pset &HA000, X, Y, INT(RND * 255) X = INT(RND * 320): Y = INT(RND * 200) AF.PsetTrans &HA000, X, Y, INT(RND * 255) LOOP UNTIL INKEY$ <> "" AF.Pcopy Layer2, &HA000 'Save our BG DO AF.Pcopy Layer, Layer2 FOR I = 0 TO UBOUND(Sprite) Sprite(I).X = Sprite(I).X + Sprite(I).XV Sprite(I).Y = Sprite(I).Y + Sprite(I).YV IF Sprite(I).X < -32 THEN Sprite(I).XV = -Sprite(I).XV ELSEIF Sprite(I).X > 325 THEN Sprite(I).XV = -Sprite(I).XV END IF IF Sprite(I).Y < -32 THEN Sprite(I).YV = -Sprite(I).YV ELSEIF Sprite(I).Y > 225 THEN Sprite(I).YV = -Sprite(I).YV END IF SELECT CASE Sprite(I).ID CASE 0 SELECT CASE Sprite(I).Plotmode CASE 1 AF.Sprite Layer, Sprite(I).X, Sprite(I).Y, VARSEG(Spr(0)), VARPTR(Spr(0)) CASE 2 AF.SpriteTrans Layer, Sprite(I).X, Sprite(I).Y, VARSEG(Spr(0)), VARPTR(Spr(0)) CASE 3 AF.SpriteGamma Layer, Sprite(I).X, Sprite(I).Y, VARSEG(Spr(0)), VARPTR(Spr(0)), -6 CASE 4 AF.SpriteGamma Layer, Sprite(I).X, Sprite(I).Y, VARSEG(Spr(0)), VARPTR(Spr(0)), 4 CASE ELSE AF.SpriteColor Layer, Sprite(I).X, Sprite(I).Y, VARSEG(Spr(0)), VARPTR(Spr(0)), INT(RND * 255) END SELECT CASE ELSE SELECT CASE Sprite(I).Plotmode CASE 1 AF.Sprite Layer, Sprite(I).X, Sprite(I).Y, VARSEG(Spr2(0)), VARPTR(Spr2(0)) CASE 2 AF.SpriteTrans Layer, Sprite(I).X, Sprite(I).Y, VARSEG(Spr2(0)), VARPTR(Spr2(0)) CASE 3 AF.SpriteGamma Layer, Sprite(I).X, Sprite(I).Y, VARSEG(Spr2(0)), VARPTR(Spr2(0)), -6 CASE 4 AF.SpriteGamma Layer, Sprite(I).X, Sprite(I).Y, VARSEG(Spr2(0)), VARPTR(Spr2(0)), 4 CASE ELSE AF.SpriteColor Layer, Sprite(I).X, Sprite(I).Y, VARSEG(Spr2(0)), VARPTR(Spr2(0)), INT(RND * 255) END SELECT END SELECT NEXT I 'WAIT &H3DA, 8 AF.Pcopy &HA000, Layer LOOP UNTIL INKEY$ <> "" CLS SCREEN 0 WIDTH 80 END FJPALDATA: 'Pp256 palette data(16 color gradient pal.) DATA 0,2752512,10752,2763264,42,2752554,5418,2763306 DATA 1381653,4134165,1392405,4144917,1381695,4134207,1392447,4144959 DATA 0,328965,526344,723723,921102,1118481,1315860,1579032 DATA 1842204,2105376,2368548,2631720,2960685,3289650,3684408,4144959 DATA 0,4,8,12,16,21,25,29 DATA 33,37,42,46,50,54,58,63 DATA 0,262144,524288,786432,1048576,1376256,1638400,1900544 DATA 2162688,2424832,2752512,3014656,3276800,3538944,3801088,4128768 DATA 0,1024,2048,3072,4096,5376,6400,7424 DATA 8448,9472,10752,11776,12800,13824,14848,16128 DATA 0,262148,524296,786444,1048592,1376277,1638425,1900573 DATA 2162721,2424869,2752554,3014702,3276850,3538998,3801146,4128831 DATA 0,263168,526336,789504,1052672,1381632,1644800,1907968 DATA 2171136,2434304,2763264,3026432,3289600,3552768,3815936,4144896 DATA 0,1028,2056,3084,4112,5397,6425,7453 DATA 8481,9509,10794,11822,12850,13878,14906,16191 DATA 0,516,1032,1548,2064,2581,3097,3613 DATA 4385,4901,5418,5934,6450,6966,7482,8255 DATA 0,131076,262152,393228,524304,655381,786457,917533 DATA 1114145,1245221,1376298,1507374,1638450,1769526,1900602,2097215 DATA 0,262656,525312,787968,1050624,1378816,1641472,1904128 DATA 2167040,2429696,2757888,3020544,3283200,3545856,3808512,4136960 DATA 0,131844,263688,395532,527376,659477,791321,923165 DATA 1120545,1252389,1384490,1516334,1648178,1780022,1911866,2109503 DATA 0,131588,263176,394764,526352,657941,789529,921117 DATA 1118497,1250085,1381674,1513262,1644850,1776438,1908026,2105407 DATA 0,515,1030,1545,2060,2575,3090,3605 DATA 4376,4891,5406,5921,6436,6951,7466,8238 DATA 63,2103,4143,6183,8223,10008,12048,14088 DATA 16128,13833,11538,9243,6948,4653,2358,63 DATA 32,1058,2084,3110,4136,5418,6444,7470 DATA 8496,9522,10804,11830,12856,13882,14908,16191 REM $STATIC SUB AF.Box (DestSeg%, X1%, Y1%, X2%, Y2%, C%) 'Draws a box in a Layer(DestSeg%) 'Clipping supported 'parameters: 'Destseg=Layer to draw the Box(use VARSEG) 'X1,Y1,X2,Y2=Coordinates of the box 'C=Color STATIC Asm.Box%(), InitDone% IF InitDone% = 0 THEN Asm$ = "" Asm$ = Asm$ + "5589E51E8B46106631D28EC066528B460E8B4E0A39C87E01918B5E0C8B5608" Asm$ = Asm$ + "39D37E0287D33D3F010F8F970081FBC7000F8F8F003D00007D0231C083FB00" Asm$ = Asm$ + "7D0231DB83F9007C7C83FA007C7781F93F017E03B93F0181FAC7007E03BAC7" Asm$ = Asm$ + "0029C141894EFC29DA428956FA86DF89DFC1EF0201DF01C78A56FA8A4606BB" Asm$ = Asm$ + "400188C42B5EFC66C1E01080EA028A460688C48B4EFCC1E902F366AB8B4EFC" Asm$ = Asm$ + "83E103F3AA01DF268805037EFC268845FF01DFFECA75F08B4EFCC1E902F366" Asm$ = Asm$ + "AB8B4EFC83E103F3AA83C4041F5DCA0C00" CodeLen% = LEN(Asm$) IF (CodeLen% MOD 2) <> 0 THEN CodeLen% = CodeLen% + 1 Size% = CodeLen% \ 4 REDIM Asm.Box%(Size%) DEF SEG = VARSEG(Asm.Box%(0)) FOR I% = 0 TO CodeLen% \ 2 Byte% = VAL("&H" + MID$(Asm$, (I% * 2) + 1, 2)) POKE VARPTR(Asm.Box%(0)) + I%, Byte% NEXT I% DEF SEG InitDone% = 1 END IF DEF SEG = VARSEG(Asm.Box%(0)) CALL ABSOLUTE(BYVAL DestSeg%, BYVAL X1%, BYVAL Y1%, BYVAL X2%, BYVAL Y2%, BYVAL C%, VARPTR(Asm.Box%(0))) DEF SEG END SUB SUB AF.BoxF (DestSeg%, X1%, Y1%, X2%, Y2%, C%) 'See AF.Box 'Draws a filled box STATIC Asm.BoxF%(), InitDone% IF InitDone% = 0 THEN Asm$ = "" Asm$ = Asm$ + "5589E51E8B46106631D28EC06652528B460E8B4E0A39C87E01918B5E0C8B5" Asm$ = Asm$ + "60839D37E0287D33D3F017F7981FBC7007F733D00007D0231C083FB007D02" Asm$ = Asm$ + "31DB83F9007C6083FA007C5B81F93F017E03B93F0181FAC7007E03BAC7002" Asm$ = Asm$ + "9C141894EFC29DA428956FA86DF89DFC1EF0201DF01C78B56FA8A4606BB40" Asm$ = Asm$ + "0188C42B5EFC89C166C1E01089C88B4EFCC1E902894EF88B4EF8F366AB8B4" Asm$ = Asm$ + "EFC83E103F3AA01DF4A75ED83C4061F5DCA0C00" CodeLen% = LEN(Asm$) IF (CodeLen% MOD 2) <> 0 THEN CodeLen% = CodeLen% + 1 Size% = CodeLen% \ 4 REDIM Asm.BoxF%(Size%) DEF SEG = VARSEG(Asm.BoxF%(0)) FOR I% = 0 TO CodeLen% \ 2 Byte% = VAL("&H" + MID$(Asm$, (I% * 2) + 1, 2)) POKE VARPTR(Asm.BoxF%(0)) + I%, Byte% NEXT I% DEF SEG InitDone% = 1 END IF DEF SEG = VARSEG(Asm.BoxF%(0)) CALL ABSOLUTE(BYVAL DestSeg%, BYVAL X1%, BYVAL Y1%, BYVAL X2%, BYVAL Y2%, BYVAL C%, VARPTR(Asm.BoxF%(0))) DEF SEG END SUB SUB AF.BoxTrans (DestSeg%, X1%, Y1%, X2%, Y2%, C%) 'See AF.Box 'Draws a box Translucently!!! STATIC Asm.BoxTrans%(), InitDone% IF InitDone% = 0 THEN Asm$ = "" Asm$ = Asm$ + "5589E51E8B46108EC031D252528B460E8B4E0A39C87E01918B5E0C8B56083" Asm$ = Asm$ + "9D37E0287D33D3F010F8FD40081FBC7000F8FCC003D00007D0231C083FB00" Asm$ = Asm$ + "7D0231DB83F9000F8CB70083FA000F8CB00081F93F017E03B93F0181FAC70" Asm$ = Asm$ + "07E03BAC70029C141894EFC29DA428956FA86DF89DFC1EF0201DF01C78A56" Asm$ = Asm$ + "FA8A4606BB400180EA022B5EFC88C680E60F8B4EFC88F0268A2580E40F00C" Asm$ = Asm$ + "4D0EC2A4606F6D800E0268805474975E601DF88F0268A2580E40F00C4D0EC" Asm$ = Asm$ + "2A4606F6D800E0268805037EFC88F0268A65FF80E40F00C4D0EC2A4606F6D" Asm$ = Asm$ + "800E0268845FF01DFFECA75C98B4EFC88F0268A2580E40F00C4D0EC2A4606" Asm$ = Asm$ + "F6D800E0268805474975E683C4041F5DCA0C00" CodeLen% = LEN(Asm$) IF (CodeLen% MOD 2) <> 0 THEN CodeLen% = CodeLen% + 1 Size% = CodeLen% \ 4 REDIM Asm.BoxTrans%(Size%) DEF SEG = VARSEG(Asm.BoxTrans%(0)) FOR I% = 0 TO CodeLen% \ 2 Byte% = VAL("&H" + MID$(Asm$, (I% * 2) + 1, 2)) POKE VARPTR(Asm.BoxTrans%(0)) + I%, Byte% NEXT I% DEF SEG InitDone% = 1 END IF DEF SEG = VARSEG(Asm.BoxTrans%(0)) CALL ABSOLUTE(BYVAL DestSeg%, BYVAL X1%, BYVAL Y1%, BYVAL X2%, BYVAL Y2%, BYVAL C%, VARPTR(Asm.BoxTrans%(0))) DEF SEG END SUB SUB AF.BoxTransF (DestSeg%, X1%, Y1%, X2%, Y2%, C%) 'See AF.Box 'Draws a filled box Translucently!!! STATIC Asm.BoxTransF%(), InitDone% IF InitDone% = 0 THEN Asm$ = "" Asm$ = Asm$ + "5589E51E8B46106631D28EC066528B460E8B4E0A39C87E01918B5E0C8B560" Asm$ = Asm$ + "839D37E0287D33D3F017F7981FBC7007F733D00007D0231C083FB007D0231" Asm$ = Asm$ + "DB83F9007C6083FA007C5B81F93F017E03B93F0181FAC7007E03BAC70029C" Asm$ = Asm$ + "141894EFC29DA428956FA86DF89DFC1EF0201DF01C78A76FABB40012B5EFC" Asm$ = Asm$ + "8A560680E20F8B4EFC88D0268A2580E40F00C4D0EC2A4606F6D800E026880" Asm$ = Asm$ + "5474975E601DFFECE75DD83C4041F5DCA0C00" CodeLen% = LEN(Asm$) IF (CodeLen% MOD 2) <> 0 THEN CodeLen% = CodeLen% + 1 Size% = CodeLen% \ 4 REDIM Asm.BoxTransF%(Size%) DEF SEG = VARSEG(Asm.BoxTransF%(0)) FOR I% = 0 TO CodeLen% \ 2 Byte% = VAL("&H" + MID$(Asm$, (I% * 2) + 1, 2)) POKE VARPTR(Asm.BoxTransF%(0)) + I%, Byte% NEXT I% DEF SEG InitDone% = 1 END IF DEF SEG = VARSEG(Asm.BoxTransF%(0)) CALL ABSOLUTE(BYVAL DestSeg%, BYVAL X1%, BYVAL Y1%, BYVAL X2%, BYVAL Y2%, BYVAL C%, VARPTR(Asm.BoxTransF%(0))) DEF SEG END SUB SUB AF.Cls (DestSeg%, C%) 'Clears the Layer to a specified color 'Parameters: 'Destseg=Layer or page to clear(use VARSEG or VIDEO/&HA000) STATIC Asm.Cls%(), InitDone% IF InitDone% = 0 THEN Asm$ = "" Asm$ = Asm$ + "5589E58B46088CDA8EC031FF8A460688C489C166C1E01089C8B9803EF366AB8EDA5DCA0400" CodeLen% = LEN(Asm$) IF (CodeLen% MOD 2) <> 0 THEN CodeLen% = CodeLen% + 1 Size% = CodeLen% \ 4 REDIM Asm.Cls%(Size%) DEF SEG = VARSEG(Asm.Cls%(0)) FOR I% = 0 TO CodeLen% \ 2 Byte% = VAL("&H" + MID$(Asm$, (I% * 2) + 1, 2)) POKE VARPTR(Asm.Cls%(0)) + I%, Byte% NEXT I% DEF SEG InitDone% = 1 END IF DEF SEG = VARSEG(Asm.Cls%(0)) CALL ABSOLUTE(BYVAL DestSeg%, BYVAL C%, VARPTR(Asm.Cls%(0))) DEF SEG END SUB FUNCTION AF.Collide (Layer%, X%, Y%, SPRSEG%, SPROFF%) 'Returns the color in the layer that the sprite collided with 'Pixel*pixel collision 'Parameters: 'Layer=Page to check collision with(use VARSEG/VIDEO/&HA000) 'X,Y=coordinates of the sprite 'SprSeg=Segment of the Sprite(use VARSEG) 'Sproff=offset of the Sprite(use VARPTR) STATIC Asm.Collide%(), InitDone% IF InitDone% = 0 THEN Asm$ = "" Asm$ = Asm$ + "5589E51E8B460C8ED88B56128EC28B760A3E8B1CC1EB0331C03E8B5402505" Asm$ = Asm$ + "383C60452508B46103D3F017F663D00007C788B4E0E81F9C7007F5883F900" Asm$ = Asm$ + "7C7A01C381FB3F010F8F7F0029C301CA81FAC7000F8F820029CA895EF886C" Asm$ = Asm$ + "DBB400189CF2B5EF8C1EF0201CF895EF601C78B5EF889D93E8A2408E47407" Asm$ = Asm$ + "268A0508C0751349464783F90075EA037EF60376FC4A75DF29C08B5E088EC" Asm$ = Asm$ + "328E48B7E0626880583C4081F5DCA0E00F7D829C37EE301C68946FC31C0E9" Asm$ = Asm$ + "78FFF7D929CA7ED30376FA4975FAE977FF81EB4001015EFCBB400129C3E97" Asm$ = Asm$ + "4FF01D181E9C80029CA8B4E0EE972FF" CodeLen% = LEN(Asm$) IF (CodeLen% MOD 2) <> 0 THEN CodeLen% = CodeLen% + 1 Size% = CodeLen% \ 4 REDIM Asm.Collide%(Size%) DEF SEG = VARSEG(Asm.Collide%(0)) FOR I% = 0 TO CodeLen% \ 2 Byte% = VAL("&H" + MID$(Asm$, (I% * 2) + 1, 2)) POKE VARPTR(Asm.Collide%(0)) + I%, Byte% NEXT I% DEF SEG InitDone% = 1 END IF CLR% = 0 AF.Collide = 0 DEF SEG = VARSEG(Asm.Collide%(0)) CALL ABSOLUTE(BYVAL Layer%, BYVAL X%, BYVAL Y%, BYVAL SPRSEG%, BYVAL SPROFF%, BYVAL VARSEG(CLR%), BYVAL VARPTR(CLR%), VARPTR(Asm.Collide%(0))) DEF SEG AF.Collide = CLR% END FUNCTION FUNCTION AF.CollideSpr (X1%, Y1%, SprSeg1%, SprOff1%, X2%, Y2%, SprSeg2%, SprOff2%) 'Returns the color of the second sprite the first sprite collided with 'Pixel*pixel collision 'Parameters: 'Layer=Page to check collision with(use VARSEG/VIDEO/&HA000) 'X1,Y1=coordinates of the first sprite 'SprSeg1=Segment of the first Sprite(use VARSEG) 'Sproff1=offset of the first Sprite(use VARPTR) 'X2,Y2=coordinates of the second sprite 'SprSeg2=Segment of the second Sprite(use VARSEG) 'Sproff2=offset of the second Sprite(use VARPTR) STATIC Asm.CollideSpr%(), InitDone% IF InitDone% = 0 THEN Asm$ = "" Asm$ = Asm$ + "5589E51E8B46188B5E1029D88946188B4E168B560E29D1894E168B46148B4" Asm$ = Asm$ + "E0C8ED88EC18B76128B7E0A3E8B1C31C0C1EB038B5402505383C604525026" Asm$ = Asm$ + "8B0D268B4502C1E9034948515083C7048B46183B46F47F5E3D00007C728B4" Asm$ = Asm$ + "E163B4EF27F5183F9007C7501C33B5EF47F7D29C301CA3B56F20F8F820029" Asm$ = Asm$ + "CA895EF88B5EF4430FAFCB2B5EF8895EF601CF01C78B5EF889D93E8A04460" Asm$ = Asm$ + "8C0740A268A2580FC007511474975EE037EF60376FC4A75E329C086C428E4" Asm$ = Asm$ + "8B5E088EC38B7E0626890583C40C1F5DCA1400F7D829C37EE301C68946FC3" Asm$ = Asm$ + "1C0EB81F7D929CA7ED40376FA4975FDEB802B5EF44B015EFC8B5EF44329C3" Asm$ = Asm$ + "E97BFF01D12B4EF24929CA8B4E16E978FF8153E83401" CodeLen% = LEN(Asm$) IF (CodeLen% MOD 2) <> 0 THEN CodeLen% = CodeLen% + 1 Size% = CodeLen% \ 4 REDIM Asm.CollideSpr%(Size%) DEF SEG = VARSEG(Asm.CollideSpr%(0)) FOR I% = 0 TO CodeLen% \ 2 Byte% = VAL("&H" + MID$(Asm$, (I% * 2) + 1, 2)) POKE VARPTR(Asm.CollideSpr%(0)) + I%, Byte% NEXT I% DEF SEG InitDone% = 1 END IF CLR% = 0 AF.CollideSpr = 0 DEF SEG = VARSEG(Asm.CollideSpr%(0)) CALL ABSOLUTE(BYVAL X1%, BYVAL Y1%, BYVAL SprSeg1%, BYVAL SprOff1%, BYVAL X2%, BYVAL Y2%, BYVAL SprSeg2%, BYVAL SprOff2%, BYVAL VARSEG(CLR%), BYVAL VARPTR(CLR%), VARPTR(Asm.CollideSpr%(0))) DEF SEG AF.CollideSpr = CLR% END FUNCTION SUB AF.Font256 (DestSeg%, X%, Y%, Text$, Centered%, FontArray(), FontArrayIndex()) FontSeg% = VARSEG(FontArray(1)) IF NOT Centered% THEN FOR I% = 1 TO LEN(Text$) FontChar% = ASC(MID$(Text$, I%, 1)) - 31 AF.Sprite DestSeg%, X%, Y%, FontSeg%, VARPTR(FontArray(FontArrayIndex(FontChar))) X% = X% + (FontArray(FontArrayIndex(FontChar%)) \ 8) NEXT I% ELSE 'Centered StrLen% = 0 FOR I% = 1 TO LEN(Text$) FontChar% = ASC(MID$(Text$, I%, 1)) - 31 StrLen% = StrLen% + (FontArray(FontArrayIndex(FontChar%))) NEXT I% StrLen% = StrLen% \ 8 'Calculate length X% = (320 - StrLen%) \ 2 FOR I% = 1 TO LEN(Text$) FontChar% = ASC(MID$(Text$, I%, 1)) - 31 AF.Sprite DestSeg%, X%, Y%, FontSeg%, VARPTR(FontArray(FontArrayIndex(FontChar))) X% = X% + (FontArray(FontArrayIndex(FontChar%)) \ 8) NEXT I% END IF END SUB SUB AF.Get (Layer%, X1%, Y1%, X2%, Y2%, SPRSEG%, SPROFF%) 'Same a QB's GET statement 'Paramenters: 'Layer: the Page to GET the bounding box(VARSEG/VIDEO/&HA000) 'X1.Y1,X2,Y2:Coords of the box to get the image from 'SprSeg=Segment of the array(VARSEG) 'Sproff=offset of the array (VARPTR) STATIC Asm.Get%(), InitDone% IF InitDone% = 0 THEN Asm$ = "" Asm$ = Asm$ + "5589E51E8B46128B5E088ED88EC38B7E0631D252528B46108B4E0C39C87E0" Asm$ = Asm$ + "1918B5E0E8B560A39D37E0287D33D3F017F7081FBC7007F6A3D00007D0231" Asm$ = Asm$ + "C083FB007D0231DB83F9007C5783FA007C5281F93F017E03B93F0181FAC70" Asm$ = Asm$ + "07E03BAC70029C141894EFCC1E10326890D29DA428956FA2689550286DF89" Asm$ = Asm$ + "DEC1EE0201DE01C6BB40012B5EFC83C7048B4EFCC1E902F366A58B4EFC83E" Asm$ = Asm$ + "103F3AA01DE4A75EA83C4041F5DCA0E00" CodeLen% = LEN(Asm$) IF (CodeLen% MOD 2) <> 0 THEN CodeLen% = CodeLen% + 1 Size% = CodeLen% \ 4 REDIM Asm.Get%(Size%) DEF SEG = VARSEG(Asm.Get%(0)) FOR I% = 0 TO CodeLen% \ 2 Byte% = VAL("&H" + MID$(Asm$, (I% * 2) + 1, 2)) POKE VARPTR(Asm.Get%(0)) + I%, Byte% NEXT I% DEF SEG InitDone% = 1 END IF DEF SEG = VARSEG(Asm.Get%(0)) CALL ABSOLUTE(BYVAL Layer%, BYVAL X1%, BYVAL Y1%, BYVAL X2%, BYVAL Y2%, BYVAL SPRSEG%, BYVAL SPROFF%, VARPTR(Asm.Get%(0))) DEF SEG END SUB SUB AF.LoadPalPp256 (File$) STATIC 'Loads a pp256 palette 'Changes the VGA palette on the fly 'if File$="" the data statement is used IF File$ = "" OR File$ = " " THEN FOR n = 0 TO 255 READ C& B = C& \ 65536: C& = C& - B * 65536 G = C& \ 256: C& = C& - G * 256 R = C& OUT &H3C8, n OUT &H3C9, R OUT &H3C9, G OUT &H3C9, B NEXT ELSE FR = FREEFILE IF INSTR(File$, ".") = 0 THEN File$ = LEFT$(File$, 8) + ".Pal" OPEN File$ FOR BINARY AS #FR FOR n = 0 TO 255 GET #FR, , C& B = C& \ 65536: C& = C& - B * 65536 G = C& \ 256: C& = C& - G * 256 R = C& OUT &H3C8, n OUT &H3C9, R OUT &H3C9, G OUT &H3C9, B NEXT CLOSE #FR END IF END SUB SUB AF.Pcopy (DestSeg%, SRCSEG%) 'copies the sourceseg to destseg 'this acheives double buffering to eliminate flicker 'same as QB's PCOPY command 'Parameters: 'Destseg=Layer or page to copy to(usually VIDEO) 'srcseg=the source layer to copy from STATIC Asm.Pcopy%(), InitDone% IF InitDone% = 0 THEN Asm$ = "" Asm$ = Asm$ + "5589E58CD88B4E088B56068EC18EDA31FF31F6B9803EF366A58ED85DCA0400" CodeLen% = LEN(Asm$) IF (CodeLen% MOD 2) <> 0 THEN CodeLen% = CodeLen% + 1 Size% = CodeLen% \ 4 REDIM Asm.Pcopy%(Size%) DEF SEG = VARSEG(Asm.Pcopy%(0)) FOR I% = 0 TO CodeLen% \ 2 Byte% = VAL("&H" + MID$(Asm$, (I% * 2) + 1, 2)) POKE VARPTR(Asm.Pcopy%(0)) + I%, Byte% NEXT I% DEF SEG InitDone% = 1 END IF DEF SEG = VARSEG(Asm.Pcopy%(0)) CALL ABSOLUTE(BYVAL DestSeg%, BYVAL SRCSEG%, VARPTR(Asm.Pcopy%(0))) DEF SEG END SUB FUNCTION AF.Point (DestSeg%, X%, Y%) 'Same as QB's POINT command 'Returns the color of the coordinate 'Paramenters: 'Dest seg=See AF.Box 'X,Y:coordinates of the point STATIC Asm.Point%(), InitDone% IF InitDone% = 0 THEN Asm$ = "" Asm$ = Asm$ + "5589E58B460E8EC08B560A7C2581FAC7007F1F8B5E0C83FB007C1781FB3F0" Asm$ = Asm$ + "17F1167668D1492C1E20689D701DF268A0530E48B5E088EC38B7E06268905" Asm$ = Asm$ + "5DCA0A00" CodeLen% = LEN(Asm$) IF (CodeLen% MOD 2) <> 0 THEN CodeLen% = CodeLen% + 1 Size% = CodeLen% \ 4 REDIM Asm.Point%(Size%) DEF SEG = VARSEG(Asm.Point%(0)) FOR I% = 0 TO CodeLen% \ 2 Byte% = VAL("&H" + MID$(Asm$, (I% * 2) + 1, 2)) POKE VARPTR(Asm.Point%(0)) + I%, Byte% NEXT I% DEF SEG InitDone% = 1 END IF CLR% = 0 AF.Point = 0 Tseg% = VARSEG(CLR%) Toff% = VARPTR(CLR%) DEF SEG = VARSEG(Asm.Point%(0)) CALL ABSOLUTE(BYVAL DestSeg%, BYVAL X%, BYVAL Y%, BYVAL Tseg%, BYVAL Toff%, VARPTR(Asm.Point%(0))) DEF SEG AF.Point = CLR% END FUNCTION SUB AF.Print (Segment%, Xpos%, Ypos%, Text$, col%) 'Prints the standard 8*8 CGA font 'Paramenters: 'Segment=the Layer to print to 'Xpos,Ypos=the coordinates of the text 'Text$=the string to print 'col= is the color to print(gradient) X% = Xpos% Y% = Ypos% Spacing% = 8 FOR I% = 0 TO LEN(Text$) - 1 X% = X% + Spacing% Offset% = 8 * ASC(MID$(Text$, I% + 1, 1)) + 14 FOR J% = 0 TO 7 DEF SEG = &HFFA6 Bit% = PEEK(Offset% + J%) IF Bit% AND 1 THEN CALL AF.Pset(Segment%, X%, Y% + J%, col% + J%) IF Bit% AND 2 THEN CALL AF.Pset(Segment%, X% - 1, Y% + J%, col% + J%) IF Bit% AND 4 THEN CALL AF.Pset(Segment%, X% - 2, Y% + J%, col% + J%) IF Bit% AND 8 THEN CALL AF.Pset(Segment%, X% - 3, Y% + J%, col% + J%) IF Bit% AND 16 THEN CALL AF.Pset(Segment%, X% - 4, Y% + J%, col% + J%) IF Bit% AND 32 THEN CALL AF.Pset(Segment%, X% - 5, Y% + J%, col% + J%) IF Bit% AND 64 THEN CALL AF.Pset(Segment%, X% - 6, Y% + J%, col% + J%) IF Bit% AND 128 THEN CALL AF.Pset(Segment%, X% - 7, Y% + J%, col% + J%) NEXT J% NEXT I% DEF SEG END SUB SUB AF.Pset (DestSeg%, X%, Y%, C%) 'Same as QB's PSET command 'Paramenters: 'Dest seg=See AF.Box 'X,Y:coordinates of the pixel 'C:color of the pixel to draw STATIC Asm.Pset%(), InitDone% IF InitDone% = 0 THEN Asm$ = "" Asm$ = Asm$ + "5589E58B460C8B56087C288EC081FAC7007F208B5E0A83FB007C1881FB3F01" Asm$ = Asm$ + "7F1267668D1492C1E20689D701DF8A4E0626880D5DCA0800" CodeLen% = LEN(Asm$) IF (CodeLen% MOD 2) <> 0 THEN CodeLen% = CodeLen% + 1 Size% = CodeLen% \ 4 REDIM Asm.Pset%(Size%) DEF SEG = VARSEG(Asm.Pset%(0)) FOR I% = 0 TO CodeLen% \ 2 Byte% = VAL("&H" + MID$(Asm$, (I% * 2) + 1, 2)) POKE VARPTR(Asm.Pset%(0)) + I%, Byte% NEXT I% DEF SEG InitDone% = 1 END IF DEF SEG = VARSEG(Asm.Pset%(0)) CALL ABSOLUTE(BYVAL DestSeg%, BYVAL X%, BYVAL Y%, BYVAL C%, VARPTR(Asm.Pset%(0))) DEF SEG END SUB SUB AF.PsetTrans (DestSeg%, X%, Y%, C%) 'See AF.Pset 'Draws a pixel translucently STATIC Asm.PsetTrans%(), InitDone% IF InitDone% = 0 THEN Asm$ = "" Asm$ = Asm$ + "5589E58B460C8B56087C3C8EC081FAC7007F348B5E0A83FB007C2C81FB3F0" Asm$ = Asm$ + "17F2667668D1492C1E20689D701DF8A4E0680E10F268A2D80E50F00CDD0ED" Asm$ = Asm$ + "2A4E06F6D900CD26882D5DCA0800" CodeLen% = LEN(Asm$) IF (CodeLen% MOD 2) <> 0 THEN CodeLen% = CodeLen% + 1 Size% = CodeLen% \ 4 REDIM Asm.PsetTrans%(Size%) DEF SEG = VARSEG(Asm.PsetTrans%(0)) FOR I% = 0 TO CodeLen% \ 2 Byte% = VAL("&H" + MID$(Asm$, (I% * 2) + 1, 2)) POKE VARPTR(Asm.PsetTrans%(0)) + I%, Byte% NEXT I% DEF SEG InitDone% = 1 END IF DEF SEG = VARSEG(Asm.PsetTrans%(0)) CALL ABSOLUTE(BYVAL DestSeg%, BYVAL X%, BYVAL Y%, BYVAL C%, VARPTR(Asm.PsetTrans%(0))) DEF SEG END SUB SUB AF.Sprite (DestSeg%, X%, Y%, SPRITESEGMENT%, SPRITEOFFSET%) 'AF.Sprite 'Draws a sprite on the Page/Layer or directly to screen 'Same as QB's PUT routine 'Skips Color 0, 197 bytes,No need for masks 'Clipping supported 'Parameters: 'Destseg:The layer to draw the sprite to(VARSEG/VIDEO/&HA000) 'X,Y:coordinates of the sprite 'SpriteSegment=the segment the of the SpriteArray(VARSEG) 'SpriteOffset=the offset the of the SpriteArray(VARPTR) STATIC Asm.Sprite%(), InitDone% IF InitDone% = 0 THEN Asm$ = "" Asm$ = Asm$ + "5589E51E8B56088EDA8B560E8EC28B76068B1C31C0C1EB038B5402505383" Asm$ = Asm$ + "C60452508B460C3D3F017F5B3D00007C5E8B4E0A81F9C7007F4D83F9007C" Asm$ = Asm$ + "5F01C381FB3F017F6529C301CA81FAC7007F6929CA895EF886CDBB400189" Asm$ = Asm$ + "CF2B5EF8C1EF0201CF895EF601C78B5EF889D93E8A0408C0740326880546" Asm$ = Asm$ + "474975F1037EF60376FC4A75E683C4081F5DCA0A00F7D829C37EF201C689" Asm$ = Asm$ + "46FC31C0EB93F7D929CA7EE30376FA4975FAEB9381EB4001015EFCBB4001" Asm$ = Asm$ + "29C3EB8F01D181E9C80029CA8B4E0AEB8C" CodeLen% = LEN(Asm$) IF (CodeLen% MOD 2) <> 0 THEN CodeLen% = CodeLen% + 1 Size% = CodeLen% \ 4 REDIM Asm.Sprite%(Size%) DEF SEG = VARSEG(Asm.Sprite%(0)) FOR I% = 0 TO CodeLen% \ 2 Byte% = VAL("&H" + MID$(Asm$, (I% * 2) + 1, 2)) POKE VARPTR(Asm.Sprite%(0)) + I%, Byte% NEXT I% DEF SEG InitDone% = 1 END IF 'This Draws ;*) DEF SEG = VARSEG(Asm.Sprite%(0)) CALL ABSOLUTE(BYVAL DestSeg%, BYVAL X%, BYVAL Y%, BYVAL SPRITESEGMENT%, BYVAL SPRITEOFFSET%, VARPTR(Asm.Sprite%(0))) DEF SEG END SUB SUB AF.SpriteColor (DestSeg%, X%, Y%, SPRITESEGMENT%, SPRITEOFFSET%, CLR%) 'See AF.Sprite 'Draws the sprites outline on a single color 'Parameter: 'Same as AF.Sprite 'C=Color to plot the outline of the sprite STATIC Asm.SpriteColor%(), InitDone% IF InitDone% = 0 THEN Asm$ = "" Asm$ = Asm$ + "5589E51E8B560A8EDA8B56108EC28B76088B1C31C0C1EB038B5402505383C" Asm$ = Asm$ + "60452508B460E3D3F017F5E3D00007C618B4E0C81F9C7007F5083F9007C62" Asm$ = Asm$ + "01C381FB3F017F6829C301CA81FAC7007F6C29CA895EF886CDBB400189CF2" Asm$ = Asm$ + "B5EF8C1EF0201CF895EF601C78B5EF88A660689D93E8A0408C07403268825" Asm$ = Asm$ + "46474975F1037EF60376FC4A75E683C4081F5DCA0C00F7D829C37EF201C68" Asm$ = Asm$ + "946FC31C0EB90F7D929CA7EE30376FA4975FAEB9081EB4001015EFCBB4001" Asm$ = Asm$ + "29C3EB8C01D181E9C80029CA8B4E0CEB89" CodeLen% = LEN(Asm$) IF (CodeLen% MOD 2) <> 0 THEN CodeLen% = CodeLen% + 1 Size% = CodeLen% \ 4 REDIM Asm.SpriteColor%(Size%) DEF SEG = VARSEG(Asm.SpriteColor%(0)) FOR I% = 0 TO CodeLen% \ 2 Byte% = VAL("&H" + MID$(Asm$, (I% * 2) + 1, 2)) POKE VARPTR(Asm.SpriteColor%(0)) + I%, Byte% NEXT I% DEF SEG InitDone% = 1 END IF DEF SEG = VARSEG(Asm.SpriteColor%(0)) CALL ABSOLUTE(BYVAL DestSeg%, BYVAL X%, BYVAL Y%, BYVAL SPRITESEGMENT%, BYVAL SPRITEOFFSET%, BYVAL CLR%, VARPTR(Asm.SpriteColor%(0))) DEF SEG END SUB SUB AF.SpriteGamma (DestSeg%, X%, Y%, SPRITESEGMENT%, SPRITEOFFSET%, GAMMADISP%) 'See AF.Sprite 'Draws a "LIGHTENED" or "DARKENED" sprite depending on the GammaDisp 'useful for night and day FX as well as shadows 'Paramenters:(extra) 'GammaDisp: is the light and dark controller 'Positive(+)=Lightens 'Negative(-)=Darkens 'Try values of +6 or -6 for cool fx STATIC Asm.SpriteGamma%(), InitDone% IF InitDone% = 0 THEN Asm$ = "" Asm$ = Asm$ + "5589E51E8B560A8EDA8B56108EC28B76088B1C31C0C1EB038B5402505383C" Asm$ = Asm$ + "60452508B460E3D3F010F8F85003D00000F8C86008B4E0C81F9C7007F7583" Asm$ = Asm$ + "F9000F8C860001C381FB3F010F8F8B0029C301CA81FAC7000F8F8E0029CA8" Asm$ = Asm$ + "95EF886CDBB400189CF2B5EF8C1EF0201CF895EF601C731DB8A66068B4EF8" Asm$ = Asm$ + "3E8A0408C0742288C3240F28C300E000D838D8770526881DEB0F80C30F38D" Asm$ = Asm$ + "8720526881DEB0326880546474975D2037EF60376FC4A75C683C4081F5DCA" Asm$ = Asm$ + "0C00F7D829C37EF201C68946FC31C0E96AFFF7D929CA7EE20376FA4975FAE" Asm$ = Asm$ + "96BFF81EB4001015EFCBB400129C3E968FF01D181E9C80029CA8B4E0CE966" Asm$ = Asm$ + "FF" CodeLen% = LEN(Asm$) IF (CodeLen% MOD 2) <> 0 THEN CodeLen% = CodeLen% + 1 Size% = CodeLen% \ 4 REDIM Asm.SpriteGamma%(Size%) DEF SEG = VARSEG(Asm.SpriteGamma%(0)) FOR I% = 0 TO CodeLen% \ 2 Byte% = VAL("&H" + MID$(Asm$, (I% * 2) + 1, 2)) POKE VARPTR(Asm.SpriteGamma%(0)) + I%, Byte% NEXT I% DEF SEG InitDone% = 1 END IF DEF SEG = VARSEG(Asm.SpriteGamma%(0)) CALL ABSOLUTE(BYVAL DestSeg%, BYVAL X%, BYVAL Y%, BYVAL SPRITESEGMENT%, BYVAL SPRITEOFFSET%, BYVAL GAMMADISP%, VARPTR(Asm.SpriteGamma%(0))) DEF SEG END SUB SUB AF.SpriteSolid (DestSeg%, X%, Y%, SPRITESEGMENT%, SPRITEOFFSET%) 'AF.SpriteSolid 'Solid Put plots 4 pixels at a time 'Use for speed ;*) 'Parameters: See AF.Sprite STATIC Asm.SpriteSolid%(), InitDone% IF InitDone% = 0 THEN Asm$ = "" Asm$ = Asm$ + "5589E51E8B56088EDA8B560E8EC28B76068B1C31C0C1EB038B5402505383C" Asm$ = Asm$ + "60452508B460C3D3F017F5B3D00007C5E8B4E0A81F9C7007F4D83F9007C5F" Asm$ = Asm$ + "01C381FB3F017F6529C301CA81FAC7007F6929CA895EF886CDBB400189CF2" Asm$ = Asm$ + "B5EF8C1EF0201CF895EF601C78B5EF889D8C1E80283E30389C1F366A589D9" Asm$ = Asm$ + "F3A4037EF60376FC4A75EE83C4081F5DCA0A00F7D829C37EF201C68946FC3" Asm$ = Asm$ + "1C0EB93F7D929CA7EE30376FA4975FAEB9381EB4001015EFCBB400129C3EB" Asm$ = Asm$ + "8F01D181E9C80029CA8B4E0AEB8C" CodeLen% = LEN(Asm$) IF (CodeLen% MOD 2) <> 0 THEN CodeLen% = CodeLen% + 1 Size% = CodeLen% \ 4 REDIM Asm.SpriteSolid%(Size%) DEF SEG = VARSEG(Asm.SpriteSolid%(0)) FOR I% = 0 TO CodeLen% \ 2 Byte% = VAL("&H" + MID$(Asm$, (I% * 2) + 1, 2)) POKE VARPTR(Asm.SpriteSolid%(0)) + I%, Byte% NEXT I% DEF SEG InitDone% = 1 END IF DEF SEG = VARSEG(Asm.SpriteSolid%(0)) CALL ABSOLUTE(BYVAL DestSeg%, BYVAL X%, BYVAL Y%, BYVAL SPRITESEGMENT%, BYVAL SPRITEOFFSET%, VARPTR(Asm.SpriteSolid%(0))) DEF SEG END SUB SUB AF.SpriteTrans (DestSeg%, X%, Y%, SPRITESEGMENT%, SPRITEOFFSET%) 'See AF.Sprite 'Draws a sprite translucently!!! STATIC Asm.SpriteTrans%(), InitDone% IF InitDone% = 0 THEN Asm$ = "" Asm$ = Asm$ + "5589E51E8B56088EDA8B560E8EC28B76068B1C31C0C1EB038B5402505383C" Asm$ = Asm$ + "60452508B460C3D3F017F753D00007C788B4E0A81F9C7007F6783F9007C7A" Asm$ = Asm$ + "01C381FB3F010F8F7F0029C301CA81FAC7000F8F820029CA895EF886CDBB4" Asm$ = Asm$ + "00189CF2B5EF8C1EF0201CF895EF601C78B5EF889D93E8A0408C07416240F" Asm$ = Asm$ + "268A2580E40F00C4D0EC3E2A04F6D800E026880549464783F90075DB037EF" Asm$ = Asm$ + "60376FC4A75D083C4081F5DCA0A00F7D829C37EF201C68946FC31C0E978FF" Asm$ = Asm$ + "F7D929CA7EE20376FA4975FAE977FF81EB4001015EFCBB400129C3E974FF0" Asm$ = Asm$ + "1D181E9C80029CA8B4E0AE972FF" CodeLen% = LEN(Asm$) IF (CodeLen% MOD 2) <> 0 THEN CodeLen% = CodeLen% + 1 Size% = CodeLen% \ 4 REDIM Asm.SpriteTrans%(Size%) DEF SEG = VARSEG(Asm.SpriteTrans%(0)) FOR I% = 0 TO CodeLen% \ 2 Byte% = VAL("&H" + MID$(Asm$, (I% * 2) + 1, 2)) POKE VARPTR(Asm.SpriteTrans%(0)) + I%, Byte% NEXT I% DEF SEG InitDone% = 1 END IF DEF SEG = VARSEG(Asm.SpriteTrans%(0)) CALL ABSOLUTE(BYVAL DestSeg%, BYVAL X%, BYVAL Y%, BYVAL SPRITESEGMENT%, BYVAL SPRITEOFFSET%, VARPTR(Asm.SpriteTrans%(0))) DEF SEG END SUB SUB InitImageData (FileName$, ImageArray()) IF FileName$ <> "" THEN '***** Read image data from file ***** 'Establish size of integer array required. FileNo = FREEFILE OPEN FileName$ FOR BINARY AS #FileNo Ints = (LOF(FileNo) - 7) \ 2 CLOSE #FileNo REDIM ImageArray(1 TO Ints) 'Load image data directly into array memory. DEF SEG = VARSEG(ImageArray(1)) BLOAD FileName$, 0 DEF SEG ELSE '***** Read image data from DATA statements ***** 'Establish size of integer array required. READ IntCount REDIM ImageArray(1 TO IntCount) 'READ image DATA into array. FOR n = 1 TO IntCount READ X ImageArray(n) = X NEXT n END IF END SUB SUB MakeImageIndex (ImageArray(), IndexArray()) 'The index will initially be built in a temporary array, allowing 'for the maximum 1000 images per file. DIM Temp(1 TO 1000) ptr& = 1: IndexNo = 1: LastInt = UBOUND(ImageArray) DO Temp(IndexNo) = ptr& IndexNo = IndexNo + 1 'Evaluate descriptor of currently referenced image to 'calculate the beginning of the next image. X& = (ImageArray(ptr&) \ 8) * (ImageArray(ptr& + 1)) + 4 IF X& MOD 2 THEN X& = X& + 1 ptr& = ptr& + (X& \ 2) LOOP WHILE ptr& < LastInt LastImage = IndexNo - 1 'Copy the image index values into the actual index array. REDIM IndexArray(1 TO LastImage) FOR n = 1 TO LastImage IndexArray(n) = Temp(n) NEXT n END SUB FUNCTION MULTIKEY (t) 'Milo Sedlacek's multikey STATIC kbcontrol%(), kbmatrix%(), Firsttime, StatusFlag IF Firsttime = 0 THEN 'Initalize DIM kbcontrol%(128) DIM kbmatrix%(128) code$ = "" code$ = code$ + "E91D00E93C00000000000000000000000000000000000000000000000000" code$ = code$ + "00001E31C08ED8BE24000E07BF1400FCA5A58CC38EC0BF2400B85600FAAB" code$ = code$ + "89D8ABFB1FCB1E31C08EC0BF2400BE14000E1FFCFAA5A5FB1FCBFB9C5053" code$ = code$ + "51521E560657E460B401A8807404B400247FD0E088C3B700B0002E031E12" code$ = code$ + "002E8E1E100086E08907E4610C82E661247FE661B020E6205F075E1F5A59" code$ = code$ + "5B589DCF" DEF SEG = VARSEG(kbcontrol%(0)) FOR I% = 0 TO 155 ' Load ASM d% = VAL("&h" + MID$(code$, (I% * 2) + 1, 2)) POKE VARPTR(kbcontrol%(0)) + I%, d% NEXT I% I& = 16 ' I think this stuff connects the interrupt with kbmatrix%() n& = VARSEG(kbmatrix%(0)): l& = n& AND 255: h& = ((n& AND &HFF00) \ 256): POKE I&, l&: POKE I& + 1, h&: I& = I& + 2 n& = VARPTR(kbmatrix%(0)): l& = n& AND 255: h& = ((n& AND &HFF00) \ 256): POKE I&, l&: POKE I& + 1, h&: I& = I& + 2 DEF SEG Firsttime = 1 END IF SELECT CASE t CASE -1 IF StatusFlag = 0 THEN DEF SEG = VARSEG(kbcontrol%(0)) CALL ABSOLUTE(0) ' Run interrupt DEF SEG StatusFlag = 1 END IF CASE -2 IF StatusFlag = 1 THEN DEF SEG = VARSEG(kbcontrol%(0)) ' Turn off interrupt CALL ABSOLUTE(3) DEF SEG StatusFlag = 0 END IF CASE 1 TO 128 MULTIKEY = kbmatrix%(t) ' Return status CASE ELSE MULTIKEY = 0 ' User Supidity Error END SELECT END FUNCTION