Tile - the perspective way

Game development specific discussions.
leopardpm
Posts: 1795
Joined: Feb 28, 2009 20:58

Re: Tile - the perspective way

Post by leopardpm »

nice Dodicat! I like how the size of the circles change with perspective
Tourist Trap
Posts: 2958
Joined: Jun 02, 2015 16:24

Re: Tile - the perspective way

Post by Tourist Trap »

dodicat wrote:A grid, similar to tourist ...
My arms are detaching from my shoulders ;-) It's an amazing piece of art. I'll try to figure out how it works!

Any idea on how transform square to any quadrangle in a linear fashion, pixel -> pixel mapping ?
leopardpm
Posts: 1795
Joined: Feb 28, 2009 20:58

Re: Tile - the perspective way

Post by leopardpm »

without going through the code, and knowing Dodicat, he is probably 'just' rotating the end-points through 3D space... the 3D -> 2D(screen) function is pretty simple and fast.

just looked at the code... yeah, except he sets up everything with tricky vector stuff and matrix manipulations(i think!?)... I can never de-code his code...

here is a reference I use to plot 3D to 2D(screen): http://freespace.virgin.net/hugo.elias/ ... _to_2d.htm
there are alot of google hits on this as well
dodicat
Posts: 7983
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Tile - the perspective way

Post by dodicat »

The axial rotate is Rodriue's method.
Dot and cross products I am afraid.
It's the easiest way to do it.
Here are some actual coloured tiles.
But the method is not very analytical.

Code: Select all

Screen 20,32
dim as integer xres,yres
screeninfo xres,yres
#include "crt.bi"
Type sincos
    As Single s,c
End Type

Type v3
    As Single x,y,z
    As Ulong col
    Declare Property length As Single
    Declare Property unit As v3
    Declare Function AxialRotate(As v3,As sincos,As V3) As v3
    Declare Function perspective(eyepoint As v3) As v3
    #define vct Type<v3>
    #define dot *
    #define cross ^
End Type

Operator + (v1 As v3,v2 As v3) As v3
Return Type<v3>(v1.x+v2.x,v1.y+v2.y,v1.z+v2.z)
End Operator
Operator -(v1 As v3,v2 As v3) As v3
Return Type<v3>(v1.x-v2.x,v1.y-v2.y,v1.z-v2.z)
End Operator
Operator * (f As Single,v1 As v3) As v3 
Return vct(f*v1.x,f*v1.y,f*v1.z)
End Operator
Operator *(v1 As v3,f As Single) As v3
Return f*v1
End Operator
Operator * (v1 As v3,v2 As v3) As Single 'dot product
Return v1.x*v2.x+v1.y*v2.y+v1.z*v2.z
End Operator
Operator ^ (v1 As v3,v2 As v3) As v3     'cross product
Return Type<v3>(v1.y*v2.z-v2.y*v1.z,-(v1.x*v2.z-v2.x*v1.z),v1.x*v2.y-v2.x*v1.y)
End Operator
Operator /(v1 As v3,n As Single) As v3
Return Type<v3>(v1.x/n,v1.y/n,v1.z/n)
End Operator

Property v3.length As Single
Return Sqr(this.x*this.x+this.y*this.y+this.z*this.z)
End Property

Property v3.unit As v3 'normalize
Dim n As Single=this.length
If n=0 Then n=1e-20
Return This/n
End Property

Function v3.AxialRotate(centre As v3,Angle As sincos,norm As V3) As v3
    Dim As v3 V=This-centre
    Var ret= (V*angle.C+(Norm cross V)*angle.S+Norm*(Norm dot V)*(1-angle.c))+centre 
    Return vct(ret.x,ret.y,ret.z,col)
End Function

Function v3.perspective(eyepoint As v3) As v3
    Dim As Single   w=1+(this.z/eyepoint.z)
    If w=0 Then w=1e-20
    Var ret= eyepoint+(This-eyepoint)/w
    Return vct(ret.x,ret.y,ret.z,col)
End Function

Function Regulate(Byval MyFps As long,Byref fps As long) As long
    Static As Double timervalue,lastsleeptime,t3,frames
    Dim As Double t=Timer
    frames+=1
    If (t-t3)>=1 Then t3=t:fps=frames:frames=0
    Dim As long sleeptime=lastsleeptime+((1/myfps)-T+timervalue)*1000
    If sleeptime<1 Then sleeptime=1
    lastsleeptime=sleeptime
    timervalue=T
    Return sleeptime
End Function

Sub drawarray(a() As V3) 'draw the lines only
    For n As long=Lbound(a) To Ubound(a)-2 Step 2
        if n<> ubound(a)\2-1 then Line(a(n).x,a(n).y)-(a(n+1).x,a(n+1).y),rgb(0,0,1)
    Next n
End Sub
'========================================================
Redim As V3 pts()
Dim As double pi=4*Atn(1)

'create all the points
Dim As long ctr,fps,ctr2
Dim As Long k=400 'the z depth
redim as v3 c()
For n As long=1 To 200 Step 4
    ctr+=1
    k=-k
    Redim Preserve pts(1 To ctr)
    pts(ctr)=Type<V3>(20*ctr+10,yres/2,-k)
Next n
'the points are now on the horizontal plane

reDim As V3 rot(Lbound(pts) To Ubound(pts))

var tmp=ubound(pts)
'create another set, 90 degrees to first set, by rotating round the y axis
For n As long=Lbound(pts) To Ubound(pts)
    rot(n)=pts(n).axialrotate(Type(xres/2,yres/2,0),Type<sincos>(Sin(pi/2),Cos(pi/2)),Type<v3>(0,1,0))
    next n
redim as V3 T(1 to tmp*2)

'add the two sets into T()
memcpy(@T(1),@pts(1),(Ubound(pts)-Lbound(pts)+1)*Sizeof(V3))
memcpy(@T(Ubound(pts)),@rot(1),(Ubound(rot)-Lbound(rot)+1)*Sizeof(V3))

'temp set points vertical
dim as V3 temp(lbound(T) to ubound(T))

For n As long=Lbound(T) To Ubound(T)
    temp(n)=T(n).axialrotate(Type(xres/2,yres/2,0),Type<sincos>(Sin(pi/2),Cos(pi/2)),Type<v3>(1,0,0))
Next n
'get the centres of each tile for painting (not very scientific)
 for x as integer=215 to 800 step 40
     for y as integer=30+80 to 600+80 step 40
         ctr2+=1
         redim preserve c(1 to ctr2)
         c(ctr2)=type<V3>(x,y,0)
     next y
 next x

 'rotate the centres back to horizontal, give a random colour
 For n As long=Lbound(C) To Ubound(C)
    C(n)=C(n).axialrotate(Type(xres/2,yres/2,0),Type<sincos>(Sin(-pi/2),Cos(-pi/2)),Type<v3>(1,0,0))
    c(n).col=rgb(rnd*255,rnd*255,rnd*255)
Next n

Dim As v3 axis=(0,1,0)'now tilt this y axis forward
axis=axis.axialrotate(Type<v3>(0,0,0),Type<sincos>(Sin(.4),Cos(.4)),Type<v3>(1,0,0))
axis=axis.unit'normalize the new y axis

'tilt all the points the same angle as the y axis (above)
For n As long=Lbound(T) To Ubound(T)
    T(n)=T(n).axialrotate(Type(1024/2,768/2,0),Type<sincos>(Sin(.4),Cos(.4)),Type<v3>(1,0,0))
Next n
'and tilt the tile centres forward
for n as integer=1 to ubound(c)
 c(n)=c(n).axialrotate(Type(1024/2,768/2,0),Type<sincos>(Sin(.4),Cos(.4)),Type<v3>(1,0,0))
Next n   

