Anonymous user
Honeycombs: Difference between revisions
→{{header|Java}}
m (→{{header|Sidef}}: minor code simplifications) |
|||
Line 1,377:
}
}</lang>
=={{header|Liberty BASIC}}==
By Andy Amaya, Sept. 24, 2015 -- with thanks from the Liberty BASIC Community.
<lang lb>
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
</lang>
=={{header|Mathematica}} / {{header|Wolfram Language}}==
| |||