QB64.org Forum

Active Forums => Programs => Topic started by: bplus on July 20, 2019, 09:15:27 pm

Title: Letter Memory
Post by: bplus on July 20, 2019, 09:15:27 pm

A simple little game to play until Ken gets his next thing going. :)

Code: QB64: [Select]

1. OPTION _EXPLICIT
2. DEFINT A-Z
3. RANDOMIZE TIMER
4. _TITLE "Letter Memory Remake" '  by bplus started 2019-06-09 mod structure of first game
5.  
6. ' Keep clicking boxes until all the letter pairs are revealed.
7.  
8. TYPE XYtype
9.     X AS INTEGER
10.     Y AS INTEGER
11. END TYPE
12.  
13. TYPE LetterBox
14.     XY AS XYtype
15.     Reveal AS INTEGER ' 0, -1 revealed when matched, stay revealed
16.     Letter AS STRING '  letter to match
17. END TYPE
18.  
19. CONST xmax = 400, ymax = 450, boxSize = 50, xoffLetter = (boxSize - 8) / 2, yoffLetter = (boxSize - 16) / 2 ' for letters in box
20. SCREEN _NEWIMAGE(xmax, ymax, 32)
21. _SCREENMOVE 360, 60
22. REDIM SHARED LB(1 TO 1) AS LetterBox, nBoxes 'so setup can set values to these globals
23. REDIM SHARED shuffle(1 TO 1) AS STRING 'container of letter pairs to shuffle and distrbute before each round
24. DIM SHARED nRevealed, b1Index, b2Index, tStart!, s$
25. DIM i
26. setUpGame
27. WHILE 1
28.     tStart! = TIMER(.001)
29.     initRound
30.     CLS
31.     updateScreen
32.     DO
33.         i = getBoxIndex
34.         IF i THEN
35.             IF b1Index = 0 THEN 'first reveal box
36.                 IF LB(i).Reveal <> -1 THEN b1Index = i: LB(i).Reveal = -1
37.             ELSE '2nd reveal box
38.                 IF LB(i).Reveal <> -1 THEN b2Index = i: LB(i).Reveal = -1
39.             END IF
40.             updateScreen
41.         END IF
42.         IF b2Index <> 0 THEN 'check match, if they do leave them revealed
43.             IF LB(b1Index).Letter <> LB(b2Index).Letter THEN 'no match
44.                 _DELAY 1
45.                 LB(b1Index).Reveal = 0: LB(b2Index).Reveal = 0
46.                 nRevealed = nRevealed - 2 'when complete = number of squares then done
47.                 updateScreen
48.             END IF
49.             b1Index = 0: b2Index = 0 'clear box clicks
50.         END IF
51.         _LIMIT 60
52.     LOOP UNTIL nRevealed = nBoxes
53.     COLOR &HFFDDDDDD, &HFF000000
54.     s$ = "Completed in" + STR$(INT(TIMER(.001) - tStart!)) + " secs."
55.     LOCATE 2, (xmax / 8 - LEN(s$)) / 2: PRINT s$
56.     _DELAY 2
57. WEND
58.  
59. FUNCTION getBoxIndex
60.     DIM m, mx, my, mb, i
61.     WHILE _MOUSEINPUT: WEND
62.     mb = _MOUSEBUTTON(1) '            left button down
63.     IF mb THEN '                      get last place mouse button was down
64.         WHILE mb '                    wait for mouse button release as a "click"
65.             m = _MOUSEINPUT: mb = _MOUSEBUTTON(1): mx = _MOUSEX: my = _MOUSEY
66.         WEND
67.         FOR i = 1 TO nBoxes '         now find which box was clicked
68.             IF mx > LB(i).XY.X AND mx < LB(i).XY.X + boxSize THEN
69.                 IF my > LB(i).XY.Y AND my < LB(i).XY.Y + boxSize THEN
70.                     getBoxIndex = i: EXIT FUNCTION
71.                 END IF
72.             END IF
73.         NEXT
74.     END IF
75. END FUNCTION
76.  
77. SUB updateScreen
78.     DIM i
79.     nRevealed = 0 '              (shared) detect how many boxes are revealed
80.     FOR i = 1 TO nBoxes
81.         LINE (LB(i).XY.X, LB(i).XY.Y)-STEP(boxSize, boxSize), &HFFFF0000, BF
82.         IF LB(i).Reveal = -1 THEN
83.             COLOR &HFFDDDDDD, &HFFFF0000
84.             _PRINTSTRING (LB(i).XY.X + xoffLetter, LB(i).XY.Y + yoffLetter), LB(i).Letter
85.             nRevealed = nRevealed + 1
86.         END IF
87.     NEXT
88. END SUB
89.  
90. SUB initRound 'reassign letters and hide them all
91.     DIM i, r
92.     FOR i = nBoxes TO 2 STEP -1 ' shuffle stuff in array
93.         r = INT(i * RND) + 1
94.         SWAP shuffle(i), shuffle(r)
95.     NEXT
96.     FOR i = 1 TO nBoxes '       reset or reassign values
97.         LB(i).Letter = shuffle(i): LB(i).Reveal = 0
98.     NEXT
99. END SUB
100.  
101. SUB setUpGame
102.     DIM i, x, y '(                main) CONST xmax = 400, ymax = 450, boxSize = 50
103.     CONST xBoxes = 6, yBoxes = 4 '           Board N x M  boxes across, boxes down
104.     nBoxes = xBoxes * yBoxes '               Total boxes (shared)
105.     REDIM LB(1 TO nBoxes) AS LetterBox '     ready to rec data (shared)
106.     'CONST boxSize = 50                '     Screen drawing topleft box locations
107.     CONST spacer = 5 '                       for XY calc
108.     CONST xoffset = INT((xmax - boxSize * xBoxes - spacer * (xBoxes - 1)) / 2)
109.     CONST yoffset = INT((ymax - boxSize * yBoxes - spacer * (yBoxes - 1)) / 2)
110.     CONST sq = boxSize + spacer '            for XY calc
111.     FOR y = 1 TO yBoxes '                    set screen XY locations for all boxes
112.         FOR x = 1 TO xBoxes
113.             i = i + 1
114.             LB(i).XY.X = xoffset + (x - 1) * sq
115.             LB(i).XY.Y = yoffset + (y - 1) * sq
116.         NEXT
117.     NEXT
118.     REDIM shuffle(1 TO nBoxes) AS STRING ' load shuffle array for shuffling later (shared)
119.     CONST letterPairs = "AABBCCDDEEFFGGHHIIJJKKLLMMNNOOPPQQRRSSTTUUVVWWXXYYZZ11223344556677889900"
120.     FOR i = 1 TO nBoxes
121.         shuffle(i) = MID$(letterPairs, i, 1)
122.     NEXT
123. END SUB
124.  

EDIT: updateScreen xoff, yoff made into xoffLetter, yoffLetter CONST's, as not efficient to recalc those for every update.

Title: Re: Letter Memory
Post by: SierraKen on July 20, 2019, 11:39:44 pm

Wow B+ nice game! Wouldn't help me that good though because my short term memory has been super bad since my head injury decades ago lol. I think I'm going to convert an old ASIC game called Alphabet Invaders to QB64. :)

Title: Re: Letter Memory
Post by: Ashish on July 21, 2019, 12:19:12 am

Cool game Bplus!

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

Title: Re: Letter Memory
Post by: johnno56 on July 21, 2019, 12:42:07 am

Nice game. Bit of a workout for My grey matter as well...

Does it come in blue?  lol

J

Title: Re: Letter Memory
Post by: bplus on July 21, 2019, 09:09:51 am

Thanks guys, should be easy to modify colors, add more buttons for letters and digit pairs...  I don't know about pointy ears though. ;-))

Well what do you know!?
 

Title: Re: Letter Memory
Post by: Pete on July 21, 2019, 12:12:55 pm

I'll stick with Republican Red!

Easy game...

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

Pete

Title: Re: Letter Memory
Post by: TempodiBasic on July 21, 2019, 01:09:38 pm

Cool Bplus!
I find it very fine so that I think to add a simple mod while the ideas are flourishing!

try it please!

Code: QB64: [Select]

