Rotozoom function...

Dr_D · Post by **Dr_D** » Feb 08, 2009 8:12

You're right. That is a bug with the pitch when drawing to an image buffer. As for the axis skewing, that was actually intentional. Thanks for reporting that bug. ;)

recycled · Post by **recycled** » Feb 08, 2009 8:12

Your new routine draws skewed image when it draws into another buffer.
To reproduce this skew bug, just change the size of buffer in line 30
try +1, +2 ,+3 ,+4 and so on. it seems +4,+8,+12... draws the image correctly.

Code: Select all

background = imagecreate(SCR_W + 1 , SCR_H)

I think rotozoom rotates image like the MODE-7 floormap in SNES Mario Kart.

Here is same demo with MULTIPUT, side by side.
I think rotating axis is not same as multiput.

press down arrow key to make skull look fat.
then rotate around and you will see what I mean.

Code: Select all

#include "fbgfx.bi"
 
const as double pi = 3.1415926, pi_180 = pi / 180
const as integer SCR_W = 640'\2
const as integer SCR_H = 480'\2
const as integer SCR_W2 = SCR_W\2
const as integer SCR_H2 = SCR_H\2
 
declare sub rotozoom( byref dst as FB.IMAGE ptr = 0, byref src as const FB.IMAGE ptr, byval positx as integer, byval posity as integer, byref angle as integer, byref zoomx as single, byref zoomy as single, byval transcol as uinteger )
DECLARE Sub MultiPut(Byval lpTarget As Any Ptr= 0, _
             Byval xMidPos  As Integer= 0, _
             BYVAL yMidPos  As Integer= 0, _
             Byval lpSource As Any Ptr   , _
             Byval xScale   AS Single = 1, _
             BYVAL yScale   As Single = 1, _
             Byval Rotate   AS Single = 0, _
             Byval Trans    As Integer= 0, _
             Byval Custom As Function(Byval Src As Uinteger, Byval Dest As Uinteger, Byval Param As Any Ptr = 0) As Uinteger = 0, _
             Byval Param As Any Ptr = 0)

screenres SCR_W,SCR_H,32,,FB.GFX_HIGH_PRIORITY
 
dim as string filename
dim as integer iw, ih, fpscount, vsync
dim as fb.image ptr image, background
dim as string mString, fpsString
dim as double this_time, last_loop, last_toggle, fpsTime
dim as integer angle
dim as single zoomx = 1, zoomy = 1
 
filename = "skull32.bmp"
open filename for binary as #1
get #1,19,iw
get #1,23,ih
close #1
 
image = imagecreate(iw, ih)
bload filename, image
 
background = imagecreate(SCR_W, SCR_H)
 
 
do
    last_loop = timer-this_time
    this_time = timer
 
    fpsCount+=1
    if this_time>fpsTime then
        fpsTime = this_time+1
        fpsString = "FPS: " & fpsCount
        fpsCount = 0
    end if
 
 
    if multikey(FB.SC_UP) then
        zoomx *=.995
        if zoomx<.01 then zoomx = .01
    end if
 
    if multikey(FB.SC_DOWN) then
        zoomx *=1.005
        if zoomx>200 then zoomx = 200
    end if
 
    if multikey(FB.SC_PAGEUP) then
        zoomy *=.995
        if zoomy<.01 then zoomy = .01
    end if
 
    if multikey(FB.SC_PAGEDOWN) then
        zoomy *=1.005
        if zoomy>200 then zoomy = 200
    end if
 
    if multikey(FB.SC_LEFT) then
        angle -=1'last_loop*300
        if angle<0 then angle = 360
    end if
 
    if multikey(FB.SC_RIGHT) then
        angle +=1'last_loop*300
        if angle>360 then angle = 0
    end if
 
    if multikey(FB.SC_V) then
        vsync = not vsync
        sleep 200,1
    end if
 
    screenlock
    line(0,0)-(SCR_W,SCR_H), 0, bf
    
    'render to screen
    rotozoom( 0, image, SCR_W2-100, SCR_H2, angle, zoomx, zoomy, 0)
    DRAW STRING (SCR_W2 - 100, SCR_H2), "rotozoom"
    
    MULTIPUT( 0, SCR_W2 + 100, SCR_H2, image, zoomx, zoomy, -angle, 0)
    DRAW STRING (SCR_W2+100, SCR_H2), "multiput"
    


    'render to buffer
    'line background,(0,0)-(background->width-1,background->height-1), rgb(0,0,255),bf
    'rotozoom( background, image, SCR_W2, SCR_H2, angle, zoomx, zoomy, rgb(255,0,255) )
    'put(0,0), background, pset
 
    locate 1,1
    print fpsString
    print "left/right arrows to rotate = " & angle
    print "up/down arrows to zoom x = " & zoomx
    print "page up/down to zoom y = " & zoomy
    print "V to toggle vsync = " & vsync
    if vsync then
        screensync
    end if
    screenunlock
    sleep 1,1
 
loop until multikey(FB.SC_ESCAPE)
 
 
 
