03-08-2004, 11:16 AM
Code:
'One of the many possibilities of SuperPut
'This is prolly the fastest interference circles ever done in QB.
'SetVideoSeg and SuperPut by Plasma
'Relsoft
DEFINT A-Z
DECLARE SUB SuperPut ()
DECLARE SUB SuperPutRemove ()
DECLARE SUB SetVideoSeg (Segment)
SCREEN 13 '(not really needed because SuperPut sets screen 13)
SuperPut 'Install the patch
' Simple 32x32 sprite for testing
DIM Image(32001)
CLS
'set up our nice circles
FOR y% = -99 TO 100
ydist! = y% * y%
FOR x% = -159 TO 160
xdist! = CLNG(x% * x%)
PSET (x% + 159, y% + 99), 15 * (SQR(ABS(xdist!) + ABS(ydist!)) \ 4 AND 1)
NEXT x%
NEXT y%
GET (0, 0)-(319, 199), Image 'get image
CLS
REDIM Vpage(32009) AS INTEGER 'Clear offscreen buffer
Vpage(6) = 2560 'Width 320*8
Vpage(7) = 200 'Height
Layer = VARSEG(Vpage(0)) + 1 'Buffer Seg(Ask Plasma)
DO
F& = F& + 1
x1 = COS(F& / 80) * 50 'loactions of images
y1 = SIN(F& / 40) * 30
x2 = COS(F& / 20) * 50
y2 = SIN(F& / 30) * 30
SetVideoSeg Layer
PUT (x1, y1), Image, PSET 'first image
PUT (x2, y2), Image, XOR 'superimposed image
LINE (0, 0)-(50, 199), 0, BF 'left border
LINE (0, 0)-(319, 30), 0, BF 'top border
LINE (320 - 50, 0)-(319, 199), 0, BF 'right border
LINE (0, 200 - 30)-(319, 199), 0, BF 'down border
SetVideoSeg &HA000
WAIT &H3DA, 8
PUT (0, 0), Vpage(6), PSET
LOOP UNTIL INKEY$ <> ""
END
SUB SetVideoSeg (Segment) STATIC
'===============================================================
' SetVideoSeg by Plasma
'---------------------------------------------------------------
' Changes QB's active video segment for SCREEN 13
'---------------------------------------------------------------
' * Works for all graphics functions (does not work with PRINT)
' * Compatible with: QBasic 1.x
' QuickBasic 4.x (IDE & compiled)
' QB PDS 7.1 (IDE & compiled)
' VBDOS 1.0 (IDE & compiled)
'===============================================================
DEF SEG
' If SetVideoSeg was previously called, we can just
' set the new segment and bail.
IF VideoSegOff <> 0 THEN
POKE VideoSegOff, Segment AND &HFF
POKE VideoSegOff + 1, (Segment AND &HFF00&) \ &H100
EXIT SUB
END IF
' Otherwise we have to search for b$AddrC, which holds the
' graphics offset (b$OffC) and segment (b$SegC). Since b$AddrC
' is in the default segment, we can find it by setting it to a
' certain value, and then searching for that value.
SCREEN 13 ' Set b$SegC to A000 (00A0 in memory)
PSET (160, 100), 0 ' Set b$OffC to 7DA0 (not needed in the IDE)
' Search for b$AddrC, which is in the default segment and
' should have a value of A0 7D 00 A0.
FOR i = 0 TO &H7FFC
IF PEEK(i) = &HA0 AND PEEK(i + 1) = &H7D THEN
IF PEEK(i + 2) = &H0 AND PEEK(i + 3) = &HA0 THEN
' Found it, so set b$SegC to the specified segment and exit
VideoSegOff = i + 2
POKE VideoSegOff, Segment AND &HFF
POKE VideoSegOff + 1, (Segment AND &HFF00&) \ &H100
EXIT SUB
END IF
END IF
NEXT
SCREEN 0
WIDTH 80, 25
PRINT "SetVideoSeg Error: Cannot find video segment offset."
PRINT "Check to make sure you are using a compatible version of QB."
END
END SUB
SUB SuperPut STATIC
'===============================================================
' SuperPut by Plasma
' Props to Rel for the original idea and RelSpriteFlip
'---------------------------------------------------------------
' Replaces QB's graphics PUT with Rel's optimized routine that
' supports clipping, transparency, and flipping.
'---------------------------------------------------------------
' Clipping: Sprites will be clipped if they are partially
' off-screen, rather than returning "Illegal Function
' Call". This also means you can pass negative
' coordinates.
'
' Transparency: Color 0 is always the transparent color,
' except when the PSET actionverb is passed
' (transparency is then ignored).
'
' New PUT actionverbs: XOR - not flipped (default)
' PSET - not flipped &
' no transparency
' PRESET - flipped horizontally
' OR - flipped vertically
' AND - flipped horizontally &
' vertically
'---------------------------------------------------------------
' * Works with SCREEN 13 only
' * Fully compatible with SetVideoSeg :)
' * Compatible with: QBasic 1.x
' QuickBasic 4.x (IDE & compiled)
' QB PDS 7.1 (IDE & compiled)
' VBDOS 1.0 (IDE & compiled)
'
' Note: If you compile your program, it must be compiled as
' a stand-alone EXE!
'===============================================================
IF NOT Loaded THEN 'First time? If so, find the offsets and load the code
' Find the video segment offset (b$SegC). See SetVideoSeg if
' you want to see how this works.
SCREEN 13
PSET (160, 100), 0
DefSeg& = VARSEG(DefSeg$)
DEF SEG = DefSeg&
FOR i = 0 TO &H7FFC
IF PEEK(i) = &HA0 AND PEEK(i + 1) = &H7D THEN
IF PEEK(i + 2) = &H0 AND PEEK(i + 3) = &HA0 THEN
VideoSegOff = i + 2
EXIT FOR
END IF
END IF
NEXT
IF i = &H7FFD THEN
SCREEN 0
WIDTH 80, 25
PRINT "SuperPut Error: Cannot find video segment offset."
PRINT "Check to make sure you are using a compatible version of QB."
END
END IF
' Find QB's B$GPUT routine by searching for some known opcodes
' (backwards from the default segment)
PutSeg& = DefSeg& - &H400
DO WHILE PutSeg& > 0
DEF SEG = PutSeg&
FOR i = 0 TO &H3FF4
IF PEEK(i) = &HC4 AND PEEK(i + 1) = &H5E AND PEEK(i + 2) = &HA THEN
IF PEEK(i + 3) = &H8C AND PEEK(i + 4) = &HC1 AND PEEK(i + 5) = &H41 THEN
IF PEEK(i + 6) = &HE2 AND PEEK(i + 7) = &H5 AND PEEK(i + 8) = &H8B THEN
IF PEEK(i + 9) = &H5E AND PEEK(i + 10) = &H8 AND PEEK(i + 11) = &HC4 THEN
IF PEEK(i + 12) = &H1F THEN
PutOff = i 'Routine entry point is 16 bytes before
PutSeg& = PutSeg& - 1 'the anchor, so just decrease the segment
EXIT DO 'and we have the real entry point.
END IF
END IF
END IF
END IF
END IF
NEXT
PutSeg& = PutSeg& - &H3FF
LOOP
IF i = &H3FF5 THEN
SCREEN 0
WIDTH 80, 25
PRINT "SuperPut Error: Cannot find QB's B$GPUT routine."
PRINT "Check to make sure you are using a compatible version of QB"
PRINT "and have compiled your program as a stand-alone EXE."
END
END IF
' Modified version of RelSpriteFlip
NewPut$ = "8B1CC1EB032E891E36022E891E3C028B54022E891638022E89163E022EC706"
NewPut$ = NewPut$ + "340200002EC7063A0200002EC706400200002EC706420200002E"
NewPut$ = NewPut$ + "C706460200002EC7064402000083C6048B460A3D3F010F8F8C00"
NewPut$ = NewPut$ + "3D00000F8CA6008B4E0881F9C7007F7C83F9000F8CAB0003D881"
NewPut$ = NewPut$ + "FB3F010F8FB7002BD803D181FAC7000F8FC1002BD12E891E3602"
NewPut$ = NewPut$ + "86E9BB40018BF92E2B1E3602C1EF0203F92E891E3A0203F8837E"
NewPut$ = NewPut$ + "06020F84B700837E06000F84DF00837E06010F842601837E0603"
NewPut$ = NewPut$ + "742A2E8B1E36028BCB8A04460AC07403268805474975F22E033E"
NewPut$ = NewPut$ + "3A022E033634024A75E31F075F5E5DCA0800FC2E8B1E36028BCB"
NewPut$ = NewPut$ + "F3A42E033E3A022E033634024A75EFEBDFF7D82BD87ED903F02E"
NewPut$ = NewPut$ + "A334022EA3440233C0E945FFF7D92BD17EC42E890E40022E0336"
NewPut$ = NewPut$ + "36024975F8E93FFF81EB40012E011E34022E891E4202BB40012B"
NewPut$ = NewPut$ + "D8E935FF03CA81E9C8002BD12E8B0E3E022E890E46022E291646"
NewPut$ = NewPut$ + "028B4E08E924FF2E033642022E8B0E36028BD94B2E2B1E44028A"
NewPut$ = NewPut$ + "000AC07403268805474B4975F22E033E3A022E03363C024A75D8"
NewPut$ = NewPut$ + "E951FFB940018BDA4B0FAFCB03F92E8B0E3C022E8B1E40020FAF"
NewPut$ = NewPut$ + "CB2BF12EA13C022E8B1E46020FAFC303F02E8B0E36028A04460A"
NewPut$ = NewPut$ + "C07403268805474975F22E2B3E360281EF40012E033634024A75"
NewPut$ = NewPut$ + "DCE902FF2E8B0E3C028BDA0FAFCB03F14E2E8B0E3C022E8B1E40"
NewPut$ = NewPut$ + "020FAFCB2BF12EA13C022E8B1E46020FAFC303F02E2B3644022E"
NewPut$ = NewPut$ + "8B0E36022E2B3644028A044E0AC07403268805474975F22E033E"
NewPut$ = NewPut$ + "3A022E2B3642024A75DBE9ABFE00000000000000000000000000"
NewPut$ = NewPut$ + "00000000000000"
' Load the code into memory and dump the wasteful string
DIM NewPut(LEN(NewPut$) / 2 - 1)
DEF SEG = VARSEG(NewPut(0))
FOR i = 1 TO LEN(NewPut$) STEP 2
POKE (i - 1) / 2, VAL("&H" + MID$(NewPut$, i, 2))
NEXT
NewPut$ = ""
END IF
DEF SEG = PutSeg&
IF PEEK(PutOff + &H1D) = &H26 THEN 'First time patching?
POKE PutOff + &H50, PEEK(PutOff + &H2B) 'Save addresses before we
POKE PutOff + &H51, PEEK(PutOff + &H2C) 'overwrite them (in case
POKE PutOff + &H52, PEEK(PutOff + &H33) 'the user wants to restore
POKE PutOff + &H53, PEEK(PutOff + &H34) 'the PUT routine...)
POKE PutOff + &H54, PEEK(PutOff + &H38)
POKE PutOff + &H55, PEEK(PutOff + &H39)
END IF
' Patch it up
POKE PutOff + &H1D, &H1E 'push ds
POKE PutOff + &H1E, &HA1 'mov ax,B$GYPOS
POKE PutOff + &H1F, PEEK(PutOff + &H42)
POKE PutOff + &H20, PEEK(PutOff + &H43)
POKE PutOff + &H21, &H89 'mov [bp+08],ax
POKE PutOff + &H22, &H46
POKE PutOff + &H23, &H8
POKE PutOff + &H24, &HA1 'mov ax,B$GXPOS
POKE PutOff + &H25, PEEK(PutOff + &H54)
POKE PutOff + &H26, PEEK(PutOff + &H55)
POKE PutOff + &H27, &H89 'mov [bp+0A],ax
POKE PutOff + &H28, &H46
POKE PutOff + &H29, &HA
POKE PutOff + &H2A, &H89 'mov si,bx
POKE PutOff + &H2B, &HDE
POKE PutOff + &H2C, &H8C 'mov bx,es
POKE PutOff + &H2D, &HC3
POKE PutOff + &H2E, &H8E 'mov ds,bx
POKE PutOff + &H2F, &HDB
POKE PutOff + &H30, &HBB 'mov bx,DefSeg&
POKE PutOff + &H31, DefSeg& AND &HFF
POKE PutOff + &H32, (DefSeg& AND &HFF00&) \ &H100
POKE PutOff + &H33, &H8E 'mov es,bx
POKE PutOff + &H34, &HC3
POKE PutOff + &H35, &H26 'mov bx,es:VideoSegOff
POKE PutOff + &H36, &H8B
POKE PutOff + &H37, &H1E
POKE PutOff + &H38, VideoSegOff AND &HFF
POKE PutOff + &H39, (VideoSegOff AND &HFF00&) \ &H100
POKE PutOff + &H3A, &H8E 'mov es,bx
POKE PutOff + &H3B, &HC3
POKE PutOff + &H3C, &HEA 'jmp VARSEG(NewPut(0)):0000
POKE PutOff + &H3D, &H0
POKE PutOff + &H3E, &H0
POKE PutOff + &H3F, VARSEG(NewPut(0)) AND &HFF
POKE PutOff + &H40, (VARSEG(NewPut(0)) AND &HFF00&) \ &H100
Loaded = -1
END SUB
SUB SuperPutRemove STATIC
'===============================================================
' SuperPut (Remove) by Plasma
' Props to Rel for the original idea and RelSpriteFlip
'---------------------------------------------------------------
' Restores QB's original PUT routine. (Not needed unless you
' want to use a screen mode other than 13 and have already
' called SuperPut.)
'---------------------------------------------------------------
' * Compatible with: QBasic 1.x
' QuickBasic 4.x (IDE & compiled)
' QB PDS 7.1 (IDE & compiled)
' VBDOS 1.0 (IDE & compiled)
'
' Note: If you compile your program, it must be compiled as
' a stand-alone EXE!
'===============================================================
IF PutSeg& = 0 THEN 'First time? If so, we have to find B$GPUT.
' Find QB's B$GPUT routine by searching for some known opcodes
' (backwards from the default segment)
PutSeg& = VARSEG(DefSeg$) - &H400
DO WHILE PutSeg& > 0
DEF SEG = PutSeg&
FOR i = 0 TO &H3FF4
IF PEEK(i) = &HC4 AND PEEK(i + 1) = &H5E AND PEEK(i + 2) = &HA THEN
IF PEEK(i + 3) = &H8C AND PEEK(i + 4) = &HC1 AND PEEK(i + 5) = &H41 THEN
IF PEEK(i + 6) = &HE2 AND PEEK(i + 7) = &H5 AND PEEK(i + 8) = &H8B THEN
IF PEEK(i + 9) = &H5E AND PEEK(i + 10) = &H8 AND PEEK(i + 11) = &HC4 THEN
IF PEEK(i + 12) = &H1F THEN
PutOff = i 'Routine entry point is 16 bytes before
PutSeg& = PutSeg& - 1 'the anchor, so just decrease the segment
EXIT DO 'and we have the real entry point.
END IF
END IF
END IF
END IF
END IF
NEXT
PutSeg& = PutSeg& - &H3FF
LOOP
IF i = &H3FF5 THEN
SCREEN 0
WIDTH 80, 25
PRINT "SuperPut Error: Cannot find QB's B$GPUT routine."
PRINT "Check to make sure you are using a compatible version of QB"
PRINT "and have compiled your program as a stand-alone EXE."
END
END IF
END IF
DEF SEG = PutSeg&
IF PEEK(PutOff + &H1D) = &H26 THEN EXIT SUB 'SuperPut isn't loaded
' Restore the part of QB's original PUT routine that SuperPut overwrote
POKE PutOff + &H1D, &H26 'mov si,es:[bx]
POKE PutOff + &H1E, &H8B
POKE PutOff + &H1F, &H37
POKE PutOff + &H20, &H56 'push si
POKE PutOff + &H21, &H26 'mov di,es:[bx+2]
POKE PutOff + &H22, &H8B
POKE PutOff + &H23, &H7F
POKE PutOff + &H24, &H2
POKE PutOff + &H25, &H57 'push di
POKE PutOff + &H26, &H83 'add bx,4
POKE PutOff + &H27, &HC3
POKE PutOff + &H28, &H4
POKE PutOff + &H29, &H53 'push bx
POKE PutOff + &H2A, &HE8 'call B$PixSize
POKE PutOff + &H2B, PEEK(PutOff + &H50)
POKE PutOff + &H2C, PEEK(PutOff + &H51)
POKE PutOff + &H2D, &H93 'xchg bx,ax
POKE PutOff + &H2E, &H96 'xchg si,ax
POKE PutOff + &H2F, &H99 'cwd
POKE PutOff + &H30, &H32 'xor bh,bh
POKE PutOff + &H31, &HFF
POKE PutOff + &H32, &HE8 'call B$IDIVBX
POKE PutOff + &H33, PEEK(PutOff + &H52)
POKE PutOff + &H34, PEEK(PutOff + &H53)
POKE PutOff + &H35, &H48 'dec ax
POKE PutOff + &H36, &H8B 'mov dx,B$GXPOS
POKE PutOff + &H37, &H16
POKE PutOff + &H38, PEEK(PutOff + &H54)
POKE PutOff + &H39, PEEK(PutOff + &H55)
POKE PutOff + &H3A, &H3 'add ax,dx
POKE PutOff + &H3B, &HC2
POKE PutOff + &H3C, &H72 'jb PRNGER
POKE PutOff + &H3D, &H1B
POKE PutOff + &H3E, &H8B 'mov cx,ax
POKE PutOff + &H3F, &HC8
POKE PutOff + &H40, &H8B 'mov (partial)
POKE PutOff + &H50, &H75 'jnz PRNGNW
POKE PutOff + &H51, &H4
POKE PutOff + &H52, &H2B 'sub bx,di
POKE PutOff + &H53, &HDF
POKE PutOff + &H54, &HEB 'jmp SHORT PRNGER
POKE PutOff + &H55, &H3
END SUB