THAT was the trick! yay! no more out of date command reference issues! Thanks all!MrSwiss wrote:You might have to "unlock" the file first:
right click it,
choose properties,
look for: small check box (lower right corner)
uncheck
press apply button
Another, rather sensless "M$ security" issue ...
Continuing issue using pointers etc...
Re: Continuing issue using pointers etc...
Re: Continuing issue using pointers etc...
drats! this code ALMOST works.... think I am getting a handle on my error...
Code: Select all
sub BasicBlit(img as any ptr, dx as ulong, dy as ulong)
' BasicBlit is just a pset
dim as ulong sy = 0, sy_end = ImageHeight * ImagePitch, sdy = dy * SCR_pitch, numBytes = ImageWidth * 4
dim as any ptr drowy = SCR_address + dx * 4
dim as ulong ptr image_end
dim as ulong ptr srow, drow
srow = ImageAddress
drow = SCR_address + (dy * SCR_pitch) + (dx * 4)
image_end = ImageAddress + (ImageHeight * ImagePitch)
do
' srow = ImageAddress + sy
' drow = drowy + sdy
memcpy (drow, srow, numBytes) ' = ImageWidth pixels x 4 bytes each
' sy += ImagePitch
' sdy += SCR_pitch
srow = srow + ImagePitch
drow = drow + SCR_pitch
loop until srow > image_end
end sub
Re: Continuing issue using pointers etc...
Regarding the problems (in your routine):
- forget, that it's image-data completely!
- it's simply an ARRAY of ULong! (only Width and Height are of interest)
- use 2 loops (one for x = horizontal, one for y = vertical, stepping)
Re: Continuing issue using pointers etc...
if you are talking about the routine in the first post, it is working fine - probably could be optimized much better since I coded it with one thought, then added a different thought in the middle... but it is working and speed is not so much an issue with it.MrSwiss wrote:Regarding the problems (in your routine):Problem solved ... (most of your math. is obsolete, now)
- forget, that it's image-data completely!
- it's simply an ARRAY of ULong! (only Width and Height are of interest)
- use 2 loops (one for x = horizontal, one for y = vertical, stepping)
if you are talking about this routine, speed is of utmost importance within the loop:
Code: Select all
'-------------------------------------------------------------------------------
sub BasicBlit(img as any ptr, dx as ulong, dy as ulong)
' BasicBlit is just a pset
' dim shared as ulong SCR_pitch
' dim shared as any ptr SCR_address
' Dim As Any Ptr img
' screeninfo ,,,, SCR_pitch
' SCR_address = screenptr
' dim shared as ulong ImageWidth, ImageHeight, ImageBytesPerPixel, ImagePitch
' dim shared as any ptr ImageAddress
'
dim as ulong ptr image_end, img_row, scr_row
dim as ulong numBytes = ImageWidth * 4
img_row = ImageAddress
scr_row = SCR_address + (dy * SCR_pitch) + (dx * 4)
image_end = ImageAddress + ((ImageHeight-1) * ImagePitch)
do
memcpy (scr_row, img_row, numBytes) ' = ImageWidth pixels x 4 bytes each
img_row = img_row + ImagePitch
scr_row = scr_row + SCR_pitch
loop until img_row > image_end
end sub
Re: Continuing issue using pointers etc...
figured it out... stupid pointer arithmetic! Problem was when adding the 'pitch' to each of the pointers, FB was assuming that the pitch was the number or bytes * the ptr type.... so I just divided by for and used that for the pitch to add... very surprising that my routine is still about 10% slower than FB's PUT statement, even with no bounds checking!!! Can't figure out how FB is getting the speed. My routine is MUCH faster on tiny images though...makes no sense...
one thing I am unsure of now is my loop end test:
it seems to work... BUT, I could actually be going 4 times longer (or something)... can I compare pointers in this manner?
one thing I am unsure of now is my loop end test:
Code: Select all
loop until img_row > image_end
Code: Select all
'-------------------------------------------------------------------------------
sub BasicBlit(img as any ptr, dx as ulong, dy as ulong)
' BasicBlit is just a pset
'
dim as ulong ptr image_end, img_row, scr_row
dim as ulong numBytes = ImageWidth * 4
img_row = ImageAddress
scr_row = SCR_address + (dy * SCR_pitch) + (dx * 4)
image_end = ImageAddress + ((ImageHeight-1) * ImagePitch)
dim as ulong imgpitch4 = ImagePitch\4, scrpitch4 = SCR_pitch\4
do
memcpy (scr_row, img_row, numBytes)
img_row = img_row + imgpitch4
scr_row = scr_row + scrpitch4
loop until img_row > image_end
end sub
Last edited by leopardpm on Jun 12, 2017 15:02, edited 1 time in total.
Re: Continuing issue using pointers etc...
If I where you: get correct info (as much, as possible), instead of: assuming things ...
Just to get you properly started ...If you want to use CRT functions, like memcpy(), you must include the headers, like:
#include "crt/string.bi" ' <-- for memcpy (and the like)
Just to get you properly started ...
Code: Select all
Sub BasicBlit(ByVal img As Any Ptr, ByVal dx As ULong, ByVal dy As ULong)
' BasicBlit is just a pset
Dim As Integer w, h, bypp, pitch, size ' Integer is mandatory!
Dim As Any Ptr pdata ' check: bypp for pixel size
Dim As Long res
res = ImageInfo(img, w, h, bypp, pitch, pdata, size)
If res <> 0 Then
Print "ERROR: ImageInfo()!" : Sleep 1000, 1 : End
EndIf
' redo from here ...
'do
' memcpy (scr_row, img_row, numBytes) ' = ImageWidth pixels x 4 bytes each
' img_row = img_row + ImagePitch
' scr_row = scr_row + SCR_pitch
'loop until img_row > image_end
End Sub
#include "crt/string.bi" ' <-- for memcpy (and the like)
Re: Continuing issue using pointers etc...
yes, I already do this, forgot to post it with program exampleMrSwiss wrote:If you want to use CRT functions, like memcpy(), you must include the headers, like:
#include "crt/string.bi" ' <-- for memcpy (and the like)
Re: Continuing issue using pointers etc...
Yeah, it was from that thread of ours that I remembered the memcpy.... but, it is only good for 'pset', no transparency effects, just blit bytes straight to screen (or a buffer).
I am doing some tests, but I think a run-length blit where only the transparency is RLE, will be faster than or about as fast as FB PUT(pset), definitely faster than FB PUT(trans). I don't know about a full image RLE blit though because alot of sprite images have small run-lengths (1 or a few pixels only) so no savings compared to the overhead of RLE. RLE of just the transparency makes sense though because there tend to be lots of longer transparency runs....
Re: Continuing issue using pointers etc...
interesting! so with a transparency run the position marker is a key variable. atm my focus is on another project. i'll try to be helpful from time to time :-)
Re: Continuing issue using pointers etc...
exactly! and can then use the super-speedy memcpy to copy over the actual image pixels...dafhi wrote:interesting! so with a transparency run the position marker is a key variable. atm my focus is on another project. i'll try to be helpful from time to time :-)
I will be making a few versions:
SpeedBlit, Basic: (output same as PUT with 'Tran's) Only Fully Transparency RLE and is able to use memcpy, should be fastest method
SpeedBlit, RLE: (output same as PUT with 'Tran's) RLE entire image and decode while blitting, will be slower, but less memory used for the images
SpeedBlit, Z-Order: (no FB equivalent) RLE entire image and decode while blitting, but also allows sprite to have a 'layer' assigned to it as well as some other sprite-ish things...
Re: Continuing issue using pointers etc...
got my old vb6 blit working. i can hardly understand it
Code: Select all
/' -- run length blit (translated from vb) by dafhi '/
' ----- run length ----------
'
Public Type StartAndFin
as short start, lenm ''length - 1
End Type
Private Type tRLInfo
as long ySegs
as StartAndFin vRun(any)
as long SectDelt(any)
as StartAndFin hRun(any)
End Type
' ---------------
type imagevars '2017 June 8 - by dafhi
'1. quick reference for ScreenInfo & ImageInfo
'2. encapsulate standard metrics
'3. convenient additional vars, subs and functions
as integer w,h, bpp,bypp,pitch, rate
as string driver_name
as any ptr im
as any ptr pixels 'same address
as ulong ptr p32 '
as single midx,midy
as integer pitchBy, wm = -1, hm = -1, ub = -1, is_screen
declare sub screen_init(w as integer=0, h as integer=0, bpp as integer=32, npages as integer=1, flags as integer=0)
declare sub create(w as integer=0, h as integer=0, col as ulong=&HFF000000)
declare sub bmp_load( ByRef filename As String )
declare sub RLBlit(pDest As imagevars ptr, sX As Single=0, sY As Single=0)
declare sub fillinfo(im as any ptr=0)
declare sub RL_Encode(MaskColor As uLong = -1)
declare destructor
private:
as single sR(any), sG(any), sB(any), a(any)
as tRLInfo RLI
declare sub destroy
declare sub release
as any ptr hRelease
as imagevars ptr pdes ' aablit
as long yDes1D, ySrc1D '
as single sx, x_scal '
as single sy, y_scal '
declare sub GetClipRgn(byref pDest As long, byref pSrcMin As long, _
byref pSrcMax As long, pSrcM1 As long, _
pDestHigh As long, pVal As Single)
end type
Destructor.imagevars: release
End Destructor
sub imagevars.release '2016 Aug 30
w=0: h=0: bpp=0: bypp=0: im=0: pixels=0
If ImageInfo(hRelease) = 0 Then ImageDestroy hRelease: hRelease = 0
End Sub
sub imagevars.fillinfo(im as any ptr)
if im=0 then
ScreenInfo w,h, bpp, bypp, pitch, rate, driver_name: pixels=screenptr
is_screen = -1: im=0
elseif Imageinfo(im)=0 then
ImageInfo im, w, h, bypp, pitch, pixels: bpp = bypp * 8
this.im = im: is_screen = 0
endif: hRelease = im: p32=pixels
wm=w-1: midx=w/2: pitchBy=pitch\bypp
hm=h-1: midy=h/2: ub = h*pitchBy - 1
end sub
sub imagevars.screen_init(w as integer, h as integer, bpp as integer, npages as integer, flags as integer)
release: screenres w,h,bpp,npages,flags: pixels = screenptr
fillinfo: if npages > 1 then screenset 0,1
end sub
sub imagevars.create(_w as integer, _h as integer, col as ulong)
release: fillinfo imagecreate(_w,_h,col)
End Sub
sub imagevars.bmp_load( ByRef filename As String ) 'modified fb example
Dim As Long filenum = FreeFile(), bmpwidth, bmpheight
for i as integer = 1 to 2
If Open( filename For Binary Access Read As #filenum ) = 0 Then
Get #filenum, 19, bmpwidth
Get #filenum, 23, bmpheight
create bmpwidth, abs(bmpheight)
bload filename, im: close #filenum: exit for
endif
Close #filenum
filename = exepath & "\" & filename
next
End sub
Sub imagevars.RL_Encode(MaskColor As uLong)
Dim LX As long
Dim IsBlit As Boolean
Dim IsBlitP As Boolean
Dim ScBlit As Boolean
Dim ScBlitP As Boolean
Dim cRgn As Long
Dim vRgnPtr As Long
Dim cRgnP As Long
Dim vLen As Long
Dim ScanPtr As Long
redim RLI.hRun( (w+1)\2*h )
redim RLI.vRun( (h+1)\2 )
For DimMode as long = 0 To 1
For LY as long = 0 To HM
dim as long BlitLenM
For LX as long = 0 To WM
IsBlit = p32[LX+ LY*pitchBy] <> MaskColor
If IsBlit Xor IsBlitP Then
If IsBlit Then 'wasn't blit, now is
If DimMode = 1 Then
RLI.hRun(cRgn).Start = LX
End If
Else 'was blit, now not
If DimMode = 1 Then
RLI.hRun(cRgn).LenM = BlitLenM
End If
BlitLenM = 0
cRgn += 1
End If
ElseIf IsBlit Then
BlitLenM += 1
End If
IsBlitP = IsBlit
Next
IsBlitP = False
If IsBlit Then
If DimMode = 1 Then
RLI.hRun(cRgn).LenM = BlitLenM
End If
cRgn += 1
End If
ScBlit = (cRgn - cRgnP) > 0
If ScBlit Xor ScBlitP Then
If ScBlit Then 'wasn't, now is
vRgnPtr += 1
If DimMode = 1 Then
RLI.vRun(vRgnPtr).Start = LY
End If
vLen = 0
Else 'was, now isn't
If DimMode = 1 Then
RLI.vRun(vRgnPtr).LenM = vLen - 1
End If
End If
End If
If ScBlit Then
If DimMode = 1 Then
RLI.SectDelt(ScanPtr) = cRgn - 1 - cRgnP
End If
ScanPtr += 1
cRgnP = cRgn
End If
vLen += 1
ScBlitP = ScBlit
Next
If vRgnPtr > 0 Then
If DimMode = 0 Then
ReDim RLI.vRun(1 To vRgnPtr)
ReDim RLI.SectDelt(ScanPtr - 1)
RLI.ySegs = vRgnPtr
ElseIf ScBlit Then
RLI.vRun(vRgnPtr).LenM = vLen - 1
vLen = 0
End If
End If
If cRgn > 0 Then
If DimMode = 0 Then
ReDim RLI.hRun(0 To cRgn - 1)
End If
cRgn = 0
cRgnP = 0
End If
ScBlitP = False
IsBlit = False
vRgnPtr = 0
ScanPtr = 0
Next
End Sub
Sub imagevars.GetClipRgn(byref pDest As long, byref pSrcMin As long, byref pSrcMax As long, pSrcM1 As long, pDestHigh As long, pVal As Single)
pDest = Int(pVal + 0.5) 'round
pSrcMax = pSrcM1
If pDest + pSrcM1 > pDestHigh Then
pSrcMax = pSrcMax - (pDest + pSrcM1 - pDestHigh)
End If
pSrcMin = 0
If pDest < 0 Then
pSrcMin = pSrcMin - pDest
End If
End Sub
Sub imagevars.RLBlit(des As imagevars ptr, sx As Single, sy As Single)
dim as long LenRef
dim as long ySrcE, xSrcE2
dim as long SrcBotM1
dim as long DestLeft
dim as long DestBot
dim as long SrcMinY,SrcMinX
dim as long SrcMaxY,SrcMaxX
'GetClipRgn DestLeft, SrcMinX, SrcMaxX, WM, pSrc.LowX, des->LowX, des->LowX + des->WM, sx
GetClipRgn DestLeft, SrcMinX, SrcMaxX, WM, des->WM, sx
'GetClipRgn DestBot, SrcMinY, SrcMaxY, HM, pSrc.LowY, des->LowY, des->LowY + des->HM, sy
GetClipRgn DestBot, SrcMinY, SrcMaxY, HM, des->HM, sy
SrcBotM1 = SrcMinY - 1
dim as long ySrcS, hPtrS
For yPtr as long = 1 To RLI.ySegs
'vertical contiguous chunk of scanlines that have data
ySrcS = RLI.vRun(yPtr).Start
ySrcE = ySrcS + RLI.vRun(yPtr).LenM
For ySrcS = ySrcS To IIF(ySrcE > SrcMaxY, SrcMaxY, ySrcE) 'vertical run length
'with new scanline we have this recomputation
var hPtrE = hPtrS + RLI.SectDelt(LenRef)
If ySrcS > SrcBotM1 Then
var yDst = DestLeft + des->pitchBy*(ySrcS + DestBot)
var ySrc = ySrcS*pitchBy
For hPtrS = hPtrS To hPtrE
var xSrcS = RLI.hRun(hPtrS).Start
var xSrcE = xSrcS + RLI.hRun(hPtrS).LenM
If xSrcS < SrcMinX Then xSrcS = SrcMinX
If xSrcE > SrcMaxX Then xSrcE = SrcMaxX
For xSrcS = xSrcS To xSrcE
des->p32[xSrcS + yDst] = p32[xSrcS + ySrc]
Next
Next
End If
LenRef = LenRef + 1
hPtrS = hPtrE + 1
Next
If ySrcE > SrcMaxY Then Exit For
Next
End Sub
' -- sinewave generator
'
type sinevars
as single a=rnd*6.28, i = .003 * (.1 + rnd)
as single bas = 0.5, scale = .5
declare operator cast as single
end type
operator sinevars.cast as single
a += i: return bas + scale * sin(a)
end operator
Type SpritePos
cenx As sinevars
ceny As sinevars
End Type
#ifndef pi
const TwoPi = 8*atn(1)
const Pi = 4*atn(1)
const piBy2 = 2*atn(1)
const iPi = 1/Pi
#EndIf
sub Main
dim as imagevars buf, sprite
buf.screen_init 640,480
var MaskColor = rgb(0,0,0)
sprite.create 201,201, maskcolor
for i as long = 0 to sprite.wm step 10
line sprite.im,(i,0)-(i,sprite.hm),rgb(128,64,255)
line sprite.im,(0,i)-(sprite.wm,i),rgb(128,55,128)
next
for i as long = 1 to sprite.w*sprite.h / 10
pset sprite.im, (rnd*sprite.wm, rnd*sprite.hm), rgb(rnd*255,rnd*255,rnd*255)
next
'sprite.bmp_load ".bmp"
sprite.rl_encode MaskColor
var NUM_VECTORS = 40
dim as spritepos vec(1 to num_vectors)
For I as long = 1 To Num_Vectors
with vec(i)
.cenx.bas = rnd*buf.wm
.ceny.bas = rnd*buf.hm
.cenx.scale = buf.midx
.ceny.scale = buf.midy
end with
Next
do
screenlock
cls
For I as long = 1 To Num_Vectors
sprite.rlblit @buf, vec(i).cenx, vec(i).ceny
next
screenunlock
sleep 15
if inkey<>"" then exit do
loop
end sub
Main
Last edited by dafhi on Jun 13, 2017 6:56, edited 3 times in total.
Re: Continuing issue using pointers etc...
very interesting!dafhi wrote:got my old vb6 blit working. i can hardly understand it
Re: Continuing issue using pointers etc...
maskcolor needed to be Ulong. updated.
Re: Continuing issue using pointers etc...
what does the mask do?dafhi wrote:maskcolor needed to be Ulong. updated.