sub rotozoom( byref dst as FB.IMAGE ptr = 0, byref src as const FB.IMAGE ptr, byval positx as integer, byval posity as integer, byref angle as integer, byref zoomx as single, byref zoomy as single, byval transcol as uinteger )
 
    'Rotozoom for 32-bit FB.Image by Dr_D(Dave Stanley) and yetifoot(Simon Nash)
    'No warranty implied... use at your own risk ;) 
 
    static as integer mx, my, col, nx, ny
    static as single nxtc, nxts, nytc, nyts
    static as single tcdzx, tcdzy, tsdzx, tsdzy
    static as integer sw2, sh2, dw, dh
    static as single tc, ts, _mx, _my
    static as uinteger ptr dstptr, srcptr, odstptr
    static as integer xput, yput, startx, endx, starty, endy
    static as integer x(3), y(3), xa, xb, ya, yb, lx, ly
    static as ubyte ptr srcbyteptr, dstbyteptr
    static as integer dstpitch, srcpitch, srcbpp, dstbpp, srcwidth, srcheight
 
    if zoomx <= 0 or zoomy <= 0 then exit sub
 
    if dst = 0 then
        dstptr = screenptr
        odstptr = dstptr
        screeninfo dw,dh
    else
        dstptr = cast( uinteger ptr, dst + 1 )
        odstptr = cast( uinteger ptr, dst + 1 )
        dw = dst->width
        dh = dst->height
        dstbpp = dst->bpp
    end if
 
    srcptr = cast( uinteger ptr, src + 1 )
    srcbyteptr = cast( ubyte ptr, srcptr )
    dstbyteptr = cast( ubyte ptr, dstptr )
 
    sw2 = src->width\2
    sh2 = src->height\2
    srcbpp = src->bpp
    srcpitch = src->pitch
    srcwidth = src->width
    srcheight = src->height
 
    tc = cos( angle * pi_180 )
    ts = sin( angle * pi_180 )
    tcdzx = tc/zoomx
    tcdzy = tc/zoomy
    tsdzx = ts/zoomx
    tsdzy = ts/zoomy
 
    xa = sw2 * tc * zoomx + sh2  * ts * zoomx
    ya = sh2 * tc * zoomy - sw2  * ts * zoomy
 
    xb = sh2 * ts * zoomx - sw2  * tc * zoomx
    yb = sw2 * ts * zoomy + sh2  * tc * zoomy
 
    x(0) = sw2-xa
    x(1) = sw2+xa
    x(2) = sw2-xb
    x(3) = sw2+xb
    y(0) = sh2-ya
    y(1) = sh2+ya
    y(2) = sh2-yb
    y(3) = sh2+yb
 
    for i as integer = 0 to 3
        for j as integer = i to 3
            if x(i)>=x(j) then
                swap x(i), x(j)
            end if
        next
    next
    startx = x(0)
    endx = x(3)
 
    for i as integer = 0 to 3
        for j as integer = i to 3
            if y(i)>=y(j) then
                swap y(i), y(j)
            end if
        next
    next
    starty = y(0)
    endy = y(3)
 
    positx-=sw2
    posity-=sh2
    if posity+starty<0 then starty = -posity
    if positx+startx<0 then startx = -positx
    if posity+endy<0 then endy = -posity
    if positx+endx<0 then endx = -positx
    
    if positx+startx>(dw-1) then startx = (dw-1)-positx
    if posity+starty>(dh-1) then starty = (dh-1)-posity
    if positx+endx>(dw-1) then endx = (dw-1)-positx
    if posity+endy>(dh-1) then endy = (dh-1)-posity
    if startx = endx or starty = endy then exit sub


    xput = (startx + positx) * 4
    yput = starty + posity
    dstpitch = (yput * dw)
    ny = starty - sh2
    nx = startx - sw2
    nxtc = (nx * tcdzx)
    nxts = (nx * tsdzx)
    nytc = (ny * tcdzy)
    nyts = (ny * tsdzy)
    dstptr += dstpitch

	dim as integer y_draw_len = (endy - starty) + 1
	dim as integer x_draw_len = (endx - startx) + 1

 
    'and we're off!
    asm

        mov edx, dword ptr [y_draw_len]
 
        test edx, edx ' 0?
        jz y_end      ' nothing to do here
 
        fld dword ptr[tcdzy]
        fld dword ptr[tsdzy]
        fld dword ptr [tcdzx]
        fld dword ptr [tsdzx]
 
        y_inner:
 
        fld dword ptr[nxtc]     'st(0) = nxtc, st(1) = tsdzx, st(2) = tcdzx, st(3) = tsdzy, st(4) = tcdzy
        fsub dword ptr[nyts]    'nxtc-nyts
        fiadd dword ptr[sw2]    'nxtc-nyts+sw2
 
        fld dword ptr[nxts]     'st(0) = nxts, st(1) = tsdzx, st(2) = tcdzx, st(3) = tsdzy, st(4) = tcdzy
        fadd dword ptr[nytc]    'nytc+nxts
        fiadd dword ptr[sh2]    'nxts+nytc+sh2
        'fpu stack returns to: st(0) = tsdzx, st(1) = tcdzx, st(2) = tsdzy, st(3) = tcdzy 

        mov ebx, [xput]
        add ebx, [dstptr]

        mov ecx, dword ptr [x_draw_len]

        test ecx, ecx ' 0?
        jz x_end      ' nothing to do here
 
        x_inner:
 
        fist dword ptr [my] ' my = _my
 
        fld st(1)           ' mx = _mx
        fistp dword ptr [mx]
 
        mov esi, dword ptr [mx]         ' esi = mx
        mov edi, dword ptr [my]         ' edi = my
 
        ' bounds checking
        cmp esi, -1                     ' mx < 0?
        jle no_draw
        cmp edi, -1                     ' my < 0?
        jle no_draw
        cmp esi, dword ptr [srcwidth]   ' mx >= width?
        jge no_draw
        cmp edi, dword ptr [srcheight]  ' my >= height?
        jge no_draw
 
        ' calculate position in src buffer
        mov eax, dword ptr [srcbyteptr] ' eax = srcbyteptr
        imul edi, dword ptr [srcpitch]  ' edi = my * srcpitch
        add eax, edi
        shl esi, 2
        ' eax becomes src pixel color
        mov eax, dword ptr [eax+esi]
        cmp eax, [transcol]
        je no_draw
 
        ' draw pixel
        mov dword ptr [ebx], eax
        no_draw:

        fld st(3)
        faddp st(2), st(0) ' _mx += tcdzx
        fadd st(0), st(2) ' _my += tsdzx

        ' increment the output pointer
        add ebx, 4
 
        ' increment the x loop
        dec ecx
        jnz x_inner
 
        x_end:
 
        fstp dword ptr [_my]
        fstp dword ptr [_mx]
 
        'st(0) = tsdzx, st(1) = tcdzx, st(2) = tsdzy, st(3) = tcdzy
        'nytc += tcdzy
        fld dword ptr[nytc]
        fadd st(0), st(4)
        fstp dword ptr[nytc]
 
        'st(0) = tsdzx, st(1) = tcdzx, st(2) = tsdzy, st(3) = tcdzy
        'nyts+=tsdzy
        fld dword ptr[nyts]
        fadd st(0), st(3) 
        fstp dword ptr[nyts]
 
        'dstptr += dw
        mov eax, dword ptr [dw]
        shl eax, 2
        add dword ptr [dstptr], eax
 
        dec edx
        jnz y_inner
 
        y_end:
 
        finit
    end asm
 
    'hey, how did this get here?
    'http://www.youtube.com/watch?v=0ca6Wlsa-ow
 
end SUB


Sub MultiPut(Byval lpTarget As Any Ptr= 0, _
             Byval xMidPos  As Integer= 0, _
             Byval yMidPos  As Integer= 0, _
             Byval lpSource As Any Ptr   , _
             Byval xScale   As Single = 1, _
             Byval yScale   As Single = 1, _
             Byval Rotate   As Single = 0, _
             Byval Trans    As Integer= 0, _
             Byval Custom As Function(Byval Src As Uinteger, Byval Dest As Uinteger, Byval Param As Any Ptr = 0) As Uinteger = 0, _
             Byval Param As Any Ptr = 0)

  If (screenptr=0) Or (lpSource=0) Then Exit Sub

  If xScale < 0.001 Then xScale=0.001
  If yScale < 0.001 Then yScale=0.001

  Dim As Integer MustLock,MustRotate

  If lpTarget= 0 Then MustLock  =1
  If Rotate  <>0 Then MustRotate=1

  Dim As Integer  TargetWidth,TargetHeight,TargetBytes,TargetPitch
  If MustLock Then
    screeninfo    _
    TargetWidth , _
    TargetHeight, _
    TargetBytes ,,_
    TargetPitch
    TargetBytes Shr=3

    lpTarget=screenptr
  Else
    TargetBytes  = cptr(Uinteger Ptr,lpTarget)[1]
    TargetWidth  = cptr(Uinteger Ptr,lpTarget)[2]
    TargetHeight = cptr(Uinteger Ptr,lpTarget)[3]
    TargetPitch  = cptr(Uinteger Ptr,lpTarget)[4]
    lpTarget    += 32
  End If
  If (TargetWidth<4) Or (TargetHeight<4) Then Exit Sub

  Dim As Integer   SourceWidth,SourceHeight,SourceBytes,SourcePitch
  If cptr(Integer Ptr,lpSource)[0] = 7 Then
    SourceBytes  = cptr(Uinteger Ptr,lpSource)[1]
    SourceWidth  = cptr(Uinteger Ptr,lpSource)[2]
    SourceHeight = cptr(Uinteger Ptr,lpSource)[3]
    SourcePitch  = cptr(Uinteger Ptr,lpSource)[4]
    lpSource    += 32
  Else
    SourceBytes  = cptr(Ushort Ptr,lpSource)[0] And 7
    SourceWidth  = cptr(Ushort Ptr,lpSource)[0] Shr 3
    SourceHeight = cptr(Ushort Ptr,lpSource)[1]
    SourcePitch  = SourceWidth * SourceBytes
    lpSource    += 4
  End If
#if 0
  ? TargetWidth & "x" & TargetHeight & "x" & TargetBytes,TargetPitch
  ? SourceWidth & "x" & SourceHeight & "x" & SourceBytes,SourcePitch
  ? MustLock,Trans
  Sleep:End
#endif

  If (SourceWidth<2) Or (SourceHeight<2) Then Exit Sub
  If (TargetBytes<>SourceBytes) Then Exit Sub

#define xs 0 'screen
#define ys 1
#define xt 2 'texture
#define yt 3
  Dim As Single Points(3,3)
  points(0,xs)=-SourceWidth/2 * xScale
  points(1,xs)= SourceWidth/2 * xScale
  points(2,xs)= points(1,xs)
  points(3,xs)= points(0,xs)

  points(0,ys)=-SourceHeight/2 * yScale
  points(1,ys)= points(0,ys)
  points(2,ys)= SourceHeight/2 * yScale
  points(3,ys)= points(2,ys)

  points(1,xt)= SourceWidth-1
  points(2,xt)= points(1,xt)
  points(2,yt)= SourceHeight-1
  points(3,yt)= points(2,yt)

  Dim As Uinteger i
  Dim As Single x,y
  If MustRotate Then
    #ifndef UseRad
    Rotate*=Atn(1)/45 'degree 2 rad
    #endif
    While Rotate< 0       :rotate+=8*Atn(1):Wend
    While Rotate>=8*Atn(1):rotate-=8*Atn(1):Wend
    For i=0 To 3
      x=points(i,xs)*Cos(Rotate) - points(i,ys)*Sin(Rotate)
      y=points(i,xs)*Sin(Rotate) + points(i,ys)*Cos(Rotate)
      points(i,xs)=x:points(i,ys)=y
    Next
  End If

  Dim As Integer yStart,yEnd,xStart,xEnd
  yStart=100000:yEnd=-yStart:xStart=yStart:xEnd=yEnd