'rot for the points,crot for the centres.
redim rot(lbound(t) to ubound(T)):redim crot(1 to ubound(c)) as V3
Dim As sincos ang
Dim As Single z
Do
    z+=.01
    ang=Type<sincos>(Sin(z),Cos(z))
    Screenlock
    Cls
    Draw String(50,50),"FPS = " &fps
    For n As long=Lbound(T) To Ubound(T)
        rot(n)=T(n).axialrotate(Type<v3>(xres\2,yres\2,0),ang,axis)
        rot(n)=rot(n).perspective(Type<v3>(xres\2,yres\2,900))'900 deep for the eyepoint
    Next n
    
    For n As long=Lbound(crot) To Ubound(crot)
        crot(n)=c(n).axialrotate(Type<v3>(xres\2,yres\2,0),ang,axis)
        crot(n)=crot(n).perspective(Type<v3>(xres\2,yres\2,900))'900 deep for the eyepoint
    Next n
    
    drawarray(rot())
    
    for n as integer=lbound(crot) to ubound(crot)
        paint(crot(n).x,crot(n).y),c(n).col,rgb(0,0,1)
        next n
    
    Screenunlock
    Sleep regulate(40,fps)
Loop Until inkey=chr(27)
Sleep



  
Tourist Trap
Posts: 2958
Joined: Jun 02, 2015 16:24

Re: Tile - the perspective way

Post by Tourist Trap »

dodicat wrote:The axial rotate is Rodriue's method.
I'll try all that. Sounds nice. Rodrigue rotation is a must you're right, and not so difficult. I've already used that some times ago.
dodicat
Posts: 7983
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Tile - the perspective way

Post by dodicat »

It's so easy, it's more or less a one liner
The statement here:
https://en.wikipedia.org/wiki/Rodrigues ... on_formula
and my statement in the function:
Var ret= (V*angle.C+(Norm cross V)*angle.S+Norm*(Norm dot V)*(1-angle.c))+centre
where angle.C is just cos(angle)
and
angle.s is just sin(angle)
and Norm is just (K) the unit vector pointing the axis direction.
Tourist Trap
Posts: 2958
Joined: Jun 02, 2015 16:24

Re: Tile - the perspective way

Post by Tourist Trap »

dodicat wrote:It's so easy, it's more or less a one liner
The statement here:
https://en.wikipedia.org/wiki/Rodrigues ... on_formula
and my statement in the function:
Var ret= (V*angle.C+(Norm cross V)*angle.S+Norm*(Norm dot V)*(1-angle.c))+centre
where angle.C is just cos(angle)
and
angle.s is just sin(angle)
and Norm is just (K) the unit vector pointing the axis direction.
Yes it's not very hard. But I have difficulties to do the 3D -> 2D final projection. When I had used rodrigues before, it was on 3D software (gmax). No projection was required. I'm so weak at projecting on screen that I use intersections, far more computations for cpu...
Tourist Trap
Posts: 2958
Joined: Jun 02, 2015 16:24

Re: Tile - the perspective way

Post by Tourist Trap »

Oh damn, I finally made it with this bilinear mapping. The formula was just a little huge. Anyway now, this part of the work is complete:

Code: Select all

'case_study-----------------------
'perspective transform of an image
'---------------------------------


const as string   imgFileName => "planet.bmp"
const as long     imgW          =>  200
const as long     imgH          =>  260
const as ulong    imgTransColor => rgb(255,0,255)

const as long     screenWidth   => 800
const as long     screenHeight  => 400

#include "fbgfx.bi"


declare sub BiLinearXY(byval Img   as fb.IMAGE ptr)

'(ui routine)
declare function DrawWindowFrame(byval as fb.IMAGE ptr) as fb.IMAGE ptr
declare sub DrawExitButton(byval as boolean=FALSE)
declare function TestFrameWorkForMouse() as boolean

type SCREENTEST extends OBJECT
    declare static sub TestScreen()
    static as integer  scrW
    static as integer  scrH
end type
type MOUSETEST extends SCREENTEST
    declare static function TestMouse() as long
    static as long  gmX
    static as long  gmY
    static as long  gmBtn
end type
type BUTTON extends MOUSETEST
    declare constructor()
    declare constructor(byval as long, _ 
                        byval as long, _ 
                        byval as long, _ 
                        byval as long, _ 
                        byval as string)
    declare property CenterXForText() as long
    declare property CenterYForText() as long
    declare property MouseClick() as boolean
    declare sub TestButton()
    declare sub DrawButton()
    static as long      fontWidth
    static as long      fontHeight
    static as double    clickDelay
        as long     _topLeftCornerX
        as long     _topLeftCornerY
        as long     _width
        as long     _height
        as string   _text
        as boolean  _mouseOver
        as boolean  _mouseClick
end type
dim as integer SCREENTEST.scrW       => -1
dim as integer SCREENTEST.scrH       => -1
sub SCREENTEST.TestScreen()
    screenInfo (SCREENTEST.scrW, SCREENTEST.scrH)
end sub
dim as long MOUSETEST.gmX       => -1
dim as long MOUSETEST.gmY       => -1
dim as long MOUSETEST.gmBtn     => -1
function MOUSETEST.TestMouse() as long
    '---->
    return getMouse (MOUSETEST.gmX, _ 
                     MOUSETEST.gmY, _ 
                     , _ 
                     MOUSETEST.gmBtn)
end function
dim as long     BUTTON.fontWidth   => 8
dim as long     BUTTON.fontHeight  => 8
dim as double   BUTTON.clickDelay  => 0.8
constructor BUTTON()
    BASE()
    '
   dim as integer scrW, scrH
   screenInfo  scrW, scrH
    with THIS
        ._topLeftCornerX    => scrW\3
        ._topLeftCornerY    => scrH\3
        ._width             => scrW\3
        ._height            => scrH\3
        ._text              => left("default button", _ 
                                    len("default button")*BUTTON.fontWidth\8)
        ._mouseOver         => FALSE
        ._mouseClick        => FALSE
    end with
end constructor
constructor BUTTON(byval TLCX  as long, _ 
                   byval TLCY  as long, _ 
                   byval W     as long, _ 
                   byval H     as long, _ 
                   byval Text  as string)
    BASE()
    '
    with THIS
        ._topLeftCornerX    => TLCX
        ._topLeftCornerY    => TLCY
        ._width             => W
        ._height            => H
        ._text              => left(Text, _ 
                                    len(Text)*BUTTON.fontWidth\8)
        ._mouseOver         => FALSE
        ._mouseClick        => FALSE
    end with
end constructor
property BUTTON.CenterXForText() as long
    '---->
    return THIS._topLeftCornerX + _
           ( THIS._width - len(THIS._text)*BUTTON.fontWidth )\2
end property
property BUTTON.CenterYForText() as long
    '---->
    return THIS._topLeftCornerY + _ 
           ( THIS._height - BUTTON.fontHeight )\2
end property
property BUTTON.MouseClick() as boolean
    '---->
    return (THIS._mouseOver and THIS._mouseClick)
end property
sub BUTTON.TestButton()
    static as double    clickTime
    if TIMER<(clickTime + BUTTON.clickDelay) then 
        if THIS._mouseOver=TRUE then THIS._mouseOver = FALSE
        exit sub
    else
        if THIS._mouseClick=TRUE then THIS._mouseClick = FALSE
    end if
    '
    THIS.TestMouse()
    '
    if THIS.gmX>=THIS._topLeftCornerX                   and _ 
       THIS.gmX<(THIS._topLeftCornerX + THIS._width)    and _ 
       THIS.gmY>=THIS._topLeftCornerY                   and _ 
       THIS.gmY<(THIS._topLeftCornerY + THIS._height)   then
        if THIS._mouseOver=FALSE then THIS._mouseOver = TRUE
        if THIS.gmBtn=+1    then
            if THIS._mouseClick=FALSE then 
                THIS._mouseClick    = TRUE
                clickTime           = TIMER
            end if
        else
            if THIS._mouseClick=TRUE then THIS._mouseClick = FALSE
        end if
    else
        if THIS._mouseOver=TRUE then THIS._mouseOver = FALSE
        if THIS._mouseClick=TRUE then THIS._mouseClick = FALSE
    end if    
end sub
sub BUTTON.DrawButton()
    THIS.TestButton()
    '
    dim as long x   = THIS._topLeftCornerX
    dim as long y   = THIS._topLeftCornerY
    dim as long w   = THIS._width
    dim as long h   = THIS._height
    dim as string t = THIS._text
    '
    dim as ulong bckgColor
    if  THIS._mouseClick    then
        bckgColor  = rgb(100,190,140)
    elseif THIS._mouseOver  then
        bckgColor  = rgb(100,100,160)
    else
        bckgColor  = rgb(100,100,100)
    end if
        '
    line (x,y)-step(w,h), , b
    line (x + 1,y + 1)-step(w - 1,h - 1), bckgColor, bf
    draw string (THIS.CenterXForText,THIS.CenterYForText), t
