Honeycombs

From Rosetta Code
Revision as of 22:23, 21 July 2011 by rosettacode>Markhobley ({{omit from|AWK}})
Task
Honeycombs
You are encouraged to solve this task according to the task description, using any language you may know.

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. For platforms that support pointing devices and keyboards, the application should support both methods of selection. A record of the chosen letters should be maintained and the code should be suitably commented, at the point where the the selected letter has been determined. The selected hexagon should now change colour on the display. The cycle repeats until the user has chosen all 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 letters have been chosen.

Optionally: output the list of selected letters and show the last selected letter, cater for a different number of columns or a different number of hexagons in each column, cater for two players, (turns alternate and the hexagons change a different colour depending on whether they were selected by player one or player two and records of both players selections are maintained.)

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 = 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</lang>

Tcl

Library: Tk

<lang tcl>package require Tcl 8.5 package require Tk

  1. 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

  1. 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]

}

  1. 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

}

  1. 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}

}

  1. Build the GUI

pack [honeycomb .c $letterpattern] focus .c

  1. Usually don't use this, but it's ideal for this interaction pattern

tkwait window .c puts "overall list of characters: $chosen" exit</lang>

Retrieved from "https://rosettacode.org/wiki/Honeycombs?oldid=182875"