SuperPut in Screen 13
Superput is a great PUT replacement by Plasma.

No libraries, interrupts, or call absolute...source and example are here. Hope you PureQB(?) nuts find a use for it.
Code:

'===============================================================
' 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. And you
' thought SetVideoSeg was bad-ass...
'===============================================================

DEFINT A-Z

DECLARE SUB superPut ()
DECLARE SUB superPutRemove ()
DECLARE SUB SetVideoSeg (Segment)

' Example...

SCREEN 13 '(not really needed because superPut sets screen 13)
superPut 'Install the patch

' Simple 32x32 sprite for testing
DIM Sprite(513)
CIRCLE (15, 15), 14, 4
PAINT (15, 15), 4
CIRCLE (10, 10), 4, 12
PAINT (10, 10), 12
GET (0, 0)-(31, 31), Sprite(0)
CLS

' Slap a background up
FOR x = 0 TO 319
LINE (x, 0)-(x, 199), x MOD 255
NEXT

' Draw some sprites
PUT (25, 84), Sprite(0), PSET '(no flipping, no transparency)
PUT (85, 84), Sprite(0) '(default is XOR) (no flipping)
PUT (145, 84), Sprite(0), PRESET '(flipped horizontally)
PUT (205, 84), Sprite(0), OR '(flipped vertically)
PUT (265, 84), Sprite(0), AND '(flipped both ways)

k$ = INPUT$(1)
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


SuperPutInScreenThirteen - page last edited 2004-02-10 12:26:10 by 172.167.146.22 (home) (edit)
Blast WIKI - by RoboticBoy - edited and tweaked for our evil purposes by Hexadecimal Disaster