Tile - the perspective way

Game development specific discussions.
Tourist Trap
Posts: 2756
Joined: Jun 02, 2015 16:24

Tile - the perspective way

Postby Tourist Trap » Feb 02, 2016 13:56

Hi, still in the continuation of tile studies for gaming. Some development here viewtopic.php?f=15&p=215578#p215578, but the perspective chapter is a step harder and deserves its own treatment.

Basically the questions are 2. So to fill the never-ending plane with tiles of a single rectangular type we ask:
  • how the whole tile grid gets transformed by perspective?
  • if the tile is an image, how doing good texture distortion within any of the many contours generated by the perspective?

The question of the grid
Unfortunately websites are returning very technical stuff so after having simplified to extreme, here is what I’ve finally been able to get so far. Please if I’m wrong please correct me.

Principle
What is important is that, provided a flat view window (the screen):
  • perspective means that there should be a line of horizon somewhere on the screen (or out but still existing);
  • any set of parallel lines meets to the horizon line in exactly one point (one point a set),
  • two different sets of parallel should meet in general at two different points - but not always if we have things built in a symmetrical way we can meet only one perspective point, and in the most general case 3 points may appear;
  • lines that are parallel to the horizon are special and keep parallel, but there interline distance is vanishing as they get closer to the true horizon.

Test program
This leads to a first code attempt to deal with perspective grid. This is based on the simple implementation of the following scheme:
Image

Code: Select all

'case_study-----------------------
'horizon dependant perspectivegrid
'---------------------------------

const as long     imgW          =>  200
const as long     imgH          =>  260
const as long     screenWidth   =>   800
const as long     screenHeight  =>   400
const as ulong    imgTransColor => rgb(255,0,255)

#include "fbgfx.bi"


'type_declaration----------------
'---------------------------------
type SCREENTEST extends OBJECT
    '** global variable container
    'to hold/get screen parameter
    declare static sub TestScreen()
    static as integer  scrW
    static as integer  scrH
end type 'SCREENTEST <- OBJECT

type MOUSETEST extends SCREENTEST
    '** global variable container
    'to hold/get mouse parameter
    declare static function TestMouse() as long
    static as long  gmX
    static as long  gmY
    static as long  gmBtn
end type 'MOUSETEST <- SCREENTEST <- OBJECT

type DRAGGABLEHORIZON extends MOUSETEST
   declare constructor()
   declare constructor(byval as long)
   declare property ControllerY() as long
   declare property ControllerY(byval as long)
   declare sub TestController()
   declare sub DrawController()
   declare sub DrawHorizon()
      as long         _yMainCoordinate
      as double      _yControllerRate
      as double      _viewingAngle
      as double      _viewingRadius
      as boolean      _mouseOver
      as boolean      _mouseClick
      as boolean      _dragStarted
end type 'DRAGGABLEHORIZON


'type_implemetation--------------
'---------------------------------
dim as integer SCREENTEST.scrW       => -1
dim as integer SCREENTEST.scrH       => -1
sub SCREENTEST.TestScreen()
    screenInfo (SCREENTEST.scrW, SCREENTEST.scrH)
end sub 'SCREENTEST.TestScreen()

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 'LNG:=MOUSETEST.TestMouse()

constructor DRAGGABLEHORIZON()
   BASE()
   '
   with THIS
      ._yMainCoordinate   => THIS.scrH\2
      ._yControllerRate   => 0.4
      ._viewingAngle      => 1 - THIS._yControllerRate
      ._viewingRadius      => 200
      ._mouseOver         => FALSE
      ._mouseClick      => FALSE
      ._dragStarted      => FALSE
   end with 'THIS
end constructor 'DRAGGABLEHORIZON()
constructor DRAGGABLEHORIZON(byval Y as long)
   BASE()
   '
   with THIS
      ._yMainCoordinate   => Y
      ._yControllerRate   => Y/THIS.scrH
      ._viewingAngle      => 1 - THIS._yControllerRate
      ._viewingRadius      => 200
      ._mouseOver         => FALSE
      ._mouseClick      => FALSE
      ._dragStarted      => FALSE
   end with 'THIS
end constructor 'DRAGGABLEHORIZON(valLONG)
property DRAGGABLEHORIZON.ControllerY() as long
   '---->
   return (90 + THIS._yControllerRate*140)
end property 'LNG:=DRAGGABLEHORIZON.ControllerY
property DRAGGABLEHORIZON.ControllerY(byval SetValue as long)
   THIS._yControllerRate   = (SetValue - 90)/140
end property 'DRAGGABLEHORIZON.ControllerY(valLNG)
sub DRAGGABLEHORIZON.TestController()
   dim as long      dragGmX
   dim as long      dragGmY
   dim as long      dragGmBtn
    if THIS._dragStarted   then
        getMouse dragGmX, dragGmY, , dragGmBtn
        if dragGmX<(10 + 4)                  then dragGmX = 10 + 4 + 4
        if dragGmX>(26 + 4)                  then dragGmX = 26 + 4 - 4
        if dragGmY<(THIS.ControllerY + 28)      then THIS.gmY = THIS.ControllerY + 28 + 4
        if dragGmY>(THIS.ControllerY + 8 + 28)   then THIS.gmY = THIS.ControllerY + 28 + 4
    end if
    '
    if dragGmY<30 then dragGmY = 30
    if dragGmY>(THIS.scrH - 14) then dragGmY = THIS.scrH - 14
    if ( THIS.gmX>=(10 + 4)                           and _
       THIS.gmX<=(26 + 4)                           and _
       THIS.gmY>=(THIS.ControllerY + 28)               and _
       THIS.gmY<=(THIS.ControllerY + 8 + 28) )            or _
       THIS._dragStarted                            then
       if THIS._mouseOver=FALSE then THIS._mouseOver = TRUE
        if THIS.gmBtn=+1 then
           if THIS._mouseClick=FALSE then THIS._mouseClick = TRUE
            if THIS._dragStarted then
               THIS.ControllerY   = dragGmY - 28
            else
                THIS._dragStarted   = TRUE
            end if
        else
           if THIS._mouseClick=TRUE then THIS._mouseClick = FALSE
            THIS._dragStarted   = FALSE
        end if
    else
       if THIS._mouseClick=TRUE then THIS._mouseClick = FALSE
        if THIS._mouseOver=TRUE then THIS._mouseOver = FALSE
    end if
