Qbasicnews.com

Qbasicnews.com > General > General/Misc > I remember somebody asking me how to implement Gamma+ Mode7
Full Version: I remember somebody asking me how to implement Gamma+ Mode7
You're currently viewing a stripped down version of our content. View the full version with proper formatting.

relsoft

07-11-2004, 12:51 PM
Enjoy!!!

Code:
'Mode7 demo for Af.Lib
'Uses AF.GammaBlock to simulate lighting
'I saw this effect on FF6(intro) on the Snes
'I remember someone asking for this so...

'Http://Rel.betterwebber.com

'Controls...
'    Arrows = move
'    A/Z    = Scale z/height
'    S/X    = scale x
'    D/C    = scale y
'    F/V    = Horizon/Eyeview

DECLARE SUB AF.Smooth (Layer%, x1%, y1%, x2%, y2%)
DECLARE SUB AF.Mode7 (Layer%, x1%, y1%, x2%, y2%, Angle%, Scalex%, Scaley%, Scalez%, Horz%, camx!, camy!, Texture%(), TextureOffset%)
DECLARE SUB AF.Print (Segment%, Xpos%, Ypos%, Text$, col%)
DECLARE SUB AF.Pcopy (DestSeg%, SRCSEG%)
DECLARE SUB AF.Cls (DestSeg%, C%)
DECLARE FUNCTION MULTIKEY% (T%)
DECLARE SUB AF.Pset (DestSeg%, X%, Y%, C%)
DECLARE SUB AF.SpriteFlip (DestSeg%, X%, Y%, SPRITESEGMENT%, SPRITEOFFSET%, FlipMode%)
DECLARE SUB AF.Get (Layer%, x1%, y1%, x2%, y2%, SprSeg%, SprOff%)
DECLARE SUB AF.GammaBLock (DestSeg%, x1%, y1%, x2%, y2%, gammaval%)
DECLARE SUB AF.GradColor (col1%, r1%, g1%, b1%, col2%, r2%, g2%, b2%)


DEFINT A-Z

RANDOMIZE TIMER

TYPE KartType                   'our camera
    X       AS SINGLE
    Y       AS SINGLE
    dx      AS SINGLE
    dy      AS SINGLE
    Angle   AS INTEGER
    speed   AS SINGLE
    accel   AS SINGLE
END TYPE

'KEY CONSTANTS
CONST KEYESC = 1, KEYENTER = 28, KEYSPACE = 57, KEYTAB = &HF
CONST KEYUP = 72, KEYDOWN = 80, KEYLEFT = 75, KEYRIGHT = 77

'Of course!!!!! :)
CONST FALSE = 0, TRUE = NOT FALSE
CONST VIDEO = &HA000

'FlipMode(for use with RelSpriteFlip)
CONST FLIPNONE = 0, FLIPH = 1, FLIPV = 2, FLIPVH = 3
'not needed but used for easy reference
CONST PI = 3.141593
CONST FRICTION = .016                       'for pseudo physics
CONST TSIZE = 64                            'tilesize try to change this...
CONST TSIZESQUARED = TSIZE * TSIZE
CONST MAPTILEXMAX = 128
CONST MAPMAXPIXELX = MAPTILEXMAX * TSIZE
CONST MAPTILEYMAX = 64
CONST MAPMAXPIXELY = MAPTILEYMAX * TSIZE


'$DYNAMIC

DIM SHARED Vpage%(0 TO 31999)           'our buffer
DIM SHARED Layer%

'$STATIC
DIM SHARED Lcos!(359)                   'fast Lookups
DIM SHARED Lsin!(359)
DIM SHARED Texture%((((TSIZESQUARED%) + 4) \ 2))    'calc array size for
                                                    'GET array

Layer% = VARSEG(Vpage%(0))                          'set layer address
                                                    'for reference

DIM SHARED Mario AS KartType                        'needs a better name


Mario.X = MAPMAXPIXELX \ 2                  'center our camera
Mario.Y = MAPMAXPIXELY \ 2
Mario.dx = 0
Mario.dy = 0
Mario.Angle = 0
Mario.accel = .1                        'acceleration
Mario.speed = 0



'calc lookup tables

FOR I% = 0 TO 359
    RA! = I% * (3.141593 / 180)
    Lcos!(I%) = COS(RA!)
    Lsin!(I%) = SIN(RA!)
NEXT I%


CLS
SCREEN 13