#define LI 0   'LeftIndex
#define RI 1   'RightIndex
#define  IND 0 'Index
#define NIND 1 'NextIndex
  Dim As Integer CNS(1,1) 'Counters

  For i=0 To 3
    points(i,xs)=Int(points(i,xs)+xMidPos)
    points(i,ys)=Int(points(i,ys)+yMidPos)
    If points(i,ys)<yStart Then yStart=points(i,ys):CNS(LI,IND)=i
    If points(i,ys)>yEnd   Then yEnd  =points(i,ys)
    If points(i,xs)<xStart Then xStart=points(i,xs)
    If points(i,xs)>xEnd   Then xEnd  =points(i,xs)
  Next
  If yStart =yEnd         Then Exit Sub
  If yStart>=TargetHeight Then Exit Sub
  If yEnd   <0            Then Exit Sub
  If xStart = xEnd        Then Exit Sub
  If xStart>=TargetWidth  Then Exit Sub
  If xEnd   <0            Then Exit Sub

  Dim As Ubyte    Ptr t1,s1
  Dim As Ushort   Ptr t2,s2
  Dim As Uinteger     t2c, s2c
  Dim As Uinteger Ptr t4,s4


#define ADD 0
#define CMP 1
#define SET 2
  Dim As Integer ACS(1,2) 'add compare and set
  ACS(LI,ADD)=-1:ACS(LI,CMP)=-1:ACS(LI,SET)=3
  ACS(RI,ADD)= 1:ACS(RI,CMP)= 4:ACS(RI,SET)=0

#define EX  0
#define EU  1
#define EV  2
#define EXS 3
#define EUS 4
#define EVS 5
  Dim As Single E(2,6),S(6),Length,uSlope,vSlope
  Dim As Integer U,UV,UA,UN,V,VV,VA,VN

  ' share the same highest point
  CNS(RI,IND)=CNS(LI,IND)
  If MustLock Then screenlock
  ' loop from Top to Bottom
  While yStart<yEnd
    'Scan Left and Right sides together
    For i=LI To RI
      ' bad to read but fast and short ;-)
      If yStart=points(CNS(i,IND),ys) Then
        CNS(i,NIND)=CNS(i,IND)+ACS(i,Add)
        If CNS(i,NIND)=ACS(i,CMP) Then CNS(i,NIND)=ACS(i,SET)
        While points(CNS(i,IND),ys) = points(CNS(i,NIND),ys)
          CNS(i, IND)=CNS(i,NIND)
          CNS(i,NIND)=CNS(i, IND)+ACS(i,Add)
          If CNS(i,NIND)=ACS(i,CMP) Then CNS(i,NIND)=ACS(i,SET)
        Wend
        E(i,EX) = points(CNS(i, IND),xs)
        E(i,EU) = points(CNS(i, IND),xt)
        E(i,EV) = points(CNS(i, IND),yt)
        Length  = points(CNS(i,NIND),ys)
        Length -= points(CNS(i, IND),ys)
        If Length <> 0.0 Then
          E(i,EXS) = points(CNS(i, NIND),xs)-E(i,EX):E(i,EXS)/=Length
          E(i,EUS) = points(CNS(i, NIND),xt)-E(i,EU):E(i,EUS)/=Length
          E(i,EVS) = points(CNS(i, NIND),yt)-E(i,EV):E(i,EVS)/=Length
        End If
        CNS(i,IND)=CNS(i,NIND)
      End If
    Next

    If (yStart<0)                              Then Goto SkipScanLine
    xStart=E(LI,EX)+0.5:If xStart>=TargetWidth Then Goto SkipScanLine
    xEnd  =E(RI,EX)-0.5:If xEnd  < 0           Then Goto SkipScanLine
    If (xStart=xEnd)                           Then Goto SkipScanLine
    'if xEnd  <xStart                           then goto SkipScanLine
    Length=xEnd-xStart
    uSlope=E(RI,EU)-E(LI,EU):uSlope/=Length
    vSlope=E(RI,EV)-E(LI,EV):vSlope/=Length
    If xstart<0 Then
      Length=Abs(xStart)
      U=Int(E(LI,EU)+uSlope*Length)
      V=Int(E(LI,EV)+vSlope*Length)
      xStart = 0
    Else
      U=Int(E(LI,EU)):V=Int(E(LI,EV))
    End If
    If xEnd>=TargetWidth Then xEnd=TargetWidth-1
    UV=Int(uSlope):UA=(uSlope-UV)*100000:UN=0
    VV=Int(vSlope):VA=(vSlope-VV)*100000:VN=0
    xEnd-=xStart
    Select Case TargetBytes
      Case 1
        t1=cptr(Ubyte Ptr,lpTarget)
        t1+=yStart*TargetPitch+xStart:xStart=0
        If Custom Then
          While xStart<xEnd
            s1=lpSource+V*SourcePitch+U
            *t1=Custom(*s1,*t1,Param)
            U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
            V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
            If u<0 Then u=0
            If v<0 Then v=0
            xStart+=1:t1+=1
          Wend
        Elseif Trans=0 Then
          While xStart<xEnd
            s1=lpSource+V*SourcePitch+U
            *t1=*s1
            U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
            V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
            If u<0 Then u=0
            If v<0 Then v=0
            xStart+=1:t1+=1
          Wend
        Else
          While xStart<xEnd
            s1=lpSource+V*SourcePitch+U
            If *s1 Then *t1=*s1
            U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
            V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
            If u<0 Then u=0
            If v<0 Then v=0
            xStart+=1:t1+=1
          Wend
        End If
      Case 2
        t2=cptr(Short Ptr,lpTarget)
        t2+=yStart*(TargetPitch Shr 1)+xStart:xStart=0
        If Custom Then
          While xStart<xEnd
            s2=cptr(Short Ptr,lpSource)+V*(SourcePitch Shr 1)+U
            s2c=*s2
            t2c=*t2
            s2c=(s2c And &H001F) Shl 3 Or (s2c Shr 2 And &H000007) Or _
                (s2c And &H07E0) Shl 5 Or (s2c Shr 1 And &H000300) Or _
                (s2c And &HF800) Shl 8 Or (s2c Shl 3 And &H070000) Or &HFF000000
            t2c=(t2c And &H001F) Shl 3 Or (s2c Shr 2 And &H000007) Or _
                (t2c And &H07E0) Shl 5 Or (s2c Shr 1 And &H000300) Or _
                (t2c And &HF800) Shl 8 Or (s2c Shl 3 And &H070000) Or &HFF000000
            t2c=Custom(s2c,t2c,Param)
            *t2=(t2c Shr 3 And &H001F) Or _
                (t2c Shr 5 And &H07E0) Or _
                (t2c Shr 8 And &HF800)
            U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
            V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
            If u<0 Then u=0
            If v<0 Then v=0
            xStart+=1:t2+=1
          Wend
        Elseif Trans=0 Then
          While xStart<xEnd
            s2=cptr(Short Ptr,lpSource)+V*(SourcePitch Shr 1)+U
            *t2=*s2
            U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
            V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
            If u<0 Then u=0
            If v<0 Then v=0
            xStart+=1:t2+=1
          Wend
        Else
          While xStart<xEnd
            s2=cptr(Short Ptr,lpSource)+V*(SourcePitch Shr 1)+U
            If *s2<>&HF81F Then *t2=*s2
            U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
            V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
            If u<0 Then u=0
            If v<0 Then v=0
            xStart+=1:t2+=1
          Wend
        End If
      Case 4
        t4=cptr(Integer Ptr,lpTarget)+yStart*(TargetPitch Shr 2)+xStart:xStart=0
        If Custom Then
          While xStart<xEnd
            s4=cptr(Integer Ptr,lpSource)+V*(SourcePitch Shr 2)+U
            *t4=Custom(*s4, *t4, Param)
            U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
            V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
            If u<0 Then u=0
            If v<0 Then v=0
            xStart+=1:t4+=1
          Wend
        Elseif Trans=0 Then
          While xStart<xEnd
            s4=cptr(Integer Ptr,lpSource)+V*(SourcePitch Shr 2)+U
            *t4=*s4
            U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
            V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
            If u<0 Then u=0
            If v<0 Then v=0
            xStart+=1:t4+=1
          Wend
        Else
          While xStart<xEnd
            's4=cptr(Integer Ptr,lpSource):s4+=V*(SourcePitch shr 2):s4+=U
            s4=cptr(Integer Ptr,lpSource)+V*(SourcePitch Shr 2)+U
            If (*s4 And &HFFFFFF)<>&HFF00FF Then *t4=*s4
            U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
            V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
            If u<0 Then u=0
            If v<0 Then v=0
            xStart+=1:t4+=1
          Wend
        End If
    End Select