end sub 'DRAGGABLEHORIZON.TestController()
sub DRAGGABLEHORIZON.DrawController()
   THIS.TestController()
   '
   line (12,90)-step(12,140), rgb(160,120,120), b
   line (12 + 1,90 + 1)-step(12 - 2,140 - 2), rgb(190,190,190), bf
   '
   if THIS._mouseOver then
      line (10,90 + THIS._yControllerRate*140)-step(16,08), rgb(190,100,100), bf
   else
      line (10,90 + THIS._yControllerRate*140)-step(16,08), rgb(120,120,120), bf
   end if
   '
   draw string (28,THIS.ControllerY - 20), _
            "Angle "& str(1 - THIS._yControllerRate), _
            rgb(200,120,120)
   '
   THIS._viewingAngle = 1 - THIS._yControllerRate
   circle (50,THIS.ControllerY - 24), 50, 0,0, -1.57, , F
   line (50,THIS.ControllerY - 24)-step(50,0),0
   paint (50 + 8,THIS.ControllerY - 24 - 8), rgb(240,230,230), 0
   line (50,THIS.ControllerY - 24)-step(80*cos(THIS._viewingAngle),-80*sin(THIS._viewingAngle)), 0
   circle (50 + 80*cos(THIS._viewingAngle),THIS.ControllerY - 24 - 80*sin(THIS._viewingAngle)), 5, 0
end sub 'DRAGGABLEHORIZON.DrawHorizon()
sub DRAGGABLEHORIZON.DrawHorizon()
   THIS.DrawController()
   '
   THIS._yMainCoordinate = _
               THIS.scrH - THIS._viewingRadius*tan(THIS._viewingAngle)
   '
   draw string (28,THIS._yMainCoordinate - 10), "Horizon", rgb(200,120,120)
   line (0,THIS._yMainCoordinate)-step(THIS.scrW,0), rgb(240,140,140)
   line (0,THIS._yMainCoordinate - 1)-step(THIS.scrW,0), rgb(200,120,120)
   line (0,THIS._yMainCoordinate + 1)-step(THIS.scrW,0), rgb(200,120,120)
   '
   'draw horizon parallel tile border
   for n as long = -1 to -150 step -1
      dim as single   borderStep   = THIS.scrH\2 + (n - 1/2)*imgH
      dim as single   cYn         
      dim as single   cZn         
      cYn   = _
      THIS._viewingRadius*sin(THIS._viewingAngle)*sin(THIS._viewingAngle)*borderStep/ _
                        (THIS._viewingRadius - cos(THIS._viewingAngle)*borderStep)
      cZn   = _
      - THIS._viewingRadius*cos(THIS._viewingAngle)*sin(THIS._viewingAngle)*borderStep/ _
                        (THIS._viewingRadius - cos(THIS._viewingAngle)*borderStep)
      line (0,THIS.scrH - sqr(cYn^2 + cZn^2))-step(THIS.scrW,0), rgb(080,170,090)
   next n
end sub 'DRAGGABLEHORIZON.DrawHorizon()


'subroutine_declaration----------
'---------------------------------
'(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


'program_initialization----------
'---------------------------------
randomize TIMER

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

SCREENTEST.TestScreen()

dim as DRAGGABLEHORIZON      horizon

'program_main_loop---------------
'---------------------------------
dim as boolean  quitOrder   => FALSE
do
    SCREENTEST.TestScreen()
   MOUSETEST.TestMouse()
   quitOrder   = TestFrameWorkForMouse()

    screenLock
       cls
       DrawWindowFrame(0)
      DrawExitButton(quitOrder)
      
      view (4,28)-(SCREENTEST.scrW - 6,SCREENTEST.scrH - 4)
         line (SCREENTEST.scrW\2,0)-step(0,SCREENTEST.scrH),  _
              rgb(80,80,180), _
              ,_
              &b1100000011110000
         
         for i as long = 0 to 100
            line (SCREENTEST.scrW\2,SCREENTEST.scrH - 32)-step(-(i + 1/2)*imgW,0), 0
            line step-(SCREENTEST.scrW\2,horizon._yMainCoordinate), 0
            
            line (SCREENTEST.scrW\2,SCREENTEST.scrH - 32)-step(+(i + 1/2)*imgW,0), 0
            line step-(SCREENTEST.scrW\2,horizon._yMainCoordinate), 0      
         next i
         
         horizon.DrawHorizon()
      
      view screen
   screenUnlock

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


'program_finalization------------
'---------------------------------
'(explicit clean up)


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


'subroutine_implementation-------
'---------------------------------
'(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(090 + x,190 + x\2,120 + x), _
             bf
    next x
    line (04,24)-(SCREENTEST.scrW - 1 - 4, 28), _
         rgb(200,200,220), _
         bf
   draw string (08,12), _
                "HORIZON DEPENDANT PERSPECTIVE GRID - FB1.04" & _
                " (note: window not movable not resizable)", _
                rgb(030,050,140)
    if DrawingZone<>0 then
        put (04,28), DrawingZone, TRANS
    else
       imageDestroy DrawingZone
       'MEMORY LEAK AROUND HERE
       'fixed by null image attribute but still weird
        DrawingZone = imageCreate(0, _
                                  0, _
                                  imgTransColor, _
                                  32)
    end if
    '
    '---->
    return DrawingZone
end function 'IMAGE_PTR:=DrawWindowFrame(valIMAGE_PTR)
'
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 'DrawExitButton()
'
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 'BOOL:=TestFrameWorkForMouse()


'[EOF]


The question of the texture
About texture, my first attempt has lead to a test program where I’m distorting the tile image in various ways. This is not complete or general enough, but it’s a program I think useful for anyone for it's possible to add more testing procedures.

First conclusion anyway: there is no major problem in distorting a texture if this involves only size reduction. Magnification means loss of pixels, and would probably require good color interpolation algorithm that I don’t know at all.

Code
Use the here joined tile ("planet.bmp") to get the program work, or an equivalent dimension bmp tile of your choice.
Image

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"


'subroutine_declaration----------
'---------------------------------
'(perspective routine)
'if new routine added ->
'          add button to interface
'the implementation are at the end
declare sub ReduceXY(byval Img          as fb.IMAGE ptr, _
                     byval XScaleFactor as double=0.5, _
                     byval YScaleFactor as double=0.5)
declare sub ShearAlongX(byval Img           as fb.IMAGE ptr, _
                        byval XscaleFactor  as double=0.5, _
                        byval OffsetXatYmax as long=0)
declare sub TriangleAlongX(byval Img            as fb.IMAGE ptr, _
                           byval BaseAtBottom   as boolean=TRUE, _
                           byval XscaleFactor   as double=0.5, _
                           byval OffsetXatYmax  as long=0)
declare sub TrapezeAlongX(byval Img                 as fb.IMAGE ptr, _
                          byval XscaleFactorAtYmin  as double=0.5, _
                          byval XscaleFactorAtYmax  as double=1)

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

'type_declaration----------------
'---------------------------------
type SCREENTEST extends OBJECT
    '** global variable container
    'to hold/get screen parameter
    declare static sub TestScreen()
    static as integer  scrW
    static as integer  scrH
end type 'SCREENTEST <- OBJECT

type MOUSETEST extends SCREENTEST
    '** global variable container
    'to hold/get mouse parameter
    declare static function TestMouse() as long
    static as long  gmX
    static as long  gmY
    static as long  gmBtn
end type 'MOUSETEST <- SCREENTEST <- OBJECT

type BUTTON extends MOUSETEST
    '** button object with delay
    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
    'private:   
        as boolean  _mouseOver
        as boolean  _mouseClick