end sub


'-------------------------------------------
randomize TIMER
screenRes screenWidth, _ 
          screenHeight, _ 
          32, _ 
          1, _ 
          fb.GFX_NO_FRAME
'note:
'gfx screen should always be initialized before image creation

SCREENTEST.TestScreen()

dim as fb.IMAGE ptr drawingImg
dim as fb.IMAGE ptr clearDrawingImg
drawingImg      => DrawWindowFrame(drawingImg)
clearDrawingImg => DrawWindowFrame(clearDrawingImg)
dim as integer drawingZoneW
dim as integer drawingZoneH
imageInfo drawingImg, drawingZoneW, drawingZoneH

dim as fb.IMAGE ptr     tileImg
tileImg =>  imageCreate(imgW, imgH, imgTransColor, 32)
bLoad imgFileName, tileImg

dim as BUTTON   testBtn     => BUTTON(SCREENTEST.scrW - 480, _ 
                                      SCREENTEST.scrH - 320, _
                                      120, _ 
                                      12, _ 
                                      "Test")

'---------------main_loop---------------
dim as double   startTime
dim as double   endTime
dim as boolean  quitOrder   => FALSE
do
    SCREENTEST.TestScreen()
    MOUSETEST.TestMouse()
   quitOrder   = TestFrameWorkForMouse()

    screenLock
       cls
      imageInfo DrawWindowFrame(drawingImg), _ 
                  drawingZoneW, _ 
                  drawingZoneH
      DrawExitButton(quitOrder)
        
        put (060, 120), tileImg, TRANS
                
        testBtn.DrawButton()
        if testBtn.MouseClick then
            DrawWindowFrame(clearDrawingImg)
            draw string (10,54), "pixel transfer.."
                startTime   = TIMER
                BilinearXY(tileImg)
                endTime     = TIMER
            draw string (10,40),  "op. time="& str(cSng(endTime - startTime))
            if (endTime - startTime)>0.01 then 
                draw string (140,54), "slow"
            else
                draw string (140,54), "fast"
            end if
            get (04,28)-step(drawingZoneW - 1,drawingZoneH -1), drawingImg
        end if
        
   screenUnlock

   if quitOrder then 
        '(quit)
        imageDestroy tileImg
        imageDestroy drawingImg
        sleep 200
        end 0
    else
        '(standard delay)
        sleep 15
   end if
loop until inkey=chr(27)    

'(explicit clean up)
imageDestroy tileImg
imageDestroy drawingImg


'-------------program_termination-------------
sleep
end 0

'(ui)
function DrawWindowFrame(byval DrawingZone as fb.IMAGE ptr) as fb.IMAGE ptr
   line (00,00)-(SCREENTEST.scrW - 1, SCREENTEST.scrH - 1), _ 
         rgb(200,190,220), _ 
         bf
    for x as long = 0 to SCREENTEST.scrW\10
        line (04 + 4*x,04)-(SCREENTEST.scrW - 1 - 4, 24), _ 
             rgb(190 - x,200,090 + x), _ 
             bf
    next x
    for x as long = 0 to SCREENTEST.scrW\10
        line (04 + 2*x,24)-(SCREENTEST.scrW - 1 - 4 - 2*x, SCREENTEST.scrH - 1 - 4), _ 
             rgb(100 + x,100 + x\2,120 + x), _ 
             bf
    next x
    line (04,24)-(SCREENTEST.scrW - 1 - 4, 28), _ 
         rgb(200,200,220), _ 
         bf
   draw string (08,12), _ 
                "TEST FRAMEWORK FOR PERSPECTIVE - FB1.04" & _ 
                " (note: window not movable not resizable)", _ 
                rgb(030,050,140)
    if DrawingZone<>0 then
        put (04,28), DrawingZone, TRANS
    else
        DrawingZone = imageCreate(SCREENTEST.scrW - 8, _ 
                                  SCREENTEST.scrH - 32, _ 
                                  imgTransColor, _ 
                                  32)
    end if
    '
    '---->
    return DrawingZone
end function
sub DrawExitButton(byval QuitOrderSent as boolean=FALSE)
   line (SCREENTEST.scrW - 1 - 4 - 18, 5)-(SCREENTEST.scrW - 1 - 5, 22), _ 
         rgb(250,80,80), _ 
         bf
   draw string (SCREENTEST.scrW - 1 - 4 - 12,12), "X"
   if QuitOrderSent then
      line (SCREENTEST.scrW - 1 - 4 - 16, 7)- _ 
             (SCREENTEST.scrW - 1 - 6, 20), _ 
             rgb(140,120,080), _ 
             bf
   end if
end sub
function TestFrameWorkForMouse() _ 
                        as boolean
   dim as boolean QuitOrder
   if MOUSETEST.gmX>(SCREENTEST.scrW - 1 - 4 - 18) and _
      MOUSETEST.gmX<(SCREENTEST.scrW - 1 - 5) and _
      MOUSETEST.gmY>5 and _ 
      MOUSETEST.gmY<22 then
         if MOUSETEST.gmBtn=+1 then 
         QuitOrder = TRUE
         end if
   else
      QuitOrder = FALSE
   end if
   '---->
   return QuitOrder
end function

