## Hexagonal Grid

General FreeBASIC programming questions.
duke4e
Posts: 717
Joined: Dec 04, 2005 0:16
Location: Varazdin, Croatia, Europe
Contact:

### Hexagonal Grid

Hey,

Does anyone have more elegant function for drawing hexagonal grid and to detect in witch hexagon/array position is the mouse.

Code: Select all

`#include "fbgfx.bi"Using FBConst Pi = Atn(1) * 4Const RAD = Pi / 180Const DEG = 180 / PiConst xres = 800Const yres = 600Screenres xres, yres, 32Sub DrawHex(x As Integer, y As Integer, h As Integer, mycolor As Uinteger = Rgb(225, 225, 225))    Dim As Single h2 = h / 2    Dim As Single s = h / Cos(30 * RAD) / 2    Dim As Single tilex = x * s * 1.5f    Dim As Single tiley = y * h + (x Mod 2) * h2        h2 *= 1.16    Line(tilex + Cos(0 * RAD) * h2, tiley + Sin(0 * RAD) * h2)-(tilex + Cos(60 * RAD) * h2, tiley + Sin(60 * RAD) * h2), mycolor    Line(tilex + Cos(60 * RAD) * h2, tiley + Sin(60 * RAD) * h2)-(tilex + Cos(120 * RAD) * h2, tiley + Sin(120 * RAD) * h2), mycolor    Line(tilex + Cos(120 * RAD) * h2, tiley + Sin(120 * RAD) * h2)-(tilex + Cos(180 * RAD) * h2, tiley + Sin(180 * RAD) * h2), mycolor    Line(tilex + Cos(180 * RAD) * h2, tiley + Sin(180 * RAD) * h2)-(tilex + Cos(240 * RAD) * h2, tiley + Sin(240 * RAD) * h2), mycolor    Line(tilex + Cos(240 * RAD) * h2, tiley + Sin(240 * RAD) * h2)-(tilex + Cos(300 * RAD) * h2, tiley + Sin(300 * RAD) * h2), mycolor    Line(tilex + Cos(300 * RAD) * h2, tiley + Sin(300 * RAD) * h2)-(tilex + Cos(0 * RAD) * h2, tiley + Sin(0 * RAD) * h2), mycolorEnd SubConst size = 64Dim As Integer mx, myDo    Getmouse mx, my        Dim As Single s = size / Cos(30 * RAD) / 2    Dim As Integer arrayx = mx / s / 1.5f    Dim As Integer arrayy = (my - (arrayx Mod 2) * size / 2) / size        Screenlock    Color Rgb(0, 0, 0), Rgb(255, 255, 255)    Cls    For x As Integer = 0 To 14        For y As Integer = 0 To 9            DrawHex x, y, size        Next    Next        DrawHex arrayx, arrayy, size, Rgb(0, 0, 0)    Locate 1, 1 : Print arrayx; arrayy    ScreenunlockLoop Until Multikey(SC_ESCAPE)`

http://www.gamedev.net/reference/articles/article1800.asp
http://www.tonypa.pri.ee/tbw/tut25.html

I've been tossing with those tutorials, but the gamedev one is "wrongly rotated" and hard to follow, while the other tutorial lacks information about drawing hexagon, and mouse to hexagon array isn't 100% correct.
Eclipzer
Posts: 432
Joined: Oct 01, 2005 10:50
Location: Maryland
Contact:
Your mouse collision seems elegant enough to me. You're translating mosue x,y coordinates into hex x,y coordinates using 3 lines. You might be able to optimize the calculations in there, but still that type of set up is what you want. Also, can you elaborate where the "mouse to hexagon array isn't 100% correct"?

I did update your Hex render code slightly. First I pre-calced all those sin/cos values, which should improve render speed. If you move those pre-calcs outside the render code, you should gain even more speed. Next I renamed a few of your variables to decrease the length of the code lines, which icreases readability. Guess, that's just a personal thing.

tilex,tiley are now tx,ty. myColor is now c.

Here's my update:

Code: Select all