end type 'BUTTON <- MOUSETEST <- SCREENTEST <- OBJECT


'type_implemetation--------------
'---------------------------------
dim as integer SCREENTEST.scrW       => -1
dim as integer SCREENTEST.scrH       => -1
sub SCREENTEST.TestScreen()
    screenInfo (SCREENTEST.scrW, SCREENTEST.scrH)
end sub 'SCREENTEST.TestScreen()

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 'LNG:=MOUSETEST.TestMouse()

dim as long     BUTTON.fontWidth   => 8
dim as long     BUTTON.fontHeight  => 8
dim as double   BUTTON.clickDelay  => 0.8
constructor BUTTON()
    'note:
    'default explicit constructor necessary
    'if array of the object to be declared
    'the implict constructor would not go
    BASE()
    '
   dim as long 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 'THIS
end constructor 'BUTTON()
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 'THIS
end constructor 'BUTTON({valLNG}*5,STR)
property BUTTON.CenterXForText() as long
    '---->
    return THIS._topLeftCornerX + _
           ( THIS._width - len(THIS._text)*BUTTON.fontWidth )\2
end property 'get LNG:=BUTTON.CenterXForText
property BUTTON.CenterYForText() as long
    '---->
    return THIS._topLeftCornerY + _
           ( THIS._height - BUTTON.fontHeight )\2
end property 'get LNG:=BUTTON.CenterYForText
property BUTTON.MouseClick() as boolean
    'to trigger an action at mouse click
    'one should test this property
    '---->
    return (THIS._mouseOver and THIS._mouseClick)
end property 'BOOL:=BUTTON.MouseClick
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 'BUTTON.TestButton()
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 'BUTTON.DrawButton()

'subroutine_declaration----------
'---------------------------------
'(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


'program_initialization----------
'---------------------------------
randomize TIMER

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

SCREENTEST.TestScreen()

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

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

dim as BUTTON   resetBtn    => BUTTON(SCREENTEST.scrW - 480, _
                                      SCREENTEST.scrH - 320, _
                                      120, _
                                      12, _
                                      "Reset")
dim as BUTTON   reduceXYBtn => BUTTON(SCREENTEST.scrW - 480, _
                                      SCREENTEST.scrH - 300, _
                                      120, _
                                      12, _
                                      "ReduceXY")
dim as BUTTON   ShearXBtn   => BUTTON(SCREENTEST.scrW - 480, _
                                      SCREENTEST.scrH - 280, _
                                      120, _
                                      12, _
                                      "ShearAlongX")
dim as BUTTON   TrgleXBtn   => BUTTON(SCREENTEST.scrW - 480, _
                                      SCREENTEST.scrH - 260, _
                                      120, _
                                      12, _
                                      "TriangleAlongX")
dim as BUTTON   TrpzeXBtn   => BUTTON(SCREENTEST.scrW - 480, _
                                      SCREENTEST.scrH - 240, _
                                      120, _
                                      12, _
                                      "TrapezeAlongX")
dim as BUTTON   LinearXYBtn  => BUTTON(SCREENTEST.scrW - 480, _
                                      SCREENTEST.scrH - 200, _
                                      120, _
                                      12, _
                                      "LinearXY")


'program_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
       
        resetBtn.DrawButton()
        if resetBtn.MouseClick then
            DrawWindowFrame(clearDrawingImg)
                startTime   = TIMER
                put (060, 120), tileImg, TRANS
                endTime     = TIMER
            draw string (10,40), "op. time="& str(cSng(endTime - startTime))
            get (04,28)-step(drawingZoneW - 1,drawingZoneH -1), drawingImg
        end if
       
        reduceXYBtn.DrawButton()
        if reduceXYBtn.MouseClick then
            DrawWindowFrame(clearDrawingImg)
            draw string (10,54), "pixel transfer.."
                startTime   = TIMER
                ReduceXY(tileImg, 0.5, 0.5)
                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
       
        ShearXBtn.DrawButton()
        if ShearXBtn.MouseClick then
            DrawWindowFrame(clearDrawingImg)
            draw string (10,54), "pixel transfer.."
                startTime   = TIMER
                ShearAlongX(tileImg, 0.5, 0)
                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
       
        TrgleXBtn.DrawButton()
        if TrgleXBtn.MouseClick then
            DrawWindowFrame(clearDrawingImg)
            draw string (10,54), "pixel transfer.."
                startTime   = TIMER
                TriangleAlongX(tileImg, TRUE, 0.5, 0)
                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
       
        TrpzeXBtn.DrawButton()
        if TrpzeXBtn.MouseClick then
            DrawWindowFrame(clearDrawingImg)
            draw string (10,54), "pixel transfer.."
                startTime   = TIMER
                TrapezeAlongX(tileImg, 0.5, 1)
                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
       
       
        LinearXYBtn.DrawButton()
        if LinearXYBtn.MouseClick then
            DrawWindowFrame(clearDrawingImg)
            draw string (10,54), "pixel transfer.."
                startTime   = TIMER
                LinearXY(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)   


'program_finalization------------
'---------------------------------
'(explicit clean up)
imageDestroy tileImg
imageDestroy drawingImg


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


'subroutine_implementation-------
'---------------------------------
'(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 'IMAGE_PTR:=DrawWindowFrame(valIMAGE_PTR)
'
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 'DrawExitButton()
'
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 'BOOL:=TestFrameWorkForMouse()

'(perspective routine)******************************************************************
sub ReduceXY(byval Img as fb.IMAGE ptr, _
             byval XScaleFactor as double=0.5, _
             byval YScaleFactor as double=0.5)
    for x as long = 0 to (imgW - 1)
        for y as long = 0 to (imgH - 1)
            pSet (500 + x*XScaleFactor, 120 + y*YScaleFactor), point(x,y,Img)
        next y       
    next x
end sub 'ReduceXY(valIMAGE_PTR,valDBL[0.5],valDBL[0.5])
'
sub ShearAlongX(byval Img as fb.IMAGE ptr, _
                byval XscaleFactor as double=0.5, _
                byval OffsetXatYmax as long=0)
    for x as long = 0 to (imgW - 1)
        for y as long = 0 to (imgH - 1)
            pSet (450 + x + y*XscaleFactor, 120 + y), point(x,y,Img)
        next y       
    next x
end sub 'ShearAlongX(valIMAGE_PTR,valDBL[0.5],valLNG[0])
'
sub TriangleAlongX(byval Img as fb.IMAGE ptr, _
                   byval BaseAtBottom as boolean=TRUE, _
                   byval XscaleFactor as double=0.5, _
                   byval OffsetXatYmax as long=0)
    for x as long = 0 to (imgW - 1)
        for y as long = 0 to (imgH - 1)
            pSet (500 + x*((imgH - 1) - y)/(2*(imgW - 1)), 120 + y), _
                 point(x,y,Img)
        next y       
    next x