1. OPTION _EXPLICIT
2. DEFINT A-Z
3. RANDOMIZE TIMER
4. _TITLE "Letter Memory Remake" '  by bplus started 2019-06-09 mod structure of first game
5.  
6. ' Keep clicking boxes until all the letter pairs are revealed.
7.  
8. TYPE XYtype
9.     X AS INTEGER
10.     Y AS INTEGER
11. END TYPE
12.  
13. TYPE LetterBox
14.     XY AS XYtype
15.     Reveal AS INTEGER ' 0, -1 revealed when matched, stay revealed
16.     Letter AS STRING '  letter to match
17. END TYPE
18.  
19. CONST xmax = 400, ymax = 450, boxSize = 50, xoffLetter = (boxSize - 8) / 2, yoffLetter = (boxSize - 16) / 2 ' for letters in box
20.  
21. CONST Topten = "TopTen.SAV", Bonus = 100 ' <---new line TDB
22. SCREEN _NEWIMAGE(xmax, ymax, 32)
23. _SCREENMOVE 360, 60
24. REDIM SHARED LB(1 TO 1) AS LetterBox, nBoxes 'so setup can set values to these globals
25. REDIM SHARED shuffle(1 TO 1) AS STRING 'container of letter pairs to shuffle and distrbute before each round
26. DIM SHARED nRevealed, b1Index, b2Index, tStart!, s$
27. DIM SHARED Score AS LONG ' <---new line TDB
28. DIM i
29. setUpGame
30.  
31. WHILE 1
32.     tStart! = TIMER(.001)
33.     initRound
34.     CLS
35.     updateScreen
36.     DO
37.         i = getBoxIndex
38.         IF i THEN
39.             IF b1Index = 0 THEN 'first reveal box
40.                 IF LB(i).Reveal <> -1 THEN b1Index = i: LB(i).Reveal = -1
41.             ELSE '2nd reveal box
42.                 IF LB(i).Reveal <> -1 THEN b2Index = i: LB(i).Reveal = -1
43.             END IF
44.             updateScreen
45.         END IF
46.         IF b2Index <> 0 THEN 'check match, if they do leave them revealed
47.             IF LB(b1Index).Letter <> LB(b2Index).Letter THEN 'no match
48.                 _DELAY 1
49.                 LB(b1Index).Reveal = 0: LB(b2Index).Reveal = 0
50.                 nRevealed = nRevealed - 2 'when complete = number of squares then done
51.                 updateScreen
52.  
53.                 Score = Score + Bonus
54.             END IF
55.             b1Index = 0: b2Index = 0 'clear box clicks
56.         END IF
57.         _LIMIT 60
58.     LOOP UNTIL nRevealed = nBoxes
59.     COLOR &HFFDDDDDD, &HFF000000
60.     ' qua calcola il tempo come punteggio aggiuntivo
61.     s$ = "Completed in" + STR$(INT(TIMER(.001) - tStart!)) + " secs."
62.     LOCATE 2, (xmax / 8 - LEN(s$)) / 2: PRINT s$
63.     _DELAY 2
64. WEND
65.  
66. FUNCTION getBoxIndex
67.     DIM m, mx, my, mb, i
68.     WHILE _MOUSEINPUT: WEND
69.     mb = _MOUSEBUTTON(1) '            left button down
70.     IF mb THEN '                      get last place mouse button was down
71.         WHILE mb '                    wait for mouse button release as a "click"
72.             m = _MOUSEINPUT: mb = _MOUSEBUTTON(1): mx = _MOUSEX: my = _MOUSEY
73.         WEND
74.         FOR i = 1 TO nBoxes '         now find which box was clicked
75.             IF mx > LB(i).XY.X AND mx < LB(i).XY.X + boxSize THEN
76.                 IF my > LB(i).XY.Y AND my < LB(i).XY.Y + boxSize THEN
77.                     getBoxIndex = i: EXIT FUNCTION
78.                 END IF
79.             END IF
80.         NEXT
81.         ' if no nBoxe clicked , user maybe clicks on menubar
82.         DIM done, High$ ' <---new lines TDB
83.         IF my < 16 THEN
84.             SELECT CASE mx
85.                 CASE 55 TO 85
86.                     ' END
87.                     COLOR , &HFF0000FF
88.                     _PRINTSTRING ((xmax - 60) / 2, 400), "QUIT?"
89.                     _PRINTSTRING ((xmax - 110) / 2, 430), "[YES]  [NO]"
90.                     done = 0
91.                     WHILE done = 0
92.                         done = LEN(INKEY$)
93.                         IF _MOUSEINPUT THEN
94.                             IF _MOUSEBUTTON(1) OR _MOUSEBUTTON(2) THEN done = 1
95.                             mx = _MOUSEX: my = _MOUSEY
96.                         END IF
97.                     WEND
98.                     IF my >= 430 AND my <= 450 THEN
99.                         IF mx <= 188 AND mx >= 130 THEN
100.                             ' yes  Quit
101.                             COLOR , &HFF000000
102.                             CLS
103.                             DIM NAMES AS STRING * 8
104.                             _PRINTSTRING ((xmax - 110) / 2, 380), "ENTER NAME"
105.                             INPUT NAMES
106.                             OPEN Topten FOR APPEND AS #1
107.                             PRINT #1, NAMES + STR$(Score)
108.                             CLOSE #1
109.                             'Topten
110.                             COLOR , &HFF000000
111.                             CLS
112.                             IF NOT _FILEEXISTS(Topten) THEN
113.                                 _PRINTSTRING ((xmax - 160) / 2, 100), "File " + Topten + " corrupted"
114.                             ELSE
115.                                 COLOR , &HFF0000FF
116.                                 LOCATE , 20: PRINT "HIGHSCORES"
117.                                 LOCATE , 20: PRINT " TOP TEN "
118.                                 PRINT: PRINT
119.                                 OPEN Topten FOR INPUT AS #1
120.                                 WHILE NOT EOF(1)
121.                                     INPUT #1, High$
122.                                     LOCATE , 15
123.                                     PRINT High$
124.                                     _DELAY .5
125.                                 WEND
126.                                 CLOSE #1
127.                             END IF
128.  
129.                             SLEEP 4
130.                             END
131.                         ELSE
132.                             COLOR , &HFF000000
133.                             CLS
134.                             updateScreen
135.                         END IF
136.                     END IF
137.  
138.                 CASE 110 TO 158
139.                     'pause
140.                     COLOR , &HFF0000FF
141.                     _PRINTSTRING ((xmax - 60) / 2, 400), "PAUSED"
142.                     done = 0
143.                     WHILE done = 0
144.                         done = LEN(INKEY$)
145.                         IF _MOUSEINPUT THEN
146.                             IF _MOUSEBUTTON(1) OR _MOUSEBUTTON(2) THEN done = 1
147.                         END IF
148.                     WEND
149.                     COLOR , &HFF000000
150.                     CLS
151.                     updateScreen
152.                 CASE 180 TO 238
153.                     'Topten
154.                     COLOR , &HFF000000
155.                     CLS
156.                     IF NOT _FILEEXISTS(Topten) THEN
157.                         _PRINTSTRING ((xmax - 160) / 2, 100), "File " + Topten + " corrupted"
158.                     ELSE
159.                         COLOR , &HFF0000FF
160.                         LOCATE , 20: PRINT "HIGHSCORES"
161.                         LOCATE , 20: PRINT " TOP TEN "
162.                         PRINT: PRINT
163.                         OPEN Topten FOR INPUT AS #1
164.                         WHILE NOT EOF(1)
165.                             INPUT #1, High$
166.                             LOCATE , 15
167.                             PRINT High$
168.                             _DELAY .5
169.                         WEND
170.                         CLOSE #1
171.                     END IF
172.                     done = 0
173.                     WHILE done = 0
174.                         done = LEN(INKEY$)
175.                         IF _MOUSEINPUT THEN
176.                             IF _MOUSEBUTTON(1) OR _MOUSEBUTTON(2) THEN done = 1
177.                         END IF
178.                     WEND
179.                     COLOR , &HFF000000
180.                     CLS
181.                     updateScreen
182.                 CASE 250 TO 294
183.                     ' Help
184.                     COLOR , &HFF000000
185.                     CLS
186.                     COLOR , &HFF0000FF
187.                     _PRINTSTRING ((xmax - 60) / 2, 100), "Help:"
188.                     _PRINTSTRING (5, 120), "-find the matched letters"
189.                     _PRINTSTRING (5, 140), "-more matches more scores"
190.                     _PRINTSTRING ((xmax - 60) / 2, 160), "Menu:"
191.                     _PRINTSTRING (5, 180), "END = quit, Pause = wait, Topten = HighScores"
192.                     _PRINTSTRING (5, 200), "Help = this screen"
193.                     done = 0
194.                     WHILE done = 0
195.                         done = LEN(INKEY$)
196.                         IF _MOUSEINPUT THEN
197.                             IF _MOUSEBUTTON(1) OR _MOUSEBUTTON(2) THEN done = 1
198.                         END IF
199.                     WEND
200.                     COLOR , &HFF000000
201.                     CLS
202.                     updateScreen
203.                 CASE ELSE
204.             END SELECT
205.         END IF
206.     END IF
207. END FUNCTION
208.  
209. SUB updateScreen
210.     DIM i
211.     nRevealed = 0 '              (shared) detect how many boxes are revealed
212.     FOR i = 1 TO nBoxes
213.         LINE (LB(i).XY.X, LB(i).XY.Y)-STEP(boxSize, boxSize), &HFFFF0000, BF
214.         IF LB(i).Reveal = -1 THEN
215.             COLOR &HFFDDDDDD, &HFFFF0000
216.             _PRINTSTRING (LB(i).XY.X + xoffLetter, LB(i).XY.Y + yoffLetter), LB(i).Letter
217.             nRevealed = nRevealed + 1
218.         END IF
219.     NEXT
220.     '    qua il rigo guida menu
221.     LINE (1, 1)-(xmax, 15), &HFF0000FF, BF ' <---new lines TDB
222.     COLOR , &HFF0000FF
223.     _PRINTSTRING (50, 0), "[END]  [Pause]  [TopTen] [Help] " '55-85  110-158  180-238  250-294
224.     COLOR &HFFDDDDDD, &HFFFF0000
225.  
226. END SUB
227.  
228. SUB initRound 'reassign letters and hide them all
229.     DIM i, r
230.     FOR i = nBoxes TO 2 STEP -1 ' shuffle stuff in array
231.         r = INT(i * RND) + 1
232.         SWAP shuffle(i), shuffle(r)
233.     NEXT
234.     FOR i = 1 TO nBoxes '       reset or reassign values
235.         LB(i).Letter = shuffle(i): LB(i).Reveal = 0
236.     NEXT
237. END SUB
238.  
239. SUB setUpGame
240.     DIM i, x, y '(                main) CONST xmax = 400, ymax = 450, boxSize = 50
241.     CONST xBoxes = 6, yBoxes = 4 '           Board N x M  boxes across, boxes down
242.     nBoxes = xBoxes * yBoxes '               Total boxes (shared)
243.     REDIM LB(1 TO nBoxes) AS LetterBox '     ready to rec data (shared)
244.     'CONST boxSize = 50                '     Screen drawing topleft box locations
245.     CONST spacer = 5 '                       for XY calc
246.     CONST xoffset = INT((xmax - boxSize * xBoxes - spacer * (xBoxes - 1)) / 2)
247.     CONST yoffset = INT((ymax - boxSize * yBoxes - spacer * (yBoxes - 1)) / 2)
248.     CONST sq = boxSize + spacer '            for XY calc
249.     FOR y = 1 TO yBoxes '                    set screen XY locations for all boxes
250.         FOR x = 1 TO xBoxes
251.             i = i + 1
252.             LB(i).XY.X = xoffset + (x - 1) * sq
253.             LB(i).XY.Y = yoffset + (y - 1) * sq
254.         NEXT
255.     NEXT
256.     REDIM shuffle(1 TO nBoxes) AS STRING ' load shuffle array for shuffling later (shared)
257.     CONST letterPairs = "AABBCCDDEEFFGGHHIIJJKKLLMMNNOOPPQQRRSSTTUUVVWWXXYYZZ11223344556677889900"
258.     FOR i = 1 TO nBoxes
259.         shuffle(i) = MID$(letterPairs, i, 1)
260.     NEXT
261.  
262.     ' section score TopTen
263.     Score = 0 ' <---new lines TDB
264.     IF NOT _FILEEXISTS(Topten) THEN
265.         OPEN Topten FOR OUTPUT AS #1
266.         PRINT #1, " 1. SMcNeill... 100000"
267.         PRINT #1, " 1. Heitor..... 100000"
268.         PRINT #1, " 1. Bplus...... 100000"
269.         PRINT #1, " 1. Pete....... 100000"
270.         PRINT #1, " 1. Petr....... 100000"
271.         PRINT #1, " 1. Ashish..... 100000"
272.         PRINT #1, " 1. Rhosigma... 100000"
273.         PRINT #1, " 1. Qwerkey.... 100000"
274.         PRINT #1, " 1. _Vince..... 100000"
275.         PRINT #1, " 1. The Others. 100000"
276.         CLOSE #1
277.     END IF
278. END SUB
279.  

