Hexagonal Grid

[duke4e]

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 FB
Const Pi = Atn(1) * 4
Const RAD = Pi / 180
Const DEG = 180 / Pi


Const xres = 800
Const yres = 600
Screenres xres, yres, 32

Sub 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), mycolor
End Sub

Const size = 64

Dim As Integer mx, my
Do
    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
    Screenunlock
Loop Until Multikey(SC_ESCAPE)

http://www.gamedev.net/reference/articl ... le1800.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]

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 FB
Const Pi = Atn(1) * 4
Const RAD = Pi / 180
Const DEG = 180 / Pi


Const xres = 800
Const yres = 600
Screenres xres, yres, 32

Sub 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), c

End Sub

Const size = 64

Dim As Integer mx, my
Do
    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
    Screenunlock
Loop Until Multikey(SC_ESCAPE)
 

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

-Eclipzer

[Richard]

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]

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]

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]

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 c
end function

const wid = 320, hei = 200


const hexside = 16
const hexwidmin = hexside, hexwidmax = 2 * hexside
const hexhei = 2 * cint(hexside * sqr(3) / 2)
const dy = hexhei, dx = (hexwidmax - hexwidmin)

const tilewid = hexwidmin + hexwidmax, tilehei = hexhei

screenres wid, hei, 8
dim as integer x, y, mx, my, hx, hy
const spd = 1
for 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 end
next y

do 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 sub

sub 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:
http://www.youtube.com/watch?v=kKhnVvHWJ3A

[Richard]

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 global
Const xres = 800
Const yres = 600
Screenres xres, yres, 32
Const As Double size = 200 '64
Const As Double k = Sqr(1/3)  ' tan(30) = sqr(1/3) = 0.5773
Const As Double s = size / 3
Const As Double t = s * 2

Sub 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), mycolor
End Sub

'----------------------------------------------------------------------
Dim As Integer mousex, mousey
Dim As Double mx, my, mu, mv, x, y, u, v
Do
    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 global
Const xres = 800
Const yres = 600
Screenres xres, yres, 32
Const As Double size = 200 '64
Const As Double k = Sqr(1/3)  ' tan(30) = sqr(1/3) = 0.5773
Const As Double s = size / 3
Const As Double t = s * 2

Sub 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), mycolor
End Sub

'----------------------------------------------------------------------
Dim As Integer mousex, mousey
Dim As Double mx, my, mu, mv, x, y, u, v
Do
    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]

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 global
Const xres = 800
Const yres = 600
Screenres xres, yres, 32

Const As Double size = 64  ' try 200 '  size of hexagons on the screen

Const As Double k = Sqr(1/3)  ' tan(30) = sqr(1/3) = 0.5773
Const As Double s = size / 3
Const As Double t = s * 2
Const 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), mycolor
End Sub

'----------------------------------------------------------------------
Dim As Integer mousex, mousey
Dim As Double mx, my, mu, mv, x, y, u, v
Do
    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]

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]

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 global
Const As Double size = 64   'size of hexagons on the screen test with 250
Const As Double k = Sqr(1/3)    ' tan(30) = sqr(1/3) = 0.5773
Const As Double s = size / 3    ' one third size
Const As Double t = s * 2       ' two thirds size
Const As Double z = k * size    ' half hexagon height
Const As Integer xres = 800
Const As Integer yres = 600
Screenres 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, v
Dim As Integer mousex, mousey, intx
Do
    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)

[counting_pine]

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 c
end function


'' Set the screen size
const 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 HEXSIDE
const HEXSIDE = 16
const HEXWIDMIN = HEXSIDE, HEXWIDMAX = 2 * HEXSIDE
const HEXHEI = 2 * cint(HEXSIDE * sqr(3) / 2)


const DY = HEXHEI, DX = (HEXWIDMAX - HEXWIDMIN)
const TILEWID = HEXWIDMIN + HEXWIDMAX, TILEHEI = HEXHEI

screenres WID, HEI, 8, 2
dim as integer x, y, mx, my, hx, hy

'' Draw hexagon map on screen
for 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 end
next y
screencopy 0, 1


do 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 sub

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

sub 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.

[badidea]

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 global
Const As Double size = 64     ' size of hexagons on the screen
Const As Double k = Sqr(1/3)  ' tan(30) = sqr(1/3) = 0.5773
Const As Double s = size / 3  ' one third size
Const As Double t = s * 2     ' two thirds size
Const As Double z = k * size  ' half hexagon height
Const As Integer xres = 800
Const As Integer yres = 600
Screenres xres, yres, 32
Width 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
	Next
End Sub

'----------------------------------------------------------------------
Dim As Double x, y, u, v
Dim As Integer mousex, mousey, intx
Do
	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 1
Loop Until Multikey(SC_ESCAPE)

[RockTheSchock]

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]

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

Code: Select all

Type pt 
    As Single x,y
End Type

Type hexagon
    As pt h(1 To 6)
    As Long idx,idy 'if index is needed
End Type

Function 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 wn
End Function

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

Sub 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 x
End Sub

'==============================================='
Screen 20
Dim As hexagon p(any)
Dim As Long mx,my,btn,flag
tessellate(p(),20)'starters
Do
    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=btn
Loop Until Inkey=Chr(27)

Sleep


 

[badidea]

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.