Honeycomb keyboard

[B+]

I started out attempting the Honeycomb Rosetta challenge but thought this twist more interesting:
'Honeycomb Rosetta started for JB v2 2018-11-23 B+

' I changed mid course following Rosetta specs to making this Hexagonal keys of type writer.
' So the letters are not scrambled, you can type or click them more than once and type out a
' fine little message under the keyboard, quit when you fill up 2 lines or before.

' all caps for globals
global H$, XMAX, YMAX, PI, PI3, SQR3, SIDE, LMAX, SELECTED$, ROWS, YOFF, LKEY$, LASTI, MAXSELECTED

' important constants for Hexagon making,
' hexagon side is 30 pixels with rows and cols and offsets > sets screen size
H$ = "gr" : PI = acs(-1) : PI3 = PI/3 : SQR3 = sqr(3) : SIDE = 30

cols = 12 : ROWS = 8 : LMAX = cols * ROWS

dim lx(LMAX), ly(LMAX)  'save positions of hex centers by index

xoff = 100 - 1.5 * SIDE : YOFF = 100 - SIDE * SQR3

LKEY$ = "AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz0123456789.,?!:;'@#$%^&*=_+-<>(){}[]\/|            "

' The screen size depends on number of rows and cols
XMAX = 2 * xoff + cols * 1.5 * SIDE + 1.5 * SIDE
YMAX = 2 * YOFF + (ROWS + 3) * SIDE * SQR3

MAXSELECTED = int((XMAX - 20) / 16)  'about how many letters will fit across the screen with font size

nomainwin
WindowWidth = XMAX + 8
WindowHeight = YMAX + 32
UpperLeftX = (DisplayWidth - XMAX) / 2
UpperLeftY = (DisplayHeight - YMAX) / 2
open "Honeycomb - Rosetta Challenge" for graphics_nsb_nf as #gr
#gr "setfocus"
#gr "trapclose quit"
#gr "when leftButtonUp lButtonUp"
#gr "when characterInput charIn"
#gr "font consolus bold 22"
#gr "down"
#gr "color black"
#gr "size 1"

'initialize screen and hex key positions
for y = 1 to ROWS
   for x = 1 to cols
       n = n + 1
       if x mod 2 = 0 then yoff2 = .5 * SIDE * SQR3 else yoff2 = 0
       scan
       cx = x * 1.5 * SIDE + xoff : cy = y * SIDE * SQR3 + YOFF + yoff2
       lx(n) = cx : ly(n) = cy
       call drawHex n, "green"
   next
next
wait

sub lButtonUp H$, mx, my  'must have handle and mouse x,y
   'calc distance from button and if within radius that was clicked
   for i = 1 to LMAX
       if sqr((mx - lx(i))^2 + (my - ly(i))^2) <= SIDE * .5 * SQR3 then
           'notice str$(i) + " is close!"
           if LASTI <> 0 then call drawHex LASTI, "green"
           call drawHex i, "blue"
           exit sub
       end if
   next
end sub

sub drawHex i, c$
   #gr "size 1"
   #gr "backcolor ";c$
   #gr "place ";lx(i) + .5;" ";ly(i);"; circlefilled ";SIDE * .5 * SQR3
   #gr "color black"
   #gr "size 10"
   call Hex lx(i), ly(i)
   call stext lx(i) - 10, ly(i) + 11, mid$(LKEY$, i, 1)
   if c$ = "blue" then
       SELECTED$ = SELECTED$ + mid$(LKEY$, i, 1)
       call stext 10, (ROWS + 2) * SIDE * SQR3 + YOFF, mid$(SELECTED$, 1, MAXSELECTED - 1)
       call stext 10, (ROWS + 3) * SIDE * SQR3 + YOFF, mid$(SELECTED$, MAXSELECTED)
       LASTI = i
   end if
end sub

sub charIn H$, c$
   place = instr(LKEY$, c$)
   if place > 0 and place <= LMAX then
       if LASTI <> 0 then call drawHex LASTI, "green"
       call drawHex place, "blue"
   end if
end sub

sub Hex x0, y0
   for i = 0 to 6
       x1 = x0 + SIDE * cos(i * PI3)
       y1 = y0 + SIDE * sin(i * PI3)
       if i > 0 then #gr "line ";lastx;" ";lasty;" ";x1;" ";y1
       lastx = x1 : lasty = y1
   next
