137 lines
4.1 KiB
Text
137 lines
4.1 KiB
Text
NoMainWin
|
|
Dim hxc(20,2), ltr(26)
|
|
Global sw, sh, radius, radChk, mx, my, h$, last
|
|
h$="#g": radius = 40: radChk = 35 * 35: last = 0
|
|
sw = 400: sh = 380: WindowWidth = sw+6: WindowHeight= sh+32
|
|
Open "Liberty BASIC - Honeycombs" For graphics_nsb_nf As #g
|
|
#g "Down; Cls; TrapClose xit"
|
|
|
|
Call shuffle
|
|
Call grid 75, 15, "0 0 0", "255 215 32", "0 0 0"
|
|
|
|
#g "SetFocus; when characterInput getKey; when leftButtonDown chkClick"
|
|
Wait
|
|
|
|
Sub xit h$
|
|
Close #h$:End
|
|
End Sub
|
|
|
|
'Assign ASCII values of A thru Z to ltr() array and randomize order of letters
|
|
Sub shuffle
|
|
For i = 1 To 26
|
|
ltr(i) = i+64
|
|
Next
|
|
For i = 1 To 77
|
|
r1 = Int(Rnd(1)*26)+1
|
|
r2 = Int(Rnd(1)*26)+1
|
|
temp = ltr(r1): ltr(r1) = ltr(r2): ltr(r2) = temp
|
|
Next
|
|
End Sub
|
|
|
|
'Draw the hex cells and fill with 20 out of 26 random letters
|
|
Sub grid ox, oy, fc$, bc$, tc$
|
|
cx = ox: cy = oy
|
|
For i = 1 To 5
|
|
If (i And 1)=0 Then cy = oy + 76 Else cy = oy + 42
|
|
For j = 1 To 4
|
|
count = count + 1: letter$ = Chr$(ltr(count))
|
|
Call cell, cx, cy, fc$, bc$, tc$, letter$
|
|
hxc(count,0)=cx: hxc(count,1)=cy: cy = cy + 70
|
|
Next
|
|
cx = cx + 61
|
|
Next
|
|
End Sub
|
|
|
|
'Draw a filled hex cell and printed the letter associated with cell
|
|
Sub cell cx, cy, fc$, bc$, tc$, lt$
|
|
lastx = cx + radius: lasty = cy
|
|
For f = 1.04719755 To 6.2831853 Step 1.0471955
|
|
nx = Cos(f)*radius+cx: ny = Sin(f)*radius+cy
|
|
#g "Size 2; Color ";bc$;";BackColor ";bc$
|
|
Call triFill cx, cy, lastx, lasty, nx, ny
|
|
#g "Size 5; Color ";fc$
|
|
#g "Line ";lastx;" ";lasty;" ";nx;" ";ny;";Size 1"
|
|
lastx = nx: lasty = ny
|
|
Next
|
|
#g "Font Courier_New 36 Bold"
|
|
#g "Color ";tc$;";BackColor ";bc$
|
|
#g "Place ";cx-15;" ";cy+15;";\";lt$
|
|
End Sub
|
|
|
|
'Check for a mouse click in a hex cell
|
|
Sub chkClick h$, x, y
|
|
mx = MouseX
|
|
my = MouseY
|
|
For i = 1 To 20
|
|
If pnc(mx,my,hxc(i,0),hxc(i,1)) = 1 Then 'selected hex cell found
|
|
If hxc(i,2)=0 Then
|
|
hxc(i,2)=1 'when set to 1, hex cell & letter no longer selectable
|
|
key$ = Chr$(ltr(i))
|
|
Call cell hxc(i,0),hxc(i,1),"0 0 0","80 0 128","255 255 255",key$
|
|
Call showLetter key$
|
|
Exit For
|
|
End If
|
|
End If
|
|
Next
|
|
End Sub
|
|
|
|
'Allow letter selection via keyboard
|
|
Sub getKey h$, char$
|
|
key$ = Upper$(Inkey$)
|
|
'Poll ESC key to exit at any time
|
|
If key$=Chr$(27) Then Call xit h$
|
|
idx = Instr("ABCDEFGHIJKLMNOPQRSTUVWXYZ",key$)
|
|
If idx <> 0 Then
|
|
For i = 1 To 20
|
|
If idx+64 = ltr(i) Then 'letter matching key press found
|
|
If hxc(i,2)=0 Then
|
|
hxc(i,2)=1 'when set to 1, hex cell & letter no longer selectable
|
|
Call cell hxc(i,0),hxc(i,1),"0 0 0","80 0 128","255 255 255",key$
|
|
Call showLetter key$
|
|
Exit For
|
|
End If
|
|
End If
|
|
Next
|
|
End If
|
|
End Sub
|
|
|
|
'Print letters selected at bottom of screen
|
|
Sub showLetter key$
|
|
#g "Font Courier_New 18 Bold"
|
|
#g "Color Black;BackColor white"
|
|
#g "Place ";last*18+20;" 365;\"; key$
|
|
last = last + 1
|
|
'When 20th letter selected; exit
|
|
If last > 19 Then Call xit h$
|
|
End Sub
|
|
|
|
'Draw a filled triangle
|
|
Sub triFill x1,y1, x2,y2, x3,y3
|
|
If x2<x1 Then x=x2: y=y2: x2=x1: y2=y1: x1=x: y1=y
|
|
If x3<x1 Then x=x3: y=y3: x3=x1: y3=y1: x1=x: y1=y
|
|
If x3<x2 Then x=x3: y=y3: x3=x2: y3=y2: x2=x: y2=y
|
|
If x1<>x3 Then slope1=(y3-y1)/(x3-x1)
|
|
length=x2-x1
|
|
If length<>0 Then
|
|
slope2=(y2-y1)/(x2-x1)
|
|
For x = 0 To length
|
|
#g "Line ";Int(x+x1);" ";Int(x*slope1+y1);" ";Int(x+x1);" ";Int(x*slope2+y1)
|
|
Next
|
|
End If
|
|
y = length*slope1+y1 :length=x3-x2
|
|
If length<>0 Then
|
|
slope3=(y3-y2)/(x3-x2)
|
|
For x = 0 To length
|
|
#g "Line ";Int(x+x2);" ";Int(x*slope1+y);" ";Int(x+x2);" ";Int(x*slope3+y2)
|
|
Next
|
|
End If
|
|
End Sub
|
|
|
|
'Point in Circle function
|
|
Function pnc(ax, ay, bx, by)
|
|
If (bx-ax)*(bx-ax)+(by-ay)*(by-ay) <= radChk Then
|
|
pnc=1
|
|
Else
|
|
pnc=0
|
|
End If
|
|
End Function
|