Yahtzee 64!!!

[Cobalt]

Bit of Preview of Yahtzee I'm working on as a possible net-play game for Steve's server. Still pretty early in development, but the core is there now I'm just working on keeping the score sheets. after that its done until the addition of Steve's server-side code so it can be played over the net, setting it up for a max 255 player game(like that would ever happen but, Hey Optimism!).  See what you guys like about it so far, or what you would suggest I change, but its a pretty simple game, I could have gone completely TEXT only (and made Pete happy) but wanted to give it some Pizazz! Will eventually have simple sound effects and perhaps background music but not yet.

Controls are completely mouse based, save for ESC to quit. not a whole lot to do with this release, you can use the shaker cup and lock the dice you wish to keep, then click on the Upper Score card section. but that is about it so far.

(12/14/2019 update info)
Okay, Major update here, the local High Scores list now functions properly, Added an intro with totally misleading music! :)  Has extra functionality depending on which MFI resource file you have downloaded. Right now this just means a "bubblely" background music if you download the beta MFI file(the one ending in 'b'). The controls are a bit finicky\touchy, if you happen to bump the mouse button over the shaker cup that counts as one roll. so be careful there.

(12/21/2019 update info)
Some Functionality is only implemented when you have the correct MFI file for that option, this mainly pertains to the Back Ground Musics. This is done to keep the resource file size down for people who do not have good internet access, as BGMs tend to be rather bulky even when saved at a fairly low quality rate. Version 'C' gives access to 3 more BGMs to choose from.

(12/22/2019 update info)
Most the major bugs are quashed, Online scores seem to be working, and main audio elements are in place. Version upped to 1.0beta save for a credits screen the only thing I had planned left is the multi player side, but as for the solitaire side its seem good to go. This is the last update of 2019(might whip up a credits screen though). Going to go back to Dragon Warrior for now, at least until QB64 1.4 is out.
Lets see who can get the highest online Score! To be able to add your scores to the online score list you must first view the online scores section. At the moment this connects you to the server.

Note: Requires current Dev. Build of QB64 Can not wait for the 1.4 release! :D

