'generic rotozoom method testing by Dr_D(Dave Stanley) May 18, 2008
'includes multiput test, by DJ Peters.

#include "fbgfx.bi"
'#define UseRad 'if not then Rotate are in degres

const as single pi_180 = 3.1415926 / 180
const as integer SCR_W = 320
const as integer SCR_H = 240
const as integer SCR_W2=SCR_W\2
const as integer SCR_H2=SCR_H\2

  type imagedat    
    as uinteger ptr dataptr 'image pointer
    as integer      bpp     'bits per pixel
    as uinteger     bgColor 'transparent color (-1=none)    
    as integer      frames  'frame count
    as integer      length  'image length
    as integer      height  'image height
    as integer      offset  'frame offset
  end type

declare sub rotozoom( byref dst as FB.IMAGE ptr, byref src as FB.IMAGE ptr, byref positx as integer, byref posity as integer, byref angle as integer, byref zoom as single )
declare sub rotozoomfp( byref dst as FB.IMAGE ptr = 0, byref src as FB.IMAGE ptr, byref positx as integer, byref posity as integer, byref angle as integer, byref zoomx as single, byref zoomy as single )
declare sub rotoskew( byref dst as FB.IMAGE ptr = 0, byref src as FB.IMAGE ptr, byref positx as integer, byref posity as integer, byref angle as integer, byref zoomx as single, byref zoomy as single )

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)

declare sub img_create(length as integer,height as integer,frames as integer,imageptr as imagedat ptr)
declare sub img_free(source as imagedat ptr)
declare sub img_roto_draw(x0 as integer,y0 as integer,cx as double,cy as double,sx as double,sy as double,ang as integer,alpha as integer,frame as integer,source as imagedat ptr)

screenres SCR_W,SCR_H,32',,FB.GFX_HIGH_PRIORITY

dim as string filename
dim as integer tw, th
dim as fb.image ptr image
dim as imagedat     img
dim as string mString, fpsString
dim as double this_time, last_loop, last_toggle, fpsTime
dim as integer angle, rMode=4, fpsCount
dim as single zoom = 1

filename = "skull.bmp"
open filename for binary as #1
    get #1,19,tw
    get #1,23,th
close #1

image = imagecreate(tw, th)
bload filename, image

dim as uinteger ptr uint=cptr(uinteger ptr,image)+8

    img.bpp=len(integer)    
    img.frames=1
    img.length=tw+2
    img.height=th+0
    img.offset=img.length*img.height
    img.dataptr=uint'[8]
    
    dim ii as integer=0
    for yy as integer=0 to th-1'0+1
    for xx as integer=0 to tw+1      
      pset(xx,yy),uint[ii]'+8]
      ii+=1
    next
  next
  
  '? th,tw
    
    'line (0,0)-(50,50),rgb(255,0,0)
    
    'sleep
    'end

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_SPACE) then
        if this_time>last_toggle then
            last_toggle = this_time+.15
            rMode += 1
            if rMode>4 then rMode = 0
        end if
    end if
    
    if multikey(FB.SC_UP) then
        zoom -=.1
        if zoom<.1 then zoom = .1
    end if
    
    if multikey(FB.SC_DOWN) then
        zoom +=.1
        if zoom>100 then zoom = 100
    end if
    
    if multikey(FB.SC_LEFT) then
        angle -=1
        if angle<0 then angle = 360
    end if
    
    if multikey(FB.SC_RIGHT) then
        angle +=1
        if angle>360 then angle = 0
    end if
    
    
    screenlock
    line(0,0)-(SCR_W,SCR_H),0,bf
    select case as const rMode
        case 0
            mString = "Floating Point"
            rotozoom( 0, image, SCR_W2-image->width\2, SCR_H2-image->height\2, angle, zoom )
        case 1
            mString = "Floating Point w/Skew"
            rotoskew( 0, image, SCR_W2-image->width\2, SCR_H2-image->height\2, angle, zoom, zoom )
        case 2
            mString = "Fixed Point"
            rotozoomfp( 0, image, SCR_W2-image->width\2, SCR_H2-image->height\2, angle, zoom, zoom )
        case 3
            mString = "Multiput"
            Multiput( 0, SCR_W2, SCR_H2, image, zoom, zoom, 360-angle, 1 )
        case 4            
            mString = "Rotodraw"
            'img_roto_draw(x0 ,y0 ,cx,cy ,sx, sy, ang as integer,alpha as integer,frame as integer,source as imagedat ptr)
            img_roto_draw(SCR_W2,SCR_H2,0,0,zoom,zoom,angle,0,0,@img)
            
    end select
    
    locate 1,1
    COLOR(&HFFFF00)
    print "SPACE = TOGGLE RENDERING METHODS"
    print
    print "ARROWS = ROTATE/ZOOM"
    print

    COLOR(&H9999FF)
    print mString
    print

    COLOR(&HFFFFFF)
    print fpsString
    print

    COLOR(&HFFFFFF)
    print "Angle: " & angle
    'screensync
    screenunlock
    sleep 1,1
    
