Image Buffer Flipping

[fxm]

@fxm,

INT doesn't replace CINT inside CPTR when doing pointer arithmetic, Is it right?

Code: Select all

cptr(any ptr, x + int(y/z))

doesn't work, whereas same with CINT, yes.

A Double (or Single) cannot be converted to a pointer.

In your example, as 'y/z' is A Double, 'Int(y/z)' is also a Double, while 'Cint(y/z)' is an Integer.
Note: simpler, 'y\z' is an Integer.
Remark: the error message 'error 28: Expected pointer' is not clear.

[leopardpm]

dodicat.... here it is testing with my adjustment... 1/3 of the time on average (3 times faster)

comment/uncomment in your reverse routine to test other way

Code: Select all

 
Function reverse(Byref im As Any Ptr) As Any Ptr
    #define ppset(_x,_y,colour)    *Cptr(Ulong Ptr,row+ (_y)*pitch+ (_x) Shl 2)  =(colour)
    #define ppoint(_x,_y)          *Cptr(Ulong Ptr,row + (_y)*pitch + (_x) Shl 2)
    Dim As Integer pitch
    Dim As Any Ptr row
    Dim As Ulong Ptr pixel
    Dim As Integer dx,dy
    Imageinfo im,dx,dy,,pitch,row
'    Static As Ulong a(dx-1,dy-1)
'    For y As Integer=0 To dy-1
'        For x As Integer=0 To dx-1
'            a(x,y)=ppoint(x,y)
'        Next x
'    Next y
'    For y As Integer=0 To dy-1
'        For x As Integer=0 To dx-1
'            ppset((dx-1)-x,y,a(x,y))
'        Next x
'    Next y
    
'    ' leopard's way...
    dx -= 1 : dy -= 1 'so is not done in the loops....
    dim as ulong tempclr
    For y As Integer=0 To dy
        For x As Integer=0 To int(dx)\2
            tempclr = ppoint(x,y)
            ppset (x,y,ppoint((dx)-x,y))
            ppset((dx)-x,y,tempclr)
        Next x
    Next y    
    
    
    Return im
End Function

'===================================

Screen 20,32
Dim As Any Ptr im=Imagecreate (1000,750,rgb(200,200,200))
Windowtitle("Press space key to flip the baloons")
'=========draw to image======
For z As Integer=0 To 20
    Line im,(50+40*z,  200+90*Sin(z))-(200,400),Rgb(0,0,0)
    Circle im,(50+40*z,200+90*Sin(z)),20+z,Rgb(z*10,200,255-10*z),,,,f
    Circle im,(50+40*z,200+90*Sin(z)),20+z,Rgb(z*10,0,255-10*z)
Next z
for x as long=0 to 999
    for y as long=400 to 749
        pset im,(x,y),rgb(x,x xor y,y)
    next
    next
Draw String im,(100,100),"HELLO",Rgb(0,0,0)
Line im,(0,0)-(999,749),0,b
'============================
Color ,Rgb(100,100,255)
dim as double t1,t2
Do
    
    Screenlock
    Cls
   
    t1=timer
    for t as integer = 1 to 99
    Put(10,10),reverse(im),pset
    next t
    t2=timer
   
    draw string (30,30),"Flipping time  " &(t2-t1),0
    Screenunlock
    Sleep
    Sleep 1,1
Loop Until Inkey=Chr(27)
Sleep
 

PS: I always like your macros!

[dodicat]

Nicely done leopardpm, very fast.

[leopardpm]

Nicely done leopardpm, very fast.

you did the hard work, sir!

[D.J.Peters]

Why not using GET and PUT for flipping and mirror ?

It's fast works with all Video modes and the drawing modes like PSET, ALPHA, CUSTOM are for free.

Joshy

[leopardpm]

Why not using GET and PUT for flipping and mirror ?

It's fast works with all Video modes and the drawing modes like PSET, ALPHA, CUSTOM are for free.

Joshy

um... how? I looked at the manual and didn't see how to do that...

EDIT: just saw your post on Tips and tricks... interesting.... gotta be much slower, But, as you said, all drawing & video modes are free...

[D.J.Peters]

"gotta be much slower" How many FPS do you get ?

Joshy

Code: Select all

' mirror an image or the screen (img=0)
' horizontal or vertical of course you can combine different calls
' e.g. step 1 vertical step 2 horizontal, step 3 vertical ...