'Display color grad
FOR I = 0 TO 15
    FOR j = 0 TO 15
        LINE (j * 5, I * 5)-STEP(5, 5), (I * 16) + j, BF
    NEXT j
NEXT I

'Read ending grad colors and set gradient pal
RESTORE RGB
FOR I = 0 TO 15
    READ R%, G%, B%
    AF.GradColor I * 16, 0, 0, 0, (I * 16) + 15, R%, G%, B%
NEXT I

C$ = INPUT$(1)

'do some nice texture
FOR Y% = 0 TO TSIZE - 1
FOR X% = 0 TO TSIZE - 1
    PSET (X%, Y%), 16 + (X% XOR Y%)
NEXT X%
NEXT Y%

'duh!
GET (0, 0)-STEP(TSIZE - 1, TSIZE - 1), Texture%(0)

x1 = 0              'window dimensions for Mode7
y1 = 100
x2 = 319
y2 = 199

'GammaDDA
gi& = 16 * 256& \ ((y2 - y1) + 1)
Bright% = 1
Ceilsize% = ((100 * 320) + 4) \ 2
DIM SHARED Ceil%(Ceilsize%)           'our buffer


'mode 7 parameters
Angle = 0               'Look forward
Scalex = 200            '200 looks good
Scaley = 200
Scalez = 15             'height
Horz = 10               'eyeview
camx! = 0
camy! = 0
Dummy = MULTIKEY(-1)      'activate keyboard handler
Finished = FALSE
T# = TIMER
DO
    f& = (f& + 1) AND &H7FFFFFFF

    IF MULTIKEY(KEYLEFT) THEN             'rotate angle
       Mario.Angle = (Mario.Angle - 1)
       IF Mario.Angle < 0 THEN Mario.Angle = 360 + Mario.Angle
       KoopaFrame% = 2
    END IF
    IF MULTIKEY(KEYRIGHT) THEN            'rotate angle
       Mario.Angle = (Mario.Angle + 1)
       IF Mario.Angle > 359 THEN Mario.Angle = 360 - Mario.Angle
       KoopaFrame% = 3
    END IF
    IF MULTIKEY(KEYDOWN) THEN             'move backwards
        Mario.speed = Mario.speed - Mario.accel
    END IF
    IF MULTIKEY(KEYUP) THEN               'move forvard
        Mario.speed = Mario.speed + Mario.accel
    END IF

    IF MULTIKEY(&H1E) THEN            'A  'increase height
        Scalez = Scalez + 1
    END IF
    IF MULTIKEY(&H2C) THEN            'z  decrease height
        Scalez = Scalez - 1
    END IF
    IF MULTIKEY(&H1F) THEN            's
        Scalex = Scalex + 1
    END IF
    IF MULTIKEY(&H2D) THEN            'x
        Scalex = Scalex - 1
    END IF
    IF MULTIKEY(&H20) THEN            'd
        Scaley = Scaley + 1
    END IF
    IF MULTIKEY(&H2E) THEN            'c
        Scaley = Scaley - 1
    END IF

    IF MULTIKEY(&H21) THEN            'F  'decrease eyeview
        Horz = Horz + 1
        y1 = y1 - 1
        IF y1 < 0 THEN y1 = 0
    END IF
    IF MULTIKEY(&H2F) THEN            'v  increase eyeview
        Horz = Horz - 1
        y1 = y1 + 1
        IF y1 > 199 THEN y1 = 199
    END IF

    IF MULTIKEY(KEYENTER) THEN
       Finished = TRUE
    END IF
    IF MULTIKEY(KEYESC) THEN
        Finished = TRUE
    END IF

    'calc physics
    Mario.speed = Mario.speed - Mario.speed * FRICTION
    dx! = (Lcos!(Mario.Angle)) * Mario.speed
    dy! = (Lsin!(Mario.Angle)) * Mario.speed

    Mario.X = Mario.X + dx!
    IF Mario.X < 0 THEN
        Mario.X = 0
    ELSEIF Mario.X >= MAPMAXPIXELX THEN
        Mario.X = MAPMAXPIXELX
    END IF

    Mario.Y = Mario.Y + dy!
    IF Mario.Y < 0 THEN
        Mario.Y = 0
    ELSEIF Mario.Y >= MAPMAXPIXELY THEN
        Mario.Y = MAPMAXPIXELY
    END IF

    Angle% = Mario.Angle
    px! = Mario.X
    py! = Mario.Y
    AF.Cls Layer, 0
    AF.Mode7 Layer%, x1, y1, x2, y2, Angle%, Scalex, Scaley, Scalez, Horz, px!, py!, Texture%(), 0
    gvs& = (-16 + Bright%) * 256
    FOR I = 0 TO 99
        yy = I + 100
        gv% = gvs& \ 256
        AF.GammaBLock Layer, 0, yy, 319, yy, gv%
        gvs& = gvs& + gi&
    NEXT I
    AF.Get Layer, x1, y1, x2, y2, VARSEG(Ceil%(0)), VARPTR(Ceil%(0))
    AF.SpriteFlip Layer, 0, 0, VARSEG(Ceil%(0)), VARPTR(Ceil%(0)), FLIPV
    ''WAIT &H3DA, 8
    AF.Pcopy VIDEO, Layer
