Honeycombs: Difference between revisions
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}}
|
Revision as of 15:03, 27 June 2011
The task is to produce a matrix of 20 hexagon shaped widgets in a honeycomb arrangement. The matrix should be arranged in such a manner that there are five columns of four hexagons. The hexagons in columns one, three and five are aligned horizontally, whereas the hexagons in columns two and four occupy a lower position within the arrangement. Each hexagon should be the same colour, and should display a unique randomly selected single capital letter on the front. The application should now wait for the user to select a hexagon, either by using a pointing device, or by pressing a key that carries a corresponding letter on a hexagon. The selected hexagon should now change colour on the display. A message should be now be output saying "The user chose letter E" (or whatever letter the user actually chose). The cycle repeats until the user has chosen five of the letters. Note that each letter can only be selected once and previously selected hexagons retain their colour after selection. The program terminates when all five letters have been chosen.
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)
Tcl
<lang tcl>package require Tcl 8.5 package require Tk
- How to make a honeycomb
proc honeycomb {w letterpattern} {
canvas $w -width 500 -height 470 set basey 10 foreach row $letterpattern {
set basex 10 set majoroffsety 0 foreach letter $row { set x [expr {$basex + 60}] set y [expr {$basey + 50 + $majoroffsety}] drawhex $w $x $y $letter 30 50 set majoroffsety [expr {50 - $majoroffsety}] incr basex 90 } incr basey 100
} return $w
}
namespace import tcl::mathop::? ;# For convenience
- How to draw a single hexagon, centered at a particular point.
proc drawhex {w x y ch dx dy} {
if {$ch eq ""} return ;# Allow elision of cells (not used here) $w create polygon \
[- $x $dx] [- $y $dy] [+ $x $dx] [- $y $dy] [+ $x $dx $dx] $y \ [+ $x $dx] [+ $y $dy] [- $x $dx] [+ $y $dy] [- $x $dx $dx] $y \ -fill yellow -outline black -tags [list hex$ch hull$ch] -width 3
$w create text $x $y -text $ch -fill red -tags [list hex$ch txt$ch] \
-font {Arial 72 bold}
# Install bindings on items $w bind hex$ch <Enter> [list enterhex $w $ch] $w bind hex$ch <Leave> [list leavehex $w $ch] $w bind hex$ch <Button-1> [list dohex $w $ch] # Handle keyboard activity through canvas-level bindings bind $w [string toupper $ch] [list dokey $w $ch] bind $w [string tolower $ch] [list dokey $w $ch]
}
- Callbacks for various bindings
proc enterhex {w ch} {
global chosen if {$ch ni $chosen} {
$w itemconfigure hull$ch -fill magenta $w itemconfigure txt$ch -fill black
}
} proc leavehex {w ch} {
global chosen if {$ch ni $chosen} {
$w itemconfigure hull$ch -fill yellow $w itemconfigure txt$ch -fill red
}
} proc dohex {w ch} {
global chosen if {$ch ni $chosen} {
lappend chosen $ch puts "chosen $ch"
} if {[llength $chosen] >= 5} {
destroy $w
}
} proc dokey {w ch} {
enterhex $w $ch dohex $w $ch
}
- Initial declarations of state variables
set chosen {} set letterpattern {
{L A R N D} {G U I Y T} {P C F E B} {V S O M K}
}
- Build the GUI
pack [honeycomb .c $letterpattern] focus .c
- Usually don't use this, but it's ideal for this interaction pattern
tkwait window .c puts "overall list of characters: $chosen" exit</lang>