PureBasic Forums - English

Code: Select all

;*****************************************************************************
;
;- Vectorial rotation routine
; (c)djes@free.fr 2014
; No sinus, cosinus, pi or other trigonometric functions, and only two multiplications by pixel.
; http://www.purebasic.fr/english/viewtopic.php?f=12&t=61016&p=456305
;
;*****************************************************************************

EnableExplicit

Structure vector
  x.d
  y.d
  du.d
EndStructure

Dim RotationVar.vector(1, 1)
Dim ImageData.l(1, 1)
Define CanvasWidth, CanvasHeight 
Define CanvasCenterX, CanvasCenterY 
Define.i RotatedImageWidth, RotatedImageHeight
Define.d RotatedImageCenterX, RotatedImageCenterY
Define.d UnitVector
Define.i x, y, Color, Event, Quit
Define.d ZoomX, ZoomY

;*****************************************************************************
;- PROCEDURES
;*****************************************************************************

Procedure.d VectorNorm(x1.d, y1.d, x2.d, y2.d)
  
  ProcedureReturn Sqr(Pow(x2 - x1, 2) + Pow(y2 - y1, 2))
  
EndProcedure

;*****************************************************************************

Procedure ComputeRotationVar()
  
  Define.d MaxLength
  Define.i x, y
  
  Shared CanvasWidth, CanvasHeight 
  Shared CanvasCenterX, CanvasCenterY
  Shared RotationVar()
  Shared UnitVector
  
  Dim RotationVar.vector(CanvasWidth, CanvasHeight)
  
  CanvasCenterX = CanvasWidth / 2
  CanvasCenterY = CanvasHeight / 2
  
  MaxLength = VectorNorm(0, 0, CanvasCenterX, CanvasCenterY)
  UnitVector.d = 1 / MaxLength
  
  For y = 0 To CanvasHeight - 1
    For x = 0 To CanvasWidth - 1
      
      RotationVar(x, y)\x =  x - CanvasCenterX
      RotationVar(x, y)\y =  y - CanvasCenterY
      
    Next x    
  Next y
  
EndProcedure

;*****************************************************************************

Procedure LoadNConvertImage()
  
  Define.i x, y
  Shared RotatedImageWidth, RotatedImageHeight
  Shared.d RotatedImageCenterX, RotatedImageCenterY
  Shared ImageData()
  
  If LoadImage(0, #PB_Compiler_Home + "Examples\Sources\Data\PureBasicLogo.bmp") = 0
    MessageRequester("Alert", "Can't load example image", #PB_MessageRequester_Ok)
    End 
  EndIf
  
  RotatedImageWidth = ImageWidth(0)
  RotatedImageHeight = ImageHeight(0)
  RotatedImageCenterX = RotatedImageWidth / 2
  RotatedImageCenterY = RotatedImageHeight / 2
  
  Dim ImageData.l(RotatedImageWidth, RotatedImageHeight)
  
  StartDrawing(ImageOutput(0))
  
  For y = 0 To RotatedImageHeight - 1
    For x = 0 To RotatedImageWidth - 1
      ImageData(x, y) = Point(x, y)
    Next x    
  Next y
  
  StopDrawing()
EndProcedure

;*****************************************************************************

Procedure Rotate()
  
  Define.i x, y
  Define.d ox, oy
  
  Shared CanvasWidth, CanvasHeight
  Shared RotationVar()
  Shared UnitVector
  
  For y = 0 To CanvasHeight - 1
    For x = 0 To CanvasWidth - 1
      
      ox = RotationVar(x, y)\x
      oy = RotationVar(x, y)\y
      
      RotationVar(x, y)\x = ox + oy * UnitVector
      RotationVar(x, y)\y = oy - ox * UnitVector
      
    Next x    
  Next y
  
EndProcedure

;*****************************************************************************

Procedure MyPoint(x.i, y.i)
  
  Shared RotatedImageHeight, RotatedImageWidth
  Shared RotationVar(), ImageData()
  
  If x >= 0 And x < RotatedImageWidth And y >= 0 And y < RotatedImageHeight  
    ProcedureReturn ImageData(x, y)
  Else
    ProcedureReturn RGBA(0, 0, 0, 0)    
  EndIf
  
EndProcedure

;*****************************************************************************
;- MAIN
;*****************************************************************************

CanvasWidth = 512
CanvasHeight = 512

If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0
  MessageRequester("Error", "Can't init the system", 0)
  End
EndIf

If OpenWindow(0, 0, 0, CanvasWidth, CanvasHeight, "Rotation example", #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_ScreenCentered) = 0
  MessageRequester("Error", "Can't open the window", 0)
  End
EndIf

If OpenWindowedScreen(WindowID(0), 0, 0, CanvasWidth, CanvasHeight, 0, 0, 0) = 0
  MessageRequester("Error", "Can't open windowed screen!", 0)
  End
EndIf

;*****************************************************************************

LoadNConvertImage()

ComputeRotationVar()

;*****************************************************************************
;- EVENT LOOP
;*****************************************************************************

MouseLocate(100, 100)

Repeat
  
  Repeat
    ; Always process all the events to flush the queue at every frame
    Event = WindowEvent()
    
    Select Event
      Case #PB_Event_CloseWindow
        Quit = 1
        
    EndSelect
    
  Until Event = 0 ; Quit the event loop only when no more events are available
  
  ExamineMouse()
  ExamineKeyboard()
  
  ZoomX = MouseX()/100
  ZoomY = MouseY()/100
  
  Rotate()
  
  ClearScreen(RGB(0,0,0))
  StartDrawing(ScreenOutput())
  
  For y = 0 To CanvasHeight - 1
    For x = 0 To CanvasWidth - 1
      
      Color = MyPoint(RotatedImageCenterX + RotationVar(x, y)\x * ZoomX, RotatedImageCenterY + RotationVar(x, y)\y * ZoomY)
      
      If Color <> 0 
        Plot(x, y, Color)
      EndIf
      
    Next x    
  Next y
  
  StopDrawing()
  
  FlipBuffers()       ; Inverse the buffers (the back become the front (visible)...) and we can do the rendering on the back
  
Until  Quit Or KeyboardPushed(#PB_Key_Escape)