Todo List: Finish Sound control menu Done 12/21/2019
              : Fix Scoring bug, odd behavior: sometimes game quits before all scores are filled in other times it wont quit even with all
                scores filled in!?(with Yahtzee dice(5 of kind) clicking Large Straight then cancel then choosing yathzee with all
                other scores done has reproduced this error.)[/color] Done 12/22/2019
              : Implement On-Line score keeping Done 12/22/2019
              :Implement game sound effects(they are already in the MFIs and loaded just not coded in) Done 12/21/2019
              :confirm fix for multiple Yahtzee scoring.[only managed to pull this off once and it didn't track the score properly :( ]Done 12/21/2019 Best score yet 351!
              : Implement multi player games( this will be a big deal as it will require actual re-coding of some functions and a 'master host'
                program.
              :Add a credits screen

Code: QB64: [Select]

1. REM'$Include:'YahtzeeTypes.BI'
2. TYPE Upper_Card 'max score 125('base' shown),140('lite')
3.  Aces AS _BYTE '  4
4.  Duces AS _BYTE ' 8
5.  Trips AS _BYTE ' 12
6.  Quads AS _BYTE ' 16
7.  Quinc AS _BYTE ' 20
8.  Sexte AS _BYTE ' 24
9.  Bonus AS _BYTE ' 35 if all values added >= 63
10.  Total AS _UNSIGNED _BYTE 'base rules allow for only 125 max, but lite rules allow for 140
11. END TYPE
12.  
13. TYPE Lower_Card
14.  ThreeOfKind AS _BYTE 'total all dice, max 28(3x6+2x5 not using full house/30 with yahtzee bonus)
15.  FourOfKind AS _BYTE ' total all dice, max 29(4x6+1x5/30 with yahtzee bonus)
16.  FullHouse AS _BYTE '  25
17.  SmStraight AS _BYTE ' 30
18.  LgStraight AS _BYTE ' 40
19.  Chance AS _BYTE '     29 max(30 if not using yahtzee\'base' rules or yahtzee+bonus taken)
20.  Yahtzee AS _BYTE '    50 points(+100 per bonus yahtzee)
21.  Bonus AS _BYTE '      only 1 allowed in 'base' rules but multiple in 'lite' rules
22.  Total AS INTEGER 'Max:'base' rules-332: 'lite' rules- 650+185 and + 600 for upper_card(1435)
23. END TYPE
24. 'Absolute MAXIMUM high score is 1575 using 'lite' rules which allow for up to 13 yahtzees
25. 'first yahtzee being 50 points then 12 extra yahtzee at 100 points placing max numbers in
26. 'all 12 non yahtzee boxes, this would be a 'GOD'game where player rolled nothing but 5 of
27. 'a kind including 1 for each of the upper card scores and nothing but 6s for lower.
28. 'Odds are astronomical, but not technically impossible!
29.  
30. TYPE Game_Data
31.  Players AS _UNSIGNED _BYTE 'odds of 255 players for 1 game also ASTRONOMICAL!
32.  Whos_Turn AS _UNSIGNED _BYTE
33.  Current_Roll AS _BYTE 'each player gets up to 3 rolls for max score
34.  Upper_Filled AS _BYTE 'flag if all upper stats are filled in
35.  Lower_Filled AS _BYTE 'flag if all lower stats are filled in
36.  Rule_Set AS _BYTE 'using base rules or lite rules
37.  SetValues AS INTEGER ' flags for 13 values
38.  GameOver AS _BYTE 'when all 13 flags are set game is over
39.  FirstGame AS _BYTE 'if there is no score file then this is first game
40.  Connected AS _BYTE
41.  MFIVerB AS _BYTE 'does user have the B version MFI file?(extra BGM)
42.  MFIVerC AS _BYTE 'does user have Full BGM list MFI file?
43.  BGMVol AS _BYTE 'volume level of Background music
44.  SFXVol AS _BYTE 'volume level of Sound effects
45.  Current_BGM AS _BYTE 'which type of BGM is playing
46.  Loaded AS _BYTE 'are online high scores already loaded?
47. END TYPE
48.  
49. TYPE Die_Data
50.  Value AS _BYTE
51.  Locked AS _BYTE
52. END TYPE
53.  
54. TYPE Scores
55.  Who AS STRING * 16
56.  Score AS INTEGER
57.  Rules AS _BYTE
58. END TYPE
59.  
60. CONST TRUE = -1, FALSE = NOT TRUE
61. CONST STANDARD = 1, LITE = 2, LOWER = -1, UPPER = -2
62. CONST ACES = 1, DUCES = 2, TRIPS = 3, QUADS = 4, QUINC = 5, SEXTE = 6
63. CONST THREEOFKIND = 7, CHANCE = 13, FULLHOUSE = 9, FOUROFKIND = 8, YAHTZEE = 12, SMSTRAIGHT = 10, LGSTRAIGHT = 11
64. DIM SHARED PCU(255) AS Upper_Card, PCL(255) AS Lower_Card, G AS Game_Data, Layer(13) AS LONG
65. DIM SHARED DieArray(5) AS Die_Data '5 dice results
66. DIM SHARED Nick(255) AS STRING, Local(100) AS Scores, Online(255) AS Scores
67. DIM SHARED FFX&, FFX2&, BGM(6) AS LONG, SFX(8) AS LONG, D1 AS STRING, C2 AS STRING, T$(1)
68.  
69. DIM SHARED Host, Client '<--server needs
70.  
71. REM _DEFINE A-Z AS _INTEGER64  'we're going to send/recieve int64s usually (8 bytes).  Deal with it.
72.  
73. 'Graphic stuff setup---------------------------------------
74. SCREEN _NEWIMAGE(640, 480, 32)
75. Layer(0) = _DISPLAY
76. Layer(1) = _NEWIMAGE(640, 480, 32) 'Mixing layer
77. Layer(4) = _NEWIMAGE(640, 480, 32) 'click boxes
78. Layer(10) = _NEWIMAGE(640, 480, 32) 'Temp Layer
79. Layer(11) = _NEWIMAGE(640, 480, 32) 'green mat layer
80. Layer(13) = _NEWIMAGE(297, 608, 32) 'final score temp layer
81. '----------------Special Resource file check--------------------------
82. DATA 9,80,104,97,125,115,108,108,86,56,8,89,125,97,107,99,87,97,124
83. IF _FILEEXISTS("YahtzeeV1_2c.MFI") THEN
84.  G.MFIVerC = TRUE
85.  G.Current_BGM = 2
86.  MFI_Loader "YahtzeeV1_2c.MFI" 'load graphics and fonts (and sounds) B version
87. ELSEIF _FILEEXISTS("YahtzeeV1_2b.MFI") THEN
88.  G.MFIVerB = TRUE
89.  G.Current_BGM = 2
90.  MFI_Loader "YahtzeeV1_2b.MFI" 'load graphics and fonts (and sounds) B version
91. ELSE
92.  G.MFIVerB = FALSE
93.  G.MFIVerC = FALSE
94.  MFI_Loader "YahtzeeV1_2.MFI" 'load graphics and fonts (and sounds)
95. END IF
96. '-----------------------------------------------------------------------
97. RANDOMIZE TIMER
98. '-------------Final GFX setup-----------------------------
99. _CLEARCOLOR _RGB32(0, 0, 0), Layer(8)
100. _CLEARCOLOR _RGB32(0, 0, 0), Layer(9)
101. _FONT FFX&, Layer(10)
102. _PRINTMODE _KEEPBACKGROUND , Layer(10)
103. _PRINTMODE _KEEPBACKGROUND , Layer(1)
104. _SCREENMOVE 10, 10
105. _TITLE "Yahtzee64 by Unikorn Produckions @2019 Ver 1.0b Build 011"
106. Draw_GameMat Layer(11)
107. _SOURCE Layer(4) 'source for mouse click detection
108. '----------------------------------------------------------
109.  
110. '---------Inital Sound level setup-----------------------
111. G.BGMVol = 10
112. G.SFXVol = 10
113. FOR i%% = 1 TO 5
114.  _SNDVOL BGM(i%%), .1
115.  _SNDVOL SFX(i%%), .1
116. NEXT i%%
117. '----------------------------------------------------------
118. '---------Some inital setup values------------
119. Init_Scores 0
120. G.Rule_Set = STANDARD
121. Die_Shaker 'pre-shake dice
122. '---------------------------------------------
123.  
124. '--------intro screens-------
125. Intro
126. CLS
127. '-------------------------------------------------
128.  
129. IF G.MFIVerB OR G.MFIVerC THEN _SNDLOOP BGM(G.Current_BGM)
130. Load_Local_HiScore
131. Menu
132. IF G.MFIVerB OR G.MFIVerC THEN _SNDSTOP BGM(G.Current_BGM)
133. END
134.  
135.  
136. SUB Menu
137.  Create_ClickLayer 3
138.  DO
139.   _PUTIMAGE (0, 0), Layer(7), Layer(1)
140.   _PUTIMAGE , Layer(1), Layer(0)
141.  
142.   Selection%% = Check_ClickBox(_MOUSEX, _MOUSEY)
143.   LOCATE 1, 1: PRINT Selection%%
144.  
145.   IF _MOUSEBUTTON(1) THEN
146.    SELECT CASE Selection%%
147.     CASE 1
148.      ClearLayer Layer(1)
149.      Pick_Nick 0
150.      Create_ClickLayer 0
151.      Init_Scores 0
152.      Main_Game_Loop
153.      Create_ClickLayer 3
154.      End_Score 0
155.      Save_Local_Score
156.      IF G.Connected THEN Save_Online_Score: Sort_Online_Scores
157.      G.GameOver = FALSE
158.      G.SetValues = 0
159.     CASE 2 'multiplayer game
160.     CASE 3 'local high scores
161.      ClearLayer Layer(1)
162.      ClearLayer Layer(10)
163.      Load_Local_HiScore
164.      Local_Scores
165.     CASE 4 'online high scores
166.      ClearLayer Layer(1)
167.      ClearLayer Layer(10)
168.      IF NOT G.Loaded THEN
169.       Load_Online_HiScore
170.       Sort_Online_Scores
171.       G.Loaded = TRUE
172.      END IF
173.      Online_Scores
174.     CASE 5 'Sound control
175.      Sound_Controls
176.     CASE 6 'QUIT game
177.      ExitFlag%% = TRUE
178.    END SELECT
179.   END IF
180.   _LIMIT 30
181.   DO: LOOP WHILE _MOUSEINPUT
182.   IF INKEY$ = CHR$(27) THEN ExitFlag%% = TRUE
183.  LOOP UNTIL ExitFlag%%
184. END SUB
185.  
186.  
187. SUB Pick_Nick (Who~%%)
188.  Create_ClickLayer 4
189.  _DEST Layer(1)
190.  _FONT FFX2&, Layer(1)
191.  _PRINTSTRING (85, 160), "A B C D E F G H I J K L M", Layer(1)
192.  _PRINTSTRING (85, 210), "N O P Q R S T U V W X Y Z", Layer(1)
193.  _PRINTSTRING (85, 260), "0 1 2 3 4 5 6 7 8 9   .", Layer(1)
194.  _PRINTSTRING (85, 310), "      BACK      DONE     ", Layer(1)
195.  FOR i%% = 0 TO 15
196.   LINE (64 + 32 * i%%, 64)-STEP(24, 4), _RGB32(192, 192, 192), BF
197.  NEXT i%%
198.  _PUTIMAGE , Layer(1), Layer(10)
199.  
200.  DO
201.   SELECT CASE Selection%%
202.    CASE 0 TO 13
203.     i%% = 0
204.     j%% = (Selection%% MOD 14) - 1
205.    CASE 14 TO 26
206.     i%% = 1
207.     j%% = (Selection%% MOD 14)
208.    CASE 27 TO 38
209.     i%% = 2
210.     j%% = (Selection%% MOD 13) - 1
211.   END SELECT
212.   _PUTIMAGE , Layer(10), Layer(1)
213.   IF Selection%% < 63 THEN
214.    IF Selection%% <> 0 THEN 'hi-lite current letter mouse is over
215.     LINE (85 + 35 * j%% + j%%, 158 + 50 * i%%)-STEP(19, 25), _RGB32(224, 204, 16), B
216.    END IF
217.   ELSEIF Selection%% = 63 THEN
218.    LINE (190, 308)-STEP(80, 25), _RGB32(224, 204, 16), B
219.  
220.   ELSEIF Selection%% = 64 THEN
221.    LINE (370, 308)-STEP(80, 25), _RGB32(224, 204, 16), B
222.   ELSE
223.   END IF
224.  
225.   FOR k%% = 1 TO LEN(Nick$) 'Print name
226.    _PRINTSTRING (64 + 32 * (k%% - 1), 32), MID$(Nick$, k%%, 1), Layer(1)
227.   NEXT k%%
228.  
229.   'hi-lite current Character
230.   IF lit%% AND LEN(Nick$) < 16 THEN LINE (64 + 32 * LEN(Nick$), 64)-STEP(24, 4), _RGB32(224, 224, 64), BF
231.  
232.   _PUTIMAGE , Layer(1), Layer(0) 'move image to screen
233.  
234.   Selection%% = Check_ClickBox(_MOUSEX, _MOUSEY)
235.   _PRINTSTRING (0, 0), STR$(Selection%%) + STR$(j%%) + STR$(i%%), Layer(0)
236.   IF _MOUSEBUTTON(1) THEN
237.    IF LEN(Nick$) < 16 THEN
238.     SELECT CASE Selection%%
239.      CASE 1 TO 26
240.       Nick$ = Nick$ + CHR$(64 + Selection%%)
241.      CASE 27 TO 36
242.       Nick$ = Nick$ + CHR$(48 + (Selection%% - 27))
243.      CASE 37 '32
244.       Nick$ = Nick$ + " "
245.      CASE 38 '46
246.       Nick$ = Nick$ + "."
247.      CASE 63 'back space
248.       IF LEN(RTRIM$(Nick$)) > 0 THEN Nick$ = LEFT$(Nick$, LEN(Nick$) - 1)
249.      CASE 64 'accept nick
250.       Exitflag%% = TRUE
251.     END SELECT
252.    END IF
253.    Button_Down_Lock
254.   END IF
255.  
256.  
257.   _LIMIT 30
258.   ClearLayer Layer(1)
259.   DO: LOOP WHILE _MOUSEINPUT
260.   IF INKEY$ = CHR$(27) THEN Exitflag%% = TRUE
261.   tim%% = tim%% + 1
262.   IF tim%% = 15 AND lit%% = FALSE THEN lit%% = TRUE: tim%% = 0
263.   IF tim%% = 15 AND lit%% THEN lit%% = FALSE: tim%% = 0
264.  LOOP UNTIL Exitflag%%
265.  
266.  _DEST Layer(0)
267.  _FONT 16, Layer(1)
268.  Nick(Who~%%) = Nick$
269. END SUB
270.  
271.  
272. SUB Main_Game_Loop
273.  DO
274.   _PUTIMAGE , Layer(11), Layer(1)
275.   Place_ShakerCup 500, 20
276.   IF G.Current_Roll > 0 THEN
277.    Display_Dice 50, 50
278.    IF G.Current_Roll < 3 THEN
279.     _PRINTSTRING (30, 409), "Click on Dice to keep then click shaker cup,", Layer(1)
280.     _PRINTSTRING (30, 426), "to reroll remaining dice, or click on score ", Layer(1)
281.     _PRINTSTRING (30, 443), "card to record score.", Layer(1)
282.    ELSE
283.     _PRINTSTRING (30, 409), "Out of Rolls, select score card to save ", Layer(1)
284.     _PRINTSTRING (30, 426), "Dice score.", Layer(1)
285.    END IF
286.   ELSE
287.    _PRINTSTRING (30, 425), "Click on shaker cup.", Layer(1)
288.   END IF
289.   Display_UpperCard 400, 140, .33, 0
290.   Display_LowerCard 400, 295, .33, 0
291.   _PUTIMAGE (0, 0), Layer(1), Layer(0)
292.   Selection%% = Check_ClickBox(_MOUSEX, _MOUSEY)
293.  
294.   Top~%% = _SHL(G.SetValues, 2)
295.   Bot~%% = _SHR(G.SetValues, 6)
296.   LOCATE 1, 1: PRINT Selection%%; G.Current_Roll; Die_Check; G.Upper_Filled; Top~%%; Bot~%%; G.SetValues
297.  
298.   IF _MOUSEBUTTON(1) THEN
299.    SELECT CASE Selection%%
300.     CASE 1
301.      IF G.Current_Roll < 3 THEN
302.       Die_Shaker
303.       Shaking%% = TRUE
304.      END IF
305.     CASE 2, 3 'view score card
306.      DO: nul = _MOUSEINPUT: LOOP WHILE _MOUSEBUTTON(1)
307.      View_Score_Card Selection%%, 0
308.     CASE 4 TO 8 'dice
309.      IF DieArray(Selection%% - 3).Locked THEN DieArray(Selection%% - 3).Locked = FALSE ELSE DieArray(Selection%% - 3).Locked = TRUE
310.    END SELECT
311.    IF Selection%% > 1 THEN DO: nul = _MOUSEINPUT: LOOP WHILE _MOUSEBUTTON(1) 'wait while button is down unless shaking dice
312.   END IF
313.   'player gets 3 rolls, count roll when mouse button released
314.   IF Shaking%% AND NOT _MOUSEBUTTON(1) THEN G.Current_Roll = G.Current_Roll + 1: Shaking%% = FALSE: _SNDPLAY SFX(5)
315.  
316.   IF Shaking%% AND Soundplaying%% = FALSE THEN
317.    SELECT CASE Die_In_Cup
318.     CASE 4 OR 5
319.      _SNDPLAY SFX(1)
320.      Soundplaying%% = 1
321.     CASE 3
322.      _SNDPLAY SFX(2)
323.      Soundplaying%% = 2
324.     CASE 2
325.      _SNDPLAY SFX(3)
326.      Soundplaying%% = 3
327.     CASE 1
328.      _SNDPLAY SFX(4)
329.      Soundplaying%% = 4
330.    END SELECT
331.   ELSEIF NOT Shaking%% THEN
332.    _SNDSTOP SFX(Soundplaying%%)
333.    Soundplaying%% = 0
334.   END IF
335.  
336.   _LIMIT 30
337.   DO: LOOP WHILE _MOUSEINPUT
338.   IF INKEY$ = CHR$(27) THEN ExitFlag%% = TRUE
339.  LOOP UNTIL ExitFlag%% OR G.GameOver
340. END SUB
341.  
342. SUB View_Score_Card (UL%%, Who~%%)
343.  DO
344.   SELECT CASE UL%%
345.    CASE 2 'upper
346.     Result%% = Show_Upper_Card(Who~%%)
347.    CASE 3 'lower
348.     Result%% = Show_Lower_Card(Who~%%)
349.   END SELECT
350.   IF Result%% = -1 THEN ExitFlag%% = TRUE
351.   IF Result%% = -2 THEN G.Current_Roll = 0: ExitFlag%% = TRUE
352.   IF Result%% = 1 THEN UL%% = 3
353.   IF Result%% = 2 THEN UL%% = 2
354.   PRINT Result%%; UL%%
355.   _DELAY .05
356.  LOOP UNTIL ExitFlag%%
357.  UL%% = 0
358.  Top~%% = _SHL(G.SetValues, 2)
359.  Bot~%% = _SHR(G.SetValues, 6)
360.  IF Top~%% = 252 THEN G.Upper_Filled = TRUE
361.  IF Bot~%% = 254 THEN G.Lower_Filled = TRUE
362.  IF Top~%% = 252 AND Bot~%% = 254 THEN G.GameOver = TRUE
363.  Button_Down_Lock
364. END SUB
365.  
366.  
367.  
368. SUB MFI_Loader (FN$)
369.  DIM Size(64) AS LONG, FOffset(64) AS LONG
370.  OPEN FN$ FOR BINARY AS #1
371.  GET #1, , c~%% 'retrieve number of files
372.  FOR I~%% = 1 TO c~%%
373.   GET #1, , FOffset(I~%%)
374.   GET #1, , Size(I~%%)
375.   FOffset&(I~%%) = FOffset&(I~%%) + 1
376.  NEXT I~%%
377.  FOR d%% = 0 TO 1: READ C%%
378.   FOR i%% = 1 TO C%%
379.    READ T%%: T%% = T%% XOR C%%: T$(d%%) = T$(d%%) + CHR$(T%%)
380.  NEXT i%%, d%%
381.  'load the files where they go here----------
382.  Layer(2) = LoadGFX(FOffset(1), Size(1)) '_LOADIMAGE("Upper_Card.png", 32) 'upper score card
383.  Layer(3) = LoadGFX(FOffset(2), Size(2)) '_LOADIMAGE("Lower_Card.png", 32) 'Lower score card
384.  Layer(5) = LoadGFX(FOffset(3), Size(3)) '_LOADIMAGE("UPsplash6x4.BMP", 32) 'flash Screen
385.  Layer(6) = LoadGFX(FOffset(4), Size(4)) '_LOADIMAGE("Yahtzeeflash.BMP", 32)
386.  Layer(7) = LoadGFX(FOffset(5), Size(5)) '_LOADIMAGE("Yahtzee-logo.BMP", 32)
387.  Layer(8) = LoadGFX(FOffset(6), Size(6)) '_LOADIMAGE("SizedDiceRedDot.BMP", 32)
388.  Layer(9) = LoadGFX(FOffset(7), Size(7)) '_LOADIMAGE("ShakerCup.BMP", 32)
389.  FFX& = LoadFFX(FOffset(8), Size(8), 24) '_LOADFONT("OBGB.ttf", 24, "MONOSPACE")
390.  FFX2& = LoadFFX(FOffset(8), Size(8), 24) '_LOADFONT("OBGB.ttf", 24, "MONOSPACE")
391.  Layer(12) = LoadGFX(FOffset(15), Size(15)) '_LOADIMAGE("ShakerCup.BMP", 32)
392.  BGM(1) = LoadSFX(FOffset(16), Size(16))
393.  
394.  SFX(1) = LoadSFX(FOffset(9), Size(9)) 'die shake 4 or 5 dice
395.  SFX(2) = LoadSFX(FOffset(10), Size(10)) 'die shake 3 dice
396.  SFX(3) = LoadSFX(FOffset(11), Size(11)) 'die shake 2 dice
397.  SFX(4) = LoadSFX(FOffset(12), Size(12)) 'single die shake
398.  SFX(5) = LoadSFX(FOffset(13), Size(13)) 'rolling dice
399.  
400.  IF G.MFIVerB OR G.MFIVerC THEN BGM(2) = LoadSFX(FOffset(17), Size(17))
401.  IF G.MFIVerC THEN BGM(3) = LoadSFX(FOffset(18), Size(18))
402.  IF G.MFIVerC THEN BGM(4) = LoadSFX(FOffset(19), Size(19))
403.  IF G.MFIVerC THEN BGM(5) = LoadSFX(FOffset(20), Size(20))
404.  
405.  '-------------------------------------------
406.  CLOSE #1
407.  IF _FILEEXISTS("temp.dat") THEN KILL "temp.dat"
408. END SUB
409.  
410.  
411. REM'$include:'Core_Funcitons.BAS'
412. REM'$include:'GFX_Functions.BAS'
413. REM'$include:'MFI_Functions.BAS'
414. REM'$include:'ServerCode.BAS'
415.  
416. SUB Button_Down_Lock
417.  DO: nul = _MOUSEINPUT: LOOP WHILE _MOUSEBUTTON(1)
418. END SUB
419.  
420. FUNCTION Check_ClickBox%% (X%, Y%)
421.  Result%% = 0
422.  R%% = _RED32(POINT(X%, Y%))
423.  Result%% = R%%
424.  Check_ClickBox = Result%%
425. END FUNCTION
426.  
427. SUB ClearLayer (L&)
428.  old& = _DEST
429.  _DEST L&
430.  CLS
431.  _DEST old&
432. END SUB
433.  
434. SUB Clear_Scores
435.  FOR i%% = 1 TO 99
436.   Local(i%%).Who = ""
437.   Local(i%%).Score = 0
438.   Local(i%%).Rules = 0
439.  NEXT i%%
440. END SUB
441.  
442. FUNCTION Count_Dice%% (DV%%)
443.  Result%% = 0 'initalize value
444.  FOR i%% = 1 TO 5
445.   IF DieArray(i%%).Value = DV%% THEN Result%% = Result%% + DV%%
446.  NEXT i%%
447.  Count_Dice = Result%%
448. END FUNCTION
449.  
450. FUNCTION Die_Check%%
451.  'Steves Dice Status checking routine
452.  DIM Count(7)
453.  
454.  FOR i%% = 1 TO 5
455.   Count(DieArray(i%%).Value) = Count(DieArray(i%%).Value) + 1
456.  NEXT i%%
457.  
458.  FOR i%% = 1 TO 6
459.   IF Count(i%%) >= 2 THEN
460.    Result%% = Result%% + Count(i%%)
461.    IF Count(i%%) > 3 THEN Result%% = Result%% + 2
462.   END IF
463.  NEXT i%%
464.  
465.  'check for long straight------
466.  FOR i%% = 1 TO 5
467.   IF Count(i%%) = 1 THEN LS%% = LS%% + 1
468.   IF Count(i%% + 1) = 1 THEN LS2%% = LS2%% + 1
469.  NEXT i%%
470.  '-----------------------------
471.  
472.  'check for short straight------
473.  FOR x%% = 0 TO 2
474.   FOR i%% = 1 TO 4
475.    IF Count(i%% + x%%) = 1 OR Count(i%% + x%%) = 2 THEN SS%% = SS%% + 1
476.   NEXT i%%
477.   IF SS%% = 4 THEN x%% = 3 ELSE SS%% = 0
478.  NEXT x%%
479.  '------------------------------
480.  IF SS%% = 4 THEN Result%% = 9
481.  
482.  IF LS%% = 5 OR LS2%% = 5 THEN Result%% = 8 'comes after short straight cause a long trumps a short.
483.  
484.  ' IF Result = 3 THEN PRINT "Three of Kind"
485.  ' IF Result = 5 THEN PRINT "Full House"
486.  ' IF Result = 6 THEN PRINT "Four of Kind"
487.  ' IF Result = 7 THEN PRINT "Yahtzee"
488.  ' IF Result = 8 THEN PRINT "Large Straight"
489.  ' IF Result = 9 THEN PRINT "Short Straight"
490.  Die_Check = Result%%
491. END FUNCTION
492.  
493. FUNCTION Die_In_Cup%%
494.  Result%% = 5
495.  FOR i%% = 1 TO 5 'check if any dice are locked, then they are not in the shaker cup.
496.   IF DieArray(i%%).Locked THEN Result%% = Result%% - 1
497.  NEXT i%%
498.  Die_In_Cup = Result%%
499. END FUNCTION
500.  
501. FUNCTION Die_Roll%%
502.  Die_Roll = INT(RND * 6) + 1 'very, very simple
503. END FUNCTION
504.  
505. SUB Die_Shaker
506.  FOR i%% = 1 TO 5
507.   IF G.Current_Roll = 0 THEN DieArray(i%%).Locked = FALSE
508.   IF DieArray(i%%).Locked = FALSE THEN DieArray(i%%).Value = Die_Roll
509.  NEXT i%%
510. END SUB
511.  
512. SUB Init_Scores (who~%%)
513.  'set all values at -1 to show not filled in, as you can score 0
514.  PCU(who~%%).Aces = -1
515.  PCU(who~%%).Duces = -1
516.  PCU(who~%%).Trips = -1
517.  PCU(who~%%).Quads = -1
518.  PCU(who~%%).Quinc = -1
519.  PCU(who~%%).Sexte = -1
520.  PCU(who~%%).Total = -1
521.  PCL(who~%%).ThreeOfKind = -1
522.  PCL(who~%%).FourOfKind = -1
523.  PCL(who~%%).FullHouse = -1
524.  PCL(who~%%).SmStraight = -1
525.  PCL(who~%%).LgStraight = -1
526.  PCL(who~%%).Chance = -1
527.  PCL(who~%%).Yahtzee = -1
528.  PCL(who~%%).Bonus = 0 'save for bonus Yahtzees which starts at 0
529.  PCL(who~%%).Total = -1
530. END SUB
531.  
532. SUB Load_Local_HiScore
533.  IF _FILEEXISTS("LocalYahtzee.SCR") THEN
534.   'load high scores
535.   OPEN "LocalYahtzee.SCR" FOR BINARY AS #1
536.   GET #1, , Local()
537.   CLOSE
538.  ELSE
539.   G.FirstGame = TRUE
540.   'use defult names
541.   Local(1).Who = "COBALT": Local(1).Score = 390: Local(1).Rules = 0
542.   Local(2).Who = "SMcNeill": Local(2).Score = 300: Local(2).Rules = 0
543.   Local(3).Who = "Fellippe": Local(3).Score = 290: Local(3).Rules = 0
544.   Local(4).Who = "Pete": Local(4).Score = 280: Local(4).Rules = 0
545.   Local(5).Who = "STaXaTIC": Local(5).Score = 270: Local(5).Rules = 0
546.   Local(6).Who = "Luke": Local(6).Score = 260: Local(6).Rules = 0
547.   Local(7).Who = "[banned user]": Local(7).Score = 250: Local(7).Rules = 0
548.   Local(8).Who = "Keybone": Local(8).Score = 240: Local(8).Rules = 0
549.   Local(9).Who = "Catherine": Local(9).Score = 230: Local(9).Rules = 0
550.   Local(10).Who = "Clippy": Local(10).Score = 220: Local(10).Rules = 0
551.   Local(11).Who = "Narika": Local(11).Score = 210: Local(11).Rules = 0
552.   Local(12).Who = "Galleon": Local(12).Score = 20: Local(12).Rules = 0
553.  END IF
554. END SUB
555.  
556. SUB Load_Online_HiScore
557.  DIM M AS _MEM
558.  M = _MEM(Online())
559.  
560.  LOCATE 20, 1: PRINT "Logging on to server"
561.  DO
562.   count = count + 1: C2 = T$(1)
563.   Client = _OPENCLIENT("TCP/IP:7993:172.93.60.23") 'attempt to join as client
564.   _LIMIT 10
565.  LOOP UNTIL Client <> 0 OR count > 100
566.  D1 = T$(0)
567.  OK$ = Verify$
568.  IF LEFT$(OK$, 4) <> "[OK]" THEN
569.   Detail$ = "[ERROR]Host not responding."
570.   CLOSE
571.   END
572.  ELSE
573.   G.Connected = TRUE
574.  END IF
575.  _DELAY .25
576.  
577.  PRINT "logging in to scores"
578.  IF G.Connected THEN
579.   N$ = D1: P$ = C2
580.   Send Client, "[LOG IN]" + N$ + "," + P$ 'Register a new account
581.   OK$ = Verify$
582.   _TITLE OK$
583.   Detail$ = OK$
584.   IF LEFT$(OK$, 4) = "[OK]" THEN
585.    _DELAY .15
586.    DO
587.     Send Client, "[GAME SET]Yahtzee" 'Let the server know what game we're playing.
588.     OK$ = Verify$
589.     IF LEFT$(OK$, 4) = "[OK]" THEN
590.      ExitFlag%% = TRUE
591.     ELSE
592.      DisplayError OK$
593.      CLOSE
594.      END
595.     END IF
596.    LOOP UNTIL ExitFlag%%
597.    _DELAY .25
598.    PRINT "Requesting score file"
599.  
600.  
601.    Send Client, "[GAME GET]TestScores.txt" 'the command to get the data back from the server.
602.    OK$ = Verify$
603.    IF LEFT$(OK$, 4) = "[OK]" THEN
604.     'All is good
605.     DataWeGot$ = MID$(OK$, 5) 'the data is attached after the [OK].  Like this, we got it.
606.    ELSE
607.     DisplayError OK$ 'pop up an error message telling us what went wrong.
608.     END 'However we want to handle an error when trying to put data to the server.
609.    END IF
610.  
611.    _MEMPUT M, M.OFFSET, DataWeGot$
612.  
613.   ELSE
614.    PRINT OK$
615.    CLOSE
616.    END
617.   END IF
618.  
619.  ELSE
620.   Online(1).Who = "Not Connected"
621.  END IF
622.  _MEMFREE M
623. END SUB
624.  
625. FUNCTION LowerTotal% (Who~%%)
626.  IF PCL(Who~%%).ThreeOfKind >= 0 THEN Result% = PCL(Who~%%).ThreeOfKind
627.  IF PCL(Who~%%).FourOfKind >= 0 THEN Result% = Result% + PCL(Who~%%).FourOfKind
628.  IF PCL(Who~%%).FullHouse >= 0 THEN Result% = Result% + PCL(Who~%%).FullHouse
629.  IF PCL(Who~%%).SmStraight >= 0 THEN Result% = Result% + PCL(Who~%%).SmStraight
630.  IF PCL(Who~%%).LgStraight >= 0 THEN Result% = Result% + PCL(Who~%%).LgStraight
631.  IF PCL(Who~%%).Chance >= 0 THEN Result% = Result% + PCL(Who~%%).Chance
632.  IF PCL(Who~%%).Yahtzee >= 0 THEN Result% = Result% + PCL(Who~%%).Yahtzee
633.  'go ahead and calculate grand total for lower as we go.-------------
634.  PCL(Who~%%).Total = Result%
635.  IF PCL(Who~%%).Bonus THEN
636.   FOR i%% = 1 TO PCL(Who~%%).Bonus
637.    PCL(Who~%%).Total = PCL(Who~%%).Total + 100
638.    Result% = Result% + 100
639.   NEXT i%%
640.  END IF
641.  '-------------------------------------------------------------------
642.  LowerTotal = Result%
643. END FUNCTION
644.  
645. SUB Reset_SelectedScore (Selected%%, Who~%%, Rules%%)
646.  SELECT CASE Rules%%
647.   CASE STANDARD
648.    SELECT CASE Selected%%
649.     CASE 1 'aces
650.      PCU(Who~%%).Aces = -1
651.     CASE 2 'Duces
652.      PCU(Who~%%).Duces = -1
653.     CASE 3 'Trips
654.      PCU(Who~%%).Trips = -1
655.     CASE 4 'quads
656.      PCU(Who~%%).Quads = -1
657.     CASE 5 'quinc
658.      PCU(Who~%%).Quinc = -1
659.     CASE 6 'sexte
660.      PCU(Who~%%).Sexte = -1
661.     CASE 7 '3 of kind
662.      PCL(Who~%%).ThreeOfKind = -1
663.     CASE 8 '4 of kind
664.      PCL(Who~%%).FourOfKind = -1
665.     CASE 9 'full house
666.      PCL(Who~%%).FullHouse = -1
667.     CASE 10 'Small Straight
668.      PCL(Who~%%).SmStraight = -1
669.     CASE 11 'Large Straight
670.      PCL(Who~%%).LgStraight = -1
671.     CASE 12 'Yahtzee
672.      PCL(Who~%%).Yahtzee = -1
673.     CASE 13 'Chance
674.      PCL(Who~%%).Chance = -1
675.    END SELECT
676.  END SELECT
677. END SUB
678.  
679. FUNCTION Return_Local_Rank%% (Score%)
680.  DO
681.   i%% = i%% + 1
682.   IF Local(i%%).Score < Score% THEN Found%% = TRUE: Result%% = i%%
683.  LOOP UNTIL Found%%
684.  Return_Local_Rank = Result%%
685. END FUNCTION
686.  
687. FUNCTION Return_Online_Rank~%% (Score%)
688.  DO
689.   i~%% = i~%% + 1
690.   IF Online(i~%%).Score < Score% THEN Found~%% = TRUE: Result~%% = i~%%
691.  LOOP UNTIL Found~%%
692.  Return_Online_Rank = Result~%%
693. END FUNCTION
694.  
695. FUNCTION Set_SelectedScore%% (Selected%%, Who~%%, Rules%%)
696.  Result%% = FALSE
697.  SELECT CASE Rules%%
698.   CASE STANDARD
699.    SELECT CASE Selected%%
700.     CASE 1 'aces
701.      IF PCU(Who~%%).Aces = -1 THEN
702.       PCU(Who~%%).Aces = Count_Dice%%(ACES)
703.       IF Die_Check = 7 AND PCL(Who~%%).Yahtzee > 0 THEN 'the bonus Yahtzee check
704.        IF G.Rule_Set = STANDARD AND PCL(Who~%%).Bonus = 0 THEN
705.         PCL(Who~%%).Bonus = 1
706.        ELSEIF G.Rule_Set = LITE THEN
707.         PCL(Who~%%).Bonus = PCL(Who~%%).Bonus + 1
708.        END IF
709.       END IF
710.       Result%% = TRUE
711.      END IF
712.     CASE 2 'Duces
713.      IF PCU(Who~%%).Duces = -1 THEN
714.       PCU(Who~%%).Duces = Count_Dice%%(DUCES)
715.       IF Die_Check = 7 AND PCL(Who~%%).Yahtzee > 0 THEN 'the bonus Yahtzee check
716.        IF G.Rule_Set = STANDARD AND PCL(Who~%%).Bonus = 0 THEN
717.         PCL(Who~%%).Bonus = 1
718.        ELSEIF G.Rule_Set = LITE THEN
719.         PCL(Who~%%).Bonus = PCL(Who~%%).Bonus + 1
720.        END IF
721.       END IF
722.       Result%% = TRUE
723.      END IF
724.     CASE 3 'Trips
725.      IF PCU(Who~%%).Trips = -1 THEN
726.       PCU(Who~%%).Trips = Count_Dice%%(TRIPS)
727.       IF Die_Check = 7 AND PCL(Who~%%).Yahtzee > 0 THEN 'the bonus Yahtzee check
728.        IF G.Rule_Set = STANDARD AND PCL(Who~%%).Bonus = 0 THEN
729.         PCL(Who~%%).Bonus = 1
730.        ELSEIF G.Rule_Set = LITE THEN
731.         PCL(Who~%%).Bonus = PCL(Who~%%).Bonus + 1
732.        END IF
733.       END IF
734.       Result%% = TRUE
735.      END IF
736.     CASE 4 'quads
737.      IF PCU(Who~%%).Quads = -1 THEN
738.       PCU(Who~%%).Quads = Count_Dice%%(QUADS)
739.       IF Die_Check = 7 AND PCL(Who~%%).Yahtzee > 0 THEN 'the bonus Yahtzee check
740.        IF G.Rule_Set = STANDARD AND PCL(Who~%%).Bonus = 0 THEN
741.         PCL(Who~%%).Bonus = 1
742.        ELSEIF G.Rule_Set = LITE THEN
743.         PCL(Who~%%).Bonus = PCL(Who~%%).Bonus + 1
744.        END IF
745.       END IF
746.       Result%% = TRUE
747.      END IF
748.     CASE 5 'quinc
749.      IF PCU(Who~%%).Quinc = -1 THEN
750.       PCU(Who~%%).Quinc = Count_Dice%%(QUINC)
751.       IF Die_Check = 7 AND PCL(Who~%%).Yahtzee > 0 THEN 'the bonus Yahtzee check
752.        IF G.Rule_Set = STANDARD AND PCL(Who~%%).Bonus = 0 THEN
753.         PCL(Who~%%).Bonus = 1
754.        ELSEIF G.Rule_Set = LITE THEN
755.         PCL(Who~%%).Bonus = PCL(Who~%%).Bonus + 1
756.        END IF
757.       END IF
758.       Result%% = TRUE
759.      END IF
760.     CASE 6 'sexte
761.      IF PCU(Who~%%).Sexte = -1 THEN
762.       PCU(Who~%%).Sexte = Count_Dice%%(SEXTE)
763.       IF Die_Check = 7 AND PCL(Who~%%).Yahtzee > 0 THEN 'the bonus Yahtzee check
764.        IF G.Rule_Set = STANDARD AND PCL(Who~%%).Bonus = 0 THEN
765.         PCL(Who~%%).Bonus = 1
766.        ELSEIF G.Rule_Set = LITE THEN
767.         PCL(Who~%%).Bonus = PCL(Who~%%).Bonus + 1
768.        END IF
769.       END IF
770.       Result%% = TRUE
771.      END IF
772.  
773.     CASE 7 '3 of kind
774.      'condition is met 4 ways, 3 of kind, 4 of kind, full house and yahtzee
775.      IF PCL(Who~%%).ThreeOfKind = -1 THEN
776.       IF Die_Check >= 3 AND Die_Check <= 6 THEN
777.        Result%% = TRUE
778.        PCL(Who~%%).ThreeOfKind = 0
779.        FOR i%% = 1 TO 5
780.         PCL(Who~%%).ThreeOfKind = PCL(Who~%%).ThreeOfKind + DieArray(i%%).Value
781.        NEXT i%%
782.       ELSEIF Die_Check = 7 AND PCL(Who~%%).Yahtzee > 0 THEN
783.        IF G.Rule_Set = STANDARD AND PCL(Who~%%).Bonus = 0 THEN
784.         Result%% = TRUE
785.         PCL(Who~%%).ThreeOfKind = 0
786.         FOR i%% = 1 TO 5
787.          PCL(Who~%%).ThreeOfKind = PCL(Who~%%).ThreeOfKind + DieArray(i%%).Value
788.         NEXT i%%
789.         PCL(Who~%%).Bonus = PCL(Who~%%).Bonus + 1
790.        ELSEIF G.Rule_Set = LITE THEN
791.         Result%% = TRUE
792.         PCL(Who~%%).ThreeOfKind = 0
793.         FOR i%% = 1 TO 5
794.          PCL(Who~%%).ThreeOfKind = PCL(Who~%%).ThreeOfKind + DieArray(i%%).Value
795.         NEXT i%%
796.         PCL(Who~%%).Bonus = PCL(Who~%%).Bonus + 1
797.        END IF
798.       ELSE
799.        Result%% = TRUE
800.        PCL(Who~%%).ThreeOfKind = 0
801.       END IF
802.      END IF
803.  
804.     CASE 8 '4 of kind
805.      'condition is met with 4 of a kind or yahtzee
806.      IF PCL(Who~%%).FourOfKind = -1 THEN
807.       IF Die_Check = 6 THEN
808.        Result%% = TRUE
809.        PCL(Who~%%).FourOfKind = 0
810.        FOR i%% = 1 TO 5
811.         PCL(Who~%%).FourOfKind = PCL(Who~%%).FourOfKind + DieArray(i%%).Value
812.        NEXT i%%
813.       ELSEIF Die_Check = 7 AND PCL(Who~%%).Yahtzee > 0 THEN
814.        IF G.Rule_Set = STANDARD AND PCL(Who~%%).Bonus = 0 THEN
815.         Result%% = TRUE
816.         PCL(Who~%%).FourOfKind = 0
817.         FOR i%% = 1 TO 5
818.          PCL(Who~%%).FourOfKind = PCL(Who~%%).FourOfKind + DieArray(i%%).Value
819.         NEXT i%%
820.         PCL(Who~%%).Bonus = PCL(Who~%%).Bonus + 1
821.        ELSEIF G.Rule_Set = LITE THEN
822.         Result%% = TRUE
823.         PCL(Who~%%).FourOfKind = 0
824.         FOR i%% = 1 TO 5
825.          PCL(Who~%%).FourOfKind = PCL(Who~%%).FourOfKind + DieArray(i%%).Value
826.         NEXT i%%
827.         PCL(Who~%%).Bonus = PCL(Who~%%).Bonus + 1
828.        END IF
829.       ELSE
830.        Result%% = TRUE
831.        PCL(Who~%%).FourOfKind = 0
832.       END IF
833.      END IF
834.  
835.     CASE 9 'full house
836.      IF PCL(Who~%%).FullHouse = -1 THEN
837.       IF Die_Check = 5 THEN
838.        Result%% = TRUE
839.        PCL(Who~%%).FullHouse = 25
840.       ELSEIF Die_Check = 7 AND PCL(Who~%%).Yahtzee > 0 THEN
841.        IF G.Rule_Set = STANDARD AND PCL(Who~%%).Bonus = 0 THEN
842.         Result%% = TRUE
843.         PCL(Who~%%).FullHouse = 25
844.         PCL(Who~%%).Bonus = PCL(Who~%%).Bonus + 1
845.        ELSEIF G.Rule_Set = LITE THEN
846.         Result%% = TRUE
847.         PCL(Who~%%).FullHouse = 25
848.         PCL(Who~%%).Bonus = PCL(Who~%%).Bonus + 1
849.        END IF
850.       ELSE
851.        Result%% = TRUE
852.        PCL(Who~%%).FullHouse = 0
853.       END IF
854.      END IF
855.  
856.     CASE 10 'Small Straight
857.      IF PCL(Who~%%).SmStraight = -1 THEN
858.       IF Die_Check = 9 OR Die_Check = 8 THEN 'check for long as well, if you have a long straight automatically have a short.
859.        Result%% = TRUE
860.        PCL(Who~%%).SmStraight = 30
861.       ELSEIF Die_Check = 7 AND PCL(Who~%%).Yahtzee > 0 THEN
862.        IF G.Rule_Set = STANDARD AND PCL(Who~%%).Bonus = 0 THEN
863.         Result%% = TRUE
864.         PCL(Who~%%).SmStraight = 30
865.         PCL(Who~%%).Bonus = PCL(Who~%%).Bonus + 1
866.        ELSEIF G.Rule_Set = LITE THEN
867.         Result%% = TRUE
868.         PCL(Who~%%).SmStraight = 30
869.         PCL(Who~%%).Bonus = PCL(Who~%%).Bonus + 1
870.        END IF
871.       ELSE
872.        Result%% = TRUE
873.        PCL(Who~%%).SmStraight = 0
874.       END IF
875.      END IF
876.  
877.     CASE 11 'Large Straight
878.      IF PCL(Who~%%).LgStraight THEN
879.       IF Die_Check = 8 THEN
880.        Result%% = TRUE
881.        PCL(Who~%%).LgStraight = 40
882.       ELSEIF Die_Check = 7 AND PCL(Who~%%).Yahtzee > 0 THEN
883.        IF G.Rule_Set = STANDARD AND PCL(Who~%%).Bonus = 0 THEN
884.         Result%% = TRUE
885.         PCL(Who~%%).LgStraight = 40
886.         PCL(Who~%%).Bonus = PCL(Who~%%).Bonus + 1
887.        ELSEIF G.Rule_Set = LITE THEN
888.         Result%% = TRUE
889.         PCL(Who~%%).LgStraight = 40
890.         PCL(Who~%%).Bonus = PCL(Who~%%).Bonus + 1
891.        END IF
892.       ELSE
893.        Result%% = TRUE
894.        PCL(Who~%%).LgStraight = 0
895.       END IF
896.      END IF
897.  
898.     CASE 12 'Yahtzee
899.      IF PCL(Who~%%).Yahtzee = -1 THEN
900.       IF Die_Check = 7 THEN
901.        Result%% = TRUE
902.        PCL(Who~%%).Yahtzee = 50
903.       ELSE
904.        Result%% = TRUE
905.        PCL(Who~%%).Yahtzee = 0
906.       END IF
907.      END IF
908.  
909.     CASE 13 'Chance
910.      IF PCL(Who~%%).Chance = -1 THEN
911.       Result%% = TRUE
912.       PCL(Who~%%).Chance = 0
913.       FOR i%% = 1 TO 6
914.        PCL(Who~%%).Chance = PCL(Who~%%).Chance + Count_Dice%%(i%%)
915.       NEXT
916.       IF Die_Check = 7 AND PCL(Who~%%).Yahtzee > 0 THEN
917.        IF G.Rule_Set = STANDARD AND PCL(Who~%%).Bonus = 0 THEN
918.         PCL(Who~%%).Bonus = PCL(Who~%%).Bonus + 1
919.        ELSEIF G.Rule_Set = LITE THEN
920.         PCL(Who~%%).Bonus = PCL(Who~%%).Bonus + 1
921.        END IF
922.       END IF
923.      END IF
924.    END SELECT
925.  END SELECT
926.  Set_SelectedScore = Result%%
927. END FUNCTION
928.  
929. FUNCTION UpperTotal~%% (Who~%%)
930.  IF PCU(Who~%%).Aces >= 0 THEN Result~%% = PCU(Who~%%).Aces
931.  IF PCU(Who~%%).Duces >= 0 THEN Result~%% = Result~%% + PCU(Who~%%).Duces
932.  IF PCU(Who~%%).Trips >= 0 THEN Result~%% = Result~%% + PCU(Who~%%).Trips
933.  IF PCU(Who~%%).Quads >= 0 THEN Result~%% = Result~%% + PCU(Who~%%).Quads
934.  IF PCU(Who~%%).Quinc >= 0 THEN Result~%% = Result~%% + PCU(Who~%%).Quinc
935.  IF PCU(Who~%%).Sexte >= 0 THEN Result~%% = Result~%% + PCU(Who~%%).Sexte
936.  'go ahead and calculate grand total for upper as we go.-------------
937.  PCU(Who~%%).Total = Result~%%
938.  IF Result~%% >= 63 THEN PCU(Who~%%).Total = PCU(Who~%%).Total + 35
939.  '-------------------------------------------------------------------
940.  UpperTotal = Result~%%
941. END FUNCTION
942.  
943. FUNCTION Show_Upper_Card%% (Who~%%)
944.  SELECT CASE G.Rule_Set
945.   CASE STANDARD
946.    Create_ClickLayer 1
947.  
948.    DO
949.     Display_UpperCard 0, 0, 1, Who~%%
950.     _PUTIMAGE , Layer(1), Layer(0)
951.     Selection%% = Check_ClickBox(_MOUSEX, _MOUSEY)
952.     LOCATE 1, 1: PRINT Selection%%; Clicked%%
953.     IF _MOUSEBUTTON(1) THEN
954.      IF Clicked%% = 0 THEN
955.       SELECT CASE Selection%%
956.        CASE 1
957.         IF Set_SelectedScore(ACES, Who~%%, G.Rule_Set) THEN Clicked%% = 1: G.SetValues = _SETBIT(G.SetValues, 0)
958.        CASE 2
959.         IF Set_SelectedScore(DUCES, Who~%%, G.Rule_Set) THEN Clicked%% = 2: G.SetValues = _SETBIT(G.SetValues, 1)
960.        CASE 3
961.         IF Set_SelectedScore(TRIPS, Who~%%, G.Rule_Set) THEN Clicked%% = 3: G.SetValues = _SETBIT(G.SetValues, 2)
962.        CASE 4
963.         IF Set_SelectedScore(QUADS, Who~%%, G.Rule_Set) THEN Clicked%% = 4: G.SetValues = _SETBIT(G.SetValues, 3)
964.        CASE 5
965.         IF Set_SelectedScore(QUINC, Who~%%, G.Rule_Set) THEN Clicked%% = 5: G.SetValues = _SETBIT(G.SetValues, 4)
966.        CASE 6
967.         IF Set_SelectedScore(SEXTE, Who~%%, G.Rule_Set) THEN Clicked%% = 6: G.SetValues = _SETBIT(G.SetValues, 5)
968.       END SELECT
969.      END IF
970.      'if player clicks accept make sure they have selected a scoring location
971.      IF Selection%% = 7 AND Clicked%% > 0 THEN Result%% = -2: ExitFlag%% = TRUE
972.      IF Selection%% = 8 THEN 'resets selection
973.       Reset_SelectedScore Clicked%%, Who~%%, G.Rule_Set
974.       G.SetValues = _RESETBIT(G.SetValues, Clicked%% - 1)
975.       Clicked%% = FALSE
976.      END IF
977.      IF Selection%% = 9 THEN
978.       Result%% = TRUE: ExitFlag%% = TRUE 'hits cancel
979.       Reset_SelectedScore Clicked%%, Who~%%, G.Rule_Set
980.       G.SetValues = _RESETBIT(G.SetValues, Clicked%% - 1)
981.       Clicked%% = FALSE
982.      END IF
983.      IF Selection%% = 10 THEN
984.       Result%% = 1: ExitFlag%% = TRUE 'switch to lower card
985.       Reset_SelectedScore Clicked%%, Who~%%, G.Rule_Set
986.       G.SetValues = _RESETBIT(G.SetValues, Clicked%% - 1)
987.       Clicked%% = FALSE
988.      END IF
989.      Button_Down_Lock 'hold program while button is down to help prevent 'skipping'
990.     END IF
991.     DO: LOOP WHILE _MOUSEINPUT
992.  
993.     _LIMIT 30
994.     IF INKEY$ = CHR$(27) THEN ExitFlag%% = TRUE: Result%% = TRUE
995.    LOOP UNTIL ExitFlag%%
996.  END SELECT
997.  Create_ClickLayer 0
998.  Show_Upper_Card = Result%%
999.  ClearLayer Layer(1)
1000. END FUNCTION
1001.  
1002. FUNCTION Show_Lower_Card%% (Who~%%)
1003.  SELECT CASE G.Rule_Set
1004.   CASE STANDARD
1005.    Create_ClickLayer 2
1006.    DO
1007.     Display_LowerCard 0, 0, 1, Who~%%
1008.     _PUTIMAGE , Layer(1), Layer(0)
1009.     Selection%% = Check_ClickBox(_MOUSEX, _MOUSEY)
1010.     LOCATE 1, 1: PRINT Selection%%; Clicked%%
1011.     IF _MOUSEBUTTON(1) THEN
1012.      IF Clicked%% = 0 AND G.Current_Roll > 0 THEN
1013.       SELECT CASE Selection%%
1014.        CASE 1
1015.         IF Set_SelectedScore(THREEOFKIND, Who~%%, G.Rule_Set) THEN Clicked%% = 7: G.SetValues = _SETBIT(G.SetValues, 7)
1016.        CASE 2
1017.         IF Set_SelectedScore(FOUROFKIND, Who~%%, G.Rule_Set) THEN Clicked%% = 8: G.SetValues = _SETBIT(G.SetValues, 8)
1018.        CASE 3
1019.         IF Set_SelectedScore(FULLHOUSE, Who~%%, G.Rule_Set) THEN Clicked%% = 9: G.SetValues = _SETBIT(G.SetValues, 9)
1020.        CASE 4
1021.         IF Set_SelectedScore(SMSTRAIGHT, Who~%%, G.Rule_Set) THEN Clicked%% = 10: G.SetValues = _SETBIT(G.SetValues, 10)
1022.        CASE 5
1023.         IF Set_SelectedScore(LGSTRAIGHT, Who~%%, G.Rule_Set) THEN Clicked%% = 11: G.SetValues = _SETBIT(G.SetValues, 11)
1024.        CASE 6
1025.         IF Set_SelectedScore(YAHTZEE, Who~%%, G.Rule_Set) THEN Clicked%% = 12: G.SetValues = _SETBIT(G.SetValues, 12)
1026.        CASE 7
1027.         IF Set_SelectedScore(CHANCE, Who~%%, G.Rule_Set) THEN Clicked%% = 13: G.SetValues = _SETBIT(G.SetValues, 13)
1028.       END SELECT
1029.      END IF
1030.      'if player clicks accept make sure they have selected a scoring location
1031.      IF Selection%% = 8 AND Clicked%% > 0 THEN Result%% = -2: ExitFlag%% = TRUE
1032.      IF Selection%% = 9 THEN
1033.       Reset_SelectedScore Clicked%%, Who~%%, G.Rule_Set
1034.       G.SetValues = _RESETBIT(G.SetValues, Clicked%%)
1035.       Clicked%% = 0
1036.      END IF
1037.      IF Selection%% = 10 THEN
1038.       ExitFlag%% = TRUE: Result%% = TRUE 'cancel
1039.       Reset_SelectedScore Clicked%%, Who~%%, G.Rule_Set
1040.       G.SetValues = _RESETBIT(G.SetValues, Clicked%%)
1041.      END IF
1042.      IF Selection%% = 11 THEN
1043.       Result%% = 2: ExitFlag%% = TRUE 'switch to upper card
1044.       Reset_SelectedScore Clicked%%, Who~%%, G.Rule_Set
1045.       G.SetValues = _RESETBIT(G.SetValues, Clicked%%)
1046.       Clicked%% = FALSE
1047.      END IF
1048.      Button_Down_Lock 'hold program while button is down to help prevent 'skipping'
1049.     END IF
1050.     DO: LOOP WHILE _MOUSEINPUT
1051.     _LIMIT 30
1052.     IF INKEY$ = CHR$(27) THEN ExitFlag%% = TRUE: Result%% = TRUE
1053.    LOOP UNTIL ExitFlag%%
1054.  END SELECT
1055.  Create_ClickLayer 0
1056.  Show_Lower_Card = Result%%
1057.  ClearLayer Layer(1)
1058. END FUNCTION
1059.  
1060. SUB Save_Local_Score
1061.  F1 = FREEFILE
1062.  OPEN "LocalYahtzee.SCR" FOR BINARY AS #F1
1063.  GrandTotal% = PCU(Who~%%).Total + PCL(who%%).Total
1064.  
1065.  IF G.FirstGame THEN
1066.   Clear_Scores
1067.   Local(1).Who = Nick(0)
1068.   Local(1).Score = GrandTotal%
1069.   Local(1).Rules = G.Rule_Set
1070.  
1071.   PUT #F1, , Local()
1072.   G.FirstGame = 0
1073.  ELSE
1074.   Start%% = Return_Local_Rank(GrandTotal%) 'where is player being placed in score list
1075.   FOR i%% = 99 TO Start%% STEP -1
1076.    Local(i%% + 1) = Local(i%%)
1077.   NEXT i%%
1078.   Local(Start%%).Who = Nick(0)
1079.   Local(Start%%).Rules = G.Rule_Set
1080.   Local(Start%%).Score = GrandTotal%
1081.   PUT #F1, , Local()
1082.  END IF
1083.  CLOSE #F1
1084. END SUB
1085.  
1086. SUB Sort_Online_Scores
1087.  'simple but slow sort
1088.   FOR i~%% = 1 TO 255
1089.   FOR j~%% = i%% + 1 TO 255
1090.    IF Online(j~%%).Score < Online(i~%%).Score THEN SWAP Online(j~%%), Online(i~%%)
1091.   NEXT j~%%
1092.  NEXT i~%%
1093. END SUB
1094.  
1095. SUB Save_Online_Score
1096.  DIM M AS _MEM
1097.  M = _MEM(Online())
1098.  
1099.  Send Client, "[GAME GET]TestScores.txt" 'the command to get the data back from the server.
1100.  OK$ = Verify$
1101.  IF LEFT$(OK$, 4) = "[OK]" THEN
1102.   'All is good
1103.   DataWeGot$ = MID$(OK$, 5) 'the data is attached after the [OK].  Like this, we got it.
1104.  ELSE
1105.   DisplayError OK$ 'pop up an error message telling us what went wrong.
1106.   END 'However we want to handle an error when trying to put data to the server.
1107.  END IF
1108.  
1109.  _MEMPUT M, M.OFFSET, DataWeGot$
1110.  Online(0).Who = Nick$(0)
1111.  Online(0).Rules = 0
1112.  Online(0).Score = PCU(Who~%%).Total + PCL(who%%).Total
1113.  'bump scores down, oldest score falls off. not too keen on this maybe some day
1114.  'I could adjust the score file to handle a larger number of scores.
1115.  FOR i~%% = 254 TO 0 STEP -1
1116.   Online(i~%% + 1) = Online(i~%%)
1117.  NEXT i~%%
1118.  Online(0).Who = ""
1119.  Online(0).Rules = 0
1120.  Online(0).Score = 0
1121.  
1122.  Temp$ = SPACE$(19 * 255)
1123.  _MEMGET M, M.OFFSET, Temp$
1124.  
1125.  DataToPut$ = Temp$
1126.  'TO PUT INFORMATION TO THE SERVER:
1127.  Send Client, "[GAME PUT]TestScores.TXT" + CHR$(0) + DataToPut$ 'put the data to filename.ext on the server
1128.  OK$ = Verify$
1129.  IF LEFT$(OK$, 4) = "[OK]" THEN
1130.   'All is good
1131.  ELSE
1132.   DisplayError OK$ 'pop up an error message telling us what went wrong.
1133.   END 'However we want to handle an error when trying to put data to the server.
1134.  END IF
1135.  _DELAY .25
1136.  
1137.  _MEMFREE M
1138. END SUB
1139.  
1140. SUB Create_ClickLayer (Scren%%)
1141.  _DEST Layer(4)
1142.  CLS , 0
1143.  SELECT CASE Scren%%
1144.   CASE 0 'main game wscreen
1145.    'shaker cup
1146.    LINE (500, 20)-STEP(90, 118), _RGB32(1, 0, 0), BF
1147.    'upper score card
1148.    LINE (400, 140)-STEP(210, 154), _RGB32(2, 0, 0), BF
1149.    'lower score card
1150.    LINE (400, 295)-STEP(210, 155), _RGB32(3, 0, 0), BF
1151.    'dice
1152.    FOR i%% = 0 TO 4
1153.     LINE (50 + i%% * 60, 50)-STEP(52, 50), _RGB32(4 + i%%, 0, 0), BF
1154.    NEXT i%%
1155.   CASE 1 'upper score card screen
1156.    FOR i%% = 0 TO 5
1157.     LINE (230, 150 + (32 * i%%) + i%%)-STEP(63, 31), _RGB32(1 + i%%, 0, 0), BF
1158.    NEXT i%%
1159.    LINE (465, 128)-STEP(129, 31), _RGB32(7, 0, 0), BF
1160.    LINE (465, 175)-STEP(129, 31), _RGB32(8, 0, 0), BF
1161.    LINE (465, 220)-STEP(129, 31), _RGB32(10, 0, 0), BF
1162.    LINE (465, 264)-STEP(129, 31), _RGB32(9, 0, 0), BF
1163.  
1164.   CASE 2 'lower score card screen
1165.    FOR i%% = 0 TO 6
1166.     LINE (230, 28 + (32 * i%%))-STEP(63, 31), _RGB32(1 + i%%, 0, 0), BF
1167.    NEXT i%%
1168.    LINE (475, 38)-STEP(129, 31), _RGB32(8, 0, 0), BF
1169.    LINE (475, 85)-STEP(129, 31), _RGB32(9, 0, 0), BF
1170.    LINE (475, 130)-STEP(129, 31), _RGB32(11, 0, 0), BF
1171.    LINE (475, 174)-STEP(129, 31), _RGB32(10, 0, 0), BF
1172.   CASE 3 'main menu
1173.    LINE (220, 336)-STEP(180, 20), _RGB32(1, 0, 0), BF
1174.    LINE (220, 357)-STEP(180, 22), _RGB32(2, 0, 0), BF
1175.    LINE (220, 380)-STEP(180, 21), _RGB32(3, 0, 0), BF
1176.    LINE (220, 403)-STEP(180, 21), _RGB32(4, 0, 0), BF
1177.    LINE (220, 426)-STEP(180, 22), _RGB32(5, 0, 0), BF
1178.    LINE (220, 450)-STEP(180, 28), _RGB32(6, 0, 0), BF
1179.   CASE 4 'Nick name selection screen
1180.    FOR i%% = 0 TO 1
1181.     FOR j%% = 0 TO 12
1182.      C%% = C%% + 1
1183.      LINE (85 + 35 * j%% + j%%, 158 + 50 * i%%)-STEP(19, 25), _RGB32(C%%, 0, 0), BF
1184.     NEXT j%%
1185.    NEXT i%%
1186.    FOR j%% = 0 TO 11
1187.     C%% = C%% + 1
1188.     LINE (85 + 35 * j%% + j%%, 158 + 50 * i%%)-STEP(19, 25), _RGB32(C%%, 0, 0), BF
1189.    NEXT j%%
1190.    LINE (190, 308)-STEP(80, 25), _RGB32(63, 0, 0), BF
1191.    LINE (370, 308)-STEP(80, 25), _RGB32(64, 0, 0), BF
1192.  
1193.  END SELECT
1194.  _DEST Layer(0)
1195. END SUB
1196.  
1197. SUB Display_Dice (X%, Y%)
1198.  FOR i%% = 0 TO 4
1199.   IF DieArray(i%% + 1).Locked = FALSE THEN
1200.    _PUTIMAGE (X% + i%% * 60, Y%)-STEP(52, 50), Layer(8), Layer(1), (23 + DieArray(i%% + 1).Value * 54, 0)-STEP(52, 50)
1201.   ELSE
1202.    _PUTIMAGE (X% + i%% * 60, Y%)-STEP(52, 50), Layer(8), Layer(1), (23 + DieArray(i%% + 1).Value * 54, 55)-STEP(52, 50)
1203.   END IF
1204.  NEXT i%%
1205. END SUB
1206.  
1207. SUB Draw_GameMat (L&)
1208.  _DEST L&
1209.  LINE (18, 22)-STEP(604, 436), _RGB32(8, 72, 32), BF
1210.  LINE (22, 18)-STEP(596, 444), _RGB32(8, 72, 32), BF
1211.  LINE (19, 21)-STEP(602, 438), _RGB32(16, 96, 40), BF
1212.  LINE (21, 19)-STEP(598, 442), _RGB32(16, 96, 40), BF
1213.  LINE (20, 20)-STEP(600, 440), _RGB32(24, 128, 52), BF
1214.  _DEST Layer(0)
1215. END SUB
1216.  
1217. SUB Display_UpperCard (X%, Y%, Scale!, Who~%%)
1218.  _DEST Layer(10)
1219.  COLOR _RGB32(0, 0, 0)
1220.  _PUTIMAGE , Layer(2), Layer(10)
1221.  Display_UpperScores Layer(10), Who~%%
1222.  _PUTIMAGE (X%, Y%)-STEP(639 * Scale!, 474 * Scale!), Layer(10), Layer(1)
1223.  COLOR _RGB32(255, 255, 255)
1224.  _DEST Layer(0)
1225. END SUB
1226.  
1227. SUB Display_LowerCard (X%, Y%, Scale!, Who~%%)
1228.  _DEST Layer(10)
1229.  COLOR _RGB32(0, 0, 0)
1230.  _PUTIMAGE , Layer(3), Layer(10)
1231.  Display_LowerScores Layer(10), Who~%%
1232.  _PUTIMAGE (X%, Y%)-STEP(639 * Scale!, 474 * Scale!), Layer(10), Layer(1)
1233.  COLOR _RGB32(255, 255, 255)
1234.  _DEST Layer(0)
1235. END SUB
1236.  
1237. SUB Display_UpperScores (L&, Who~%%)
1238.  SELECT CASE G.Rule_Set
1239.   CASE STANDARD
1240.    _PRINTSTRING (363, 15), Nick(Who~%%), L&
1241.    IF PCU(Who~%%).Aces >= 0 THEN _PRINTSTRING (260 - 12 * (LEN(LTRIM$(STR$(PCU(Who~%%).Aces))) / 1.6), 157), LTRIM$(STR$(PCU(Who~%%).Aces)), L&
1242.    IF PCU(Who~%%).Duces >= 0 THEN _PRINTSTRING (260 - 12 * (LEN(LTRIM$(STR$(PCU(Who~%%).Duces))) / 1.6), 190), LTRIM$(STR$(PCU(Who~%%).Duces)), L&
1243.    IF PCU(Who~%%).Trips >= 0 THEN _PRINTSTRING (260 - 12 * (LEN(LTRIM$(STR$(PCU(Who~%%).Trips))) / 1.6), 223), LTRIM$(STR$(PCU(Who~%%).Trips)), L&
1244.    IF PCU(Who~%%).Quads >= 0 THEN _PRINTSTRING (260 - 12 * (LEN(LTRIM$(STR$(PCU(Who~%%).Quads))) / 1.6), 258), LTRIM$(STR$(PCU(Who~%%).Quads)), L&
1245.    IF PCU(Who~%%).Quinc >= 0 THEN _PRINTSTRING (260 - 12 * (LEN(LTRIM$(STR$(PCU(Who~%%).Quinc))) / 1.6), 291), LTRIM$(STR$(PCU(Who~%%).Quinc)), L&
1246.    IF PCU(Who~%%).Sexte >= 0 THEN _PRINTSTRING (260 - 12 * (LEN(LTRIM$(STR$(PCU(Who~%%).Sexte))) / 1.6), 326), LTRIM$(STR$(PCU(Who~%%).Sexte)), L&
1247.    _PRINTSTRING (260 - 12 * (LEN(LTRIM$(STR$(UpperTotal(Who~%%)))) / 1.6), 370), LTRIM$(STR$(UpperTotal(Who~%%))), L&
1248.    IF UpperTotal(Who~%%) >= 63 THEN _PRINTSTRING (260 - 12 * (LEN(LTRIM$(STR$(35))) / 1.6), 405), LTRIM$(STR$(35)), L&
1249.    IF G.Upper_Filled THEN _PRINTSTRING (260 - 12 * (LEN(LTRIM$(STR$(PCU(Who~%%).Total))) / 1.6), 438), LTRIM$(STR$(PCU(Who~%%).Total)), L&
1250.  END SELECT
1251. END SUB
1252.  
1253. SUB Display_LowerScores (L&, Who~%%)
1254.  SELECT CASE G.Rule_Set
1255.   CASE STANDARD
1256.    IF PCL(Who~%%).ThreeOfKind >= 0 THEN _PRINTSTRING (260 - 12 * (LEN(LTRIM$(STR$(PCL(Who~%%).ThreeOfKind))) / 1.6), 34), LTRIM$(STR$(PCL(Who~%%).ThreeOfKind)), L&
1257.    IF PCL(Who~%%).FourOfKind >= 0 THEN _PRINTSTRING (260 - 12 * (LEN(LTRIM$(STR$(PCL(Who~%%).FourOfKind))) / 1.6), 67), LTRIM$(STR$(PCL(Who~%%).FourOfKind)), L&
1258.    IF PCL(Who~%%).FullHouse >= 0 THEN _PRINTSTRING (260 - 12 * (LEN(LTRIM$(STR$(PCL(Who~%%).FullHouse))) / 1.6), 101), LTRIM$(STR$(PCL(Who~%%).FullHouse)), L&
1259.    IF PCL(Who~%%).SmStraight >= 0 THEN _PRINTSTRING (260 - 12 * (LEN(LTRIM$(STR$(PCL(Who~%%).SmStraight))) / 1.6), 134), LTRIM$(STR$(PCL(Who~%%).SmStraight)), L&
1260.    IF PCL(Who~%%).LgStraight >= 0 THEN _PRINTSTRING (260 - 12 * (LEN(LTRIM$(STR$(PCL(Who~%%).LgStraight))) / 1.6), 165), LTRIM$(STR$(PCL(Who~%%).LgStraight)), L&
1261.    IF PCL(Who~%%).Yahtzee >= 0 THEN _PRINTSTRING (260 - 12 * (LEN(LTRIM$(STR$(PCL(Who~%%).Yahtzee))) / 1.6), 199), LTRIM$(STR$(PCL(Who~%%).Yahtzee)), L&
1262.    IF PCL(Who~%%).Chance >= 0 THEN _PRINTSTRING (260 - 12 * (LEN(LTRIM$(STR$(PCL(Who~%%).Chance))) / 1.6), 232), LTRIM$(STR$(PCL(Who~%%).Chance)), L&
1263.    IF PCL(Who~%%).Bonus > 0 THEN _PRINTSTRING (300, 199), "100x" + LTRIM$(STR$(PCL(Who~%%).Bonus)), L&
1264.    _PRINTSTRING (260 - 12 * (LEN(LTRIM$(STR$(LowerTotal(Who~%%)))) / 1.6), 265), LTRIM$(STR$(LowerTotal(Who~%%))), L&
1265.    '   _PRINTSTRING (260 - 12 * (LEN(LTRIM$(STR$(UpperTotal(Who~%%)))) / 1.6), 298), LTRIM$(STR$(UpperTotal(Who~%%))), L&
1266.    _PRINTSTRING (260 - 12 * (LEN(LTRIM$(STR$(PCU(Who~%%).Total))) / 1.6), 298), LTRIM$(STR$(PCU(Who~%%).Total)), L&
1267.    GrandTotal% = PCU(Who~%%).Total + PCL(who%%).Total
1268.    IF GrandTotal% > 0 THEN _PRINTSTRING (260 - 12 * (LEN(LTRIM$(STR$(GrandTotal%))) / 1.6), 330), LTRIM$(STR$(GrandTotal%)), L&
1269.  END SELECT
1270. END SUB
1271.  
1272. SUB End_Score (Who~%%)
1273.  _PRINTMODE _KEEPBACKGROUND , Layer(13)
1274.  CLS
1275.  _PUTIMAGE , Layer(12), Layer(13)
1276.  'fill in card
1277.  _FONT FFX&, Layer(13)
1278.  _DEST Layer(13)
1279.  COLOR _RGB32(16)
1280.  _DEST Layer(0)
1281.  IF PCU(Who~%%).Aces >= 0 THEN _PRINTSTRING (260 - 12 * (LEN(LTRIM$(STR$(PCU(Who~%%).Aces))) / 1.6), 16), LTRIM$(STR$(PCU(Who~%%).Aces)), Layer(13)
1282.  IF PCU(Who~%%).Duces >= 0 THEN _PRINTSTRING (260 - 12 * (LEN(LTRIM$(STR$(PCU(Who~%%).Duces))) / 1.6), 50), LTRIM$(STR$(PCU(Who~%%).Duces)), Layer(13)
1283.  IF PCU(Who~%%).Trips >= 0 THEN _PRINTSTRING (260 - 12 * (LEN(LTRIM$(STR$(PCU(Who~%%).Trips))) / 1.6), 84), LTRIM$(STR$(PCU(Who~%%).Trips)), Layer(13)
1284.  IF PCU(Who~%%).Quads >= 0 THEN _PRINTSTRING (260 - 12 * (LEN(LTRIM$(STR$(PCU(Who~%%).Quads))) / 1.6), 118), LTRIM$(STR$(PCU(Who~%%).Quads)), Layer(13)
1285.  IF PCU(Who~%%).Quinc >= 0 THEN _PRINTSTRING (260 - 12 * (LEN(LTRIM$(STR$(PCU(Who~%%).Quinc))) / 1.6), 152), LTRIM$(STR$(PCU(Who~%%).Quinc)), Layer(13)
1286.  IF PCU(Who~%%).Sexte >= 0 THEN _PRINTSTRING (260 - 12 * (LEN(LTRIM$(STR$(PCU(Who~%%).Sexte))) / 1.6), 186), LTRIM$(STR$(PCU(Who~%%).Sexte)), Layer(13)
1287.  IF UpperTotal(Who~%%) >= 63 THEN _PRINTSTRING (260 - 12 * (LEN(LTRIM$(STR$(35))) / 1.6), 221), LTRIM$(STR$(35)), Layer(13)
1288.  
1289.  IF PCL(Who~%%).ThreeOfKind >= 0 THEN _PRINTSTRING (260 - 12 * (LEN(LTRIM$(STR$(PCL(Who~%%).ThreeOfKind))) / 1.6), 254), LTRIM$(STR$(PCL(Who~%%).ThreeOfKind)), Layer(13)
1290.  IF PCL(Who~%%).FourOfKind >= 0 THEN _PRINTSTRING (260 - 12 * (LEN(LTRIM$(STR$(PCL(Who~%%).FourOfKind))) / 1.6), 288), LTRIM$(STR$(PCL(Who~%%).FourOfKind)), Layer(13)
1291.  IF PCL(Who~%%).FullHouse >= 0 THEN _PRINTSTRING (260 - 12 * (LEN(LTRIM$(STR$(PCL(Who~%%).FullHouse))) / 1.6), 320), LTRIM$(STR$(PCL(Who~%%).FullHouse)), Layer(13)
1292.  IF PCL(Who~%%).SmStraight >= 0 THEN _PRINTSTRING (260 - 12 * (LEN(LTRIM$(STR$(PCL(Who~%%).SmStraight))) / 1.6), 354), LTRIM$(STR$(PCL(Who~%%).SmStraight)), Layer(13)
1293.  IF PCL(Who~%%).LgStraight >= 0 THEN _PRINTSTRING (260 - 12 * (LEN(LTRIM$(STR$(PCL(Who~%%).LgStraight))) / 1.6), 386), LTRIM$(STR$(PCL(Who~%%).LgStraight)), Layer(13)
1294.  IF PCL(Who~%%).Yahtzee >= 0 THEN _PRINTSTRING (260 - 12 * (LEN(LTRIM$(STR$(PCL(Who~%%).Yahtzee))) / 1.6), 418), LTRIM$(STR$(PCL(Who~%%).Yahtzee)), Layer(13)
1295.  IF PCL(Who~%%).Chance >= 0 THEN _PRINTSTRING (260 - 12 * (LEN(LTRIM$(STR$(PCL(Who~%%).Chance))) / 1.6), 450), LTRIM$(STR$(PCL(Who~%%).Chance)), Layer(13)
1296.  
1297.  IF PCL(Who~%%).Bonus > 0 THEN _PRINTSTRING (165, 482), LTRIM$(STR$(PCL(Who~%%).Bonus)), Layer(13): _PRINTSTRING (250 - 12 * (LEN(LTRIM$(STR$(PCL(Who~%%).Bonus * 100))) / 1.6), 482), LTRIM$(STR$(PCL(Who~%%).Bonus * 100)), Layer(13)
1298.  
1299.  _PRINTSTRING (254 - 12 * (LEN(LTRIM$(STR$(LowerTotal(Who~%%)))) / 1.6), 517), LTRIM$(STR$(LowerTotal(Who~%%))), Layer(13)
1300.  _PRINTSTRING (258 - 12 * (LEN(LTRIM$(STR$(PCU(Who~%%).Total))) / 1.6), 549), LTRIM$(STR$(PCU(Who~%%).Total)), Layer(13)
1301.  GrandTotal% = PCU(Who~%%).Total + PCL(who%%).Total
1302.  _PRINTSTRING (254 - 12 * (LEN(LTRIM$(STR$(GrandTotal%))) / 1.6), 581), LTRIM$(STR$(GrandTotal%)), Layer(13)
1303.  
1304.  _PUTIMAGE (0, 0)-STEP(296, 479), Layer(13), Layer(0)
1305.  
1306.  _FONT 16
1307.  ' COLOR _RGB32(255)
1308.  'display top 5 scores
1309.  IF NOT G.FirstGame THEN _PRINTSTRING (360, 0), "Gameover, Good Job." ELSE _PRINTSTRING (300, 0), "Congradulations on playing the first Game!"
1310.  COLOR _RGB32(160, 124, 32)
1311.  _PRINTSTRING (400, 20), "Top 5 Local"
1312.  COLOR _RGB32(255)
1313.  _PRINTSTRING (310, 38), "   Name                Rules      Score"
1314.  
1315.  LINE (305, 54)-STEP(320, 3), _RGB32(212, 212, 60), BF
1316.  
1317.  FOR i%% = 1 TO 5
1318.   _PRINTSTRING (310, 44 + 18 * i%%), "#" + LTRIM$(STR$(i%%)) + "-" + RTRIM$(Local(i%%).Who) + SPACE$(32 - LEN(RTRIM$(Local(i%%).Who))) + LTRIM$(STR$(Local(i%%).Score))
1319.   IF Local(i%%).Rules = 2 THEN _PRINTSTRING (500, 44 + 18 * i%%), "Lite" ELSE _PRINTSTRING (500, 44 + 18 * i%%), "Base"
1320.  
1321.  NEXT i%%
1322.  COLOR _RGB32(212, 200, 48)
1323.  _PRINTSTRING (400, 48 + 18 * i%%), "Your Ranking"
1324.  COLOR _RGB32(255)
1325.  
1326.  IF G.FirstGame THEN
1327.   _PRINTSTRING (310, 48 + 18 * (i%% + 1)), "#1-" + RTRIM$(Nick(Who~%%)) + SPACE$(32 - LEN(RTRIM$(Nick(Who~%%)))) + LTRIM$(STR$(GrandTotal%))
1328.   IF Local(i%%).Rules = 2 THEN _PRINTSTRING (500, 48 + 18 * (i%% + 1)), "Lite" ELSE _PRINTSTRING (500, 48 + 18 * (i%% + 1)), "Base"
1329.  ELSE
1330.   _PRINTSTRING (310, 48 + 18 * (i%% + 1)), "#" + LTRIM$(STR$(Return_Local_Rank(GrandTotal%))) + "-" + RTRIM$(Nick(Who~%%)) + SPACE$(32 - LEN(RTRIM$(Nick(Who~%%)))) + LTRIM$(STR$(GrandTotal%))
1331.   IF Local(i%%).Rules = 2 THEN _PRINTSTRING (500, 48 + 18 * (i%% + 1)), "Lite" ELSE _PRINTSTRING (500, 48 + 18 * (i%% + 1)), "Base"
1332.  END IF
1333.  
1334.  COLOR _RGB32(60, 192, 32)
1335.  IF G.Connected THEN
1336.   _PRINTSTRING (400, 216), "Top 5 Online"
1337.   COLOR _RGB32(255)
1338.   FOR i%% = 1 TO 5
1339.    _PRINTSTRING (310, 224 + 18 * i%%), "#" + LTRIM$(STR$(i%%)) + "-" + RTRIM$(Online(i%%).Who) + SPACE$(32 - LEN(RTRIM$(Online(i%%).Who))) + LTRIM$(STR$(Online(i%%).Score))
1340.    IF Online(i%%).Rules = 2 THEN _PRINTSTRING (500, 224 + 18 * i%%), "Lite" ELSE _PRINTSTRING (500, 224 + 18 * i%%), "Base"
1341.   NEXT i%%
1342.  
1343.   COLOR _RGB32(144, 240, 64)
1344.   _PRINTSTRING (380, 228 + 18 * i%%), "Your Ranking Online"
1345.   COLOR _RGB32(255)
1346.   _PRINTSTRING (310, 228 + 18 * (i%% + 1)), "#" + LTRIM$(STR$(Return_Online_Rank(GrandTotal%))) + "-" + RTRIM$(Nick(Who~%%)) + SPACE$(32 - LEN(RTRIM$(Nick(Who~%%)))) + LTRIM$(STR$(GrandTotal%))
1347.   IF Local(i%%).Rules = 2 THEN _PRINTSTRING (500, 228 + 18 * (i%% + 1)), "Lite" ELSE _PRINTSTRING (500, 228 + 18 * (i%% + 1)), "Base"
1348.  ELSE
1349.   _PRINTSTRING (350, 216), "Top 5 Online (not connected)"
1350.  END IF
1351.  COLOR _RGB32(255)
1352.  _PRINTSTRING (350, 450), "Press any key to return to menu"
1353.  DO: LOOP UNTIL INKEY$ <> ""
1354.  _KEYCLEAR
1355. END SUB
1356.  
1357. SUB FlashScreen (L&)
1358.  _PUTIMAGE (0, 0), L&, Layer(0)
1359. END SUB
1360.  
1361. SUB Place_ShakerCup (X%, Y%)
1362.  _PUTIMAGE (X%, Y%), Layer(9), Layer(1)
1363. END SUB
1364.  
1365. SUB DarkenImage (Image AS LONG, Value_From_0_To_1 AS SINGLE)
1366.  'Taken from the QB64 Wiki.
1367.  IF Value_From_0_To_1 <= 0 OR Value_From_0_To_1 >= 1 OR _PIXELSIZE(Image) <> 4 THEN EXIT SUB
1368.  DIM Buffer AS _MEM: Buffer = _MEMIMAGE(Image) 'Get a memory reference to our image
1369.  DIM Frac_Value AS LONG: Frac_Value = Value_From_0_To_1 * 65536 'Used to avoid slow floating point calculations
1370.  DIM O AS _OFFSET, O_Last AS _OFFSET
1371.  O = Buffer.OFFSET 'We start at this offset
1372.  O_Last = Buffer.OFFSET + _WIDTH(Image) * _HEIGHT(Image) * 4 'We stop when we get to this offset
1373.  'use on error free code ONLY!
1374.  $CHECKING:OFF
1375.  DO
1376.   _MEMPUT Buffer, O, _MEMGET(Buffer, O, _UNSIGNED _BYTE) * Frac_Value \ 65536 AS _UNSIGNED _BYTE
1377.   _MEMPUT Buffer, O + 1, _MEMGET(Buffer, O + 1, _UNSIGNED _BYTE) * Frac_Value \ 65536 AS _UNSIGNED _BYTE
1378.   _MEMPUT Buffer, O + 2, _MEMGET(Buffer, O + 2, _UNSIGNED _BYTE) * Frac_Value \ 65536 AS _UNSIGNED _BYTE
1379.   O = O + 4
1380.  LOOP UNTIL O = O_Last
1381.  'turn checking back on when done!
1382.  $CHECKING:ON
1383.  _MEMFREE Buffer
1384. END SUB
1385.  
1386. SUB Intro
1387.  _SNDPLAY BGM(1)
1388.  FOR n! = 0.01 TO 1 STEP 0.01
1389.   tmp& = _COPYIMAGE(Layer(5))
1390.   DarkenImage tmp&, n!
1391.   _PUTIMAGE (0, 0), tmp&
1392.   _FREEIMAGE tmp&
1393.   _DELAY .025
1394.  NEXT
1395.  _DELAY 3
1396.  FOR n! = 1 TO 0.01 STEP -0.01
1397.   tmp& = _COPYIMAGE(Layer(5))
1398.   DarkenImage tmp&, n!
1399.   _PUTIMAGE (0, 0), tmp&
1400.   _FREEIMAGE tmp&
1401.   _DELAY .025
1402.  NEXT
1403.  FOR n! = 0.01 TO 1 STEP 0.01
1404.   tmp& = _COPYIMAGE(Layer(6))
1405.   DarkenImage tmp&, n!
1406.   _PUTIMAGE (5, 0), tmp&
1407.   _FREEIMAGE tmp&
1408.   _DELAY .025
1409.  NEXT
1410.  _DELAY 2.5
1411.  FOR n! = 1 TO 0.01 STEP -0.01
1412.   tmp& = _COPYIMAGE(Layer(6))
1413.   DarkenImage tmp&, n!
1414.   _PUTIMAGE (5, 0), tmp&
1415.   _FREEIMAGE tmp&
1416.   _DELAY .025
1417.  NEXT
1418. END SUB
1419.  
1420. SUB Local_Scores
1421.  Display_Offset%% = 0
1422.  'setup the static parts of high score list on layer 10---------
1423.  _DEST Layer(10)
1424.  _FONT 16
1425.  _PRINTSTRING (320 - (39 * 4), 38), "   Name                Rules      Score", Layer(10)
1426.  LINE (320 - 39 * 4, 54)-STEP(320, 3), _RGB32(212, 212, 60), BF
1427.  LINE (500, 60)-STEP(16, 360), _RGB32(24, 24, 24), BF
1428.  LINE (610, 60)-STEP(20, 60), _RGBA32(192, 192, 192, 96), BF
1429.  FOR i%% = 1 TO 40 STEP 5
1430.   LINE (615, 70 + i%%)-STEP(10, 2), _RGBA32(224, 224, 224, 192), BF
1431.  NEXT i%%
1432.  LINE (60, 20)-STEP(60, 20), _RGB32(92, 112, 16), BF
1433.  _PRINTSTRING (74, 23), "Exit", Layer(10)
1434.  LINE (540, 20)-STEP(60, 20), _RGB32(92, 112, 16), BF
1435.  _PRINTSTRING (552, 23), "Reset", Layer(10)
1436.  _DEST Layer(0)
1437.  '---------------------------------------------------------------
1438.  
1439.  DO
1440.   _PUTIMAGE (0, 0), Layer(10), Layer(1), (0, 0)-STEP(600, 479)
1441.   _PUTIMAGE (498, 60 + Display_Offset%% * 3.8), Layer(10), Layer(1), (610, 60)-STEP(20, 60)
1442.   FOR j%% = 1 TO 20
1443.    i%% = j%% + Display_Offset%%
1444.    N$ = LTRIM$(STR$(i%%))
1445.    N$ = LEFT$("00", 2 - LEN(N$)) + N$
1446.    NickString$ = "#" + N$ + "-" + RTRIM$(Local(i%%).Who)
1447.    ScoreString$ = LTRIM$(STR$(Local(i%%).Score))
1448.    _PRINTSTRING (320 - 39 * 4, 44 + 18 * j%%), NickString$, Layer(1)
1449.    _PRINTSTRING (472 - 8 * LEN(ScoreString$), 44 + 18 * j%%), ScoreString$, Layer(1)
1450.    IF Local(i%%).Rules = 2 THEN _PRINTSTRING (350, 44 + 18 * j%%), "Lite", Layer(1) ELSE _PRINTSTRING (350, 44 + 18 * j%%), "Base", Layer(1)
1451.   NEXT j%%
1452.   IF _MOUSEX >= 60 AND _MOUSEX <= 120 AND _MOUSEY >= 20 AND _MOUSEY <= 40 THEN
1453.    _DEST Layer(1): COLOR _RGB32(212, 64, 64)
1454.    _PRINTSTRING (74, 23), "Exit", Layer(1)
1455.    COLOR _RGB32(255): _DEST Layer(0)
1456.   END IF
1457.   IF _MOUSEX >= 540 AND _MOUSEX <= 600 AND _MOUSEY >= 20 AND _MOUSEY <= 40 THEN
1458.    _DEST Layer(1): COLOR _RGB32(212, 64, 64)
1459.    _PRINTSTRING (552, 23), "Reset", Layer(1)
1460.    COLOR _RGB32(255): _DEST Layer(0)
1461.   END IF
1462.   _PUTIMAGE , Layer(1), Layer(0)
1463.   ClearLayer Layer(1)
1464.   _LIMIT 30
1465.  
1466.   IF _MOUSEBUTTON(1) THEN
1467.    IF _MOUSEX >= 498 AND _MOUSEX <= 524 THEN
1468.     Display_Offset%% = INT(_MOUSEY - starty%) / 4
1469.    END IF
1470.    IF _MOUSEX >= 60 AND _MOUSEX <= 120 AND _MOUSEY >= 20 AND _MOUSEY <= 40 THEN ExitFlag%% = TRUE: Button_Down_Lock
1471.    IF _MOUSEX >= 540 AND _MOUSEX <= 600 AND _MOUSEY >= 20 AND _MOUSEY <= 40 THEN
1472.     IF _FILEEXISTS("LocalYahtzee.SCR") THEN KILL "LocalYahtzee.SCR": G.FirstGame = TRUE
1473.     Button_Down_Lock
1474.    END IF
1475.   ELSE
1476.    starty% = _MOUSEY
1477.   END IF
1478.  
1479.  
1480.   DO: LOOP WHILE _MOUSEINPUT
1481.  
1482.   SELECT CASE _KEYHIT
1483.    CASE 27
1484.     ExitFlag%% = TRUE
1485.    CASE 18432
1486.     Display_Offset%% = Display_Offset%% - 1
1487.    CASE 20480
1488.     Display_Offset%% = Display_Offset%% + 1
1489.   END SELECT
1490.   IF Display_Offset%% > 80 THEN Display_Offset%% = 80
1491.   IF Display_Offset%% < 0 THEN Display_Offset%% = 0
1492.  
1493.  LOOP UNTIL ExitFlag%%
1494.  _FONT FFX&, Layer(10) 'restore font to layer 10
1495.  ClearLayer Layer(10) 'clean layer 10 up
1496.  _KEYCLEAR
1497. END SUB
1498.  
1499. SUB Online_Scores
1500.  Display_Offset% = 0
1501.  'setup the static parts of high score list on layer 10---------
1502.  _DEST Layer(10)
1503.  _FONT 16
1504.  _PRINTSTRING (320 - (39 * 4), 38), "   Name                Rules      Score", Layer(10)
1505.  LINE (320 - 39 * 4, 54)-STEP(320, 3), _RGB32(212, 212, 60), BF
1506.  LINE (500, 60)-STEP(16, 360), _RGB32(24, 24, 24), BF
1507.  LINE (610, 60)-STEP(20, 60), _RGBA32(192, 192, 192, 96), BF
1508.  FOR i%% = 1 TO 40 STEP 5
1509.   LINE (615, 70 + i%%)-STEP(10, 2), _RGBA32(224, 224, 224, 192), BF
1510.  NEXT i%%
1511.  LINE (60, 20)-STEP(60, 20), _RGB32(92, 112, 16), BF
1512.  _PRINTSTRING (74, 23), "Exit", Layer(10)
1513.  _DEST Layer(0)
1514.  '---------------------------------------------------------------
1515.  
1516.  DO
1517.   _PUTIMAGE (0, 0), Layer(10), Layer(1), (0, 0)-STEP(600, 479)
1518.   _PUTIMAGE (498, 60 + Display_Offset% * 1.3), Layer(10), Layer(1), (610, 60)-STEP(20, 60)
1519.   FOR J~%% = 1 TO 20
1520.    I~%% = J~%% + Display_Offset%
1521.    N$ = LTRIM$(STR$(I~%%))
1522.    N$ = LEFT$("00", 2 - LEN(N$)) + N$
1523.    NickString$ = "#" + N$ + "-" + RTRIM$(Online(I~%%).Who)
1524.    ScoreString$ = LTRIM$(STR$(Online(I~%%).Score))
1525.    _PRINTSTRING (320 - 39 * 4, 44 + 18 * J~%%), NickString$, Layer(1)
1526.    _PRINTSTRING (472 - 8 * LEN(ScoreString$), 44 + 18 * J~%%), ScoreString$, Layer(1)
1527.    IF Online(I~%%).Rules = 2 THEN _PRINTSTRING (350, 44 + 18 * J~%%), "Lite", Layer(1) ELSE _PRINTSTRING (350, 44 + 18 * J~%%), "Base", Layer(1)
1528.   NEXT J~%%
1529.   IF _MOUSEX >= 60 AND _MOUSEX <= 120 AND _MOUSEY >= 20 AND _MOUSEY <= 40 THEN
1530.    _DEST Layer(1): COLOR _RGB32(212, 64, 64)
1531.    _PRINTSTRING (74, 23), "Exit", Layer(1)
1532.    COLOR _RGB32(255): _DEST Layer(0)
1533.   END IF
1534.   _PUTIMAGE , Layer(1), Layer(0)
1535.   ClearLayer Layer(1)
1536.   _LIMIT 30
1537.  
1538.   IF _MOUSEBUTTON(1) THEN
1539.    IF _MOUSEX >= 498 AND _MOUSEX <= 524 THEN
1540.     Display_Offset% = INT(_MOUSEY - starty%) / 1.4
1541.    END IF
1542.    IF _MOUSEX >= 60 AND _MOUSEX <= 120 AND _MOUSEY >= 20 AND _MOUSEY <= 40 THEN ExitFlag%% = TRUE: Button_Down_Lock
1543.   ELSE
1544.    starty% = _MOUSEY
1545.   END IF
1546.  
1547.  
1548.   DO: LOOP WHILE _MOUSEINPUT
1549.  
1550.   SELECT CASE _KEYHIT
1551.    CASE 27
1552.     ExitFlag%% = TRUE
1553.    CASE 18432
1554.     Display_Offset% = Display_Offset% - 1
1555.    CASE 20480
1556.     Display_Offset% = Display_Offset% + 1
1557.   END SELECT
1558.   IF Display_Offset% > 235 THEN Display_Offset% = 235
1559.   IF Display_Offset% < 0 THEN Display_Offset% = 0
1560.  
1561.  LOOP UNTIL ExitFlag%%
1562.  _FONT FFX&, Layer(10) 'restore font to layer 10
1563.  ClearLayer Layer(10) 'clean layer 10 up
1564.  _KEYCLEAR
1565. END SUB
1566.  
1567. SUB Sound_Controls
1568.  _DEST Layer(10)
1569.  LINE (610, 60)-STEP(20, 60), _RGBA32(192, 192, 192, 160), BF
1570.  FOR i%% = 1 TO 40 STEP 5
1571.   LINE (615, 70 + i%%)-STEP(10, 2), _RGBA32(224, 224, 224, 224), BF
1572.  NEXT i%%
1573.  _DEST Layer(1)
1574.  
1575.  DO
1576.   C1~%% = 2.55 * G.BGMVol
1577.   C2~%% = 2.55 * G.SFXVol
1578.   _FONT FFX2&, Layer(1)
1579.   _PUTIMAGE , Layer(11), Layer(1)
1580.   LINE (60, 136)-STEP(309, 43), _RGB32(C1~%%, 255 - C1~%%, 0), BF
1581.   LINE (60, 328)-STEP(309, 43), _RGB32(C2~%%, 255 - C2~%%, 0), BF
1582.   _PRINTSTRING (64, 64), "Music", Layer(1)
1583.   _PRINTSTRING (64, 256), "Sound FX", Layer(1)
1584.   '-----------Background Music selection---------------
1585.   IF G.MFIVerB OR G.MFIVerC THEN
1586.    _PRINTSTRING (424, 128), "Bubblely", Layer(1)
1587.    IF G.MFIVerC THEN
1588.     _PRINTSTRING (424, 172), "Aggresive", Layer(1)
1589.     _PRINTSTRING (424, 216), "Creepy", Layer(1)
1590.     _PRINTSTRING (424, 260), "Up Beat", Layer(1)
1591.    END IF
1592.    COLOR _RGB32(160, 16, 16)
1593.    SELECT CASE G.Current_BGM
1594.     CASE 2
1595.      _PRINTSTRING (424, 128), "Bubblely", Layer(1)
1596.     CASE 3
1597.      _PRINTSTRING (424, 172), "Aggresive", Layer(1)
1598.     CASE 4
1599.      _PRINTSTRING (424, 216), "Creepy", Layer(1)
1600.     CASE 5
1601.      _PRINTSTRING (424, 260), "Up Beat", Layer(1)
1602.    END SELECT
1603.    COLOR _RGB32(255)
1604.   END IF
1605.   '-----------------------------------------------------
1606.   '-------------Hi_lite done button---------------------
1607.   IF _MOUSEX > 500 AND _MOUSEX < 575 AND _MOUSEY > 48 AND _MOUSEY < 72 THEN
1608.    COLOR _RGB32(212, 224, 16)
1609.    _PRINTSTRING (500, 48), "Done", Layer(1)
1610.    COLOR _RGB32(255)
1611.   ELSE
1612.    _PRINTSTRING (500, 48), "Done", Layer(1)
1613.   END IF
1614.   '-----------------------------------------------------
1615.   _PUTIMAGE (60 + (3 * G.BGMVol), 128), Layer(10), Layer(1), (610, 60)-STEP(20, 60)
1616.   _PUTIMAGE (60 + (3 * G.SFXVol), 320), Layer(10), Layer(1), (610, 60)-STEP(20, 60)
1617.   _PUTIMAGE , Layer(1), Layer(0)
1618.   _PRINTSTRING (0, 0), STR$(G.BGMVol) + STR$(G.SFXVol) + STR$(_MOUSEX) + STR$(_MOUSEY), Layer(0)
1619.  
1620.   IF _MOUSEBUTTON(1) THEN
1621.    IF _MOUSEX > 60 AND _MOUSEX < 360 THEN
1622.     IF _MOUSEY > 128 AND _MOUSEY < 188 THEN 'music vol slider
1623.      G.BGMVol = (_MOUSEX - 60) \ 3
1624.      Sound_Adjust%% = TRUE
1625.     END IF
1626.     IF _MOUSEY > 320 AND _MOUSEY < 380 THEN 'sound fx vol slider
1627.      G.SFXVol = (_MOUSEX - 60) \ 3
1628.      Sound_Adjust%% = -2
1629.     END IF
1630.    END IF
1631.    IF _MOUSEX > 500 AND _MOUSEX < 575 AND _MOUSEY > 48 AND _MOUSEY < 72 THEN 'done button
1632.     ExitFlag%% = TRUE
1633.    END IF
1634.    IF _MOUSEX > 424 AND _MOUSEX < 560 AND (G.MFIVerB OR G.MFIVerC) THEN 'BGM selection
1635.     SELECT CASE _MOUSEY
1636.      CASE 128 TO 152 'Bubblely
1637.       IF G.Current_BGM <> 2 THEN
1638.        _SNDSTOP BGM(G.Current_BGM)
1639.        G.Current_BGM = 2
1640.        _SNDLOOP BGM(G.Current_BGM)
1641.       END IF
1642.      CASE 172 TO 196 'Agressive
1643.       IF G.Current_BGM <> 3 AND G.MFIVerC THEN
1644.        _SNDSTOP BGM(G.Current_BGM)
1645.        G.Current_BGM = 3
1646.        _SNDLOOP BGM(G.Current_BGM)
1647.       END IF
1648.      CASE 216 TO 240 'Creepy
1649.       IF G.Current_BGM <> 4 AND G.MFIVerC THEN
1650.        _SNDSTOP BGM(G.Current_BGM)
1651.        G.Current_BGM = 4
1652.        _SNDLOOP BGM(G.Current_BGM)
1653.       END IF
1654.      CASE 260 TO 284 'up beat
1655.       IF G.Current_BGM <> 5 AND G.MFIVerC THEN
1656.        _SNDSTOP BGM(G.Current_BGM)
1657.        G.Current_BGM = 5
1658.        _SNDLOOP BGM(G.Current_BGM)
1659.       END IF
1660.     END SELECT
1661.    END IF
1662.   END IF
1663.  
1664.   IF NOT _MOUSEBUTTON(1) AND Sound_Adjust%% THEN
1665.    FOR i%% = 1 TO 5
1666.     _SNDVOL BGM(i%%), G.BGMVol / 100
1667.    NEXT i%%
1668.    FOR i%% = 1 TO 5
1669.     _SNDVOL SFX(i%%), G.SFXVol / 100
1670.    NEXT i%%
1671.    IF Sound_Adjust%% = -2 THEN _SNDPLAY SFX(5)
1672.    Sound_Adjust%% = FALSE
1673.   END IF
1674.  
1675.   DO: LOOP WHILE _MOUSEINPUT
1676.   IF INKEY$ = CHR$(27) THEN ExitFlag%% = TRUE
1677.   _LIMIT 30
1678.   ClearLayer Layer(1)
1679.  LOOP UNTIL ExitFlag%%
1680.  
1681.  FOR i%% = 1 TO 2
1682.   _SNDVOL BGM(i%%), G.BGMVol / 100
1683.  NEXT i%%
1684.  
1685.  FOR i%% = 1 TO 5
1686.   _SNDVOL SFX(i%%), G.SFXVol / 100
1687.  NEXT i%%
1688.  
1689.  _FONT 16, Layer(1)
1690.  _DEST Layer(0)
1691. END SUB
1692.  
1693. FUNCTION LoadGFX& (Foff&, Size&)
1694.  IF _FILEEXISTS("temp.dat") THEN KILL "temp.dat"
1695.  OPEN "temp.dat" FOR BINARY AS #3
1696.  dat$ = SPACE$(Size&)
1697.  GET #1, Foff&, dat$
1698.  PUT #3, , dat$
1699.  CLOSE #3
1700.  LoadGFX& = _LOADIMAGE("temp.dat", 32)
1701. END FUNCTION
1702.  
1703. FUNCTION LoadFFX& (Foff&, Size&, Fize%%)
1704.  IF _FILEEXISTS("temp.dat") THEN KILL "temp.dat"
1705.  OPEN "temp.dat" FOR BINARY AS #3
1706.  dat$ = SPACE$(Size&)
1707.  GET #1, Foff&, dat$
1708.  PUT #3, , dat$
1709.  CLOSE #3
1710.  LoadFFX& = _LOADFONT("temp.dat", Fize%%, "monospace")
1711. END FUNCTION
1712.  
1713. FUNCTION LoadSFX& (Foff&, Size&)
1714.  IF _FILEEXISTS("temp.dat") THEN KILL "temp.dat"
1715.  OPEN "temp.dat" FOR BINARY AS #3
1716.  dat$ = SPACE$(Size&)
1717.  GET #1, Foff&, dat$
1718.  PUT #3, , dat$
1719.  CLOSE #3
1720.  LoadSFX& = _SNDOPEN("temp.dat")
1721. END FUNCTION
1722.  
1723. SUB LoadData (Foff&, Size&)
1724.  IF _FILEEXISTS("temp.dat") THEN KILL "temp.dat"
1725.  OPEN "temp.dat" FOR BINARY AS #3
1726.  dat$ = SPACE$(Size&)
1727.  GET #1, Foff&, dat$
1728.  PUT #3, , dat$
1729.  CLOSE #3
1730.  
1731.  F1 = FREEFILE
1732.  OPEN "temp.dat" FOR BINARY AS #F1
1733.  CLOSE #F1
1734. END SUB
1735.  
1736. SUB DisplayError (ErrorMessage$)
1737.  D = _DEST: Disp = _AUTODISPLAY
1738.  DC = _DEFAULTCOLOR: BGC = _BACKGROUNDCOLOR
1739.  BG = _COPYIMAGE(D)
1740.  E$ = ErrorMessage$ 'back up the string so we don't corrupt it any way.
1741.  
1742.  LogInScreen = _NEWIMAGE(200, 240, 32)
1743.  _DEST LogInScreen
1744.  _KEYCLEAR 'clear the buffer before we start accepting stray input as being part of our login
1745.  Xoffset = (_WIDTH(D) - _WIDTH(LogInScreen)) / 2
1746.  Yoffset = (_HEIGHT(D) - _HEIGHT(LogInScreen)) / 2
1747.  
1748.  CLS , DarkGray
1749.  LINE (3, 3)-(_WIDTH - 4, _HEIGHT - 4), LightGray, BF
1750.  LINE (5, 5)-(_WIDTH - 6, 27), DarkGray, BF
1751.  LINE (6, 6)-(_WIDTH - 7, 26), White, BF
1752.  LINE (5, 30)-(_WIDTH - 6, 180), DarkGray, BF
1753.  LINE (6, 31)-(_WIDTH - 7, 179), Black, BF
1754.  LINE (30, 190)-(90, 225), DarkGray, BF
1755.  LINE (33, 193)-(87, 222), Green, BF
1756.  LINE (111, 190)-(170, 225), DarkGray, BF
1757.  LINE (113, 193)-(167, 222), Red, BF
1758.  
1759.  ViewWidth = _WIDTH - 13 - _FONTWIDTH '(_WIDTH -7, -6 from above for our print box area)
1760.  ViewHeight = 179 - 31 '(again, from the 179, 31 above)
1761.  
1762.  U = ViewHeight \ _FONTHEIGHT - 1
1763.  IF U < 0 THEN U = 0 'we can't have negative lines to print to!
1764.  DIM A(U) AS STRING 'the most lines we can print too
1765.  
1766.  COLOR Red, 0
1767.  
1768.  i = 0: OUT$ = ""
1769.  FOR j = 1 TO LEN(E$)
1770.   OUT$ = OUT$ + MID$(E$, j, 1)
1771.   IF _PRINTWIDTH(OUT$) >= ViewWidth THEN 'we're printing off the screen
1772.    j1 = 0 'back up to our next valid breakpoint.
1773.    DO
1774.     j = j - 1: j1 = j1 + 1
1775.     SELECT CASE MID$(OUT$, LEN(OUT$) - j1, 1)
1776.      CASE " ", ".", ";", "-", "!", "?": EXIT DO 'valid end of line breaks.
1777.     END SELECT
1778.    LOOP UNTIL j1 >= ViewWidth
1779.    IF j1 >= ViewWidth THEN j = j + j1: j1 = 0
1780.    'if we have such a long word that we can't break it
1781.    '(perhaps like a html link), then print as much of it on one line as we can and carry on
1782.    'with business like usual.
1783.    A(i) = _TRIM$(LEFT$(OUT$, LEN(OUT$) - j1))
1784.    OUT$ = ""
1785.    i = i + 1
1786.    IF i > U THEN EXIT FOR
1787.   END IF
1788.  NEXT
1789.  IF i < U AND OUT$ <> "" THEN A(i) = OUT$
1790.  
1791.  p1 = (U - i) / 2
1792.  FOR p = 0 TO U 'center the text as much as possible inside our error box
1793.   _PRINTSTRING (100 - _PRINTWIDTH(A(p)) / 2, 33 + _FONTHEIGHT * (p + p1)), A(p)
1794.  NEXT
1795.  
1796.  COLOR White, 0
1797.  _PRINTSTRING (60 - _PRINTWIDTH("OK") / 2, 200), "OK"
1798.  COLOR Black, 0
1799.  _PRINTSTRING (140 - _PRINTWIDTH("QUIT") / 2, 200), "QUIT"
1800.  DO
1801.   count = (count + 1) MOD 2
1802.   IF count MOD 2 = 0 THEN blink = NOT blink
1803.   IF blink THEN COLOR Red, 0 ELSE COLOR Black, 0
1804.   _PRINTSTRING (100 - _PRINTWIDTH("WARNING: ERROR") / 2, 10), "WARNING: ERROR"
1805.   k = _KEYHIT
1806.   SELECT CASE k
1807.    CASE 13: EXIT DO 'Enter for "OK"
1808.    CASE 27: SYSTEM 'ESC for "QUIT"
1809.   END SELECT
1810.  
1811.   WHILE _MOUSEINPUT: WEND
1812.   mb = _MOUSEBUTTON(1): mx = _MOUSEX - Xoffset: my = _MOUSEY - Yoffset
1813.   IF mb = -1 AND oldmouse = 0 THEN
1814.    IF my >= 190 AND my <= 225 THEN
1815.     IF mx >= 30 AND mx <= 90 THEN
1816.      EXIT DO 'we clicked our "OK"
1817.     ELSEIF mx >= 111 AND mx <= 170 THEN
1818.      SYSTEM 'we clicked the "QUIT"
1819.     END IF
1820.    END IF
1821.   END IF
1822.   oldmouse = mb
1823.   _PUTIMAGE (Xoffset, Yoffset), LogInScreen, D
1824.   _DISPLAY
1825.   _LIMIT 10
1826.  LOOP
1827.  
1828.  _DEST D
1829.  IF Disp THEN _AUTODISPLAY
1830.  COLOR DC, BGC
1831.  _PUTIMAGE , BG, D 'restore the background
1832.  _FREEIMAGE BG
1833. END SUB
1834.  
1835.  
1836. FUNCTION LogIn (Detail$)
1837.  D = _DEST: Disp = _AUTODISPLAY
1838.  DC = _DEFAULTCOLOR: BGC = _BACKGROUNDCOLOR
1839.  BG = _COPYIMAGE(D)
1840.  
1841.  DO
1842.   count = count + 1
1843.   Client = _OPENCLIENT("TCP/IP:7993:172.93.60.23") 'attempt to join as client
1844.   _LIMIT 10
1845.  LOOP UNTIL Client <> 0 OR count > 100
1846.  OK$ = Verify$
1847.  IF LEFT$(OK$, 4) <> "[OK]" THEN
1848.   Detail$ = "[ERROR]Host not responding."
1849.   LogIn = 0
1850.   EXIT FUNCTION
1851.  END IF
1852.  
1853.  LogInScreen = _NEWIMAGE(200, 240, 32)
1854.  _DEST LogInScreen
1855.  _KEYCLEAR 'clear the buffer before we start accepting stray input as being part of our login
1856.  Xoffset = (_WIDTH(D) - _WIDTH(LogInScreen)) / 2
1857.  Yoffset = (_HEIGHT(D) - _HEIGHT(LogInScreen)) / 2
1858.  DO
1859.   CLS , DarkGray
1860.   LINE (3, 3)-(_WIDTH - 4, _HEIGHT - 4), LightGray, BF
1861.   LINE (20, 40)-(180, 200), DarkGray, BF
1862.   LINE (23, 68)-(177, 92), DarkGray, BF
1863.   LINE (23, 128)-(172, 152), DarkGray, BF
1864.   LINE (25, 70)-(175, 90), Black, BF
1865.   LINE (25, 130)-(175, 150), Black, BF
1866.   LINE (20, 210)-(100, 230), DarkGray, BF
1867.   LINE (22, 212)-(98, 228), Green, BF
1868.   LINE (101, 210)-(180, 230), DarkGray, BF
1869.   LINE (103, 212)-(178, 228), Red, BF
1870.  
1871.   COLOR DarkBlue, 0
1872.   _PRINTSTRING (100 - _PRINTWIDTH("CHECKERS") / 2, 15), "CHECKERS"
1873.   _PRINTSTRING (100 - _PRINTWIDTH("User Name") / 2, 95), "User Name"
1874.   _PRINTSTRING (100 - _PRINTWIDTH("Password") / 2, 155), "Password"
1875.   COLOR Yellow
1876.   _PRINTSTRING (60 - _PRINTWIDTH("LOG IN") / 2, 212), "LOG IN"
1877.   _PRINTSTRING (141 - _PRINTWIDTH("REGISTER") / 2, 212), "REGISTER"
1878.   count = (count + 1) MOD 30
1879.   IF count MOD 15 = 0 THEN blink = NOT blink
1880.   k = _KEYHIT
1881.   SELECT CASE k
1882.    CASE 9, 13 'tab or enter to toggle between the two fields.
1883.     S = NOT S
1884.    CASE 8 'backspace
1885.     IF S THEN p$ = LEFT$(p$, LEN(p$) - 1) ELSE n$ = LEFT$(n$, LEN(n$) - 1)
1886.    CASE 27 'Escape quits before we login
1887.     Detail$ = "[ERROR]User Exited Log In Manually"
1888.     GOTO function_exit
1889.    CASE 32 TO 255 'visable characters
1890.     IF S THEN p$ = p$ + CHR$(k) ELSE n$ = n$ + CHR$(k)
1891.   END SELECT
1892.   COLOR White
1893.   _PRINTSTRING (27, 72), RIGHT$(n$, 18): _PRINTSTRING (27, 132), RIGHT$(p$, 18)
1894.   IF blink THEN
1895.    IF S THEN l = _PRINTWIDTH(p$) ELSE l = _PRINTWIDTH(n$)
1896.    _PRINTSTRING (27 + l, 72 - 60 * S), "_"
1897.   END IF
1898.   _PUTIMAGE (Xoffset, Yoffset), LogInScreen, D
1899.  
1900.   WHILE _MOUSEINPUT: WEND
1901.   mb = _MOUSEBUTTON(1): mx = _MOUSEX - Xoffset: my = _MOUSEY - Yoffset
1902.   IF mb = TRUE AND oldmouse = FALSE THEN
1903.    IF my >= 210 AND my <= 230 THEN 'we're in the right X/Y position
1904.     IF mx >= 20 AND mx <= 100 THEN
1905.      'Run log in code
1906.      _TITLE n$ + "," + p$
1907.      Send Client, "[LOG IN]" + n$ + "," + p$ 'Register a new account
1908.      OK$ = Verify$
1909.      _TITLE OK$
1910.      Detail$ = OK$
1911.      IF LEFT$(OK$, 4) = "[OK]" THEN LogIn = -1: GOTO function_exit 'Success
1912.      GOTO function_exit 'Failure
1913.     END IF
1914.     IF mx >= 101 AND mx <= 180 THEN
1915.      'Run register code
1916.      Send Client, "[REGISTER]" + n$ + "," + p$ 'Login from an existing account
1917.      OK$ = Verify$
1918.      Detail$ = OK$
1919.      IF LEFT$(OK$, 4) = "[OK]" THEN LogIn = -1: GOTO function_exit
1920.      GOTO function_exit
1921.     ELSEIF my >= 70 AND my <= 90 AND mx >= 20 AND mx <= 180 THEN
1922.      S = 0
1923.     ELSEIF my >= 130 AND my <= 150 AND mx >= 20 AND mx <= 180 THEN
1924.      S = -1
1925.     END IF
1926.    END IF
1927.   END IF
1928.   _DISPLAY
1929.   _LIMIT 30
1930.   oldmouse = mb
1931.  LOOP
1932.  
1933.  function_exit: 'Safely restore our settings.
1934.  PlayerName$ = n$
1935.  _DEST D
1936.  IF Disp THEN _AUTODISPLAY
1937.  COLOR DC, BGC
1938.  _PUTIMAGE , BG, D 'restore the background
1939.  _FREEIMAGE BG
1940. END FUNCTION
1941.  
1942. SUB Send (Who, What$)
1943.  IF Client = 0 OR What$ = "" THEN EXIT SUB
1944.  OUT$ = CHR$(2) 'an initial byte to say, "We're sending data."
1945.  OUT$ = OUT$ + _MK$(_INTEGER64, LEN(What$) + 8) '8 bytes to store the length of the data we're sending.
1946.  OUT$ = OUT$ + What$
1947.  PUT Client, , OUT$
1948. END FUNCTION
1949.  
1950. SUB Receive (Who, What$)
1951.  STATIC In AS STRING
1952.  DIM B AS _UNSIGNED _BYTE
1953.  IF Client = 0 THEN EXIT SUB
1954.  IF In = "" THEN
1955.   GET Client, , B
1956.  ELSE
1957.   B = ASC(In)
1958.   r$ = r$ + In
1959.   In = "" 'Is there a message waiting for us, after we processed one message?
1960.  END IF
1961.  IF B = 2 THEN
1962.   DO
1963.    GET Client, , a$
1964.    IF a$ <> "" THEN r$ = r$ + a$
1965.    IF LEN(r$) > 8 THEN length = _CV(_INTEGER64, LEFT$(r$, 8))
1966.    _LIMIT 10
1967.   LOOP UNTIL LEN(r$) >= length AND length <> 0
1968.   What$ = MID$(r$, 9) '8 bytes for the length
1969.   In = MID$(r$, length + 1)
1970.  END IF
1971. END SUB
1972.  
1973. FUNCTION Verify$
1974.  DO
1975.   Receive Client, OK$ 'Get the confirmation message.
1976.   _LIMIT 10 'Use low CPU while waiting.  No need for a high number here... Be patient and let the server have time to respond.  Checking 10 times a second is more than enough to get an [OK] or [ERROR] message.
1977.  LOOP UNTIL OK$ <> ""
1978.  Verify$ = OK$
1979. END FUNCTION
1980.  

Updated 12/3/2019: Playable!
Updated 12/14/2019: Intro with music, and 'Bubblely' BGM game music added, Local High Scores functionality added
Updated 12/21/2019: 3 more musics added, sound control menu added. C version MFI file added
Updated 12/22/2019: Online Score keeping activated.

[Pete]

Hi Cobalt,

Check line 530. I pointed out to Steve, in your other post, that that his FOR/NEXT loop needed to be 1 TO 6, not 1 to 5. He edited his reply, accordingly. As is, if you haven't modified his code since my post, your loop will only analyze die rolls of 1 to 5, and not include any sixes. You'll also have to increase dim count to: DIM COUNT(7)

To check this try...

Code: QB64: [Select]

1. DIM Count(6)
2. DieArray(1) = 6
3. DieArray(2) = 6
4. DieArray(3) = 6
5. DieArray(4) = 6
6. DieArray(5) = 6
7.  
8. FOR i% = 1 TO 5
9.     Count(DieArray(i%)) = Count(DieArray(i%)) + 1
10. NEXT i%
11.  
12. FOR i% = 1 TO 5
13.     IF Count(i%) > 2 THEN
14.         Result% = Result% + Count(i%)
15.         IF Count(i%) > 3 THEN Result% = Result% + 2
16.     END IF
17.     PRINT i, Result%
18.     'check for long straight------
19.     IF Count(i%) = 1 THEN LS% = LS% + 1
20.     IF Count(i% + 1) = 1 THEN LS2% = LS2% + 1
21.     '-----------------------------
22. NEXT i%
23.  

See? The sixes were not counted. Now increase DIM by one, because you added  IF Count(i% + 1) = 1 THEN LS2% = LS2% + 1 to the mix, and make the FOR loop 1 TO 6...

Code: QB64: [Select]

1. DIM Count(7)
2. DieArray(1) = 6
3. DieArray(2) = 6
4. DieArray(3) = 6
5. DieArray(4) = 6
6. DieArray(5) = 6
7.  
8. FOR i% = 1 TO 5
9.     Count(DieArray(i%)) = Count(DieArray(i%)) + 1
10. NEXT i%
11.  
12. FOR i% = 1 TO 6
13.     IF Count(i%) > 2 THEN
14.         Result% = Result% + Count(i%)
15.         IF Count(i%) > 3 THEN Result% = Result% + 2
16.     END IF
17.     PRINT i, Result%
18.     'check for long straight------
19.     IF Count(i%) = 1 THEN LS% = LS% + 1
20.     IF Count(i% + 1) = 1 THEN LS2% = LS2% + 1
21.     '-----------------------------
22. NEXT i%
23.  

See? it now includes a six roll. Please note I took out the double % and got rid of .value, to make it easy code for me to use, so don't copy paste this code, edit your own as needed.

The game looks great. I look forward to giving it a roll, later today.

Pete

[SMcNeill]

Wrong loop, Pete.   You wanted to increase this one instead:

Code: [Select]

FOR i% = 1 TO 5
    Count(DieArray(i%)) = Count(DieArray(i%)) + 1
NEXT i%
Make that 5 a 6 and all is good.  :)