end sub 'TriangleAlongX(valIMAGE_PTR,valBOOL[-1],valDBL[0.5],valLNG[0])
'
sub TrapezeAlongX(byval Img as fb.IMAGE ptr, _
                  byval XscaleFactorAtYmin as double=0.5, _
                  byval XscaleFactorAtYmax as double=1)
    for x as long = 0 to (imgW - 1)
        for y as long = 0 to (imgH - 1)
            pSet (550 + (x/2 - y*(imgW -1)/(4*(imgH - 1))) + 3*x*y/(8*(imgW - 1)), _
                 120 + y), _
                 point(x,y,Img)
        next y       
    next x
end sub 'TrapezeAlongX(valIMAGE_PTR,valDBL[0.5],valDBL[1])


sub LinearXY(byval Img   as fb.IMAGE ptr)
   dim as double   a   = 0.5
   dim as double   b   = 100
   dim as double   c   =  1/(2*(imgH - 1))
   dim as double   d   = 1
   dim as double   e   = 0.8
   dim as double   f   = 50
   dim as double   g   = 1/(4*(imgH - 1))
   dim as double   h   = 1
    for x as long = 0 to (imgW - 1)
        for y as long = 0 to (imgH - 1)
            pSet (550 + sqr(2)/2*cos(1)*x - sin(1)*y , _
                  120 + 0.5*cos(1)*y + 1*sqr(2)/2*sin(1)*x ), _
                 point(x,y,Img)
                 '
        next y       
    next x
end sub 'LinearXY(valIMAGE_PTR)



'[EOF]



Conclusion
My final goal right now is, once determined a perspective grid, to build the set of distorted tiles that match the grid, and apply them!

Any help would be welcome. Feedback, ideas, improvements, or theory explanations from people that knows about those affairs, all welcome.

Solving this problem would possibly mean crafting perspective game very easily from a tile basis. First example we can think of is something like Doom of course, but not only, it's very open field...


(last thing: the programs posted above have compiled and worked for me (xp32 1.04). The grid program may have a memory leak, but not for an essential part, and it's fixed. What I mean is that this should run normally, though not in an optimized way. So if this is not working, this is an issue for itself, please give some feedback if you meet problems.)
Last edited by Tourist Trap on Feb 03, 2016 14:46, edited 1 time in total.
fxm
Posts: 8972
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Tile - the perspective way

Postby fxm » Feb 02, 2016 15:19

Two small remarks on coding:
- To be also compatible with 64-bit, all numeric parameters for 'ScrenInfo()' must be Integer.
- What is the usage of 'as OBJECT _fieldPlaceHolder' in types.
badidea
Posts: 1368
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Tile - the perspective way

Postby badidea » Feb 02, 2016 18:20

A few remarks:

1) Performance can be improved a lot, e.g. I see in the loop: pSet (550 + sqr(2)/2*cos(1)*x - sin(1)*y , 120 + 0.5*cos(1)*y + 1*sqr(2)/2*sin(1)*x ), point(x,y,Img) all these sines, conines and squares can be outside the loop.

2) Linear color-interpolation is not that hard, but additional calculation per pixel is then required. I'll try to post something later...

3) Is it not easier to use a 3d library and let the library and/or graphics card do all this work? 3d examples can be found on this forum.
badidea
Posts: 1368
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Tile - the perspective way

Postby badidea » Feb 03, 2016 8:18

Bilinear interpolation example:

Code: Select all

screenres 800, 600, 32

const as integer numTerrainTypes = 7
const as integer xMapSize = 24\2, yMapSize = 18\2
const as integer xTileSize = 32*2, yTileSize = 32*2

dim as integer terrainColor(numTerrainTypes-1) = _
   {&h0023719B, &h0047BD31, &h00DDEFEE, &h00766258, &h002F5319, &h00CBBC7F, &h001D3E57}

type rbg_type
   r as ubyte
   g as ubyte
   b as ubyte
   a as ubyte
end type

union rgb_union
   value as integer
   comp as rbg_type
end union

function limit(value as integer, minimum as integer, maximum as integer) as integer
   dim as integer result = value
   if (result > maximum) then result = maximum
   if (result < minimum) then result = minimum
   return result
end function


sub drawBlock(x0 as integer, y0 as integer, pC as rgb_union ptr, noise as integer)
   dim as integer x, y
   dim as rgb_union cT, cB, c
   dim as single xFactor1, xFactor2
   dim as single yFactor1, yFactor2
   for x = 0 to xTileSize-1
      for y = 0 to yTileSize-1
         xFactor1 = x / xTileSize
         xFactor2 = 1 - xFactor1
         cT.comp.r = int(xFactor2 * pC[0].comp.r + xFactor1 * pC[1].comp.r)
         cT.comp.g = int(xFactor2 * pC[0].comp.g + xFactor1 * pC[1].comp.g)
         cT.comp.b = int(xFactor2 * pC[0].comp.b + xFactor1 * pC[1].comp.b)
         cB.comp.r = int(xFactor2 * pC[2].comp.r + xFactor1 * pC[3].comp.r)
         cB.comp.g = int(xFactor2 * pC[2].comp.g + xFactor1 * pC[3].comp.g)
         cB.comp.b = int(xFactor2 * pC[2].comp.b + xFactor1 * pC[3].comp.b)
         yFactor1 = y / yTileSize
         yFactor2 = 1 - yFactor1
         c.comp.r = limit(int(yFactor2 * cT.comp.r + yFactor1 * cB.comp.r + (rnd - 0.5) * noise), 0, 255)
         c.comp.g = limit(int(yFactor2 * cT.comp.g + yFactor1 * cB.comp.g + (rnd - 0.5) * noise), 0, 255)
         c.comp.b = limit(int(yFactor2 * cT.comp.b + yFactor1 * cB.comp.b + (rnd - 0.5) * noise), 0, 255)
         pset (x0 + x, y0 + y), c.value
      next
   next
end sub

dim as integer xMap, yMap
dim as integer xTile, yTile
dim as rgb_union c(4-1)
dim as rgb_union cMap(xMapSize, yMapSize) 'not minus 1

c(0).value = terrainColor(0) 'top left
c(1).value = terrainColor(3) 'top right
c(2).value = terrainColor(5) 'bottom left
c(3).value = terrainColor(1) 'bottom right

randomize timer

dim as integer itl, itr, ibl, ibr
dim as string text, filename
dim as any ptr pImage = imagecreate(xTileSize, yTileSize)

for xMap = 0 to xMapSize 'not minus 1
   for yMap = 0 to yMapSize 'not minus 1
      cMap(xMap, yMap).value = terrainColor(int(rnd*numTerrainTypes))
   next
next

for xMap = 0 to xMapSize-1
   for yMap = 0 to yMapSize-1
      c(0) = cMap(xMap, yMap)
      c(1) = cMap(xMap + 1, yMap)
      c(2) = cMap(xMap, yMap + 1)
      c(3) = cMap(xMap + 1, yMap + 1)
      drawBlock(xMap * (xTileSize + 1), yMap * (yTileSize + 1), @c(0), 20)
   next
next
   
sleep