`#include "fbgfx.bi"Using FBConst Pi = Atn(1) * 4Const RAD = Pi / 180Const DEG = 180 / PiConst xres = 800Const yres = 600Screenres xres, yres, 32Sub DrawHex(x As Integer, y As Integer, h As Integer, c As Uinteger = Rgb(225, 225, 225))    ' pre-calc these recurring values (calc them outside of the routines for more speed!)    dim as single cos000=cos(0*RAD),  sin000=sin(0*RAD)    dim as single cos060=cos(60*RAD), sin060=sin(60*RAD)    dim as single cos120=cos(120*RAD),sin120=sin(120*RAD)    dim as single cos180=cos(180*RAD),sin180=sin(180*RAD)    dim as single cos240=cos(240*RAD),sin240=sin(240*RAD)    dim as single cos300=cos(300*RAD),sin300=sin(300*RAD)        Dim As Single h2 = h / 2    Dim As Single s = h / Cos(30 * RAD) / 2    Dim As Single tx = x * s * 1.5f    Dim As Single ty = y * h + (x Mod 2) * h2       h2 *= 1.16     Line(tx + cos000 * h2, ty + sin000 * h2)-(tx + cos060 * h2, ty + sin060 * h2), c    Line(tx + cos060 * h2, ty + sin060 * h2)-(tx + cos120 * h2, ty + sin120 * h2), c    Line(tx + cos120 * h2, ty + sin120 * h2)-(tx + cos180 * h2, ty + sin180 * h2), c    Line(tx + cos180 * h2, ty + sin180 * h2)-(tx + cos240 * h2, ty + sin240 * h2), c    Line(tx + cos240 * h2, ty + sin240 * h2)-(tx + cos300 * h2, ty + sin300 * h2), c    Line(tx + cos300 * h2, ty + sin300 * h2)-(tx + cos000 * h2, ty + sin000 * h2), cEnd SubConst size = 64Dim As Integer mx, myDo    Getmouse mx, my       Dim As Single s = size / Cos(30 * RAD) / 2    Dim As Integer arrayx = mx / s / 1.5f    Dim As Integer arrayy = (my - (arrayx Mod 2) * size / 2) / size       Screenlock    Color Rgb(0, 0, 0), Rgb(255, 255, 255)    Cls    For x As Integer = 0 To 14        For y As Integer = 0 To 9            DrawHex x, y, size        Next    Next       DrawHex arrayx, arrayy, size, Rgb(0, 0, 0)    Locate 1, 1 : Print arrayx; arrayy    ScreenunlockLoop Until Multikey(SC_ESCAPE) `

Don't know if this helps at all, but it's here regardless. =)

-Eclipzer
Richard
Posts: 3086
Joined: Jan 15, 2007 20:44
Location: Australia
When you create your hexagonal grid you repeatedly draw full hexagons. You only need draw half of the lines because of overlap. You can remove draw lines 3, 4 and 5 during create.
duke4e
Posts: 717
Joined: Dec 04, 2005 0:16
Location: Varazdin, Croatia, Europe
Contact:
Hmm....

I know that there could be optimisations, but I didn't include them cause I wanted tho show you the most simplest code. Cos and Sin could be precalculated and mirrored+fliped, etc...

The biggest trouble is that mouse to hexagon doesnt work right. IIRC the detection works more similar to circle detection than hexagon detection. If you're near edge and move to next heaxgon, it sometimes doesn't work right until you move to next "circle" (trouble starts near the edges). If anyone will need further explanations, I'll post some screenshots about what I'm talking about.

Anyways, thanks for replies!
Eclipzer
Posts: 432
Joined: Oct 01, 2005 10:50
Location: Maryland
Contact:
Okay, I did notice that the collision detection wasn't exact, but it's pretty close and the biggest thing to note here is that you're able to do it using a transform vs a point-in-poly type test which becomes increasingly slower the more polys you're testing against. Really, it comes down to what you're using this for. If exact accuracy is important, then you have a trade off of more complex code and slow down with increasing poly count. If you can get by with a close approximation or you need speed, then stick with what you've got. Dunno if your actual transform can be improved to give exact results, but if it can that's your third and best option.

-Eclipzer
counting_pine
Posts: 6295
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs
The current detection uses rectangular regions to approximate it. The rectangles are arranged in sort of a vertical bricklayer's pattern, with the same centre, height and average width as the hexagons.

Here's one method of getting hexagonal regions. Important code's at the bottom:

Code: Select all

