Anonymous user
Honeycombs: Difference between revisions
→{{header|Tcl}}: Added PureBasic
m (→{{header|Tcl}}: Tinkering) |
(→{{header|Tcl}}: Added PureBasic) |
||
Line 7:
[[image:honeycomb.gif]]
=={{header|PureBasic}}==
Requires PureBasic v4.60. Screen controls in PureBasic are referred to as 'gadgets'.
<lang PureBasic>Macro PS(a)
#PB_Shortcut_#a
EndMacro
DataSection
keyAlphaArray:
Data.i ps(a), ps(b), ps(c), ps(d), ps(e), ps(f), ps(g), ps(h), ps(i), ps(j), ps(k), ps(l), ps(m)
Data.i ps(n), ps(o), ps(p), ps(q), ps(r), ps(s), ps(t), ps(u), ps(v), ps(w), ps(x), ps(y), ps(z)
EndDataSection
Structure integerArray
i.i[0]
EndStructure
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)
Global *keyAlphaArray.integerArray = ?keyalphaarray
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)
Protected key = GetGadgetAttribute(*h\gadgetID, #PB_Canvas_Key)
If key = *keyAlphaArray\i[Asc(*h\hexGadgets(hexID)\text) - 65]
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_KeyDown
*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 = 5, hexGadgetCount = hCols * hRows - 1
If Not *h: ProcedureReturn 0: EndIf
*h\unusedLetters.s = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
*h\chosen = ""
*h\maxLength = 5
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</lang>
[[File:PureBasic_Honeycomb.png]]
=={{header|Tcl}}==
{{libheader|Tk}}
| |||