[Pete]

I don't think so, Tim...

So, let's back up the truck, and try this...

Code: QB64: [Select]

1. LOCATE 25, 1: PRINT "Press Enter to continue or Esc to quit...";
2. LOCATE 1, 1
3. DO
4.     REDIM Count(7)
5.     ' Roll 5 6-sided dice.
6.     FOR i% = 1 TO 5
7.         DieArray(i%) = INT(RND * 6 + 1)
8.         PRINT DieArray(i%);
9.     NEXT
10.  
11.     FOR i% = 1 TO 5
12.         Count(DieArray(i%)) = Count(DieArray(i%)) + 1
13.     NEXT i%
14.  
15.  ' SIX is required in the loop below to count the instances of die showing the number 6. Each Count() variable has recorded the number of instances of each die value from 1 to 6.
16.  
17.     FOR i% = 1 TO 6
18.         IF Count(i%) > 2 THEN
19.             Result% = Result% + Count(i%)
20.             IF Count(i%) > 3 THEN Result% = Result% + 2
21.             PRINT "Result ="; Result%,
22.         END IF
23.  
24.         '-----------------------------
25.     NEXT i%
26.  
27.     IF Result% = 3 THEN PRINT "Three of Kind";
28.     IF Result% = 5 THEN PRINT "Full House";
29.     IF Result% = 6 THEN PRINT "Four of Kind";
30.     IF Result% = 7 THEN PRINT "Yahtzee";
31.  
32.     DO
33.         _LIMIT 30
34.         b$ = INKEY$
35.         IF LEN(b$) THEN
36.             IF b$ = CHR$(13) THEN EXIT DO
37.             IF b$ = CHR$(27) THEN SYSTEM
38.         END IF
39.     LOOP
40.     Result% = 0
41.     PRINT
42. LOOP
43.  

