/'
  rotateScaleImage.bi
'/

Function Rotate_Image ( _
    imgSur As Any Ptr, _
    angle As Double = 0 _
    ) As Any Ptr

    If imgSur = 0 Then Exit Function

    Dim As Any Ptr imgOut

    Scope
    #Define lenght(x1,y1,x2,y2) sqr((x1-x2)*(x1-x2)+(y1-y2)*(y1-y2))

    Dim As Double d, r
    dim as Double ySin, yCos
    dim as Double sinRot = sin(angle)
    Dim as Double cosRot = cos(angle)

    dim as ulong ptr imgSurPtr
    Dim As Integer i, j, w, h, w2, h2, pix, defaultColour = RGB( 255, 0, 255)
    ImageInfo imgSur, w, h, , ,imgSurPtr
    d = lenght(0,0, w,h ): w2 = w /2 : h2 = h /2

    imgOut = ImageCreate ( d, d, RGB( 255,0,255))
    dim as ulong ptr imgOutPtr
    Dim As Integer wo, ho
    ImageInfo imgOut, wo, ho, , ,imgOutPtr

    r = d /2

    For j = 0 To d - 1
  ySin = (j - r ) * sinRot
  yCos = (j - r ) * cosRot
  For i = 0 To d - 1

   Var xsrc = int((i - r ) * cosRot - ySin + w2 + 0.5 )
   Var ysrc = int((i - r ) * sinRot + yCos + h2 + 0.5 )

   if (xsrc >= 0) and (xsrc < w) and (ysrc >= 0) and (ysrc < h) Then
    pix = imgSurPtr[ysrc * w + xsrc]
   Else
    pix = defaultColour
   EndIf
   If pix <> RGB(255,0,255) Then PSet imgOut, (i, j),pix
  Next
    Next

    'Line imgOut,(0,0) - (d-1,d-1), &Hcccccc, B

    End Scope

    Return imgOut
End Function

Sub RotatImage ( _
    ByRef imgSur As Any Ptr, _
    angle As Double = 0 _
    )

    If imgSur = 0 Then Exit Sub

    Dim As Any Ptr imgOut

    Scope
    #Define lenght(x1,y1,x2,y2) sqr((x1-x2)*(x1-x2)+(y1-y2)*(y1-y2))

    Dim As Double d, r
    dim as Double ySin, yCos
    dim as Double sinRot = sin(angle)
    Dim as Double cosRot = cos(angle)

    dim as ulong ptr imgSurPtr
    Dim As Integer i, j, w, h, w2, h2, pix, defaultColour = RGB( 255, 0, 255)
    ImageInfo imgSur, w, h, , ,imgSurPtr
    d = lenght(0,0, w,h ): w2 = w /2 : h2 = h /2

    imgOut = ImageCreate ( d, d, RGB( 255,0,255))
    dim as ulong ptr imgOutPtr
    Dim As Integer wo, ho
    ImageInfo imgOut, wo, ho, , ,imgOutPtr

    r = d /2

    For j = 0 To d - 1
  ySin = (j - r ) * sinRot
  yCos = (j - r ) * cosRot
  For i = 0 To d - 1

   Var xsrc = int((i - r ) * cosRot - ySin + w2 + 0.5 )
   Var ysrc = int((i - r ) * sinRot + yCos + h2 + 0.5 )

   if (xsrc >= 0) and (xsrc < w) and (ysrc >= 0) and (ysrc < h) Then
    pix = imgSurPtr[ysrc * w + xsrc]
   Else
    pix = defaultColour
   EndIf
   If pix <> RGB(255,0,255) Then PSet imgOut, (i, j),pix
  Next
    Next

    imgSur = imgOut

    End Scope
End Sub

