09-14-2025, 01:48 AM
I'd appreciate some fresh eyes on this. I'm ready to post a finished space shooter game, but every once in a while the program crashes when it gets to this high score sub. Sometimes the prog calls the sub via a timer, sometimes directly, doesn't seem to matter. When it glitches, the background sound loop keeps playing and the screen usually clears, but nada after that and it gives no error message when I Alt-Command-Esc (the Mac version of Ctrl-Alt-Del). It seems only to die when it has to change the existing high scores though it doesn't ever get much beyond inputting the file info. When it crashes the sound on line 54 plays, then apparently doesn't like the addYrName input loop since it doesn't _PutImage the starScape background on line 67 - or anything else. I tried changing out that image, but it makes no difference. The file CSV output is fine. It glitches on Mac and Windows. It works 95% of the time. This ain't rocket science just some simple input and file handling. Any help much appreciated.
Code: (Select All)
Sub HighScore () '
Dim a$, b$, c$, d$, e$, f$, g$, h$, newName$, filePlayer$
Dim As Integer c, d, i, fileScore
Dim As _Byte addYrName, a
Dim As Long virty, starBox, fontX
Shared As Long font1, font2, longOutro, shortOutro
Shared As HiScore hiscore() '
a$ = "CONGRATS! YOU MADE IT ONTO THE HIGH SCORE BOARD!"
b$ = "Enter your name below to commemorate this moment forever."
c$ = "- 15 character max - hit 'RETURN' when done -"
e$ = "WANT TO PLAY AGAIN?"
f$ = "The Universal Hall of Fame"
g$ = "(Right-Click for YES, Left-Click or Hit a Key for NO)"
h$ = e$ + g$
Timer(longOutro) Off: Timer(shortOutro) Off ' kill end-of-game timers
If _SndPlaying(S(22)) Then _SndStop S(22) ' kill generator hum if playing
For a = 12 To 16 ' find the playing background loop
If _SndPlaying(S(a)) Then Exit For
Next
Select Case a ' cut playing background loop volume in half
Case 12: _SndVol (S(a)), .02
Case 13: _SndVol (S(a)), .022
Case 14: _SndVol (S(a)), .09
Case 15: _SndVol (S(a)), .07
Case 16: _SndVol (S(a)), .018
End Select
virty = _NewImage(SWIDTH, SHEIGHT, 32) ' virtual screen for high score board
starBox = _NewImage(481, 241, 32) ' starry score box
fontX = _LoadFont("BlackwoodCastle.otf", 54) ' special one-time font
If fontX <= 0 Then
Beep: Cls: Print "Font Load Error at High Score Sub!"
_Delay 4: WrapUp: System
End If
If _FileExists("scores.txt") Then
Open "scores.txt" For Input As #3
' read high scores from file to hiScore array
For c = 0 To 4
Input #3, filePlayer$, fileScore '
hiscore(c).player = filePlayer$
hiscore(c).score = fileScore
Next c
' check for high score
If Game.score > hiscore(4).score Then ' if new score is > lowest HSBoard entry then addYrName... if not, fall thru to display HSB only
addYrName = _TRUE
_SndPlay S(30) ' tada sound
End If
Else If Game.score > 0 Then ' no HSB file: if you have a score > 0 then start a new HSB file & show the high score board b
addYrName = _TRUE
_SndPlay S(25) ' zap sound
End If
End If
_KeyClear ' ---------------------------
If addYrName Then '
Do ' name input loop
Cls '
_PutImage , StarScapeSW '
_Font font2: Color Gold
_PrintString (_Width / 2 - _PrintWidth(a$) / 2, 100), a$
Color DarkOliveGreen
_PrintString (_Width / 2 - _PrintWidth(b$) / 2, 160), b$
_PrintString (_Width / 2 - _PrintWidth(c$) / 2, 190), c$
d$ = InKey$
If d$ = Chr$(13) Then Exit Do ' return = done
If d$ = Chr$(8) Then ' if backspace is pressed...
newName$ = Mid$(newName$, 1, Len(newName$) - 1) ' delete the character
Else If Len(newName$) < 15 Then
newName$ = newName$ + d$
End If
End If
Line (CENTX - 150, 285)-(CENTX + 138, 335), _RGB32(255, 255, 0, 62), BF ' erasure box for name
_Font font2: Color ChartReuse
_PrintString (_Width / 2 - _PrintWidth(newName$) / 2 - 14, 300), newName$ ' display new name
If Len(newName$) < 1 Then
Color Yellow
_PrintString (_Width / 2 - 40, 300), Chr$(62) ' ">" show the input prompt
End If
_Display
_Limit 30 '
Loop ' ---------------------------
newName$ = _Trim$(Mid$(newName$, 1, 15)) ' limit to 15 characters
' load latest results from game play to index 6 in array
hiscore(5).score = Game.score
hiscore(5).player = newName$
' swap the positions
d = 5
For c = 4 To 0 Step -1
If hiscore(d).score > hiscore(c).score Then
Swap hiscore(d).player, hiscore(c).player
Swap hiscore(d).score, hiscore(c).score
d = d - 1
Else Exit For
End If
Next c
' write adjusted rankings to file
Open "temp.txt" For Output As #4 '
If _FileExists("scores.txt") Then Close #3: Kill "scores.txt" ' dump the old HSB
For c = 0 To 4
Write #4, hiscore(c).player, hiscore(c).score ' write new rankings to temp file
Next c '
Close #4 ' tidy up
Name "temp.txt" As "scores.txt" ' temp becomes new HSB
If _FileExists("temp.txt") Then Kill "temp.txt" '
End If
If hiscore(0).score = 0 Then _Font 16: WrapUp: System ' skip displaying of high score if it's all zeros
' display results to virty screen for reuse below
_Dest virty
_PrintMode _KeepBackground
Cls , _RGBA(0, 0, 0, 0) ' or is it _RGB32(0, 0, 0, 0)??? <<<<
_PutImage , StarScapeSW
Color Tann: _Font fontX
_UPrintString (CENTX - _PrintWidth(f$) \ 2, 80), f$
Line (CENTX - 400, 650)-(CENTX + 400, 850), Orange, B
_PutImage (CENTX - (_Width(I(9)) \ 2), CENTY - (_Height(I(9)) \ 2)), I(9) ' temple
Line (CENTX - 242, CENTY + 17)-(CENTX + 242, CENTY + 262), Black, BF ' high score block
Line (CENTX - 238, CENTY + 22)-(CENTX + 238, CENTY + 258), ChartReuse, B
Line (CENTX - 242, CENTY + 18)-(CENTX + 242, CENTY + 262), Magenta, B
_PutImage (0, 0), StarScapeSW, starBox, (CENTX - 237, CENTY + 24)-(CENTX + 237, CENTY + 257) ' cut some stars out of starScape & put em in starBox
_PutImage (CENTX - 240, CENTY + 22), starBox ' put stars in place
Color _RGB32(0, 128, 0, 215)
_Font font2
_PrintString (CENTX - 183, CENTY + 40), "Player Score"
_Font font1
Color _RGB32(255, 215, 0, 166)
For c = 0 To 4
_PrintString (CENTX - 190, CENTY + 80 + c * 35), Str$(c + 1) + " )" ' #)
_PrintString (CENTX - 150, CENTY + 80 + c * 35), hiscore(c).player
_PrintString (CENTX + 120, CENTY + 80 + c * 35), Str$(hiscore(c).score)
Next c
_Display '
_Font 16 '>>>> gotta use a system font to close out every _dest that uses a diff font otherwise ERRORS occur @ _freefont wrapUp! <<<<
_Dest 0
For i = 255 To 0 Step -4 ' fade in scene
_Limit 60 '
_PutImage , virty
Line (0, 0)-(_Width, _Height), _RGBA(0, 0, 0, i), BF ' increase black box transparency
_Display
Next
Color GoldenRod
Do: Cls
_PutImage , virty ' highScore table and background
While _MouseInput: Wend
If _MouseButton(1) _OrElse InKey$ <> "" Then ' end it
_FreeImage virty: _FreeImage starBox: _FreeFont fontX
WrapUp: System
End If
If _MouseButton(2) Then ' new game
_FreeImage virty: _FreeImage starBox: _FreeFont fontX
PrepNewGame: NewRound
Cls: Exit Sub '
End If
_Font font1: Color Lime
_PrintString (_Width \ 2 - _PrintWidth(h$) \ 2, _Height - 100), e$ ' ** PLAY AGAIN? **
Color CornflowerBlue
_PrintString (_Width \ 2 - _PrintWidth(h$) \ 2 + _PrintWidth(e$) + 10, _Height - 100), g$ ' input options
c = c + 1
If c > 50 Then ' attention-grabbing bar
Line (_Width \ 2 - _PrintWidth(h$) \ 2, _Height - 70)-((_Width \ 2 + _PrintWidth(h$) \ 2) + 7, _Height - 70), Yellow
Else Line (_Width \ 2 - _PrintWidth(h$) \ 2, _Height - 70)-((_Width \ 2 + _PrintWidth(h$) \ 2) + 7, _Height - 70), Magenta
End If
If c > 100 Then c = 0
_Display
_Limit 30
Loop
End Sub
