Rutt Etra Izer Effect v0.7

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
UEZ
Posts: 336
Joined: May 05, 2017 19:59
Location: Germany

Rutt Etra Izer Effect v0.7

Postby UEZ » Apr 22, 2019 18:05

Here another graphical example to display an image using the Rutt Etra Izer video effect.

If you want to use the predefined image settings than you need first the image. Copy / paste the code to your editor and run it. It will convert the JPG to BMP format and save it to disk (Windows only!). Put it to the same folder as Rutt_Etra_Izer_FX.bas below.

ExtractTestImage.bas

Otherwise you must adjust the settings within the code to run it properly.

Rutt_Etra_Izer_FX.bas

Code: Select all

'Coded by UEZ v0.7 build 2019-04-24
'Thanks to eukalyptus for the fast ASM sin / cos functions and vdecampo for the DrawAALine function

#Include "fbgfx.bi"

Using FB

Declare Function _ASM_Sin6th(fX As Double) As Double
Declare Function _ASM_Cos6th(fX As Double) As Double
Declare Sub Translate3Dto2D(fXin As Single, fYin As Single, fZin As Single, _            
               fRotX As Single, fRotY As Single, fRotZ As Single, _
               Byref xout As Single, Byref yout As Single, _
               fCenterX  As Single = 0, fCenterY As Single = 0.0, _
               fScale As Single = 1.0, fZDeepCorrection As Single = 1000.0)
Declare Function ipart(x As Single) As Integer
Declare Function round(x As Single) As Integer
Declare Function fpart(x As Single) As Single
Declare Function rfpart(x As Single) As Single
Declare Sub Plot(x As Short, y As Short, baseclr As Ulong, c As Single)
Declare Sub DrawAALine(x0 As Single,y0 As Single,x1 As Single,y1 As Single, clr As Ulong)

#Define _GetPixel(_x, _y)      *Cptr(Ulong Ptr, imgData + (_y) * pitch + (_x) Shl 2)
#Define _SetPixel(_x, _y, iCol)   *Cptr(Ulong Ptr, imgData + (_y) * pitch + (_x) Shl 2) = (iCol)
#Define _Red(iCol)            ((iCol And &hFF0000) Shr 16)      
#Define _Green(iCol)         ((iCol And &h00FF00) Shr 8)      
#Define _Blue(iCol)            ((iCol And &h0000FF))      
#Define _Max(a, b)            (Iif(a > b, a, b))            
#Define _Min(a, b)            (Iif(a < b, a, b))   

            
Dim As Any Ptr pBitmap, pImage
Dim Shared As Integer pitch, pitch2
Dim Shared As Any Pointer imgData, imgData2
Dim Shared As Ushort sw = 1200, sh = 800, bAA = 0
Dim As UShort iw, ih, wh, hh, swh = sw \ 2, shh = sh \ 2, cx, cy, iStepX = 4, iStepY = 4, x, y
Dim As String sImage = "Panda_800x800.bmp"

iw = 800
ih = 800

Screenres sw, sh, 32, 2
Screenset 1, 0

Windowtitle "Rutt Etra Izer Effect v0.7 by UEZ"

pBitmap = Imagecreate(iw, ih, 0, 32)
Bload sImage, pBitmap
Imageinfo(pBitmap, , , , pitch, imgData)
pImage = Imagecreate(sw, sh, 0, 32)
Imageinfo(pImage, , , , pitch2, imgData2)

cx = (sw - iw) \ 2
cy = (sh - ih) \ 2


Type vec4
   As Single x, y, z
   As Ulong col
End Type

Dim As Ushort iUBY = ih \ iStepY + 1, iUBX = iw \ iStepX + 1, xx = 0, yy = 0

wh = iw \ 2
hh = ih \ 2
Dim As vec4 aPixels(iUBY, iUBX)
For y = 0 To ih - 1 Step iStepY
   For x = 0 To iw - 1 Step iStepX
      aPixels(yy, xx).x = x - wh
      aPixels(yy, xx).y = y - hh
      aPixels(yy, xx).col = _GetPixel(x, y)
      aPixels(yy, xx).z = 255 - (_Red(aPixels(yy, xx).col) + _Green(aPixels(yy, xx).col) + _Blue(aPixels(yy, xx).col)) / 6
      xx += 1
   Next
   yy += 1
   xx = 0
Next

Dim As Single px1, py1, px2, py2, fPi = Acos(-1), fSpeed = fPi / (8 * 180), fAngle = 0, f2Pi = 2 * fPi, xr, yr, xrot, yrot, dx = cx + wh, dy = cy + hh, fScale = 1.0, s
Dim As Integer mx, my, mb, mw, mc, mwo, mxo, myo
Dim As Ushort iFPS = 0, iFPS_current = 0

Dim As Double fTimer = Timer


