Structure hexGadget text.s Status.i ;nonselected = 0, selected = 1 center.POINT ;location of hex's center List shape.POINT() EndStructure Structure honeycomb gadgetID.i margins.POINT unusedLetters.s chosen.s maxLength.i Array hexGadgets.hexGadget(0) textY.i EndStructure Prototype hexEvent_prt(*h.honeycomb, hexID) Procedure inpoly(*p.POINT, List poly.POINT()) ;returns 1 if point is inside the polygon defined by poly(), otherwise returns 0 Protected new.POINT, old.POINT, lp.POINT, rp.POINT, i, inside, *poly If ListSize(poly()) < 3: ProcedureReturn 0: EndIf LastElement(poly()): old = poly() ForEach poly() ;find leftmost endpoint 'lp' and the rightmost endpoint 'rp' based on x value If poly()\x > old\x lp = old rp = poly() Else lp = poly() rp = old EndIf If lp\x < *p\x And *p\x <= rp\x And (*p\y - lp\y) * (rp\x - lp\x) < (rp\y - lp\y) * (*p\x - lp\x) inside = ~inside EndIf old = poly() Next ProcedureReturn inside & 1 EndProcedure ;draw a hex Gadget by number Procedure drawhex(*h.honeycomb, hexID) With *h\hexGadgets(hexID) Protected p.POINT If LastElement(\shape()) p = \shape() EndIf ForEach \shape() LineXY(p\x, p\y, \shape()\x, \shape()\y, RGB(0, 0, 0)) ;black p = \shape() Next DrawingMode(#PB_2DDrawing_Transparent) DrawingFont(FontID(0)) If \Status FillArea(\center\x + 1, \center\y + 1, RGB(0, 0, 0), RGB($FF, 0, $FF)) ;magenta DrawText(\center\x - TextWidth(\text) / 2, \center\y - TextHeight(\text) / 2, \text, RGB(0, 0, 1)) ;black, almost Else FillArea(\center\x + 1, \center\y + 1, RGB(0, 0, 0), RGB($FF, $FF, 0)) ;yellow DrawText(\center\x - TextWidth(\text) / 2, \center\y - TextHeight(\text) / 2, \text, RGB($FF, 0, 0)) ;red EndIf EndWith EndProcedure Procedure selectHex(*h.honeycomb, hexID) If Not *h\hexGadgets(hexID)\Status *h\chosen + *h\hexGadgets(hexID)\text *h\hexGadgets(hexID)\Status = 1 StartDrawing(CanvasOutput(*h\gadgetID)) drawhex(*h, hexID) DrawingMode(#PB_2DDrawing_Default) DrawingFont(#PB_Default) DrawText(0, *h\textY, "Chosen: " + *h\chosen) DrawText(0, *h\textY + 20, "The user chose letter " + *h\hexGadgets(hexID)\text + ". ") StopDrawing() ProcedureReturn 1 EndIf EndProcedure Procedure hexKey(*h.honeycomb, hexID) If UCase(Chr(GetGadgetAttribute(*h\gadgetID, #PB_Canvas_Input))) = *h\hexGadgets(hexID)\text ProcedureReturn selectHex(*h, hexID) EndIf EndProcedure Procedure hexMouse(*h.honeycomb, hexID) Protected mPos.POINT mPos\x = GetGadgetAttribute(*h\gadgetID, #PB_Canvas_MouseX) mPos\y = GetGadgetAttribute(*h\gadgetID, #PB_Canvas_MouseY) If inpoly(mPos,*h\hexGadgets(hexID)\shape()) ProcedureReturn selectHex(*h, hexID) EndIf EndProcedure Procedure honeycombEvents(*h.honeycomb) If Len(*h\chosen) >= *h\maxLength: ProcedureReturn: EndIf Protected event = EventType(), *eventFunction.hexEvent_prt Select event Case #PB_EventType_Input *eventFunction = @hexKey() Case #PB_EventType_LeftButtonUp *eventFunction = @hexMouse() Case #PB_EventType_LostFocus SetActiveGadget(*h\gadgetID) EndSelect If *eventFunction For hexID = 0 To ArraySize(*h\hexGadgets()) If *eventFunction(*h, hexID) Break ;event successfully handled EndIf Next EndIf EndProcedure Procedure createHexGadget(*h.honeycomb, hexID, x, y, dx, dy) With *h\hexGadgets(hexID) If *h\unusedLetters Protected letterNum = Random(Len(*h\unusedLetters) - 1) + 1 \text = Mid(*h\unusedLetters, letterNum, 1) *h\unusedLetters = ReplaceString(*h\unusedLetters, \text, "") EndIf \center\x = x: \center\y = y AddElement(\shape()): \shape()\x = x - dx: \shape()\y = y AddElement(\shape()): \shape()\x = x - dx / 2: \shape()\y = y + dy AddElement(\shape()): \shape()\x = x + dx / 2: \shape()\y = y + dy AddElement(\shape()): \shape()\x = x + dx: \shape()\y = y AddElement(\shape()): \shape()\x = x + dx / 2: \shape()\y = y - dy AddElement(\shape()): \shape()\x = x - dx / 2: \shape()\y = y - dy EndWith EndProcedure Procedure initHoneycomb(*h.honeycomb, posX, posY, dx = 30, dy = 25, marginX = 10, marginY = 5) Protected i, sx, sy, hCols = 5, hRows = 4, hexGadgetCount = hCols * hRows - 1 If Not *h: ProcedureReturn 0: EndIf *h\unusedLetters.s = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" *h\chosen = "" *h\maxLength = 20 Dim *h\hexGadgets(hexGadgetCount) ;calculate size width, height and create honeycomb with margins sx = Round(dx * (0.5 + hCols * 1.5), #PB_Round_Nearest) + 1 + 2 * marginX sy = dy * (2 * hRows + 1) + 1 + 2 * marginY + 2 * 20 ;includes room for hex, margins, and text *h\textY = sy - 2 * 20 ;create hexes Protected hexID, column, row, x, y, baseX, baseY, majorOffsetY = dy baseX = dx + marginX For column = 0 To hCols - 1 baseY = dy + marginY majorOffsetY ! dy For row = 0 To hRows - 1 x = baseX y = baseY + majorOffsetY createHexGadget(*h, hexID, x, y, dx, dy) baseY + dy * 2 hexID + 1 Next baseX + dx * 1.5 Next ;draw honeycomb *h\gadgetID = CanvasGadget(#PB_Any, posX, posY, sx, sy, #PB_Canvas_Keyboard | #PB_Canvas_ClipMouse) If *h\gadgetID = 0: ProcedureReturn 0: EndIf ;failed to created honeycomb LoadFont(0, "Arial", 24, #PB_Font_Bold) StartDrawing(CanvasOutput(*h\gadgetID)) For i = 0 To ArraySize(*h\hexGadgets()) drawhex(*h, i) Next Box(0, *h\textY, sx, 40, RGB(0, 0, 0)) ;draw black text box StopDrawing() ProcedureReturn 1 EndProcedure If OpenWindow(0, 0, 0, 400, 400, "PureBasic - Honeycombs", #PB_Window_SystemMenu) Define honeycomb.honeycomb, quit If Not initHoneycomb(honeycomb, 0, 0): End: EndIf ResizeWindow(0, #PB_Ignore, #PB_Ignore, GadgetWidth(honeycomb\gadgetID), GadgetHeight(honeycomb\gadgetID)) SetActiveGadget(honeycomb\gadgetID) Repeat event = WaitWindowEvent() Select event Case #PB_Event_Gadget If EventGadget() = honeycomb\gadgetID honeycombEvents(honeycomb) If Len(honeycomb\chosen) = honeycomb\maxLength MessageRequester("Exit", "You chose: " + honeycomb\chosen + ".") quit = 1 EndIf EndIf Case #PB_Event_CloseWindow quit = 1 EndSelect Until quit = 1 FreeGadget(honeycomb\gadgetID) CloseWindow(0) EndIf