'***Bilinear stuff***
sub BiLinearXY(byval Img   as fb.IMAGE ptr)
    'original image rectangle
    dim as single   x0 = 0, y0 = 0
    dim as single   x1 = imgW - 1, y1 = 0
    dim as single   x2 = imgW - 1, y2 = imgH - 1
    dim as single   x3 = 0, y3 = imgH - 1
    'set up a new quadrangle
    dim as single   xA = x0 + imgW/2 + (rnd()*45 - 89), yA = y0 + (rnd()*85)
    dim as single   xB = x1 + imgW/2 + (rnd()*40 - 79), yB = y1 + (rnd()*20 - 40)
    dim as single   xC = x2 + imgW/2 + (rnd()*40 - 79), yC = y2 + (rnd()*20 - 40)
    dim as single   xD = x3 + imgW/2 + (rnd()*40 - 79), yD = y3 + (rnd()*20 - 40)
    '
    line (xA + 400,yA + 120)-(xB + 400,yB + 120), rgb(255,0,255)
    line step-(xC + 400,yC + 120)
    line step-(xD + 400,yD + 120)
    line step-(xA + 400,yA + 120)
    '
    dim as double   a
    dim as double   b
    dim as double   c
    dim as double   d
    dim as double   e
    dim as double   f
    dim as double   g
    dim as double   h
    '
    a   = ((((x3-x2)*xB+(x2-x3)*xA)*y2+((x1-x3)*xC+(x3-x1)*xA)*y1+((x3-x0)*xC+(x0-x3)*xB)*y0)*y3+(((x2-x1)*xD+(x1-x2)*xA)*y1+((x0-x2)*xD+(x2-x0)*xB)*y0)*y2+((x1-x0)*xD+(x0-x1)*xC)*y0*y1)/((((x1-x0)*x3+(x0-x1)*x2)*y2+((x0-x2)*x3+x1*x2-x0*x1)*y1+((x2-x1)*x3-x0*x2+x0*x1)*y0)*y3+(((x2-x1)*x3-x0*x2+x0*x1)*y1+((x0-x2)*x3+x1*x2-x0*x1)*y0)*y2+((x1-x0)*x3+(x0-x1)*x2)*y0*y1)
    b   = (((x1-x0)*x3*xC+(x0-x2)*x3*xB+(x2-x1)*x3*xA)*y3+((x0-x1)*x2*xD+(x2*x3-x0*x2)*xB+(x1*x2-x2*x3)*xA)*y2+((x1*x2-x0*x1)*xD+(x0*x1-x1*x3)*xC+(x1*x3-x1*x2)*xA)*y1+((x0*x1-x0*x2)*xD+(x0*x3-x0*x1)*xC+(x0*x2-x0*x3)*xB)*y0)/((((x1-x0)*x3+(x0-x1)*x2)*y2+((x0-x2)*x3+x1*x2-x0*x1)*y1+((x2-x1)*x3-x0*x2+x0*x1)*y0)*y3+(((x2-x1)*x3-x0*x2+x0*x1)*y1+((x0-x2)*x3+x1*x2-x0*x1)*y0)*y2+((x1-x0)*x3+(x0-x1)*x2)*y0*y1)
    c   = -(((x1-x0)*xC+(x0-x2)*xB+(x2-x1)*xA)*y3+((x0-x1)*xD+(x3-x0)*xB+(x1-x3)*xA)*y2+((x2-x0)*xD+(x0-x3)*xC+(x3-x2)*xA)*y1+((x1-x2)*xD+(x3-x1)*xC+(x2-x3)*xB)*y0)/((((x1-x0)*x3+(x0-x1)*x2)*y2+((x0-x2)*x3+x1*x2-x0*x1)*y1+((x2-x1)*x3-x0*x2+x0*x1)*y0)*y3+(((x2-x1)*x3-x0*x2+x0*x1)*y1+((x0-x2)*x3+x1*x2-x0*x1)*y0)*y2+((x1-x0)*x3+(x0-x1)*x2)*y0*y1)
    d   = -((((x0*x3-x0*x2)*xB+(x1*x2-x1*x3)*xA)*y2+((x0*x1-x0*x3)*xC+(x2*x3-x1*x2)*xA)*y1+((x1*x3-x0*x1)*xC+(x0*x2-x2*x3)*xB)*y0)*y3+(((x0*x2-x0*x1)*xD+(x1-x2)*x3*xA)*y1+((x0*x1-x1*x2)*xD+(x2-x0)*x3*xB)*y0)*y2+((x1-x0)*x2*xD+(x0-x1)*x3*xC)*y0*y1)/((((x1-x0)*x3+(x0-x1)*x2)*y2+((x0-x2)*x3+x1*x2-x0*x1)*y1+((x2-x1)*x3-x0*x2+x0*x1)*y0)*y3+(((x2-x1)*x3-x0*x2+x0*x1)*y1+((x0-x2)*x3+x1*x2-x0*x1)*y0)*y2+((x1-x0)*x3+(x0-x1)*x2)*y0*y1)   
    e   = ((((x2-x1)*y1+(x0-x2)*y0)*y2+(x1-x0)*y0*y1)*yD+(((x1-x3)*y1+(x3-x0)*y0)*y3+(x0-x1)*y0*y1)*yC+(((x3-x2)*y2+(x0-x3)*y0)*y3+(x2-x0)*y0*y2)*yB+(((x2-x3)*y2+(x3-x1)*y1)*y3+(x1-x2)*y1*y2)*yA)/((((x1-x0)*x3+(x0-x1)*x2)*y2+((x0-x2)*x3+x1*x2-x0*x1)*y1+((x2-x1)*x3-x0*x2+x0*x1)*y0)*y3+(((x2-x1)*x3-x0*x2+x0*x1)*y1+((x0-x2)*x3+x1*x2-x0*x1)*y0)*y2+((x1-x0)*x3+(x0-x1)*x2)*y0*y1)
    f   = -(((x1-x0)*x2*y2+(x0*x1-x1*x2)*y1+(x0*x2-x0*x1)*y0)*yD+((x0-x1)*x3*y3+(x1*x3-x0*x1)*y1+(x0*x1-x0*x3)*y0)*yC+((x2-x0)*x3*y3+(x0*x2-x2*x3)*y2+(x0*x3-x0*x2)*y0)*yB+((x1-x2)*x3*y3+(x2*x3-x1*x2)*y2+(x1*x2-x1*x3)*y1)*yA)/((((x1-x0)*x3+(x0-x1)*x2)*y2+((x0-x2)*x3+x1*x2-x0*x1)*y1+((x2-x1)*x3-x0*x2+x0*x1)*y0)*y3+(((x2-x1)*x3-x0*x2+x0*x1)*y1+((x0-x2)*x3+x1*x2-x0*x1)*y0)*y2+((x1-x0)*x3+(x0-x1)*x2)*y0*y1)
    g   = (((x1-x0)*y2+(x0-x2)*y1+(x2-x1)*y0)*yD+((x0-x1)*y3+(x3-x0)*y1+(x1-x3)*y0)*yC+((x2-x0)*y3+(x0-x3)*y2+(x3-x2)*y0)*yB+((x1-x2)*y3+(x3-x1)*y2+(x2-x3)*y1)*yA)/((((x1-x0)*x3+(x0-x1)*x2)*y2+((x0-x2)*x3+x1*x2-x0*x1)*y1+((x2-x1)*x3-x0*x2+x0*x1)*y0)*y3+(((x2-x1)*x3-x0*x2+x0*x1)*y1+((x0-x2)*x3+x1*x2-x0*x1)*y0)*y2+((x1-x0)*x3+(x0-x1)*x2)*y0*y1)
    h   = -((((x0*x2-x0*x1)*y1+(x0*x1-x1*x2)*y0)*y2+(x1-x0)*x2*y0*y1)*yD+(((x0*x1-x0*x3)*y1+(x1*x3-x0*x1)*y0)*y3+(x0-x1)*x3*y0*y1)*yC+(((x0*x3-x0*x2)*y2+(x0*x2-x2*x3)*y0)*y3+(x2-x0)*x3*y0*y2)*yB+(((x1*x2-x1*x3)*y2+(x2*x3-x1*x2)*y1)*y3+(x1-x2)*x3*y1*y2)*yA)/((((x1-x0)*x3+(x0-x1)*x2)*y2+((x0-x2)*x3+x1*x2-x0*x1)*y1+((x2-x1)*x3-x0*x2+x0*x1)*y0)*y3+(((x2-x1)*x3-x0*x2+x0*x1)*y1+((x0-x2)*x3+x1*x2-x0*x1)*y0)*y2+((x1-x0)*x3+(x0-x1)*x2)*y0*y1)
    '
    dim as single xTprev, yTprev
    dim as single xT, yT
    dim as single x, y
    dim as ulong lastColor
    for x = 0 to (imgW - 1) step .5
        for y = 0 to (imgH - 1) step .5
            xT = a*x + b*y + c*x*y + d
            yT = e*x + f*y + g*x*y + h
            lastColor = point(x,y,Img)
            pSet (xT + 400, yT + 120), lastColor
        next y
        '
    next x
    /'
    for x as long = 0 to (imgW - 1)
        for y as long = 0 to (imgH - 1)
            dim as single xT = a*x + b*y + c*x*y + d
            dim as single yT = e*x + f*y + g*x*y + h
            pSet (xT + 400, yT + 120), point(x,y,Img)
        next y        
    next x
    '/
end sub

'(EOF)
leopardpm
Posts: 1795
Joined: Feb 28, 2009 20:58

Re: Tile - the perspective way

Post by leopardpm »

that's pretty good! a useful routine indeed
Tourist Trap
Posts: 2958
Joined: Jun 02, 2015 16:24

Re: Tile - the perspective way

Post by Tourist Trap »

leopardpm wrote:that's pretty good! a useful routine indeed
Very kind, thanks for your attention!
However the value of this showcase here is probably more to be very straighforward with the maths involved. I solved the whole thing with Maxima (a free symbolic math solver), copied it and pasted without any other adjustement.
It would unfortunately be far too slow to do any real time texture mapping. I will try to go to the end of this however, just for the fun. It's now just a matter of a last round :)

Here a link about the math involved:
https://math.stackexchange.com/question ... -rectangle

edit : some addition here

Code: Select all

'---------------------------------
'rotation of a plane grid network
'provided 3D space eye parameter
'shows in a box now
'---------------------------------

#include "fbgfx.bi"

const as double   _pi            => atn(1)*4
const as ulong    _lightGrey     => rgb(205,205,205)

'tile constant
const as long     imgW           => 15
const as long     imgH           => 15
const as ulong    imgTransColor  => rgb(255,0,255)

'screen constant
const as long     screenWidth    => 800
const as long     screenHeight   => 600

#macro _ExitforOnEscapeKeyPressed
   if inkey=chr(27) then exit for
#endMacro


'---------------------------------
type SCREENTEST extends OBJECT
   'global variable container
   'storing screen parameter
   declare static sub TestScreen()
   static as integer  scrW
   static as integer  scrH
end type 'SCREENTEST <- OBJECT
dim as integer SCREENTEST.scrW       => -1
dim as integer SCREENTEST.scrH       => -1
sub SCREENTEST.TestScreen()
   screenInfo (SCREENTEST.scrW, SCREENTEST.scrH)
