Steve's Xmas Game 2021

[Dav]

Steve, great Christmas program.  Relaxing, and has a good vibe.  Even my wife was curious how to use it, and she is usually anti-programming on me. (I'd insert a funny smiley here but I haven't figured out how yet).  Nice classic song choice too, I've been getting requests for that on dining room gigs at retirement communities already.  I like the old timey wallpaper collection too.   Anyway, well done.  Runs well for me.  Gets me in the mood for Christmas.

- Dav

[SMcNeill]

Version 0.4 is now up: https://1drv.ms/u/s!AknUrv8RXVYMm_QQ3W8KOf27i39tTA?e=jphyRd

Changes include:

A wider selection of music to play in the background, for anyone who stays in the program long enough to notice.  (The first song is always the same, but after that there's an assortment of music which it can play for you, which shuffles itself each runtime.)

falcon.h has been modified so that the path is no longer an issue, and it has been included into the main download folder itself now.  For most folks, this means you can just download the 7z, extract it, and compile the Xmas.bas file if you want and have it work, without having to make certain that anything is in the proper place or not.  It helps simplify the build process for us.

For Windows users, I went ahead and kept the compiled Xmas.EXE in the package for you guys.  It adds a little extra to the download size, but at this point I don't care about that.  Our resource files are much larger than any EXE would ever be, and it just makes things convenient for the end users.  (Like Dav's sweet wife, who has impeccable taste and astute aesthetics to enjoy my work!)  ;)

Our Christmas "Time to Color" background has been colorized, thanks to the coloring game itself!  This helps it pop out and look more appealing, in my opinion.  (Also helps highlight the difference between it and our actual coloring pages, once we click on it.)

  [ You are not allowed to view this attachment ]  

The only issue which I'm currently concerned about is with start-up behavior for people with slower, older computers.  There's a large music selection now which the program loads in the background while the user is enjoy the background or making selections and clicking on options.  I've tried to work this out so that it processes one file at a time, unobtrusively, but from my experience, loading a sound file can cause a half second delay (or more) as _SNDOPEN opens and decodes it into memory.  On a modern PC this isn't such a drag that it's very noticeable, but I'm afraid it might be an issue with older machines, and I'm not entirely certain how to work around it if it is.

When you guys test this version out, let me know how it performs for you and if it seems to miss mouse clicks (it shouldn't), or if it seems excessively slow to respond to them. (I'm worried it might, but hope not.  Mine's a newer, top of the line gaming PC and laptop, so almost nothing bogs it down, and this doesn't cause any problems for me personally.  I'm just worried that folks like Cobalt might see issues on his old 286's which he has running Dos 2.0 still...  ;D )

If all works well, and I don't have to do a rewrite anywhere to try and bypass some sort of lag issue, then the next things to implement are:

The high score system.  (For now, it'll track number of pictures colored and saved, and number of pictures printed for each user.  Except for the Grinch.  That dude never gets credit for anything he does!)  This should give us an actual reason to take advantage of the pretty little Log-in system from now on, rather than just bypass it and go straight to the games. 

One we have high scores starting to save themselves, I'll also need to add in the LOAD PLAYER option, so you can resume with your old log-in, and not have to start over from scratch each time as well, so those are the next two basic options which I'll be working into the game if all works as advertised without any major issues for anyone.

[STxAxTIC]

I'm sure this christmas musical coloring book is awesome, but can we get an alpha-version download that isn't 900 gigs and virus-ridden?

  [ You are not allowed to view this attachment ]  

Half-kidding, I'm sure that's my browser and operating system just being cranky. But the fact remains that I literally can't download this project.

Might I suggest a release with 5 pictures, 2 songs, and the rest just code - the thing we actually want to see!

[Petr]

My new Windows 10 return the same output: Downloading failed, virus found.

[SMcNeill]

I'll dig into it to see why it's acting up with the virus detection.  Maybe Windows doesn't like the precompiled EXE?

[bplus]

Loaded fine for me on Windows 10 Laptop.

[SMcNeill]

I'm sure this christmas musical coloring book is awesome, but can we get an alpha-version download that isn't 900 gigs and virus-ridden?

  [ You are not allowed to view this attachment ]  

Half-kidding, I'm sure that's my browser and operating system just being cranky. But the fact remains that I literally can't download this project.

Might I suggest a release with 5 pictures, 2 songs, and the rest just code - the thing we actually want to see!

We all know the truth -- there's nothing here that you actually want to see.  You're just looking for something to complain about. :P

Here, the definitive STx version, without any of the bells or whistles which makes it worthwhile:   [ You are not allowed to view this attachment ]  

Of course, since a good portion of the code is all about loading, dealing with, and handling multiple resource files in the background, you're missing out on 90% of the brilliance of the project, but at least it's small enough now for folks to divide by zero and download it off dial-up when they have to.  ;D

[SMcNeill]

My new Windows 10 return the same output: Downloading failed, virus found.

Give this a try:  https://1drv.ms/u/s!AknUrv8RXVYMm_RfDlAhJZLM5Bmp_Q?e=xelOqf

It's the same version with just the precompiled EXE stripped out.  I included it just for convenience's sake, but if it's going to be triggering anti-virus warnings for everyone, it's simply more convenient to leave it out. 

Let me know if there's any issues with the download.  ;)

[Petr]

@SMcNeill

Hi, thanks for the link. I tried it on windows 7 (other computer) and it behaves strangely - now seeing to source and this do opening sound files. At first, it didn't want to respond to anything at all (mouse or keyboard) and memory usage rose to 1.3 gigabytes. Thid duration is about 1 minute. I thing, you use RAMDRIVE? I use here standard harddrive... After that, it started to work fast and the memory usage remained at the same level and no longer increased.

[SMcNeill]

@SMcNeill

Hi, thanks for the link. I tried it on windows 7 (other computer) and it behaves strangely - now seeing to source and this do opening sound files. At first, it didn't want to respond to anything at all (mouse or keyboard) and memory usage rose to 1.3 gigabytes. Thid duration is about 1 minute. I thing, you use RAMDRIVE? I use here standard harddrive... After that, it started to work fast and the memory usage remained at the same level and no longer increased.

@Petr thanks for the testing and invaluable feedback. 

If you look at the code, it's only supposed to load the sound files one at a time and then exit so the other routines can process keyboard/mouse clicks.  I've been testing it on my laptop with a SSD, and things seem to work okay with the mouse.  (To be honest, I'm not certain if I even tried it with the keyboard or not.  Lately my back has been hurting so I've been coding from my recliner and the mouse/trackball is a much simpler input device than the keyboard on my laptop which I'm not used to yet.)

The issue is QB64's slow loading of music files.  Even on my SSD, they often take 2-3 seconds to load and process.  I'd considered loading and unloading them, on the fly, as needed, but you never know when that delay with impact the user's experience.  So then I thoughtI'd load everything at start-up, but that causes a minute long opening for the game.  (Maybe if I animated a logo and some sound to distract the user, such a delay could be overlooked, but that's a lot of work just to conceal a background process.)

In an attempt to bypass both those major issues, I was hoping to load in the background, but apparently something is working quite right yet, from your description.  Now, I could always do as STx suggests and only use a single resource file of tiny size, but -- like you -- I have other projects I'm working on in the background.  Sorting out resource loading and management now, for a simple project like this one, will save me the time and hassle to figure them out later with other projects.

If what I have now isn't working as I'd hoped, as you say it isn't, then I need to rethink my process.  I'll have to dig into the keyboard routines, as I have an idea what the problem could be there (my custom Keyhit has no buffer by default, whereas _KEYHIT does), and I'll see if I can make the mouse more responsive as well. 

I'll give it one more good push for the current style of process handling, and if it doesn't work this next go, I'll switch gears and shoot for a completely different solution.  Heck, if all else fails, I can always use some video/audio editing software to break each song up into small, 10-second soundbites, to minimize load times of each segment -- but that'd be an extreme last resort.

There's a balance to be found yet, I'm certain, between loading resource files, program lag, and input responsiveness.  I just have to keep playing around to find the right combination which works on all machines outthere.  ;)

[SMcNeill]

@Petr See if this is more responsive for you:

Code: QB64: [Select]

1. $Resize:Smooth
2. $Color:32
3. $Console
4. 'So I can quickly add debug text if needed.  It's not ON by default.
5.  
6. '$INCLUDE:'Keyboard Library.BI'
7. '$INCLUDE:'Virtual Keyboard.BI'
8. '$INCLUDE:'SaveImage.BI'
9. Repeat_Speed = 0.2 'Global variable in the Virtual Keyboard library which a user can change for repeat speed
10.  
11.  
12. Randomize Timer
13. Screen _NewImage(1280, 720, 32)
14. _ControlChr Off
15.  
16.  
17. 'Remove the titlebar if on windows just to keep it prettier
18. $If WIN Then
19.     Declare Dynamic Library "User32"
20.         Function GetWindowLongA& (ByVal hWnd As _Offset, Byval nIndex As Long)
21.         Function SetWindowLongA& (ByVal hWnd As _Offset, Byval nIndex As Long, Byval dwNewLong As Long)
22.         Function SetWindowPos& (ByVal hWnd As Long, Byval hWndInsertAfter As _Offset, Byval X As Integer,_
23.                   Byval Y As Integer, Byval cx As Integer, Byval cy As Integer, Byval uFlags As _Offset)
24.  
25.     End Declare
26.     a = SetWindowLongA&(_WindowHandle, -16, GetWindowLongA(_WindowHandle, -16) And Not &H00C80000)
27.     a& = SetWindowPos&(_WindowHandle, 0, _DesktopWidth / 2 - 640, _DesktopHeight / 2 - 360, 1280, 720, 32)
28. $End If
29.  
30. $If FALCON = UNDEFINED Then
31.     $Let FALCON = TRUE
32.     Declare Library "./falcon"
33.         Sub uprint_extra (ByVal x&, Byval y&, Byval chars%&, Byval length%&, Byval kern&, Byval do_render&, txt_width&, Byval charpos%&, charcount&, Byval colour~&, Byval max_width&)
34.         Function uprint (ByVal x&, Byval y&, chars$, Byval txt_len&, Byval colour~&, Byval max_width&)
35.         Function uprintwidth (chars$, Byval txt_len&, Byval max_width&)
36.         Function uheight& ()
37.         Function uspacing& ()
38.         Function uascension& ()
39.     End Declare
40.     Dim Shared QPrintTextType As String
41.     QPrintTextType = "ASCII"
42. $End If
43.  
44.  
45. Dim Shared As Long MusicPlaying
46. Dim Shared As String User
47.  
48. Do
49.     TitleScreen
50.     MainMenu
51. Loop
52.  
53.  
54. '$INCLUDE:'Virtual Keyboard.BM'
55. '$INCLUDE:'Keyboard Library.BM'
56. '$INCLUDE:'SaveImage.BM'
57.  
58. Sub ColorIt
59.     ReDim As String Dir(0), File(0)
60.     GetLists "Coloring Sheets", Dir(), File()
61.  
62.     _DisplayOrder _Software , _Hardware
63.  
64.     f = _Font
65.     f128 = _LoadFont("Xmas.ttf", 128)
66.  
67.     ImageLimit = UBound(File) '
68.     ReDim As Long Image(ImageLimit)
69.     CandyArrow = _LoadImage(".\candy arrow.jpg", 32)
70.     For i = 1 To ImageLimit
71.         Image(i) = _LoadImage("Coloring Sheets\" + File(i), 32)
72.         'Image(i) = _LoadImage(File(i), 32)
73.     Next
74.     choice = 1: Oldmouse = -1
75.     Color Green, 0
76.     Do
77.         Cls , SkyBlue
78.         CenterText 25, "Welcome, " + User, f128
79.         _PutImage (50, 400)-(250, 300), CandyArrow
80.         _PutImage (300, 175)-(980, 560), Image(choice)
81.         _PutImage (1230, 300)-(1030, 400), CandyArrow
82.         CenterText 575, "What to color?", f128
83.         k = _KeyHit
84.         scroll = 0
85.         While _MouseInput
86.             If _MouseButton(1) Or _MouseButton(2) Then Exit While
87.             scroll = scroll + _MouseWheel
88.         Wend
89.         scroll = Sgn(scroll)
90.         If scroll = 1 Then k = 19200 'scroll left in choices
91.         If scroll = -1 Then k = 20480 'scroll right in choices
92.         MX = _MouseX: MY = _MouseY: MB = _MouseButton(1)
93.         If MB And Not Oldmouse Then
94.             k = 13 'count it as an enter press unless it's in the arrows
95.             If MY >= 300 And MY <= 400 Then 'in the right y area for arrow interaction
96.                 If MX >= 50 And MX <= 250 Then k = 19200 'in the left arrow box
97.                 If MX >= 1030 And MX <= 1230 Then k = 20480 'in the right arrow box
98.             End If
99.         End If
100.         If _MouseButton(2) Then k = 27
101.         Select Case k
102.             Case 19200, 18432 'left/up
103.                 choice = choice - 1
104.                 If choice < 1 Then choice = ImageLimit
105.             Case 20480, 19712 'right/down
106.                 choice = choice + 1
107.                 If choice > ImageLimit Then choice = 1
108.             Case 27 'ESC
109.                 GoSub beforeexit
110.                 MainMenu
111.             Case 32, 13 'SELECT AN IMAGE
112.                 Exit Do
113.         End Select
114.         _Limit 30
115.         _Display
116.         Oldmouse = MB
117.     Loop
118.  
119.  
120.     Dim kolor(3, 5) As _Unsigned Long
121.     kolor(0, 0) = Black: kolor(1, 0) = DarkBlue: kolor(2, 0) = DarkGreen: kolor(3, 0) = DarkCyan
122.     kolor(0, 1) = DarkRed: kolor(1, 1) = DarkMagenta: kolor(2, 1) = GoldenRod: kolor(3, 1) = LightGray
123.     kolor(0, 2) = DimGray: kolor(1, 2) = Blue: kolor(2, 2) = Lime: kolor(3, 2) = Cyan
124.     kolor(0, 3) = Red: kolor(1, 3) = Magenta: kolor(2, 3) = Yellow: kolor(3, 3) = White
125.     kolor(0, 4) = Gold: kolor(1, 4) = Purple: kolor(2, 4) = Pink: kolor(3, 4) = Copper
126.     kolor(0, 5) = Orange: kolor(1, 5) = Maroon: kolor(2, 5) = Salmon: kolor(3, 5) = Tann
127.  
128.  
129.  
130.     'At this point, we should now have our image chosen for coloring.
131.     'Let's draw a simple color interface and place the image on the screen and start playing with it!
132.     R = 128: G = 128: B = 128
133.     Oldmouse = -1
134.     Cls
135.     _PutImage (0, 0)-(1000, 720), Image(choice)
136.     Color White, 0
137.     Do
138.         CheckMusic
139.         Line (1001, 0)-(1279, 719), DarkGray, BF
140.         Line (1010, 25)-Step(257, 25), LightGray, BF
141.         Line (1010, 25)-Step(R, 25), Red, BF
142.         Line (1010, 60)-Step(257, 25), LightGray, BF
143.         Line (1010, 60)-Step(G, 25), Green, BF
144.         Line (1010, 95)-Step(257, 25), LightGray, BF
145.         Line (1010, 95)-Step(B, 25), Blue, BF
146.         Line (1010, 130)-Step(257, 70), _RGB32(R, G, B), BF
147.         _PrintString (1090, 156), "Custom Color"
148.         For x = 0 To 3
149.             For y = 0 To 5
150.                 Line (1020 + 60 * x, 220 + 60 * y)-Step(50, 50), kolor(x, y), BF
151.         Next y, x
152.         Line (1010, 590)-Step(120, 50), Green, BF
153.         _PrintString (1070 - _PrintWidth("Save") \ 2, 610), "Save"
154.         Line (1150, 590)-Step(120, 50), Green, BF
155.         _PrintString (1210 - _PrintWidth("Print") \ 2, 610), "Print"
156.         Line (1010, 650)-Step(250, 50), Red, BF
157.         _PrintString (1135 - _PrintWidth("Quit") \ 2, 670), "Quit"
158.         While _MouseInput
159.             If _MouseButton(1) Or _MouseButton(2) Then Exit While
160.         Wend
161.         MX = _MouseX: MY = _MouseY: MB = _MouseButton(1): mb2 = _MouseButton(2)
162.  
163.         If MX < 1000 And MB And Not Oldmouse Then Paint (MX, MY), _RGB32(R, G, B), _RGB32(0, 0, 0)
164.         If MB Then
165.             If MX > 1010 And MX < 1265 Then 'on a color tile?
166.                 If MY >= 25 And MY <= 50 Then R = MX - 1010
167.                 If MY >= 60 And MY <= 85 Then G = MX - 1010
168.                 If MY >= 95 And MY <= 120 Then B = MX - 1010
169.             End If
170.             If Not Oldmouse Then
171.                 For x = 0 To 3
172.                     For y = 0 To 5
173.                            if MX >= 1020 + 60 * x and MX <= 1070 + 60 * x and _
174.                               MY >= 220 + 60 * y and MY <= 270 + 60 * y then
175.                             R = _Red32(kolor(x, y))
176.                             G = _Green32(kolor(x, y))
177.                             B = _Blue32(kolor(x, y))
178.                         End If
179.                 Next y, x
180.                 If MX >= 1010 And MX <= 1130 And MY >= 590 And MY <= 640 Then
181.                     Open "Saved Images\saved count.bin" For Binary As #1
182.                     Get #1, 1, SC&
183.                     SC& = SC& + 1
184.                     Put #1, 1, SC&
185.                     Close
186.                     file$ = "Saved Images\Saved Picture" + Str$(SC&) + ".png"
187.                     result = SaveImage(file$, 0, 0, 0, 1000, 719)
188.                     PCopy 0, 1: Cls , 0
189.                     Print "Image Saved as "; file$: _Display
190.                     _Delay 5
191.                     Print: Print "Press <ANY KEY> to return.": _Display
192.                     Do: _Limit 15: Loop Until _KeyHit
193.                     PCopy 1, 0
194.                 End If
195.  
196.                 If MX >= 1150 And MX <= 1270 And MY >= 590 And MY <= 640 Then
197.                     tempImage = _NewImage(1000, 720, 32)
198.                     _PutImage , 0, tempImage, (0, 0)-(1000, 719)
199.                     _PrintImage tempImage
200.                     _FreeImage tempImage
201.                 End If
202.                 If MX >= 1010 And MX <= 1270 And MY >= 650 And MY <= 700 Then Exit Do
203.             End If
204.         End If
205.         If mb2 Then Exit Do
206.         _Limit 30
207.         _Display
208.         Oldmouse = MB
209.     Loop
210.  
211.  
212.  
213.     GoSub beforeexit
214.     Exit Sub
215.  
216.  
217.  
218.     beforeexit:
219.     For i = 1 To ImageLimit: _FreeImage Image(i): Next
220.     _FreeImage CandyArrow
221.     _FreeFont f128
222.     Return
223.  
224. End Sub
225.  
226.  
227.  
228. Sub ChooseGame
229.     If User = "" Then User = "Grinch"
230.     _DisplayOrder _Software , _Hardware
231.     f = _Font
232.     f128 = _LoadFont("Xmas.ttf", 128)
233.  
234.     GameLimit = 1 '                          Increase game limit and add new games as we go!
235.     Dim As String Games(1 To GameLimit)
236.     Dim As Long GameImage(1 To GameLimit)
237.     Games(1) = "Christmas Color It!"
238.  
239.     GameImage(1) = _LoadImage("The Season to Color.png", 33)
240.  
241.     CandyArrow = _LoadImage(".\candy arrow.jpg", 32)
242.     choice = 1: Oldmouse = -1: Oldmouse2 = -1
243.     Color Green, 0
244.     Do
245.         Cls , SkyBlue
246.         CenterText 25, "Welcome, " + User, f128
247.         _PutImage (50, 400)-(250, 300), CandyArrow
248.         _PutImage (300, 175)-(980, 560), GameImage(choice)
249.         _PutImage (1230, 300)-(1030, 400), CandyArrow
250.         CenterText 575, "Choose a game", f128
251.         k = _KeyHit
252.         scroll = 0
253.         While _MouseInput
254.             If _MouseButton(1) Or _MouseButton(2) Then Exit While
255.             scroll = scroll + _MouseWheel
256.         Wend
257.         scroll = Sgn(scroll)
258.         If scroll = 1 Then k = 19200 'scroll left in choices
259.         If scroll = -1 Then k = 20480 'scroll right in choices
260.         MB = _MouseButton(1): MB2 = _MouseButton(2)
261.         If MB And Not Oldmouse Then
262.             k = 13 'count it as an enter press unless it's in the arrows
263.             If MY >= 300 And MY <= 400 Then 'in the right y area for arrow interaction
264.                 If MX >= 50 And MX <= 250 Then k = 19200 'in the left arrow box
265.                 If MX >= 1030 And MX <= 1230 Then k = 20480 'in the right arrow box
266.             End If
267.         End If
268.         If MB2 And Not Oldmouse2 Then k = 27
269.         Select Case k
270.             Case 19200, 18432 'left/up
271.                 choice = choice - 1
272.                 If choice < 1 Then choice = GameLimit
273.             Case 20480, 19712 'right/down
274.                 choice = choice + 1
275.                 If choice > GameLimit Then choice = 1
276.             Case 27 'ESC
277.                 GoSub beforeexit
278.                 Exit Sub
279.             Case 32, 13 'SELECT A GAME
280.                 GoSub beforeexit
281.                 Select Case choice
282.                     Case 1: ColorIt
283.                 End Select
284.                 Exit Sub
285.         End Select
286.         _Limit 30
287.         _Display
288.         Oldmouse = MB: Oldmouse2 = MB2
289.     Loop
290.  
291.     beforeexit:
292.     For i = 1 To GameLimit: _FreeImage GameImage(i): Next
293.     _FreeImage CandyArrow
294.     _Font f
295.     _FreeFont f128
296.     Return
297. End Sub
298.  
299.  
300.  
301. Sub NewPlayer
302.     _DisplayOrder _Software , _Hardware
303.  
304.     'CREATE YOUR CUSTOM KEYBOARD LAYOUT HERE
305.     Dim My_Keyboard(5) As String
306.     My_Keyboard(0) = CHR$(0) + "27,ESC" + STRING$(2,0) + "15104,F1" + STRING$(2,0) + "15360,F2" + _
307.         STRING$(2,0) + "15616,F3" + STRING$(2,0) + "15872,F4" + STRING$(2,0) + "16128,F5" + _
308.         STRING$(2,0) + "16384,F6" + STRING$(2,0) + "16640,F7" + STRING$(2,0) + "16896,F8" + _
309.         STRING$(2,0) + "17152,F9" + STRING$(2,0) + "17408,F10" + STRING$(2,0) + "34048,F11" + _
310.         STRING$(2,0) + "34304,F12" + CHR$(0)
311.     My_Keyboard(1) = "`1234567890-=" + Chr$(0) + "8,BKSP" + Chr$(0)
312.     My_Keyboard(2) = Chr$(0) + "9,TAB" + Chr$(0) + "QWERTYUIOP[]\"
313.     My_Keyboard(3) = Chr$(0) + "100301,caps" + Chr$(0) + "ASDFGHJKL;'" + Chr$(0) + "13,ENTER" + Chr$(0)
314.     My_Keyboard(4) = Chr$(0) + "100304,SHIFT" + Chr$(0) + "ZXCVBNM,./" + Chr$(0) + "100303,SHIFT" + Chr$(0)
315.     My_Keyboard(5) = CHR$(0) + "100306,CTRL" + STRING$(2,0) + "100311,WIN" + STRING$(2,0) + "100308,ALT" + _
316.         STRING$(2,0) + "32,SPACE" + STRING$(2,0) + "100307,ALT" + STRING$(2,0) + "100312,WIN" + _
317.         STRING$(2,0) + "100319,MENU" + STRING$(2,0) + "100305,CTRL" +  CHR$(0)
318.  
319.     f = _Font
320.     font = _LoadFont("Courbd.ttf", 20, "monospace") 'IF USED ON A KEYBOARD, DON'T FREE THIS FONT
321.     font2 = _LoadFont("Courbd.ttf", 64, "monospace")
322.     font3 = _LoadFont("Courbd.ttf", 32, "monospace")
323.  
324.     Button_Style_Up = Register_Button(50, 50, 50, 150, 150, 150, 8, font, &HFFFFFF00, 0) 'create the styles for our keyboard buttons
325.     Button_Style_Down = Register_Button(150, 150, 150, 110, 110, 110, 8, font, &HFFFFFF00, 0)
326.     FullsizeKB1 = Create_KB(My_Keyboard(), 85, 65, Button_Style_Up, Button_Style_Down) 'and make the keyboard
327.  
328.  
329.     'REDEFINE MY LOwERCASE KEYS FOR KEYBOARD 2
330.     My_Keyboard(1) = "~!@#$%^&*()_+" + Chr$(0) + "8,BKSP" + Chr$(0)
331.     My_Keyboard(2) = Chr$(0) + "9,TAB" + Chr$(0) + "qwertyuiop{}|"
332.     My_Keyboard(3) = Chr$(0) + "100301,CAPS" + Chr$(0) + "asdfghjkl:" + Chr$(34) + Chr$(0) + "13,ENTER" + Chr$(0)
333.     My_Keyboard(4) = Chr$(0) + "100304,SHIFT" + Chr$(0) + "zxcvbnm<>?" + Chr$(0) + "100303,SHIFT" + Chr$(0)
334.     FullsizeKB2 = Create_KB(My_Keyboard(), 85, 65, Button_Style_Up, Button_Style_Down)
335.  
336.     Keyboard_In_Use = FullsizeKB1 'Set the keyboard I'm currently using
337.     'View Print 1 To 20
338.     Do
339.         _Font font2
340.         Color White, 0
341.         Do
342.             CheckMusic
343.             Cls , SkyBlue
344.             Display_KB Keyboard_In_Use, 25, 280, -1 'display the virtual keyboard
345.  
346.             QPrintString 25, 32, "NAME" 'show the user generated name
347.             Line (200, 25)-Step(1000, 75), DarkGray, BF
348.             QPrintString 1200 - QPrintWidth(User), 32, User
349.  
350.  
351.             While _MouseInput: Wend 'must update mouse buffer before reading virtual keyboard
352.             k = _KeyHit 'The library version which reads all the keys for us, not the qb64 _KEYHIT version
353.             '(ONLY FOR WINDOWS. LINUX/MAC USERS STILL GET THE SAME OLE BUGGY _KEYHIT FOR NOW.  SORRY.)
354.             If k = 0 Or k > 900000 Then k = VK_Keyhit(Keyboard_In_Use) 'this checks the virtual keyboard
355.             'If VK_Keydown(32) Then Print "Space held"; 'and here we can check for virtual keys being held down.
356.             Select Case k
357.                 Case 100301 'swap keyboards, rather than having a CAPS LOCK key
358.                     Keyboard_In_Use = (Keyboard_In_Use + 1) Mod 2
359.                     _Delay .2 'we need a delay here, as we haven't actually pressed any key on the new keyboard
360.                     'so the keys aren't going to have a down timer to stop repeats.. We'd probably change keyboards
361.                     'multiple times quickly without it, before we lifted our finger up off the mouse button.
362.                 Case 27: System
363.                 Case 8: User = Left$(User, Len(User) - 1)
364.                 Case 13: Exit Do
365.                 Case 1 TO 255: User = User + Chr$(k)
366.             End Select
367.             _Display
368.         Loop
369.  
370.         User = _Trim$(User)
371.         If User = "" Then User = "Grinch"
372.  
373.         'Confirm entry
374.         Color Green, 0
375.         choice = -1
376.         text = TextToImage(User + " is correct?", font3, Green, 0&, 1)
377.         _PutImage (325, 150)-(955, 225), text 'make certain our user name always fits nicely in the center
378.         Do
379.             CheckMusic
380.             k = _KeyHit
381.             Select Case k
382.                 Case 19200, 18432, 20480, 19712: choice = Not choice
383.                 Case 13: Exit Do
384.                 Case 27: System
385.             End Select
386.             If choice Then
387.                 Line (50, 150)-Step(250, 75), Red, BF
388.                 Line (980, 150)-Step(250, 75), DarkGray, BF
389.             Else
390.                 Line (50, 150)-Step(250, 75), DarkGray, BF
391.                 Line (980, 150)-Step(250, 75), Red, BF
392.             End If
393.             QPrintString 175 - QPrintWidth("YES") / 2, 150, "YES"
394.             QPrintString 1105 - QPrintWidth("NO") / 2, 150, "NO"
395.             _Limit 60
396.             _Display
397.         Loop
398.         User = ""
399.     Loop Until choice
400.  
401.     beforeexit:
402.     _Font f
403.     _FreeFont font
404.     _FreeFont font2
405.     _FreeImage text
406.     If User = "" Then User = "Grinch"
407.     ChooseGame
408. End Sub
409.  
410. Sub MainMenu
411.     restart:
412.     ReDim As String Dir(0), File(0)
413.     ReDim As Long menu(5): MakeMenus menu()
414.     Static OldMouse
415.     GetLists "Backgrounds", Dir(), File()
416.     Do
417.         count = count + 1: fetch = Int(Rnd * UBound(File)) + 1: file$ = "Backgrounds\" + File(fetch)
418.     Loop Until _FileExists(file$) Or count = 1000
419.     If count = 100 Then Cls: Print "ERROR CAN NOT LOAD BACKGROUNDS": End
420.     bg = _LoadImage(file$, 33)
421.  
422.     _DisplayOrder _Hardware , _Software 'we're going to use hardware only screens, just for the speed of things
423.     Type Flake_type: As Integer x, y, size: End Type: ReDim Flakes(1000) As Flake_type
424.  
425.     Cls , 0
426.     choice = 1: OldMouse = -1: Oldmouse2 = -1
427.     Do
428.         CheckMusic
429.         k = _KeyHit
430.         While _MouseInput
431.             If _MouseButton(1) Or _MouseButton(2) Then Exit While
432.             choice = choice + _MouseWheel
433.             If choice > 5 Then choice = 1
434.             If choice < 1 Then choice = 5
435.         Wend
436.         MX = _MouseX: MY = _MouseY: MB = _MouseButton(1): MB2 = _MouseButton(2)
437.  
438.         If MX >= 400 And MX <= 880 Then 'mouse is in right row area
439.             For i = 1 To 5
440.                 If MY >= 75 * i + 100 And MY <= 75 * i + 175 Then choice = i
441.             Next
442.         End If
443.         If MB = -1 And OldMouse = 0 Then k = 32
444.         If MB2 And Not Oldmouse2 Then k = 27
445.         Select Case k
446.             Case 18432, 19200: choice = choice - 1: If choice < 1 Then choice = 5
447.             Case 20480, 19712: choice = choice + 1: If choice > 5 Then choice = 1
448.             Case 13, 32
449.                 Select Case choice
450.                     Case 1 'new player
451.                         GoSub beforeexit
452.                         NewPlayer
453.                         Exit Sub
454.                     Case 2 'load player
455.                     Case 3 'new game
456.                         GoSub beforeexit
457.                         ChooseGame
458.                         GoTo restart
459.                     Case 4 'high scores
460.                     Case 5: System
461.                 End Select
462.             Case 27: System
463.         End Select
464.         _PutImage (0, 0)-(1279, 719), bg
465.         _PutImage (0, 0)-(1279, 719), menu(choice)
466.         _Limit 30
467.         _Display
468.         OldMouse = MB: Oldmouse2 = MB2
469.     Loop
470.  
471.     beforeexit:
472.     For i = 1 To 5: _FreeImage menu(i): Next
473.     Return
474. End Sub
475.  
476. Sub MakeMenus (Menu() As Long)
477.     Dim Options(5) As String, tempMenu(5) As Long
478.     D = _Dest
479.     Options(1) = "New Player": Options(2) = "Load Player": Options(3) = "New Game"
480.     Options(4) = "Highscores": Options(5) = "Quit"
481.     f64 = _LoadFont("Xmas3.ttf", 64)
482.     For j = 1 To 5
483.         tempMenu(j) = _NewImage(1280, 720, 32)
484.         _Dest tempMenu(j)
485.         For i = 1 To 5
486.             If i = j Then Color Red, 0 Else Color DarkGray, 0
487.             CenterText 75 * i + 100, Options(i), f64
488.         Next
489.         Menu(j) = _CopyImage(tempMenu(j), 33)
490.         _FreeImage tempMenu(j)
491.     Next
492.     _Dest D
493.     _FreeFont f64
494. End Sub
495.  
496. Sub TitleScreen
497.     CheckMusic
498.     Cls , SkyBlue: Color Snow, 0
499.     f128 = _LoadFont("Xmas.ttf", 128): f64 = _LoadFont("Xmas.ttf", 64)
500.     Wreath = _LoadImage("Images\OIP (7).jpg", 32): _SetAlpha 0, &HFFADADAD To &HFFFFFFFF, Wreath
501.     Tree = _LoadImage("Images\OIP (5).jpg", 32): _SetAlpha 0, &HFFADADAD To &HFFFFFFFF, Tree
502.     Bell = _LoadImage("Images\OIP (1).jpg", 32): _SetAlpha 0, &HFFADADAD To &HFFFFFFFF, Bell
503.     Present = _LoadImage("Images\OIP (21).jpg", 32): _SetAlpha 0, &HFFADADAD To &HFFFFFFFF, Present
504.     CenterText 250, "Xmas  Match", f128
505.     CenterText 375, "by SMcNeill", f64
506.     _PutImage (50, 10)-Step(250, 250), Wreath: _PutImage (980, 10)-Step(250, 250), Bell
507.     _PutImage (980, 400)-Step(250, 250), Tree: _PutImage (50, 400)-Step(250, 250), Present
508.     _FreeImage Wreath: _FreeImage Bell: _FreeImage Tree: _FreeImage Present
509.     _FreeFont f128: _FreeFont f64
510.     Do
511.         While _MouseInput
512.             If _MouseButton(1) Or _MouseButton(2) Then Exit While
513.         Wend
514.         If _MouseButton(1) Then Exit Sub
515.         If _MouseButton(2) Then System
516.         _Limit 5
517.     Loop Until _KeyHit Or Not _SndPlaying(MusicPlaying)
518. End Sub
519.  
520.  
521. Sub CheckMusic
522.     Static As Long MusicList, MusicLoaded, MusicFiles(1000)
523.     Static As _Float Delay
524.     If MusicList = 0 Then
525.         ReDim As String Dir(0), File(0)
526.         GetLists "Music", Dir(), File()
527.         MusicList = UBound(File)
528.     End If
529.     If MusicLoaded < MusicList And ExtendedTimer > Delay Then 'load music files while the user is busy looking at graphics or making choices
530.         ReDim As String Dir(0), File(0)
531.         GetLists "Music", Dir(), File()
532.         MusicLoaded = MusicLoaded + 1
533.         MusicFiles(MusicLoaded) = _SndOpen("Music/" + File(MusicLoaded)) 'Load one file at a time in the background
534.         If MusicLoaded = MusicList Then
535.             For i = 2 To MusicList 'shuffle the playlist each time the program starts for variety
536.                 Swap MusicFiles(i), MusicFiles(Rnd * i + 1)
537.             Next
538.         End If
539.         Delay = ExtendedTimer + 1 'At most, only load one file per second.  Have a delay between loading.
540.     End If
541.     If Not _SndPlaying(MusicPlaying) Then
542.         MusicPlaying = MusicPlaying + 1
543.         If MusicPlaying > MusicList Then MusicPlaying = 1 'replay the list all over again, if someone let it go that long!
544.         _SndPlay MusicPlaying 'play the new music file
545.     End If
546. End Sub
547.  
548. Sub CenterText (y, text$, font)
549.     f = _Font: _Font font: pw = QPrintWidth(text$): w = 1280: x = (w - pw) / 2
550.     QPrintString x, y, text$: _Font f
551. End Sub
552.  
553.  
554. Sub SafeLoadFont (font#) 'Safely loads a font without destroying our current print location and making it revert to the top left corner.
555.     right = Pos(0): down = (CsrLin - 1) * _FontHeight
556.     If _FontWidth <> 0 Then right = (right - 1) * _PrintWidth(" ") 'convert the monospace LOC to a graphic X coordinate
557.     _Font font#
558.     If _FontWidth <> 0 Then right = (right / _PrintWidth(" ")) + 1 'convert the graphic X coordinate back to a monospace LOC column
559.     down = (down / _FontHeight) + 1: If right < 1 Then right = 1
560.     Locate down, right
561. End Sub
562.  
563.  
564.  
565. Sub GetLists (SearchDirectory As String, DirList() As String, FileList() As String)
566.     Declare CustomType Library ".\direntry"
567.         Function load_dir& (s As String)
568.         Function has_next_entry& ()
569.         Sub close_dir ()
570.         Sub get_next_entry (s As String, flags As Long, file_size As Long)
571.     End Declare
572.  
573.     Dim flags As Long, file_size As Long, DirCount As Long, FileCount As Long, length As Long
574.     Dim nam$, slash$
575.     ReDim _Preserve DirList(1000), FileList(1000)
576.     DirCount = 0: FileCount = 0
577.     $If WIN Then
578.         slash$ = "\"
579.     $Else
580.         slash$ = "/"
581.     $End If
582.     If Right$(SearchDirectory$, 1) <> "/" And Right$(SearchDirectory$, 1) <> "\" Then SearchDirectory$ = SearchDirectory$ + slash$
583.  
584.     If load_dir(SearchDirectory + Chr$(0)) Then
585.         Do
586.             length = has_next_entry
587.             If length > -1 Then
588.                 nam$ = Space$(length)
589.                 get_next_entry nam$, flags, file_size
590.                 If _DirExists(SearchDirectory + nam$) Then
591.                     DirCount = DirCount + 1
592.                     If DirCount > UBound(DirList) Then ReDim _Preserve DirList(UBound(DirList) + 100)
593.                     DirList(DirCount) = nam$
594.                 ElseIf _FileExists(SearchDirectory + nam$) Then
595.                     FileCount = FileCount + 1
596.                     If FileCount > UBound(FileList) Then ReDim _Preserve FileList(UBound(FileList) + 100)
597.                     FileList(FileCount) = nam$
598.                 Else 'This else should never actually trigger
599.                     Print: Print: Print "zzz...  Unknown file found: "; SearchDirectory; slash$; nam$, _DirExists(nam$)
600.                     Beep: Sleep ' alert the user to
601.                 End If
602.             End If
603.         Loop Until length = -1
604.     End If
605.     close_dir
606.  
607.     ReDim _Preserve DirList(DirCount)
608.     ReDim _Preserve FileList(FileCount)
609. End Sub
610.  
611.  
612.  
613. Sub QPrint (temp$)
614.     Static m As _MEM: m = _MemImage(0)
615.     Dim BreakPoint As String
616.     BreakPoint = ",./- ;:!" 'I consider all these to be valid breakpoints.  If you want something else, change them.
617.     If QPrintTextType = "ASCII" Or QPrintTextType = "" Then text$ = _Trim$(AnsiTextToUtf8Text$(temp$)) Else text$ = temp$
618.     count = -1
619.     Do
620.         'first find the natural length of the line
621.         x = Pos(0) - 1: If _FontWidth Then x = x * _FontWidth
622.         y = CsrLin
623.         wide% = _Width - x - 1
624.         For i = 1 To Len(text$)
625.             If Asc(text$, i) = 10 Or Asc(text$, i) = 13 Then i = i - 1: Exit For
626.             p = uprintwidth(text$, i, 0)
627.             If p > wide% Then Exit For
628.         Next
629.         'IF i < LEN(text$) THEN lineend = i - 1 ELSE
630.         lineend = i
631.  
632.         t$ = RTrim$(Left$(text$, lineend)) 'at most, our line can't be any longer than what fits the screen.
633.         For i = lineend To 1 Step -1
634.             If InStr(BreakPoint, Mid$(text$, i, 1)) Then lineend = i: Exit For
635.         Next
636.         out$ = RTrim$(Left$(text$, lineend))
637.         text$ = LTrim$(Mid$(text$, lineend + 1))
638.         If Left$(text$, 2) = Chr$(13) + Chr$(10) Then text$ = Mid$(text$, 3)
639.         If Left$(text$, 2) = Chr$(10) + Chr$(13) Then text$ = Mid$(text$, 3)
640.         If Left$(text$, 1) = Chr$(13) Then text$ = Mid$(text$, 2)
641.         If Left$(text$, 1) = Chr$(10) Then text$ = Mid$(text$, 2)
642.         If _BackgroundColor <> 0 Then
643.             Line (x - 1, (y - 1) * uheight)-Step(uprintwidth(out$, Len(out$), 0), uheight), _BackgroundColor, BF
644.         End If
645.         w& = uprint(x - 1, (y - 1) * uheight, out$, Len(out$), _DefaultColor, 0)
646.         x = 1
647.         If y + 1 >= _Height / uheight Then 'scroll up
648.             h = uheight * _Width * 4
649.             t$ = Space$(m.SIZE - h)
650.             _MemGet m, m.OFFSET + h, t$
651.             Cls , 0
652.             _MemPut m, m.OFFSET, t$
653.             Locate y, x
654.         Else
655.             Locate y + 1, x
656.         End If
657.  
658.     Loop Until text$ = ""
659.     clean_exit:
660. End Sub
661.  
662. Function QPrintWidth& (out$)
663.     QPrintWidth = uprintwidth(out$, Len(out$), 0)
664. End Function
665.  
666. Function QFontHeight
667.     QFontHeight = uheight
668. End Function
669.  
670. Sub QPrintString (x, y, text$)
671.     If QPrintTextType = "ASCII" Or QPrintTextType = "" Then temp$ = _Trim$(AnsiTextToUtf8Text$(text$)) Else temp$ = text$
672.     If _BackgroundColor <> 0 Then
673.         Line (x, y)-Step(uprintwidth(temp$, Len(temp$), 0), uheight), _BackgroundColor, BF
674.     End If
675.     w& = uprint(x, y, temp$, Len(temp$), _DefaultColor, 0)
676. End Sub
677.  
678. Function AnsiTextToUtf8Text$ (text$)
679.     Dim chi&, ascii%, unicode&, aci%
680.     For chi& = 1 To Len(text$)
681.         '--- get ANSI char code, reset Unicode ---
682.         unicode& = _MapUnicode(Asc(text$, chi&))
683.         If unicode& = 0 Then unicode& = 65533 'replacement character
684.         temp$ = temp$ + UnicodeToUtf8Char$(unicode&)
685.     Next chi&
686.     AnsiTextToUtf8Text$ = temp$
687. End Function
688.  
689. Function UnicodeToUtf8Char$ (unicode&)
690.     '--- option _explicit requirements ---
691.     Dim uc&, first%, remain%, conti%
692.     '--- UTF-8 encoding ---
693.     If unicode& < 128 Then
694.         '--- standard ASCII (0-127) goes as is ---
695.         UnicodeToUtf8Char$ = Chr$(unicode&)
696.         Exit Function
697.     Else
698.         '--- encode the Unicode into UTF-8 notation ---
699.         temp$ = "": uc& = unicode& 'avoid argument side effect
700.         first% = &B10000000: remain% = 63
701.         Do
702.             first% = &B10000000 Or (first% \ 2): remain% = (remain% \ 2)
703.             conti% = &B10000000 Or (uc& And &B00111111): uc& = uc& \ 64
704.             temp$ = Chr$(conti%) + temp$
705.             If uc& <= remain% Then
706.                 first% = (first% Or uc&): uc& = 0
707.             End If
708.         Loop Until uc& = 0
709.         UnicodeToUtf8Char$ = Chr$(first%) + temp$
710.     End If
711. End Function
712.  
713. Function TextToImage& (text$, font&, fc&, bfc&, mode As _Byte)
714.     'text$ is the text that we wish to transform into an image.
715.     'font& is the handle of the font we want to use.
716.     'fc& is the color of the font we want to use.
717.     'bfc& is the background color of the font.
718.  
719.     'Mode 1 is print forwards
720.     'Mode 2 is print backwards
721.     'Mode 3 is print from top to bottom
722.     'Mode 4 is print from bottom up
723.     'Mode 0 got lost somewhere, but it's OK.  We check to see if our mode is < 1 or > 4 and compensate automatically if it is to make it one (default).
724.  
725.     If mode < 1 Or mode > 4 Then mode = 1
726.     dc& = _DefaultColor: bgc& = _BackgroundColor
727.     D = _Dest
728.     F = _Font
729.     T2Idown = CsrLin: T2Iright = Pos(0)
730.     If font& <> 0 Then _Font font&
731.     If mode < 3 Then
732.         'print the text lengthwise
733.         w& = _PrintWidth(text$): h& = _FontHeight
734.     Else
735.         'print the text vertically
736.         For i = 1 To Len(text$)
737.             If w& < _PrintWidth(Mid$(text$, i, 1)) Then w& = _PrintWidth(Mid$(text$, i, 1))
738.         Next
739.         h& = _FontHeight * (Len(text$))
740.     End If
741.  
742.     TextToImage_temp& = _NewImage(w&, h&, 32)
743.     TextToImage = TextToImage_temp&
744.     _Dest TextToImage_temp&
745.     If font& <> 0 Then _Font font&
746.     Color fc&, bfc&
747.  
748.     Select Case mode
749.         Case 1
750.             'Print text forward
751.             _PrintString (0, 0), text$
752.         Case 2
753.             'Print text backwards
754.             temp$ = ""
755.             For i = 0 To Len(text$) - 1
756.                 temp$ = temp$ + Mid$(text$, Len(text$) - i, 1)
757.             Next
758.             _PrintString (0, 0), temp$
759.         Case 3
760.             'Print text upwards
761.             'first lets reverse the text, so it's easy to place
762.             temp$ = ""
763.             For i = 0 To Len(text$) - 1
764.                 temp$ = temp$ + Mid$(text$, Len(text$) - i, 1)
765.             Next
766.             'then put it where it belongs
767.             For i = 1 To Len(text$)
768.                 fx = (w& - _PrintWidth(Mid$(temp$, i, 1))) / 2 + .99 'This is to center any non-monospaced letters so they look better
769.                 _PrintString (fx, _FontHeight * (i - 1)), Mid$(temp$, i, 1)
770.             Next
771.         Case 4
772.             'Print text downwards
773.             For i = 1 To Len(text$)
774.                 fx = (w& - _PrintWidth(Mid$(text$, i, 1))) / 2 + .99 'This is to center any non-monospaced letters so they look better
775.                 _PrintString (fx, _FontHeight * (i - 1)), Mid$(text$, i, 1)
776.             Next
777.     End Select
778.     _Dest D
779.     Color dc&, bgc&
780.     _Font F
781.     Locate T2Idown, T2Iright
782. End Function
783.  

I'm swapped over to _KEYHIT, which has a back buffer for us, and introduced a noticeable delay in the loading of resource files.  (Delay = ExtendedTimer + 1 'At most, only load one file per second.  Have a delay between loading. )

Hopefully these two tweaks will help with the unresponsiveness you described.  If not, then I'll have to switch gears completely and shoot for a different solution to this type problem.  (Not that many folks ever load 100+ MB of sound files into a program to begin with -- I just like to push the boundaries and create issues for myself that nobody else ever sees, I think sometimes.)

Try it in place of the last Xmas.bas you downloaded and let me know how it goes for you. ;)

[Petr]

@SMcNeill

Hi, it's a bit faster, but there are noticeable jamming at first.

[SMcNeill]

@SMcNeill

Hi, it's a bit faster, but there are noticeable jamming at first.

Then I guess I need to rethink this approach.  QB64 just takes too long to decode each sound file, causing the issues you're talking about.  I'll just need to come up with a different way to load resources, which the users won't find too intrusive or time consuming/detrimental.  :)