function Scale_Image ( _
    imgSur As Any Ptr, _
    scale_x As Double = 1.0, _
    scale_y As Double = 1.0 _
    ) As Any Ptr

    If imgSur = 0 And scale_x > 0 And scale_y > 0 Then Exit Function

    Dim As Any Ptr imgOut

    Scope
    #undef onscreen
    #define onscreen(xx,yy,xres,yres) xx >= 0 and xx < xres and yy >= 0 and yy < yres

    Dim As Integer i,j, scx, scy
    Dim imgSurPtr As ULong Ptr, w As Integer, h As Integer
    ImageInfo imgSur, w, h, , , imgSurPtr

    imgOut = ImageCreate ( Int(w * scale_x), Int(h  * scale_y))
    Dim imgOutPtr As ULong Ptr, wo As Integer, ho As Integer
    ImageInfo imgOut, wo, ho, , , imgOutPtr

    For j = 0 To h
  For i = 0 To w
   scx = Int( i * scale_x )
   scy = Int( j * scale_y )
   If onscreen( scx, scy, wo, ho) Then
    Line imgOut,( scx, scy) - ( scx + scale_x * 2, scy + scale_y * 2), imgSurPtr[ j * w + i], BF
   EndIf
  Next
    Next

    'Line imgOut,( 0, 0) - ( wo-1, ho-1), &Hcccccc, B

    End Scope
    Return imgOut
End Function

Sub ScaleImage ( _
    imgSur As Any Ptr, _
    x As Double, _
    y As Double, _
    scale_x As Double = 1.0, _
    scale_y As Double = 1.0 _
    )

    If imgSur = 0 And scale_x > 0 And scale_y > 0 Then Exit sub

    Dim As Any Ptr imgOut

    Scope
    #undef onscreen
    #define onscreen(xx,yy,xres,yres) xx >= 0 and xx < xres and yy >= 0 and yy < yres

    Dim As Integer i,j, scx, scy, WS, hs
    Dim imgSurPtr As ULong Ptr, w As Integer, h As Integer
    ImageInfo imgSur, w, h, , , imgSurPtr

    WS = Int(w * scale_x)
    hs = Int(h * scale_y)
    imgOut = ImageCreate ( ws, hs)
    Dim imgOutPtr As ULong Ptr, wo As Integer, ho As Integer
    ImageInfo imgOut, wo, ho, , , imgOutPtr

    For j = 0 To h
  For i = 0 To w
   scx = Int( i * scale_x )
   scy = Int( j * scale_y )
   If onscreen( scx, scy, wo, ho) Then
    Line imgOut,( scx, scy) - ( scx + scale_x * 2, scy + scale_y * 2), imgSurPtr[ j * w + i], BF
   EndIf
  Next
    Next

    Put ( x - WS / 2, y - hs / 2), imgOut, Trans

    End Scope
End Sub

Sub ScalImage ( _
    ByRef imgSur As Any Ptr, _
    scale_x As Double = 1.0, _
    scale_y As Double = 1.0 _
    )

    If imgSur = 0 And scale_x > 0 And scale_y > 0 Then Exit sub

    Dim As Any Ptr imgOut

    Scope
    #undef onscreen
    #define onscreen(xx,yy,xres,yres) xx >= 0 and xx < xres and yy >= 0 and yy < yres

    Dim As Integer i,j, scx, scy, WS, hs
    Dim imgSurPtr As ULong Ptr, w As Integer, h As Integer
    ImageInfo imgSur, w, h, , , imgSurPtr

    WS = Int(w * scale_x)
    hs = Int(h  * scale_y)
    imgOut = ImageCreate ( ws, hs)
    Dim imgOutPtr As ULong Ptr, wo As Integer, ho As Integer
    ImageInfo imgOut, wo, ho, , , imgOutPtr

    For j = 0 To h
  For i = 0 To w
   scx = Int( i * scale_x )
   scy = Int( j * scale_y )
   If onscreen( scx, scy, wo, ho) Then
    Line imgOut,( scx, scy) - ( scx + scale_x * 2, scy + scale_y * 2), imgSurPtr[ j * w + i], BF
   EndIf
  Next
    Next

    imgSur = imgOut

    End Scope
End Sub