imagedestroy pImage

Bilinear interpolation which is Linear interpolation twice (in 2 directions).
Tourist Trap
Posts: 2756
Joined: Jun 02, 2015 16:24

Re: Tile - the perspective way

Postby Tourist Trap » Feb 03, 2016 14:48

fxm wrote:- To be also compatible with 64-bit, all numeric parameters for 'ScrenInfo()' must be Integer.
- What is the usage of 'as OBJECT _fieldPlaceHolder' in types.

Thanks for the remarks. The second is unuseful place holder. About screeninfo(), I didn't know that. Not in the documentation anyway. Thanks again.

badidea wrote:Bilinear interpolation example

Thanks for the code illustration. Of course requires adaptation for the present case. I'm not sure that for tilling, trying magnification is not simply too risky since there are other problems than just interpolation, like conservation of contrast and so on.Taken as a whole, seems really not easy. Reduction is fortunately simpler.

badidea wrote:1) Performance can be improved a lot, e.g. I see in the loop: pSet (550 + sqr(2)/2*cos(1)*x - sin(1)*y , 120 + 0.5*cos(1)*y + 1*sqr(2)/2*sin(1)*x ), point(x,y,Img) all these sines, conines and squares can be outside the loop.

Fortunately this function is just a sandbox. In fact I was trying to find something linear in the common meaning of this term, but I was wrong. Perspective in general is not linear, it's homography, and it's linear in a very special meaning in projective spaces. Quite interesting to know indeed.

[quote="badidea]
3) Is it not easier to use a 3d library and let the library and/or graphics card do all this work? 3d examples can be found on this forum.[/quote]
I'm affraid not. OpenGl is not that easy. It may also finally require the help of the gpu. And I dont want learn a third-party library and get bounded to hardware for so basic stuff. Of course I'm not against a tutorial on implementing a infinitely textured tiled plane in OpenGl if someone provided it!

New example game based on previous developments:

Image

Code: Select all

'LION KING........................
'---------------------------------
'  a simple perspective grid game
'---------------------------------

'animated char
const as string      animatedCharacter = "tigerwood.bmp"
const as long     animaW          =>  491
const as long     animaH          =>  149

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

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

#include "fbgfx.bi"


'---------------------------------
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)   and multiKey(fb.SC_UP)      then
      scanCodeResult   =    fb.SC_LEFT + fb.SC_UP
   elseif   multiKey(fb.SC_LEFT)   and multiKey(fb.SC_DOWN)   then
      scanCodeResult   =    fb.SC_LEFT + fb.SC_DOWN
   elseif   multiKey(fb.SC_RIGHT)   and multiKey(fb.SC_UP)      then
      scanCodeResult   =    fb.SC_RIGHT + fb.SC_UP
   elseif   multiKey(fb.SC_RIGHT)   and 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
    '---->
    return scanCodeResult
end function 'LNG:=INTERACTIONTEST.TestMouse()


'---------------------------------
screenRes screenWidth, _
          screenHeight, _
          32
color rgb(0,200,0)
SCREENTEST.TestScreen()

'load tiger frame!
dim as fb.IMAGE ptr      tiger(4)
for frameNum as long = 0 to 4
   tiger(frameNum) => imageCreate(animaW\5 - 1, animaH - 1, imgTransColor, 32)
next frameNum
scope
   dim as fb.IMAGE ptr      fullCharacterImage
   fullCharacterImage => _
         imageCreate(animaW, animaH, imgTransColor, 32)
   bLoad animatedCharacter, fullCharacterImage
   for frameNum as long = 0 to 4
      get fullCharacterImage, _
          (frameNum*(animaW\5),0)-step((animaW\5) - 1,animaH - 1), _
          tiger(frameNum)
   next frameNum
end scope

dim as double   viewAngle   = 1.0
dim as long      viewRadius   = 200


'---------------------------------
dim as long      animationStep   => 0
dim as long      animationSlower   => 0
dim as long      sideStep      => 0
dim as long      depthStep      => 0
dim as long      jumpStep      => 0
dim as boolean   jumpStarted      => FALSE
do
   '------------------interaction
   if jumpStarted then
      animationStep = 4
      if jumpStep<40 then
         jumpStep   += 1
         if jumpStep<20 then
            viewAngle += 0.01
            depthStep   += +12
         else
            viewAngle -= 0.01
            depthStep   += +1
         end if
      else
         viewAngle   = 1.0
         jumpStep   = 0
         jumpStarted   = FALSE
      end if
   else
      if animationStep=4 then
         animationStep   = 1
         animationSlower   = 9
      end if
      animationSlower += 1
      if animationSlower>10 then
         animationSlower   = 0
         animationStep   += 1
         if    animationStep>=4 then    animationStep = 0
      end if
   end if
   select case INTERACTIONTEST.TestKeyboard()
      case fb.SC_SPACE
         if not jumpStarted then jumpStarted = TRUE
      case fb.SC_LEFT + fb.SC_UP
         sideStep   += -2
         depthStep   += +2
      case fb.SC_LEFT + fb.SC_DOWN
         sideStep   += -2
         depthStep   += -2
      case fb.SC_RIGHT + fb.SC_UP
         sideStep   += +2
         depthStep   += +2
      case fb.SC_RIGHT + fb.SC_DOWN
         sideStep   += +2
         depthStep   += -2
      case fb.SC_LEFT
         sideStep   += -2
      case fb.SC_RIGHT
         sideStep   += +2
      case fb.SC_DOWN
         depthStep   += -2   
      case fb.SC_UP
         depthStep   += +2
      case else
         animationSlower -= 1
         sideStep   += 0
         depthStep   += 0      
   end select 'INTERACTIONTEST.TestKeyboard()

   '----------------------drawing
   screenLock
   cls
   ? "Help the lion king to reach the great city of kings"
   ? "<ARROW KEY> move .. <SPACE> jump .. <ESC> leave out"
   
   'draw horizon-incident tile border
   for i as long = 0 to 100
      line (sideStep + SCREENTEST.scrW\2 - (i + 1/2)*imgW,SCREENTEST.scrH)- _
      (SCREENTEST.scrW\2,SCREENTEST.scrH - viewRadius*tan(viewAngle)), rgb(080,170 - 4*i,090)
      line (sideStep + SCREENTEST.scrW\2 + (i + 1/2)*imgW,SCREENTEST.scrH)- _
      (SCREENTEST.scrW\2,SCREENTEST.scrH - viewRadius*tan(viewAngle)), rgb(080,170 - 4*i,090)      
   next i
   'draw horizon-parallel tile border
   for n as long = -1 to -150 step -1
      dim as single   borderStep   = SCREENTEST.scrH\2 + (n - 1/2)*imgH + depthStep mod imgH
      dim as single   cYn         
      dim as single   cZn         
      cYn   = + viewRadius*sin(viewAngle)*sin(viewAngle)*borderStep/ _
                              (viewRadius - cos(viewAngle)*borderStep)
      cZn   = - viewRadius*cos(viewAngle)*sin(viewAngle)*borderStep/ _
                              (viewRadius - cos(viewAngle)*borderStep)
      line (0,SCREENTEST.scrH - sqr(cYn^2 + cZn^2))-step(SCREENTEST.scrW,0), rgb(080,170 - n,090)
   next n
   
   put (SCREENTEST.scrW\2,SCREENTEST.scrH - animaH - animationStep*5), tiger(animationStep), TRANS
   screenUnlock

   '
   sleep 15