loop until multikey(FB.SC_ESCAPE)



sub rotozoom( byref dst as FB.IMAGE ptr = 0, byref src as FB.IMAGE ptr, byref positx as integer, byref posity as integer, byref angle as integer, byref zoom as single )
    'Dave Stanley
    static as integer nx, ny, mx, my, col
    static as single nxtc, nxts, nytc, nyts
    static as integer sw2, sh2, dw, dh
    static as single tc,ts
    static as uinteger ptr dstptr, srcptr
    static as integer xput, yput, startx, endx, starty, endy
    static as integer x(3), y(3), xa, xb, ya, yb
    static as uinteger transcol = rgb(255,0,255)
    
    if dst = 0 then
        dstptr = screenptr
        screeninfo dw,dh
    else
        dstptr = cast( uinteger ptr, dst+1)
        dw = dst->width
        dh = dst->height
    end if
    
    srcptr = cast( uinteger ptr, src +1 )
    
    sw2 = src->width\2
    sh2 = src->height\2
    
    tc = cos( angle * pi_180 )
    ts = sin( angle * pi_180 )
    
    xa = ((sw2 * zoom)*tc + (sh2  * zoom)*ts)
    ya = ((sh2 * zoom)*tc - (sw2  * zoom)*ts)
    
    xb = ((sh2 * zoom)*ts - (sw2  * zoom)*tc)
    yb = ((sw2 * zoom)*ts + (sh2  * zoom)*tc)
    
    tc/=zoom
    ts/=zoom
    
    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)
    
    if dst = 0 then
        
        
        for y as integer = starty to endy
            
            yput = y + posity
            
            if yput>-1 and yput<dh then
                
                ny = y - sh2
                
                nytc = (ny * tc)
                nyts = (ny * ts)
                
                for x as integer = startx to endx
                    
                    xput = x+positx
                    
                    if xput>-1 and xput<dW then
                        
                        nx = x - sw2
                        
                        nxtc = (nx * tc)
                        nxts = (nx * ts)
                        
                        mx = (nxtc - nyts) + sw2
                        my = (nytc + nxts) + sh2
                        
                        if mx>-1 and my>-1 and mx<src->width and my<src->height then
                            
                            col = *cast(uinteger ptr, cast(ubyte ptr, srcptr) + my * src->pitch + mx * src->bpp )
                            
                            if col<>transcol then
                                dstptr[ (yput * dw ) + xput ] = col
                            end if
                            
                        end if
                    end if
                    
                next
                
            end if
            
        next
        
    else
        
        for y as integer = starty to endy
            
            yput = y + posity
            
            if yput>-1 and yput<dh then
                
                ny = y - sh2
                
                nytc = (ny * tc)
                nyts = (ny * ts)
                
                for x as integer = startx to endx
                    
                    xput = x+positx
                    
                    if xput>-1 and xput<dW then
                        
                        nx = x - sw2
                        
                        nxtc = (nx * tc)
                        nxts = (nx * ts)
                        
                        mx = (nxtc - nyts) + sw2
                        my = (nytc + nxts) + sh2
                        
                        if mx>-1 and my>-1 and mx<src->width and my<src->height then
                            
                            col = *cast(uinteger ptr, cast(ubyte ptr, srcptr) + my * src->pitch + mx * src->bpp )
                            
                            if col<>transcol then
                                *cast(uinteger ptr, cast(ubyte ptr, dstptr) + yput * dst->pitch + xput * dst->bpp) = col
                            end if
                            
                        end if
                    end if
                    
                next
                
            end if
            
        next
        
    end if
    
end sub