fine changing color of back of boxes! It can be another item of the menu!
:-)
Good Playing

@Pete
but do you  use C++ to hacking Bplus code?
O_O  you're Anonymous! https://www.repubblica.it/images/2011/07/18/184150799-e341c968-23d0-4422-ba68-97dc59b84b8a.jpg (https://www.repubblica.it/images/2011/07/18/184150799-e341c968-23d0-4422-ba68-97dc59b84b8a.jpg)
 https://images2.alphacoders.com/606/thumb-1920-606513.jpg (https://images2.alphacoders.com/606/thumb-1920-606513.jpg)

Title: Re: Letter Memory
Post by: johnno56 on July 21, 2019, 05:47:28 pm

bplus,

Not exactly the shade of blue I was expecting, but blue none the less... Cool...

Now... about the letters.... How is your ancient Samarian? lol

Title: Re: Letter Memory
Post by: bplus on July 21, 2019, 09:33:40 pm

TempodiBasic, that's quite a mod! longer than the original program that took some time!

I did have in mind a mod myself, not quite Sumarian... :)

Title: Re: Letter Memory
Post by: johnno56 on July 22, 2019, 08:54:14 am

Oh. What about Klingon? Vulcan will do in a pinch (no pun intended) but, if you settle for Romulan, your punishment will be to memorise all the Ferengi Laws of Acquisition...

Title: Re: Letter Memory
Post by: TempodiBasic on July 22, 2019, 12:21:31 pm

Quote

not quite Sumarian... :)

???
Please what do you mean with sumarian?
Sumerian http://www.ilsapere.org/wp-content/uploads/bfi_thumb/sumeri-1-33i7zodpx38ur4jhrymnsw.jpg (http://www.ilsapere.org/wp-content/uploads/bfi_thumb/sumeri-1-33i7zodpx38ur4jhrymnsw.jpg)
or somariano (dummy or donkey) http://2.bp.blogspot.com/-WnfOoV8iYpc/UycT2mfxmsI/AAAAAAAAAY4/ygQu51cLbUw/s1600/donkey-821x1024.jpg (http://2.bp.blogspot.com/-WnfOoV8iYpc/UycT2mfxmsI/AAAAAAAAAY4/ygQu51cLbUw/s1600/donkey-821x1024.jpg)
:D

If you like, you can short my mod and make it fine to you  building more SUB and Function at the place of write the same code anywhere, moreover you can use a k-ed position on X an Y for the menu items to click. And a record type to store Topten in file.
Just as you prefer.
;-)
Thanks to give a look.

Title: Re: Letter Memory
Post by: bplus on July 22, 2019, 12:40:50 pm

Sumarian, Samarian, there is a difference?

Apparently so: https://www.quora.com/Is-Sumerian-the-same-thing-as-Samaritan... wait that's Samaritans, sa-martians???  :D those we learned about from Bible (the good one) and Ancient Aliens program ;-))

Hi TempodiBasic,

The top ten list is great for games of competition, IMHO not so hot for this little app. For me, scores quickly go down with repetition of play because I start to confuse letters in position 1 or 2 games ago.

The code you started might be generalized so one could add it to any great games program along with a sort to put scores from high to low... wait was that already in there? Also I would score times to complete a board of n matches.

Title: Re: Letter Memory
Post by: TempodiBasic on July 22, 2019, 04:27:51 pm

about

Quote

Also I would score times to complete a board of n matches.

what weight do you think to give to the time used to complete a level?
do you like a formula as scoreTimeBonus = Premium/timePassed and/ or use scoreTimeBonus as multiplier of total score of the match (that is always the same)?