`declare sub hexpos(byref hx as integer, byref hy as integer, _                   byval x as integer, byval y as integer)declare sub hexdxdy(byref hdx as integer, byref hdy as integer, _                    byval x as integer, byval y as integer)function modp(byval a as integer, byval b as integer) as integer    var c = a mod b: if c < 0 then: c += abs(b): end if: return cend functionconst wid = 320, hei = 200const hexside = 16const hexwidmin = hexside, hexwidmax = 2 * hexsideconst hexhei = 2 * cint(hexside * sqr(3) / 2)const dy = hexhei, dx = (hexwidmax - hexwidmin)const tilewid = hexwidmin + hexwidmax, tilehei = hexheiscreenres wid, hei, 8dim as integer x, y, mx, my, hx, hyconst spd = 1for y = 0 to hei - 1 step spd    screenlock    for x = 0 to wid - 1 step spd                hexpos( hx, hy, x, y )                pset (x, y), (hx * 2 + hy * 6) mod 24 + 32            next x    screenunlock    sleep 1    if len(inkey) then endnext ydo until len(inkey)        getmouse mx, my        hexpos( hx, hy, mx, my )        locate 1, 1: print using "### ###"; hx, hy    sleep 1    loop'''''''''''''''''''''''''sub hexpos(byref hx as integer, byref hy as integer, _           byval x as integer, byval y as integer)        dim as integer hdx, hdy        hexdxdy( hdx, hdy, x, y )        x -= modp(x, tilewid)    y -= modp(y, tilehei)        hx = (x * 2) \ tilewid + hdx    hy = y \ tilehei + hdy    end subsub hexdxdy(byref hdx as integer, byref hdy as integer, _            byval x as integer, byval y as integer)        if x < 0 or x >= tilewid then x = modp(x, tilewid)    if y < 0 or y >= tilehei then y = modp(y, tilehei)        var y2 = y - tilehei \ 2    var x2 = x - tilewid \ 2    if abs(y2) * dx >= (abs(x2) - hexwidmax \ 2) * -dy then        hdx = 2 * (1 and x2 > 0)        hdy = (1 and y2 > 0)    else        hdx = 1        hdy = 0    end if    end sub`

It splits the screen into tiles, then finds the exact hexagon based on the position in the tile.

Sorry, no fast drawing routines there, but if you want pixel-perfect, you'll probably have to calculate pixel-by-pixel anyway. Because it's all tiled though, you only really have to do the grunt work for one tile, then you can cache the results.

PS: I've just realised, in the process of writing/tuning this, I've managed to get the Blockbusters theme tune in my head:
Richard
Posts: 3086
Joined: Jan 15, 2007 20:44
Location: Australia
counting_pine is right. The fundamental problem was that you mapped orthogonal to isometric with two axies. Two axies cannot resolve the three orientations of the hexagon faces, only two, so it makes rectangles.
By zig-zagging your rows you made it more difficult for me to understand, because mod 2 is needed and the mapping got too confusing for my brain. Anyhow, I have used a different transform that is easily reversible and added a closest centre routine to resolve the selection.
Now it seems to work well.

Code: Select all

`#include "fbgfx.bi"Using FB' constants are globalConst xres = 800Const yres = 600Screenres xres, yres, 32Const As Double size = 200 '64Const As Double k = Sqr(1/3)  ' tan(30) = sqr(1/3) = 0.5773Const As Double s = size / 3Const As Double t = s * 2Sub DrawHex(Byval x As Double, Byval y As Double, Byval mycolor As Uinteger)    x = x * size    y = y * size    Dim As Double z = k * size    x = x + t             : Pset  (x, y), mycolor     x = x - s : y = y + z : Line -(x, y), mycolor    x = x - t             : Line -(x, y), mycolor    x = x - s : y = y - z : Line -(x, y), mycolor    x = x + s : y = y - z : Line -(x, y), mycolor    x = x + t             : Line -(x, y), mycolor    x = x + s : y = y + z : Line -(x, y), mycolorEnd Sub'----------------------------------------------------------------------Dim As Integer mousex, mouseyDim As Double mx, my, mu, mv, x, y, u, vDo    Screenlock    Color Rgb(0, 0, 0), Rgb(255, 255, 255)    Cls    For u = 0 To 5        For v = 0 To 5            x = (u - v)            y = (u + v) * k            DrawHex x, y, Rgb(215, 215, 215)        Next    Next    Getmouse mousex, mousey    mx = mousex / size  ' scale back to unity    my = mousey / size    Locate 1, 1    Print Using "mx ###.######   my ###.######  ";mx; my    mu = (mx + my/k)/2    ' transform to u,v    mv = (mu - mx)    mu = int(mu)     mv = int(mv)    ' find the closest of the four centres    Dim as double dx, dy, rr, min = 1e30    for u = mu to mu + 1        for v = mv to mv + 1            x = (u - v) ' centre of hex(u, v)            y = (u + v) * k            dx = x - mx            dy = y - my            rr = dx*dx + dy*dy            if rr < min then                min = rr                mu = u  ' remember the closest hex(u,v)                mv = v            end if        next v    next u        Print Using "mu ###.#        mv ###.#       ";mu; mv    mx = (mu - mv)      ' transform back to centre of hexagon    my = (mu + mv) * k    DrawHex (mx, my, Rgb(0, 0, 0))        Screenunlock    Loop Until Multikey(SC_ESCAPE) `