end sub 'SCREENTEST.TestScreen()

type INTERACTIONTEST extends SCREENTEST
   'global variable container
   'storing mouse/keyboard interaction
   declare static function TestMouse() as long
   declare static function TestKeyboard() as long
   static as long  gmX
   static as long  gmY
   static as long  gmBtn
   static as long  scanCode
end type 'INTERACTIONTEST <- SCREENTEST <- OBJECT
dim as long INTERACTIONTEST.gmX        => -1
dim as long INTERACTIONTEST.gmY        => -1
dim as long INTERACTIONTEST.gmBtn      => -1
dim as long INTERACTIONTEST.scanCode   => -1
function INTERACTIONTEST.TestMouse() as long
   return getMouse ( INTERACTIONTEST.gmX, _
                     INTERACTIONTEST.gmY, _
                     , _
                     INTERACTIONTEST.gmBtn   )
end function 'LNG:=INTERACTIONTEST.TestMouse()
function INTERACTIONTEST.TestKeyboard() as long
   dim as long scanCodeResult => -1
   if multiKey(fb.SC_BACKSPACE) then
      scanCodeResult = fb.SC_BACKSPACE
   elseif   multiKey(fb.SC_SPACE)   then
      scanCodeResult = fb.SC_SPACE
   elseif   multiKey(fb.SC_LEFT)    andAlso   multiKey(fb.SC_UP)      then
      scanCodeResult = fb.SC_LEFT + fb.SC_UP
   elseif   multiKey(fb.SC_LEFT)    andAlso   multiKey(fb.SC_DOWN)    then
      scanCodeResult = fb.SC_LEFT + fb.SC_DOWN
   elseif   multiKey(fb.SC_RIGHT)   andAlso   multiKey(fb.SC_UP)      then
      scanCodeResult = fb.SC_RIGHT + fb.SC_UP
   elseif   multiKey(fb.SC_RIGHT)   andAlso   multiKey(fb.SC_DOWN)    then
      scanCodeResult = fb.SC_RIGHT + fb.SC_DOWN
   elseif   multiKey(fb.SC_LEFT)    then
      scanCodeResult   =    fb.SC_LEFT
   elseif   multiKey(fb.SC_RIGHT)   then
      scanCodeResult = fb.SC_RIGHT
   elseif   multiKey(fb.SC_DOWN)    then
      scanCodeResult = fb.SC_DOWN
   elseif   multiKey(fb.SC_UP)      then
      scanCodeResult = fb.SC_UP
   end if
   '
   while inkey<>"" : /'clean keyboard buffer'/ :wend
   INTERACTIONTEST.scanCode = scanCodeResult
   '
   return scanCodeResult
end function 'LNG:=INTERACTIONTEST.TestMouse()

type POINT2D extends SCREENTEST
   declare constructor()
   declare constructor( byval as double, _
                        byval as double, _
                        byval as string, _
                        byval as ulong=rgb(205,205,205)  )
   declare operator Let(byval as long)
   declare property OutOfScreen() as boolean
   declare property DistanceToOrigin() as double
   declare sub DrawPoint2D()
   static as long    constructionCount
      as double      _x
      as double      _y
      as string      _id
      as ulong       _color
end type 'POINT2D <- SCREENTEST <- OBJECT
dim as long POINT2D.constructionCount
constructor POINT2D()
   BASE()
   POINT2D.constructionCount +=> 1
   THIS.TestScreen()
   '
   with THIS
      ._x      => SCREENTEST.scrW\2
      ._y      => SCREENTEST.scrH\2
      ._id     => "point" & str(POINT2D.constructionCount)
      ._color  => rgb(205,205,205)
   end with 'THIS
end constructor 'POINT2D default explicit constructor
constructor POINT2D( byval X     as double, _
                     byval Y     as double, _
                     byval Id    as string, _
                     byval C     as ulong=rgb(205,205,205)  )
   BASE()
   '
   with THIS
      ._x      => X
      ._y      => Y
      ._id     => Id
      ._color  => C
   end with 'THIS
end constructor 'POINT2D(valDBL,valDBL,valSTR,valULNG[rgb(205,205,205)])
operator POINT2D.Let(byval SameForAllCoordinate as long)
   with THIS
      ._x   =   SameForAllCoordinate
      ._y   =   SameForAllCoordinate
   end with 'THIS
end operator 'POINT2D:=valLNG
property POINT2D.OutOfScreen() as boolean
   THIS.TestScreen()
   '
   if not( THIS._x>=0 andAlso THIS._x<=THIS.scrW andAlso _
           THIS._y>=0 andAlso THIS._y<=THIS.scrH   ) then
      '
      return TRUE
   else
      '
      return FALSE
   end if
end property 'get BOOL:=POINT2D.OutOfScreen
property POINT2D.DistanceToOrigin() as double
      '
      return sqr(THIS._x*THIS._x + THIS._y*THIS._y)
end property 'get DBL:=POINT2D.DistanceToOrigin
sub POINT2D.DrawPoint2D()
   THIS.TestScreen()
   '
   if THIS._x>=0 andAlso  THIS._x<=THIS.scrW andAlso _
      THIS._y>=0 andAlso  THIS._y<=THIS.scrH then
      circle (THIS._x, THIS._y), 4, THIS._color
      circle (THIS._x, THIS._y), 2, THIS._color
      draw string (THIS._x - 4, THIS._y - 12), THIS._id
   end if
end sub 'POINT2D.DrawPoint2D()

type SCREENBIPOINTLINE extends SCREENTEST
   declare constructor()
   declare constructor( byval as POINT2D, _
                        byval as POINT2D=type<POINT2D>(0,0,"o"), _
                        byval as ulong=rgb(205,205,205)  )
   declare sub DrawLine()
   declare sub DrawLineWithPoint()
      as POINT2D     _p1
      as POINT2D     _p2
      as ulong       _lineColor
end type 'SCREENBIPOINTLINE <- SCREENTEST <- OBJECT
constructor SCREENBIPOINTLINE()
   BASE()
   THIS.TestScreen()
   '
   with THIS
      ._p1        => 0
      ._p2        => type<POINT2D>(THIS.scrW,THIS.scrH,"Corner")
      ._lineColor => rgb(205,205,205)
   end with 'THIS
end constructor 'SCREENBIPOINTLINE default explicit constructor
constructor SCREENBIPOINTLINE(   byval P1   as POINT2D, _
                                 byval P2   as POINT2D=type<POINT2D>(0,0,"o"), _
                                 byval LC   as ulong=rgb(205,205,205)   )
   with THIS
      ._p1        => P1
      ._p2        => P2
      ._lineColor => LC
   end with 'THIS