end sub

sub stext x, y, message$ 'note: have to reset fore or back color after ink
   #gr "place ";x;" ";y;";|";message$
end sub

sub quit H$
   close #H$
   end
end sub



[B+]

OK here is the code to meet Rosetta Challenge specs, I think

'Honeycomb Rosetta.txt for JB v2 2018-11-24 B+ finish Rosetta Challenge

global XMAX, YMAX, PI3, SQR3, SIDE, LMAX, SELECTED$, ROWS, YOFF  ' all caps for globals
PI3 = acs(-1)/3 : SQR3 = sqr(3) : SIDE = 30                      ' constants for Hexagon making
cols = 5 : ROWS = 4 : LMAX = cols * ROWS                         ' hex grid size
dim L$(LMAX), LX(LMAX), LY(LMAX), LSELECTED(LMAX)                ' save letter and hex center positions by index
xoff = 100 - 1.5 * SIDE : YOFF = 100 - SIDE * SQR3               ' center grid with offsets
for i = 1 to LMAX : L$(i) = chr$(64 + i) : next                  ' get letters array loaded
for i = LMAX to 2 step -1                                        ' shuffle letters Fisher - Yates
   r = int(rnd(0) * i) + 1                                      ' random number up to i place
   t$ = L$(r) : L$(r) = L$(i) : L$(i) = t$                      ' swap
next
XMAX = 2*xoff + cols*1.5*SIDE + 1.5*SIDE                         'screen display size needed
YMAX = 2*YOFF + (ROWS + 2)*SIDE*SQR3
nomainwin                                                        ' Window prep before open
WindowWidth = XMAX + 8                                           ' size
WindowHeight = YMAX + 32
UpperLeftX = (DisplayWidth - XMAX) / 2                           ' top left corner, center window
UpperLeftY = (DisplayHeight - YMAX) / 2
open "Honeycomb - Rosetta Challenge" for graphics_nsb_nf as #gr  ' open with title
#gr "setfocus"                                                   ' catch keys and mouse
#gr "trapclose quit"                                             ' set exit code sub
#gr "when leftButtonUp lButtonUp"                                ' set mouse click up sub
#gr "when characterInput charIn"                                 ' set keppress sub
#gr "font consolus bold 20"                                      ' set font
#gr "down"                                                       ' pen ready to draw
for y = 1 to ROWS                                                ' initialize screen with grid
   for x = 1 to cols
       n = n + 1                                                ' index hex buttons
       if x mod 2 = 0 then yoff2 = .5*SIDE*SQR3 else yoff2 = 0  ' is this column lower than first column?
       cx = x*1.5*SIDE + xoff : cy = y*SIDE*SQR3 + YOFF + yoff2 ' calc hex key centers
       LX(n) = cx : LY(n) = cy                                  ' save hex key center positions
       call drawHex n, "green"                                  ' draw key
   next
next
#gr "flush"
wait
sub charIn H$, c$                                                'is c$, the key pressed, one of the letters in L$?
   for i = 1 to LMAX                                            'if so was it selected already? or select it.
       if upper$(c$) = L$(i) and LSELECTED(i) = 0 then call drawHex i, "blue" : #gr "flush" : exit sub
   next
end sub
sub lButtonUp H$, mx, my                                         ' mx, my are mouse button release locations
   for i = 1 to LMAX                                            ' is distance from click within radius of non-selected button?
       if sqr((mx-LX(i))^2+(my-LY(i))^2) <= SIDE*.5*SQR3 and LSELECTED(i) = 0 then call drawHex i, "blue" : #gr "flush" : exit sub
   next
end sub
sub drawHex i, c$
   #gr "size 1"
   #gr "backcolor ";c$                                          ' color location
   #gr "place ";LX(i) + .5;" ";LY(i);"; circlefilled ";SIDE * .5 * SQR3
   #gr "color black"                                            ' color letter and grid, thick line #10
   #gr "size 10"
   call Hex LX(i), LY(i)                                        ' draw hexagon cell
   call stext LX(i) - 10, LY(i) + 11, L$(i)                     ' draw letter
   if c$ = "blue" then                                          ' update Selection tracking and display
       LSELECTED(i) = 1
       SELECTED$ = SELECTED$ + L$(i)
       call stext 0, (ROWS + 2) * SIDE * SQR3 + YOFF, SELECTED$ 'are we done yet? are all letters selected?
       if len(SELECTED$) = LMAX then notice "All the keys have been used. Goodbye" : call quit "#gr"
   end if