Here is a cleaner version that passes u and v as integers.

Code: Select all

`#include "fbgfx.bi"Using FB' constants are globalConst xres = 800Const yres = 600Screenres xres, yres, 32Const As Double size = 200 '64Const As Double k = Sqr(1/3)  ' tan(30) = sqr(1/3) = 0.5773Const As Double s = size / 3Const As Double t = s * 2Sub DrawHex(Byval u As Integer, Byval v As Integer, Byval mycolor As Uinteger)    Dim As Double x, y    x = (u - v)      ' compute centre of hexagon    y = (u + v) * k    x = x * size    y = y * size    Dim As Double z = k * size    x = x + t             : Pset  (x, y), mycolor     x = x - s : y = y + z : Line -(x, y), mycolor    x = x - t             : Line -(x, y), mycolor    x = x - s : y = y - z : Line -(x, y), mycolor    x = x + s : y = y - z : Line -(x, y), mycolor    x = x + t             : Line -(x, y), mycolor    x = x + s : y = y + z : Line -(x, y), mycolorEnd Sub'----------------------------------------------------------------------Dim As Integer mousex, mouseyDim As Double mx, my, mu, mv, x, y, u, vDo    Screenlock    Color Rgb(0, 0, 0), Rgb(255, 255, 255)    Cls    For u = 0 To 5        For v = 0 To 5            DrawHex u, v, Rgb(215, 215, 215)        Next    Next    Getmouse mousex, mousey    mx = mousex / size  ' scale back to unity    my = mousey / size    mu = (mx + my/k)/2    ' transform to u,v    mv = (mu - mx)    mu = Int(mu)    ' the lowest possible hex(u,v)    mv = Int(mv)    ' find the closest of the four possible centres    Dim As Double dx, dy, rr, min = 1e30    For u = mu To mu + 1        For v = mv To mv + 1            x = (u - v) ' centre of hex(u, v)            y = (u + v) * k            dx = x - mx            dy = y - my            rr = dx*dx + dy*dy            If rr < min Then                min = rr                mu = u  ' remember the closest hex(u,v)                mv = v            End If        Next v    Next u        Locate 1, 1    Print Using "u =####    v =####  ";mu; mv    DrawHex (mu, mv, Rgb(0, 0, 0))        Screenunlock    Loop Until Multikey(SC_ESCAPE)`
Richard
Posts: 3086
Joined: Jan 15, 2007 20:44
Location: Australia

Code: Select all

`'--------------------------------------------------------------------' hexagon centres are at integer u, v coordinates in isometric space. ' the mapping transforms uses a constant, k = sqr(1/3)'--------------------------------------------------------------------' isometric to orthogonal mapping.  hexagon(u,v) to screen(x,y)' x = (u - v)' y = (u + v) * k' orthogonal to isometric mapping.  screen(x,y) to hexagon(u,v)' u = (x + y/k)/2' v = (u - x)'--------------------------------------------------------------------#include "fbgfx.bi"Using FB' constants are globalConst xres = 800Const yres = 600Screenres xres, yres, 32Const As Double size = 64  ' try 200 '  size of hexagons on the screenConst As Double k = Sqr(1/3)  ' tan(30) = sqr(1/3) = 0.5773Const As Double s = size / 3Const As Double t = s * 2Const As Double z = k * size'----------------------------------------------------------------------Sub DrawHex(Byval u As Integer, Byval v As Integer, Byval mycolor As Uinteger)    Dim As Double x, y    x = size * (u - v)      ' compute centre(x,y) of hexagon(u,v)    y = size * (u + v) * k    x = x + t             : Pset  (x, y), mycolor     x = x - s : y = y + z : Line -(x, y), mycolor    x = x - t             : Line -(x, y), mycolor    x = x - s : y = y - z : Line -(x, y), mycolor    x = x + s : y = y - z : Line -(x, y), mycolor    x = x + t             : Line -(x, y), mycolor    x = x + s : y = y + z : Line -(x, y), mycolorEnd Sub'----------------------------------------------------------------------Dim As Integer mousex, mouseyDim As Double mx, my, mu, mv, x, y, u, vDo    Screenlock    Color Rgb(0, 0, 0), Rgb(255, 255, 255)    Cls    For x = .01 to 1 + xres/size    ' generate a rectangular field that is        for y = .01 to 1 + yres/size' fine enough to generate all hex(u,v)            u = (x + y/k)/2  ' transform x,y to u,v            v = (u - x)      ' they will become integers in drawhex            DrawHex u, v, Rgb(215, 215, 215)        Next    Next    Getmouse mousex, mousey    mx = mousex / size  ' scale back to unity    my = mousey / size    mu = (mx + my/k)/2  ' transform to u,v    mv = (mu - mx)    mu = Int(mu)    ' the lowest possible hex(u,v)    mv = Int(mv)    ' find the closest of the four possible centres    Dim As Double dx, dy, rr, min = 1e30    For u = mu To mu + 1        For v = mv To mv + 1            x = (u - v) ' centre of hex(u, v)            y = (u + v) * k            dx = x - mx            dy = y - my            rr = dx*dx + dy*dy            If rr < min Then                min = rr                mu = u  ' remember the closest hex(u,v)                mv = v            End If        Next v    Next u        Locate 1, 1    Print Using "u =####    v =####  ";mu; mv    DrawHex (mu, mv, Rgb(0, 0, 0))    Screenunlock    Loop Until Multikey(SC_ESCAPE)`
duke4e
Posts: 717
Joined: Dec 04, 2005 0:16
Location: Varazdin, Croatia, Europe
Contact:
Hey, thanks guys. This is what I was looking for. If I'll have some questions, I'll post em here.