Title: Re: Letter Memory
Post by: bplus on July 22, 2019, 05:55:03 pm

I'm not interested in scoring this game.

Title: Re: Letter Memory
Post by: Petr on July 23, 2019, 03:15:24 am

Cool game, BPlus.   

and...

Nice hack, Pete :-D

Title: Re: Letter Memory
Post by: bplus on July 23, 2019, 02:01:59 pm

Here is a much more challenging Letter Memory Game.

The letters are paired off such that when one letter is revealed you must reveal the paired letter, it takes a little longer to process :)

Code: QB64: [Select]

1. OPTION _EXPLICIT
2. DEFINT A-Z
3. RANDOMIZE TIMER
4. _TITLE "Match Paired Letters Memory Game" '  by bplus started 2019-07-23
5. 'this is a variation of Letter Memory Game Remake (July 2019)
6.  
7. 'Listed in lines below the board are letters pairs to be matched.
8. 'Click 2 boxes to reveal potential match, if so the boxes remain revealed.
9. 'The object is to quickly get all the boxes revealed exposing full alphabet.
10.  
11. TYPE XYtype
12.     X AS INTEGER
13.     Y AS INTEGER
14. END TYPE
15.  
16. TYPE LetterBox
17.     XY AS XYtype
18.     Reveal AS INTEGER ' 0, -1 revealed when matched, stay revealed
19.     Letter AS STRING '  letter to match
20. END TYPE
21.  
22. CONST xmax = 800, ymax = 300, boxSize = 50 'screen stuff
23. CONST xoffLetter = (boxSize - 8) / 2, yoffLetter = (boxSize - 16) / 2 ' for letters in box
24. SCREEN _NEWIMAGE(xmax, ymax, 32)
25. _SCREENMOVE 360, 60
26. REDIM SHARED LB(1 TO 1) AS LetterBox, nBoxes 'so setup can set values to these globals
27. REDIM SHARED shuffle(1 TO 1) AS STRING 'container of letter pairs to shuffle and distrbute before each round
28. DIM SHARED nRevealed
29. DIM i, s$, b1Index, b2Index, tStart!, clickCnt
30. setUpGame
31. WHILE 1
32.     tStart! = TIMER(.001)
33.     initRound
34.     CLS
35.     updateScreen
36.     DO
37.         i = getBoxIndex
38.         IF i THEN 'reveals, click counts only count if they are revealing
39.             IF b1Index = 0 THEN 'first reveal box
40.                 IF LB(i).Reveal <> -1 THEN b1Index = i: LB(i).Reveal = -1: clickCnt = clickCnt + 1
41.             ELSE '2nd reveal box
42.                 IF LB(i).Reveal <> -1 THEN b2Index = i: LB(i).Reveal = -1: clickCnt = clickCnt + 1
43.             END IF
44.             updateScreen
45.         END IF
46.         IF b2Index <> 0 THEN 'check pair, if they are a matched pair leave them revealed
47.             IF ABS(ASC(LB(b1Index).Letter) - ASC(LB(b2Index).Letter)) <> 13 THEN 'no match
48.                 _DELAY 1
49.                 LB(b1Index).Reveal = 0: LB(b2Index).Reveal = 0
50.                 nRevealed = nRevealed - 2 'when complete = number of squares then done
51.                 updateScreen
52.             END IF
53.             b1Index = 0: b2Index = 0 'clear box clicks
54.         END IF
55.         _LIMIT 60
56.     LOOP UNTIL nRevealed = nBoxes
57.     COLOR &HFFDDDDDD, &HFF000000
58.     s$ = "Completed in" + STR$(INT(TIMER(.001) - tStart!)) + " secs and" + STR$(clickCnt) + " clicks."
59.     LOCATE 3, (xmax / 8 - LEN(s$)) / 2: PRINT s$
60.     _DELAY 7
61. WEND
62.  
63. FUNCTION getBoxIndex
64.     DIM m, mx, my, mb, i
65.     WHILE _MOUSEINPUT: WEND
66.     mb = _MOUSEBUTTON(1) '            left button down
67.     IF mb THEN '                      get last place mouse button was down
68.         WHILE mb '                    wait for mouse button release as a "click"
69.             m = _MOUSEINPUT: mb = _MOUSEBUTTON(1): mx = _MOUSEX: my = _MOUSEY
70.         WEND
71.         FOR i = 1 TO nBoxes '         now find which box was clicked
72.             IF mx > LB(i).XY.X AND mx < LB(i).XY.X + boxSize THEN
73.                 IF my > LB(i).XY.Y AND my < LB(i).XY.Y + boxSize THEN
74.                     getBoxIndex = i: EXIT FUNCTION
75.                 END IF
76.             END IF
77.         NEXT
78.     END IF
79. END FUNCTION
80.  
81. SUB updateScreen
82.     DIM i
83.     COLOR &HFFAAAAFF, &HFF000000
84.     LOCATE 15, 12: PRINT "Letter Pairs to Match:  A   B   C   D   E   F   G   H   I   J   K   L   M"
85.     LOCATE 16, 12: PRINT "                 with:  N   O   P   Q   R   S   T   U   V   W   X   Y   Z"
86.     nRevealed = 0 '              (shared) detect how many boxes are revealed
87.     FOR i = 1 TO nBoxes
88.         LINE (LB(i).XY.X, LB(i).XY.Y)-STEP(boxSize, boxSize), &HFFFF0000, BF
89.         IF LB(i).Reveal = -1 THEN
90.             COLOR &HFFDDDDDD, &HFFFF0000
91.             _PRINTSTRING (LB(i).XY.X + xoffLetter, LB(i).XY.Y + yoffLetter), LB(i).Letter
92.             nRevealed = nRevealed + 1
93.         END IF
94.     NEXT
95. END SUB
96.  
97. SUB initRound 'reassign letters and hide them all
98.     DIM i, r
99.     FOR i = nBoxes TO 2 STEP -1 ' shuffle stuff in array
100.         r = INT(i * RND) + 1
101.         SWAP shuffle(i), shuffle(r)
102.     NEXT
103.     FOR i = 1 TO nBoxes '       reset or reassign values
104.         LB(i).Letter = shuffle(i): LB(i).Reveal = 0
105.     NEXT
106. END SUB
107.  
108. SUB setUpGame
109.     DIM i, x, y '(                main) CONST xmax = 800, ymax = 300, boxSize = 50
110.     CONST xBoxes = 13, yBoxes = 2 '          Board N x M  boxes across, boxes down
111.     nBoxes = xBoxes * yBoxes '               Total boxes (shared)
112.     REDIM LB(1 TO nBoxes) AS LetterBox '     ready to rec data (shared)
113.     'CONST boxSize = 50                '     Screen drawing topleft box locations
114.     CONST spacer = 5 '                       for XY calc
115.     CONST xoffset = INT((xmax - boxSize * xBoxes - spacer * (xBoxes - 1)) / 2)
116.     CONST yoffset = INT((ymax - boxSize * yBoxes - spacer * (yBoxes - 1)) / 2)
117.     CONST sq = boxSize + spacer '            for XY calc
118.     FOR y = 1 TO yBoxes '                    set screen XY locations for all boxes
119.         FOR x = 1 TO xBoxes
120.             i = i + 1
121.             LB(i).XY.X = xoffset + (x - 1) * sq
122.             LB(i).XY.Y = yoffset + (y - 1) * sq
123.         NEXT
124.     NEXT
125.     REDIM shuffle(1 TO nBoxes) AS STRING ' load shuffle array for shuffling later (shared)
126.     CONST letters = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
127.     FOR i = 1 TO nBoxes
128.         shuffle(i) = MID$(letters, i, 1)
129.     NEXT
130. END SUB
131.  
132.  

Title: Re: Letter Memory
Post by: Petr on July 23, 2019, 02:29:24 pm

Cool idea, very good!

Title: Re: Letter Memory
Post by: TempodiBasic on July 23, 2019, 04:37:07 pm

yep it is a harder level of pair!
Cool!
I find more difficult also the couple of boxes and not the previouse square scheme.

Title: Re: Letter Memory
Post by: bplus on July 23, 2019, 05:44:52 pm

Well I am glad I am cooling you guys off this summer :D

Thanks!