loop until inkey=chr(27)


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


'[end of file]
Last edited by Tourist Trap on Feb 04, 2016 9:35, edited 1 time in total.
fxm
Posts: 8972
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Tile - the perspective way

Postby fxm » Feb 03, 2016 15:15

1.
Only non-derived types must have at least a non-static member variable.
Any type which extends another type (including 'Extends Object') can be empty of any own member variable.
=> you can suppress all 'as OBJECT _fieldPlaceHolder'.

2.
ScreenInfo declaration in documentation:
Declare Sub ScreenInfo ( ByRef w As Integer = 0, ByRef h As Integer = 0, ByRef depth As Integer = 0, ByRef bpp As Integer = 0, ByRef pitch As Integer = 0, ByRef rate As Integer = 0, ByRef driver As String = "" )
MrSwiss
Posts: 3083
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: Tile - the perspective way

Postby MrSwiss » Feb 03, 2016 16:27

Sorry to but in on ScreenInfo ...

Just because ScreenInfo wants Integer, and a lot of WIN programmers prefer Long instead,
I've coded the "getScrInfo Sub()" which wraps ScreenInfo and returns LONG(s), NOT Integer!!
Search Tips&Tricks for the Name given above ...
Tourist Trap
Posts: 2756
Joined: Jun 02, 2015 16:24

Re: Tile - the perspective way

Postby Tourist Trap » Feb 04, 2016 9:33

fxm wrote:1.
Only non-derived types must have at least a non-static member variable.
Any type which extends another type (including 'Extends Object') can be empty of any own member variable.
=> you can suppress all 'as OBJECT _fieldPlaceHolder'.
2.
ScreenInfo declaration in documentation:
Declare Sub ScreenInfo ( ByRef w As Integer = 0, ByRef h As Integer = 0, ByRef depth As Integer = 0, ByRef bpp As Integer = 0, ByRef pitch As Integer = 0, ByRef rate As Integer = 0, ByRef driver As String = "" )

This is fixed. But are you sure that not using Integer for ScreenInfo() parameters would crash a 64 bits OS? Shouldn't it be casted anyway? This not pointers, just simple numeric parameters here.
fxm
Posts: 8972
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Tile - the perspective way

Postby fxm » Feb 04, 2016 10:33

Tourist Trap wrote:This is fixed. But are you sure that not using Integer for ScreenInfo() parameters would crash a 64 bits OS?
Yes, it induces a compiler error for fbc 64-bit (checked).

Tourist Trap wrote:Shouldn't it be cast anyway? This not pointers, just simple numeric parameters here.
The problem occurs only when passing parameters by reference:
- No problem when passing by value, because compiler can do an implicit conversion before passing.
- When passing by reference, in fact a pointer is passed and value is written by dereferencing the pointer.
(not any possibility of casting)


In your 2nd code, other variables to be modified:
- dim as integer scrW, scrH ' in constructor BUTTON()
- dim as integer drawingZoneW ' in main code
- dim as integer drawingZoneH ' in main code
Last edited by fxm on Sep 02, 2017 20:15, edited 1 time in total.
Tourist Trap
Posts: 2756
Joined: Jun 02, 2015 16:24

Re: Tile - the perspective way

Postby Tourist Trap » Feb 09, 2016 14:14

fxm wrote:The problem occurs only when passing parameters by reference:
- No problem when passing by value, because compiler can do an implicit conversion before passing.
- When passing by reference, in fact a pointer is passed and value is written by dereferencing the pointer.
(not any possibility of casting)

I'm not sure I understand what is done exactly here. However thanks for the remark. I'm still convinced that the documentation is not insisting enough on the fact that there won't be any cast, and pointers are involved, so Integer type is mandatory. It could lead to many compatibility issues. Thanks for the corrections and remarks anyway.

Whatever!
I've made some progress with the perspective grid calculation. Here the new demo code. Have a try, any comment is welcome. Ah yes I need to post something about macros also. A rather annoying issue (fixed here).

Code: Select all

'---------------------------------
'rotation of a plane grid network
'provided 3D space eye parameter 
'---------------------------------


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

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

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

#include "fbgfx.bi"