Do 6 turns and you should get these results:

 

If you don't go through 6 loops of the RESULTS FOR/NEXT, you cannot get the number of 6 instances from each turn. Try it this way, then switch it around so the line you posted is 6 and mine is 5 and you will not get accurate results when the three sixes appear in the 4th turn.

Pete

[Cobalt]

It's PLAYABLE!!! now. Make your rolls, save the dice you wish to keep between rolls, and make up to 3 rolls trying to get that perfect Yahtzee!. No sounds yet I'm afraid, but do not be afraid to make your own sounds(go ahead, do it, no body is watching!). My best score by chance '301'. Standard rules set at the moment, 2 Yahtzees allowed, +50 for first one +100 for second. though I have yet to pull this off so I do not know if the code works correctly when scoring such an event.

Working on the menu now, hopefully be able to have it save(and even play across the net) with Steve's server.

[Cobalt]

Next release! once the sound menu is done, and sounds added will start implementing on-line score keeping thanks to, and with, Steve's server!

[johnno56]

Just downloaded Yahtzee (and the YahtzeeV1_2.MFI and YahtzeeV1_2b.MFI file).

Ran it and received the following error message...

 

Running QB64 v1.3 on 64 bit Linux Mint 19.2

[FellippeHeitor]

_SETBIT is only available in the development build of QB64 for now. Intended to be released with upcoming v.1.4