Title: Re: Letter Memory
Post by: Ashish on July 24, 2019, 03:32:09 am

Good Job. I played this for half an hour but I never get less than 200 sec...

Title: Re: Letter Memory
Post by: bplus on July 24, 2019, 03:01:33 pm

Quote from: Ashish on July 24, 2019, 03:32:09 am

Good Job. I played this for half an hour but I never get less than 200 sec...

Hi Ashish,

Today I had my first below 200, it gets a little easier once you start to remember pairs automatically and mainly focus on remembering where letters are, trying not to waste time remembering the matching letter because you can look that up at bottom of screen.

Of course it doesn't hurt either to use the code to create and test Button tools for your toolbox.

Here I have the game rewritten with my first set of button tools:

Code: QB64: [Select]

1. OPTION _EXPLICIT
2. DEFINT A-Z
3. RANDOMIZE TIMER
4. _TITLE "Button Memory Game" '  by bplus started 2019-07-24
5. 'This is a generalization of "Match Paired Letters Memory Game" by bplus started 2019-07-23
6.  
7. ' The goal here is 2 Fold:
8. '   Broaden the Memory Game seires to more than letters,
9. '   And develop some potential button library procedures.
10. ' 1. Button Type
11. ' 2. Button Draw
12. ' 3. Buttons Layout  'setup a whole keypad of buttons, assuming base 1 for first index
13. ' 4. ButtonIndexClicked  'get the button index clicked, assuming base 1 for first index
14.  
15. '1. Button Type common to all buttons
16. TYPE ButtonType
17.     X AS INTEGER
18.     Y AS INTEGER
19.     W AS INTEGER
20.     H AS INTEGER
21.     FC AS _UNSIGNED LONG 'fore color is the color of anything printed
22.     BC AS _UNSIGNED LONG 'back color  is the color of button
23.     L AS STRING 'label
24.     IMG AS LONG 'image handle
25.     O AS INTEGER 'O stands for On or Off reveal string/img of button function or keep hidden
26. END TYPE
27.  
28. CONST xmax = 800, ymax = 300, boxSize = 50, sbc = &HFF005500, sfc = &HFFAAAADD 'screen stuff
29. CONST xoffLetter = (boxSize - 8) / 2, yoffLetter = (boxSize - 16) / 2 ' for letters in box
30. SCREEN _NEWIMAGE(xmax, ymax, 32)
31. _SCREENMOVE 360, 60
32. REDIM SHARED Btn(1 TO 1) AS ButtonType, nBtns 'so setup can set values to these globals
33. REDIM SHARED shuffle(1 TO 1) AS STRING 'container of letter pairs to shuffle and distrbute before each round
34. DIM SHARED nRevealed
35. DIM i, s$, b1Index, b2Index, tStart!, clickCnt
36.  
37. COLOR sfc, sbc: CLS
38. setUpGame
39. WHILE 1
40.     tStart! = TIMER(.001)
41.     initRound
42.     updateScreen
43.     DO
44.         i = ButtonIndexClicked
45.         IF i THEN 'reveals, click counts only count if they are revealing
46.             IF b1Index = 0 THEN 'first reveal box
47.                 IF Btn(i).O <> -1 THEN b1Index = i: Btn(i).O = -1: clickCnt = clickCnt + 1
48.             ELSE '2nd reveal box
49.                 IF Btn(i).O <> -1 THEN b2Index = i: Btn(i).O = -1: clickCnt = clickCnt + 1
50.             END IF
51.             updateScreen
52.         END IF
53.         IF b2Index <> 0 THEN 'check pair, if they are a matched pair leave them revealed
54.             IF ABS(ASC(Btn(b1Index).L) - ASC(Btn(b2Index).L)) <> 13 THEN 'no match
55.                 _DELAY 1
56.                 Btn(b1Index).O = 0: Btn(b2Index).O = 0
57.                 nRevealed = nRevealed - 2 'when complete = number of squares then done
58.                 updateScreen
59.             END IF
60.             b1Index = 0: b2Index = 0 'clear box clicks
61.         END IF
62.         _LIMIT 60
63.     LOOP UNTIL nRevealed = nBtns
64.     s$ = "Completed in" + STR$(INT(TIMER(.001) - tStart!)) + " secs and" + STR$(clickCnt) + " clicks."
65.     LOCATE 3, (xmax / 8 - LEN(s$)) / 2: PRINT s$
66.     _DELAY 7
67. WEND
68.  
69. SUB updateScreen
70.     DIM i
71.     LOCATE 15, 12: PRINT "Letter Pairs to Match:  A   B   C   D   E   F   G   H   I   J   K   L   M"
72.     LOCATE 16, 12: PRINT "                 with:  N   O   P   Q   R   S   T   U   V   W   X   Y   Z"
73.     nRevealed = 0 '              (shared) detect how many boxes are revealed
74.     FOR i = 1 TO nBtns
75.         DrawButton (i)
76.         IF Btn(i).O THEN nRevealed = nRevealed + 1
77.     NEXT
78. END SUB
79.  
80. SUB initRound 'reassign letters and hide them all
81.     DIM i, r
82.     FOR i = nBtns TO 2 STEP -1 ' shuffle stuff in array
83.         r = INT(i * RND) + 1
84.         SWAP shuffle(i), shuffle(r)
85.     NEXT
86.     FOR i = 1 TO nBtns '       reset or reassign values
87.         Btn(i).L = shuffle(i): Btn(i).O = 0
88.     NEXT
89. END SUB
90.  
91. SUB setUpGame
92.     DIM i '(main) CONST xmax = 800, ymax = 300, boxSize = 50
93.  
94.     CONST xBoxes = 13, yBoxes = 2 '          Board N x M  boxes across, boxes down
95.     'CONST boxSize = 10                '     Screen drawing topleft box locations
96.     CONST spacer = 10 '                       for XY calc
97.     LayoutButtons 0, 0, xmax, ymax, boxSize, boxSize, xBoxes, yBoxes, spacer, &HFFFFCCAA, &HFF000088
98.     REDIM shuffle(1 TO nBtns) AS STRING ' load shuffle array for shuffling later (shared)
99.     CONST letters = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
100.     FOR i = 1 TO nBtns
101.         shuffle(i) = MID$(letters, i, 1)
102.     NEXT
103. END SUB
104.  
105. '2. Button draw for the index of an array Btn() of ButtonType's, assuming standard default font
106. SUB DrawButton (index AS INTEGER)
107.     DIM dc AS _UNSIGNED LONG, dbc AS _UNSIGNED LONG, ox, oy, s$
108.     dc = _DEFAULTCOLOR: dbc = _BACKGROUNDCOLOR
109.     LINE (Btn(index).X, Btn(index).Y)-STEP(Btn(index).W, Btn(index).H), &HFF000000, BF
110.     LINE (Btn(index).X, Btn(index).Y)-STEP(Btn(index).W - 3, Btn(index).H - 3), &HFFFFFFFF, BF
111.     LINE (Btn(index).X + 1, Btn(index).Y + 1)-STEP(Btn(index).W - 3, Btn(index).H - 3), Btn(index).BC, BF
112.     IF Btn(index).O THEN
113.         IF 8 * LEN(Btn(index).L) > Btn(index).W - 4 THEN 'string is too long for button
114.             s$ = MID$(Btn(index).L, 1, INT((Btn(index).W - 4) / 8)) 'fit part of string into button
115.             ox = 2
116.         ELSE
117.             s$ = Btn(index).L: ox = (Btn(index).W - 8 * LEN(Btn(index).L)) \ 2
118.         END IF
119.         oy = (Btn(index).H - 16) \ 2
120.         COLOR &HFF000000, &H0
121.         _PRINTSTRING (Btn(index).X + ox - 1, Btn(index).Y + oy - 1), s$
122.         COLOR Btn(index).FC
123.         _PRINTSTRING (Btn(index).X + ox, Btn(index).Y + oy), s$
124.         COLOR dc, dbc
125.     END IF
126. END SUB
127.  
128. ' 3. Layout buttons
129. ' this sub will setup button locations for shared Btn() as ButtonType with first button index = 1
130. ' also shared is nBtns whic will set/reset here
131. SUB LayoutButtons (areaX AS INTEGER, areaY AS INTEGER, areaW AS INTEGER, areaH AS INTEGER, btnW, btnH,_
132.     BtnsAcross, BtnsDown, spacer, Fore as _unsigned long, Back as _unsigned long)
133.     DIM xoffset, yoffset, xx, yy, xSide, ySide, i
134.     nBtns = BtnsAcross * BtnsDown '               Total btns (shared) in main declares section
135.     REDIM Btn(1 TO nBtns) AS ButtonType '     ready to rec data (shared) in main declares section
136.     xoffset = INT((areaW - btnW * BtnsAcross - spacer * (BtnsAcross - 1)) / 2) + areaX
137.     yoffset = INT((areaH - btnH * BtnsDown - spacer * (BtnsDown - 1)) / 2) + areaY
138.     xSide = btnW + spacer: ySide = btnH + spacer
139.     FOR yy = 1 TO BtnsDown '                    set screen XY locations for all boxes
140.         FOR xx = 1 TO BtnsAcross
141.             i = i + 1
142.             Btn(i).X = xoffset + (xx - 1) * xSide
143.             Btn(i).Y = yoffset + (yy - 1) * ySide
144.             Btn(i).W = btnW
145.             Btn(i).H = btnH
146.             Btn(i).FC = Fore
147.             Btn(i).BC = Back
148.         NEXT
149.     NEXT
150. END SUB
151.  
152. '4. Button Index Clicked
153. FUNCTION ButtonIndexClicked
154.     DIM m, mx, my, mb, i
155.     WHILE _MOUSEINPUT: WEND
156.     mb = _MOUSEBUTTON(1) '            left button down
157.     IF mb THEN '                      get last place mouse button was down
158.         WHILE mb '                    wait for mouse button release as a "click"
159.             m = _MOUSEINPUT: mb = _MOUSEBUTTON(1): mx = _MOUSEX: my = _MOUSEY
160.         WEND
161.         FOR i = 1 TO nBtns '         now find which box was clicked
162.             IF mx > Btn(i).X AND mx < Btn(i).X + Btn(i).W THEN
163.                 IF my > Btn(i).Y AND my < Btn(i).Y + Btn(i).H THEN
164.                     ButtonIndexClicked = i: EXIT FUNCTION
165.                 END IF
166.             END IF
167.         NEXT
168.     END IF
169. END FUNCTION
170.  