sub rotoskew( byref dst as FB.IMAGE ptr = 0, byref src as FB.IMAGE ptr, byref positx as integer, byref posity as integer, byref angle as integer, byref zoomx as single, byref zoomy as single )
    'Dave Stanley
    static as integer nx, ny, mx, my, col
    static as single nxtc, nxts, nytc, nyts
    static as integer sw2, sh2, dw, dh
    static as single tc,ts
    static as uinteger ptr dstptr, srcptr
    static as integer xput, yput, startx, endx, starty, endy
    static as integer x(3), y(3), xa, xb, ya, yb
    static as uinteger transcol = rgb(255,0,255)
    
    if dst = 0 then
        dstptr = screenptr
        screeninfo dw,dh
    else
        dstptr = cast( uinteger ptr, dst+1)
        dw = dst->width
        dh = dst->height
    end if
    
    srcptr = cast( uinteger ptr, src +1 )
    
    sw2 = src->width\2
    sh2 = src->height\2
    
    tc = cos( angle * pi_180 )
    ts = sin( angle * pi_180 )
    
    xa = ((sw2 * zoomx)*tc + (sh2  * zoomy)*ts)
    ya = ((sh2 * zoomy)*tc - (sw2  * zoomx)*ts)
    
    xb = ((sh2 * zoomx)*ts - (sw2  * zoomy)*tc)
    yb = ((sw2 * zoomy)*ts + (sh2  * zoomx)*tc)
    
    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)
    
    if dst = 0 then
        
        for y as integer = starty to endy
            
            yput = y + posity
            
            if yput>-1 and yput<dh then
                
                ny = y - sh2
                
                nytc = (ny * tc)
                nyts = (ny * ts)
                
                for x as integer = startx to endx
                    
                    xput = x+positx
                    
                    if xput>-1 and xput<dW then
                        
                        nx = x - sw2
                        
                        nxtc = (nx * tc)
                        nxts = (nx * ts)
                        
                        mx = (nxtc - nyts) / zoomx + sw2
                        my = (nytc + nxts) / zoomy + sh2
                        
                        if mx>-1 and my>-1 and mx<src->width and my<src->height then
                            
                            col = *cast(uinteger ptr, cast(ubyte ptr, srcptr) + my * src->pitch + mx * src->bpp )
                            
                            if col<>transcol then
                                dstptr[ (yput * dw ) + xput ] = col
                            end if
                            
                        end if
                    end if
                    
                next
                
            end if
            
        next
        
    else
        
        for y as integer = starty to endy
            
            yput = y + posity
            
            if yput>-1 and yput<dh then
                
                ny = y - sh2
                
                nytc = (ny * tc)
                nyts = (ny * ts)
                
                for x as integer = startx to endx
                    
                    xput = x+positx
                    
                    if xput>-1 and xput<dW then
                        
                        nx = x - sw2
                        
                        nxtc = (nx * tc)
                        nxts = (nx * ts)
                        
                        mx = (nxtc - nyts) / zoomx + sw2
                        my = (nytc + nxts) / zoomy + sh2
                        
                        if mx>-1 and my>-1 and mx<src->width and my<src->height then
                            
                            col = *cast(uinteger ptr, cast(ubyte ptr, srcptr) + my * src->pitch + mx * src->bpp )
                            
                            if col<>transcol then
                                *cast(uinteger ptr, cast(ubyte ptr, dstptr) + yput * dst->pitch + xput * dst->bpp) = col
                            end if
                            
                        end if
                    end if
                    
                next
                
            end if
            
        next
        
    end if
end sub



