NoMainWin
Dim hxc(20,2), ltr(26)
Global sw, sh, radius, radChk, mx, my, h$, last
h$="#g": radius = 40: radChk = 35 * 35: last = 0
sw = 400: sh = 380: WindowWidth = sw+6: WindowHeight= sh+32
Open "Liberty BASIC - Honeycombs" For graphics_nsb_nf As #g
#g "Down; Cls; TrapClose xit"

Call shuffle
Call grid 75, 15, "0 0 0", "255 215 32", "0 0 0"

#g "SetFocus; when characterInput getKey; when leftButtonDown chkClick"
Wait

Sub xit h$
    Close #h$:End
End Sub

'Assign ASCII values of A thru Z to ltr() array and randomize order of letters
Sub shuffle
    For i = 1 To 26
        ltr(i) = i+64
    Next
    For i = 1 To 77
        r1 = Int(Rnd(1)*26)+1
        r2 = Int(Rnd(1)*26)+1
        temp = ltr(r1): ltr(r1) = ltr(r2): ltr(r2) = temp
    Next
End Sub

'Draw the hex cells and fill with 20 out of 26 random letters
Sub grid ox, oy, fc$, bc$, tc$
    cx = ox: cy = oy
    For i = 1 To 5
        If (i And 1)=0 Then cy = oy + 76 Else cy = oy + 42
        For j = 1 To 4
            count = count + 1: letter$ = Chr$(ltr(count))
            Call cell, cx, cy, fc$, bc$, tc$, letter$
            hxc(count,0)=cx: hxc(count,1)=cy: cy = cy + 70
        Next
        cx = cx + 61
    Next
End Sub

'Draw a filled hex cell and printed the letter associated with cell
Sub cell cx, cy, fc$, bc$, tc$, lt$
    lastx = cx + radius: lasty = cy
    For f = 1.04719755 To 6.2831853 Step 1.0471955
        nx = Cos(f)*radius+cx: ny = Sin(f)*radius+cy
        #g "Size 2; Color ";bc$;";BackColor ";bc$
        Call triFill cx, cy, lastx, lasty, nx, ny
        #g "Size 5; Color ";fc$
        #g "Line ";lastx;" ";lasty;" ";nx;" ";ny;";Size 1"
        lastx = nx: lasty = ny
    Next
    #g "Font Courier_New 36 Bold"
    #g "Color ";tc$;";BackColor ";bc$
    #g "Place ";cx-15;" ";cy+15;";\";lt$
End Sub

'Check for a mouse click in a hex cell
Sub chkClick h$, x, y
    mx = MouseX
    my = MouseY
    For i = 1 To 20
        If pnc(mx,my,hxc(i,0),hxc(i,1)) = 1 Then 'selected hex cell found
            If hxc(i,2)=0 Then
                hxc(i,2)=1 'when set to 1, hex cell & letter no longer selectable
                key$ = Chr$(ltr(i))
                Call cell hxc(i,0),hxc(i,1),"0 0 0","80 0 128","255 255 255",key$
                Call showLetter key$
                Exit For
            End If
        End If
    Next
End Sub

'Allow letter selection via keyboard
Sub getKey h$, char$
    key$ = Upper$(Inkey$)
    'Poll ESC key to exit at any time
    If key$=Chr$(27) Then Call xit h$
    idx = Instr("ABCDEFGHIJKLMNOPQRSTUVWXYZ",key$)
    If idx <> 0 Then
        For i = 1 To 20
            If idx+64 = ltr(i) Then 'letter matching key press found
                If hxc(i,2)=0 Then
                    hxc(i,2)=1 'when set to 1, hex cell & letter no longer selectable
                    Call cell hxc(i,0),hxc(i,1),"0 0 0","80 0 128","255 255 255",key$
                    Call showLetter key$
                    Exit For
                End If
            End If
        Next
    End If
End Sub

'Print letters selected at bottom of screen
Sub showLetter key$
    #g "Font Courier_New 18 Bold"
    #g "Color Black;BackColor white"
    #g "Place ";last*18+20;" 365;\"; key$
    last = last + 1
    'When 20th letter selected; exit
    If last > 19 Then Call xit h$
End Sub

'Draw a filled triangle
Sub triFill x1,y1, x2,y2, x3,y3
    If x2<x1 Then x=x2: y=y2: x2=x1: y2=y1: x1=x: y1=y
    If x3<x1 Then x=x3: y=y3: x3=x1: y3=y1: x1=x: y1=y
    If x3<x2 Then x=x3: y=y3: x3=x2: y3=y2: x2=x: y2=y
    If x1<>x3 Then slope1=(y3-y1)/(x3-x1)
    length=x2-x1
    If length<>0 Then
        slope2=(y2-y1)/(x2-x1)
        For x = 0 To length
            #g "Line ";Int(x+x1);" ";Int(x*slope1+y1);" ";Int(x+x1);" ";Int(x*slope2+y1)
        Next
    End If
    y = length*slope1+y1 :length=x3-x2
    If length<>0 Then
        slope3=(y3-y2)/(x3-x2)
        For x = 0 To length
            #g "Line ";Int(x+x2);" ";Int(x*slope1+y);" ";Int(x+x2);" ";Int(x*slope3+y2)
        Next
    End If
End Sub

'Point in Circle function
Function pnc(ax, ay, bx, by)
    If (bx-ax)*(bx-ax)+(by-ay)*(by-ay) <= radChk Then
        pnc=1
    Else
        pnc=0
    End If
End Function