SkipScanLine:
    E(LI,EX)+=E(LI,EXS):E(LI,EU)+=E(LI,EUS):E(LI,EV)+=E(LI,EVS)
    E(RI,EX)+=E(RI,EXS):E(RI,EU)+=E(RI,EUS):E(RI,EV)+=E(RI,EVS)
    yStart+=1:If yStart=TargetHeight Then yStart=yEnd 'exit loop
  Wend
If MustLock Then screenunlock
End SUB

Dr_D · Post by **Dr_D** » Feb 09, 2009 2:11

Ok. I think this is it then... If anyone finds any other bugs, please let us know. Archive in first post updated. :)

MichaelW · Post by **MichaelW** » Feb 09, 2009 7:42

For what it’s worth, under Windows the sleep 1,1 statement is inserting a 10ms delay into the loop. A demonstration that shows how to get a 1ms delay (without a busy loop):

Code: Select all

#include "windows.bi"
#include once "win/mmsystem.bi"

dim as double t

t = timer
for i as integer = 1 to 1000
  sleep 1,1
next
print using "##.##ms";(timer-t)

t = timer
for i as integer = 1 to 1000
  timeBeginPeriod( 1 ) '' set minimum resolution to 1 ms
  sleep 1,1
  timeEndPeriod( 1 )   '' restore to default
next
print using "##.##ms";(timer-t)

sleep

As per the Microsoft recommendations, the timer resolution is increased immediately before the sleep statement and then restored to the default immediately afterwards to minimize the effect of the increased timer overhead on other processes. On my relatively slow system, when rotating the image at its initial size the reduced delay increases the fps by ~15%, and I would expect a larger difference on faster systems.

recycled · Post by **recycled** » Feb 10, 2009 5:52

Here is addon function that can stretch and rotate the image same way as MULTIPUT.
first, it will stretch image into temporary buffer then rotate it.
speed will be at least 2x slower because ROTOZOOM function is called twice.
I added default value for angle=0, zoomx=1, and zoomy=1

I named it rotozoom2D. flat as 2D.

Code: Select all

SUB rotozoom2D( byref dst as FB.IMAGE ptr = 0, byref src as const FB.IMAGE ptr, byval positx as integer, byval posity as integer, byref angle as INTEGER = 0, byref zoomx as SINGLE = 1, byref zoomy as SINGLE = 1, byval transcol as uinteger  = &hffff00ff)
   ' image will be stretched into temp buffer.
   ' then rotate the stretched buffer.
   ' result will be same shape as multiput.

   DIM AS FB.IMAGE PTR temp_stretch_buffer
   DIM AS INTEGER source_width, source_height, zoomed_width, zoomed_height

   'get the size of source buffer.
   imageinfo(src, source_width, source_height)

   zoomed_width = source_width * zoomx
   zoomed_height = source_height * zoomy

   'create big enouch buffer to hold stretched image.
   temp_stretch_buffer = IMAGECREATE(zoomed_width, zoomed_height)

   'first, stretch the image into center of the temporary buffer
   ROTOZOOM( temp_stretch_buffer, src, (zoomed_width \ 2), (zoomed_height \ 2), 0, zoomx, zoomy, transcol)

   'then rotate the temporary stretched image
   ROTOZOOM( dst, temp_stretch_buffer, positx , posity, angle, 1, 1, transcol)

   IMAGEDESTROY temp_stretch_buffer

END SUB

here is demo of rotozoom2D with MULTIPUT, side by side.

Code: Select all

#include "fbgfx.bi"
 
Const As Double pi = 3.1415926, pi_180 = pi / 180
Const As Integer SCR_W = 640'\2
Const As Integer SCR_H = 480'\2
Const As Integer SCR_W2 = SCR_W\2
Const As Integer SCR_H2 = SCR_H\2
 
Declare Sub rotozoom( Byref dst As FB.IMAGE Ptr = 0, Byref src As Const FB.IMAGE Ptr, Byval positx As Integer, Byval posity As Integer, Byref angle As Integer, Byref zoomx As Single, Byref zoomy As Single, Byval transcol As Uinteger )
Declare Sub MultiPut(Byval lpTarget As Any Ptr= 0, _
             Byval xMidPos  As Integer= 0, _
             Byval yMidPos  As Integer= 0, _
             Byval lpSource As Any Ptr   , _
             Byval xScale   As Single = 1, _
             Byval yScale   As Single = 1, _
             Byval Rotate   As Single = 0, _
             Byval Trans    As Integer= 0, _
             Byval Custom As Function(Byval Src As Uinteger, Byval Dest As Uinteger, Byval Param As Any Ptr = 0) As Uinteger = 0, _
             Byval Param As Any Ptr = 0)
DECLARE SUB rotozoom2D( byref dst as FB.IMAGE ptr = 0, byref src as const FB.IMAGE ptr, byval positx as integer, byval posity as integer, byref angle as INTEGER = 0, byref zoomx as SINGLE = 1, byref zoomy as SINGLE = 1, byval transcol as uinteger  = &hffff00ff)

screenres SCR_W,SCR_H,32,,FB.GFX_HIGH_PRIORITY
 
Dim As String filename
Dim As Integer iw, ih, fpscount, vsync
Dim As fb.image Ptr image, background
Dim As String mString, fpsString
Dim As Double this_time, last_loop, last_toggle, fpsTime
Dim As Integer angle
Dim As Single zoomx = 1, zoomy = 1
 
filename = "skull32.bmp"
Open filename For Binary As #1
Get #1,19,iw
Get #1,23,ih
Close #1
 
image = imagecreate(iw, ih)
Bload filename, image
 
background = imagecreate(SCR_W, SCR_H)
 
 
Do
    last_loop = timer-this_time
    this_time = Timer
 
    fpsCount+=1
    If this_time>fpsTime Then
        fpsTime = this_time+1
        fpsString = "FPS: " & fpsCount
        fpsCount = 0
    End If
 
 
    If multikey(FB.SC_UP) Then
        zoomx *=.995
        If zoomx<.01 Then zoomx = .01
    End If
 
    If multikey(FB.SC_DOWN) Then
        zoomx *=1.005
        If zoomx>200 Then zoomx = 200
    End If
 
    If multikey(FB.SC_PAGEUP) Then
        zoomy *=.995
        If zoomy<.01 Then zoomy = .01
    End If
 
    If multikey(FB.SC_PAGEDOWN) Then
        zoomy *=1.005
        If zoomy>200 Then zoomy = 200
    End If
 
    If multikey(FB.SC_LEFT) Then
        angle -=1'last_loop*300
        If angle<0 Then angle = 360
    End If
 
    If multikey(FB.SC_RIGHT) Then
        angle +=1'last_loop*300
        If angle>360 Then angle = 0
    End If
 
    If multikey(FB.SC_V) Then
        vsync = Not vsync
        Sleep 200,1
    End If
 
    screenlock
    Line(0,0)-(SCR_W,SCR_H), 0, bf
   
    'render to screen
    rotozoom2D( 0, image, SCR_W2-100, SCR_H2, angle, zoomx, zoomy)
    Draw String (SCR_W2 - 100, SCR_H2), "rotozoom2D"
   
    MULTIPUT( 0, SCR_W2 + 100, SCR_H2, image, zoomx, zoomy, -angle,1)
    Draw String (SCR_W2+100, SCR_H2), "multiput"
   


    'render to buffer
    'line background,(0,0)-(background->width-1,background->height-1), rgb(0,0,255),bf
    'rotozoom2D( background, image, SCR_W2, SCR_H2, angle, zoomx, zoomy, rgb(255,0,255) )
    'put(0,0), background, pset
 
    Locate 1,1
    Print fpsString
    Print "left/right arrows to rotate = " & angle
    Print "up/down arrows to zoom x = " & zoomx
    Print "page up/down to zoom y = " & zoomy
    Print "V to toggle vsync = " & vsync
    If vsync Then
        screensync
    End If
    screenunlock
    Sleep 1,1
 