#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)   and multiKey(fb.SC_UP)      then
      scanCodeResult   =    fb.SC_LEFT + fb.SC_UP
   elseif   multiKey(fb.SC_LEFT)   and multiKey(fb.SC_DOWN)   then
      scanCodeResult   =    fb.SC_LEFT + fb.SC_DOWN
   elseif   multiKey(fb.SC_RIGHT)   and multiKey(fb.SC_UP)      then
      scanCodeResult   =    fb.SC_RIGHT + fb.SC_UP
   elseif   multiKey(fb.SC_RIGHT)   and 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
    '---->
    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   and THIS._x<=THIS.scrW      and _
          THIS._y>=0   and 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 and  THIS._x<=THIS.scrW and _
      THIS._y>=0 and  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 and (THIS._p1)._y=(THIS._p2)._y ) then
      case1   = TRUE
      'no line to draw
      exit sub
   elseif _
      ( (THIS._p1)._x=(THIS._p2)._x and (THIS._p1)._y<>(THIS._p2)._y ) then
      case2   = TRUE
      if (THIS._p1)._x>=0 and (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 and (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 and (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 or 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()


'---------------------------------
screenRes screenWidth, _
          screenHeight, _
          32
color rgb(0,200,0)
SCREENTEST.TestScreen()

'---------------------------------
'initial plane grid
dim as SCREENBIPOINTLINE   arrayOfVerticalLine(9)
/'
for index as long = 0 to uBound(arrayOfVerticalLine)
   dim as long   n => index - (uBound(arrayOfVerticalLine) + 1)\2
   arrayOfVerticalLine(index)   => _
   SCREENBIPOINTLINE(type<POINT2D>(SCREENTEST.scrW\2 + imgW*(1/2 - sgn(n)*n)*sgn(n), 0, "!"), _
                 type<POINT2D>(SCREENTEST.scrW\2 + imgW*(1/2 - sgn(n)*n)*sgn(n), 1, "!"), _
                 iif(n<>0,rgb(90,70,150),rgb(90,70,190)) )
   arrayOfVerticalLine(index).DrawLine()
next index
'/

dim as SCREENBIPOINTLINE   arrayOfHorizontalLine(9)
/'
for index as long = 0 to uBound(arrayOfHorizontalLine)
   dim as long   n => index - (uBound(arrayOfHorizontalLine) + 1)\2
   arrayOfHorizontalLine(index)   => _
   SCREENBIPOINTLINE(type<POINT2D>(0, SCREENTEST.scrH/2 + sgn(n)*imgH*(1/2 - sgn(n)*n), "!"), _
                 type<POINT2D>(1, SCREENTEST.scrH/2 + sgn(n)*imgH*(1/2 - sgn(n)*n), "!"), _
                 iif(n<>0,rgb(150,70,90),rgb(190,70,90)) )
   arrayOfHorizontalLine(index).DrawLine()
next index
'/

'---------------------------------
'observation point parameter
dim as double   rE   => 100.
dim as double   aE   => 55*_pi/180

'source plane grid orientation
dim as double   rA   => 100
dim as double   aA   => 35.*_pi/180

'---------------------------------
'---------------------------------
'---------------------------------
dim as double      angleStep => .01
do
   aA   += angleStep
   if aA>(_pi/2)   then angleStep *= -1
   if aA<00      then angleStep *= -1
   
   screenLock
   cls
   'parameter of intersection with the screen
   ' *AE inter screen_plane* = IA
   ' *BE inter screen_plane* = IB
   dim as double   pA   => -rE*1/(rA*sin(aA)*cos(aE) + rE)
   dim as double   pB   => -rE*1/(rA*cos(aA)*cos(aE) + rE)
   
   dim as double   xIA => 0000000000 - pA*( rA*cos(aA) )
   dim as double   yIA => rE*cos(aE) - pA*( - rA*sin(aA) - rE*cos(aE))
   dim as double   zIA => rE*sin(aE)*(1 + pA)
   
   dim as double   xIB => 000000000 - pB*( -rA*sin(aA) )
   dim as double   yIB => rE*cos(aE) - pB*( -rA*cos(aA) - rE*cos(aE))
   dim as double   zIB => rE*sin(aE)*(1 + pB)
   
   'screen plane grid main X,Y axis after rotation
   dim as double   alfa   => acos( xIA/(sqr( xIA^2 + yIA^2 + zIA^2 )) )
   dim as double   beta   => acos( xIB/(sqr( xIB^2 + yIB^2 + zIB^2 )) )
   
   dim as double   xHA      => rE*tan(aE)/tan(alfa)
   dim as double   yHA      => -rE*tan(aE)
   
   dim as double   xHB      => rE*tan(aE)/tan(beta)
   dim as double   yHB      => -rE*tan(aE)
   
   dim as SCREENBIPOINTLINE   horizon
   horizon   => SCREENBIPOINTLINE(type<POINT2D>(0,yHA + SCREENTEST.scrH\2,"h0"), _
                         type<POINT2D>(SCREENTEST.scrW,yHA + SCREENTEST.scrH\2,"h1"), _
                         rgb(100,190,120) )
      'draw horizon line
      horizon.DrawLineWithPoint()
   
   dim as SCREENBIPOINTLINE   xAxis
   xAxis   => SCREENBIPOINTLINE(type<POINT2D>(0 + SCREENTEST.scrW\2,0 + SCREENTEST.scrH\2,"o"), _
                         type<POINT2D>(xHA + SCREENTEST.scrW\2,yHA + SCREENTEST.scrH\2,"HA", rgb(180,100,100)))
      'draw X axis rotated
      'xAxis.DrawLineWithPoint()
   
   dim as SCREENBIPOINTLINE   yAxis
   yAxis   => SCREENBIPOINTLINE(type<POINT2D>(0 + SCREENTEST.scrW\2,0 + SCREENTEST.scrH\2,"o"), _
                         type<POINT2D>(xHB + SCREENTEST.scrW\2,yHB + SCREENTEST.scrH\2,"HB", rgb(100,100,180)))
      'draw Y axis rotated
      'yAxis.DrawLineWithPoint()
   
   'rotated grid line in the original grid plane
      'vertical grid line equation
      #macro _X(n)
         (sgn(n)*imgW*(1/2 - sgn(n)*n) + SCREENTEST.scrW\2)
      #endMacro
      'horizontal grid line equation
      #macro _Y(n)
         (sgn(n)*imgH*(1/2 - sgn(n)*n) + SCREENTEST.scrH\2)
      #endMacro
      'rotation of vertical grid line
      #macro _XRV(n,t)
         ((_X(n) - SCREENTEST.scrW\2)*cos(_pi - aA) - (t)*sin(_pi - aA) + SCREENTEST.scrW\2)
      #endMacro
      #macro _YRV(n,t)
         ((_X(n) - SCREENTEST.scrW\2)*sin(_pi - aA) + (t)*cos(_pi - aA) + SCREENTEST.scrH\2)
      #endMacro
      'rotation of horizontal grid line
      #macro _XRH(n,t)
         ((t)*cos(-aA) - (_Y(n) - SCREENTEST.scrH\2)*sin(-aA)  + SCREENTEST.scrW\2)
      #endMacro
      #macro _YRH(n,t)
         ((t)*sin(-aA) + (_Y(n) - SCREENTEST.scrH\2)*cos(-aA) + SCREENTEST.scrH\2)
      #endMacro
      
      'display vertical point for n=0, t=100
      '(type<POINT2D>(_XRV(0,100), _YRV(0,100), "vert0,1", rgb(0,0,120))).DrawPoint2D()
      'display vertical point for n=0, t=200
      (type<POINT2D>(_XRV(0,200), _YRV(0,200), "vert0,2", rgb(0,0,120))).DrawPoint2D()
      'display vertical line
      '(type<SCREENBIPOINTLINE> _
      '(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), "hori0,2", rgb(190,0,0))).DrawPoint2D()
      'display horizontal line
      '(type<SCREENBIPOINTLINE> _
      '(type<POINT2D>(_XRH(0,-100), _YRH(0,-100),""),type<POINT2D>(_XRH(0,200), _YRH(0,200),""), rgb(150,0,0))).DrawLine()
   
   /'
      for n as long = -10 to 10
         'display vertical line
         (type<SCREENBIPOINTLINE> _
         (type<POINT2D> _
         (_XRV(n,-100), _YRV(n,-100),""),type<POINT2D>(_XRV(n,200), _YRV(n,200),""), rgb(0,0,120))).DrawLine()
         'display horizontal line
         (type<SCREENBIPOINTLINE> _
         (type<POINT2D>_
         (_XRH(n,-100), _YRH(n,-100),""),type<POINT2D>(_XRH(n,200), _YRH(n,200),""), rgb(150,0,0))).DrawLine()      
      next n
   '/
   
      '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   scrCenter
      scrCenter._x   => SCREENTEST.scrW\2
      scrCenter._y   => SCREENTEST.scrH\2
      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   => SCREENTEST.scrW\2 + 1
      xAxisUnit._y   => SCREENTEST.scrH\2
      
      ? _VECTANGLE(scrCenter,xAxisUnit,hori00) *180/_pi   
      ? _VECTANGLE(scrCenter,xAxisUnit,vert00) *180/_pi
   
   
   'compute and store intersection of rotated grid line with X axis
   
   
   #macro _RHX(n)
      ( _XRH(n,0) + ( SCREENTEST.scrH\2 - _YRH(n,0)) * ( _XRH(n,1) - _XRH(n,0) )/( _YRH(n,1) - _YRH(n,0) ) )
   #endMacro
   #macro _RVX(n)
      ( _XRV(n,0) + ( SCREENTEST.scrH\2 - _YRV(n,0)) * ( _XRV(n,1) - _XRV(n,0) )/( _YRV(n,1) - _YRV(n,0) ) )
   #endMacro
   
   /'
   for n as long = -5 to 5
      'horizontal case
      (type<SCREENBIPOINTLINE> _
      (type<POINT2D>(_XRH(n,0), _YRH(n,0),""),type<POINT2D>(_XRH(n,1), _YRH(n,1),""), rgb(200,150,0))).DrawLine()
      (type<POINT2D>(_RHX(n) , SCREENTEST.scrH\2, "h"& str(n), rgb(220,100,100))).DrawPoint2D()
      
      'vertical case
      (type<SCREENBIPOINTLINE> _
      (type<POINT2D>(_XRV(n,0), _YRV(n,0),""),type<POINT2D>(_XRV(n,1), _YRV(n,1),""), rgb(0,150,200))).DrawLine()
      (type<POINT2D>(_RVX(n) , SCREENTEST.scrH\2, "v"& str(n), rgb(100,100,220))).DrawPoint2D()
   next n
   '/
   
   'draw perspective grid
   dim as POINT2D   xAxisHorizonPoint
   xAxisHorizonPoint._x   => xHA  + SCREENTEST.scrW\2
   xAxisHorizonPoint._y   => yHA  + SCREENTEST.scrH\2
   
   dim as POINT2D   yAxisHorizonPoint
   yAxisHorizonPoint._x   => xHB  + SCREENTEST.scrW\2
   yAxisHorizonPoint._y   => yHB  + SCREENTEST.scrH\2
   
   for n as long = -45 to 45
      if n=0 then continue for
      
      'horizontal line
      (type<SCREENBIPOINTLINE> _
      (type<POINT2D>(_RHX(n) , SCREENTEST.scrH\2,""),xAxisHorizonPoint, rgb(200,150,200))).DrawLine()
      
      'vertical case
      (type<SCREENBIPOINTLINE> _
      (type<POINT2D>(_RVX(n) , SCREENTEST.scrH\2,""),yAxisHorizonPoint, rgb(200,150,200))).DrawLine()
   next n
   
   'draw sky box
      line (0,0)-(SCREENTEST.scrW, yHA  + (100/95)*SCREENTEST.scrH\2), rgb(140,150,180), bf
   
   'draw view center
      circle(SCREENTEST.scrW\2, SCREENTEST.scrH\2), 8, rgb(220,140,155), , , , f
   
   /'
   ? sqr( xIA^2 + (yIA - rE*cos(aE))^2 + (zIA - rE*sin(aE))^2 )
   ? "EA="; sqr( (rA*cos(aA))^2 + (-rA*sin(aA) - rE*cos(aE))^2 + ( -rE*sin(aE))^2 )
   ? sqr( xIB^2 + (yIB - rE*cos(aE))^2 + (zIB - rE*sin(aE))^2 )
   ? "EB="; sqr( (-rA*sin(aA))^2 + (-rA*cos(aA) - rE*cos(aE))^2 + ( -rE*sin(aE))^2 )
   '/
   screenUnlock
   
   '
   sleep 75
loop until inkey=chr(27)


sleep
end 0
leopardpm
Posts: 1791
Joined: Feb 28, 2009 20:58

Re: Tile - the perspective way

Postby leopardpm » Apr 10, 2016 17:48

very interesting! keep going, Mr. Trap
Tourist Trap
Posts: 2756
Joined: Jun 02, 2015 16:24

Re: Tile - the perspective way

Postby Tourist Trap » Apr 11, 2016 13:51

leopardpm wrote:very interesting! keep going, Mr. Trap

Hi leopardpm,

Yes that's funny.

I will try continue this as soon as possible. However I've not found yet the way to transform a rectangle tile to any quadrangle. I'm sure I'm missing a tiny trick, but not found yet. And for the grid projection I will need to rewrite it from start now that I can see what it looks like. There are one or two weak points that I need to get reinforced in all those intersections formulas.

So it's potentially long, and I'm right now fighting with files to make a communication system between two programs Passing messages to a unique file on disk. Doing that clean (checking file possible errors) is not that easy so far...
leopardpm
Posts: 1791
Joined: Feb 28, 2009 20:58

Re: Tile - the perspective way

Postby leopardpm » Apr 11, 2016 16:33

Tourist Trap wrote:So it's potentially long, and I'm right now fighting with files to make a communication system between two programs Passing messages to a unique file on disk. Doing that clean (checking file possible errors) is not that easy so far...
sounds like a useful routine... start another thread!
Tourist Trap
Posts: 2756
Joined: Jun 02, 2015 16:24

Re: Tile - the perspective way

Postby Tourist Trap » Apr 13, 2016 13:42

leopardpm wrote:...start another thread!

Yes you're right of course. Here is it:
  • http://www.freebasic.net/forum/viewtopic.php?f=7&t=24604
  • http://www.freebasic.net/forum/viewtopic.php?f=8&t=24578
dodicat
Posts: 5771
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Tile - the perspective way

Postby dodicat » Apr 13, 2016 23:43

A grid, similar to tourist trap's.

Code: Select all

Screen 20
#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
#define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
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
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)
    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)
        Dim As long rad=map(-900,900,a(n).z,8,2)
       if n<> ubound(a)\2-1 then Circle(a(n).x,a(n).y),rad,5,,,,f
        rad=map(-900,900,a(n+1).z,8,2)
       if n<> ubound(a)\2-1 then Circle(a(n+1).x,a(n+1).y),rad,4,,,,f
    Next n
End Sub
'========================================================


Redim As V3 pts()
Dim As Single pi=4*Atn(1)

'create all the points
Dim As long ctr,fps
Dim As Long k=400,yy
For n As long=1 To 200 Step 4
    ctr+=1
    k=-k
    Redim Preserve pts(1 To ctr)
    pts(ctr)=Type<V3>(10*ctr+262,768\2,-k)
Next n
reDim As V3 rot(Lbound(pts) To Ubound(pts))
var tmp=ubound(pts)
'create another set, 90 degrees to first set.
For n As long=Lbound(pts) To Ubound(pts)
    rot(n)=pts(n).axialrotate(Type(1024/2,768/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
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))


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
'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

redim rot(lbound(t) to ubound(T))
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>(1024\2,768\2,0),ang,axis)
        rot(n)=rot(n).perspective(Type<v3>(1024\2,768\2,900))
    Next n
    drawarray(rot())
   
    Screenunlock
    Sleep regulate(50,fps)
Loop Until inkey=chr(27)
Print Ubound(pts)
Sleep



 

Return to “Game Dev”

Who is online

Users browsing this forum: No registered users and 2 guests