Data commit
This commit is contained in:
Ingy döt Net
parent
7387c8f97b
commit
cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
203
Task/Honeycombs/PureBasic/honeycombs.basic
Normal file
203
Task/Honeycombs/PureBasic/honeycombs.basic
Normal file
|
|
@ -0,0 +1,203 @@
|
|||
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
|
||||
Loading…
Add table
Add a link
Reference in a new issue