Loop Until multikey(FB.SC_ESCAPE)
 
 
 
Sub rotozoom( byref dst as FB.IMAGE ptr = 0, byref src as const FB.IMAGE ptr, byval positx as integer, byval posity as integer, byref angle as integer, byref zoomx as single, byref zoomy as single, byval transcol as uinteger  = &hffff00ff)

   'Rotozoom for 32-bit FB.Image by Dr_D(Dave Stanley) and yetifoot(Simon Nash)
   'No warranty implied... use at your own risk ;)

   static as integer mx, my, col, nx, ny
   static as single nxtc, nxts, nytc, nyts
   static as single tcdzx, tcdzy, tsdzx, tsdzy
   static as integer sw2, sh2, dw, dh
   static as single tc, ts, _mx, _my
   static as uinteger ptr dstptr, srcptr, odstptr
   static as integer xput, yput, startx, endx, starty, endy
   static as integer x(3), y(3), xa, xb, ya, yb, lx, ly
   static as ubyte ptr srcbyteptr, dstbyteptr
   static as integer dstpitch, srcpitch, srcbpp, dstbpp, srcwidth, srcheight

   if zoomx <= 0 or zoomy <= 0 then exit sub

   if dst = 0 then
      dstptr = screenptr
      odstptr = dstptr
      screeninfo dw,dh,,,dstpitch
   else
      dstptr = cast( uinteger ptr, dst + 1 )
      odstptr = cast( uinteger ptr, dst + 1 )
      dw = dst->width
      dh = dst->height
      dstbpp = dst->bpp
      dstpitch = dst->pitch
   end if

   srcptr = cast( uinteger ptr, src + 1 )
   srcbyteptr = cast( ubyte ptr, srcptr )
   dstbyteptr = cast( ubyte ptr, dstptr )

   sw2 = src->width\2
   sh2 = src->height\2
   srcbpp = src->bpp
   srcpitch = src->pitch
   srcwidth = src->width
   srcheight = src->height

   tc = cos( angle * pi_180 )
   ts = sin( angle * pi_180 )
   tcdzx = tc/zoomx
   tcdzy = tc/zoomy
   tsdzx = ts/zoomx
   tsdzy = ts/zoomy

   xa = sw2 * tc * zoomx + sh2  * ts * zoomx
   ya = sh2 * tc * zoomy - sw2  * ts * zoomy

   xb = sh2 * ts * zoomx - sw2  * tc * zoomx
   yb = sw2 * ts * zoomy + sh2  * tc * zoomy

   x(0) = sw2-xa
   x(1) = sw2+xa
   x(2) = sw2-xb
   x(3) = sw2+xb
   y(0) = sh2-ya
   y(1) = sh2+ya
   y(2) = sh2-yb
   y(3) = sh2+yb

   for i as integer = 0 to 3
      for j as integer = i to 3
         if x(i)>=x(j) then
            swap x(i), x(j)
         end if
      next
   next
   startx = x(0)
   endx = x(3)

   for i as integer = 0 to 3
      for j as integer = i to 3
         if y(i)>=y(j) then
            swap y(i), y(j)
         end if
      next
   next
   starty = y(0)
   endy = y(3)

   positx-=sw2
   posity-=sh2
   if posity+starty<0 then starty = -posity
   if positx+startx<0 then startx = -positx
   if posity+endy<0 then endy = -posity
   if positx+endx<0 then endx = -positx

   if positx+startx>(dw-1) then startx = (dw-1)-positx
   if posity+starty>(dh-1) then starty = (dh-1)-posity
   if positx+endx>(dw-1) then endx = (dw-1)-positx
   if posity+endy>(dh-1) then endy = (dh-1)-posity
   if startx = endx or starty = endy then exit sub


   xput = (startx + positx) * 4
   yput = starty + posity
   ny = starty - sh2
   nx = startx - sw2
   nxtc = (nx * tcdzx)
   nxts = (nx * tsdzx)
   nytc = (ny * tcdzy)
   nyts = (ny * tsdzy)
   dstptr += dstpitch * yput \ 4

   dim as integer y_draw_len = (endy - starty) + 1
   dim as integer x_draw_len = (endx - startx) + 1


   'and we're off!
   asm
      mov edx, dword ptr [y_draw_len]

      test edx, edx ' 0?
      jz y_end      ' nothing to do here

      fld dword ptr[tcdzy]
      fld dword ptr[tsdzy]
      fld dword ptr [tcdzx]
      fld dword ptr [tsdzx]

      y_inner:

      fld dword ptr[nxtc]     'st(0) = nxtc, st(1) = tsdzx, st(2) = tcdzx, st(3) = tsdzy, st(4) = tcdzy
      fsub dword ptr[nyts]    'nxtc-nyts
      fiadd dword ptr[sw2]    'nxtc-nyts+sw2

      fld dword ptr[nxts]     'st(0) = nxts, st(1) = tsdzx, st(2) = tcdzx, st(3) = tsdzy, st(4) = tcdzy
      fadd dword ptr[nytc]    'nytc+nxts
      fiadd dword ptr[sh2]    'nxts+nytc+sh2
      'fpu stack returns to: st(0) = tsdzx, st(1) = tcdzx, st(2) = tsdzy, st(3) = tcdzy

      mov ebx, [xput]
      add ebx, [dstptr]

      mov ecx, dword ptr [x_draw_len]

      test ecx, ecx ' 0?
      jz x_end      ' nothing to do here

      x_inner:

      fist dword ptr [my] ' my = _my

      fld st(1)           ' mx = _mx
      fistp dword ptr [mx]

      mov esi, dword ptr [mx]         ' esi = mx
      mov edi, dword ptr [my]         ' edi = my

      ' bounds checking
      cmp esi, -1                     ' mx < 0?
      jle no_draw
      cmp edi, -1                     ' my < 0?
      jle no_draw
      cmp esi, dword ptr [srcwidth]   ' mx >= width?
      jge no_draw
      cmp edi, dword ptr [srcheight]  ' my >= height?
      jge no_draw

      ' calculate position in src buffer
      mov eax, dword ptr [srcbyteptr] ' eax = srcbyteptr
      imul edi, dword ptr [srcpitch]  ' edi = my * srcpitch
      add eax, edi
      shl esi, 2
      ' eax becomes src pixel color
      mov eax, dword ptr [eax+esi]
      cmp eax, [transcol]
      je no_draw

      ' draw pixel
      mov dword ptr [ebx], eax
      no_draw:

      fld st(3)
      faddp st(2), st(0) ' _mx += tcdzx
      fadd st(0), st(2) ' _my += tsdzx

      ' increment the output pointer
      add ebx, 4

      ' increment the x loop
      dec ecx
      jnz x_inner

      x_end:

      fstp dword ptr [_my]
      fstp dword ptr [_mx]

      'st(0) = tsdzx, st(1) = tcdzx, st(2) = tsdzy, st(3) = tcdzy
      'nytc += tcdzy
      fld dword ptr[nytc]
      fadd st(0), st(4)
      fstp dword ptr[nytc]

      'st(0) = tsdzx, st(1) = tcdzx, st(2) = tsdzy, st(3) = tcdzy
      'nyts+=tsdzy
      fld dword ptr[nyts]
      fadd st(0), st(3)
      fstp dword ptr[nyts]

      'dstptr += dst->pitch
      mov eax, dword ptr [dstpitch]
      add dword ptr [dstptr], eax

      dec edx
      jnz y_inner

      y_end:

      finit
   end asm

   'hey, how did this get here?
   'http://www.youtube.com/watch?v=0ca6Wlsa-ow

end Sub