[johnno56]

Ok. Good to know. Thank you.

[AndyA]

johnno56,

If you don't want to download the latest dev build you could use these home rolled functions.

Code: [Select]

_TITLE "Bit Changing Functions"


'Populate powers of 2 array
DIM SHARED pow2~&(31)
FOR i% = 0 TO 31: pow2~&(i%) = 2 ^ i%: NEXT

PRINT "Decimal number to binary number"
PRINT "123456789 = "
PRINT dec2bin$(123456789)
PRINT
PRINT "Set bit 5"
PRINT dec2bin$(setBit~&(123456789, 5))
PRINT setBit~&(123456789, 5)
SLEEP
SYSTEM



FUNCTION setBit~& (iVal~&, bitPos%)
    setBit~& = iVal~& OR pow2~&(bitPos%)
END FUNCTION

FUNCTION clearBit~& (iVal~&, bitPos%)
    clearBit~& = iVal~& AND (iVal~& XOR pow2~&(bitPos%))
END FUNCTION

FUNCTION toggleBit~& (iVal~&, bitPos%)
    toggleBit~& = iVal~& XOR pow2~&(bitPos%)
END FUNCTION

FUNCTION readBit~& (iVal~&, bitPos%)
    readBit~& = iVal~& AND pow2~&(bitPos%)
END FUNCTION

FUNCTION dec2bin$ (iVal~&)
    FOR i% = 31 TO 0 STEP -1
        b$ = b$ + _TRIM$(STR$(ABS((iVal~& AND pow2~&(i%)) > 0)))
    NEXT
    dec2bin$ = b$
END FUNCTION

[Cobalt]

Ready to GO! you will need the latest development build.  Lets see who can get the highest online Score! To be able to add your scores to the online score list you must first view the online scores section. At the moment this connects you to the server.