Richard, have you considered posting your code in form of tutorial to QB Express?
Richard
Posts: 3086
Joined: Jan 15, 2007 20:44
Location: Australia
By mapping the mouse position from hexagon space onto isometric space the exact hex(u,v) can be computed directly without any search.

Code: Select all

`'--------------------------------------------------------------------' hexagon centres are at integer u, v coordinates in isometric space. ' the mapping transforms use a constant, k = sqr(1/3)'--------------------------------------------------------------------' isometric to orthogonal mapping.  hexagon(u,v) to screen(x,y)' x = (u - v)' y = (u + v) * k' orthogonal to isometric mapping.  screen(x,y) to hexagon(u,v)' u = (x + y/k)/2' v = (u - x)'--------------------------------------------------------------------#include "fbgfx.bi"Using FB' constants are globalConst As Double size = 64   'size of hexagons on the screen test with 250Const As Double k = Sqr(1/3)    ' tan(30) = sqr(1/3) = 0.5773Const As Double s = size / 3    ' one third sizeConst As Double t = s * 2       ' two thirds sizeConst As Double z = k * size    ' half hexagon heightConst As Integer xres = 800Const As Integer yres = 600Screenres xres, yres, 32'----------------------------------------------------------------------Sub DrawHex(Byval u As Integer, Byval v As Integer, Byval allLines As Integer, Byval mycolor As Uinteger)    Dim As Double x, y    x = size * (u - v)      ' compute centre(x,y) of hexagon(u,v)    y = size * (u + v) * k    Line  (x+t  , y  )-(x+t-s, y+z), mycolor    Line -(x-s  , y+z), mycolor    Line -(x-s-s, y  ), mycolor    If allLines Then   ' draw all lines        Line -(x-s  , y-z), mycolor        Line -(x-s+t, y-z), mycolor        Line -(x+t  , y  ), mycolor    End If End Sub'----------------------------------------------------------------------Dim As Double x, y, u, vDim As Integer mousex, mousey, intxDo    Screenlock    Color Rgb(0, 0, 0), Rgb(255, 255, 255)    Cls    For x = .01 To xres/size+1      ' generate a rectangular field that is        For y = .01 To yres/size+1  ' fine enough to generate all hex(u,v)            u = (x + y/k)/2         ' transform x,y to u,v            v = (u - x)             ' become integers in drawhex            DrawHex u, v, 0, Rgb(215, 215, 215) ' draw tops only        Next    Next        Getmouse mousex, mousey    x = mousex / size   ' scale back to unity    y = mousey / size    intx = Int(x)       ' map hexagon space onto isometric rhombic space    x = x - intx    If x < 1/3 Then        x = intx        ' move to the left centre    Elseif x > 2/3 Then        x = intx + 1    ' move to the right centre    Else            x = intx - 1 + 3*x  ' change slope of boundary from 60 to 30 deg    End If        u = (x + y/k)/2  ' transform x,y to u,v    v = (u - x)      ' become integers in drawhex    DrawHex (u, v, 1, Rgb(0, 0, 0)) ' draw all lines    Screenunlock    Loop Until Multikey(SC_ESCAPE)`
Last edited by Richard on Mar 04, 2008 1:57, edited 1 time in total.
counting_pine
Posts: 6295
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs
Yeah, it's true, you do have a way with words, Richard.