LOOP UNTIL Finished

Dummy = MULTIKEY(-2)

Fps% = f& / (TIMER - T#)
CLS
SCREEN 0
WIDTH 80
PRINT "FPS:"; Fps%
C$ = INPUT$(1)

'RGB colors for our Grad
RGB:
DATA 63,63,63               : 'WHITE
DATA 63,0,0                 : 'RED
DATA 0,63,0                 : 'GREEN
DATA 0,0,63                 : 'BLUE
DATA 0,63,63                : 'BLUE/GREEN
DATA 63,63,0                : 'RED/GREEN
DATA 63,0,63                : 'RED/BLUE
DATA 32,25,63               : '
DATA 63,0,45                : '
DATA 16,63,20               : '
DATA 45,45,63               : '
DATA 63,45,20               : '
DATA 25,63,45               : '
DATA 56,63,34               : '
DATA 45,25,50               : '
DATA 63,25,11               : '

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
    Asm$ = ""
END SUB

SUB AF.GammaBLock (DestSeg%, x1%, y1%, x2%, y2%, gammaval%)

STATIC Asm.GammaBlock%(), InitDone%

IF InitDone% = 0 THEN
    Asm$ = ""
    Asm$ = "1E558BEC8E46126633D26652528B46108B4E0C3BC17E039090918B5E0E8B"
    Asm$ = Asm$ + "560A3BDA7E04909087DA3D3F010F8FA30081FBC7000F8F9B003D00"
    Asm$ = Asm$ + "007D04909033C083FB007D04909033DB83F9000F8C820083FA007C"
    Asm$ = Asm$ + "7D909081F93F017E059090B93F0181FAC7007E059090BAC7002BC8"
    Asm$ = Asm$ + "41894EFE2BD3428956FC86FB8BFBC1EF0203FB03F88A76FCBB4001"
    Asm$ = Asm$ + "2B5EFE895EFA8A66088B4EFE268A053C00742790908AD8240F2AD8"
    Asm$ = Asm$ + "02C402C33AC37708909026881DEB139080C30F3AC3720890902688"
    Asm$ = Asm$ + "1DEB0490268805474975CB037EFAFECE75C183C4065D1FCA0C00"

    CodeLen% = LEN(Asm$)
    IF (CodeLen% MOD 2) <> 0 THEN CodeLen% = CodeLen% + 1
    Size% = CodeLen% \ 4
    REDIM Asm.GammaBlock%(Size%)

    DEF SEG = VARSEG(Asm.GammaBlock%(0))
    FOR I% = 0 TO CodeLen% \ 2
            Byte% = VAL("&H" + MID$(Asm$, (I% * 2) + 1, 2))
            POKE VARPTR(Asm.GammaBlock%(0)) + I%, Byte%
    NEXT I%
    DEF SEG
    InitDone% = 1
END IF

    DEF SEG = VARSEG(Asm.GammaBlock%(0))
    CALL ABSOLUTE(BYVAL DestSeg%, BYVAL x1%, BYVAL y1%, BYVAL x2%, BYVAL y2%, BYVAL gammaval%, VARPTR(Asm.GammaBlock%(0)))
    DEF SEG
    Asm$ = ""

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$ = "1E558BEC8E5E148E460A8B7E086633D266528B46128B4E0E3BC17E039090"
    Asm$ = Asm$ + "918B5E108B560C3BDA7E04909087DA3D3F010F8F800081FBC7007F"
    Asm$ = Asm$ + "7A90903D00007D04909033C083FB007D04909033DB83F9007C6190"
    Asm$ = Asm$ + "9083FA007C5A909081F93F017E059090B93F0181FAC7007E059090"
    Asm$ = Asm$ + "BAC7002BC841894EFEC1E10326890D2BD3428956FC83C702268915"
    Asm$ = Asm$ + "86FB8BF3C1EE0203F303F0BB40012B5EFE83C7028B4EFEC1E902F3"
    Asm$ = Asm$ + "66A58B4EFE83E103F3A403F34A75EA83C4045D1FCA0E00"

    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
    Asm$ = ""

END SUB

SUB AF.GradColor (col1, r1, g1, b1, col2, r2, g2, b2)
'Makes a gradient color by interpolating the RGB values of the first
'color index (col1) and col2 by the number of cols.
'Only use this in screen 13

R! = r1
G! = g1
B! = b1
cols = (col2 - col1 + 1)
Rstep! = (r2 - r1 + 1) / cols
Gstep! = (g2 - g1 + 1) / cols
Bstep! = (b2 - b1 + 1) / cols
FOR col = col1 TO col2
    R! = R! + Rstep!
    G! = G! + Gstep!
    B! = B! + Bstep!
    IF R! > 63 THEN R! = 63
    IF R! < 0 THEN R! = 0
    IF G! > 63 THEN G! = 63
    IF G! < 0 THEN G! = 0
    IF B! > 63 THEN B! = 63
    IF B! < 0 THEN B! = 0
    OUT &H3C8, col
    OUT &H3C9, FIX(R!)
    OUT &H3C9, FIX(G!)
    OUT &H3C9, FIX(B!)
NEXT col


END SUB

SUB AF.Mode7 (Layer%, x1%, y1%, x2%, y2%, Angle%, Scalex%, Scaley%, Scalez%, Horz%, camx!, camy!, Texture%(), TextureOffset%)
'Just converted my mode7 render usin List2op by Plasma
'Relsoft

STATIC Asm.Mode7%(), InitDone%

IF InitDone% = 0 THEN
    Asm$ = ""
    Asm$ = "C834000006571E568B4E228B561E3BCA0F8F0302"
    Asm$ = Asm$ + "81F9C7000F8FF30183F9000F8CF90183FA"
    Asm$ = Asm$ + "000F8CE50181FAC7000F8FFD012BD1420F"
    Asm$ = Asm$ + "84D60186E98BF9C1EF0203F98B46248B5E"
    Asm$ = Asm$ + "203BC30F8FE7013D3F010F8FBA013D0000"
    Asm$ = Asm$ + "0F8CDD0183FB000F8CAC0181FB3F010F8F"
    Asm$ = Asm$ + "DE012BD84303F8B940012BCB894ED6895E"
    Asm$ = Asm$ + "D4D1EB8BC36698668946CE8956D28B4614"
    Asm$ = Asm$ + "6698668946FC8B46126698668946F86633"
    Asm$ = Asm$ + "C08B46188B5E1A0FAFC366C1E008668946"
    Asm$ = Asm$ + "E4C746E200008E46268E5E088B76068B04"
    Asm$ = Asm$ + "C1E8038946DE488946DA8B44028946DC48"
    Asm$ = Asm$ + "8946D88B46DE3D020075099090C646CC01"
    Asm$ = Asm$ + "EB60903D040075099090C646CC02EB5290"
    Asm$ = Asm$ + "3D080075099090C646CC03EB44903D1000"
    Asm$ = Asm$ + "75099090C646CC04EB36903D2000750990"
    Asm$ = Asm$ + "90C646CC05EB28903D400075099090C646"
    Asm$ = Asm$ + "CC06EB1A903D800075099090C646CC07EB"
    Asm$ = Asm$ + "0C903D00010F85D100C646CC088B46E203"
    Asm$ = Asm$ + "46166698668BD8668B46E46633D266F7FB"
    Asm$ = Asm$ + "668BD8668BC86633D28B461C6698669166"
    Asm$ = Asm$ + "F7F9668BC8668BD166F7DA660FAF56F866"
    Asm$ = Asm$ + "8956F4660FAF4EFC66894EF0668BC3660F"
    Asm$ = Asm$ + "AF5EFC660FAF56CE662BDA66895EEC668B"
    Asm$ = Asm$ + "560E660156EC660FAF46F8660FAF4ECE66"
    Asm$ = Asm$ + "2BC1668946E8668B4E0A66014EE88A4ECC"
    Asm$ = Asm$ + "8B5ED4895EE0668B46EC66C1F8102346DA"
    Asm$ = Asm$ + "668B5EE866C1FB10235ED8D3E38BF303F0"
    Asm$ = Asm$ + "0376068A4404268805668B56F4668B46F0"
    Asm$ = Asm$ + "660156EC660146E847FF4EE075C5037ED6"
    Asm$ = Asm$ + "8B46D28346E2013946E20F8C33FF5E1F5F"
    Asm$ = Asm$ + "07C9CA220087CAE9F8FD8BC22BC103C883"
    Asm$ = Asm$ + "F9007CE833C9E9F7FDE9F4FDBAC700E9FD"
    Asm$ = Asm$ + "FD93E915FE8BCB2BC803C13D00007CCB33"
    Asm$ = Asm$ + "C0E913FEBB3F01E91CFE"

    CodeLen% = LEN(Asm$)
    IF (CodeLen% MOD 2) <> 0 THEN CodeLen% = CodeLen% + 1
    Size% = CodeLen% \ 4
    REDIM Asm.Mode7%(Size%)

    DEF SEG = VARSEG(Asm.Mode7%(0))
    FOR I% = 0 TO CodeLen% \ 2
            Byte% = VAL("&H" + MID$(Asm$, (I% * 2) + 1, 2))
            POKE VARPTR(Asm.Mode7%(0)) + I%, Byte%
    NEXT I%
    DEF SEG
    InitDone% = 1
END IF

'This Draws ;*)

'xRelMode7   Proc  Uses es di ds si,\
'            Layer:word,scalex:word, scaley:word, scalez:word, horz:word,\
'            cosa: word, sina: word, camx: word, camy: word, TextSeg: word, TextOff: word
a! = (Angle% * 3.141593) / 180
cosa% = COS(a!) * 256
sina% = SIN(a!) * 256
camx& = camx! * 65536
camy& = camy! * 65536
IF Horz% < 1 THEN Horz% = 1


DEF SEG = VARSEG(Asm.Mode7%(0))
CALL ABSOLUTE(BYVAL Layer%, BYVAL x1%, BYVAL y1%, BYVAL x2%, BYVAL y2%, BYVAL Scalex%, BYVAL Scaley%, BYVAL Scalez%, BYVAL Horz%, BYVAL cosa%, BYVAL sina%, BYVAL camx&, BYVAL camy&, BYVAL VARSEG(Texture%(TextureOffset%)), BYVAL VARPTR(Texture%( _
TextureOffset%)), VARPTR(Asm.Mode7%(0)))
DEF SEG

END SUB

SUB AF.Mode7Map (Layer%, x1%, y1%, x2%, y2%, Angle%, Scalex%, Scaley%, Scalez%, Horz%, camx!, camy!, Texture%(), TextureOffset%, Map%())

STATIC Asm.Mode7Map%(), InitDone%

IF InitDone% = 0 THEN
    Asm$ = ""
    Asm$ = "C834000006571E568B4E228B561E3BCA0F8F0302"
    Asm$ = Asm$ + "81F9C7000F8FF30183F9000F8CF90183FA"
    Asm$ = Asm$ + "000F8CE50181FAC7000F8FFD012BD1420F"
    Asm$ = Asm$ + "84D60186E98BF9C1EF0203F98B46248B5E"
    Asm$ = Asm$ + "203BC30F8FE7013D3F010F8FBA013D0000"
    Asm$ = Asm$ + "0F8CDD0183FB000F8CAC0181FB3F010F8F"
    Asm$ = Asm$ + "DE012BD84303F8B940012BCB894ED6895E"
    Asm$ = Asm$ + "D4D1EB8BC36698668946CE8956D28B4614"
    Asm$ = Asm$ + "6698668946FC8B46126698668946F86633"
    Asm$ = Asm$ + "C08B46188B5E1A0FAFC366C1E008668946"
    Asm$ = Asm$ + "E4C746E200008E46268E5E088B76068B04"
    Asm$ = Asm$ + "C1E8038946DE488946DA8B44028946DC48"
    Asm$ = Asm$ + "8946D88B46DE3D020075099090C646CC01"
    Asm$ = Asm$ + "EB60903D040075099090C646CC02EB5290"
    Asm$ = Asm$ + "3D080075099090C646CC03EB44903D1000"
    Asm$ = Asm$ + "75099090C646CC04EB36903D2000750990"
    Asm$ = Asm$ + "90C646CC05EB28903D400075099090C646"
    Asm$ = Asm$ + "CC06EB1A903D800075099090C646CC07EB"
    Asm$ = Asm$ + "0C903D00010F85D100C646CC088B46E203"
    Asm$ = Asm$ + "46166698668BD8668B46E46633D266F7FB"
    Asm$ = Asm$ + "668BD8668BC86633D28B461C6698669166"
    Asm$ = Asm$ + "F7F9668BC8668BD166F7DA660FAF56F866"
    Asm$ = Asm$ + "8956F4660FAF4EFC66894EF0668BC3660F"
    Asm$ = Asm$ + "AF5EFC660FAF56CE662BDA66895EEC668B"
    Asm$ = Asm$ + "560E660156EC660FAF46F8660FAF4ECE66"
    Asm$ = Asm$ + "2BC1668946E8668B4E0A66014EE88A4ECC"
    Asm$ = Asm$ + "8B5ED4895EE0668B46EC66C1F8102346DA"
    Asm$ = Asm$ + "668B5EE866C1FB10235ED8D3E38BF303F0"
    Asm$ = Asm$ + "0376068A4404268805668B56F4668B46F0"
    Asm$ = Asm$ + "660156EC660146E847FF4EE075C5037ED6"
    Asm$ = Asm$ + "8B46D28346E2013946E20F8C33FF5E1F5F"
    Asm$ = Asm$ + "07C9CA220087CAE9F8FD8BC22BC103C883"
    Asm$ = Asm$ + "F9007CE833C9E9F7FDE9F4FDBAC700E9FD"
    Asm$ = Asm$ + "FD93E915FE8BCB2BC803C13D00007CCB33"
    Asm$ = Asm$ + "C0E913FEBB3F01E91CFE"

    CodeLen% = LEN(Asm$)
    IF (CodeLen% MOD 2) <> 0 THEN CodeLen% = CodeLen% + 1
    Size% = CodeLen% \ 4
    REDIM Asm.Mode7Map%(Size%)

    DEF SEG = VARSEG(Asm.Mode7Map%(0))
    FOR I% = 0 TO CodeLen% \ 2
            Byte% = VAL("&H" + MID$(Asm$, (I% * 2) + 1, 2))
            POKE VARPTR(Asm.Mode7Map%(0)) + I%, Byte%
    NEXT I%
    DEF SEG
    InitDone% = 1
END IF

'xRelMode7map   Proc  Uses es di ds si,\
'                Layer:word, x1:word, y1:word, x2:word, y2:word, scalex:word, scaley:word, scalez:word, horz:word,\
'                cosa: word, sina: word, camx: Dword, camy: Dword, TextSeg: word, TextOff: word, Mapseg:Word, MapOff: word, xMapsize:word,yMapsize: word

a! = (Angle% * 3.141593) / 180
cosa% = COS(a!) * 256
sina% = SIN(a!) * 256
camx& = camx! * 65536
camy& = camy! * 65536
Mx% = UBOUND(Map%, 1) + 1
My% = UBOUND(Map%, 2) + 1

IF Horz% < 1 THEN Horz% = 1


DEF SEG = VARSEG(Asm.Mode7Map%(0))
CALL ABSOLUTE(BYVAL Layer%, BYVAL x1%, BYVAL y1%, BYVAL x2%, BYVAL y2%, BYVAL Scalex%, BYVAL Scaley%, BYVAL Scalez%, BYVAL Horz%, BYVAL cosa%, BYVAL sina%, BYVAL camx&, BYVAL camy&, BYVAL VARSEG(Texture%(TextureOffset%)), BYVAL VARPTR(Texture%( _
TextureOffset%)), BYVAL VARSEG(Map%(0, 0)), BYVAL VARPTR(Map%(0, 0)), BYVAL Mx%, BYVAL My%, VARPTR(Asm.Mode7Map%(0)))
DEF SEG

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
    Asm$ = ""
END SUB

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$ = "8BC58BEC8E460A8B560683FA007C2E909081FAC7007F2690908B5E0883FB"
    Asm$ = Asm$ + "007C1C909081FB3F017F14909066678D1492C1E2068BFA03FB8A4E"
    Asm$ = Asm$ + "0426880D8BE8CA0800"

    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
    Asm$ = ""
END SUB

SUB AF.Smooth (Layer%, x1%, y1%, x2%, y2%)

STATIC Asm.Smooth%(), InitDone%

IF InitDone% = 0 THEN
    Asm$ = ""
    Asm$ = "C806000006578B4E0A8B56063BCA0F8FD30081F9C7000F8FC50083F9000F"
    Asm$ = Asm$ + "8CC90083FA000F8CB70081FAC7000F8FCA002BD1420F84A80086E9"
    Asm$ = Asm$ + "8BF9C1EF0203F98B460C8B5E083BC30F8FB4003D3F010F8F8C003D"
    Asm$ = Asm$ + "00000F8CAA0083FB000F8C7E0081FB3F010F8FAB002BD84303F8B9"
    Asm$ = Asm$ + "40012BCB894EFA8956FE895EFC8E460E8B4EFC33C033DB268A85BF"
    Asm$ = Asm$ + "FE268A9D410103C3268A9DC1FE03C3268A9D3F0103C3C1E8048BD0"
    Asm$ = Asm$ + "33C033DB268A85C0FE268A9D400103C3268A5DFF03C3268A5D0103"
    Asm$ = Asm$ + "C3C1E80303D033C0268A05C1E80202C2268805474975AB037EFAFF"
    Asm$ = Asm$ + "4EFE75A05F07C9CA0A0087CAE928FF8BC22BC103C883F9007CEA33"
    Asm$ = Asm$ + "C9E927FFBAC700E930FF93E948FF8BCB2BC803C13D00007CD033C0"
    Asm$ = Asm$ + "E946FFBB3F01E94FFF"

    CodeLen% = LEN(Asm$)
    IF (CodeLen% MOD 2) <> 0 THEN CodeLen% = CodeLen% + 1
    Size% = CodeLen% \ 4
    REDIM Asm.Smooth%(Size%)

    DEF SEG = VARSEG(Asm.Smooth%(0))
    FOR I% = 0 TO CodeLen% \ 2
            Byte% = VAL("&H" + MID$(Asm$, (I% * 2) + 1, 2))
            POKE VARPTR(Asm.Smooth%(0)) + I%, Byte%
    NEXT I%
    DEF SEG
    InitDone% = 1
END IF

    DEF SEG = VARSEG(Asm.Smooth%(0))
    CALL ABSOLUTE(BYVAL Layer%, BYVAL x1%, BYVAL y1%, BYVAL x2%, BYVAL y2%, VARPTR(Asm.Smooth%(0)))
    DEF SEG
    Asm$ = ""

END SUB

SUB AF.SpriteFlip (DestSeg%, X%, Y%, SPRITESEGMENT%, SPRITEOFFSET%, FlipMode%)


STATIC Asm.SpriteFlip%(), InitDone%

IF InitDone% = 0 THEN
    Asm$ = ""
    Asm$ = "C81400001E0656578E5E0A8E46108B76088B1CC1EB03895EFC895EF68B54"
    Asm$ = Asm$ + "028956FA8956F4C746FE0000C746F80000C746F20000C746F00000"
    Asm$ = Asm$ + "C746EC0000C746EE000083C6048B460E3D3F010F8F7E003D00000F"
    Asm$ = Asm$ + "8C7F008B4E0C81F9C7007F6E909083F9000F8C800003D881FB3F01"
    Asm$ = Asm$ + "0F8F88002BD803D181FAC7000F8F8E002BD1895EFC86E9BB40018B"
    Asm$ = Asm$ + "F92B5EFCC1EF0203F9895EF803F8837E06010F848400837E06020F"
    Asm$ = Asm$ + "84A300837E06030F84DF008B5EFC8BCB8A04460AC0740590902688"
    Asm$ = Asm$ + "05474975F0037EF80376FE4A75E55F5E071FC9CA0C00F7D82BD87E"
    Asm$ = Asm$ + "F203F08946FE8946EE33C0E96EFFF7D92BD17EDF894EF20376FC49"
    Asm$ = Asm$ + "75FAE96EFF81EB4001015EFE895EF0BB40012BD8E968FF03CA81E9"
    Asm$ = Asm$ + "C8002BD18B4EF4894EEC2956EC8B4E0CE95DFF0376F08B4EFC8BD9"
    Asm$ = Asm$ + "4B2B5EEE8A000AC074059090268805474B4975F0037EF80376F64A"
    Asm$ = Asm$ + "75DEEB83B940018BDA4B0FAFCB03F98B4EF68B5EF20FAFCB2BF18B"
    Asm$ = Asm$ + "46F68B5EEC0FAFC303F08B4EFC8A04460AC0740590902688054749"
    Asm$ = Asm$ + "75F02B7EFC81EF40010376FE4A75E0E93FFF8B4EF68BDA0FAFCB03"
    Asm$ = Asm$ + "F14E8B4EF68B5EF20FAFCB2BF18B46F68B5EEC0FAFC303F02B76EE"
    Asm$ = Asm$ + "8B4EFC2B76EE8A044E0AC074059090268805474975F0037EF82B76"
    Asm$ = Asm$ + "F04A75E1E9F9FE"

    CodeLen% = LEN(Asm$)
    IF (CodeLen% MOD 2) <> 0 THEN CodeLen% = CodeLen% + 1
    Size% = CodeLen% \ 4
    REDIM Asm.SpriteFlip%(Size%)

    DEF SEG = VARSEG(Asm.SpriteFlip%(0))
    FOR I% = 0 TO CodeLen% \ 2
            Byte% = VAL("&H" + MID$(Asm$, (I% * 2) + 1, 2))
            POKE VARPTR(Asm.SpriteFlip%(0)) + I%, Byte%
    NEXT I%
    DEF SEG
    InitDone% = 1
END IF

'This Draws ;*)

    DEF SEG = VARSEG(Asm.SpriteFlip%(0))
    CALL ABSOLUTE(BYVAL DestSeg%, BYVAL X%, BYVAL Y%, BYVAL SPRITESEGMENT%, BYVAL SPRITEOFFSET%, BYVAL FlipMode%, VARPTR(Asm.SpriteFlip%(0)))
    DEF SEG
    Asm$ = ""

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

code$ = ""
END FUNCTION

QbGuru

07-11-2004, 05:33 PM
I'm Lovi'n it. Wicked fast 522 FPs. Wow and under winXP. Can't imagine what'l happen under 98/dos :wink:

Adigun A. Polack

07-11-2004, 11:38 PM
To Richard Eric M. Lope:

WOW!!! Big Grin !!! I must say that after yours most truly has viewed your latest Mode-7 implementation for your up and coming release of AfLib, guess what? YOU DID A *MUCH* HOTTER JOB THAN EVER ON YOUR MODE-7 THING, even in that it ran so utterly smooth and fast on the Pionex Pentium-III 450mhz computer under MS Windows 98 (especially at the initial frame rate of 140fps!! :o ! ), and that the Mode-7 layers ran from both the bottom AND the top as well!!! Cool

Everybody must check your UNFORGETTABLY AWESOME code presented in this thread out, in order to be plain blown away in such gorgeous excitement that is so many steps up in creating something revolutionary in QB programming. No bull about that, ever! ;*) !!