I really like how easy it is to get the button that was clicked with this code. I also have button layout almost completely automatic on AI with this new set. As you can see I plan to include images for buttons.

Title: Re: Letter Memory
Post by: bplus on July 24, 2019, 07:22:23 pm

Relatively easy to modify for a Word Matching Game. Here I used QB64 Keywords, symbols and other associated with Basic for 5 X 6 board of matches to make.

Because the matches make more sense, the game plays faster <200 secs for more pairs:

Code: QB64: [Select]

1. OPTION _EXPLICIT
2. DEFINT A-Z
3. RANDOMIZE TIMER
4. _TITLE "Word Memory Game" '  by bplus started 2019-07-24
5. 'This is to extend Memory Series to words and test further Button tools.
6. 'Along with testing button tools there is an experiment here to see if 2 word pairs that make sense
7. 'are easier to remember than match A with N and Z with M..., rather arbitrary pairings we did in last game.
8.  
9. REM +inder: Button Memory Game
10. ' The goal here is 2 Fold:
11. '   Broaden the Memory Game series to more than letters,
12. '   And develop some potential button library procedures.
13. ' 1. Button Type
14. ' 2. Button Draw
15. ' 3. Buttons Layout  'setup a whole keypad of buttons, assuming base 1 for first index
16. ' 4. ButtonIndexClicked  'get the button index clicked, assuming base 1 for first index
17.  
18. ' ============== Instructions: ========================================================
19. 'This game uses QB64 keywords or symbols that have complementary word or symbol.
20. 'Some are obvious no brainers like WHILE is paired with WEND, ( with ) and IF with THEN.
21. 'Some might might not occur to you, eg I have DIM and AS matched up, see data statements below.
22.  
23.  
24. '1. Button Type common to all buttons
25. TYPE ButtonType
26.     X AS INTEGER
27.     Y AS INTEGER
28.     W AS INTEGER
29.     H AS INTEGER
30.     FC AS _UNSIGNED LONG 'fore color is the color of anything printed
31.     BC AS _UNSIGNED LONG 'back color  is the color of button
32.     L AS STRING 'label
33.     IMG AS LONG 'image handle
34.     O AS INTEGER 'O stands for On or Off reveal string/img of button function or keep hidden
35. END TYPE
36.  
37. CONST xmax = 800, ymax = 500, sbc = &HFF005500, sfc = &HFFAAAADD 'screen stuff
38. SCREEN _NEWIMAGE(xmax, ymax, 32)
39. _SCREENMOVE 360, 60
40. REDIM SHARED Btn(1 TO 1) AS ButtonType, nBtns 'so setup can set values to these globals
41. REDIM SHARED shuffle(1 TO 1) AS STRING 'container of strings from data
42. DIM SHARED nRevealed
43. DIM i, s$, b1Index, b2Index, tStart!, clickCnt
44.  
45. COLOR sfc, sbc: CLS
46. setUpGame
47. WHILE 1
48.     tStart! = TIMER(.001)
49.     initRound
50.     updateScreen
51.     DO
52.         i = ButtonIndexClicked
53.         IF i THEN 'reveals, click counts only count if they are revealing
54.             IF b1Index = 0 THEN 'first reveal box
55.                 IF Btn(i).O <> -1 THEN b1Index = i: Btn(i).O = -1: clickCnt = clickCnt + 1
56.             ELSE '2nd reveal box
57.                 IF Btn(i).O <> -1 THEN b2Index = i: Btn(i).O = -1: clickCnt = clickCnt + 1
58.             END IF
59.             updateScreen
60.         END IF
61.         IF b2Index <> 0 THEN 'check pair, if they are a matched pair leave them revealed
62.             IF Match(Btn(b1Index).L, Btn(b2Index).L) = 0 THEN 'no match
63.                 _DELAY 1
64.                 Btn(b1Index).O = 0: Btn(b2Index).O = 0
65.                 nRevealed = nRevealed - 2 'when complete = number of squares then done
66.                 updateScreen
67.             END IF
68.             b1Index = 0: b2Index = 0 'clear box clicks
69.         END IF
70.         _LIMIT 60
71.     LOOP UNTIL nRevealed = nBtns
72.     s$ = "Completed in" + STR$(INT(TIMER(.001) - tStart!)) + " secs and" + STR$(clickCnt) + " clicks."
73.     LOCATE 3, (xmax / 8 - LEN(s$)) / 2: PRINT s$
74.     _DELAY 7
75. WEND
76.  
77. matchData:
78. DATA "IF THEN","DO LOOP","WHILE WEND","( )","SUB FUNCTION","SELECT CASE","OPTION _EXPLICIT","FOR NEXT"
79. DATA "INPUT OUTPUT","X Y","LEFT$ RIGHT$","DIM AS","HELLO WORLD","CSRLIN POS","SIN COS"
80.  
81. FUNCTION Match (s1$, s2$)
82.     DIM i, pair$
83.     RESTORE matchData
84.     FOR i = 1 TO 15
85.         READ pair$:
86.         IF leftOf$(pair$, " ") = s1$ THEN
87.             IF rightOf$(pair$, " ") = s2$ THEN Match = -1: EXIT FUNCTION
88.         ELSE
89.             IF leftOf$(pair$, " ") = s2$ THEN
90.                 IF rightOf$(pair$, " ") = s1$ THEN Match = -1: EXIT FUNCTION
91.             END IF
92.         END IF
93.     NEXT
94. END FUNCTION
95.  
96. SUB updateScreen
97.     DIM i
98.     CLS: nRevealed = 0 '              (shared) detect how many boxes are revealed
99.     FOR i = 1 TO nBtns
100.         DrawButton (i)
101.         IF Btn(i).O THEN nRevealed = nRevealed + 1
102.     NEXT
103. END SUB
104.  
105. SUB initRound 'reassign letters and hide them all
106.     DIM i, r
107.     FOR i = nBtns TO 2 STEP -1 ' shuffle stuff in array
108.         r = INT(i * RND) + 1
109.         SWAP shuffle(i), shuffle(r)
110.     NEXT
111.     FOR i = 1 TO nBtns '       reset or reassign values
112.         Btn(i).L = shuffle(i): Btn(i).O = 0
113.     NEXT
114. END SUB
115.  
116. SUB setUpGame
117.     DIM i, pair$ '(main) CONST xmax = 800, ymax = 300, boxSize = 50
118.     CONST xBtns = 5, yBtns = 6 ' Board N x M  across, down
119.     CONST spacer = 10 ' space between buttons VVVV sets SHARED nBtns needed in lines after call
120.     LayoutButtons 0, 0, xmax, ymax, 100, 50, xBtns, yBtns, spacer, &HFFAAAAFF, &HFF000088
121.     REDIM shuffle(1 TO nBtns) AS STRING ' load shuffle array for shuffling later (SHARED)
122.     FOR i = 1 TO nBtns STEP 2 'load shuffle with words/symbol pairs
123.         READ pair$
124.         shuffle(i) = leftOf$(pair$, " "): shuffle(i + 1) = rightOf$(pair$, " ")
125.     NEXT
126. END SUB
127.  
128. '2. Button draw for the index of an array Btn() of ButtonType's, assuming standard default font
129. SUB DrawButton (index AS INTEGER)
130.     DIM dc AS _UNSIGNED LONG, dbc AS _UNSIGNED LONG, ox, oy, s$
131.     dc = _DEFAULTCOLOR: dbc = _BACKGROUNDCOLOR
132.     LINE (Btn(index).X, Btn(index).Y)-STEP(Btn(index).W, Btn(index).H), &HFF000000, BF
133.     LINE (Btn(index).X, Btn(index).Y)-STEP(Btn(index).W - 3, Btn(index).H - 3), &HFFFFFFFF, BF
134.     LINE (Btn(index).X + 1, Btn(index).Y + 1)-STEP(Btn(index).W - 3, Btn(index).H - 3), Btn(index).BC, BF
135.     IF Btn(index).O THEN
136.         IF 8 * LEN(Btn(index).L) > Btn(index).W - 4 THEN 'string is too long for button
137.             s$ = MID$(Btn(index).L, 1, INT((Btn(index).W - 4) / 8)) 'fit part of string into button
138.             ox = 2
139.         ELSE
140.             s$ = Btn(index).L: ox = (Btn(index).W - 8 * LEN(Btn(index).L)) \ 2
141.         END IF
142.         oy = (Btn(index).H - 16) \ 2
143.         COLOR &HFF000000, &H0
144.         _PRINTSTRING (Btn(index).X + ox - 1, Btn(index).Y + oy - 1), s$
145.         COLOR Btn(index).FC
146.         _PRINTSTRING (Btn(index).X + ox, Btn(index).Y + oy), s$
147.         COLOR dc, dbc
148.     END IF
149. END SUB
150.  
151. ' 3. Layout buttons
152. ' this sub will setup button locations for shared Btn() as ButtonType with first button index = 1
153. ' also shared is nBtns whic will set/reset here
154. SUB LayoutButtons (areaX AS INTEGER, areaY AS INTEGER, areaW AS INTEGER, areaH AS INTEGER, btnW, btnH,_
155.     BtnsAcross, BtnsDown, spacer, Fore AS _UNSIGNED LONG, Back AS _UNSIGNED LONG)
156.     DIM xoffset, yoffset, xx, yy, xSide, ySide, i
157.     nBtns = BtnsAcross * BtnsDown '               Total btns (shared) in main declares section
158.     REDIM Btn(1 TO nBtns) AS ButtonType '     ready to rec data (shared) in main declares section
159.     xoffset = INT((areaW - btnW * BtnsAcross - spacer * (BtnsAcross - 1)) / 2) + areaX
160.     yoffset = INT((areaH - btnH * BtnsDown - spacer * (BtnsDown - 1)) / 2) + areaY
161.     xSide = btnW + spacer: ySide = btnH + spacer
162.     FOR yy = 1 TO BtnsDown '                    set screen XY locations for all boxes
163.         FOR xx = 1 TO BtnsAcross
164.             i = i + 1
165.             Btn(i).X = xoffset + (xx - 1) * xSide
166.             Btn(i).Y = yoffset + (yy - 1) * ySide
167.             Btn(i).W = btnW
168.             Btn(i).H = btnH
169.             Btn(i).FC = Fore
170.             Btn(i).BC = Back
171.         NEXT
172.     NEXT
173. END SUB
174.  
175. '4. Button Index Clicked
176. FUNCTION ButtonIndexClicked
177.     DIM m, mx, my, mb, i
178.     WHILE _MOUSEINPUT: WEND
179.     mb = _MOUSEBUTTON(1) '            left button down
180.     IF mb THEN '                      get last place mouse button was down
181.         WHILE mb '                    wait for mouse button release as a "click"
182.             m = _MOUSEINPUT: mb = _MOUSEBUTTON(1): mx = _MOUSEX: my = _MOUSEY
183.         WEND
184.         FOR i = 1 TO nBtns '         now find which box was clicked
185.             IF mx > Btn(i).X AND mx < Btn(i).X + Btn(i).W THEN
186.                 IF my > Btn(i).Y AND my < Btn(i).Y + Btn(i).H THEN
187.                     ButtonIndexClicked = i: EXIT FUNCTION
188.                 END IF
189.             END IF
190.         NEXT
191.     END IF
192. END FUNCTION
193.  
194. 'old tools from toolbox
195. FUNCTION leftOf$ (source$, of$)
196.     IF INSTR(source$, of$) > 0 THEN leftOf$ = MID$(source$, 1, INSTR(source$, of$) - 1)
197. END FUNCTION
198.  
199. FUNCTION rightOf$ (source$, of$)
200.     IF INSTR(source$, of$) > 0 THEN rightOf$ = MID$(source$, INSTR(source$, of$) + LEN(of$))
201. END FUNCTION
202.  
203.  

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