end constructor 'SCREENBIPOINTLINE(valPOINT2D,valPOINT2D[type<POINT2D>(0,0,"o"),valULNG[rgb(205,205,205)])
sub SCREENBIPOINTLINE.DrawLine()
   THIS.TestScreen()
   '
   dim as boolean   case1   => FALSE
   dim as boolean   case2   => FALSE
   dim as boolean   case3   => FALSE
   dim as boolean   case4   => FALSE
   if ( (THIS._p1)._x=(THIS._p2)._x andAlso (THIS._p1)._y=(THIS._p2)._y ) then
      case1 = TRUE
      'no line to draw
      exit sub
   elseif _
      ( (THIS._p1)._x=(THIS._p2)._x andAlso (THIS._p1)._y<>(THIS._p2)._y ) then
      case2 = TRUE
      if (THIS._p1)._x>=0 andAlso (THIS._p1)._x<=THIS.scrW then
         dim as POINT2D   i(1 to 2)
         i(1)  => POINT2D((THIS._p1)._x, 0, "y=0")
         i(2)  => POINT2D((THIS._p1)._x, THIS.scrH, "y=scrH")
         line  (i(1)._x, i(1)._y)- _
               (i(2)._x, i(2)._y), _
               THIS._lineColor
      else
         'no line to draw
         exit sub
      end if
   elseif _
      ( (THIS._p1)._x<>(THIS._p2)._x and (THIS._p1)._y=(THIS._p2)._y ) then
      case3 = TRUE
      if (THIS._p1)._y>=0 andAlso (THIS._p1)._y<=THIS.scrH then
         dim as POINT2D   i(1 to 2)
         i(1)   => POINT2D(0, (THIS._p1)._y, "x=0")
         i(2)   => POINT2D(THIS.scrW, (THIS._p1)._y, "x=scrW")
         line  (i(1)._x, i(1)._y)- _
               (i(2)._x, i(2)._y), _
               THIS._lineColor
      else
         'no line to draw
         exit sub
      end if 
   elseif _
      ( (THIS._p1)._x<>(THIS._p2)._x andAlso (THIS._p1)._y<>(THIS._p2)._y ) then
      case4 = TRUE
      dim as double   x1   => (THIS._p1)._x
      dim as double   x2   => (THIS._p2)._x
      dim as double   y1   => (THIS._p1)._y
      dim as double   y2   => (THIS._p2)._y
      'compute intersection with screen border
      dim as POINT2D   i(1 to 4)
      i(1)   => POINT2D(x1 - y1*(x2 - x1)/(y2 - y1), 0, "y=0")
      i(2)   => POINT2D(x1 + (THIS.scrH - y1)*(x2 - x1)/(y2 - y1), THIS.scrH, "y=scrH")
      i(3)   => POINT2D(0, y1 - x1*(y2 - y1)/(x2 - x1), "x=0")
      i(4)   => POINT2D(THIS.scrW, y1 + (THIS.scrW - x1)*(y2 - y1)/(x2 - x1), "x=scrW")
      'decide what couple of point to join
      dim as long   j(1 to 2)
      for index as long = 1 to 4
            j(1) => index
            exit for
      next index
      for index as long = 1 to 4
         if i( j(1) )._x<>i(index)._x orElse i( j(1) )._y<>i(index)._y then
               j(2) => index
               exit for
         end if
      next index
      'draw line
      line  (i( j(1) )._x, i( j(1) )._y)- _
            (i( j(2) )._x, i( j(2) )._y), _
            THIS._lineColor
   end if
end sub 'SCREENBIPOINTLINE.DrawLine()
sub SCREENBIPOINTLINE.DrawLineWithPoint()
   (THIS._p1).DrawPoint2D()
   (THIS._p2).DrawPoint2D()
   '
   THIS.DrawLine()
end sub 'SCREENBIPOINTLINE.DrawLineWithPoint()


type SCRPOS
      as integer   _scrPosX
      as integer   _scrPosY
end Type

type WIDHEI
   as integer  _wid
   as integer  _hei
end type

type BOX
   declare constructor()
   declare constructor(byval as single, byval as single, byval as single, byval as single)
   declare property Xi() as integer
   declare property Xi(byval as integer)
   declare property Yi() as integer
   declare property Yi(byval as integer)
   declare property W() as integer
   declare property W(byval as integer)
   declare property H() as integer
   declare property H(byval as integer)
   declare property Xf() as integer
   declare property Xf(byval as integer)
   declare property Yf() as integer
   declare property Yf(byval as integer)
      as SCRPOS   _scrPos
      as WIDHEI   _widHei
end type
constructor BOX()
   '
end constructor
constructor BOX(byval XiParam as single, byval YiParam as single, byval WParam as single, byval HParam as single)
   THIS.Xi  = XiParam
   THIS.Yi  = YiParam
   THIS.W   = WParam
   THIS.H   = HParam
end constructor
property BOX.Xi() as integer
   return THIS._scrPos._scrPosX
end property
property BOX.Xi(byval SetValue as integer)
   THIS._scrPos._scrPosX = SetValue
end property
property BOX.Yi() as integer
   return THIS._scrPos._scrPosY
End Property
property BOX.Yi(byval SetValue as integer)
   THIS._scrPos._scrPosY = SetValue
end property
property BOX.W() as integer
   return THIS._widHei._wid
end property
property BOX.W(byval SetValue as integer)
   THIS._widHei._wid = SetValue
End Property
property BOX.H() as integer
   return THIS._widHei._hei
end property
property BOX.H(byval SetValue as integer)
   THIS._widHei._hei = SetValue
end property
property BOX.Xf() as integer
   return ( THIS._scrPos._scrPosX + THIS._widHei._wid - 1 )
end property
property BOX.Xf(byval SetValue as integer)
   THIS._widHei._wid = SetValue - THIS._scrPos._scrPosX + 1
end property
property BOX.Yf() as integer
   return ( THIS._scrPos._scrPosY + THIS._widHei._hei - 1 )
end property
property BOX.Yf(byval SetValue as integer)
   THIS._widHei._hei = SetValue - THIS._scrPos._scrPosY + 1
end property

type BOXBIPOINTLINE extends BOX
   declare constructor()
   declare constructor(byval as fb.IMAGE ptr, byref as BOX,byref as POINT2D, byref as POINT2D, byval as ulong)
   declare sub DrawLine()
   declare sub DrawLineWithPoint()
      as fb.IMAGE ptr   _imageBuffer
      as POINT2D        _p1
      as POINT2D        _p2
      as ulong          _lineColor
end type
constructor BOXBIPOINTLINE()
   BASE()
   '
   THIS._imageBuffer = 0 ''things wont work and we wont use this constructor
   with THIS
      ._p1        => type<POINT2D>(THIS.Xi,THIS.Yi,"Origin")
      ._p2        => type<POINT2D>(THIS.Xf,THIS.Yf,"Corner")
      ._lineColor => rgb(205,205,205)
   end with
end constructor
constructor BOXBIPOINTLINE(byval Img as fb.IMAGE ptr, byref BoxParam as BOX,byref P1 as POINT2D, byref P2 as POINT2D, byval LineColor as ulong)
   cast(BOX, THIS) = BoxParam
   '
   with THIS
      ._imageBuffer  => Img
      ._p1        => P1
      ._p2        => P2
      ._lineColor => rgb(205,205,205)
   end with   
end constructor
sub BOXBIPOINTLINE.DrawLine()
   dim as boolean   case1   => FALSE
   dim as boolean   case2   => FALSE
   dim as boolean   case3   => FALSE
   dim as boolean   case4   => FALSE
   if ( (THIS._p1)._x=(THIS._p2)._x andAlso (THIS._p1)._y=(THIS._p2)._y ) then
      case1 = TRUE
      'no line to draw
      exit sub
   elseif _
      ( (THIS._p1)._x=(THIS._p2)._x andAlso (THIS._p1)._y<>(THIS._p2)._y ) then
      case2 = TRUE
      if (THIS._p1)._x>=Xi andAlso (THIS._p1)._x<=THIS.Xf then
         dim as POINT2D   i(1 to 2)
         i(1)  => POINT2D((THIS._p1)._x, THIS.Yi, "y=yi")
         i(2)  => POINT2D((THIS._p1)._x,THIS.Yf, "y=yf")
         line  THIS._imageBuffer, _ 
               (i(1)._x - THIS.Xi, i(1)._y - THIS.Yi)- _
               (i(2)._x - THIS.Xi, i(2)._y - THIS.Yi), _
               THIS._lineColor
      else
         'no line to draw
         exit sub
      end if
   elseif _
      ( (THIS._p1)._x<>(THIS._p2)._x and (THIS._p1)._y=(THIS._p2)._y ) then
      case3 = TRUE
      if (THIS._p1)._y>=THIS.Yi andAlso (THIS._p1)._y<=THIS.Yf then
         dim as POINT2D   i(1 to 2)
         i(1)   => POINT2D(THIS.Xi, (THIS._p1)._y, "x=xi")
         i(2)   => POINT2D(THIS.Xf, (THIS._p1)._y, "x=xf")
         line  THIS._imageBuffer, _ 
               (i(1)._x - THIS.Xi, i(1)._y - THIS.Yi)- _
               (i(2)._x - THIS.Xi, i(2)._y - THIS.Yi), _
               THIS._lineColor
      else
         'no line to draw
         exit sub
      end if 
   elseif _
      ( (THIS._p1)._x<>(THIS._p2)._x andAlso (THIS._p1)._y<>(THIS._p2)._y ) then
      case4 = TRUE
      dim as double   x1   => (THIS._p1)._x
      dim as double   x2   => (THIS._p2)._x
      dim as double   y1   => (THIS._p1)._y
      dim as double   y2   => (THIS._p2)._y
      'compute intersection with screen border
      dim as POINT2D   i(1 to 4)
      i(1)   => POINT2D(x1 - y1*(x2 - x1)/(y2 - y1), THIS.Yi, "y=yi")
      i(2)   => POINT2D(x1 + (THIS.Yf - y1)*(x2 - x1)/(y2 - y1), THIS.Yf, "y=yf")
      i(3)   => POINT2D(THIS.Xi, y1 - x1*(y2 - y1)/(x2 - x1), "x=xi")
      i(4)   => POINT2D(THIS.Xf, y1 + (THIS.Xf - x1)*(y2 - y1)/(x2 - x1), "x=xf")
      'decide what couple of point to join
      dim as long   j(1 to 2)
      for index as long = 1 to 4
            j(1) => index
            exit for
      next index
      for index as long = 1 to 4
         if i( j(1) )._x<>i(index)._x orElse i( j(1) )._y<>i(index)._y then
               j(2) => index
               exit for
         end if
      next index
      'draw line
      line  THIS._imageBuffer, _ 
            (i( j(1) )._x - THIS.Xi, i( j(1) )._y - THIS.Yi)- _
            (i( j(2) )._x - THIS.Xi, i( j(2) )._y - THIS.Yi), _
            THIS._lineColor
   end if
