04-23-2004, 08:38 AM
[Edit: Updated to version 1.3...Version 1.2 of the code required you to remove SuperPut before your program ended (when running in the IDE), otherwise you'd have problems running it next time. Version 1.3 fixes this.]
Here's version 1.2 of SuperPut. It now supports a user-defined clipping area that is set by calling VIEW (x1, y1)-(x2, y2). Mega thanks to Rel for modifying RelSpriteFlip to support user-defined clipping.
This version is also faster and takes less memory than previous versions.
Here's version 1.2 of SuperPut. It now supports a user-defined clipping area that is set by calling VIEW (x1, y1)-(x2, y2). Mega thanks to Rel for modifying RelSpriteFlip to support user-defined clipping.
This version is also faster and takes less memory than previous versions.
Code:
'==========================================================================
' SuperPut 1.3 by Plasma (4/26/2004)
' Props to Rel for the original idea and the updated RelSpriteFlip
'--------------------------------------------------------------------------
' Replaces QB's graphics PUT with Rel's optimized routine that supports
' user-defined clipping, transparency, and flipping. Clipping range is set
' with QB's VIEW statement.
'==========================================================================
DEFINT A-Z
DECLARE FUNCTION SuperPut (Install)
DECLARE FUNCTION SetVideoSeg (Segment)
' Example...
SCREEN 13 ' (not really needed because SuperPut sets screen 13)
rc = SuperPut(1) ' Install SuperPut
IF rc >= 0 THEN ' Error checking
SCREEN 0
WIDTH 80, 25
SELECT CASE rc
CASE 0: PRINT "SuperPut error: Could not find b$SegC"
CASE 1: PRINT "SuperPut error: Could not find B$PUT"
CASE 2: PRINT "SuperPut error: Could not find B$VIEW"
END SELECT
k$ = INPUT$(1)
END
END IF
' 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
' Set a custom clipping range
VIEW (0, 31)-(319, 167)
' Draw some sprites
FOR y = 12 TO 156 STEP 48
PUT (25, y), Sprite(0), PSET ' (no flipping, no transparency)
PUT (85, y), Sprite(0) '(default is XOR) (no flipping)
PUT (145, y), Sprite(0), PRESET ' (flipped horizontally)
PUT (205, y), Sprite(0), OR ' (flipped vertically)
PUT (265, y), Sprite(0), AND ' (flipped both ways)
NEXT
k$ = INPUT$(1)
rc = SuperPut(0) ' Remove SuperPut
END
FUNCTION SetVideoSeg (Segment)
'==========================================================================
' SetVideoSeg 1.2 by Plasma (4/22/2004)
'--------------------------------------------------------------------------
' Changes QB's active video segment for SCREEN 13
'--------------------------------------------------------------------------
' Parameters: Segment = active video segment to use (&HA000 for the screen)
'
' Returns: 0 = Error (could not find b$SegC)
' anything else = Offset of b$SegC from the default segment
' (used by SuperPut)
'--------------------------------------------------------------------------
' * Works for all graphics functions (does not work with PRINT)
' * Compatible with SuperPut (any version)
' * Compatible with: QBasic 1.x
' QuickBasic 4.x (IDE & compiled)
' QB PDS 7.1 (IDE & compiled)
' VBDOS 1.0 (IDE & compiled)
'==========================================================================
STATIC VideoSegOff
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
SetVideoSeg = VideoSegOff
EXIT FUNCTION
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
' 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
SetVideoSeg = VideoSegOff
EXIT FUNCTION
END IF
END IF
NEXT
' Return an error (couldn't find b$SecC)
SetVideoSeg = 0
END FUNCTION
FUNCTION SuperPut (Install)
'==========================================================================
' SuperPut 1.3 by Plasma (4/26/2004)
' Props to Rel for the original idea and the updated RelSpriteFlip
'--------------------------------------------------------------------------
' Replaces QB's graphics PUT with Rel's optimized routine that supports
' user-defined clipping, transparency, and flipping. Clipping range is set
' with QB's VIEW statement.
'--------------------------------------------------------------------------
' 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.
'
' Sprites will also be clipped if they are partially out of the
' user-defined clipping region set with VIEW.
'
' 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
'
' New VIEW behavior: When SuperPut is installed, VIEW will set the user-
' defined clipping boundary. However, *only* this form
' of the statement is supported:
'
' VIEW (x1, y1)-(x2, y2)
'
' The maximum range is (0, 0)-(319, 199). If you do not
' specify a range, the clipping range will NOT be set
' to the entire screen. The SCREEN, COLOR, and BORDER
' options may be passed, but they will be ignored.
'
' When SuperPut is installed, VIEW will only change
' the clipping area for the PUT statement. If you need
' to change the clipping area for other graphics
' statements, use VIEW before installing SuperPut or
' after removing it.
'--------------------------------------------------------------------------
' Parameters: Install = Install SuperPut (non-zero) or
' Remove SuperPut (0)
'
' Returns: -1 = Success
' 0 = Error (could not find b$SegC)
' 1 = Error (could not find B$PUT)
' 2 = Error (could not find B$VIEW)
'--------------------------------------------------------------------------
' * Works with SCREEN 13 only
' * Requires SetVideoSeg 1.2
' * 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!
'==========================================================================
STATIC VideoSegOff
STATIC PutSeg&, PutOff, NewPut&()
STATIC ViewSeg&, ViewOff, NewView&()
IF Install <> 0 THEN ' Install SuperPut
' Easy way to get the default segment
DefSeg& = VARSEG(DefSeg$)
IF VideoSegOff = 0 THEN
' Get the location of b$SegC from SetVideoSeg
VideoSegOff = SetVideoSeg(&HA000)
IF VideoSegOff = 0 THEN
SuperPut = 0
EXIT FUNCTION
END IF
END IF
IF PutSeg& = 0 THEN
' 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
PutSeg& = 0
SuperPut = 1
EXIT FUNCTION
END IF
END IF
IF ViewSeg& = 0 THEN
' Find QB's B$VIEW routine by searching for some known opcodes
' (backwards from the default segment)
ViewSeg& = DefSeg& - &H400
DO WHILE ViewSeg& > 0
DEF SEG = ViewSeg&
FOR i = 6 TO &H3FF2
IF PEEK(i) = &H8B AND PEEK(i + 1) = &H5E AND PEEK(i + 2) = &H12 THEN
IF PEEK(i + 3) = &H8B AND PEEK(i + 4) = &H56 AND PEEK(i + 5) = &H10 THEN
IF PEEK(i + 9) = &H8B AND PEEK(i + 10) = &H5E AND PEEK(i + 11) = &HE THEN
IF PEEK(i + 12) = &H8B AND PEEK(i + 13) = &H56 AND PEEK(i + 14) = &HC THEN
ViewOff = i - 6 ' Routine entry point is 6 bytes before anchor
IF PEEK(ViewOff + 24) = &HB3 THEN ViewOff = ViewOff - 5 ' Fix for PDS/VBDOS
EXIT DO
END IF
END IF
END IF
END IF
NEXT
ViewSeg& = ViewSeg& - &H3FF
LOOP
IF i = &H3FF3 THEN
ViewSeg& = 0
SuperPut = 2
EXIT FUNCTION
END IF
END IF
' New modified version of RelSpriteFlip that supports custom clipping
REDIM NewPut&(165)
NewPut&(0) = &H4689661E: NewPut&(1) = &H8CF38B08: NewPut&(2) = &HBBDB8EC3
NewPut&(3) = &HC38E0000: NewPut&(4) = &H001E8B26: NewPut&(5) = &H8BC38E00
NewPut&(6) = &H03EBC11C: NewPut&(7) = &H7D1E892E: NewPut&(8) = &H1E892E02
NewPut&(9) = &H548B0283: NewPut&(10) = &H16892E02: NewPut&(11) = &H892E027F
NewPut&(12) = &H2E028516: NewPut&(13) = &H027B06C7: NewPut&(14) = &HC72E0000
NewPut&(15) = &H00028106: NewPut&(16) = &H06C72E00: NewPut&(17) = &H00000287
NewPut&(18) = &H8906C72E: NewPut&(19) = &H2E000002: NewPut&(20) = &H028D06C7
NewPut&(21) = &HC72E0000: NewPut&(22) = &H00028B06: NewPut&(23) = &H04C68300
NewPut&(24) = &H2E08468B: NewPut&(25) = &H0295063B: NewPut&(26) = &H00958F0F
NewPut&(27) = &H91063B2E: NewPut&(28) = &HBA8C0F02: NewPut&(29) = &H0A4E8B00
NewPut&(30) = &H930E3B2E: NewPut&(31) = &H808F0F02: NewPut&(32) = &H0E3B2E00
NewPut&(33) = &H8C0F028F: NewPut&(34) = &HD80300C1: NewPut&(35) = &H951E3B2E
NewPut&(36) = &HD68F0F02: NewPut&(37) = &H03D82B00: NewPut&(38) = &H163B2ED1
NewPut&(39) = &H8F0F0293: NewPut&(40) = &HD12B00E4: NewPut&(41) = &H7D1E892E
NewPut&(42) = &HBBE98602: NewPut&(43) = &HF98B0140: NewPut&(44) = &H7D1E2B2E
NewPut&(45) = &H02EFC102: NewPut&(46) = &H892EF903: NewPut&(47) = &H0302811E
NewPut&(48) = &H067E83F8: NewPut&(49) = &HDC840F02: NewPut&(50) = &H067E8300
NewPut&(51) = &H04840F00: NewPut&(52) = &H067E8301: NewPut&(53) = &H4B840F01
NewPut&(54) = &H067E8301: NewPut&(55) = &H2E2A7403: NewPut&(56) = &H027D1E8B
NewPut&(57) = &H048ACB8B: NewPut&(58) = &H74C00A46: NewPut&(59) = &H05882603
NewPut&(60) = &HF2754947: NewPut&(61) = &H813E032E: NewPut&(62) = &H36032E02
NewPut&(63) = &H754A027B: NewPut&(64) = &H5F071FE3: NewPut&(65) = &H08CA5D5E
NewPut&(66) = &H8B2EFC00: NewPut&(67) = &H8B027D1E: NewPut&(68) = &H02E8C1C3
NewPut&(69) = &H8B03E383: NewPut&(70) = &HA566F3C8: NewPut&(71) = &HA4F3CB8B
NewPut&(72) = &H813E032E: NewPut&(73) = &H36032E02: NewPut&(74) = &H754A027B
NewPut&(75) = &HF7D2EBEA: NewPut&(76) = &H06032ED8: NewPut&(77) = &HD82B0291
NewPut&(78) = &HF003C77E: NewPut&(79) = &H027BA32E: NewPut&(80) = &H028BA32E
NewPut&(81) = &H0291A12E: NewPut&(82) = &HF7FF2AE9: NewPut&(83) = &H0E032ED9
NewPut&(84) = &HD12B028F: NewPut&(85) = &H892EAB7E: NewPut&(86) = &H2E02870E
NewPut&(87) = &H027D3603: NewPut&(88) = &H2EF87549: NewPut&(89) = &H028F0E8B
NewPut&(90) = &H2EFF1FE9: NewPut&(91) = &H02951E2B: NewPut&(92) = &H1E012E4B
NewPut&(93) = &H892E027B: NewPut&(94) = &H2E02891E: NewPut&(95) = &H02951E8B
NewPut&(96) = &HE9D82B43: NewPut&(97) = &HCA03FF11: NewPut&(98) = &H930E2B2E
NewPut&(99) = &HD12B4902: NewPut&(100) = &H850E8B2E: NewPut&(101) = &H0E892E02
NewPut&(102) = &H292E028D: NewPut&(103) = &H8B028D16: NewPut&(104) = &HFFE90A4E
NewPut&(105) = &H36032EFE: NewPut&(106) = &H8B2E0289: NewPut&(107) = &H8B027D0E
NewPut&(108) = &H2B2E4BD9: NewPut&(109) = &H8A028B1E: NewPut&(110) = &H74C00A00
NewPut&(111) = &H05882603: NewPut&(112) = &H75494B47: NewPut&(113) = &H3E032EF2
NewPut&(114) = &H032E0281: NewPut&(115) = &H4A028336: NewPut&(116) = &H2CE9D875
NewPut&(117) = &H0140B9FF: NewPut&(118) = &H0F4BDA8B: NewPut&(119) = &HF903CBAF
NewPut&(120) = &H830E8B2E: NewPut&(121) = &H1E8B2E02: NewPut&(122) = &HAF0F0287
NewPut&(123) = &H2EF12BCB: NewPut&(124) = &H2E0283A1: NewPut&(125) = &H028D1E8B
NewPut&(126) = &H03C3AF0F: NewPut&(127) = &H0E8B2EF0: NewPut&(128) = &H048A027D
NewPut&(129) = &H74C00A46: NewPut&(130) = &H05882603: NewPut&(131) = &HF2754947
NewPut&(132) = &H7D3E2B2E: NewPut&(133) = &H40EF8102: NewPut&(134) = &H36032E01
NewPut&(135) = &H754A027B: NewPut&(136) = &HFEDDE9DC: NewPut&(137) = &H830E8B2E
NewPut&(138) = &H0FDA8B02: NewPut&(139) = &HF103CBAF: NewPut&(140) = &H0E8B2E4E
NewPut&(141) = &H8B2E0283: NewPut&(142) = &H0F02871E: NewPut&(143) = &HF12BCBAF
NewPut&(144) = &H0283A12E: NewPut&(145) = &H8D1E8B2E: NewPut&(146) = &HC3AF0F02
NewPut&(147) = &H2B2EF003: NewPut&(148) = &H2E028B36: NewPut&(149) = &H027D0E8B
NewPut&(150) = &H8B362B2E: NewPut&(151) = &H4E048A02: NewPut&(152) = &H0374C00A
NewPut&(153) = &H47058826: NewPut&(154) = &H2EF27549: NewPut&(155) = &H02813E03
NewPut&(156) = &H89362B2E: NewPut&(157) = &HDB754A02: NewPut&(158) = &H00FE86E9
NewPut&(164) = &HC7000000: NewPut&(165) = &H00013F00
DEF SEG = VARSEG(NewPut&(0))
POKE &H0C, DefSeg& AND &HFF
POKE &H0D, (DefSeg& AND &HFF00&) \ &H100
POKE &H13, VideoSegOff AND &HFF
POKE &H14, (VideoSegOff AND &HFF00&) \ &H100
' Patch B$GPUT
DEF SEG = PutSeg&
POKE PutOff + &H1D, &H66 'mov eax,B$GXPOS and B$YPOS
POKE PutOff + &H1E, &H8B
POKE PutOff + &H1F, &H06
POKE PutOff + &H20, PEEK(PutOff + &H38)
POKE PutOff + &H21, PEEK(PutOff + &H39)
POKE PutOff + &H22, &HEA 'jmp VARSEG(NewPut&(0)):0000
POKE PutOff + &H23, 0
POKE PutOff + &H24, 0
POKE PutOff + &H25, VARSEG(NewPut&(0)) AND &HFF
POKE PutOff + &H26, (VARSEG(NewPut&(0)) AND &HFF00&) \ &H100
' New VIEW routine
REDIM NewView&(8)
NewView&(0) = &H06EC8B55: NewView&(1) = &H8E0000BB: NewView&(2) = &H0000BBC3
NewView&(3) = &H10468B66: NewView&(4) = &H07896626: NewView&(5) = &H0C468B66
NewView&(6) = &H47896626: NewView&(7) = &HCA5D0704: NewView&(8) = &H0000000E
DEF SEG = VARSEG(NewView&(0))
POKE &H05, VARSEG(NewPut&(0)) AND &HFF
POKE &H06, (VARSEG(NewPut&(0)) AND &HFF00&) \ &H100
POKE &H0A, &H8F
POKE &H0B, &H02
' Patch B$VIEW
DEF SEG = ViewSeg&
POKE ViewOff + &H00, &HEA 'jmp VARSEG(NewView&(0)):0000
POKE ViewOff + &H01, 0
POKE ViewOff + &H02, 0
POKE ViewOff + &H03, VARSEG(NewView&(0)) AND &HFF
POKE ViewOff + &H04, (VARSEG(NewView&(0)) AND &HFF00&) \ &H100
' Success
SuperPut = -1
EXIT FUNCTION
' PUT and VIEW must be used at least once
' so the compiler will include them.
' (This code never actually executes)
DIM Nothing(0)
PUT (0, 0), Nothing(0)
VIEW
ELSE ' Remove SuperPut
IF ViewSeg& = 0 THEN
' SuperPut was not installed during this program, but it might have
' been previously and not removed...so reinstall it to get the
' routine addresses and then remove it.
rc = SuperPut(1)
IF rc >= 0 THEN ' Error reinstalling
SuperPut = rc
EXIT FUNCTION
END IF
END IF
' Restore old B$PUT routine
DEF SEG = PutSeg&
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+02]
POKE PutOff + &H22, &H8B
POKE PutOff + &H23, &H7F
POKE PutOff + &H24, &H02
POKE PutOff + &H25, &H57 'push di
POKE PutOff + &H26, &H83 'add (partial)
' Restore old B$VIEW routine
DEF SEG = ViewSeg&
POKE ViewOff + &H00, &H55 'push bp
POKE ViewOff + &H01, &H8B 'mov bp,sp
POKE ViewOff + &H02, &HEC
POKE ViewOff + &H03, &H90 'nop
POKE ViewOff + &H04, &H85 'test ax,ax
POKE ViewOff + &H05, &HC0
' Success
SuperPut = -1
END IF
END FUNCTION
![[Image: anya2.jpg]](http://rel.betterwebber.com/Mypics/anya2.jpg)