sub rotozoomfp( byref dst as FB.IMAGE ptr = 0, byref src as FB.IMAGE ptr, byref positx as integer, byref posity as integer, byref angle as integer, byref zoomx as single, byref zoomy as single )
    'Dave Stanley
    static as integer nx, ny, mx, my, col
    static as integer nxtc, nxts, nytc, nyts
    static as integer sw2, sh2, dw, dh
    static as integer tc,ts
    static as uinteger ptr dstptr, srcptr
    static as integer xput, yput, startx, endx, starty, endy
    static as integer x(3), y(3), xa, xb, ya, yb
    static as uinteger transcol = rgb(255,0,255)
    
    if dst = 0 then
        dstptr = screenptr
        screeninfo dw,dh
    else
        dstptr = cast( uinteger ptr, dst+1)
        dw = dst->width
        dh = dst->height
    end if
    
    srcptr = cast( uinteger ptr, src +1 )
    
    sw2 = src->width\2
    sh2 = src->height\2
    
    tc = cos( angle * pi_180 ) * 256
    ts = sin( angle * pi_180 ) * 256
    
    xa = ((sw2 * zoomx)*tc + (sh2  * zoomy)*ts) / 256
    ya = ((sh2 * zoomy)*tc - (sw2  * zoomx)*ts) / 256
    
    xb = ((sh2 * zoomx)*ts - (sw2  * zoomy)*tc) / 256
    yb = ((sw2 * zoomy)*ts + (sh2  * zoomx)*tc) / 256
    
    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)
    
    if dst = 0 then
        
        for y as integer = starty to endy
            
            yput = y + posity
            
            if yput>-1 and yput<dh then
                
                ny = y - sh2
                
                nytc = ((ny * tc))
                nyts = ((ny * ts))
                
                for x as integer = startx to endx
                    
                    xput = x+positx
                    
                    if xput>-1 and xput<dW then
                        
                        nx = x - sw2
                        
                        nxtc = ((nx * tc))
                        nxts = ((nx * ts))
                        
                        mx = (nxtc - nyts) / zoomx / 256 + sw2
                        my = (nytc + nxts) / zoomy / 256 + sh2
                        
                        if mx>-1 and my>-1 and mx<src->width and my<src->height then
                            
                            col = *cast(uinteger ptr, cast(ubyte ptr, srcptr) + my * src->pitch + mx * src->bpp )
                            
                            if col<>transcol then
                                dstptr[ (yput * dw ) + xput ] = col
                            end if
                            
                        end if
                        
                    end if
                    
                next
                
            end if
            
        next
        
    else
        
        for y as integer = starty to endy
            
            yput = y + posity
            
            if yput>-1 and yput<dh then
                
                ny = y - sh2
                
                nytc = ((ny * tc))
                nyts = ((ny * ts))
                
                for x as integer = startx to endx
                    
                    xput = x+positx
                    
                    if xput>-1 and xput<dW then
                        
                        nx = x - sw2
                        
                        nxtc = ((nx * tc))
                        nxts = ((nx * ts))
                        
                        mx = (nxtc - nyts) / zoomx / 256 + sw2
                        my = (nytc + nxts) / zoomy / 256 + sh2
                        
                        if mx>-1 and my>-1 and mx<src->width and my<src->height then
                            
                            col = *cast(uinteger ptr, cast(ubyte ptr, srcptr) + my * src->pitch + mx * src->bpp )
                            
                            if col<>transcol then
                                *cast(uinteger ptr, cast(ubyte ptr, dstptr) + yput * dst->pitch + xput * dst->bpp) = col
                            end if
                            
                        end if
                        
                    end if
                    
                next
                
            end if
            
        next
        
    end if

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)
  'DJ Peters
  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  = 1
    SourceWidth  = cptr(Ushort Ptr,lpSource)[0] Shr 3
    SourceHeight = cptr(Ushort Ptr,lpSource)[1]
    SourcePitch  = SourceWidth
    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*=0.017453292 'degre 2 rad
    #endif
    While Rotate< 0        :rotate+=6.2831853:Wend
    While Rotate>=6.2831853:rotate-=6.2831853: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 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 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 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 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<>&HFFFF00FF 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

' =============================================================================
'          Name: img_create (07.16.06)
'       Returns: 
'    Parameters:
'        length: frame length
'        height: frame height
'        frames: desired frame count [1]
'      imageptr: pointer to image data
' -----------------------------------------------------------------------------
'   Description: Create memory for image set.
'      Comments: Old image set is released if present.
' =============================================================================   
  sub img_create(length as integer,height as integer,frames as integer,imageptr as imagedat ptr)
    
    if imageptr=0 then return 'exit on null pointer
    
    imageptr->bpp=len(integer)    
    imageptr->frames=frames
    imageptr->length=length
    imageptr->height=height    
    imageptr->offset=length*height
    
    dim as uinteger bytes=imageptr->bpp*imageptr->frames*imageptr->offset
    
    if imageptr->dataptr then deallocate(imageptr->dataptr) 'release old data
      
    imageptr->dataptr=callocate(bytes)
    
  end sub

  sub img_free(source as imagedat ptr)    
    if source->dataptr then deallocate(source->dataptr)
  end sub

