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.)
Icon and Unicon
The configuration of the honeycomb can be changed from the command line (height and width in cells as well as the length of the side of one cell). Window dimensions are calculated. The character set used to label cells expands for larger grids. The completed grid is saved as a GIF.
There is no hexagonal widget in the Icon Graphics library so a custom widget was developed. No attempt was made to make this widget like the VIB or VIB2 widgets.
The HexWidgetData record carries around alot of data about each widget including drawing coordinates, label, a routine to know if it's been selected and helper data, and coordinates for drawing neighboring cells (down and upper/lower right).
Label selection is straight forward. Mouse selection first determines if x,y is within the widgets rectangular outer bounds. The x,y point is then reflected into the north west quadrant of the cell and the helper data is used to calculate an abbreviated cross-product (x and y will always be 0) to determine if the point is within the widgets inner bounds. <lang Icon>link printf
procedure main(A)
h := (0 < integer(\A[1])) | 4 # cells high w := (0 < integer(\A[2])) | 5 # cells wide u := (10 < integer(\A[3])) | 30 # length of cell side HoneyComb(h,w,u)
end
$define INACTIVE "light yellow" $define ACTIVE "light purple"
procedure HoneyComb(h,w,u) #: run HoneyComb demo
wb := u/2 # window border wmsg := 10 # . message space ww := 2*wb + u*(3*w+1)/2 # . width wh := 2*wb+wmsg+integer((h+1)*u*sqrt(3.)) # . height
chosen := sprintf("black,%d",wb)
fine := sprintf("black,%d",wmsg)
wparms := [ title := sprintf("HoneyComb-%dx%d",h,w),
"g","bg=white","fg=black",
sprintf("size=%d,%d",ww,wh) ]
&window := open!wparms | stop("Unable to open window")
alpha := &ucase # per original spec
if h*w > *alpha then alpha ++:= &lcase # more
if h*w > *alpha then alpha ++:= &digits # more again
if h*w > *alpha then
stop("More than ",*alpha," cells.") # choke
every put(letters := [],!string(alpha))
every !letters :=: ?letters # randomize
Widgets := [] # prepare widgets
every c := 1 to w do { # layout grid of cells
if /top then # start at top left
x := y := wb
else { # continue right from top
x := top.rx
y := if c % 2 = 0 then top.ry0 else top.ry1
}
put(Widgets,W := top := HexWidget(x,y,u,get(letters)))
every 2 to h do # fill in rest of column
put(Widgets,W := HexWidget(x := W.dx,y := W.dy,u,get(letters)))
}
activated := ""
until *activated = *Widgets do { # process widgets
e := Event()
every W := !Widgets do # select widget by
if ((e == &lpress) & W.inside(W,&x,&y)) | # mouse (left press) or
(e == W.s) then # label character
if not find(W.s,activated) then # activate if new
break activated ||:= ( DrawCell(W,ACTIVE), W.s)
Font(chosen)
DrawString(wb,wh-wb-wmsg,"Chosen: "||activated) # update selected list
}
WriteImage(sprintf("%s-%d.gif",title,&now)) # save file
Font(fine) # tell how to quit
DrawString(wb,wh-wmsg,"Right click to exit")
until Event() == &rpress
close(&window)
end
record HexWidgetData(s,u,w,h,ax,ay,cx,cy,poly,xx,xy,dx,dy,rx,ry0,ry1,inside)
procedure HexWidget(ax,ay,u,s) #: create widget s @ x,y & side u /u := 20. # side x := integer(0 <= ax) | runerr(205,ax) # ensure whole numbers y := integer(0 <= ay) | runerr(205,ay) u := integer(1 <= u) | runerr(205,u) # 1 is minimal if ridiculous h := integer(sqrt(3./4) * (w := 2 * u)) # h,w W := HexWidgetData(s,u,w,h, # string, side, width and height
ax,ay, # absolute x,y
ax+w/2,ay+h/2, # center x,y
[ax+u/2,ay, ax+(3*u)/2,ay, ax+2*u,ay+h/2,
ax+(3*u)/2,ay+h, ax+u/2,ay+h, ax,ay+h/2], # to draw polygon
-u/2,h/2, # const for z of cross product
x,ay+h, # next cell down
ax+(3*u)/2,ay+h/2,ay-h/2, # next cells right up/down
InHexWidget) # is it activated proc
return DrawCell(W,INACTIVE) end
procedure DrawCell(W,colour) #: Draw the (general) Widget
Fg(colour)
FillPolygon!W.poly
Fg("black")
DrawPolygon!W.poly
Font(sprintf("Helvetica,%d",integer(W.h/2.)))
DrawString(W.cx - TextWidth(W.s)/2,
W.cy + (WAttrib("ascent") - WAttrib("descent"))/2 + 1,W.s)
return W
end
procedure InHexWidget(W,x,y) #: return W if x,y are inside W
if W.w < 0 then W.ax -:= (W.w := -W.w) # fix if -w
if W.h < 0 then W.ay -:= (W.h := -W.h) # fix if -h
if (0 < x - W.ax < W.w) & (0 < y - W.ay < W.h) then { # disallow edge
if x > W.cx then x := W.cx - (x - W.cx) # reflect x->NW
if y > W.cy then y := W.cy - (y - W.cy) # reflect y->NW
if 0 > real(W.xx)*(y-W.poly[2]) - W.xy*(x-W.poly[1]) then # z from cross
return W
}
end</lang>
printf.icn provides formatting
Prolog
Works with SWI-Prolog and XPCE. <lang Prolog>honeycomb :- new(W, window('Honeycomb')), new(Counter, counter(20)),
new(Ph, phrase(W, point(50,500))),
send(W, recogniser, new(KB, key_binding(@nil, argument))), numlist(0, 19, NL), create_letters(20, [], LL), maplist(build_list(150,100), NL, LP), new(ChCell, chain), maplist(create_cell(W, Counter, Ph, KB, ChCell), LP, LL), send(W, size, size(600, 600)), % we must free the resources send(W, done_message, and(message(ChCell, for_all, message(@arg1, free)), message(ChCell, free), message(Counter, free), message(Ph, free), message(W, destroy))), send(W, open).
% create the link between the keyboard and the cell
init_key_binding(KB, Cell-UpperCase) :-
downcase_atom(UpperCase, LowerCase),
send(KB, function, UpperCase, message(Cell, click)),
send(KB, function, LowerCase, message(Cell, click)).
create_letters(0, LL, LL) :- !.
create_letters(N, L1, LL) :- C is random(26) + 65, ( \+member(C, L1) -> N1 is N-1, create_letters(N1, [C|L1], LL) ; create_letters(N, L1, LL)).
% creation of the cells create_cell(W, Counter,Phrase, KB, ChCell, Point, Code) :- char_code(Letter, Code), new(H, cell(W, Counter, Phrase, Letter, Point)), send(H, my_draw), send(ChCell, append, H), % create the link between the keyboard and the cell init_key_binding(KB, H-Letter).
% build the list of the centers of the cells
build_list(X0,Y0, N, point(X,Y)) :-
C is N mod 5,
L is N // 5,
C0 is C mod 2,
X is C * 75 + X0,
Y is L * round(50 * sqrt(3)) + C0 * round(25 * sqrt(3)) + Y0.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
- - pce_begin_class(phrase, string, "spelled string").
variable(str, string, both, "displayed string"). variable(window, object, both, "the display" ). variable(pt, point, both, "where to display strings"). variable(lbl1, label, both, "label to display the letters"). variable(lbl2, label, both, "label to display the last letter").
initialise(P, Window : object, Point : point) :-> send(P, slot, window, Window), send(P, slot, str, new(_, string())), send(P, slot, pt, Point), new(Lbl1, label), send(Lbl1, font, @times_bold_24), send(P, slot, lbl1, Lbl1), new(Lbl2, label), send(Lbl2, font, @times_bold_24), send(P, slot, lbl2, Lbl2).
unlink(P) :-> get(P, slot, lbl1, Lbl1), send(Lbl1, free), get(P, slot, lbl2, Lbl2), send(Lbl2, free), send(P, send_super, unlink).
% display the list of the letters % and the last letter on the screen new_letter(P, Letter) :-> get(P, slot, str, Str), send(Str, append, Letter), send(P, slot, str, Str), new(S1, string('Chosen : %s', Str)), get(P, slot, lbl1, Lbl1), send(Lbl1, selection, S1), get(P, slot, window, W), get(P, slot, pt, Pt), send(W, display, Lbl1, Pt), new(S2, string('The user choose letter %c.', Letter)), get(P, slot, lbl2, Lbl2), send(Lbl2, selection, S2), get(Pt, x, X), get(Pt, y, Y), Y1 is Y + 30, send(W, display, Lbl2, point(X, Y1)).
- - pce_end_class(phrase).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
- - pce_begin_class(counter, object, "count the unclicked cells").
variable(nb, number, both, "number of unclicked cells").
initialise(P, N : number) :-> send(P, slot, nb, N).
decrement(P) :-> get(P, slot, nb, N), send(N, minus, 1), send(P, slot, nb, N), ( send(N, equal, 0) -> send(@display, inform, 'The game is over !') ; true).
- - pce_end_class(counter).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
- - pce_begin_class(cell, path, "The honneycomb cell").
variable(p, path, both, "the cell itself" ). variable(window, object, both, "the display" ). variable(letter, name, both, "Upcase letter displayed in the cell" ). variable(center, point, both, "coordinates of the center of the cell"). variable(color, colour, both, "colour of the cell"). variable(count, counter, both, "counter of unclicked cells"). variable(status, object, both, "clicked/unclicked"). variable(phr, phrase, both, "to display the new letter").
initialise(P, Window : object, Counter : counter, Phrase: phrase, Letter:name, Center:point) :-> send_super(P, initialise), send(P, slot, letter, Letter), send(P, slot, center, Center), send(P, slot, window, Window), send(P, slot, count, Counter), send(P, slot, status, unclicked), send(P, slot, phr, Phrase), new(Pa, path),
(
get(Center, x, X0), get(Center, y, Y0), X is X0 - 25, Y is Y0 - round(25 * sqrt(3)),
send(Pa, append, point(X, Y)),
X1 is X + 50,
send(Pa, append, point(X1, Y)),
X2 is X1 + 25, send(Pa, append, point(X2, Y0)),
Y3 is Y0 + round(25 * sqrt(3)),
send(Pa, append, point(X1, Y3)), send(Pa, append, point(X, Y3)), X4 is X - 25, send(Pa, append, point(X4, Y0)), send(Pa, closed, @on) ), send(P, p, Pa), send(P, slot, color, colour(@default, 65535, 65535, 0)), % create the link between the mouse and the cell send(Pa, recogniser, click_gesture(left, , single, message(P, click))).
unlink(P) :->
get(P, slot, p, Pa),
send(Pa, free),
send(P, send_super, unlink).
% message processed when the cell is clicked
% or when the letter is pressed on the keyboard
click(P) :->
% test if the cell has already been clicked
% succeed when the the status is 'unclicked'
get(P, slot, status, unclicked),
% change the status
send(P, slot, status, clicked),
% change the color
send(P, slot, color, colour(@default, 65535, 0, 65535)),
send(P, my_draw),
get(P, slot, letter, Letter),
% inform the object "phrase" that a new letter is clicked
get(P, slot, phr, Phrase),
send(Phrase, new_letter, Letter),
% inform the object "counter" that a new letter is clicked
get(P, count, Counter),
send(Counter, decrement).
my_draw(P) :-> % display the path and fill it with the current colour get(P, slot, window, W), get(P, slot, p, Pa),
send(W, display, Pa),
get(P, slot, color, Col),
send(Pa, fill_pattern, Col),
% display the letter centered get(P, slot, letter, C),
new(Str, string(C)),
new(Tx, text(Str?value)), send(Tx, font, font(times, bold, 24)),
% compute the size of the message to center it get(P, slot, center, point(X0,Y0)), get(font(times, bold, 24), width(Str), M), XT is X0 - M/2, get(font(times, bold, 24), height, H), YT is Y0 - H/2, send(W, display, Tx, point(XT, YT)).
- - pce_end_class(cell).
</lang>
PureBasic
Requires PureBasic v4.60. Screen controls in PureBasic are referred to as 'gadgets'. <lang PureBasic>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</lang>
Ruby
<lang ruby>Shoes.app(:height => 700, :width => 800) do
C = Math::cos(Math::PI/3) S = Math::sin(Math::PI/3) Radius = 60 letters = [ %w[L A R N D 1 2], %w[G U I Y T 3 4], %w[P C F E B 5 6], %w[V S O M K 7 8], %w[Q X J Z H 9 0], ]
def highlight(hexagon) hexagon.style(:fill => magenta) end
def unhighlight(hexagon) hexagon.style(:fill => yellow) end
def choose(hexagon)
hexagon.choose
highlight hexagon
chosen = @hexagons.find_all {|h| h.chosen?}.map {|h| h.letter}
if chosen.size == @hexagons.size
@chosen.text = 'Every hexagon has been chosen.'
else
@chosen.text = "Chosen: #{chosen.sort.join(',')}" +
"\nLast Chosen: #{hexagon.letter}"
end
end
width = 20 + (Radius*(7*letters[0].size - 3)/4.0).ceil
height = 60 + (Radius*(1 + 2*S*letters.size)).ceil
@hexagons = []
letter_to_hex = {}
# create the GUI
stack(:height => height, :width => width) do
@chosen = para("Chosen:\nLast chosen:")
# draw the hexagrams
letters.size.times do |row|
letters[0].size.times do |column|
x = 60 + column * Radius * 0.75 + (1-S)*Radius
y = 80 + row * Radius * S + (column.odd? ? S * Radius * 0.5 : 0)
h = shape(x-Radius, y-S*Radius) do
stroke red
strokewidth 3
move_to(x-C*Radius, y-S*Radius)
line_to(x+C*Radius, y-S*Radius)
line_to(x+Radius, y)
line_to(x+C*Radius, y+S*Radius)
line_to(x-C*Radius, y+S*Radius)
line_to(x-Radius, y)
line_to(x-C*Radius, y-S*Radius)
end
# add some attributes and methods to the shape
class << h
attr_accessor :x, :y, :state, :letter
def chosen?
not @state.nil?
end
def choose
@state = :chosen
end
def contains?(px,py)
if @x-Radius < px and px <= @x-C*Radius
ratio = (px - @x + Radius).to_f/(Radius*(1-C))
return (@y - ratio*S*Radius < py and py <= @y + ratio*S*Radius)
elsif @x-C*Radius < px and px <= @x+C*Radius
return (@y - S*Radius < py and py < @y + S*Radius)
elsif @x+C*Radius < px and px <= @x+Radius
ratio = (@x + Radius - px).to_f/(Radius*(1-C))
return (@y - ratio*S*Radius < py and py <= @y + ratio*S*Radius)
else
return false
end
end
def inspect
'<%s,"%s",%s,%d@%d>' % [self.class, letter, chosen?, x, y]
end
end
h.x = x + x-Radius
h.y = y + y-S*Radius
h.letter = letters[row][column]
unhighlight h
@hexagons << h
letter_to_hex[h.letter.downcase] = h
letter_to_hex[h.letter.upcase] = h
# add the letter to the hexagon
para(h.letter) \
.style(:size => 56, :stroke => red) \
.move(h.x - C*Radius, h.y - S*Radius)
end
end
# highlight the hexagon under the mouse
@hex_over = nil
motion do |x, y|
hex = @hexagons.find {|h| h.contains?(x,y)}
unless hex.nil? or hex.chosen?
highlight hex
end
unless @hex_over == hex or @hex_over.nil? or @hex_over.chosen?
unhighlight @hex_over
end
@hex_over = hex
end
# handle mouse clicks
click do |button, x, y|
info("button #{button} clicked at (#{x}, #{y})")
hexagon = @hexagons.find {|h| h.contains?(x,y)}
unless hexagon.nil?
info("clicked hexagon #{hexagon}")
choose hexagon
end
end
# handle keystrokes
keypress do |key|
if key == "\x11" # control-Q
exit
elsif key == "?"
info @hexagons.collect {|h| h.inspect}.join("\n")
elsif letter_to_hex.has_key?(key)
info("pressed key #{key} -> #{letter_to_hex[key]}")
choose letter_to_hex[key]
end
end
end
end</lang>
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>