You know what, since one of my categories on the QBCPC 2004/2005 is about Mode-7 Programming in QB, on your program, YOU GOT SOME BIG-TIME POTENTIAL. Believe me. ^_- !

Another thing, if all of that that you have just coded is *successfully* implemented into your latest RelLib as well, then man, you are in SERIOUS business now!!! Also, as according to your wildly hot QB demo from 2003 entitled “Mono and Disco”, the background wave effect (as originally and previously seen from Thunder Force III on Sega Genesis/MegaDrive) TRULY ROCKED!!! Please implement that for RelLib for easier programming for the user on that, as it would really help me and all of us much greatly, too. Wink !

DO WHAT YOU GOTTA DO, MY MAN, and praise God for you!!! See you again! :bounce: !!



CONGRATULATING YOU ON YOUR OUTSTANDING WORK,

Adigun Azikiwe Polack
One of the Founders of “Aura Flow”
Continuing Developer of “Frantic Journey”
Current Developer of “Star Angelic Slugger”
Webmaster of the all-new “AAP Official Projects Squad”




______________________________________
[Image: aap_official_project_squad__468x80_weblinker.jpg]
Be sure to please pay a visit to it! While you are there, watch for new and exciting stuff to happen anytime and even regularly, too!! Big Grin !!

relsoft

07-12-2004, 10:10 AM
QBGuru: works on XP? Wow!!!

AAP: Trust me, I'm working on it. Along with some other stuff. ;*)
Qbasicnews.com > General > General/Misc > I remember somebody asking me how to implement Gamma+ Mode7