Do
   Line pImage, (0, 0) - (sw - 1, sh - 1), Rgba(0, 0, 0, 200), BF 'clear image
   
   'helper lines
   'Line pImage, (0, shh) - (sw, shh), Rgba(64, 64, 64, 192)
   'Line pImage, (swh, 0) - (swh, sh), Rgba(64, 64, 64, 192)
   
   Getmouse mx, my, mw, mb, mc
   
   If mb = 1 And (mx <> mxo Or my <> myo) Then
      xrot = -(mx / sw) * f2Pi + fPi
      yrot = (my / sh) * f2Pi + fPi
      mxo = mx
      myo = my
   Elseif mb = 2 Then
      xrot = 0
      yrot = 0
   End If
   
   If mc = 0 Then mwo = mw
   s = _Min(_Max(fScale + Iif(mc = -1, mwo, mw) / 20, 0.1), 4) 'scale factor
      
   For y = 0 To Ubound(aPixels) - 1
      For x = 1 To Ubound(aPixels, 2) - 2
         Translate3Dto2D(aPixels(y, x - 1).x, aPixels(y, x - 1).y, aPixels(y, x - 1).z,    yrot, -xrot, 0, px1, py1, dx, dy, s)
         Translate3Dto2D(aPixels(y, x).x,     aPixels(y, x).y,      aPixels(y, x).z,       yrot, -xrot, 0, px2, py2, dx, dy, s)
         If bAA Then
            DrawAALine(px1, py1, px2, py2, aPixels(y, x).col)
         Else
            Line pImage, (px1, py1)-(px2, py2),  aPixels(y, x).col
         End If
      Next
   Next
   
   Put (0, 0), pImage, Pset
   Draw String(1, 1), iFPS_current & " fps", Rgb(&h00, &hFF, &h00)
   Flip

   If Timer - fTimer > 0.99 Then
      iFPS_current = iFPS
      iFPS = 0
      fTimer = Timer
   Else
      iFPS += 1
   Endif
   
   Sleep(10, 1)
Loop Until Inkey = Chr(27)

Imagedestroy pBitmap
Imagedestroy pImage


Sub Translate3Dto2D(fXin As Single, fYin As Single, fZin As Single, _            
               fRotX As Single, fRotY As Single, fRotZ As Single, _
               Byref xout As Single, Byref yout As Single, _
               fCenterX  As Single = 0, fCenterY As Single = 0, _
               fScale As Single = 1.0, fZDeepCorrection As Single = 1000.0)
                   
   Dim As Single fCosRotX, fSinRotX, fCosRotY, fSinRotY, fCosRotZ, fSinRotZ, f1, f2, f3, f4, f5, f6, fXPos, fYPos, fZPos, fZPerspCorrection

   fCosRotX = _ASM_Cos6th(fRotX)
   fSinRotX = _ASM_Sin6th(fRotX)
   fCosRotY = _ASM_Cos6th(fRotY)
   fSinRotY = _ASM_Sin6th(fRotY)
   fCosRotZ = _ASM_Cos6th(fRotZ)
   fSinRotZ = _ASM_Sin6th(fRotZ)

   f1 = fCosRotY * fXin
   f2 = fSinRotX * fYin
   f3 = fCosRotX * fZin
   f4 = fCosRotX * fYin
   f5 = fSinRotX * fZin
   f6 = f1 - fSinRotY * (f2 + f3)
   fXPos = (fCosRotZ * f6 - fSinRotZ * (f4 - f5)) * fScale
   fYPos = (fSinRotZ * f6 + fCosRotZ * (f4 - f5)) * fScale
   fZPos = (fSinRotY * fXin + fCosRotY * (f2 + f3)) * fScale
   
   fZPerspCorrection = 1 / (fZPos / fZDeepCorrection + 1)
   
   xout = fXPos * fZPerspCorrection + fCenterX
   yout = fYPos * fZPerspCorrection + fCenterY
   'fZ = fZPos
End Sub

Function _ASM_Sin6th(fX As Double) As Double
   'By Eukalyptus
   Asm
      jmp 0f
      1: .Double 683565275.57643158
      2: .Double -0.0000000061763971109087229
      3: .Double 6755399441055744.0
       
      0:
         movq xmm0, [fX]
         mulsd xmm0, [1b]
         addsd xmm0, [3b]
         movd ebx, xmm0

         lea  eax, [ebx*2+0x80000000]
         sar  eax, 2
         imul eax
         sar  ebx, 31
         lea  eax, [edx*2-0x70000000]
         lea  ecx, [edx*8+edx-0x24000000]
         imul edx
         Xor  ecx, ebx
         lea  eax, [edx*8+edx+0x44A00000]
         imul ecx

         cvtsi2sd xmm0, edx
         mulsd xmm0, [2b]
         movq [Function], xmm0
   End Asm
End Function

Function _ASM_Cos6th(fX As Double) As Double
   'By Eukalyptus
   Asm
      jmp 0f
      1: .Double 683565275.57643158
      2: .Double -0.0000000061763971109087229
      3: .Double 6755399441055744.0

      0:
         movq xmm0, [fX]
         mulsd xmm0, [1b]
         addsd xmm0, [3b]
         movd ebx, xmm0

         Add ebx, 0x40000000 'SinToCos

         lea  eax, [ebx*2+0x80000000]
         sar  eax, 2
         imul eax
         sar  ebx, 31
         lea  eax, [edx*2-0x70000000]
         lea  ecx, [edx*8+edx-0x24000000]
         imul edx
         Xor  ecx, ebx
         lea  eax, [edx*8+edx+0x44A00000]
         imul ecx

         cvtsi2sd xmm0, edx
         mulsd xmm0, [2b]
         movq [Function], xmm0
   End Asm
