It's a bit puzzley, but the trick is to plot 8 pixels at a time. POKE will do so, you only have to do TONS of calculations with bitmasks... In QB this ends being really slow. I've done it with a custom sprite format (bitplanes separated in an array), but or I am the worst optimizer in the world or this is impossible to do fast. So your best pick is getting a SCREEN 12 library. I think there was one out there...
Anyhow, your 8 bits bitmap won't help. You better break it in bitplanes. The more your sprite looks like the "surface" you're gonna blit it (VGA hardware in this case), the faster your routine will be.
Code:
' Module with GFX functions and SUBs. Coded by Nathan
' Uses SCREEN 12!
DIM SHARED Pows2%(7)
DIM SHARED Div%(255, 7)
DIM SHARED Mul%(255, 7)
DIM SHARED FileHandle%
SUB GfxInit
Pows2%(0) = 1: Pows2%(1) = 2: Pows2%(2) = 4: Pows2%(3) = 8' Change
Pows2%(4) = 16: Pows2%(5) = 32: Pows2%(6) = 64: Pows2%(7) = 128
FOR i% = 0 TO 7
FOR j% = 0 TO 255
Div%(j%, i%) = (j% \ Pows2%(i%)) AND 255
Mul%(j%, i%) = (j% * Pows2%(i%)) AND 255
NEXT j%
NEXT i%
FileHandle% = FREEFILE
OPEN "DUMP.TXT" FOR OUTPUT AS FileHandle%
END SUB
SUB GfxShut
CLOSE FileHandle%
END SUB
SUB LoadBMP (x%, y%)
' This is slow as hell. It is only intended for internal purposes
' such as doing Sprite extraction from a BMP file.
END SUB
SUB PalLoad (File$, pal$)
pal$ = ""
o$ = CHR$(0)
f% = FREEFILE
OPEN File$ FOR BINARY AS #f%
FOR i% = 0 TO 15
FOR j% = 0 TO 2
GET #f%, , o$
pal$ = pal$ + o$
NEXT j%
NEXT i%
CLOSE #f%
END SUB
SUB ScrLoad (File$)
DEF SEG = &HA000
OUT &H3C4, 2: OUT &H3C5, 1: BLOAD File$ + ".BLU", 0 'bitplane 0
OUT &H3C4, 2: OUT &H3C5, 2: BLOAD File$ + ".GRN", 0 'bitplane 1
OUT &H3C4, 2: OUT &H3C5, 4: BLOAD File$ + ".RED", 0 'bitplane 2
OUT &H3C4, 2: OUT &H3C5, 8: BLOAD File$ + ".INT", 0 'bitplane 3
OUT &H3C4, 2: OUT &H3C5, 16
DEF SEG
END SUB
SUB ScrSave (File$)
DEF SEG = &HA000
OUT &H3CE, 4: OUT &H3CF, 0: BSAVE File$ + ".BLU", 0, 38400'bitplane 0 (blue)
OUT &H3CE, 4: OUT &H3CF, 1: BSAVE File$ + ".GRN", 0, 38400'bitplane 1 (green)
OUT &H3CE, 4: OUT &H3CF, 2: BSAVE File$ + ".RED", 0, 38400'bitplane 2 (red)
OUT &H3CE, 4: OUT &H3CF, 3: BSAVE File$ + ".INT", 0, 38400'bitplane 3 (intens.)
OUT &H3CE, 4: OUT &H3CF, 0
DEF SEG
f% = FREEFILE
OPEN File$ + ".PAL" FOR BINARY AS #f%
FOR j% = 0 TO 15
OUT &H3C7, j%
FOR i% = 0 TO 2
o$ = CHR$(INP(&H3C9))
PUT #f%, , o$
NEXT i%
NEXT j%
CLOSE #f%
END SUB
SUB SetDac (w%, r%, g%, b%)
OUT &H3C8, w%
OUT &H3C9, r%
OUT &H3C9, g%
OUT &H3C9, b%
END SUB
SUB SolidSpritePut (x%, y%, Sprite$(), Spx%, Spy%, idx%)
DEF SEG = &HA000: OUT &H3CE, 4: OUT &H3C4, 2
' To increase speed:
IF (x% AND 7) = 0 THEN
xorigin% = x% \ 8
FOR j% = 0 TO 3
OUT &H3CE, 4: OUT &H3CF, j%
OUT &H3C4, 2: OUT &H3C5, Pows2%(j%)
FOR yy% = 0 TO Spy% - 1
FOR xx% = 0 TO Spx% - 1
p& = xorigin% + xx% + 80& * (y% + yy%)
b% = ASC(MID$(Sprite$(idx%, j%), 1 + xx% + yy% * Spx%, 1))
POKE p&, b%
NEXT xx%
NEXT yy%
NEXT j%
ELSE
' Difficult part: I have to SHIFT, and QB doesn't have shifts :(
' So I'll have to DIVIDE AND MULTIPLY :( :( :(
xorigin% = x% \ 8
xOffset% = x% AND 7
FOR j% = 0 TO 3
OUT &H3CE, 4: OUT &H3CF, j%
OUT &H3C4, 2: OUT &H3C5, Pows2%(j%)
FOR yy% = 0 TO Spy% - 1
FOR xx% = -1 TO Spx% - 1
p& = 1 + xx% + xorigin% + 80& * (y% + yy%)
byte% = 0
IF xx% = -1 THEN
b% = PEEK(p&)
'byte% = b% AND (255 XOR Pows2%(8 - Offset%) - 1)
byte% = b% AND Mul%(Pows2%(Offset%) - 1, 8 - Offset%)
ELSEIF xx% = Spx% - 1 THEN
b% = PEEK(p&)
byte% = b% AND (Pows2%(8 - Offset%) - 1)
END IF
IF xx% > -1 THEN
byte% = byte% + Mul%((ASC(MID$(Sprite$(idx%, j%), 1 + xx% + yy% * Spx%, 1))), (8 - xOffset%))
END IF
IF xx% < Spx% - 1 THEN
byte% = byte% + Div%((ASC(MID$(Sprite$(idx%, j%), 2 + xx% + yy% * Spx%, 1))), (xOffset%))
END IF
POKE p&, byte%
NEXT xx%
NEXT yy%
NEXT j%
END IF
DEF SEG
' Reset:
OUT &H3CE, 4: OUT &H3CF, 0
OUT &H3C4, 2: OUT &H3C5, 15
END SUB
SUB SpriteGet (x%, y%, Sprite$(), Spx%, Spy%, idx%)
DEF SEG = &HA000': OUT &H3CE, 4: OUT &H3C4, 2
' To increase speed:
IF (x% AND 7) = 0 THEN
xorigin% = x% \ 8
FOR j% = 0 TO 3
OUT &H3CE, 4: OUT &H3CF, j%
FOR yy% = 0 TO Spy% - 1
FOR xx% = 0 TO Spx% - 1
p& = xorigin% + xx% + 80& * (y% + yy%)
b% = PEEK(p&)
MID$(Sprite$(idx%, j%), 1 + xx% + yy% * Spx%, 1) = CHR$(b% AND 255)
NEXT xx%
NEXT yy%
NEXT j%
ELSE
' Difficult part: I have to SHIFT, and QB doesn't have shifts :(
' So I'll have to DIVIDE AND MULTIPLY :( :( :(
xorigin% = x% \ 8
xOffset% = x% AND 7
FOR j% = 0 TO 3
OUT &H3CE, 4: OUT &H3CF, j%
FOR yy% = 0 TO Spy% - 1
FOR xx% = 0 TO Spx% - 1
p& = xx% + xorigin% + 80 * (y% + yy%)
b% = PEEK(p&)
b2% = PEEK(p& + 1)
'mybyte% = (Pows2%(xOffset%) * b%) AND 255
mybyte% = Mul%(b%, xOffset%)
'mybyte% = mybyte% + b2% \ Pows2%(8 - xOffset%)
mybyte% = mybyte% + Div%(b2%, 8 - xOffset%)
MID$(Sprite$(idx%, j%), 1 + xx% + yy% * Spx%, 1) = CHR$(mybyte% AND 255)
NEXT xx%
NEXT yy%
NEXT j%
END IF
DEF SEG
' Reset:
OUT &H3CE, 4: OUT &H3CF, 0
'OUT &H3C4, 2: OUT &H3C5, 15
END SUB
SUB SpriteGetMask (x%, y%, Sprite$(), Spx%, Spy%, idx%)
DEF SEG = &HA000: OUT &H3CE, 4: OUT &H3C4, 2
' To increase speed:
IF (x% AND 7) = 0 THEN
xorigin% = x% \ 8
FOR yy% = 0 TO Spy% - 1
FOR xx% = 0 TO Spx% - 1
p& = xorigin% + xx% + 80& * (y% + yy%)
j% = 1 ' BRIGHT MASK!
OUT &H3CE, 4: OUT &H3CF, j%
b% = PEEK(p&)
MID$(Sprite$(idx%, 4), 1 + xx% + yy% * Spx%, 1) = CHR$(b%)
NEXT xx%
NEXT yy%
ELSE
' Difficult part: I have to SHIFT, and QB doesn't have shifts :(
' So I'll have to DIVIDE AND MULTIPLY :( :( :(
xorigin% = x% \ 8
xOffset% = x% AND 7
FOR yy% = 0 TO Spy% - 1
FOR xx% = 0 TO Spx% - 1
p& = xx% + xorigin% + 80& * (y% + yy%)
j% = 1
OUT &H3CE, 4: OUT &H3CF, j%
b% = PEEK(p&)
b2% = PEEK(p& + 1)
mybyte% = (Pows2%(xOffset%) * b%) AND 255
mybyte% = mybyte% + b2% \ Pows2%(8 - xOffset%)
MID$(Sprite$(idx%, 4), 1 + xx% + yy% * Spx%, 1) = CHR$(mybyte%)
NEXT xx%
NEXT yy%
END IF
DEF SEG
' Reset:
OUT &H3CE, 4: OUT &H3CF, 0
OUT &H3C4, 2: OUT &H3C5, 15
END SUB
SUB SpriteInit (Sprite$(), Spx%, Spy%, idx%)
FOR i% = 0 TO 4
Sprite$(idx%, i%) = STRING$(Spx% * Spy%, 0)
NEXT i%
END SUB
SUB SpritePut (x%, y%, Sprite$(), Spx%, Spy%, idx%)
' I need to optimize this, but it works !! :-D
' Now I can begin working in an ASM version, but later... X-D
DEF SEG = &HA000: OUT &H3CE, 4: OUT &H3C4, 2
' To increase speed:
IF (x% AND 7) = 0 THEN
xorigin% = x% \ 8
FOR j% = 0 TO 3
OUT &H3CE, 4: OUT &H3CF, j%
OUT &H3C4, 2: OUT &H3C5, Pows2%(j%)
FOR yy% = 0 TO Spy% - 1
FOR xx% = 0 TO Spx% - 1
p& = xorigin% + xx% + 80& * (y% + yy%)
b% = PEEK(p&)
b% = b% AND ASC(MID$(Sprite$(idx%, 4), 1 + xx% + yy% * Spx%, 1))
b% = b% XOR ASC(MID$(Sprite$(idx%, j%), 1 + xx% + yy% * Spx%, 1))
POKE p&, b%
NEXT xx%
NEXT yy%
NEXT j%
ELSE
' Difficult part: I have to SHIFT, and QB doesn't have shifts :(
' So I'll have to DIVIDE AND MULTIPLY :( :( :(
xorigin% = x% \ 8
xOffset% = x% AND 7
FOR j% = 0 TO 3
OUT &H3CE, 4: OUT &H3CF, j%
OUT &H3C4, 2: OUT &H3C5, Pows2%(j%)
FOR yy% = 0 TO Spy% - 1
FOR xx% = -1 TO Spx% - 1
p& = 1 + xx% + xorigin% + 80& * (y% + yy%)
b% = PEEK(p&)
bytemask% = 0
IF xx% > -1 THEN
bytemask% = bytemask% + Mul%((ASC(MID$(Sprite$(idx%, 4), 1 + xx% + yy% * Spx%, 1))), (8 - xOffset%))
ELSE
bytemask% = bytemask% + Mul%(Pows2%(xOffset%) - 1, 8 - xOffset%)
END IF
IF xx% < Spx% - 1 THEN
bytemask% = bytemask% + Div%((ASC(MID$(Sprite$(idx%, 4), 2 + xx% + yy% * Spx%, 1))), (xOffset%))
ELSE
bytemask% = bytemask% + Pows2%(8 - xOffset%) - 1
END IF
b% = b% AND bytemask%
byte% = 0
IF xx% > -1 THEN
byte% = byte% + Mul%((ASC(MID$(Sprite$(idx%, j%), 1 + xx% + yy% * Spx%, 1))), (8 - xOffset%))
END IF
IF xx% < Spx% - 1 THEN
byte% = byte% + Div%((ASC(MID$(Sprite$(idx%, j%), 2 + xx% + yy% * Spx%, 1))), (xOffset%))
END IF
b% = b% XOR byte%
POKE p&, b%
NEXT xx%
NEXT yy%
NEXT j%
END IF
DEF SEG
' Reset:
OUT &H3CE, 4: OUT &H3CF, 0
OUT &H3C4, 2: OUT &H3C5, 15
END SUB
SUB VSync (t%)
FOR i% = 1 TO t%
WAIT &H3DA, 8
WAIT &H3DA, 8, 8
NEXT i%
END SUB
This is all the lib I wrote. But it is unusable. Shit. But maybe it gives you some ideas.