Sub MultiPut(Byval lpTarget As Any Ptr= 0, _
             Byval xMidPos  As Integer= 0, _
             Byval yMidPos  As Integer= 0, _
             Byval lpSource As Any Ptr   , _
             Byval xScale   As Single = 1, _
             Byval yScale   As Single = 1, _
             Byval Rotate   As Single = 0, _
             Byval Trans    As Integer= 0, _
             Byval Custom As Function(Byval Src As Uinteger, Byval Dest As Uinteger, Byval Param As Any Ptr = 0) As Uinteger = 0, _
             Byval Param As Any Ptr = 0)

  If (screenptr=0) Or (lpSource=0) Then Exit Sub

  If xScale < 0.001 Then xScale=0.001
  If yScale < 0.001 Then yScale=0.001

  Dim As Integer MustLock,MustRotate

  If lpTarget= 0 Then MustLock  =1
  If Rotate  <>0 Then MustRotate=1

  Dim As Integer  TargetWidth,TargetHeight,TargetBytes,TargetPitch
  If MustLock Then
    screeninfo    _
    TargetWidth , _
    TargetHeight, _
    TargetBytes ,,_
    TargetPitch
    TargetBytes Shr=3

    lpTarget=screenptr
  Else
    TargetBytes  = cptr(Uinteger Ptr,lpTarget)[1]
    TargetWidth  = cptr(Uinteger Ptr,lpTarget)[2]
    TargetHeight = cptr(Uinteger Ptr,lpTarget)[3]
    TargetPitch  = cptr(Uinteger Ptr,lpTarget)[4]
    lpTarget    += 32
  End If
  If (TargetWidth<4) Or (TargetHeight<4) Then Exit Sub

  Dim As Integer   SourceWidth,SourceHeight,SourceBytes,SourcePitch
  If cptr(Integer Ptr,lpSource)[0] = 7 Then
    SourceBytes  = cptr(Uinteger Ptr,lpSource)[1]
    SourceWidth  = cptr(Uinteger Ptr,lpSource)[2]
    SourceHeight = cptr(Uinteger Ptr,lpSource)[3]
    SourcePitch  = cptr(Uinteger Ptr,lpSource)[4]
    lpSource    += 32
  Else
    SourceBytes  = cptr(Ushort Ptr,lpSource)[0] And 7
    SourceWidth  = cptr(Ushort Ptr,lpSource)[0] Shr 3
    SourceHeight = cptr(Ushort Ptr,lpSource)[1]
    SourcePitch  = SourceWidth * SourceBytes
    lpSource    += 4
  End If
#if 0
  ? TargetWidth & "x" & TargetHeight & "x" & TargetBytes,TargetPitch
  ? SourceWidth & "x" & SourceHeight & "x" & SourceBytes,SourcePitch
  ? MustLock,Trans
  Sleep:End
#endif

  If (SourceWidth<2) Or (SourceHeight<2) Then Exit Sub
  If (TargetBytes<>SourceBytes) Then Exit Sub

#define xs 0 'screen
#define ys 1
#define xt 2 'texture
#define yt 3
  Dim As Single Points(3,3)
  points(0,xs)=-SourceWidth/2 * xScale
  points(1,xs)= SourceWidth/2 * xScale
  points(2,xs)= points(1,xs)
  points(3,xs)= points(0,xs)

  points(0,ys)=-SourceHeight/2 * yScale
  points(1,ys)= points(0,ys)
  points(2,ys)= SourceHeight/2 * yScale
  points(3,ys)= points(2,ys)

  points(1,xt)= SourceWidth-1
  points(2,xt)= points(1,xt)
  points(2,yt)= SourceHeight-1
  points(3,yt)= points(2,yt)

  Dim As Uinteger i
  Dim As Single x,y
  If MustRotate Then
    #ifndef UseRad
    Rotate*=Atn(1)/45 'degree 2 rad
    #endif
    While Rotate< 0       :rotate+=8*Atn(1):Wend
    While Rotate>=8*Atn(1):rotate-=8*Atn(1):Wend
    For i=0 To 3
      x=points(i,xs)*Cos(Rotate) - points(i,ys)*Sin(Rotate)
      y=points(i,xs)*Sin(Rotate) + points(i,ys)*Cos(Rotate)
      points(i,xs)=x:points(i,ys)=y
    Next
  End If

  Dim As Integer yStart,yEnd,xStart,xEnd
  yStart=100000:yEnd=-yStart:xStart=yStart:xEnd=yEnd

#define LI 0   'LeftIndex
#define RI 1   'RightIndex
#define  IND 0 'Index
#define NIND 1 'NextIndex
  Dim As Integer CNS(1,1) 'Counters

  For i=0 To 3
    points(i,xs)=Int(points(i,xs)+xMidPos)
    points(i,ys)=Int(points(i,ys)+yMidPos)
    If points(i,ys)<yStart Then yStart=points(i,ys):CNS(LI,IND)=i
    If points(i,ys)>yEnd   Then yEnd  =points(i,ys)
    If points(i,xs)<xStart Then xStart=points(i,xs)
    If points(i,xs)>xEnd   Then xEnd  =points(i,xs)
  Next
  If yStart =yEnd         Then Exit Sub
  If yStart>=TargetHeight Then Exit Sub
  If yEnd   <0            Then Exit Sub
  If xStart = xEnd        Then Exit Sub
  If xStart>=TargetWidth  Then Exit Sub
  If xEnd   <0            Then Exit Sub

  Dim As Ubyte    Ptr t1,s1
  Dim As Ushort   Ptr t2,s2
  Dim As Uinteger     t2c, s2c
  Dim As Uinteger Ptr t4,s4


#define ADD 0
#define CMP 1
#define SET 2
  Dim As Integer ACS(1,2) 'add compare and set
  ACS(LI,ADD)=-1:ACS(LI,CMP)=-1:ACS(LI,SET)=3
  ACS(RI,ADD)= 1:ACS(RI,CMP)= 4:ACS(RI,SET)=0