End Function


/'
https://www.freebasic.net/forum/viewtopic.php?t=24443#p216462

Xiaolin Wu's line algorithm

An algorithm for line antialiasing,
which was presented in the article
an efficient antialiasing technique
in the July 1991 issue of Computer
Graphics, as well as in the article
Fast Antialiasing in the June 1992
issue of Dr. Dobb's Journal.
'/

'// Integer part of x
Function ipart(x As Single) As Integer
    Return Int(x)
End Function

Function round(x As Single) As Integer
    Return ipart(x + 0.5)
End Function

' fractional part of x
Function fpart(x As Single) As Single
    If x < 0 Then Return 1 - (x - Fix(x))
    Return x - Fix(x)
End Function

Function rfpart(x As Single) As Single
    Return 1 - fpart(x)
End Function

Sub Plot(x As Short, y As Short, baseclr As Ulong, c As Single)
   baseclr = (_Red(baseclr) * c) Shl 16 Or (_Green(baseclr) * c) Shl 8 Or (_Blue(baseclr) * c) Shl 0
    *Cptr(Ulong Ptr, imgData2 + (Iif(y < 0, 0, Iif(y > sh - 1, sh - 1, y))) * pitch2 + (Iif(x < 0, 0, Iif(x > sw - 1, sw - 1, x))) Shl 2) = baseclr
End Sub
   
Sub DrawAALine(x0 As Single,y0 As Single,x1 As Single,y1 As Single, clr As Ulong)
   Dim As Integer steep = Abs(y1 - y0) > Abs(x1 - x0)
   Dim As Single dx,dy,gradient,xend,yend,xgap,xpxl1,ypxl1,xpxl2,ypxl2,intery
   
    If steep Then
        Swap x0, y0
        Swap x1, y1
    End If
   
    If x0 > x1 Then
        Swap x0, x1
        Swap y0, y1
    End If
   
    dx = x1 - x0
    dy = y1 - y0
    gradient = dy / dx
   
    ' handle first endpoint
    xend = round(x0)
    yend = y0 + gradient * (xend - x0)
    xgap = rfpart(x0 + 0.5)
   
    xpxl1 = xend ' This will be used in the main Loop
    ypxl1 = ipart(yend)
   
    If steep Then
        plot(ypxl1,   xpxl1, clr, rfpart(yend) * xgap)
        plot(ypxl1+1, xpxl1, clr,  fpart(yend) * xgap)
    Else
        plot(xpxl1, ypxl1  , clr, rfpart(yend) * xgap)
        plot(xpxl1, ypxl1+1, clr,  fpart(yend) * xgap)
    End If
    intery = yend + gradient ' first y-intersection For the main Loop
   
    ' handle Second endpoint
    xend = round(x1)
    yend = y1 + gradient * (xend - x1)
    xgap = fpart(x1 + 0.5)
   
    xpxl2 = xend 'This will be used in the main Loop
    ypxl2 = ipart(yend)
   
    If steep Then
        plot(ypxl2  , xpxl2, clr, rfpart(yend) * xgap)
        plot(ypxl2+1, xpxl2, clr,  fpart(yend) * xgap)
    Else
        plot(xpxl2, ypxl2, clr,  rfpart(yend) * xgap)
        plot(xpxl2, ypxl2+1, clr, fpart(yend) * xgap)
    End If
   
    ' Line Loop
    For x As Integer = xpxl1 + 1 To xpxl2 - 1
      If steep Then
          plot(ipart(intery)  , x, clr, rfpart(intery))
          plot(ipart(intery)+1, x, clr,  fpart(intery))
      Else
          plot(x, ipart(intery), clr,  rfpart(intery))
          plot(x, ipart(intery)+1, clr, fpart(intery))
      End If
      intery = intery + gradient
    Next
   
End Sub


Image

To rotate the image hold lmb pressed and move your mouse. Mouse wheel will scale and rmb will reset the rotation.
Last edited by UEZ on Apr 24, 2019 7:21, edited 2 times in total.
counting_pine
Site Admin
Posts: 6170
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs

Re: Rutt Etra Izer Effect v0.6

Postby counting_pine » Apr 23, 2019 12:49

Wow, that's pretty cool.

What does the effect do? Is it giving a Z coordinate based on the colour value?
UEZ
Posts: 336
Joined: May 05, 2017 19:59
Location: Germany

Re: Rutt Etra Izer Effect v0.6

Postby UEZ » Apr 23, 2019 13:27

counting_pine wrote:Wow, that's pretty cool.

What does the effect do? Is it giving a Z coordinate based on the colour value?


Thank you for your feedback. :-)

Yes, the Z depth is the grey scale of the color. The Z depth can be adjusted by the divider. The less the divider is the more depth will be drawn. To invert the Z depth remove "255 -" in the appropriate line.

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 42 guests