09-24-2023, 02:46 PM
(This post was last modified: 09-24-2023, 02:46 PM by James D Jarvis.)
just messing about with a demo by SMcNeil. https://qb64phoenix.com/forum/showthread...5#pid20025
Code: (Select All)
'isometric nonsense
'just messing with the isometric routines posted by SMcNeil
'here: https://qb64phoenix.com/forum/showthread.php?tid=2029&pid=20025#pid20025
'used the WASD to move a pillar about
Screen _NewImage(1024, 720, 32)
_FullScreen
Dim Shared GridSize As Integer
Dim Kolor As _Unsigned Long
Const Red = &HFFFF0000, Green = &HFF00FF00
GridSize = 12 'this uses 12x12 pixels
Dim Shared gridmax
Dim px, py, pht
Randomize Timer
px = 2: py = 2
gridmax = 40
Dim ght(gridmax, gridmax) As Integer
Dim gd(gridmax, gridmax) As _Byte
Dim gk(gridmax, gridmax) As _Unsigned Long
For y = 0 To gridmax: For x = 0 To gridmax: ght(x, y) = Int(1 + Rnd * 4): gd(x, y) = 1: gk(x, y) = _RGB32(Int(20 + Rnd * 230), Int(20 + Rnd * 230), Int(20 + Rnd * 230)): Next x: Next y
_PrintString (350, 360), "3D Isometic Perspective"
n = -1
lastfill = 0
pht = ght(px, py) + 100
Do
_Limit 20
Cls
n = n + 1: If n > (gridmax) Then n = 0
lastlift = lastfil / 2
For y = 0 To gridmax
For x = 0 To gridmax
If x = px And y = py Then
ght(x, y) = pht
gk(x, y) = Red
End If
xpos = x * GridSize + 100: ypos = y * GridSize + 100
xpos2 = xpos + GridSize: ypos2 = ypos + GridSize
IsoLine3D xpos, ypos, xpos2, ypos2, ght(x, y), 500, 100, gk(x, y)
If x = n Then
lift = Int(Rnd * (lastlift + 2))
ght(x, y) = ght(x, y) + lift * gd(x, y)
lastlift = lift
If ght(x, y) < 3 Then
ght(x, y) = 3: gd(x, y) = gd(x, y) * -1
End If
If ght(x, y) > 121 Then
If x <> px And y <> py Then
ght(x, y) = 121
End If
gd(x, y) = gd(x, y) * -1
End If
End If
Next
Next
_Display
kk$ = InKey$
Select Case kk$
Case " "
For y = 0 To gridmax: For x = 0 To gridmax: gk(x, y) = _RGB32(Int(20 + Rnd * 230), Int(20 + Rnd * 230), Int(20 + Rnd * 230)): Next x: Next y
Case "n", "N"
For y = 0 To gridmax: For x = 0 To gridmax: ght(x, y) = 3: Next x: Next y
Case "m", "m"
For y = 0 To gridmax: For x = 0 To gridmax
If ght(x, y) < 100 Then ght(x, y) = ght(x, y) + 8
Next x: Next y
Case "w", "W"
gk(px, py) = _RGB32(Int(20 + Rnd * 230), Int(20 + Rnd * 230), Int(20 + Rnd * 230))
ght(px, py) = ght(px, py) - 100
py = py - 1
If py = -1 Then py = 0
pht = ght(px, py) + 100
Case "s", "S"
gk(px, py) = _RGB32(Int(20 + Rnd * 230), Int(20 + Rnd * 230), Int(20 + Rnd * 230))
ght(px, py) = ght(px, py) - 100
py = py + 1
If py > gridmax Then py = gridmax
pht = ght(px, py) + 100
Case "a", "A"
gk(px, py) = _RGB32(Int(20 + Rnd * 230), Int(20 + Rnd * 230), Int(20 + Rnd * 230))
ght(px, py) = ght(px, py) - 100
px = px - 1
If px = -1 Then px = 0
pht = ght(px, py) + 100
Case "d", "D"
gk(px, py) = _RGB32(Int(20 + Rnd * 230), Int(20 + Rnd * 230), Int(20 + Rnd * 230))
ght(px, py) = ght(px, py) - 100
px = px + 1
If px > gridmax Then px = gridmax
pht = ght(px, py) + 100
End Select
Loop Until kk$ = Chr$(27)
Function CX2I (x As Long, y As Long) 'Convert Cartesian X To Isometic coordinates
CX2I = x - y
End Function
Function CY2I (x As Long, y As Long) 'Convert Cartesian Y To Isometic coordinates
CY2I = (x + y) / 2
End Function
Sub IsoLine (x, y, x2, y2, xoffset, yoffset, kolor As _Unsigned Long)
'since we're drawing a diamond and not a square box, we can't use Line BF.
'We have to manually down the 4 points of the line.
Line (CX2I(x, y) + xoffset, CY2I(x, y) + yoffset)-(CX2I(x2, y) + xoffset, CY2I(x2, y) + yoffset), kolor
Line -(CX2I(x2, y2) + xoffset, CY2I(x2, y2) + yoffset), kolor
Line -(CX2I(x, y2) + xoffset, CY2I(x, y2) + yoffset), kolor
Line -(CX2I(x, y) + xoffset, CY2I(x, y) + yoffset), kolor
Paint (CX2I(x, y) + xoffset, CY2I(x, y) + 4), kolor 'and fill the diamond solid
Line (CX2I(x, y) + xoffset, CY2I(x, y) + yoffset)-(CX2I(x2, y) + xoffset, CY2I(x2, y) + yoffset), &HFFFFFFFF
Line -(CX2I(x2, y2) + xoffset, CY2I(x2, y2) + yoffset), &HFFFFFFFF
Line -(CX2I(x, y2) + xoffset, CY2I(x, y2) + yoffset), &HFFFFFFFF
Line -(CX2I(x, y) + xoffset, CY2I(x, y) + yoffset), &HFFFFFFFF
End Sub
Sub IsoLine3D (x, y, x2, y2, z, xoffset, yoffset, kolor As _Unsigned Long)
'Like IsoLine, we're going to have to draw our lines manually.
'only in this case, we also need a Z coordinate to tell us how THICK/TALL/HIGH to make our tile
'Let's just do all the math first this time.
'We need to turn those 4 normal points into 4 isometric points (x, y, x1, y1)
TempX1 = CX2I(x, y) + xoffset: TempY1 = CY2I(x, y) + yoffset
TempX2 = CX2I(x2, y) + xoffset: TempY2 = CY2I(x2, y) + yoffset
TempX3 = CX2I(x2, y2) + xoffset: TempY3 = CY2I(x2, y2) + yoffset
TempX4 = CX2I(x, y2) + xoffset: TempY4 = CY2I(x, y2) + yoffset
'The top
FillQuad TempX1, TempY1 - z, TempX2, TempY2 - z, TempX3, TempY3 - z, TempX4, TempY4 - z, kolor
Line (TempX1, TempY1 - z)-(TempX2, TempY2 - z), -1 'and redraw the grid
Line -(TempX3, TempY3 - z), -1
Line -(TempX4, TempY4 - z), -1
Line -(TempX1, TempY1 - z), -1
If z <> 0 Then 'no need to draw any height, if there isn't any.
'the left side
FillQuad TempX4, TempY4 - z, TempX4, TempY4, TempX3, TempY3, TempX3, TempY3 - z, kolor
Line (TempX4, TempY4 - z)-(TempX4, TempY4), -1 'redraw the grid lines
Line -(TempX3, TempY3), -1
Line -(TempX3, TempY3 - z), -1
Line -(TempX4, TempY4 - z), -1
'and then for the right side
FillQuad TempX3, TempY3 - z, TempX3, TempY3, TempX2, TempY2, TempX2, TempY2 - z, kolor
Line (TempX3, TempY3 - z)-(TempX3, TempY3), -1 'redraw the grid lines
Line -(TempX2, TempY2), -1
Line -(TempX2, TempY2 - z), -1
Line -(TempX3, TempY3 - z), -1
End If
End Sub
Sub FillTriangle (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
Dim D As Long
Static a&
D = _Dest
If a& = 0 Then a& = _NewImage(1, 1, 32): _DontBlend a& '<< fix ??
_Dest a&
PSet (0, 0), K
_Dest D
_MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
End Sub
Sub FillQuad (x1, y1, x2, y2, x3, y3, x4, y4, K As _Unsigned Long)
FillTriangle x1, y1, x2, y2, x3, y3, K
FillTriangle x3, y3, x4, y4, x1, y1, K
End Sub
