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?
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.
This leads to a first code attempt to deal with perspective grid. This is based on the simple implementation of the following scheme:
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]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.
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.)
