Continuing issue using pointers etc...

General FreeBASIC programming questions.
leopardpm
Posts: 1792
Joined: Feb 28, 2009 20:58

Re: Continuing issue using pointers etc...

Postby leopardpm » Jun 12, 2017 13:38

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 ...
THAT was the trick! yay! no more out of date command reference issues! Thanks all!
leopardpm
Posts: 1792
Joined: Feb 28, 2009 20:58

Re: Continuing issue using pointers etc...

Postby leopardpm » Jun 12, 2017 13:58

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
MrSwiss
Posts: 3222
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: Continuing issue using pointers etc...

Postby MrSwiss » Jun 12, 2017 14:05

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)
Problem solved ... (most of your math. is obsolete, now)
leopardpm
Posts: 1792
Joined: Feb 28, 2009 20:58

Re: Continuing issue using pointers etc...

Postby leopardpm » Jun 12, 2017 14:21

MrSwiss wrote: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)
Problem solved ... (most of your math. is obsolete, now)
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.


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
it 'almost works' but gives me a striped image, like it is skipping lines of either image data or screen locations... I am purposely staying away from any for...next loops because then the routine needs an additional addition in it (see first post)... any ideas?
leopardpm
Posts: 1792
Joined: Feb 28, 2009 20:58

Re: Continuing issue using pointers etc...

Postby leopardpm » Jun 12, 2017 14:52

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:

Code: Select all

 loop until img_row > image_end

it seems to work... BUT, I could actually be going 4 times longer (or something)... can I compare pointers in this manner?

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.
MrSwiss
Posts: 3222
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: Continuing issue using pointers etc...

Postby MrSwiss » Jun 12, 2017 15:01

If I where you: get correct info (as much, as possible), instead of: assuming things ...

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
If you want to use CRT functions, like memcpy(), you must include the headers, like:
#include "crt/string.bi" ' <-- for memcpy (and the like)
leopardpm
Posts: 1792
Joined: Feb 28, 2009 20:58

Re: Continuing issue using pointers etc...

Postby leopardpm » Jun 12, 2017 18:32

MrSwiss 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)
yes, I already do this, forgot to post it with program example
dafhi
Posts: 1245
Joined: Jun 04, 2005 9:51

Re: Continuing issue using pointers etc...

Postby dafhi » Jun 12, 2017 20:12

@leopardpm - remember this?

I also did a run length blit in vb6 .. still looking for it
leopardpm
Posts: 1792
Joined: Feb 28, 2009 20:58

Re: Continuing issue using pointers etc...

Postby leopardpm » Jun 12, 2017 21:53

dafhi wrote:@leopardpm - remember this?

I also did a run length blit in vb6 .. still looking for it
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....
dafhi
Posts: 1245
Joined: Jun 04, 2005 9:51

Re: Continuing issue using pointers etc...

Postby dafhi » Jun 12, 2017 23:27

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 :-)
leopardpm
Posts: 1792
Joined: Feb 28, 2009 20:58

Re: Continuing issue using pointers etc...

Postby leopardpm » Jun 13, 2017 0:08

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 :-)
exactly! and can then use the super-speedy memcpy to copy over the actual image pixels...

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...
dafhi
Posts: 1245
Joined: Jun 04, 2005 9:51

Re: Continuing issue using pointers etc...

Postby dafhi » Jun 13, 2017 4:17

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.
leopardpm
Posts: 1792
Joined: Feb 28, 2009 20:58

Re: Continuing issue using pointers etc...

Postby leopardpm » Jun 13, 2017 5:11

dafhi wrote:got my old vb6 blit working. i can hardly understand it
very interesting!
dafhi
Posts: 1245
Joined: Jun 04, 2005 9:51

Re: Continuing issue using pointers etc...

Postby dafhi » Jun 13, 2017 5:24

maskcolor needed to be Ulong. updated.
leopardpm
Posts: 1792
Joined: Feb 28, 2009 20:58

Re: Continuing issue using pointers etc...

Postby leopardpm » Jun 13, 2017 5:31

dafhi wrote:maskcolor needed to be Ulong. updated.
what does the mask do?

Return to “General”

Who is online

Users browsing this forum: No registered users and 1 guest