#define EX  0
#define EU  1
#define EV  2
#define EXS 3
#define EUS 4
#define EVS 5
  Dim As Single E(2,6),S(6),Length,uSlope,vSlope
  Dim As Integer U,UV,UA,UN,V,VV,VA,VN

  ' share the same highest point
  CNS(RI,IND)=CNS(LI,IND)
  If MustLock Then screenlock
  ' loop from Top to Bottom
  While yStart<yEnd
    'Scan Left and Right sides together
    For i=LI To RI
      ' bad to read but fast and short ;-)
      If yStart=points(CNS(i,IND),ys) Then
        CNS(i,NIND)=CNS(i,IND)+ACS(i,Add)
        If CNS(i,NIND)=ACS(i,CMP) Then CNS(i,NIND)=ACS(i,SET)
        While points(CNS(i,IND),ys) = points(CNS(i,NIND),ys)
          CNS(i, IND)=CNS(i,NIND)
          CNS(i,NIND)=CNS(i, IND)+ACS(i,Add)
          If CNS(i,NIND)=ACS(i,CMP) Then CNS(i,NIND)=ACS(i,SET)
        Wend
        E(i,EX) = points(CNS(i, IND),xs)
        E(i,EU) = points(CNS(i, IND),xt)
        E(i,EV) = points(CNS(i, IND),yt)
        Length  = points(CNS(i,NIND),ys)
        Length -= points(CNS(i, IND),ys)
        If Length <> 0.0 Then
          E(i,EXS) = points(CNS(i, NIND),xs)-E(i,EX):E(i,EXS)/=Length
          E(i,EUS) = points(CNS(i, NIND),xt)-E(i,EU):E(i,EUS)/=Length
          E(i,EVS) = points(CNS(i, NIND),yt)-E(i,EV):E(i,EVS)/=Length
        End If
        CNS(i,IND)=CNS(i,NIND)
      End If
    Next

    If (yStart<0)                              Then Goto SkipScanLine
    xStart=E(LI,EX)+0.5:If xStart>=TargetWidth Then Goto SkipScanLine
    xEnd  =E(RI,EX)-0.5:If xEnd  < 0           Then Goto SkipScanLine
    If (xStart=xEnd)                           Then Goto SkipScanLine
    'if xEnd  <xStart                           then goto SkipScanLine
    Length=xEnd-xStart
    uSlope=E(RI,EU)-E(LI,EU):uSlope/=Length
    vSlope=E(RI,EV)-E(LI,EV):vSlope/=Length
    If xstart<0 Then
      Length=Abs(xStart)
      U=Int(E(LI,EU)+uSlope*Length)
      V=Int(E(LI,EV)+vSlope*Length)
      xStart = 0
    Else
      U=Int(E(LI,EU)):V=Int(E(LI,EV))
    End If
    If xEnd>=TargetWidth Then xEnd=TargetWidth-1
    UV=Int(uSlope):UA=(uSlope-UV)*100000:UN=0
    VV=Int(vSlope):VA=(vSlope-VV)*100000:VN=0
    xEnd-=xStart
    Select Case TargetBytes
      Case 1
        t1=cptr(Ubyte Ptr,lpTarget)
        t1+=yStart*TargetPitch+xStart:xStart=0
        If Custom Then
          While xStart<xEnd
            s1=lpSource+V*SourcePitch+U
            *t1=Custom(*s1,*t1,Param)
            U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
            V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
            If u<0 Then u=0
            If v<0 Then v=0
            xStart+=1:t1+=1
          Wend
        Elseif Trans=0 Then
          While xStart<xEnd
            s1=lpSource+V*SourcePitch+U
            *t1=*s1
            U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
            V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
            If u<0 Then u=0
            If v<0 Then v=0
            xStart+=1:t1+=1
          Wend
        Else
          While xStart<xEnd
            s1=lpSource+V*SourcePitch+U
            If *s1 Then *t1=*s1
            U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
            V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
            If u<0 Then u=0
            If v<0 Then v=0
            xStart+=1:t1+=1
          Wend
        End If
      Case 2
        t2=cptr(Short Ptr,lpTarget)
        t2+=yStart*(TargetPitch Shr 1)+xStart:xStart=0
        If Custom Then
          While xStart<xEnd
            s2=cptr(Short Ptr,lpSource)+V*(SourcePitch Shr 1)+U
            s2c=*s2
            t2c=*t2
            s2c=(s2c And &H001F) Shl 3 Or (s2c Shr 2 And &H000007) Or _
                (s2c And &H07E0) Shl 5 Or (s2c Shr 1 And &H000300) Or _
                (s2c And &HF800) Shl 8 Or (s2c Shl 3 And &H070000) Or &HFF000000
            t2c=(t2c And &H001F) Shl 3 Or (s2c Shr 2 And &H000007) Or _
                (t2c And &H07E0) Shl 5 Or (s2c Shr 1 And &H000300) Or _
                (t2c And &HF800) Shl 8 Or (s2c Shl 3 And &H070000) Or &HFF000000
            t2c=Custom(s2c,t2c,Param)
            *t2=(t2c Shr 3 And &H001F) Or _
                (t2c Shr 5 And &H07E0) Or _
                (t2c Shr 8 And &HF800)
            U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
            V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
            If u<0 Then u=0
            If v<0 Then v=0
            xStart+=1:t2+=1
          Wend
        Elseif Trans=0 Then
          While xStart<xEnd
            s2=cptr(Short Ptr,lpSource)+V*(SourcePitch Shr 1)+U
            *t2=*s2
            U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
            V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
            If u<0 Then u=0
            If v<0 Then v=0
            xStart+=1:t2+=1
          Wend
        Else
          While xStart<xEnd
            s2=cptr(Short Ptr,lpSource)+V*(SourcePitch Shr 1)+U
            If *s2<>&HF81F Then *t2=*s2
            U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
            V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
            If u<0 Then u=0
            If v<0 Then v=0
            xStart+=1:t2+=1
          Wend
        End If
      Case 4
        t4=cptr(Integer Ptr,lpTarget)+yStart*(TargetPitch Shr 2)+xStart:xStart=0
        If Custom Then
          While xStart<xEnd
            s4=cptr(Integer Ptr,lpSource)+V*(SourcePitch Shr 2)+U
            *t4=Custom(*s4, *t4, Param)
            U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
            V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
            If u<0 Then u=0
            If v<0 Then v=0
            xStart+=1:t4+=1
          Wend
        Elseif Trans=0 Then
          While xStart<xEnd
            s4=cptr(Integer Ptr,lpSource)+V*(SourcePitch Shr 2)+U
            *t4=*s4
            U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
            V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
            If u<0 Then u=0
            If v<0 Then v=0
            xStart+=1:t4+=1
          Wend
        Else
          While xStart<xEnd
            's4=cptr(Integer Ptr,lpSource):s4+=V*(SourcePitch shr 2):s4+=U
            s4=cptr(Integer Ptr,lpSource)+V*(SourcePitch Shr 2)+U
            If (*s4 And &HFFFFFF)<>&HFF00FF Then *t4=*s4
            U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
            V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
            If u<0 Then u=0
            If v<0 Then v=0
            xStart+=1:t4+=1
          Wend
        End If
    End Select

SkipScanLine:
    E(LI,EX)+=E(LI,EXS):E(LI,EU)+=E(LI,EUS):E(LI,EV)+=E(LI,EVS)
    E(RI,EX)+=E(RI,EXS):E(RI,EU)+=E(RI,EUS):E(RI,EV)+=E(RI,EVS)
    yStart+=1:If yStart=TargetHeight Then yStart=yEnd 'exit loop
  Wend
If MustLock Then screenunlock
End Sub
 
SUB rotozoom2D( byref dst as FB.IMAGE ptr = 0, byref src as const FB.IMAGE ptr, byval positx as integer, byval posity as integer, byref angle as INTEGER = 0, byref zoomx as SINGLE = 1, byref zoomy as SINGLE = 1, byval transcol as uinteger  = &hffff00ff)
   ' image will be stretched into temp buffer.
   ' then rotate the stretched buffer.
   ' result will be same shape as multiput.

   DIM AS FB.IMAGE PTR temp_stretch_buffer
   DIM AS INTEGER source_width, source_height, zoomed_width, zoomed_height

   'get the size of source buffer.
   imageinfo(src, source_width, source_height)

   zoomed_width = source_width * zoomx
   zoomed_height = source_height * zoomy

   'create big enouch buffer to hold stretched image.
   temp_stretch_buffer = IMAGECREATE(zoomed_width, zoomed_height)

   'first, stretch the image into center of the temporary buffer
   ROTOZOOM( temp_stretch_buffer, src, (zoomed_width \ 2), (zoomed_height \ 2), 0, zoomx, zoomy, transcol)

   'then rotate the temporary stretched image
   ROTOZOOM( dst, temp_stretch_buffer, positx , posity, angle, 1, 1, transcol)

   IMAGEDESTROY temp_stretch_buffer

END SUB

Dr_D · Post by **Dr_D** » Feb 19, 2009 5:44

Original archive updated with alpha blending version.

rolliebollocks · Post by **rolliebollocks** » Feb 20, 2009 12:26

@Recycled

I noticed you have screensync in your loop which as far as I know works when you have 2 or more pages. It is also hella slow, outmoded yet added for backward compatibility with QBasic approaches to double buffering. I don't know how it's functioning, but I would think it would speed everything up to just get rid of it.

rb

relsoft · Post by **relsoft** » Feb 28, 2009 0:13

recycled wrote: I think rotozoom rotates image like the MODE-7 floormap in SNES Mario Kart.

Yes and no.

Yes because it also uses DDA.

No because Doc's is more of like a "rotoscaler" which is actually a lot better than a rotozoomer.

M7 gfx chip uses a rotozoomer under the hood.

Landeel · Post by **Landeel** » Mar 07, 2009 14:46

I wanted to add mirror / flip parameters like I did with MultiPut. How can I do that?

Dr_D · Post by **Dr_D** » Mar 07, 2009 15:30

You could send negative values for zoomx/zoomy with this.

Code: Select all