end sub
sub Hex x0, y0                                                    ' draw hexagon around x0, y0 with 6 lines
   for i = 0 to 6
       x1 = x0 + SIDE * cos(i * PI3) : y1 = y0 + SIDE * sin(i * PI3)
       if i > 0 then #gr "line ";lastx;" ";lasty;" ";x1;" ";y1
       lastx = x1 : lasty = y1
   next
end sub
sub stext x, y, message$                                          ' note: y is the bottom edge not top
   #gr "place ";x;" ";y;";|";message$                            ' print message at x, y
end sub
sub quit H$                                                       ' close window ie click top right x box
   close #H$ : end
end sub



[tsh73]

Nice drawing.
And I was thinking: how one checks if mouse clicked in hexagon?
Ha!

[zzz000abc]

Nov 24, 2018 20:40:04 GMT tsh73 said:

Nice drawing.
And I was thinking: how one checks if mouse clicked in hexagon?
Ha!

If max height of a hexagon is y then max width will be at y/2. This will be key (I have to calculate). Starting at y/2 you go up or down x-min and x-max will change.Bye taking these into consideration one can make a formula.

[B+]

Yes, simply put the distance of the mouse click position mx, my is compared to each hexagon center (indexed by i in LX() and LY() arrays). If it is less than a certain distance, like h/2 (= SIDE*.5*SQR3) as you described, then that hexagon (i), was clicked.



sub lButtonUp H$, mx, my                                         ' mx, my are mouse button release locations
   for i = 1 to LMAX                                            ' is distance from click within radius of non-selected button?
       if sqr((mx-LX(i))^2+(my-LY(i))^2) <= SIDE*.5*SQR3 and LSELECTED(i) = 0 then call drawHex i, "blue" : #gr "flush" : exit sub
   next
end sub

[zzz000abc]

Jan 22, 2019 15:01:00 GMT B+ said:

Yes, simply put the distance of the mouse click position mx, my is compared to each hexagon center (indexed by i in LX() and LY() arrays). If it is less than a certain distance, like h/2 (= SIDE*.5*SQR3) as you described, then that hexagon (i), was clicked.



sub lButtonUp H$, mx, my                                         ' mx, my are mouse button release locations
   for i = 1 to LMAX                                            ' is distance from click within radius of non-selected button?
       if sqr((mx-LX(i))^2+(my-LY(i))^2) <= SIDE*.5*SQR3 and LSELECTED(i) = 0 then call drawHex i, "blue" : #gr "flush" : exit sub
   next
end sub

hi B+,
parctically the solution is ok but not the perfect solution.
suppose we have drawn a circle inside the hexagon touching its sides and another circle out side the circle passing through corners(vertices ) of the hexagon. Then there will
gaps/spaces between the circles and if mouse is clicked there it will not be detect the hexagon

[B+]

hi B+,
parctically the solution is ok but not the perfect solution.
suppose we have drawn a circle inside the hexagon touching its sides and another circle out side the circle passing through corners(vertices ) of the hexagon. Then there will
gaps/spaces between the circles and if mouse is clicked there it will not be detect the hexagon

The circle that inscribes the hexagon is the only non ambiguous choice, it was also used to color the hexagons. Then, the hexagon around the center point is drawn with lines thick enough to overlap the circle gaps in the hexagon and the ones adjacent to it. That beats trying to "paint" with filled triangles and I agree it IS a very practical solution when you don't have PAINT command available and there is no easy way to check all click points inside a hexagon, so we check all the most important and likely ones.

[zzz000abc]

The circle that inscribes the hexagon is the only non ambiguous choice, it was also used to color the hexagons. Then, the hexagon around the center point is drawn with lines thick enough to overlap the circle gaps in the hexagon and the ones adjacent to it. That beats trying to "paint" with filled triangles and I agree it IS a very practical solution when you don't have PAINT command available and there is no easy way to check all click points inside a hexagon, so we check all the most important and likely ones.

Finally conquered Hexagon derived a formula to fill it completely.
check my 2 posts on hexagon.