Image rotation (like TransformSprite)

[Michael Vogel]

I'd like to create a procedure to make a simple rotation of an image (the routine should be fast and the result should be antialiased and transparent). It would be nice to have a flexible routine like TransformSprite, but it would be enough to allow rotating using the x or y axis at the image center.

Here's my start (not so fast, not antialiased, no transparent background):

Code: Select all

CreateImage(1, 256, 256)
StartDrawing(ImageOutput(1))
DrawingMode(#PB_2DDrawing_AllChannels)
Box(0, 0, 256, 256, $FF808080)
For x = 0 To 7
	For y = x&1 To 7 Step 2
		Box(x*32, y*32, 32,32, $FFe0e0e0)
	Next
Next
StopDrawing()

Procedure TransformImage(Source,Destination,Width,Height,Distortion)

	Protected x,y,w,h

	#Temp=0

	CreateImage(Destination,Width,Height,32);,#PB_Image_Transparent)


	w=ImageWidth(Source)
	h=ImageHeight(Source)

	If Distortion>0
		ws=Width-Distortion<<1
		we=Distortion
	Else
		ws=Width
		we=0
	EndIf

	k=h/Height

	StartDrawing(ImageOutput(Destination))
	For i=0 To Height-1
		GrabImage(source,#Temp,0,i*h/Height,w,k)
		d=i*Distortion/height
		ResizeImage(#Temp,ws+d<<1,1)
		DrawImage(ImageID(#Temp),we-d,i)
	Next i
	StopDrawing()

EndProcedure


OpenWindow(0, 0, 0, 800, 600, "Screen", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
CanvasGadget(0,0,0,800,600)
AddWindowTimer(0,0,200)

Repeat

	Select WaitWindowEvent(250)
	Case #PB_Event_CloseWindow,#WM_CHAR : End
	Case #PB_Event_Timer
		n+1
		y=Sin(n/10)*150
		If y<0
			y=-y
		EndIf
		y+10
		TransformImage(1,2,200,y,Cos(n/10)*20)
		StartDrawing(CanvasOutput(0))
		Box(0,0,500,500,#White)
		DrawAlphaImage(ImageID(2),100,150-y/2)
		StopDrawing()

	EndSelect
ForEver

And now it's your turn...

[wilbert]

I'd like to create a procedure to make a simple rotation of an image (the routine should be fast and the result should be antialiased and transparent). It would be nice to have a flexible routine like TransformSprite, but it would be enough to allow rotating using the x or y axis at the image center.

Any reason not to use the VectorDrawing library ?

[Michael Vogel]

Hm, I don't know how to rotate into the 'z' dimension using the vector library. I found RotateCoordinates and SkewCoordinates so far, but was not able to squeeze an image into a trapeze form.

[wilbert]

was not able to squeeze an image into a trapeze form.

I don't think that's possible with the VectorDrawing library.

I have no clue how to do that.
The information I can find about 3x3 transform matrices also only support translate, scale, rotate and shear.

Edit:
Maybe something like the QTransform class from Qt

[Michael Vogel]

Still playing around, but the rotation doesn't look very realistic (beside there's no front and backside for now), for that it's very slow

Code: Select all

CreateImage(1, 256, 256)
StartDrawing(ImageOutput(1))
DrawingMode(#PB_2DDrawing_AllChannels)
Box(0, 0, 256, 256, $FF808080)
For x = 0 To 7
	For y = x&1 To 7 Step 2
		Box(x*32, y*32, 32,32, $FFe0e0e0)
	Next
Next
DrawingMode(#PB_2DDrawing_AlphaBlend)
For i=0 To 33
	Circle(Random(240),Random(240),Random(40),$60000000|Random(#White))
Next i
StopDrawing()


Global MaxWidth=300
Global MaxHeight=300


CreateImage(2,MaxWidth,MaxHeight,32)

Procedure TransformImage(Source,Destination,Width,Height,Distortion)

	Protected x,y,w,h

	#Temp=0
	#Tamp=9

	w=ImageWidth(Source)
	h=ImageHeight(Source)

	CopyImage(Source,#Tamp)
	ResizeImage(#Tamp,w,Height)

	If Distortion>0
		ws=Width-Distortion<<1
		we=Distortion
	Else
		ws=Width
		we=0
	EndIf

	we=(MaxWidth-ws)/2
	top=(h-height)/2+50

	StartDrawing(ImageOutput(Destination))
	Box(1,1,MaxWidth-2,MaxHeight-2,#White)
	For i=0 To Height-1
		GrabImage(#Tamp,#Temp,0,i,w,1)
		d=i*Distortion/height
		ResizeImage(#Temp,ws+d<<1,1)
		DrawImage(ImageID(#Temp),we-d,top+i)
	Next i
	StopDrawing()

EndProcedure


OpenWindow(0, 0, 0, 800, 600, "Screen", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
CanvasGadget(0,0,0,800,600)
AddWindowTimer(0,0,20)


Repeat

	Select WaitWindowEvent(25)
	Case #PB_Event_CloseWindow,#WM_CHAR : End
	Case #PB_Event_Timer
		n+1
		y=Sin(n/10)*150
		If y<0
			y=-y
			z=-1
		Else
			z=1
		EndIf
		y+2
		x=Cos(n/10)*50
		TransformImage(1,2,300-y,y,x*z)
		StartDrawing(CanvasOutput(0))
		Box(0,0,500,500,#White)
		
		DrawAlphaImage(ImageID(2),400,100)
		StopDrawing()

	EndSelect
ForEver

[netmaestro]

Hi Michael, this may be pretty close to what you're looking for: viewtopic.php?f=12&t=53246

Even if it's not an exact fit it's a library well worth having. A truly valuable gift from STARGÅTE.

[Kuron]

Hi Michael, this may be pretty close to what you're looking for: viewtopic.php?f=12&t=53246

Even if it's not an exact fit it's a library well worth having. A truly valuable gift from STARGÅTE.

Not sure how I missed that thread... Thank you for mentioning it. Should be very helpful to me. :c)

[davido]

Herewith another 3D demo by STARGÅTE.

Unfortunately it won't compile with PureBasic 5.70b1. Any way, it looks rather interesting.
I hope some one can get it to work.

https://www.purebasic.fr/german/viewtop ... 89#p305189

[RASHAD]

Hi MV
Part of the code by NM
Another Part by IceSoft (I think)
The rest by RASHAD
I hope you like it

Code: Select all

UseTGAImageDecoder()

Import "kernel32.lib"
  GetModuleHandleA(Arg.i)
EndImport

Global win,Image,TrackBar,FileName$,DImage,SImage, xang.d, yang.d, zang.d, flength.d, zoom.d, destx.l, desty.l
Global lib,*token, *Image, lBitmap,DES_Image,SCR_Image

lib = OpenLibrary(#PB_Any, "gdiplus.dll")
If Not lib
  MessageRequester("Error","GDIplus Could not loaded ",#PB_MessageRequester_Ok|#MB_ICONERROR)
  End
EndIf

#bpp = 24

;- CodecInfo\MimeType
#Jpeg_Encoder = "image/jpeg"
#Gif_Encoder = "image/gif"
#Bmp_Encoder = "image/bmp"
#Png_Encoder = "image/png"
#Tif_Encoder = "image/tiff"

Macro CopyImageToMemory(imagenumber, Memory)
	TemporaryBitmapInfo.BITMAPINFO
	TemporaryDC = CreateDC_("DISPLAY", #Null, #Null, #Null)
	GetObject_(ImageID(imagenumber), SizeOf(BITMAP), TemporaryBitmap.BITMAP)
	TemporaryBitmapInfo\bmiHeader\biSize        = SizeOf(BITMAPINFOHEADER)
	TemporaryBitmapInfo\bmiHeader\biWidth       = TemporaryBitmap\bmWidth
	TemporaryBitmapInfo\bmiHeader\biHeight      = -TemporaryBitmap\bmHeight
	TemporaryBitmapInfo\bmiHeader\biPlanes      = 1
	TemporaryBitmapInfo\bmiHeader\biBitCount    = 32
	TemporaryBitmapInfo\bmiHeader\biCompression = #BI_RGB
	GetDIBits_(TemporaryDC, ImageID(imagenumber), 0, TemporaryBitmap\bmHeight, Memory, TemporaryBitmapInfo.BITMAPINFO, #DIB_RGB_COLORS)
	DeleteDC_(TemporaryDC)
EndMacro

Macro CopyMemoryToImage(Memory, imagenumber)
	TemporaryBitmapInfo.BITMAPINFO
	TemporaryDC = CreateDC_("DISPLAY", #Null, #Null, #Null)
	GetObject_(ImageID(imagenumber), SizeOf(BITMAP), TemporaryBitmap.BITMAP)
	TemporaryBitmapInfo\bmiHeader\biSize        = SizeOf(BITMAPINFOHEADER)
	TemporaryBitmapInfo\bmiHeader\biWidth       = TemporaryBitmap\bmWidth
	TemporaryBitmapInfo\bmiHeader\biHeight      = -TemporaryBitmap\bmHeight
	TemporaryBitmapInfo\bmiHeader\biPlanes      = 1
	TemporaryBitmapInfo\bmiHeader\biBitCount    = 32
	TemporaryBitmapInfo\bmiHeader\biCompression = #BI_RGB
	SetDIBits_(TemporaryDC, ImageID(imagenumber), 0, TemporaryBitmap\bmHeight, Memory, TemporaryBitmapInfo.BITMAPINFO, #DIB_RGB_COLORS)
	DeleteDC_(TemporaryDC)
EndMacro

Structure ImageCodecInfo 
  clsid.CLSID
  formatID.GUID
  *codecName 
  *dllName 
  *formatDescription
  *filenameExtension
  *mimeType
  flags.l
  version.l
  sigCount.l
  sigSize.l
  *sigPattern.byte
  *sigMask.byte
EndStructure

Structure StreamObject
  block.l
  *bits
  stream.ISTREAM
EndStructure

CompilerIf Defined(GdiplusStartupInput, #PB_Structure) = 0
  Structure GdiplusStartupInput
    GdiPlusVersion.l
    *DebugEventCallback.Debug_Event
    SuppressBackgroundThread.l
    SuppressExternalCodecs.l
	EndStructure
CompilerEndIf
; 
Procedure.l ARGB(rgb.l, a.b = 255)
  !MOV eax, [p.v_rgb]
  !BSWAP eax 
  !SHR eax, 8 
  !MOV [p.v_rgb], eax 
  !MOV eax, [p.v_a]
  !MOV dword [p.v_rgb+3], eax
  ProcedureReturn rgb
EndProcedure

Procedure GetEncoderClsid(format$, *Clsid.CLSID)
  Protected number
  Protected Size 
  Protected *pImageCodecInfo.ImageCodecInfo 
  Protected i, *memory
  
  CallFunction(lib,"GdipGetImageEncodersSize",@number, @Size)
  If Size = 0
       ProcedureReturn -1
  EndIf
  
  *memory = AllocateMemory(Size)
  If *memory = #Null
    ProcedureReturn -1
  EndIf
  
  *pImageCodecInfo = *memory
  CallFunction(lib,"GdipGetImageEncoders",number, Size, *pImageCodecInfo)
  
  For i = 1 To number
    If format$ = PeekS(*pImageCodecInfo\MimeType, -1, #PB_Unicode)
      CopyMemory(*pImageCodecInfo\clsid, *Clsid, SizeOf(CLSID))
      FreeMemory(*memory)
      ProcedureReturn i 
    EndIf
    *pImageCodecInfo + SizeOf(ImageCodecInfo)
  Next
  FreeMemory(*memory)
  ProcedureReturn -1 
EndProcedure

ProcedureDLL ImageFromMem(Address, Length)
	Define.l *gfx
	Define.l Width ,Height ,Format ,bits_per_pixel ,imagenumber ,Retval ,hDC
	
  Define.GdiplusStartupInput input
	Define.streamobject stream
  input\GdiPlusVersion = 1
	
  CallFunction(lib, "GdiplusStartup", @*token, @input, #Null)
  If *token
		
    Stream\block = GlobalAlloc_(#GHND, Length)
    Stream\bits = GlobalLock_(Stream\block)
    CopyMemory(address, stream\bits, Length)
    If CreateStreamOnHGlobal_(stream\bits, 0, @Stream\stream) = #S_OK
      CallFunction(lib, "GdipCreateBitmapFromStream", Stream\stream , @*image)
      Stream\stream\Release()
      GlobalUnlock_(Stream\bits)
      GlobalFree_(Stream\block)
		Else
      CallFunction(lib, "GdiplusShutdown", *token)
      ProcedureReturn 0
		EndIf
		
    If *image
      CallFunction(lib, "GdipGetImageWidth", *image, @Width)
      CallFunction(lib, "GdipGetImageHeight", *image, @Height)
      CallFunction(lib, "GdipGetImagePixelFormat", *image, @Format)
			
      Select Format
				Case PixelFormat1bppIndexed: bits_per_pixel = 1
				Case PixelFormat4bppIndexed: bits_per_pixel = 4
				Case PixelFormat8bppIndexed: bits_per_pixel = 8
				Case PixelFormat16bppARGB1555: bits_per_pixel = 16
				Case PixelFormat16bppGrayScale: bits_per_pixel = 16
				Case PixelFormat16bppRGB555: bits_per_pixel = 16
				Case PixelFormat16bppRGB565: bits_per_pixel = 16
				Case PixelFormat24bppRGB: bits_per_pixel = 24
				Case PixelFormat32bppARGB: bits_per_pixel = 32
				Case PixelFormat32bppPARGB: bits_per_pixel = 32
				Case PixelFormat32bppRGB: bits_per_pixel = 32
				Case PixelFormat48bppRGB: bits_per_pixel = 48
				Case PixelFormat64bppARGB: bits_per_pixel = 64
				Case PixelFormat64bppPARGB: bits_per_pixel = 64
				Default : bits_per_pixel = 32
			EndSelect
			
      If bits_per_pixel < 24 : bits_per_pixel = 24 : EndIf
      imagenumber = CreateImage(#PB_Any, Width, Height, bits_per_pixel)
      Retval = ImageID(imagenumber)
      hDC = StartDrawing(ImageOutput(ImageNumber))
        CallFunction(lib, "GdipCreateFromHDC", hdc, @*gfx)
        CallFunction(lib, "GdipDrawImageRectI", *gfx, *image, 0, 0, Width, Height)
			StopDrawing()			
      ProcedureReturn Retval
		Else
      ProcedureReturn 0
		EndIf
	Else
    ProcedureReturn 0
	EndIf
	Debug imagenumber
	Debug Retval
EndProcedure

ProcedureDLL ImageFromFile(Filename$)
	Define.l *gfx
	Define.l Width ,Height ,Format ,bits_per_pixel ,imagenumber ,Retval ,hDC
	
  Define.GdiplusStartupInput input
	Define.streamobject stream
  input\GdiPlusVersion = 1
	
  CallFunction(lib, "GdiplusStartup", @*token, @input, #Null)
  If *token
    CallFunction(lib, "GdipLoadImageFromFile", @Filename$, @*image)
    CallFunction(lib, "GdipCreateBitmapFromFile", @Filename$, @*image)
    CallFunction(lib, "GdipGetImageWidth", *image, @Width.l)
    CallFunction(lib, "GdipGetImageHeight", *image, @Height.l)
    CallFunction(lib, "GdipGetImagePixelFormat", *image, @Format.l)
		
    Select Format
			Case PixelFormat1bppIndexed: bits_per_pixel = 1
			Case PixelFormat4bppIndexed: bits_per_pixel = 4
			Case PixelFormat8bppIndexed: bits_per_pixel = 8
			Case PixelFormat16bppARGB1555: bits_per_pixel = 16
			Case PixelFormat16bppGrayScale: bits_per_pixel = 16
			Case PixelFormat16bppRGB555: bits_per_pixel = 16
			Case PixelFormat16bppRGB565: bits_per_pixel = 16
			Case PixelFormat24bppRGB: bits_per_pixel = 24
			Case PixelFormat32bppARGB: bits_per_pixel = 32
			Case PixelFormat32bppPARGB: bits_per_pixel = 32
			Case PixelFormat32bppRGB: bits_per_pixel = 32
			Case PixelFormat48bppRGB: bits_per_pixel = 48
			Case PixelFormat64bppARGB: bits_per_pixel = 64
			Case PixelFormat64bppPARGB: bits_per_pixel = 64
			Default : bits_per_pixel = 32
		EndSelect
		
    If bits_per_pixel < 24 : bits_per_pixel = 24 : EndIf
       If Width <= 0 Or Height <= 0
           MessageRequester("Error","Format Not Supported",#MB_OK	|#MB_ICONERROR)
           Error = 1
           ProcedureReturn 0
       EndIf
    imagenumber = CreateImage(#PB_Any, Width, Height, bits_per_pixel)
    Retval = ImageID(imagenumber)
    hDC = StartDrawing(ImageOutput(ImageNumber))
    CallFunction(lib, "GdipCreateFromHDC", hdc, @*gfx)
    CallFunction(lib,"GdipGraphicsClear",*gfx, ARGB(GetSysColor_(#COLOR_BTNFACE), 255))
    CallFunction(lib, "GdipDrawImageRectI", *gfx, *image, 0, 0, Width, Height)
		StopDrawing()		
    ProcedureReturn imagenumber
	Else
    ProcedureReturn 0
	EndIf
EndProcedure

Procedure zRotateImage (DImage,SImage, xang.d, yang.d, zang.d, flength.d, zoom.d, destx.l, desty.l)
	Protected TemporaryBitmapInfo.BITMAPINFO, TemporaryBitmap.BITMAP ,PicDestDC.l,PicSrcDC.l ,BitCount ,Width,Height,LineWidth =0
	Define.l TemporaryDC
	Width = ImageWidth(SImage)
	Height = ImageHeight(SImage)
	Define.l x, y, i, j, tx, ty
	Define.d ox, oy
	Define.d nx, ny, nz
	Define.d tmp
	Define.l xw = width>>1
	Define.l yh = height>>1
	Define.d ThetaX = xang/180.0*#PI
	Define.d ThetaY = yang/180.0*#PI
	Define.d ThetaZ = zang/180.0*#PI
	Define.d cx = Cos(ThetaX)
  Define.d cy = Cos(ThetaY)
  Define.d cz = Cos(ThetaZ)
  Define.d sx = Sin(ThetaX)
  Define.d sy = Sin(ThetaY)
  Define.d sz = Sin(ThetaZ)
	Define.d xx = cy*cz
	Define.d xy = sx*sy*cz - cx*sz
	Define.d yx = cy*sz
	Define.d yy = cx*cz + sx*sy*sz
	Define.d zx = -sy
	Define.d zy = sx*cy
	
	LineWidth = Width * 4

	BitCount = LineWidth * Height
	Dim Bits.a (BitCount)
	CopyImageToMemory(SImage, @Bits())
	Dim Newbits.a (BitCount)
	
	For y = height-1 To 0 Step -1
		oy = y-yh 	
		For x = width-1 To 0 Step -1
			i = y * LineWidth + 4 * x
			ox = x-xw
			nx = ox*xx + oy*xy
			ny = ox*yx + oy*yy
			nz = ox*zx + oy*zy
			
			If nz-zoom >= 0.0
				tmp = flength/(nz-zoom)
				ty=ny*tmp+desty
				tx=nx*tmp+destx
				If tx >= 0 And tx < width And ty >= 0 And ty < height
					j = ty * LineWidth + 4 * tx
					NewBits(j+2) = Bits(i+2)
					NewBits(j+1) = Bits(i+1)
					NewBits( j ) = Bits( i )
				EndIf
			EndIf
		Next
	Next
	CopyMemoryToImage(@NewBits(), DImage)
EndProcedure

Procedure Load_Image()
	SetGadgetState(TrackBar,0)
  If IsImage(0)
    FreeImage(0)
  EndIf
   FileName$ = OpenFileRequester("SELECT IMAGE","", "All supported formats|*.bmp;*.rle;*.ico;*.cur;*.gif;*.jpg;*.jpeg;*.wmf;*.emf; *.png;*.tif;*.tiff;*.tga|TGA image (*.tga)|*.tga|TIF image (*.tif)|*.tif|TIFF image (*.tiff)|*.tiff|PNG image (*.png)|*.png|BMP image (*.bmp)|*.bmp|RLE image(*.rle)|*.rle|Icon file (*.ico)|*.ico|Cursor file (*.cur)|*.cur|JPEG image (*.jpg;*.jpeg)|*.jpg;*.jpeg|GIF image (*.gif)|*.gif|Windows Metafile (*.wmf)|*.wmf|Enhanced Metafile (*.emf)|*.emf",0)
	If FileName$
	  SetWindowTitle(win,"RASHAD "+Chr(174)+"  "+FileName$)
	  If GetExtensionPart(FileName$) = "tga"
	    SCR_Image = LoadImage(#PB_Any,FileName$)
	  Else
		  SCR_Image=ImageFromFile(Filename$)
		EndIf
		If IsImage(SCR_Image)
			If IsImage(DES_Image)
				FreeImage(DES_Image)
			EndIf
			DES_Image=CreateImage(#PB_Any,ImageWidth(SCR_Image), ImageHeight(SCR_Image),#bpp)  			
			CallFunction(lib,"GdipCreateBitmapFromHBITMAP", ImageID(SCR_Image), 0, @lBitmap)  			
			ResizeGadget(Image,WindowWidth(win)/2-ImageWidth(DES_Image)/2-75,WindowHeight(win)/2-ImageHeight(DES_Image)/2-15,ImageWidth(DES_Image),ImageHeight(DES_Image))
		  SetGadgetAttribute(Image,#PB_Button_Image, ImageID(SCR_Image))
		EndIf
	EndIf
EndProcedure

win = OpenWindow(#PB_Any, 0, 0, 800, 650,"RASHAD "+Chr(174), #PB_Window_ScreenCentered|#PB_Window_SystemMenu| #PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget| #PB_Window_SizeGadget )
WindowBounds(win ,800, 600,#PB_Ignore,#PB_Ignore)
SetWindowColor(win,$D1D1C6)
Menu = CreateMenu(#PB_Any, WindowID(win));, #PB_Menu_ModernLook)
If Menu
  MenuTitle( "File" )
    MenuItem(1,"New" )
		MenuItem(2,"Load Image" )
	  MenuBar() 
		MenuItem(3, "Quit" )
EndIf

Image = CanvasGadget(#PB_Any,10,10,WindowWidth(win)-90,WindowHeight(win)-50)
SetGadgetAttribute(Image, #PB_Button_Image,0)

TrackBar = TrackBarGadget(#PB_Any, 760, 10, 26, 600, 0, 359, #PB_TrackBar_Vertical)
 
Repeat	
	Select WaitWindowEvent(1)
      
	  Case #PB_Event_CloseWindow
      Quit = 1
      
    Case #PB_Event_Gadget
      Select EventGadget()
        Case TrackBar
          xang.d = - GetGadgetState(TrackBar)
          zRotateImage(DES_Image, SCR_Image, xang.d, -359, -359, 400, -512, ImageWidth(SCR_Image)/2,ImageHeight(SCR_Image)/2)
          nDes_Image = CopyImage_(ImageID(DES_Image),#IMAGE_BITMAP	,ImageWidth(DES_Image) ,ImageHeight(DES_Image),0)
          ResizeGadget(Image,WindowWidth(win)/2-ImageWidth(DES_Image)/2-75,WindowHeight(win)/2-ImageHeight(DES_Image)/2-15,ImageWidth(DES_Image),ImageHeight(DES_Image))
          SetGadgetAttribute(Image,#PB_Button_Image,nDes_Image)
          CallFunction(lib,"GdipCreateBitmapFromHBITMAP", ImageID(DES_Image), 0, @lBitmap)
      EndSelect

		Case #PB_Event_Menu
		  Select EventMenu()
		    Case 1
		    Case 2
		      Load_Image()		      
		    Case 3
		      Quit = 1
		      
		  EndSelect			
	EndSelect	
Until Quit = 1

CallFunction(lib, "GdipDeleteGraphics", *gfx)
CallFunction(lib, "GdipDisposeImage", *image)
CallFunction(lib, "GdiplusShutdown", *token)
CloseLibrary(lib)

End

[Trond]

The problem with the original code is that it doesn't rotate around the center of the plane. That's why it doesn't look realistic.

[Mijikai]

Can u use OpenGL ?

Code: Select all

glTranslatef_(X + TextureCenterX,Y + TextureCenter\Y,0)
glRotatef_(Angle,XR,YR,ZR)
;...

[Michael Vogel]

Thanks all, need some time to check all of your input, meanwhile I was thinking about juggling with pixel arrays (CopyImageToMem, CopyMemToImage) and tried to find out more details where the data is squeezed in a linear form (x) and where not (y), because my first attempt was to shrink the image sizes by a fixed ratio.

3D transformation to screen:

[Michael Vogel]

Did the math to create a transformation matrix o(x,y).Point where x and y are the coordinates for the original image and the point structure are x and y for the pixel position of the rotated image.

Some remarks:
_Od is the distance from the object to the display and _Vd the distance between display and the viewer. _Oh and _Ow are the image dimension.
There are some stripes seen now, have to be checked (maybe because I'm using integers only)
Everything is extremly slow (think this is because plotting each pixel, I hope everything will speed up when pokeing the pixels into an image memory)

Code: Select all

; Define 3D Constants

	Global _Od=300
	Global _Vd=800
	Global _Oh=256
	Global _Ow=256

	Global Dim o.Point(_Ow,_Oh)
	Global Dim c(_Ow,_Oh)

; EndDefine

Macro Rad(a)
	(a*#PI/180)
EndMacro
Procedure DrawObject(a)

	Protected _sin
	Protected _cos

	_cos=_Oh/2*Cos(Rad(a))
	_sin=_Oh/2*Sin(Rad(a))

	Protected w=_Ow/2
	Protected h=_Oh/2

	_Td=_Od+_Vd

	For y=-h To h
		z=_Td+_cos*y/h
		_y=_Vd*_sin*y/h/z*_Td/_Vd
		For x=-w To w
			_x=_Vd*x/z*_Td/_Vd
			o(x+w,y+h)\x=_x
			o(x+w,y+h)\y=_y
		Next x
	Next y


EndProcedure

CreateImage(1, 256, 256)
StartDrawing(ImageOutput(1))
DrawingMode(#PB_2DDrawing_AllChannels)
Box(0, 0, 256, 256, $FF808080)
For x = 0 To 7
	For y = x&1 To 7 Step 2
		Box(x*32, y*32, 32,32, $FFe0e0e0)
	Next
Next
DrawingMode(#PB_2DDrawing_AlphaBlend)
For i=0 To 33
	Circle(Random(240),Random(240),Random(40),$60000000|Random(#White))
Next i

For x=0 To _Ow-1
	For y=0 To _Oh-1
		c(x,y)=Point(x,y)
	Next y
Next x
StopDrawing()

Global MaxWidth=300
Global MaxHeight=300
CreateImage(2,MaxWidth,MaxHeight,32)

Procedure TransformImage(Source,Destination,Width,Height,Distortion)

	Protected x,y,w,h

	#Temp=0
	#Tamp=9

	w=ImageWidth(Source)
	h=ImageHeight(Source)

	CopyImage(Source,#Tamp)
	ResizeImage(#Tamp,w,Height)

	If Distortion>0
		ws=Width-Distortion<<1
		we=Distortion
	Else
		ws=Width
		we=0
	EndIf

	we=(MaxWidth-ws)/2
	top=(h-height)/2+50

	StartDrawing(ImageOutput(Destination))
	Box(1,1,MaxWidth-2,MaxHeight-2,#White)
	For i=0 To Height-1
		GrabImage(#Tamp,#Temp,0,i,w,1)
		d=i*Distortion/height
		ResizeImage(#Temp,ws+d<<1,1)
		DrawImage(ImageID(#Temp),we-d,top+i)
	Next i
	StopDrawing()

EndProcedure


OpenWindow(0, 0, 0, 800, 600, "Screen", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
CanvasGadget(0,0,0,800,600)
AddWindowTimer(0,0,20)


Repeat

	Select WaitWindowEvent(25)
	Case #PB_Event_CloseWindow,#WM_CHAR : End
	Case #PB_Event_Timer
		n+1
		y=Sin(n/10)*150
		If y<0
			y=-y
			z=-1
		Else
			z=1
		EndIf
		y+2
		x=Cos(n/10)*50
		TransformImage(1,2,300-y,y,x*z)
		StartDrawing(CanvasOutput(0))
		Box(0,0,500,500,#White)

		;DrawingMode(#PB_2DDrawing_AlphaBlend)
		DrawObject(n*6.28)
		For x=0 To _Ow-1
			For y=0 To _Oh-1
				Plot(o(x,y)\x+200,o(x,y)\y+300,$f0000000|c(x,y))
			Next y
		Next x

		DrawAlphaImage(ImageID(2),400,100)
		StopDrawing()

	EndSelect
ForEver

[wilbert]

Division is a slow operation.
Try to avoid it as much as possible in loops if speed is important.
In this case

Code: Select all

For x=-w To w
  _x=_Vd*x/z*_Td/_Vd
  o(x+w,y+h)\x=_x
  o(x+w,y+h)\y=_y
Next x

the only value that changes is x so to get _x you could simple multiply x with a precalculated value.

[Michael Vogel]

Too bad I am using integers, so it's a big difference between a/b*c and a*c/b!
The stripes are (nearly) gone now, so an effect similar to moiree is seen...

...and of course, no optimization is done for now.

Code: Select all

; Define 3D Constants

	Global _Od=300
	Global _Vd=200
	Global _Oh=256
	Global _Ow=256

	Global Dim o.Point(_Ow,_Oh)
	Global Dim c(_Ow,_Oh)

; EndDefine

Macro Rad(a)
	(a*#PI/180)
EndMacro
Procedure DrawObject(a)

	Protected _sin
	Protected _cos

	_cos=_Oh/2*Cos(Rad(a))
	_sin=_Oh/2*Sin(Rad(a))

	Protected w=_Ow/2
	Protected h=_Oh/2

	_Td=_Od+_Vd

	For y=-h To h
		z=_Vd*(_Td+_cos*y/h)
		_y=_Vd*_sin*y*_Td/h/z
		For x=-w To w
			_x=_Vd*x*_Td/z
			o(x+w,y+h)\x=_x
			o(x+w,y+h)\y=_y
		Next x
	Next y

	
EndProcedure

CreateImage(1, 256, 256)
StartDrawing(ImageOutput(1))
DrawingMode(#PB_2DDrawing_AllChannels)
Box(0, 0, 256, 256, $FF808080)
For x = 0 To 7
	For y = x&1 To 7 Step 2
		Box(x*32, y*32, 32,32, $FFe0e0e0)
	Next
Next
DrawingMode(#PB_2DDrawing_AlphaBlend)
For i=0 To 33
	Circle(Random(240),Random(240),Random(40),$60000000|Random(#White))
Next i

For x=0 To _Ow-1
	For y=0 To _Oh-1
		c(x,y)=Point(x,y)
	Next y
Next x
StopDrawing()

Global MaxWidth=300
Global MaxHeight=300
CreateImage(2,MaxWidth,MaxHeight,32)

Procedure TransformImage(Source,Destination,Width,Height,Distortion)

	Protected x,y,w,h

	#Temp=0
	#Tamp=9

	w=ImageWidth(Source)
	h=ImageHeight(Source)

	CopyImage(Source,#Tamp)
	ResizeImage(#Tamp,w,Height)

	If Distortion>0
		ws=Width-Distortion<<1
		we=Distortion
	Else
		ws=Width
		we=0
	EndIf

	we=(MaxWidth-ws)/2
	top=(h-height)/2+50

	StartDrawing(ImageOutput(Destination))
	Box(1,1,MaxWidth-2,MaxHeight-2,#White)
	For i=0 To Height-1
		GrabImage(#Tamp,#Temp,0,i,w,1)
		d=i*Distortion/height
		ResizeImage(#Temp,ws+d<<1,1)
		DrawImage(ImageID(#Temp),we-d,top+i)
	Next i
	StopDrawing()

EndProcedure


OpenWindow(0, 0, 0, 800, 600, "Screen", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
CanvasGadget(0,0,0,800,600)
AddWindowTimer(0,0,20)


Repeat

	Select WaitWindowEvent(25)
	Case #PB_Event_CloseWindow,#WM_CHAR : End
	Case #PB_Event_Timer
		n+1
		y=Sin(n/10)*150
		If y<0
			y=-y
			z=-1
		Else
			z=1
		EndIf
		y+2
		x=Cos(n/10)*50
		TransformImage(1,2,300-y,y,x*z)
		StartDrawing(CanvasOutput(0))
		Box(0,0,500,500,#White)

		;DrawingMode(#PB_2DDrawing_AlphaBlend)
		DrawObject(n*6.28)
		For x=0 To _Ow-1
			For y=0 To _Oh-1
				Plot(o(x,y)\x+200,o(x,y)\y+300,$f0000000|c(x,y))
			Next y
		Next x

		DrawAlphaImage(ImageID(2),400,100)
		StopDrawing()
		
	EndSelect
ForEver