My own code was probably rather un-self-explanatory, so I'm going to post another version, with a hexagon-drawing routine, and some more commenty goodness.

Our methods are completely different - Richard's maps to the hexagon coordinate system and finds the closest match, which, happily enough, gives exact hexagons - if you had a set of soap bubbles, and arranged them tightly together in that pattern, you would indeed see that behaviour with the edges.

Code: Select all

`declare sub drawhex(byval hx as integer, byval hy as integer)declare sub findhexpos(byref hx as integer, byref hy as integer, _                       byval x as integer,  byval y as integer)declare sub findhexdxdy(byref hdx as integer, byref hdy as integer, _                        byval x as integer,   byval y as integer)function modp(byval a as integer, byval b as integer) as integer    var c = a mod b: if c < 0 then: c += abs(b): end if: return cend function'' Set the screen sizeconst WID = 320, HEI = 200'' Set the dimensions of the hexagon (max width, min width, height) '' it doesn't need to be regular, but if it is, you can just change HEXSIDEconst HEXSIDE = 16const HEXWIDMIN = HEXSIDE, HEXWIDMAX = 2 * HEXSIDEconst HEXHEI = 2 * cint(HEXSIDE * sqr(3) / 2)const DY = HEXHEI, DX = (HEXWIDMAX - HEXWIDMIN)const TILEWID = HEXWIDMIN + HEXWIDMAX, TILEHEI = HEXHEIscreenres WID, HEI, 8, 2dim as integer x, y, mx, my, hx, hy'' Draw hexagon map on screenfor y = 0 to HEI - 1    screenlock    for x = 0 to WID - 1                findhexpos( hx, hy, x, y )                pset (x, y), (hx * 2 + hy * 6) mod 24 + 32            next x    screenunlock    sleep 1    if len(inkey) then endnext yscreencopy 0, 1do until len(inkey)        getmouse mx, my        '' Find current hexagon and draw it        findhexpos( hx, hy, mx, my )        screenlock        screencopy 1, 0        draw string (0, 0), (hx & ", " & hy)        drawhex( hx, hy )    screenunlock        sleep 1    loop'''''''''''''''''''''''''sub drawhex(byval hx as integer, byval hy as integer)        '' Draws a hexagon, given the hexagon position        dim as integer x, y '' Centre cooridnates    x = (hx * (HEXWIDMIN + HEXWIDMAX)) \ 2    y = hy * HEXHEI + (hx and 1) * HEXHEI \ 2        'pset(x, y)        ''Draw lines to form a hexagon        line (x - HEXWIDMAX \ 2, y) - (x - HEXWIDMIN \ 2, y - HEXHEI \ 2)    line                        - (x + HEXWIDMIN \ 2, y - HEXHEI \ 2)    line                        - (x + HEXWIDMAX \ 2, y)    line                        - (x + HEXWIDMIN \ 2, y + HEXHEI \ 2)    line                        - (x - HEXWIDMIN \ 2, y + HEXHEI \ 2)    line                        - (x - HEXWIDMAX \ 2, y)    end subsub findhexpos(byref hx as integer, byref hy as integer, _               byval x as integer,  byval y as integer)        '' Find the matching hexagon position(finds the right tile (see below), then    '' uses hexdxdy to find the exact hexagon, given the position in the tile)        dim as integer hdx, hdy    dim as integer tx = modp(x, TILEWID), ty = modp(y, TILEHEI)    dim as integer x2 = x - tx, y2 = y - ty        '' Find the right tile (each tile has the     '' width of two hexagons and the height of one)        hx = (x2 * 2) \ TILEWID    hy = y2 \ TILEHEI        ''adjust to find the correct position in the tile        findhexdxdy( hdx, hdy, tx, ty )    hx += hdx    hy += hdy    end subsub findhexdxdy(byref hdx as integer, byref hdy as integer, _                byval tx as integer,  byval ty as integer)        '' The screen is split into tiles like this:    '' ^    '' |    '' ''''''----'''''    '' '   /      \  '    '' ---         ---    '' '   \      /  '    '' ''''''----'''''-->        if tx < 0 or tx >= TILEWID then tx = modp(tx, TILEWID)    if ty < 0 or ty >= TILEHEI then ty = modp(ty, TILEHEI)            '' This is symmetrical, so we only deal with one quadrant:    ''      ^    ''      |    ''      '--''''''    ''      '   \   '    ''  ----''''''--'--->    ''      |        dim as integer x = tx - TILEWID \ 2, xa = abs(x)    dim as integer y = ty - TILEHEI \ 2, ya = abs(y)        '' To find out whether it's the center hexagon or a corner hexagon,     '' we just have to check what side of the line it's on        ''       ^    ''       | \    ''       '''\''''    ''       '   \  '    ''  -----+'''-\-'->    ''       |     \        if ya * DX >= (xa - HEXWIDMAX \ 2) * -DY then        '' corner hexagon        hdx = 2 and (x > 0)        hdy = 1 and (y > 0)    else        '' centre hexagon        hdx = 1        hdy = 0    end if    end sub`