Title: Re: Letter Memory
Post by: bplus on July 24, 2019, 10:26:40 pm

And now Johnno some Akkadian images, Akkadian replaced Sumerian writing with a more uniform and abstract cuneiform.

This is a simple match up of images but Akkadian makes it fun because they all sort of look the same, at first :-))

Code: QB64: [Select]

1. OPTION _EXPLICIT
2. DEFINT A-Z
3. RANDOMIZE TIMER
4. _TITLE "Image Memory Game" '  by bplus started 2019-07-24
5. 'This is to extend Memory Series to images and test further Button tools.
6.  
7. ' A VERY BIG THANKS to Steve McNeill !
8. ' for sharing code to save an image section to a .png file.
9. ' I was working from a sheet of 40 figures that would not
10. ' align to any one center and rectangle size. I ended up having to
11. ' take snapshots of the sections to load the images file by file.
12.  
13. REM +inder: Button Memory Game
14. ' The goal here is 2 Fold:
15. '   Broaden the Memory Game series to more than letters,
16. '   And develop some potential button library procedures.
17. ' 1. Button Type
18. ' 2. Button Draw
19. ' 3. Buttons Layout  'setup a whole keypad of buttons, assuming base 1 for first index
20. ' 4. ButtonIndexClicked  'get the button index clicked, assuming base 1 for first index
21.  
22. ' ============== Instructions: ========================================================
23. ' This game uses images from the Akkadian language. Just keep clicking to match up the
24. ' images until all the buttons have been exposed.
25.  
26. '1. Button Type common to all buttons
27. TYPE ButtonType
28.     X AS INTEGER
29.     Y AS INTEGER
30.     W AS INTEGER
31.     H AS INTEGER
32.     FC AS _UNSIGNED LONG 'fore color is the color of anything printed
33.     BC AS _UNSIGNED LONG 'back color  is the color of button
34.     L AS STRING 'label
35.     IMG AS LONG 'image handle
36.     O AS INTEGER 'O stands for On or Off reveal string/img of button function or keep hidden
37. END TYPE
38.  
39. CONST xmax = 800, ymax = 600, sbc = &HFF005500, sfc = &HFFAAAADD 'screen stuff
40. SCREEN _NEWIMAGE(xmax, ymax, 32)
41. _SCREENMOVE 360, 60
42. REDIM SHARED Btn(1 TO 1) AS ButtonType, nBtns 'so setup can set values to these globals
43. REDIM SHARED shuffle(1 TO 1) AS LONG 'container of strings from data
44. DIM SHARED nRevealed
45. DIM i, s$, b1Index, b2Index, tStart!, clickCnt
46.  
47. COLOR sfc, sbc: CLS
48. setUpGame
49. WHILE 1
50.     tStart! = TIMER(.001)
51.     initRound
52.     updateScreen
53.     DO
54.         i = ButtonIndexClicked
55.         IF i THEN 'reveals, click counts only count if they are revealing
56.             IF b1Index = 0 THEN 'first reveal box
57.                 IF Btn(i).O <> -1 THEN b1Index = i: Btn(i).O = -1: clickCnt = clickCnt + 1
58.             ELSE '2nd reveal box
59.                 IF Btn(i).O <> -1 THEN b2Index = i: Btn(i).O = -1: clickCnt = clickCnt + 1
60.             END IF
61.             updateScreen
62.         END IF
63.         IF b2Index <> 0 THEN 'check pair, if they are a matched pair leave them revealed
64.             IF Btn(b1Index).IMG <> Btn(b2Index).IMG THEN 'no match
65.                 _DELAY 1
66.                 Btn(b1Index).O = 0: Btn(b2Index).O = 0
67.                 nRevealed = nRevealed - 2 'when complete = number of squares then done
68.                 updateScreen
69.             END IF
70.             b1Index = 0: b2Index = 0 'clear box clicks
71.         END IF
72.         _LIMIT 60
73.     LOOP UNTIL nRevealed = nBtns
74.     s$ = "Completed in" + STR$(INT(TIMER(.001) - tStart!)) + " secs and" + STR$(clickCnt) + " clicks."
75.     LOCATE 3, (xmax / 8 - LEN(s$)) / 2: PRINT s$
76.     _DELAY 10
77. WEND
78.  
79. SUB updateScreen
80.     DIM i
81.     CLS: nRevealed = 0 '              (shared) detect how many boxes are revealed
82.     FOR i = 1 TO nBtns
83.         DrawButton (i)
84.         IF Btn(i).O THEN nRevealed = nRevealed + 1
85.     NEXT
86. END SUB
87.  
88. SUB initRound 'reassign letters and hide them all
89.     DIM i, r
90.     FOR i = nBtns TO 2 STEP -1 ' shuffle stuff in array
91.         r = INT(i * RND) + 1
92.         SWAP shuffle(i), shuffle(r)
93.     NEXT
94.     FOR i = 1 TO nBtns '       reset or reassign values
95.         Btn(i).IMG = shuffle(i): Btn(i).O = 0
96.     NEXT
97. END SUB
98.  
99. SUB setUpGame
100.     DIM i, ak& '(main) CONST xmax = 800, ymax = 600
101.     CONST xBtns = 6, yBtns = 4 ' Board N x M  across, down
102.     CONST spacer = 10 ' space between buttons VVVV sets SHARED nBtns needed in lines after call
103.     LayoutButtons 0, 0, xmax, ymax, 100, 70, xBtns, yBtns, spacer, &HFFAAAAFF, &HFFFF8844
104.     REDIM shuffle(1 TO nBtns) AS LONG ' load shuffle array for shuffling later (SHARED)
105.     FOR i = 1 TO nBtns STEP 2 'load shuffle with words/symbol pairs
106.         ak& = _LOADIMAGE("akk" + _TRIM$(STR$((i + 1) / 2)) + ".png")
107.         IF ak& >= -1 THEN 'failed to get image(s)
108.             CLS
109.             PRINT "Failed to load image * akk" + _TRIM$(STR$((i + 1) / 2)) + ".png *, Sorry Goodbye!"
110.             _DISPLAY
111.             _DELAY 7
112.             SYSTEM
113.         END IF
114.         shuffle(i) = ak&
115.         shuffle(i + 1) = ak&
116.     NEXT
117. END SUB
118.  
119. '2. Button draw for the index of an array Btn() of ButtonType's, assuming standard default font
120. SUB DrawButton (index AS INTEGER)
121.     DIM dc AS _UNSIGNED LONG, dbc AS _UNSIGNED LONG, ox, oy, s$
122.     dc = _DEFAULTCOLOR: dbc = _BACKGROUNDCOLOR
123.     LINE (Btn(index).X, Btn(index).Y)-STEP(Btn(index).W, Btn(index).H), &HFF000000, BF
124.     LINE (Btn(index).X, Btn(index).Y)-STEP(Btn(index).W - 3, Btn(index).H - 3), &HFFFFFFFF, BF
125.     LINE (Btn(index).X + 1, Btn(index).Y + 1)-STEP(Btn(index).W - 3, Btn(index).H - 3), Btn(index).BC, BF
126.     IF Btn(index).O THEN
127.         IF Btn(index).IMG THEN
128.             _PUTIMAGE (Btn(index).X + 8, Btn(index).Y + 8)-STEP(Btn(index).W - 17, Btn(index).H - 17), Btn(index).IMG, 0
129.         END IF
130.         IF 8 * LEN(Btn(index).L) > Btn(index).W - 4 THEN 'string is too long for button
131.             s$ = MID$(Btn(index).L, 1, INT((Btn(index).W - 4) / 8)) 'fit part of string into button
132.             ox = 2
133.         ELSE
134.             s$ = Btn(index).L: ox = (Btn(index).W - 8 * LEN(Btn(index).L)) \ 2
135.         END IF
136.         oy = (Btn(index).H - 16) \ 2
137.         COLOR &HFF000000, &H0
138.         _PRINTSTRING (Btn(index).X + ox - 1, Btn(index).Y + oy - 1), s$
139.         COLOR Btn(index).FC
140.         _PRINTSTRING (Btn(index).X + ox, Btn(index).Y + oy), s$
141.         COLOR dc, dbc
142.     END IF
143. END SUB
144.  
145. ' 3. Layout buttons
146. ' this sub will setup button locations for shared Btn() as ButtonType with first button index = 1
147. ' also shared is nBtns whic will set/reset here
148. SUB LayoutButtons (areaX AS INTEGER, areaY AS INTEGER, areaW AS INTEGER, areaH AS INTEGER, btnW, btnH,_
149.     BtnsAcross, BtnsDown, spacer, Fore AS _UNSIGNED LONG, Back AS _UNSIGNED LONG)
150.     DIM xoffset, yoffset, xx, yy, xSide, ySide, i
151.     nBtns = BtnsAcross * BtnsDown '               Total btns (shared) in main declares section
152.     REDIM Btn(1 TO nBtns) AS ButtonType '     ready to rec data (shared) in main declares section
153.     xoffset = INT((areaW - btnW * BtnsAcross - spacer * (BtnsAcross - 1)) / 2) + areaX
154.     yoffset = INT((areaH - btnH * BtnsDown - spacer * (BtnsDown - 1)) / 2) + areaY
155.     xSide = btnW + spacer: ySide = btnH + spacer
156.     FOR yy = 1 TO BtnsDown '                    set screen XY locations for all boxes
157.         FOR xx = 1 TO BtnsAcross
158.             i = i + 1
159.             Btn(i).X = xoffset + (xx - 1) * xSide
160.             Btn(i).Y = yoffset + (yy - 1) * ySide
161.             Btn(i).W = btnW
162.             Btn(i).H = btnH
163.             Btn(i).FC = Fore
164.             Btn(i).BC = Back
165.         NEXT
166.     NEXT
167. END SUB
168.  
169. '4. Button Index Clicked
170. FUNCTION ButtonIndexClicked
171.     DIM m, mx, my, mb, i
172.     WHILE _MOUSEINPUT: WEND
173.     mb = _MOUSEBUTTON(1) '            left button down
174.     IF mb THEN '                      get last place mouse button was down
175.         WHILE mb '                    wait for mouse button release as a "click"
176.             m = _MOUSEINPUT: mb = _MOUSEBUTTON(1): mx = _MOUSEX: my = _MOUSEY
177.         WEND
178.         FOR i = 1 TO nBtns '         now find which box was clicked
179.             IF mx > Btn(i).X AND mx < Btn(i).X + Btn(i).W THEN
180.                 IF my > Btn(i).Y AND my < Btn(i).Y + Btn(i).H THEN
181.                     ButtonIndexClicked = i: EXIT FUNCTION
182.                 END IF
183.             END IF
184.         NEXT
185.     END IF
186. END FUNCTION
187.  

 

oops! I just noticed something in screen shot. :(

EDIT: yeah the images needed frames, so they still looked like buttons too.

 

Text Only | Text with Attachments