Do you _MAPTRIANGLE? - Printable Version

Code: (Select All)
'imperfect false grid, doesn't work perfectly but it's an example of using _maptriangle to "paint"

Screen _NewImage(800, 500, 32)

'prepare the fill triangle

t& = _NewImage(9, 9, 32)

_Dest t&

Paint (2, 2), _RGB32(200, 200) 'i use paint here because it only gets called once and I wouldn't remember what is going on otherwise

_Dest 0

_DontBlend 0

'get the maze ready

maxx = 61

maxy = 41

Dim grid(0 To maxx + 1, 0 To maxy + 1, 1 To 2)

Dim map(0 To maxx + 1, 0 To maxy + 1)

Do

    Cls

    'make flasegrid

    ybias = 0

    trend = Int(-1 + Rnd * 3)

    For y = 0 To maxy + 1

        trend = Int(-2 + Rnd * 5)



        For x = 0 To maxx + 1

            ybias = ybias + ((trend * (Rnd * 6)) / 30)

            grid(x, y, 1) = x * 10 + Int(Rnd * 4) - Int(Rnd * 4)

            grid(x, y, 2) = Int(y * 10 + Int(Rnd * 4) - Int(Rnd * 4) + ybias)

            map(x, y) = 1

        Next x

    Next y

    'drunk wandering maze

    sx = 4 + Int(Rnd * (maxx - 4))

    sy = 4 + Int(Rnd * (maxy - 4))

    lastgo = Int(1 + Rnd * 4)

    drun = Int(1 + Rnd * 4)

    For c = 1 To 1800

        dgo = Int(1 + Rnd * 6)

        If dgo = 6 Then drun = Int(1 + Rnd * 4)

        If dgo > 4 Then dgo = lastgo

        Select Case dgo

            Case 1

                If sy - drun > 1 Then

                    For ny = sy To sy - drun Step -1

                        map(sx, ny) = 0

                        sy = ny

                    Next ny

                End If

                c = c + drun

            Case 2

                If sx + drun < maxx - 1 Then

                    For nx = sx To sx + drun

                        map(nx, sy) = 0

                        sx = nx

                    Next nx

                End If

                c = c + drun

            Case 3

                If sy + drun < maxy - 1 Then

                    For ny = sy To sy + drun

                        map(sx, ny) = 0

                        sy = ny

                    Next ny

                End If

                c = c + drun

            Case 4

                If sx - drun > 1 Then

                    For nx = sx To sx - drun Step -1

                        map(nx, sy) = 0

                        sx = nx

                    Next nx

                End If

                c = c + drun

        End Select

        lastgo = dgo

    Next c



    'show maze

    For y = 0 To maxy - 1

        For x = 0 To maxx - 1

            If map(x, y) > 0 Then

                x1 = grid(x, y, 1)

                x2 = grid(x + 1, y, 1)

                x3 = grid(x + 1, y + 1, 1)

                x4 = grid(x, y + 1, 1)



                y1 = grid(x, y, 2)

                y2 = grid(x + 1, y, 2)

                y3 = grid(x + 1, y + 1, 2)

                y4 = grid(x, y + 1, 2)

'filling the irregular cells with _maptriangle instead of paint so there is no need to worry about "leaking" 

                _MapTriangle (0, 0)-(0, 8)-(8, 8), t& To(x1, y1)-(x2, y2)-(x3, y3)

                _MapTriangle (0, 0)-(0, 8)-(8, 0), t& To(x1, y1)-(x3, y3)-(x4, y4)

            End If

        Next x

    Next y





    For y = 0 To maxy - 1

        For x = 0 To maxx - 1

            If map(x, y) = 0 Then

                cx = (grid(x, y, 1) + grid(x + 1, y, 1) + grid(x, y + 1, 1) + grid(x + 1, y + 1, 1)) / 4

                cy = (grid(x, y, 2) + grid(x + 1, y, 2) + grid(x, y + 1, 2) + grid(x + 1, y + 1, 2)) / 4

                ' Circle (cx, cy), 1, _RGB32(250, 0, 0)

                'not really doing anything right now... it was earlier, it might do so again

            End If

        Next x

    Next y

    Do

        _Limit 60

        kk$ = InKey$

    Loop Until kk$ <> ""

Loop Until kk$ = Chr$(27)