Honeycombs: Difference between revisions
m Got rid of extra spaces at top and bottom of code |
m Doh! Forgot to eliminate top and bottom blank lines in xaml also. |
||
Line 571: | Line 571: | ||
}</lang> |
}</lang> |
||
XAML: |
XAML: |
||
<lang xml> |
<lang xml><Window x:Class="Honeycombs.MainWindow" |
||
<Window x:Class="Honeycombs.MainWindow" |
|||
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation" |
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation" |
||
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" |
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" |
||
Line 584: | Line 583: | ||
<Canvas x:Name="HoneycombCanvas" HorizontalAlignment="Center" VerticalAlignment="Center"/> |
<Canvas x:Name="HoneycombCanvas" HorizontalAlignment="Center" VerticalAlignment="Center"/> |
||
</Grid> |
</Grid> |
||
</Window> |
</Window></lang> |
||
</lang> |
|||
[[File:CSharpHoneycomb.jpg]] |
[[File:CSharpHoneycomb.jpg]] |
||
Revision as of 18:41, 10 February 2013
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.)
BBC BASIC
<lang bbcbasic> ALTERNATE = 1
VDU 23,22,252;252;8,16,16,128 *FONT Arial,24,B Letters$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" Letters% = !^Letters$ FOR i% = 0 TO 24 SWAP Letters%?i%, Letters%?(i%+RND(26-i%)-1) NEXT DIM xpos%(20), ypos%(20), hrgn%(20) C% = 1 FOR Y% = 36 TO 192 STEP 52 FOR X% = 35 TO 215 STEP 90 xpos%(C%) = X% ypos%(C%) = Y% C% += 1 NEXT FOR X% = 80 TO 170 STEP 90 xpos%(C%) = X% ypos%(C%) = Y%+26 C% += 1 NEXT NEXT REM Plot the hexagons: FOR C% = 1 TO 20 hrgn%(C%) = FNplothexagon(xpos%(C%), ypos%(C%), &00FFFF, \ \ MID$(Letters$,C%,1), &0000FF) NEXT SYS "InvalidateRect", @hwnd%, 0, 0 REM Initialise word selected: Word$ = "" REM Monitor mouse clicks: ON MOUSE PROCmouse(@wparam%,@lparam%) : RETURN REM Monitor keypresses: REPEAT key$ = INKEY$(1) IF key$ >= "a" key$ = CHR$(ASCkey$-32) C% = INSTR(Letters$, key$) IF C% IF C%<21 IF hrgn%(C%) PROCselect(C%) UNTIL FALSE END REM Select a hexagon with the keyboard or mouse: DEF PROCselect(C%) hrgn%(C%) = 0 * FNplothexagon(xpos%(C%), ypos%(C%), &FF00FF, \ \ MID$(Letters$,C%,1), &000000) SYS "InvalidateRect", @hwnd%, 0, 0 Word$ += MID$(Letters$, C%, 1) SYS "SetWindowText", @hwnd%, Word$ ENDPROC DEF PROCmouse(W%, L%) LOCAL C%, R% IF W%<>1 ENDPROC FOR C% = 1 TO 20 SYS "PtInRegion", hrgn%(C%), L% AND &FFFF, L% >>> 16 TO R% IF R% PROCselect(C%) NEXT ENDPROC DEF FNplothexagon(x%, y%, hcol%, text$, tcol%) LOCAL brush%, pen%, hrgn%, pt%(), size{} DIM pt%(5,1), size{dx%,dy%} pt%() = x%-30,y%,x%-15,y%+26,x%+15,y%+26,x%+30,y%,x%+15,y%-26,x%-15,y%-26 SYS "CreatePen", 0, 3, 0 TO pen% SYS "CreateSolidBrush", hcol% TO brush% SYS "SelectObject", @memhdc%, pen% TO pen% SYS "SelectObject", @memhdc%, brush% TO brush% SYS "Polygon", @memhdc%, ^pt%(0,0), 6 SYS "SelectObject", @memhdc%, pen% TO pen% SYS "SelectObject", @memhdc%, brush% TO brush% SYS "DeleteObject", pen% SYS "DeleteObject", brush% SYS "GetTextExtentPoint32", @memhdc%, text$, LEN(text$), size{} SYS "SetTextColor", @memhdc%, tcol% SYS "SetBkColor", @memhdc%, hcol% SYS "TextOut", @memhdc%, x%-size.dx%/2, y%-size.dy%/2, text$, LEN(text$) SYS "CreatePolygonRgn", ^pt%(0,0), 6, ALTERNATE TO hrgn% = hrgn%</lang>
C
<lang C>
/* Program for gtk3 */ /* discovery: essential to use consistent documentation */ /* compilation on linux: */ /* $ a=./hexagon && make -k "CFLAGS=$( pkg-config --cflags gtk+-3.0 )" "LOADLIBES=$( pkg-config --libs gtk+-3.0 )" $a && $a --gtk-debug=all */ /* search for to do */ /* The keyboard and mouse callbacks increment the "selected" status, */ /* of the matching hexagon, */ /* then invalidate the drawing window which triggers a draw event. */ /* The draw callback redraws the screen and tests for completion, */ /* upon which the program spits back the characters selected and exits */
- include<math.h>
- include<string.h>
- include<stdlib.h>
- include<gtk/gtk.h>
static GdkPixbuf*create_pixbuf(const gchar*filename) {
GdkPixbuf*pixbuf; GError*error = NULL; pixbuf = gdk_pixbuf_new_from_file(filename, &error); if(!pixbuf) { fprintf(stderr,"\n%s\n", error->message); g_error_free(error); } return pixbuf;
}
- define NGON struct ngon
NGON {
double Cx,Cy, r; int sides, selected; char c;
};
GRand*random_numbers = NULL;
- define R 20
- define TAU (2*M_PI) /* http://laughingsquid.com/pi-is-wrong/ */
- define OFFSET_X (1+sin(TAU/12))
- define OFFSET_Y (cos(TAU/12))
- define ODD(A) ((A)&1)
static void initialize_hexagons(NGON*hs,size_t n) {
NGON*h; gint i,broken; GQueue*shuffler = g_queue_new(); if (NULL == shuffler) { fputs("\ncannot allocate shuffling queue. quitting!\n",stderr); exit(EXIT_FAILURE); } /* randomize characters by stuffing them onto a double end queue and popping them off from random positions */ if ((broken = (NULL == random_numbers))) random_numbers = g_rand_new(); for (i = 'A'; i <= 'Z'; ++i) g_queue_push_head(shuffler,GINT_TO_POINTER(i)); memset(hs,0,n*(sizeof(NGON))); hs[n-1].sides = -1; /* assign the sentinel */ for (h = hs; !h->sides; ++h) { int div = (h-hs)/4, mod = (h-hs)%4; h->sides = 6; h->c = GPOINTER_TO_INT(
g_queue_pop_nth( shuffler, g_rand_int_range( random_numbers, (gint32)0, (gint32)g_queue_get_length(shuffler))));
fputc(h->c,stderr); h->r = R; h->Cx = R*(2+div*OFFSET_X), h->Cy = R*(2*(1+mod*OFFSET_Y)+ODD(div)*OFFSET_Y); fprintf(stderr,"(%g,%g)\n",h->Cx,h->Cy); } fputc('\n',stderr); g_queue_free(shuffler); if (broken) g_rand_free(random_numbers);
}
static void add_loop(cairo_t*cr,NGON*hs,int select) {
NGON*h; double r,Cx,Cy,x,y; int i, sides; for (h = hs; 0 < (sides = h->sides); ++h) if ((select && h->selected) || (select == h->selected)) { r = h->r, Cx = h->Cx, Cy = h->Cy; i = 0; x = Cx+r*cos(TAU*i/sides), y = Cy+r*sin(TAU*i/sides), cairo_move_to(cr,x,y); for (i = 1; i < sides; ++i) x = Cx+r*cos(TAU*i/sides), y = Cy+r*sin(TAU*i/sides), cairo_line_to(cr,x,y); cairo_close_path(cr); }
}
static int make_labels(cairo_t*cr,NGON*hs,int select) {
NGON*h; int i = 0; char text[2]; text[1] = 0; for (h = hs; 0 < h->sides; ++h) if ((select && h->selected) || (select == h->selected)) /* yuck, need to measure the font. Better to use pango_cairo */ *text = h->c, cairo_move_to(cr,h->Cx,h->Cy), cairo_show_text(cr,text), ++i; return i;
}
static int archive(int a) {
static GQueue*q = NULL; if ((NULL == q) && (NULL == (q = g_queue_new()))) { fputs("\ncannot allocate archival queue. quitting!\n",stderr); exit(EXIT_FAILURE); } if (a < -1) /* reset */ return g_queue_free(q), q = NULL, 0; if (-1 == a) /* pop off tail */ return g_queue_is_empty(q) ? 0 : GPOINTER_TO_INT(g_queue_pop_tail(q)); if (!a) /* peek most recent entry */ return g_queue_is_empty(q) ? 0 : GPOINTER_TO_INT(g_queue_peek_head(q)); g_queue_push_head(q,GINT_TO_POINTER(a)); /* store */ return a;
}
/* to do: use appropriate sizing, use the cairo transformation matrix */ static gboolean draw(GtkWidget*widget,cairo_t*cr,gpointer data) {
/* unselected fill in yellow */ cairo_set_source_rgba(cr,0.8,0.8,0,1), add_loop(cr,(NGON*)data,0); cairo_fill(cr);
/* selected fill, purple */ cairo_set_source_rgba(cr,0.8,0,0.8,1); add_loop(cr,(NGON*)data,1); cairo_fill_preserve(cr);
/* all outlines gray, background shows through, fun fun! */ cairo_set_line_width (cr, 3.0); cairo_set_source_rgba(cr,0.7,0.7,0.7,0.7); add_loop(cr,(NGON*)data,0); cairo_stroke(cr);
/* select labels */ cairo_set_source_rgba(cr,0,1,0,1); make_labels(cr,(NGON*)data,1); cairo_stroke(cr);
/* unselected labels */ cairo_set_source_rgba(cr,1,0,0,1); /* to do: clean up this exit code */ if (!make_labels(cr,(NGON*)data,0)) { int c; putchar('\n'); while ((c = archive(-1))) putchar(c); puts("\nfinished"); archive(-2); exit(EXIT_SUCCESS); } cairo_stroke(cr);
return TRUE;
}
/*the widget is a GtkDrawingArea*/ static gboolean button_press_event(GtkWidget*widget,const GdkEvent*event,gpointer data) {
NGON*h,*hs = (NGON*)data; gdouble x_win, y_win; if (!gdk_event_get_coords(event,&x_win,&y_win)) fputs("\nBUTTON, gdk_event_get_coords(event,&x_win,&y_win)) failed\n",stderr); else { fprintf(stderr,"x_win=%g y_win=%g\n",(double)x_win,(double)y_win); for (h = hs; 0 < h->sides; ++h) /* detection algorithm: */ /* if mouse click within inner radius of hexagon */ /* Much easier than all in-order cross products have same sign test! */ if ((pow((x_win-h->Cx),2)+pow((y_win-h->Cy),2)) < pow((h->r*cos(TAU/(180/h->sides))),2)) {
++h->selected; archive(h->c); /* discovery: gdk_window_invalidate_region with NULL second argument does not work */ gdk_window_invalidate_rect(gtk_widget_get_window(widget),(const GdkRectangle*)NULL,TRUE); break;
} } return TRUE;
}
static gboolean key_press_event(GtkWidget*widget,const GdkEvent*event,gpointer data) {
NGON*h,*hs = (NGON*)data; guint keyval; int unicode; if (!gdk_event_get_keyval(event,&keyval)) fputs("\nKEY! gdk_event_get_keyval(event,&keyval)) failed.\n",stderr); else { unicode = (int)gdk_keyval_to_unicode(gdk_keyval_to_upper(keyval)); fprintf(stderr,"key with unicode value: %d\n",unicode); for (h = hs; 0 < h->sides; ++h) /* look for a matching character associated with a hexagon */ if (h->c == unicode) {
++(h->selected); archive(h->c); /* discovery: gdk_window_invalidate_region with NULL second argument does not work */ gdk_window_invalidate_rect(gtk_widget_get_window(widget),(const GdkRectangle*)NULL,TRUE); break;
} } return TRUE;
}
int main(int argc,char*argv[]) {
GtkWidget *window, *vbox, /* *label, */ *drawing_area; NGON ngons[21]; /* sentinal has negative number of sides */
/* discovery: gtk_init removes gtk debug flags, such as --gtk-debug=all */ /* also calls gdk_init which handles --display and --screen or other X11 communication issues */ gtk_init(&argc, &argv);
/* GTK VERSION 3.2.0 */ fprintf(stderr,"GTK VERSION %d.%d.%d\n",GTK_MAJOR_VERSION,GTK_MINOR_VERSION,GTK_MICRO_VERSION);
window = gtk_window_new(GTK_WINDOW_TOPLEVEL);
/* discovery: to make window transparent I have to use the alpha channel correctly */
/* discovery: GTK_WINDOW(GtkWidget*) casts the widget to window */ /* discovery: window in the function name? use GTK_WINDOW. g_ in function name? use G_OBJECT */ gtk_window_set_title(GTK_WINDOW(window), "Rosetta Code Honeycomb, C with GTK"); gtk_window_set_default_size(GTK_WINDOW(window), 308, 308+12+8); /* XxY */ /* discovery: making the window vanish does not stop the program */ /* discovery: NULL is placeholder for extra data sent to the callback */ g_signal_connect_swapped(G_OBJECT(window),"destroy",G_CALLBACK(gtk_main_quit),NULL);
/* I created /tmp/favicon.ico from http://rosettacode.org/favicon.ico */ /* Your window manager could use the icon, if it exists, and you fix the file name */ gtk_window_set_icon(GTK_WINDOW(window),create_pixbuf("/tmp/favicon.ico"));
vbox = gtk_vbox_new(TRUE,1); gtk_container_add(GTK_CONTAINER(window),vbox);
/* to do: fix the label widget */ /* I did not learn to control multiple box packing, and I was */ /* too lazy to make the label widget accessible. Plan was to */ /* insert the most recent character using "peek" option of the archive */
- if 0
label = gtk_label_new("None Selected"); gtk_widget_set_size_request(label,308,20); gtk_box_pack_end(GTK_BOX(vbox),label,FALSE,TRUE,4);
- endif
drawing_area = gtk_drawing_area_new(); gtk_widget_set_events(drawing_area,GDK_BUTTON_PRESS_MASK|GDK_KEY_PRESS_MASK|GDK_EXPOSURE_MASK);
random_numbers = g_rand_new(); initialize_hexagons(ngons,G_N_ELEMENTS(ngons)); /* Discovery: expose_event changed to draw signal. We no longer need configure-event */ g_signal_connect(G_OBJECT(drawing_area),"draw",G_CALLBACK(draw),(gpointer)ngons);
g_signal_connect(G_OBJECT(drawing_area),"button-press-event",G_CALLBACK(button_press_event),(gpointer)ngons); g_signal_connect(G_OBJECT(drawing_area),"key-press-event",G_CALLBACK(key_press_event),(gpointer)ngons); gtk_widget_set_size_request(drawing_area, 308, 308); /* XxY */ gtk_box_pack_start(GTK_BOX(vbox),drawing_area,TRUE,TRUE,4);
/* Discovery: must allow focus to receive keyboard events */ gtk_widget_set_can_focus(drawing_area,TRUE);
/* Discovery: can set show for individual widgets or use show_all */ gtk_widget_show_all(window); gtk_main(); g_rand_free(random_numbers); return EXIT_SUCCESS;
} </lang>
C#
<lang csharp>using System; using System.Collections.Generic; using System.Linq; using System.Windows; using System.Windows.Controls; using System.Windows.Input; using System.Windows.Media; using System.Windows.Shapes;
//////////////////////////////////////////////////////////////////////////////////////////////////// // namespace: Honeycombs // // summary: WPF implementation of Rosetta Code Honeycombs task. Uses Polygon shapes as hexes. ////////////////////////////////////////////////////////////////////////////////////////////////////
namespace Honeycombs {
public partial class MainWindow { private const int RowCount = 4; private const int ColCount = 5; private const int LabelSize = 20; private readonly char[] _permutedChars;
public MainWindow() { if (RowCount * ColCount > 26)
- pragma warning disable 162
{ throw new ArgumentException("Too many cells"); }
- pragma warning restore 162
_permutedChars = GetPermutedChars(RowCount * ColCount);
// VS Generated code not included InitializeComponent(); }
private static char[] GetPermutedChars(int characterCount) { const string allChars = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"; var rnd = new Random(); var chars = new char[allChars.Length];
for (int i = 0; i < allChars.Length; i++) { chars[i] = allChars[i]; }
for (int i = 0; i < characterCount; i++) { int swapIndex = rnd.Next() % (allChars.Length - i); char tmp = chars[swapIndex + i]; chars[swapIndex + i] = chars[i]; chars[i] = tmp; } return chars; }
private void SetHexProperties(UIElementCollection hexes, double cellSize) { int charIndex = 0; List<Polygon> hexList = hexes.Cast<Polygon>().ToList();
foreach (Polygon element in hexList) { SetHexProperties(element, _permutedChars[charIndex++], cellSize); } }
private void SetHexProperties(Polygon hex, char charToSet, double cellSize) { var tag = (Tuple<int, int, double, double>) hex.Tag; double cellX = tag.Item3; double cellY = tag.Item4;
// We place the text in a grid centered on the hex. // The grid will then center the text within itself.
var centeringGrid = new Grid(); centeringGrid.Width = centeringGrid.Height = 2 * cellSize; centeringGrid.SetValue(Canvas.LeftProperty, cellX - cellSize); centeringGrid.SetValue(Canvas.TopProperty, cellY - cellSize); centeringGrid.IsHitTestVisible = false; HoneycombCanvas.Children.Add(centeringGrid);
var label = new TextBlock { Text = new string(charToSet, 1), FontFamily = new FontFamily("Segoe"), FontSize = LabelSize }; label.HorizontalAlignment = HorizontalAlignment.Center; label.VerticalAlignment = VerticalAlignment.Center; label.IsHitTestVisible = false; centeringGrid.Children.Add(label);
// Reset the tag to keep track of the character in the hex hex.Tag = charToSet; hex.Fill = new SolidColorBrush(Colors.Yellow); hex.Stroke = new SolidColorBrush(Colors.Black); hex.StrokeThickness = cellSize / 10;
// Mouse down event handler for the hex hex.MouseDown += hex_MouseDown; }
private void hex_MouseDown(object sender, MouseButtonEventArgs e) { var hex = sender as Shape; if (hex == null) { throw new InvalidCastException("Non-shape in Honeycomb"); }
// Get the letter for this hex var ch = (char) hex.Tag;
// Add it to our Letters TextBlock Letters.Text = Letters.Text + ch;
// Color the hex magenta hex.Fill = new SolidColorBrush(Colors.Magenta);
// Remove the mouse down event handler so we won't hit on this hex again hex.MouseDown -= hex_MouseDown; }
private static void GetCombSize(double actualHeight, double actualWidth, int columns, int rows, out double cellSize, out double combHeight, out double combWidth) { double columnFactor = (3 * columns + 1) / 2.0; double rowFactor = (Math.Sqrt(3) * (2 * rows + 1)) / 2.0; double cellFromWidth = actualWidth / columnFactor; double cellFromHeight = actualHeight / rowFactor; cellSize = Math.Min(cellFromWidth, cellFromHeight); combWidth = cellSize * columnFactor; combHeight = cellSize * rowFactor; }
private static void AddCells(Canvas canvas, double cellSize, int columns, int rows) { double rowHeight = cellSize * Math.Sqrt(3) / 2;
for (int row = 0; row < rows; row++) { AddRow(rowHeight, canvas, cellSize, columns, row); rowHeight += cellSize * Math.Sqrt(3); } }
private static void AddRow(double rowHeight, Canvas canvas, double cellSize, int columnCount, int row) { double cellX = cellSize; double cellHeight = cellSize * Math.Sqrt(3);
for (int col = 0; col < columnCount; col++) { double cellY = rowHeight + ((col & 1) == 1 ? cellHeight / 2 : 0); Polygon hex = GetCenteredHex(cellSize, cellX, cellY, cellHeight); hex.Tag = Tuple.Create(col, row, cellX, cellY); canvas.Children.Add(hex); cellX += 3 * cellSize / 2; } }
private static Polygon GetCenteredHex(double cellSize, double cellX, double cellY, double cellHeight) { var hex = new Polygon(); hex.Points.Add(new Point(cellX - cellSize, cellY)); hex.Points.Add(new Point(cellX - cellSize / 2, cellY + cellHeight / 2)); hex.Points.Add(new Point(cellX + cellSize / 2, cellY + cellHeight / 2)); hex.Points.Add(new Point(cellX + cellSize, cellY)); hex.Points.Add(new Point(cellX + cellSize / 2, cellY - cellHeight / 2)); hex.Points.Add(new Point(cellX - cellSize / 2, cellY - cellHeight / 2)); return hex; }
private void Window_Loaded(object sender, RoutedEventArgs e) { double combHeight, combWidth, cellSize;
// Get sizes that will fit within our window GetCombSize(Main.ActualHeight, Main.ActualWidth, ColCount, RowCount, out cellSize, out combHeight, out combWidth);
// Set the canvas size appropriately HoneycombCanvas.Width = combWidth; HoneycombCanvas.Height = combHeight;
// Add the cells to the canvas AddCells(HoneycombCanvas, cellSize, ColCount, RowCount);
// Set the cells to look like we want them SetHexProperties(HoneycombCanvas.Children, cellSize); } }
}</lang> XAML: <lang xml><Window x:Class="Honeycombs.MainWindow"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" Title="Honeycomb" Height="400" Width="300" Loaded="Window_Loaded" ResizeMode="NoResize"> <Grid x:Name="Main" Margin="5,5,5,0"> <Grid.RowDefinitions> <RowDefinition/> <RowDefinition Height="69.6"/> </Grid.RowDefinitions> <TextBlock x:Name="Letters" HorizontalAlignment="Center" TextWrapping="Wrap" Grid.Row="1" VerticalAlignment="Center" FontSize="20"/> <Canvas x:Name="HoneycombCanvas" HorizontalAlignment="Center" VerticalAlignment="Center"/> </Grid>
</Window></lang> File:CSharpHoneycomb.jpg
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). The direction of the resultant z indicates if the point is inside or outside of 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 # can draw any polygon 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).
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)
Python
Rambling python3 code with tkinter
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>
XPL0
<lang XPL0>include c:\cxpl\stdlib; \(color definitions, etc.)
proc DrawHexagon(X0, Y0, Side, Color); \Draw a filled hexagon centered at X0,Y0 int X0, Y0, Side, Color; int X, Y; for Y:= -Side*19/22 to +Side*19/22 do \19/22 aprox = sqrt(3.0)/2.0
for X:= -Side to +Side do if abs(X) + abs(Y)*23/38 <= Side then \23/38 aprox = 1.0/sqrt(3.0) Point(X+X0, Y+Y0, Color);
def Cols=5, Rows=4, X0=23, Y0=20; \matrix shape, offset on screen int C, R, X, Y, Letter, Counter, SaveX(26), SaveY(26); [SetVid($101); \set video to 640x480x8 graphics for Letter:= 0 to 26-1 do SaveX(Letter):= 0; Attrib(LMagenta<<8); \light magenta letter background for R:= 0 to Rows-1 do
for C:= 0 to Cols-1 do [X:= C*35 + X0; Y:= R*40 + (C&1)*20 + Y0; DrawHexagon(X, Y, 22, LMagenta); repeat Letter:= Ran(26) until SaveX(Letter) = 0; Move(X-4, Y-7); ChOut(6, Letter+^A); SaveX(Letter):= X; SaveY(Letter):= Y; \save coordinates for letter ];
Counter:= 0; repeat Letter:= ChIn(1); \get letter from keyboard
if Letter>=^a & Letter<=^z then Letter:= Letter-$20; \make uppercase if Letter>=^A & Letter<=^Z then if SaveX(Letter-^A) # 0 then \letter is available [X:= SaveX(Letter-^A); Y:= SaveY(Letter-^A); DrawHexagon(X, Y, 22, Yellow); \change color Move(X-4, Y-7); Attrib(Yellow<<8); ChOut(6, Letter); Move(Counter*8+8, Rows*40+30); \show record of chosen letters Attrib(Yellow); ChOut(6, Letter); Counter:= Counter+1; SaveX(Letter-^A):= 0; \letter is no longer available ] else ChOut(0, Bel) \letter is not available else ChOut(0, Bel); \not a letter (A..Z)
until Counter >= Cols*Rows; SetVid($03); \restore normal text display ]</lang>