sub rotozoom( byref dst as FB.IMAGE ptr = 0, byref src as const FB.IMAGE ptr, byval positx as integer, byval posity as integer, byref angle as integer, byref zoomx as single, byref zoomy as single, byval transcol as uinteger  = &hffff00ff)
    
    'Rotozoom for 32-bit FB.Image by Dr_D(Dave Stanley) and yetifoot(Simon Nash)
    'No warranty implied... use at your own risk ;) 
    
    static as integer mx, my, col, nx, ny
    static as single nxtc, nxts, nytc, nyts
    static as single tcdzx, tcdzy, tsdzx, tsdzy
    static as integer sw2, sh2, dw, dh
    static as single tc, ts, _mx, _my
    static as uinteger ptr dstptr, srcptr, odstptr
    static as integer xput, yput, startx, endx, starty, endy
    static as integer x(3), y(3), xa, xb, ya, yb, lx, ly
    static as ubyte ptr srcbyteptr, dstbyteptr
    static as integer dstpitch, srcpitch, srcbpp, dstbpp, srcwidth, srcheight
    
    if zoomx = 0 or zoomy = 0 then exit sub
    
    if dst = 0 then
        dstptr = screenptr
        odstptr = dstptr
        screeninfo dw,dh,,,dstpitch
    else
        dstptr = cast( uinteger ptr, dst + 1 )
        odstptr = cast( uinteger ptr, dst + 1 )
        dw = dst->width
        dh = dst->height
        dstbpp = dst->bpp
        dstpitch = dst->pitch
    end if
    
    srcptr = cast( uinteger ptr, src + 1 )
    srcbyteptr = cast( ubyte ptr, srcptr )
    dstbyteptr = cast( ubyte ptr, dstptr )
    
    sw2 = src->width\2
    sh2 = src->height\2
    srcbpp = src->bpp
    srcpitch = src->pitch
    srcwidth = src->width
    srcheight = src->height
    
    tc = cos( angle * pi_180 )
    ts = sin( angle * pi_180 )
    tcdzx = tc/zoomx
    tcdzy = tc/zoomy
    tsdzx = ts/zoomx
    tsdzy = ts/zoomy
    
    xa = sw2 * tc * zoomx + sh2  * ts * zoomx
    ya = sh2 * tc * zoomy - sw2  * ts * zoomy
    
    xb = sh2 * ts * zoomx - sw2  * tc * zoomx
    yb = sw2 * ts * zoomy + sh2  * tc * zoomy
    
    x(0) = sw2-xa
    x(1) = sw2+xa
    x(2) = sw2-xb
    x(3) = sw2+xb
    y(0) = sh2-ya
    y(1) = sh2+ya
    y(2) = sh2-yb
    y(3) = sh2+yb
    
    for i as integer = 0 to 3
        for j as integer = i to 3
            if x(i)>=x(j) then
                swap x(i), x(j)
            end if
        next
    next
    startx = x(0)
    endx = x(3)
    
    for i as integer = 0 to 3
        for j as integer = i to 3
            if y(i)>=y(j) then
                swap y(i), y(j)
            end if
        next
    next
    starty = y(0)
    endy = y(3)
    
    positx-=sw2
    posity-=sh2
    if posity+starty<0 then starty = -posity
    if positx+startx<0 then startx = -positx
    if posity+endy<0 then endy = -posity
    if positx+endx<0 then endx = -positx
    
    if positx+startx>(dw-1) then startx = (dw-1)-positx
    if posity+starty>(dh-1) then starty = (dh-1)-posity
    if positx+endx>(dw-1) then endx = (dw-1)-positx
    if posity+endy>(dh-1) then endy = (dh-1)-posity
    if startx = endx or starty = endy then exit sub
    
    
    xput = (startx + positx) * 4
    yput = starty + posity
    ny = starty - sh2
    nx = startx - sw2
    nxtc = (nx * tcdzx)
    nxts = (nx * tsdzx)
    nytc = (ny * tcdzy)
    nyts = (ny * tsdzy)
    dstptr += dstpitch * yput \ 4
    
	dim as integer y_draw_len = (endy - starty) + 1
	dim as integer x_draw_len = (endx - startx) + 1
    
    
    'and we're off!
    asm
        mov edx, dword ptr [y_draw_len]
        
        test edx, edx ' 0?
        jz y_end      ' nothing to do here
        
        fld dword ptr[tcdzy]
        fld dword ptr[tsdzy]
        fld dword ptr [tcdzx]
        fld dword ptr [tsdzx]
        
        y_inner:
        
        fld dword ptr[nxtc]     'st(0) = nxtc, st(1) = tsdzx, st(2) = tcdzx, st(3) = tsdzy, st(4) = tcdzy
        fsub dword ptr[nyts]    'nxtc-nyts
        fiadd dword ptr[sw2]    'nxtc-nyts+sw2
        
        fld dword ptr[nxts]     'st(0) = nxts, st(1) = tsdzx, st(2) = tcdzx, st(3) = tsdzy, st(4) = tcdzy
        fadd dword ptr[nytc]    'nytc+nxts
        fiadd dword ptr[sh2]    'nxts+nytc+sh2
        'fpu stack returns to: st(0) = tsdzx, st(1) = tcdzx, st(2) = tsdzy, st(3) = tcdzy 
        
        mov ebx, [xput]
        add ebx, [dstptr]
        
        mov ecx, dword ptr [x_draw_len]
        
        test ecx, ecx ' 0?
        jz x_end      ' nothing to do here
        
        x_inner:
        
        fist dword ptr [my] ' my = _my
        
        fld st(1)           ' mx = _mx
        fistp dword ptr [mx]
        
        mov esi, dword ptr [mx]         ' esi = mx
        mov edi, dword ptr [my]         ' edi = my
        
        ' bounds checking
        test esi, esi       'mx<0?
        js no_draw          
        'mov esi, 0
        
        test edi, edi
        'mov edi, 0
        js no_draw          'my<0?

        cmp esi, dword ptr [srcwidth]   ' mx >= width?
        jge no_draw
        cmp edi, dword ptr [srcheight]  ' my >= height?
        jge no_draw
        
        ' calculate position in src buffer
        mov eax, dword ptr [srcbyteptr] ' eax = srcbyteptr
        imul edi, dword ptr [srcpitch]  ' edi = my * srcpitch
        add eax, edi
        shl esi, 2
        ' eax becomes src pixel color
        mov eax, dword ptr [eax+esi]
        cmp eax, [transcol]
        je no_draw
        
        ' draw pixel
        mov dword ptr [ebx], eax
        no_draw:
        
        fld st(3)
        faddp st(2), st(0) ' _mx += tcdzx
        fadd st(0), st(2) ' _my += tsdzx
        
        ' increment the output pointer
        add ebx, 4
        
        ' increment the x loop
        dec ecx
        jnz x_inner
        
        x_end:
        
        fstp dword ptr [_my]
        fstp dword ptr [_mx]
        
        'st(0) = tsdzx, st(1) = tcdzx, st(2) = tsdzy, st(3) = tcdzy
        'nytc += tcdzy
        fld dword ptr[nytc]
        fadd st(0), st(4)
        fstp dword ptr[nytc]
        
        'st(0) = tsdzx, st(1) = tcdzx, st(2) = tsdzy, st(3) = tcdzy
        'nyts+=tsdzy
        fld dword ptr[nyts]
        fadd st(0), st(3) 
        fstp dword ptr[nyts]
        
        'dstptr += dst->pitch
        mov eax, dword ptr [dstpitch]
        add dword ptr [dstptr], eax
        
        dec edx
        jnz y_inner
        
        y_end:
        
        finit
    end asm
    
end sub

Landeel · Post by **Landeel** » Mar 07, 2009 15:35

Exactly what I needed! Thanks!!!

Dr_D · Post by **Dr_D** » Jun 02, 2009 6:59

Well, the archive has been updated. Rotozoom_Alpha2 now works with variable alpha which can be passed as a param. Credit goes to Mysoft and Kristopher Windsor for the help. It's the same archive as in the original post.

KristopherWindsor · Post by **KristopherWindsor** » Jun 02, 2009 7:18

All I did was demand the function, but I think I was a valuable part of this development team. :P
The function is 1.5 - 2.0x faster than Multiput, and looks better, especially for large scaling + rotation. :)

agamemnus · Post by **agamemnus** » Jun 26, 2009 5:55

Note: If blitting to screen, use screenunlock right before (no drawing commands in between), or right after, otherwise nothing will show up. Seems to be a weird deep-rooted fb.image library bug as I've encountered something similar before with a totally different graphics function.

KristopherWindsor · Post by **KristopherWindsor** » Jun 26, 2009 6:25

Hmm? You're supposed to lock the screen before drawing, not unlock it. :o