' =============================================================================
'          Name: img_roto_draw (04.05.08)
'    Parameters:
'         x1,y1: center point in screen coordinates
'     [cx!,cy!]: center point in image coordinates [0,0]
'     [sx!,sy!]: horizontal/vertical scale factors [1,1]
'           ang: rotation angle
'           [a]: alpha value [0]
'        frame1: source frame to render in target frame
'        source: pointer to source image data
'      [frame2]: target frame to render source frame to [0]
'      [target]: pointer to target image data [0]
' -----------------------------------------------------------------------------
'   Description: Define a clipping region.
'      Comments: cx,cy range from -1 to 1. -1=top/left 1=bottom/right
' =============================================================================  
  sub img_roto_draw(x0 as integer,y0 as integer,cx as double,cy as double,sx as double,sy as double,ang as integer,alpha as integer,frame as integer,source as imagedat ptr)
        
    dim xx(3) as integer
    dim yy(3) as integer
    dim uu(3) as integer
    dim vv(3) as integer
    
    dim as integer clipx1=0,clipx2=SCR_W-1'page.xres-1
    dim as integer clipy1=0,clipy2=SCR_H-1'page.yres-1
    
    dim as integer dx,dy,dv
    dim as double  scx,scy
    dim as integer x1,y1,x2,y2,x3,y3,x4,y4
    dim as integer u1,v1,u2,v2,u3,v3,u4,v4
    
    dx=source->length
    dy=source->height
    dv=source->length
    
    scx=source->length*(cx+1)/2
    scy=source->height*(cy+1)/2
  
  ' define image corners about center point
    x1=sx*-scx:     y1=sy*-scy
    x2=sx*(dx-scx): y2=sy*-scy
    x3=sx*(dx-scx): y3=sy*(dy-scy)
    x4=sx*-scx:     y4=sy*(dy-scy)
  
  ' pre-calc sin/cos values
    dim as double sa=sin(ang*pi_180)'PI/180)
    dim as double ca=cos(ang*pi_180)'PI/180)  
    
  ' assign uv coordinates
    uu(0)=0:    vv(0)=0
    uu(1)=dx-1: vv(1)=0
    uu(2)=dx-1: vv(2)=dy-1
    uu(3)=0:    vv(3)=dy-1
    
  ' rotozoom corner points
    xx(0)=(x1*ca-y1*sa)+x0:  yy(0)=(y1*ca+x1*sa)+y0
    xx(1)=(x2*ca-y2*sa)+x0:  yy(1)=(y2*ca+x2*sa)+y0
    xx(2)=(x3*ca-y3*sa)+x0:  yy(2)=(y3*ca+x3*sa)+y0
    xx(3)=(x4*ca-y4*sa)+x0:  yy(3)=(y4*ca+x4*sa)+y0
    
    dim as integer t0,t1,t2,p1,p2,p3,p4

  ' Find top corner
    t1=-(yy(0)>yy(1))
    t2=-(yy(2)>yy(3))+2    
    if yy(t1)<yy(t2) then t0=t1 else t0=t2
    
  ' Special Case: If 2 top corners, use left corner
    t2=(t0+3) and 3
    if (yy(t0)=yy(t2)) and (xx(t0)>xx(t2)) then t0=t2
    
  ' Sort corners
    p1=t0           'top 
    p2=(t0+1) and 3 'right
    p3=(t0+3) and 3 'left
    p4=(t0+2) and 3 'bottom
    
  ' assign sorted values
    x1=xx(p1): y1=yy(p1): u1=uu(p1): v1=vv(p1)
    x2=xx(p2): y2=yy(p2): u2=uu(p2): v2=vv(p2)
    x3=xx(p3): y3=yy(p3): u3=uu(p3): v3=vv(p3)
    x4=xx(p4): y4=yy(p4): u4=uu(p4): v4=vv(p4)
    
    dim as integer dx1,dy1,dx2,dy2,dx3,dy3,dx4,dy4
    dim as integer du1,dv1,du2,dv2,du3,dv3,du4,dv4
    
  ' Calc deltas  
    dx1=x3-x1: dy1=y3-y1: du1=u3-u1: dv1=v3-v1 'top to left
    dx2=x2-x1: dy2=y2-y1: du2=u2-u1: dv2=v2-v1 'top to right
    dx3=x4-x3: dy3=y4-y3: du3=u4-u3: dv3=v4-v3 'left to bottom
    dx4=x4-x2: dy4=y4-y2: du4=u4-u2: dv4=v4-v2 'right to bottom
    
    dim as integer xoff1,yoff1,xoff2,yoff2
    dim as integer uoff1,voff1,uoff2,voff2
    
  ' Clip vertically
    if (y1<clipy1) then yoff1=clipy1-y1: yoff2=clipy1-y1: y1=clipy1
    if (y4>clipy2) then y4=clipy2
    
    dim as double dxdy1,dudy1,dvdy1
    dim as double dxdy2,dudy2,dvdy2
    
  ' Determine left-edge starting point & values  
    if (y3>=clipy1) then 'start from top
      xoff1=x1: uoff1=u1: voff1=v1
      if dy1 then
        dxdy1=dx1/dy1
        dudy1=du1/dy1
        dvdy1=dv1/dy1
      else 'handle divide by zero
        dxdy1=0
        dudy1=-(du1<>0) 'evaluates to 0 or 1
        dvdy1=-(dv1<>0) 'ditto
      end if      
    else 'start from left
      xoff1=x3: yoff1=clipy1-y3: uoff1=u3: voff1=v3
      if dy3 then
        dxdy1=dx3/dy3
        dudy1=du3/dy3
        dvdy1=dv3/dy3
      else 'handle divide by zero
        dxdy1=0
        dudy1=-(du3<>0) 'evaluates to 0 or 1
        dvdy1=-(dv3<>0) 'ditto
      end if
    end if
  
  ' Determine right-edge starting point & values  
    if (y2>=clipy1) then 'start from top
      xoff2=x1: uoff2=u1: voff2=v1
      if dy2 then
        dxdy2=dx2/dy2
        dudy2=du2/dy2
        dvdy2=dv2/dy2
      else 'handle divide by zero
        dxdy2=0
        dudy2=-(du2<>0) 'evaluates to 0 or 1
        dvdy2=-(dv2<>0) 'ditto
      end if      
    else 'start from right
      xoff2=x4: yoff2=clipy1-y4: uoff2=u4: voff2=v4
      if dy4 then
        dxdy2=dx4/dy4
        dudy2=du4/dy4
        dvdy2=dv4/dy4
      else 'handle divide by zero
        dxdy2=0
        dudy2=-(du4<>0) 'evaluates to 0 or 1
        dvdy2=-(dv4<>0) 'ditto
      end if
    end if
    
    dim as integer x,y,sx1,sx2,uv0
    dim as double  rx1,rx2,ru1,rv1,ru2,rv2
  
  ' calc initial edge values  
    rx1=xoff1+yoff1*dxdy1: sx1=rx1
    rx2=xoff2+yoff2*dxdy2: sx2=rx2
    ru1=uoff1+yoff1*dudy1: rv1=voff1+yoff1*dvdy1
    ru2=uoff2+yoff2*dudy2: rv2=voff2+yoff2*dvdy2
    
    uv0=frame*source->offset
    
  ' render roto-zoomed image  
    for y=y1 to y4
      if y=y3 then 'update left deltas
        sx1=x3: ru1=u3: rv1=v3
        if dy3 then
          dxdy1=dx3/dy3
          dudy1=du3/dy3
          dvdy1=dv3/dy3
        else 'handle divide by zero
          dxdy1=0
          dudy1=-(du3<>0) 'evaluates to 0 or 1
          dvdy1=-(dv3<>0) 'ditto
        end if
      end if      
      if y=y2 then 'update right deltas
        rx2=x2: ru2=u2: rv2=v2
        if dy4 then
          dxdy2=dx4/dy4
          dudy2=du4/dy4
          dvdy2=dv4/dy4
        else 'handle divide by zero
          dxdy2=0
          dudy2=-(du4<>0) 'evaluates to 0 or 1
          dvdy2=-(dv4<>0) 'ditto
        end if        
      end if
      
      dim as uinteger c
      dim as integer  u,v,dsx
      dim as double   ru,rv,dudx,dvdx
      
      sx1=rx1: sx2=rx2: dsx=sx2-sx1
      if dsx then
        dudx=(ru2-ru1)/dsx
        dvdx=(rv2-rv1)/dsx
      end if
      
      if (sx1>=clipx1) then
        ru=ru1: u=ru
        rv=rv1: v=rv
      else
        ru=ru1+(clipx1-sx1)*dudx: u=ru
        rv=rv1+(clipx1-sx1)*dvdx: v=rv
        sx1=clipx1
      end if
      
      if (sx2>clipx2) then sx2=clipx2
        
      for x=sx1 to sx2
        c=source->dataptr[uv0+u+v*dv]          
        if c then pset(x,y),c or (alpha shl 24)
        ru+=dudx: u=ru
        rv+=dvdx: v=rv
      next
    
    ' increment edge values with respective deltas
      rx1+=dxdy1: ru1+=dudy1: rv1+=dvdy1
      rx2+=dxdy2: ru2+=dudy2: rv2+=dvdy2
            
    next
    
  end sub