Sub RotaZoomImage OverLoad( _
    imgSur As Any Ptr, _
    x As Double, _
    y As Double, _
    angle As Double = 0, _
    scale_x As Double = 1.0, _
    scale_y As Double = 1.0 _
    )

    If imgSur = 0 Then Exit Sub

    Dim As Any Ptr imgOut =  Scale_Image( imgSur, scale_x, scale_y)
    imgOut = Rotate_Image( imgOut, angle)

    Dim As Integer w, h, WS, hs
    ImageInfo imgOut, w, h

    x -= w / 2
    y -= h / 2

    Put ( x - WS , y - hs ), imgOut,Trans
End Sub

Sub RotaZoomImage OverLoad( _
    imgTarget As Any Ptr, _
    imgSur As Any Ptr, _
    x As Double, _
    y As Double, _
    angle As Double = 0, _
    scale_x As Double = 1.0, _
    scale_y As Double = 1.0 _
    )

    If imgSur = 0 Or imgTarget = 0 Then Exit Sub

    Dim As Any Ptr imgOut =  Scale_Image( imgSur, scale_x, scale_y)
    imgOut = Rotate_Image( imgOut, angle)

    Dim As Integer w, h, WS, hs
    ImageInfo imgOut, w, h

    x -= w / 2
    y -= h / 2

    Put imgTarget, ( x - WS , y - hs ), imgOut,Trans
End Sub

#Ifdef __FB_MAIN__
'
#include "fbgfx.bi"
Using FB '' Êîíñòàíòû ñêàíêîäîâ õðàíÿòñÿ â ïðîñòðàíñòâå èìåí FB â lang FB

Dim Shared As Integer scrx, scry
ScreenControl GET_DESKTOP_SIZE, scrx, scry
screenres scrx, scry, 32, 2
Color 0, RGB( 120,136,178)
ScreenSet 1, 0

Dim As Any Ptr rimg
Dim As Any Ptr _
img = imagecreate( 120, 60, RGB( 105,0,255))
Circle img,(10, 20),20, &HccFF33,,,,F
Circle img,(60, 40),40, RGB( 255,0,255),,,,F
Circle img,(60, 30),15, &H006600,,,,F
Circle img,(90, 50),15, &H000066,,,,F

Dim As Any Ptr scr = imagecreate( 200, 200, &H333333)

Dim As Integer mx, my, mz, mb, mc, res
Dim As Integer x = scrx / 2, y = scry / 2
Dim As Double angle = 0, scale = 1, asp = 0.02

Do

    res = GetMouse ( mx, my, mz, mb, mc )

    If multikey(&h4D) then asp += .02  'right KEY
    If multikey(&h4B) then asp -= .02  'left KEY
    If multikey(&h50) Then scale -= .1  'down KEY
    If multikey(&H48) then scale += .1  'up KEY
    'If multikey(SC_PAGEUP) then scale += .1  'up KEY
    'If multikey(SC_PAGEDOWN) then scale -= .1  'up KEY
    angle += asp

    rimg = img
    ScalImage( rimg, Scale, Scale)
    RotatImage( rimg, angle)

    ScreenLock()
    Cls

    Put (20,40),img,Trans

    Put (150, 0), Rotate_Image( img, angle),Trans
    Put (300, 0), Scale_Image( img, Scale, Scale),Trans

    Put (450, 0), Rimg,Trans

    Put (600, 0), Rotate_Image( Scale_Image( img, Scale, Scale), angle),Trans

    '[ actual
    RotaZoomImage( img, 300,300,angle,Scale, Scale)

    Line ( 300,0)-(300,400),&Hcccccc
    Line ( 0,300)-(400,300),&Hcccccc
    ']

    '[
    Line scr,( 0, 0) - ( 200, 200), &H333333, BF
    RotaZoomImage( scr, img, 0,0,angle,Scale, Scale)
    Put (450, 300), scr,Trans
    ']

    Draw String ( 20,20), Left( Str(angle), 4),&Hffffff

    ScreenUnlock()
    Sleep 25
    Flip
Loop Until multikey(&H01) Or InKey = Chr(255)+"k" Or InKey = Chr(27) 'loop until ESC key pressed
While Inkey <> "": Wend
End
#EndIf