QB64.org Forum

Active Forums => Programs => Topic started by: Richard Frost on July 12, 2021, 01:39:18 am

Title: Simple locking puzzle
Post by: Richard Frost on July 12, 2021, 01:39:18 am

Move the colored items off the screen, or flush with the white goalposts, by click & drag.
A demo of what can be done in less than a hundred lines. 

Code: QB64: [Select]

1. Dim b(21, 14)
2. For by = 1 To 20 '                                         initialize
3.     Read d$
4.     For bx = 1 To 13
5.         b(by, bx) = Val(Mid$(d$, bx, 1))
6.     Next bx
7. Next by
8. begin: '                                                   MAIN LOOP
9. Locate 2, 2: Print "Move "; moves; '                       display
10. For ty = 1 To 21
11.     For tx = 1 To 14
12.         Color b(ty, tx)
13.         Locate 2 + ty, 18 + tx * 3
14.         Print String$(3, 219);
15.     Next tx
16. Next ty
17. Color 7
18. x = 0: y = 0 '                                             get move
19. Do
20.     While _MouseInput: Wend
21.     sx = _MouseX: sy = _MouseY
22.     If (sx > 0) And (sx < 80) And (sy > 0) And (sy < 25) Then t = Screen(sy, sx, 1)
23.     If (t > 0) And (t < 5) Then p = t
24.     lft = _MouseButton(1)
25.     While lft
26.         While _MouseInput: Wend
27.         dx = _MouseX - sx: dy = _MouseY - sy
28.         If Abs(dx) > Abs(dy) Then x = (dx < 0) - (dx > 0)
29.         If Abs(dy) > Abs(dx) Then y = (dy < 0) - (dy > 0)
30.         If x Or y Then Exit Do
31.         While _MouseInput: Wend
32.         lft = _MouseButton(1)
33.     Wend
34. Loop Until (p > 0) And (x Or y)
35. For by = 1 To 21 '                                         check if move is valid
36.     For bx = 1 To 14
37.         If p = b(by, bx) Then
38.             tx = bx + x: ty = by + y
39.             If (tx > 0) And (ty > 0) And (tx < 14) And (ty < 21) Then
40.                 d = b(ty, tx)
41.                 If (d <> p) And (d <> 0) Then GoTo begin
42.             End If
43.         End If
44.     Next bx
45. Next by
46. moves = moves + 1 '                                        make the move
47. v1 = 1: v2 = 21: v3 = 1: v4 = 14: v5 = 1
48. If (x > 0) Or (y > 0) Then Swap v1, v2: Swap v3, v4: v5 = -v5
49. For by = v1 To v2 Step v5
50.     For bx = v3 To v4 Step v5
51.         If p = b(by, bx) Then
52.             tx = x + bx: ty = y + by
53.             If (tx > 0) And (ty > 0) And (tx < 14) And (ty < 21) Then b(y + by, x + bx) = p
54.             b(by, bx) = 0
55.         End If
56.     Next bx
57. Next by
58. For by = 8 To 17 '                                         check if done
59.     For bx = 30 To 50
60.         If Screen(by, bx, 1) Then GoTo begin
61.     Next bx
62. Next by
63. Data "     111     "
64. Data "      1      "
65. Data "      1      "
66. Data "      1      "
67. Data "  74  11117  "
68. Data "   4444441   "
69. Data "   4 222411  "
70. Data "   4  2441   "
71. Data "4  4  2  1   "
72. Data "44444 2111  2"
73. Data "4 434 2122222"
74. Data "  433 222   2"
75. Data "  4 3 233    "
76. Data "  4 3 223    "
77. Data "    33333    "
78. Data "  7    3  7  "
79. Data "       3     "
80. Data "       3     "
81. Data "       3     "
82. Data "      333    "

Title: Re: Simple locking puzzle
Post by: bplus on July 12, 2021, 06:05:24 am

:) Well thats almost as good as coffee for waking up (dont tell johnno56).

  [ This attachment cannot be displayed inline in 'Print Page' view ]  

Oh dang it counted moves, LOL, maybe better next time.

Thanks @Richard Frost

Title: Re: Simple locking puzzle
Post by: johnno56 on July 12, 2021, 08:48:21 am

"Almost as good as coffee?" Not even close.... Moo Ha Ha...

Text Only | Text with Attachments