end sub
sub BOXBIPOINTLINE.DrawLineWithPoint()
   (THIS._p1).DrawPoint2D()
   (THIS._p2).DrawPoint2D()
   '
   THIS.DrawLine()
end sub

type RUNOVER3DGRID
   declare constructor()
   declare destructor()
   declare property MidW() as single
   declare property MidH() as single
   declare sub TestMouse()
   declare sub DrawROv3dGrid()
      as fb.IMAGE ptr         _imageBuffer
      as BOX                  _boundaryBox
      as single               _tileW
      as single               _tileH
      as double               _rE
      as double               _aE
      as double               _rA
      as double               _aA
      as single ptr           _xForwardPtr
      as double               _xIA
      as double               _yIA
      as double               _zIA
      as double               _xIB
      as double               _yIB
      as double               _zIB
      as double               _alfa
      as double               _beta
      as double               _xHA
      as double               _yHA
      as double               _xHB
      as double               _yHB
      as BOXBIPOINTLINE       _horizon
      as BOXBIPOINTLINE       _xAxis
      as BOXBIPOINTLINE       _yAxis
      as boolean              _hasMouseOver
      as boolean              _hasMouseClic
end type
constructor RUNOVER3DGRID()
   'default constructor
   THIS._imageBuffer => imageCreate(THIS._boundaryBox.W, THIS._boundaryBox.H, 0, rgb(255,0,255)) 
end constructor
destructor RUNOVER3DGRID()
   'default constructor
   imageDestroy   THIS._imageBuffer
   THIS._imageBuffer = 0
end destructor
property RUNOVER3DGRID.MidW() as single
   return THIS._boundaryBox.W/2
end property
property RUNOVER3DGRID.MidH() as single
   return THIS._boundaryBox.H/2
end property
sub RUNOVER3DGRID.TestMouse()
   '
end sub
sub RUNOVER3DGRID.DrawROv3dGrid()
   THIS.TestMouse
   '
   line (THIS._boundaryBox.Xi, THIS._boundaryBox.Yi)-step(THIS._boundaryBox.W, THIS._boundaryBox.H), rgb(0,100,70), bf
   color 0, rgba(20,100,20, 155)
   '
   'parameter of the intersection with the screen edges
   ' *AE inter screen_plane* = IA
   ' *BE inter screen_plane* = IB
   dim as double   pA   => -THIS._rE*1/(THIS._rA*sin(THIS._aA)*cos(THIS._aE) + THIS._rE)
   dim as double   pB   => -THIS._rE*1/(THIS._rA*cos(THIS._aA)*cos(THIS._aE) + THIS._rE)
   THIS._xIA => 0000000000 - pA*( THIS._rA*cos(THIS._aA ) )
   THIS._yIA => THIS._rE*cos(THIS._aE) - pA*( -THIS._rA*sin(THIS._aA) - THIS._rE*cos(THIS._aE))
   THIS._zIA => THIS._rE*sin(THIS._aE)*(1 + pA)
   THIS._xIB => 000000000 - pB*( -THIS._rA*sin(THIS._aA) )
   THIS._yIB => THIS._rE*cos(THIS._aE) - pB*( -THIS._rA*cos(THIS._aA) - THIS._rE*cos(THIS._aE))
   THIS._zIB => THIS._rE*sin(THIS._aE)*(1 + pB)/200        
   'screen plane grid main X,Y axis after rotation
   THIS._alfa   => acos( THIS._xIA/(sqr( THIS._xIA^2 + THIS._yIA^2 + THIS._zIA^2 )) )
   THIS._beta   => acos( THIS._xIB/(sqr( THIS._xIB^2 + THIS._yIB^2 + THIS._zIB^2 )) )
   THIS._xHA    => THIS._rE*tan(THIS._aE)/tan(THIS._alfa)
   THIS._yHA    => -THIS._rE*tan(THIS._aE)
   THIS._xHB    => THIS._rE*tan(THIS._aE)/tan(THIS._beta)
   THIS._yHB    => -THIS._rE*tan(THIS._aE)
   
   THIS._horizon  => BOXBIPOINTLINE(THIS._imageBuffer, _
                           THIS._boundaryBox, _ 
                           type<POINT2D>(THIS._boundaryBox.Xi, THIS._boundaryBox.Yi + THIS._yHA + THIS.MidH,"h0"), _
                           type<POINT2D>(THIS._boundaryBox.Xf,THIS._boundaryBox.Yi + THIS._yHA + THIS.MidH,"h1"), _
                           rgb(100,190,120) )
   'draw horizon line
   THIS._horizon.DrawLineWithPoint()
   THIS._xAxis   => BOXBIPOINTLINE(THIS._imageBuffer, _ 
                           THIS._boundaryBox, _ 
                           type<POINT2D>(THIS._boundaryBox.Xi + THIS.MidW,THIS._boundaryBox.Yi + THIS.MidH,"o"), _
                           type<POINT2D>(THIS._xHA + THIS.MidW,THIS._boundaryBox.Yi + THIS._yHA + THIS.MidH,"HA"), _ 
                           rgb(180,100,100))
   'draw X axis rotated
   THIS._xAxis.DrawLineWithPoint()
   THIS._yAxis   => BOXBIPOINTLINE(THIS._imageBuffer, _ 
                           THIS._boundaryBox, _
                           type<POINT2D>(THIS._boundaryBox.Xi + THIS.MidW,THIS._boundaryBox.Yi + THIS.MidH,"o"), _
                           type<POINT2D>(THIS._xHB + THIS.MidW,THIS._boundaryBox.Yi + THIS._yHB + THIS.MidH,"HB"), _ 
                           rgb(100,100,180))
   'draw Y axis rotated
   THIS._yAxis.DrawLineWithPoint()
#macro _X(n)
   (0*THIS._boundaryBox.Xi + THIS._boundaryBox.W/2) + (sgn(n)*(12)*(1/2 - sgn(n)*n) + 8 - *THIS._xForwardPtr*sin(THIS._aA))
#endMacro
'horizontal grid line equation
#macro _Y(n)
   (0*THIS._boundaryBox.Yi + THIS._boundaryBox.H/2) + (sgn(n)*(12)*(1/2 - sgn(n)*n) + 8 - *THIS._xForwardPtr*cos(THIS._aA))
#endMacro
'rotation of vertical grid line
#macro _XRV(n,t)
   ((_X(n) - THIS._boundaryBox.W/2)*cos(_pi - THIS._aA) - (t)*sin(_pi - THIS._aA) + THIS._boundaryBox.Xi + THIS._boundaryBox.W/2)
#endMacro
#macro _YRV(n,t)
   ((_X(n) - THIS._boundaryBox.W/2)*sin(_pi - THIS._aA) + (t)*cos(_pi - THIS._aA) + THIS._boundaryBox.Yi + THIS._boundaryBox.H/2)
#endMacro
'rotation of horizontal grid line
#macro _XRH(n,t)
   ((t)*cos(-THIS._aA) - (_Y(n) - THIS._boundaryBox.H/2)*sin(-THIS._aA)  +  THIS._boundaryBox.Xi + THIS._boundaryBox.W/2)