' I'm using only GET and PUT so you can use XOR,PSET,ALPHA ...
sub Mirror(byval img as any ptr=0, byval iHorizontal as integer=1)
  static as integer oWidth=0,oHeight=0,oHorizontal=0
  static as any ptr imgA=0,imgB=0
  dim as integer iWidth=any,iHeight=any
  dim as integer xSize=any,ySize=any,xStart=any,yStart,xStep=any,yStep=any
  dim as integer x1=any,x2=any,y1=any,y2=any,iStart=any,iEnd=any 
  if img=0 then ' screen
    if ScreenPtr()=0 then exit sub
    ScreenInfo(iWidth,iHeight)
  else ' image  
    if ImageInfo(img,iWidth,iHeight) then exit sub
  end if
  if iHorizontal then iHorizontal=1
  ' realloc images only if the resolution or the mirror axis are changed !
  if iWidth<>oWidth or iHeight<>oHeight or oHorizontal<>iHorizontal then
    oWidth = iWidth : oHeight = iHeight : oHorizontal = iHorizontal
    if iHorizontal then
      xSize=iWidth : ySize=1
    else
      xSize=1: ySize=iHeight
    end if
    if ImgA then ImageDestroy ImgA:ImgA=0
    if ImgB then ImageDestroy ImgB:ImgB=0
    imgA=imageCreate(xSize,ySize)
    imgB=imageCreate(xSize,ySize)
  end if  
  ' now the magic :lol:
  xSize-=1 : ySize-=1
  if iHorizontal then
    x1=0:x2=0:y1=0:y2=iHeight-1 : xStep=0: yStep=1 : iStart=0:iEnd=iHeight-1
  else
    x1=0:x2=iWidth-1:y1=0:y2=0 : xStep=1: yStep=0 : iStart=0:iEnd=iWidth-1
  end if
  while iStart<=iEnd
    Get img,(x1,y1)-step(xSize,ySize), imgA
    Get img,(x2,y2)-step(xSize,ySize), imgB
    Put img,(x1,y1),imgB,pset
    Put img,(x2,y2),imgA,pset
    x1+=xStep : x2-=xStep 
    y1+=yStep : y2-=yStep
    iStart+=1 : iEnd-=1
  wend  

end sub  

screenres 640,480,8,2
'screenres 640,480,16,2
'screenres 640,480,32,2
screenset 1,0

dim as integer w,h
screeninfo w,h
w-=1 : h-=1
for i as integer= 1 to 10
  if (i and 1=1) then
    circle (rnd*w,rnd*h),1+h*0.24,culng(2^31*rnd()),,,,F
  else
    circle (rnd*w,rnd*h),1+h*0.24,culng(2^31*rnd())
  end if
  if (i and 1=1) then
    line (rnd*w,rnd*h)-(rnd*w,rnd*h),culng(2^31*rnd()),BF
  else
    line (rnd*w,rnd*h)-(rnd*w,rnd*h),culng(2^31*rnd())
  end if
next  


draw string (8     ,8   ), "Top Left"    ,culng(2^31*rnd())
draw string (w-10*8,8   ), "Top Right"   ,culng(2^31*rnd())
draw string (w-13*8,h-16), "Bottom Right",culng(2^31*rnd())
draw string (8     ,h-16), "Bottom Left" ,culng(2^31*rnd())

dim as integer fps,frame
var tStart=Timer()
while inkey()=""
  Mirror()       : flip
  Mirror(,false) : flip 
  Mirror()       : flip
  Mirror(,false) : flip 
  frame+=4
  if frame mod 300=0 then
    var tNow=Timer()
    fps = 300/(tNow-tStart) : tStart=tNow
    windowtitle "fps: " & fps
  end if
  ' sleep 10
wend  

    

[leopardpm]

FPS: 590-760

but I can't get your routine to work on a non-screen image buffer so I can compare to :

Code: Select all

 
Function reverse(Byref im As Any Ptr) As Any Ptr
    #define ppset(_x,_y,colour)    *Cptr(Ulong Ptr,row+ (_y)*pitch+ (_x) Shl 2)  =(colour)
    #define ppoint(_x,_y)          *Cptr(Ulong Ptr,row + (_y)*pitch + (_x) Shl 2)
    Dim As Integer pitch
    Dim As Any Ptr row
    Dim As Ulong Ptr pixel
    Dim As Integer dx,dy, ddx
    Imageinfo im,dx,dy,,pitch,row
'    ' leopard's way...
    dx -= 1 : dy -= 1'so is not done in the loops....
    dim as ulong tempclr
    For y As Integer=0 To dy
        For x As Integer=0 To int(dx)\2
            tempclr = ppoint(x,y)
            ppset(x,y,ppoint(dx-x,y))
            ppset(dx-x,y,tempclr)
        Next x
    Next y    
    
    
    Return im
End Function

'===================================

Screen 20,32
Dim As Any Ptr im=Imagecreate (1000,750,rgb(200,200,200))
Windowtitle("Press space key to flip the baloons")
'=========draw to image======
For z As Integer=0 To 20
    Line im,(50+40*z,  200+90*Sin(z))-(200,400),Rgb(0,0,0)
    Circle im,(50+40*z,200+90*Sin(z)),20+z,Rgb(z*10,200,255-10*z),,,,f
    Circle im,(50+40*z,200+90*Sin(z)),20+z,Rgb(z*10,0,255-10*z)
Next z
for x as long=0 to 999
    for y as long=400 to 749
        pset im,(x,y),rgb(x,x xor y,y)
    next
    next
Draw String im,(100,100),"HELLO",Rgb(0,0,0)
Line im,(0,0)-(999,749),0,b
'============================
Color ,Rgb(100,100,255)
dim as double t1,t2
Do
    
    Screenlock
    Cls
   
    t1=timer
    for t as integer = 1 to 99
    Put(10,10),reverse(im),pset
    next t
    t2=timer
   
    draw string (30,30),"Flipping time  " &(t2-t1),0
    Screenunlock
    Sleep
    Sleep 1,1
Loop Until Inkey=Chr(27)
Sleep