On GitHub: https://github.com/verybadidea/hexgrid (test_game_hexatris.bas) <-- For this latest version
Or the copy-and-paste conveniently concatenated version:
Code: Select all
'-------------------------------------------------------------------------------
#Define sqrt Sqr
#Define max(a, b) (IIf((a) > (b), (a), (b)))
#Define min(a, b) (IIf((a) < (b), (a), (b)))
#Define limit(v, v_min, v_max) (min(max((v), (v_min)), (v_max)))
#Define lerp(a, b, t) ((a) + ((b) - (a)) * t) 'linearly interpolation
#Define M_PI (Atn(1) * 4)
'---------------------------- hex cube coordinates -----------------------------
Type hex_cube
Dim As Integer x 'pointing right/up
Dim As Integer y 'pointing left/up
Dim As Integer z 'pointing down
Declare Operator Cast () As String
End Type
Operator hex_cube.cast() As String
Return "(x: " & x & ", y: " & y & ", z: " & z & ")"
End Operator
Function hex_equal(a As hex_cube, b As hex_cube) As boolean
If a.x <> b.x Then Return false
If a.y <> b.y Then Return false
If a.z <> b.z Then Return false
Return true
End Function
Function hex_add(a As hex_cube, b As hex_cube) As hex_cube
Return Type(a.x + b.x, a.y + b.y, a.z + b.z)
End Function
Function hex_substract(a As hex_cube, b As hex_cube) As hex_cube
Return Type(a.x - b.x, a.y - b.y, a.z - b.z)
End Function
Dim Shared As Const hex_cube hex_cube_direction(0 To 5) = {_
Type(+1, -1, 0), Type(+1, 0, -1), Type(0, +1, -1), _
Type(-1, +1, 0), Type(-1, 0, +1), Type(0, -1, +1) }
Function hex_neighbor(hc As hex_cube, direction As Integer) As hex_cube
Return hex_add(hc, Cast(hex_cube, hex_cube_direction(direction)))
End Function
Dim Shared As Const hex_cube hex_cube_diagonal(0 To 5) = {_
Type(+2, -1, -1), Type(+1, +1, -2), Type(-1, +2, -1), _
Type(-2, +1, +1), Type(-1, -1, +2), Type(+1, -2, +1) }
Function hex_neighbor_diagonal(hc As hex_cube, direction As Integer) As hex_cube
Return hex_add(hc, Cast(hex_cube, hex_cube_diagonal(direction)))
End Function
Function hex_distance(a As hex_cube, b As hex_cube) As Integer
Return (Abs(a.x - b.x) + Abs(a.y - b.y) + Abs(a.z - b.z)) \ 2
End Function
'Note: cube_distance also possible with max(dx, dy, dx)
'60° rotation
Function hex_rotate_left(a As hex_cube) As hex_cube
'return type(-a.z, -a.x, -a.y)
Return Type(-a.y, -a.z, -a.x)
End Function
Function hex_rotate_right(a As hex_cube) As hex_cube
'return type(-a.y, -a.z, -a.x)
Return Type(-a.z, -a.x, -a.y)
End Function
'For 60° rotation around other hex: translate, rotate, translate back: TODO
'Use add and substract for translation
'Reflection
Function hex_reflect_x(h As hex_cube) As hex_cube
Return Type(h.x, h.z, h.y)
End Function
Function hex_reflect_y(h As hex_cube) As hex_cube
Return Type(h.z, h.y, h.x)
End Function
Function hex_reflect_z(h As hex_cube) As hex_cube
Return Type(h.y, h.x, h.z)
End Function
'--------------------------- hex axial coordinates -----------------------------
Type hex_axial
Dim As Integer q 'pointing right/up
Dim As Integer r 'pointing down
Declare Operator Cast () As String
End Type
Operator hex_axial.cast() As String
Return "(q: " & q & ", r: " & r & ")"
End Operator
Function hex_axial_add(a As hex_axial, b As hex_axial) As hex_axial
Return Type(a.q + b.q, a.r + b.r)
End Function
Function hex_axial_substract(a As hex_axial, b As hex_axial) As hex_axial
Return Type(a.q - b.q, a.r - b.r)
End Function
Const HEX_AX_RI_DN = 0
Const HEX_AX_RI_UP = 1
Const HEX_AX_UP = 2
Const HEX_AX_LE_UP = 3
Const HEX_AX_LE_DN = 4
Const HEX_AX_DN = 5
Dim Shared As Const hex_axial hex_axial_direction(0 To 5) = {_
Type(+1, 0), Type(+1, -1), Type(0, -1), _
Type(-1, 0), Type(-1, +1), Type(0, +1) }
Function hex_axial_neighbor(ha As hex_axial, direction As Integer) As hex_axial
Return hex_axial_add(ha, Cast(hex_axial, hex_axial_direction(direction)))
End Function
Function hex_axial_distance(a As hex_axial, b As hex_axial) As Integer
Return (Abs(a.q - b.q) + Abs(a.q + a.r - b.q - b.r) + Abs(a.r - b.r)) \ 2
End Function
'Note: Or convert to hex_cube first
'------------------------- a simple hex <vextor> class -------------------------
Type hex_list
Private:
Dim As hex_cube h(Any)
Public:
Declare Function Push(h As hex_cube) As Integer
Declare Function Pop() As hex_cube
Declare Sub del_()
Declare Function size() As Integer
Declare Function last_index() As Integer
End Type
'add to end of list
Function hex_list.push(h_ As hex_cube) As Integer
Dim As Integer ub = UBound(h) + 1
ReDim Preserve h(ub)
h(ub) = h_
Return ub
End Function
'remove from end of list
Function hex_list.pop() As hex_cube
Dim As hex_cube h_
Dim As Integer ub = UBound(h)
If ub >= 0 Then
h_ = h(ub)
If ub = 0 Then
Erase h
Else
ReDim Preserve h(ub - 1)
End If
End If
Return h_
End Function
Sub hex_list.del_()
Erase(h)
End Sub
Function hex_list.size() As Integer
Return UBound(h) + 1
End Function
Function hex_list.last_index() As Integer
Return UBound(h)
End Function
'------------------------ a simple point <vextor> class ------------------------
Type pt_dbl
Dim As Double x, y
End Type
Type pt_list
Private:
Dim As pt_dbl pt(Any)
Public:
Declare Function Push(pt_ As pt_dbl) As Integer
Declare Function Pop() As pt_dbl
Declare Sub del_()
Declare Function size() As Integer
Declare Function last_index() As Integer
End Type
'add to end of list
Function pt_list.push(pt_ As pt_dbl) As Integer
Dim As Integer ub = UBound(pt) + 1
ReDim Preserve pt(ub)
pt(ub) = pt_
Return ub
End Function
'remove from end of list
Function pt_list.pop() As pt_dbl
Dim As pt_dbl pt_
Dim As Integer ub = UBound(pt)
If ub >= 0 Then
pt_ = pt(ub)
If ub = 0 Then
Erase pt
Else
ReDim Preserve pt(ub - 1)
End If
End If
Return pt_
End Function
Sub pt_list.del_()
Erase(pt)
End Sub
Function pt_list.size() As Integer
Return UBound(pt) + 1
End Function
Function pt_list.last_index() As Integer
Return UBound(pt)
End Function
'---------------------------- offset coordinates -------------------------------
Type hex_offset
Dim As Integer row_, col_
End Type
'odd-r: for pointy tops, shoves odd row_s by +½ col_umn
Function hex_cube_to_oddr(hc As hex_cube) As hex_offset
Return Type(hc.x + (hc.z - (hc.z And 1)) \ 2, hc.z)
End Function
Function hex_oddr_to_cube(ho As hex_offset) As hex_cube
Dim As Integer x = ho.col_ - (ho.row_ - (ho.row_ And 1)) \ 2
Dim As Integer z = ho.row_
Dim As Integer y = -(x + z)
Return Type(x, y, z)
End Function
'even-r: for pointy tops, shoves even row_s by +½ col_umn
Function hex_cube_to_evenr(hc As hex_cube) As hex_offset
Return Type(hc.x + (hc.z + (hc.z And 1)) \ 2, hc.z)
End Function
Function hex_evenr_to_cube(ho As hex_offset) As hex_cube
Dim As Integer x = ho.col_ - (ho.row_ + (ho.row_ And 1)) \ 2
Dim As Integer z = ho.row_
Dim As Integer y = -(x + z)
Return Type(x, y, z)
End Function
'odd-q: for flat tops, shoves odd col_umns by +½ row_
Function hex_cube_to_oddq(hc As hex_cube) As hex_offset
Return Type(hc.x, hc.z + (hc.x - (hc.x And 1)) \ 2)
End Function
Function hex_oddq_to_cube(ho As hex_offset) As hex_cube
Dim As Integer x = ho.col_
Dim As Integer z = ho.row_ - (ho.col_ - (ho.col_ And 1)) \ 2
Dim As Integer y = -(x + z)
Return Type(x, y, z)
End Function
'even-q: shoves even col_umns by +½ row_
Function hex_cube_to_evenq(hc As hex_cube) As hex_offset
Return Type(hc.x, hc.z + (hc.x + (hc.x And 1)) \ 2)
End Function
Function hex_evenq_to_cube(ho As hex_offset) As hex_cube
Dim As Integer x = ho.col_
Dim As Integer z = ho.row_ - (ho.col_ + (ho.col_ And 1)) \ 2
Dim As Integer y = -(x + z)
Return Type(x, y, z)
End Function
'--------------------------- coordinate conversion -----------------------------
Function hex_cube_to_axial(hc As hex_cube) As hex_axial
Return Type(hc.x, hc.z) 'ignore y
End Function
Function hex_axial_to_cube(ha As hex_axial) As hex_cube
'return type(ha.q, ha.r, -(ha.q + ha.r))
Return Type(ha.q, -(ha.q + ha.r), ha.r)
End Function
'------------------------------- axial rotation --------------------------------
Sub hex_axial_rotate_right(ByRef ha As hex_axial)
ha = hex_cube_to_axial(hex_rotate_right(hex_axial_to_cube(ha)))
End Sub
Sub hex_axial_rotate_left(ByRef ha As hex_axial)
ha = hex_cube_to_axial(hex_rotate_left(hex_axial_to_cube(ha)))
End Sub
'--------------------------------- hex layout ----------------------------------
Type hex_orientation
Dim As Const Double f0, f1, f2, f3
Dim As Const Double b0, b1, b2, b3
Dim As Const Double start_angle 'in multiples of 60°
End Type
Dim Shared As Const hex_orientation layout_pointy = Type( _
sqrt(3), sqrt(3)/2, 0, 3/2, _
sqrt(3)/3, -1/3, 0, 2/3, _
0.5)
Dim Shared As Const hex_orientation layout_flat = Type( _
3/2, 0, sqrt(3)/2, sqrt(3), _
2/3, 0, -1/3, sqrt(3)/3, _
0.0)
Type hex_layout
Dim As Const hex_orientation orientation
Dim As Const pt_dbl size 'distance from origin to a corner
Dim As Const pt_dbl origin
End Type
'Hex to Pixel
Function hex_to_pixel(layout As hex_layout, h As hex_axial) As pt_dbl
Dim ByRef As Const hex_orientation M = layout.orientation
Dim As Double x = (M.f0 * h.q + M.f1 * h.r) * layout.size.x
Dim As Double y = (M.f2 * h.q + M.f3 * h.r) * layout.size.y
Return Type(x + layout.origin.x, y + layout.origin.y)
End Function
Type hex_cube_frac
Dim As Double x, y, z
End Type
'hex cube rounding
Function hex_round(h As hex_cube_frac) As hex_cube
Dim As Integer x = CInt(h.x) 'is this right?
Dim As Integer y = CInt(h.y)
Dim As Integer z = CInt(h.z)
Dim As Double x_diff = Abs(x - h.x) 'q
Dim As Double y_diff = Abs(y - h.y) 'r
Dim As Double z_diff = Abs(z - h.z) 's
If (x_diff > y_diff) And (x_diff > z_diff) Then
x = -(y + z)
ElseIf (y_diff > z_diff) Then
y = -(x + z)
Else
z = -(x + y)
End If
Return Type(x, y, z)
End Function
'Pixel to Hex (integer cube coordinates)
Function pixel_to_hex_int(layout As hex_layout, p As pt_dbl) As hex_cube
Dim ByRef As Const hex_orientation M = layout.orientation
Dim As pt_dbl pt = Type(_
(p.x - layout.origin.x) / layout.size.x, _
(p.y - layout.origin.y) / layout.size.y)
Dim As Double q = M.b0 * pt.x + M.b1 * pt.y
Dim As Double r = M.b2 * pt.x + M.b3 * pt.y
Return hex_round(Type(q, -(q + r), r)) 'x,y,z
End Function
Function hex_lerp(a As hex_cube, b As hex_cube, t As Double) As hex_cube_frac
Return Type(lerp(a.x, b.x, t), lerp(a.y, b.y, t), lerp(a.z, b.z, t))
End Function
'return list of hex (with cube coordinates)
Function hex_line_list(a As hex_cube, b As hex_cube) As hex_list
Dim As Integer N = hex_distance(a, b)
Dim As hex_list hexes
Dim As Double dist_step = 1.0 / max(N, 1)
For i As Integer = 0 To N
hexes.push(hex_round(hex_lerp(a, b, dist_step * i)))
Next
Return hexes
End Function
'relative corner position from hexagon center
'note: for speed, the corner positions can be precalculated (after setting size)
Function hex_corner_offset(layout As hex_layout, corner As Integer) As pt_dbl
Dim As pt_dbl size = layout.size
size.x *= 0.85
size.y *= 0.85
Dim As Double angle = 2.0 * M_PI * (layout.orientation.start_angle + corner) / 6
Return Type(size.x * Cos(angle), size.y * Sin(angle))
End Function
'a bit complex way to make an array of 6 points
Function hex_corner_list(layout As hex_layout, h As hex_axial) As pt_list
Dim As pt_list corners
Dim As pt_dbl center = hex_to_pixel(layout, h)
For i As Integer = 0 To 5 'loop 6 corners (clockwise)
Dim As pt_dbl offset = hex_corner_offset(layout, i)
corners.push(Type(center.x + offset.x, center.y + offset.y))
Next
Return corners
End Function
Sub hex_draw_outline(layout As hex_layout, h As hex_axial, c As ULong)
Dim As pt_list corners = hex_corner_list(layout, h)
Dim As pt_dbl first = corners.pop() 'save for last loop
Dim As pt_dbl b = first
For i As Integer = 0 To 5
Dim As pt_dbl a = b
b = IIf(i = 5, first, corners.pop())
Line(a.x, a.y)-(b.x, b.y), c
Next
End Sub
Sub draw_triangle_filled(pt1 As pt_dbl, pt2 As pt_dbl, pt3 As pt_dbl, c As ULong)
Dim As Integer x, y, xmid
Dim As Double x1, x2
Dim As Double dx12, dx13, dx23
'order top to bottom
If (pt1.y > pt2.y) Then Swap pt1, pt2
If (pt1.y > pt3.y) Then Swap pt1, pt3
If (pt2.y > pt3.y) Then Swap pt2, pt3
'calculate line slopes
dx12 = (pt2.x - pt1.x) / (pt2.y - pt1.y)
dx13 = (pt3.x - pt1.x) / (pt3.y - pt1.y)
dx23 = (pt3.x - pt2.x) / (pt3.y - pt2.y)
'Upper half triangle
x1 = pt1.x
x2 = pt1.x
For y = pt1.y To pt2.y - 1
Line (x1, y)-(x2, y), c
x1 += dx12
x2 += dx13
Next
'lower half triangle
x1 = pt2.x' + dx23 / 2
For y = pt2.y To pt3.y
Line (x1, y)-(x2, y), c
x1 += dx23
x2 += dx13
Next
'make edges nice (optional)
'line (pt1.x, pt1.y)-(pt2.x, pt2.y), c
'line (pt2.x, pt2.y)-(pt3.x, pt3.y), c
'line (pt3.x, pt3.y)-(pt1.x, pt1.y), c
End Sub
Sub hex_draw_filled(layout As hex_layout, h As hex_axial, c_fill As ULong)
Dim As pt_dbl center = hex_to_pixel(layout, h)
'create + fill array with 6 conners positions
Dim As pt_dbl corner(0 To 5)
For i As Integer = 0 To 5 'loop 6 corners (clockwise)
Dim As pt_dbl offset = hex_corner_offset(layout, i)
corner(i) = Type(center.x + offset.x, center.y + offset.y)
Next
Select Case layout.orientation.start_angle
Case 0.0 'flat top
Line(corner(4).x, corner(4).y)-(corner(1).x, corner(1).y), c_fill, bf
draw_triangle_filled(corner(0), corner(1), corner(5), c_fill)
draw_triangle_filled(corner(2), corner(3), corner(4), c_fill)
Case 0.5 'pointy top
Line(corner(3).x, corner(3).y)-(corner(0).x, corner(0).y), c_fill, bf
draw_triangle_filled(corner(0), corner(1), corner(2), c_fill)
draw_triangle_filled(corner(3), corner(4), corner(5), c_fill)
End Select
End Sub
Sub hex_draw_filled_border(layout As hex_layout, h As hex_axial, c_fill As ULong, c_border As ULong)
Dim As pt_dbl center = hex_to_pixel(layout, h)
'create + fill array with 6 conners positions
Dim As pt_dbl corner(0 To 5)
For i As Integer = 0 To 5 'loop 6 corners (clockwise)
Dim As pt_dbl offset = hex_corner_offset(layout, i)
corner(i) = Type(center.x + offset.x, center.y + offset.y)
Next
Select Case layout.orientation.start_angle
Case 0.0 'flat top
Line(corner(4).x, corner(4).y)-(corner(1).x, corner(1).y), c_fill, bf
draw_triangle_filled(corner(0), corner(1), corner(5), c_fill)
draw_triangle_filled(corner(2), corner(3), corner(4), c_fill)
Case 0.5 'pointy top
Line(corner(3).x, corner(3).y)-(corner(0).x, corner(0).y), c_fill, bf
draw_triangle_filled(corner(0), corner(1), corner(2), c_fill)
draw_triangle_filled(corner(3), corner(4), corner(5), c_fill)
End Select
hex_draw_outline(layout, h, c_border)
End Sub
#Define hex_draw_o hex_draw_outline
#Define hex_draw_f hex_draw_filled
#Define hex_draw_fb hex_draw_filled_border
'===============================================================================
#Define rnd_int_rng(a, b) Int(Rnd * (((b) - (a)) + 1)) + (a)
Const As String KEY_UP = Chr(255, 72)
Const As String KEY_DN = Chr(255, 80)
Const As String KEY_LE = Chr(255, 75)
Const As String KEY_RI = Chr(255, 77)
Const As String KEY_ESC = Chr(27)
Const As String KEY_SPC = Chr(32)
#Include "fbgfx.bi"
Const SW = 400, SH = 600
ScreenRes SW, SH, 32
Width SW \ 8, SH \ 16
Dim As hex_layout layout1 = _
Type(layout_flat, Type<pt_dbl>(17, 16.2), Type<pt_dbl>(SW \ 2, SH \ 2))
Const brd_rh = 10 'board height radius
Const brd_rw = 7 'board width radius
Const brd_psr = -9 'piece start row
Dim As ULong board(-brd_rh To +brd_rh, -brd_rh To +brd_rh)
Const piece_size = 4
Type piece_type
Dim As hex_axial abs_pos
Dim As hex_axial tile_pos(piece_size - 1) '0 to 3
'dim as hex_axial tile_rot 'tile to rotate around --> NOT NEEDED?
Dim As ULong c_fill
End Type
Const num_pieces = 9
Dim As piece_type piece(num_pieces-1) = {_ '(q, r)
Type((0, 0), {(0, -1), (0, 0), (0, 1), (0, 2)}, &hff007070),_
Type((0, 0), {(0, -1), (0, 0), (0, 1), (1, 1)}, &hff700070),_
Type((0, 0), {(0, -1), (0, 0), (0, 1), (-1, 0)}, &hff707000),_
Type((0, 0), {(0, -1), (0, 0), (0, 1), (1, -1)}, &hff700000),_
Type((0, 0), {(0, -1), (0, 0), (0, 1), (-1, 2)}, &hff007000),_
Type((0, 0), {(0, -1), (1, -1), (1, 0), (0, 1)}, &hff400070),_
Type((0, 0), {(0, -1), (1, -1), (1, 0), (0, 1)}, &hff704000),_
Type((0, 0), {(0, -1), (0, 0), (1, 0), (1, 1)}, &hff004070),_
Type((0, 0), {(0, -1), (0, 0), (-1, 1), (-1, 2)}, &hff507000)}
Function get_tile_pos(piece As piece_type, tile_idx As Integer) As hex_axial
Return hex_axial_add(piece.abs_pos, piece.tile_pos(tile_idx))
End Function
'valid board tile index?
Function valid_tile_pos(ha As hex_axial) As boolean
Dim As hex_cube hc = hex_axial_to_cube(ha)
Return (Abs(hc.x) <= brd_rw) And (Abs(hc.y) <= brd_rh) And (Abs(hc.z) <= brd_rh)
End Function
'all tiles valid board index & not occupied?
Function free_piece_pos(piece As piece_type, board() As ULong) As boolean
For iTile As Integer = 0 To piece_size - 1
Dim As hex_axial ha = get_tile_pos(piece, iTile)
If Not valid_tile_pos(ha) Then Return false
If board(ha.q, ha.r) <> 0 Then Return false
Next
Return true
End Function
'function is correct for all cases!
Function pos_off_screen(layout As hex_layout, ha As hex_axial) As boolean
Dim As pt_dbl pt = hex_to_pixel(layout, ha)
If pt.x + layout.size.x < 0 Then Return true 'left of screen
If pt.x - layout.size.x > SW Then Return true 'right of screen
If pt.y + layout.size.y < 0 Then Return true 'above screen
If pt.y - layout.size.y > SH Then Return true 'below screen
Return false
End Function
Sub draw_board(board() As ULong, layout As hex_layout)
Dim As hex_axial ha
For q As Integer = -(brd_rh-2) To +(brd_rh-2)
ha.q = q
For r As Integer = -(brd_rh+5) To +(brd_rh+5)
ha.r = r
If pos_off_screen(layout, ha) = false Then
If valid_tile_pos(ha) Then
If board(q, r) <> 0 Then
'piece tile, with bright edge
hex_draw_fb(layout, ha, board(q, r), board(q, r) ShL 1)
Else
'no piece tile on board
hex_draw_o(layout, ha, &hff404040)
End If
Else
'outside board
hex_draw_fb(layout, ha, &hff505050, &hff909090)
End If
End If
Next
Next
End Sub
Sub draw_piece(piece As piece_type, layout As hex_layout)
For iTile As Integer = 0 To piece_size - 1
Dim As ULong c_fill = piece.c_fill
Dim As ULong c_border = &hff000000 Or (c_fill ShL 1) 'double intensity
'dim as hex_axial ha = hex_axial_add(current_piece.tile_pos(iTile), current_piece.abs_pos)
Dim As hex_axial ha = get_tile_pos(piece, iTile)
hex_draw_filled_border(layout, ha, c_fill, c_border)
Next
End Sub
Sub rotate_piece(ByRef piece As piece_type, direction As Integer)
Dim pRotFunc As Sub (ByRef ha As hex_axial) 'subroutine pointer
pRotFunc = IIf(direction > 0, @hex_axial_rotate_right, @hex_axial_rotate_left)
For iTile As Integer = 0 To piece_size - 1
pRotFunc(piece.tile_pos(iTile))
Next
End Sub
Sub move_piece(ByRef piece As piece_type, direction As Integer)
piece.abs_pos = hex_axial_neighbor(piece.abs_pos, direction)
End Sub
'choose random piece and position at top of board
Function new_piece(piece() As piece_type) As piece_type
Dim As piece_type ret_piece = piece(Int(Rnd() * num_pieces))
ret_piece.abs_pos.r = brd_psr
Return ret_piece
End Function
Const As Double start_interval = 1.0 '1 tiles per second
Const As Double drop_interval = 0.05 '20 tiles per second
Dim As piece_type current_piece
Dim As Double t = Timer, t_step = start_interval, t_next = t + t_step
Dim As Integer enable_control = true
Dim As Integer quit = 0, request_new = true
Randomize Timer
While quit = 0
If request_new = true Then
current_piece = new_piece(piece())
request_new = false
End If
ScreenLock
Line(0, 0)-(SW-1, SH-1), 0, bf 'clear screen
draw_board(board(), layout1)
If free_piece_pos(current_piece, board()) Then
draw_piece(current_piece, layout1)
End If
Draw String (5, 0), "keys: up, down, left, right, space, escape"
ScreenUnLock
Dim As String key = InKey
If enable_control = true Then
Select Case key
Case KEY_ESC
quit = 1
Case KEY_LE
move_piece(current_piece, HEX_AX_LE_DN)
If Not free_piece_pos(current_piece, board()) Then
move_piece(current_piece, HEX_AX_RI_UP) 'undo move
End If
Case KEY_RI
move_piece(current_piece, HEX_AX_RI_DN)
If Not free_piece_pos(current_piece, board()) Then
move_piece(current_piece, HEX_AX_LE_UP) 'undo move
End If
Case KEY_UP
rotate_piece(current_piece, +1)
If Not free_piece_pos(current_piece, board()) Then
rotate_piece(current_piece, -1) 'undo move
End If
Case KEY_DN
rotate_piece(current_piece, -1)
If Not free_piece_pos(current_piece, board()) Then
rotate_piece(current_piece, +1) 'undo move
End If
Case KEY_SPC
enable_control = false
current_piece.abs_pos.r += 1
t_step = drop_interval
t_next = t + t_step
End Select
End If
If t > t_next Then
current_piece.abs_pos.r += 1
t_next = t + t_step
If Not free_piece_pos(current_piece, board()) Then
current_piece.abs_pos.r -= 1
'copy to board
For iTile As Integer = 0 To piece_size - 1
Dim As hex_axial ha = get_tile_pos(current_piece, iTile)
If valid_tile_pos(ha) Then 'redundant check
board(ha.q, ha.r) = current_piece.c_fill
End If
Next
request_new = true
enable_control = true
t_step = start_interval
t_next = t + t_step
End If
End If
Sleep 1
t = Timer
Wend
Locate 13, 13: Print "End, press any key to exit"
GetKey()
'steps:
'implement 'wall-kick'
'points / scoring: make lines, shift/drop board
'check cannot place piece on start pos: game over
'check line drop down/left and/or down right
'drop position preview (option)
'~ 'show all pieces
'~ for iPiece as integer = 0 to num_pieces-1
'~ current_piece = piece(iPiece)
'~ rotate_piece(current_piece, 1)
'~ current_piece.abs_pos.r = iPiece * 2 - 9
'~ current_piece.abs_pos.q = ((iPiece+1) mod 2) * 6 - 3
'~ draw_piece(current_piece, layout1)
'~ next
'~ getkey()
'~ end