#endMacro
#macro _YRH(n,t)
   ((t)*sin(-THIS._aA) + (_Y(n) - THIS._boundaryBox.H/2)*cos(-THIS._aA) + THIS._boundaryBox.Yi + THIS._boundaryBox.H/2)
#endMacro
   'display vertical point for n=0, t=100
   (type<POINT2D>(_XRV(0,100), _YRV(0,100), "y0,2", rgb(0,0,220))).DrawPoint2D()
   'display vertical point for n=0, t=200
   (type<POINT2D>(_XRV(0,200), _YRV(0,200), "y0,2", rgb(0,0,220))).DrawPoint2D()
   'display vertical line
   (type<BOXBIPOINTLINE> _
   (THIS._imageBuffer, THIS._boundaryBox, type<POINT2D>(_XRV(0,-100), _YRV(0,-100),""),type<POINT2D>(_XRV(0,200), _YRV(0,200),""), rgb(0,0,120))).DrawLine()
   '
   'display horizontal point for n=0, t=100
   (type<POINT2D>(_XRH(0,100), _YRH(0,100), "hori0,1", rgb(190,0,0))).DrawPoint2D()
   'display horizontal point for n=0, t=200
   (type<POINT2D>(_XRH(0,200), _YRH(0,200), "x0,2", rgb(190,0,0))).DrawPoint2D()
   'display horizontal line
   (type<BOXBIPOINTLINE> _
   (THIS._imageBuffer, THIS._boundaryBox, type<POINT2D>(_XRH(0,-100), _YRH(0,-100),""),type<POINT2D>(_XRH(0,200), _YRH(0,200),""), rgb(150,0,0))).DrawLine()
   '
   'angle check
#macro _BIPOINTDIST(p1P2D,p2P2D)
   sqr( (p2P2D._x - p1P2D._x)^2 + (p2P2D._y - p1P2D._y)^2 )
#endMacro
#macro _VECTANGLE(centerP2D,p1P2D,p2P2D)
   acos( ( (p1P2D._x - centerP2D._x)*(p2P2D._x - centerP2D._x) + _
                  (p1P2D._y - centerP2D._y)*(p2P2D._y - centerP2D._y) ) / _
                  (_BIPOINTDIST(centerP2D,p1P2D)*_BIPOINTDIST(centerP2D,p2P2D)) )
#endMacro
   dim as POINT2D   boxCenter
   boxCenter._x   => THIS.MidW
   boxCenter._y   => THIS.MidH
   dim as POINT2D   vert00
   vert00._x      => _XRV(0,100)
   vert00._y      => _YRV(0,100)
   dim as POINT2D   hori00
   hori00._x      => _XRH(0,100)
   hori00._y      => _YRH(0,100)
   dim as POINT2D   xAxisUnit
   xAxisUnit._x   => THIS.MidW + 1
   xAxisUnit._y   => THIS.MidH
   '
   'compute and store intersection of rotated grid line with X axis   
   #macro _RHX(n)
      ( _XRH(n,0) + ( THIS.MidH - _YRH(n,0)) * ( _XRH(n,1) - _XRH(n,0) )/( _YRH(n,1) - _YRH(n,0) ) ) '+ loopstep
   #endMacro
   #macro _RVX(n)
      ( _XRV(n,0) + ( THIS.MidH - _YRV(n,0)) * ( _XRV(n,1) - _XRV(n,0) )/( _YRV(n,1) - _YRV(n,0) ) ) '+ loopstep
   #endMacro
   '
   'draw perspective grid
   dim as POINT2D   xAxisHorizonPoint
   xAxisHorizonPoint._x   => THIS._boundaryBox.Xi + THIS._xHA  + THIS.MidW
   xAxisHorizonPoint._y   => THIS._boundaryBox.Yi + THIS._yHA  + THIS.MidH
   dim as POINT2D   yAxisHorizonPoint
   yAxisHorizonPoint._x   => THIS._boundaryBox.Xi + THIS._xHB  + THIS.MidW
   yAxisHorizonPoint._y   => THIS._boundaryBox.Yi + THIS._yHB  + THIS.MidH
   '
   for n as long = -20 to 20 step 1
      if n=0 then continue for
      'horizontal line
      (type<BOXBIPOINTLINE> _
      (THIS._imageBuffer, THIS._boundaryBox, type<POINT2D>(_RHX(n), THIS._boundaryBox.Yi + THIS.MidH,"H"),xAxisHorizonPoint, rgb(100,150,200))).DrawLine()
      'vertical line
      (type<BOXBIPOINTLINE> _
      (THIS._imageBuffer, THIS._boundaryBox, type<POINT2D>(_RVX(n*1.4) , THIS._boundaryBox.Yi + THIS.MidH,"V"),yAxisHorizonPoint, rgb(100,150,200))).DrawLine()
   next n
   '
   line  THIS._imageBuffer, _ 
         (0,0)- _ 
         step(THIS._boundaryBox.W,THIS._boundaryBox.H), _ 
         rgba(0,50,0,5), _ 
         bf
   'draw sky box
   line  THIS._imageBuffer, _ 
         (0,0)- _ 
         step(THIS._boundaryBox.W, 0*THIS._yHA  + (100/95)*THIS.MidH), _ 
         rgba(140,150,180,5), _ 
         bf
   '
   'draw view center
   circle THIS._imageBuffer, (THIS.MidW, THIS.MidH), 8, rgba(220,140,155,55), , , , f
end sub


'-------------------------------------------------------------------------------
screenRes screenWidth, _
          screenHeight, _
          32, _
          2, _ 
          fb.GFX_ALPHA_PRIMITIVES + fb.GFX_HIGH_PRIORITY
color rgb(0,200,0)
SCREENTEST.TestScreen()

'---------------------------------
'observation point parameter
dim as double   rE   => 400.
dim as double   aE   => .275*_pi
'source plane grid orientation
dim as double   rA   => 100.
dim as double   aA   => 225*_pi/180
dim as single ptr    xForwardPtr => new single

'RUNOVER3DGRID object initialization
dim as RUNOVER3DGRID    ro3Dgd
ro3Dgd._xForwardPtr => xForwardPtr
with ro3Dgd
   ._rE  = rE
   ._aE  = aE
   ._rA  = rA
   ._aA  = aA
   ._boundaryBox.Xi  = 300
   ._boundaryBox.Yi  = 140
   ._boundaryBox.W   = 300
   ._boundaryBox.H   = 280
   ._imageBuffer     = imageCreate(._boundaryBox.W, ._boundaryBox.H, 0, rgb(255,0,255))
end with


'---------------------------------main_loop
do
   SCREENTEST.TestScreen()
   INTERACTIONTEST.TestKeyboard()
   if INTERACTIONTEST.scanCode = fb.SC_UP    then *xForwardPtr += 1
   if INTERACTIONTEST.scanCode = fb.SC_DOWN  then *xForwardPtr -= 1
   if INTERACTIONTEST.scanCode = fb.SC_LEFT  then aA += .01
   if INTERACTIONTEST.scanCode = fb.SC_RIGHT then aA -= .01
   if INTERACTIONTEST.scanCode = (fb.SC_UP +  fb.SC_LEFT) then
      *xForwardPtr += 1
      aA += .01
   end if
   if INTERACTIONTEST.scanCode = (fb.SC_UP +  fb.SC_RIGHT) then
      *xForwardPtr += 1
      aA -= .01
   end if
   if aE>(_pi/2)           then aE = _pi/2 - .001
   if aE<(_pi/8)           then aE = _pi/8
   if aA>(3*_pi/2 - 0.003) then aA = 3*_pi/2 - .003
   if aA<(_pi)             then aA = _pi + .001
   with ro3Dgd
      ._rE  = rE
      ._aE  = aE
      ._rA  = rA
      ._aA  = aA
   end with
   
   screenSet 0, 1
      cls
      ro3Dgd.DrawROv3dGrid()
      put (ro3Dgd._boundaryBox.Xi,ro3Dgd._boundaryBox.Yi), ro3Dgd._imageBuffer, pset
   screenCopy 0, 1
   '
   sleep 5
loop until inkey=chr(27)

delete xForwardPtr

sleep
end 0

'(eof)
There is a nice fading effect by the way. At least could be nice if used correctly.
Post Reply