My method uses rectagonal tiles, each tile overlapping five different hexagons (four at the corners, plus one in the centre). The tile is easy to calculate, and finding which hexagon it belongs to within the tile isn't too bad.
Because it's symmetrical, you just have to work out which quadrant it's in, then you only have to work out what side of the line it's on to find out whether it's in the centre hexagon, or the corresponding corner hexagon.
Overall, I think my method might be more complicated. On the plus side, though, it does support non-regular hexagons.

Hopefully, you can understand both methods, and learn different things from each.
Posts: 2340
Joined: May 24, 2007 22:10
Location: The Netherlands

### Re: Hexagonal Grid

For Richard. Your code combined with your the hexagon drawing routine from the 'Pentacles' topic.
With some minor tweaking like: Ulong for color, sleep 1 in the loop, invalid mouse position detection.

Code: Select all

`'--------------------------------------------------------------------' hexagon centres are at integer u, v coordinates in isometric space.' the mapping transforms use a constant, k = sqr(1/3)'--------------------------------------------------------------------' isometric to orthogonal mapping.  hexagon(u,v) to screen(x,y)' x = (u - v)' y = (u + v) * k' orthogonal to isometric mapping.  screen(x,y) to hexagon(u,v)' u = (x + y/k)/2' v = (u - x)'--------------------------------------------------------------------#Include "fbgfx.bi"Using FB' constants are globalConst As Double size = 64     ' size of hexagons on the screenConst As Double k = Sqr(1/3)  ' tan(30) = sqr(1/3) = 0.5773Const As Double s = size / 3  ' one third sizeConst As Double t = s * 2     ' two thirds sizeConst As Double z = k * size  ' half hexagon heightConst As Integer xres = 800Const As Integer yres = 600Screenres xres, yres, 32Width xres \ 8, yres \ 16 ' bigger font'----------------------------------------------------------------------Const As Double r_cos = 0.5, r_sin = Sqr(3 / 4) ' 60° unit vector = Cos(60°), Sin(60°)Sub DrawHex(u As Integer, v As Integer, allLines As Integer, c As Ulong)   Dim As Double xc, yc   xc = size * (u - v) ' compute centre(x,y) of hexagon(u,v)   yc = size * (u + v) * k   Dim As Double x = t, y = 0, tx ' vertex (center to corner), temp x   Pset( xc + x, yc + y ), c      ' open path   For i As Integer = 1 To 6      tx = x * r_cos - y * r_sin  ' complex multiply      y  = x * r_sin + y * r_cos  ' rotates vertex about origin by 60°      x = tx      Line -( xc + x, yc + y ), c ' draw edge   NextEnd Sub'----------------------------------------------------------------------Dim As Double x, y, u, vDim As Integer mousex, mousey, intxDo   Screenlock   Color Rgb(0, 0, 0), Rgb(255, 255, 255)   Cls   For x = .01 To xres/size+1      ' generate a rectangular field that is      For y = .01 To yres/size+1  ' fine enough to generate all hex(u,v)         u = (x + y/k)/2         ' transform x,y to u,v         v = (u - x)             ' become integers in drawhex         DrawHex u, v, 0, Rgb(215, 215, 215) ' draw tops only      Next   Next   If Getmouse(mousex, mousey) = 0 Then ' mouse inside window?      x = mousex / size   ' scale back to unity      y = mousey / size      intx = Int(x)       ' map hexagon space onto isometric rhombic space      x = x - intx      If x < 1/3 Then         x = intx        ' move to the left centre      Elseif x > 2/3 Then         x = intx + 1    ' move to the right centre      Else            x = intx - 1 + 3 * x  ' change slope of boundary from 60 to 30 deg      End If         u = (x + y/k)/2  ' transform x,y to u,v      v = (u - x)      ' become integers in drawhex      'Print Using "u =####    v =####  ";u; v      Draw String (10, 10), "u = " & Cint(u) & ", v = " & Cint(v)      DrawHex (u, v, 1, Rgb(0, 0, 0)) ' draw all lines   End If   Screenunlock   Sleep 1Loop Until Multikey(SC_ESCAPE)`
RockTheSchock
Posts: 237
Joined: Mar 12, 2006 16:25

### Re: Hexagonal Grid

I started to port most of the code to freebasic from this site:
https://www.redblobgames.com/grids/hexagons/

Maybe i find it again and post it here
dodicat
Posts: 6988
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: Hexagonal Grid

Another way using winder method for inpolygon.
Left click to locate, right click for new pattern.

Code: Select all

`Type pt     As Single x,yEnd TypeType hexagon    As pt h(1 To 6)    As Long idx,idy 'if index is neededEnd TypeFunction inpolygon(p1() As Pt,Byval p2 As Pt) As Long    #define Winder(L1,L2,p) -Sgn((L1.x-L2.x)*(p.y-L2.y)-(p.x-L2.x)*(L1.y-L2.y))    Dim As Long index,nextindex,k=Ubound(p1)+1,wn    For n As Long=1 To Ubound(p1)        index=n Mod k:nextindex=(n+1) Mod k        If nextindex=0 Then nextindex=1        If p1(index).y<=p2.y Then            If p1(nextindex).y>p2.y Andalso  Winder(p1(index),p1(nextindex),p2)>0 Then wn+=1         Else            If p1(nextindex).y<=p2.y Andalso Winder(p1(index),p1(nextindex),p2)<0 Then wn-=1        End If    Next n    Return wnEnd FunctionFunction drawpolygon(p() As Pt, col As Ulong,flag As Long) As pt    Dim k As Long=Ubound(p)+1    Dim As Long index,nextindex    Dim As Single cx,cy    For n As Long=1 To Ubound(p)        index=n Mod k:nextindex=(n+1) Mod k        If nextindex=0 Then nextindex=1        Line (p(index).x,p(index).y)-(p(nextindex).x,p(nextindex).y),col        cx+=p(n).x:cy+=p(n).y    Next    cx/=Ubound(p):cy/=Ubound(p)    If flag Then Paint(cx,cy),col,col    Return Type(cx,cy)End FunctionSub tessellate(pts() As hexagon,r As Single)    Dim As Integer xres,yres    Screeninfo xres,yres    #macro _hex(p,r)    Scope       dim as long ctr        For z As Single=0 To 360 Step 360/6            Var x=p.x+r*Cos(z*.0174533)            Var y=p.y+r*Sin(z*.0174533)            ctr+=1               If ctr>6 Then Exit For            pts(ctr2).h(ctr)=Type(x,y)        Next z    End Scope    #endmacro    Dim As pt hp    Dim As Single x,y,z    Dim As Long k=1,ctr2,ctrx,ctry    For x =r To xres-r Step r+r/2        Var h=.86603*r/2        z=h*k        ctrx+=1        ctry=0        For y =z+r+r\2 To yres-r Step Sqr(3)*r            ctry+=1            hp=Type<pt>(x,y)            ctr2+=1            Redim Preserve pts(1 To ctr2)            pts(ctr2).idx=ctrx-1            pts(ctr2).idy=ctry-1              _hex(hp,r)        Next y        k=-k    Next xEnd Sub'==============================================='Screen 20Dim As hexagon p(any)Dim As Long mx,my,btn,flagtessellate(p(),20)'startersDo    Getmouse mx,my,,btn    Screenlock    Cls    For n As Long=Lbound(p) To Ubound(p)        drawpolygon(p(n).h(),7,0)         If inpolygon(p(n).h(),Type(mx,my)) And btn=1 Then drawpolygon(p(n).h(),15,1):draw string(0,0),str(p(n).idx)+","+str(p(n).idy)    Next    If btn=2 And flag=0 Then        flag=1        tessellate(p(),10+Rnd*80)    End If    Screenunlock    Sleep 1    flag=btnLoop Until Inkey=Chr(27)Sleep `
Posts: 2340
Joined: May 24, 2007 22:10
Location: The Netherlands

### Re: Hexagonal Grid

dodicat wrote:Another way using winder method for inpolygon.
Left click to locate, right click for new pattern.

Your tile coordinate system is the same as I used in 'Pentacles' but different then what Richard used above. The isometric coordinate system is easier to work with I think. See the 'redblobgames' link for all the details.

Edit: There is actually a bug in Richard's code which manifests when mousey is exactly zero.