lancio di due dadi

[bplus]

2 for 1 sale!

Code: QB64: [Select]

1. 'SUB dado
2. '    LOCATE 10, 10
3. '    PRINT "É"; STRING$(16, 205); "»"
4. '    LOCATE 17, 10
5. '    PRINT "È"; STRING$(16, 205); "¼"
6. '    FOR i = 11 TO 16
7. '        LOCATE i, 10
8. '        PRINT "º"; TAB(27); "º"
9. '    NEXT i
10. 'END SUB
11.  
12. 'SUB dadocoso2
13. '    LOCATE 10, 40
14. '    PRINT "É"; STRING$(16, 205); "»"
15. '    LOCATE 17, 40
16. '    PRINT "È"; STRING$(16, 205); "¼"
17. '    FOR i = 11 TO 16
18. '        LOCATE i, 40
19. '        PRINT "º"; TAB(57); "º"
20. '    NEXT i
21. 'END SUB
22.  
23. SUB rettangolo (column)
24.     LOCATE 10, column
25.     PRINT "É"; STRING$(16, 205); "»";
26.     LOCATE 17, column
27.     PRINT "È"; STRING$(16, 205); "¼";
28.     FOR i = 11 TO 16
29.         LOCATE i, column
30.         PRINT "º"; STRING$(16, 32); "º";
31.     NEXT i
32. END SUB
33.  

Add dice dots:

Code: QB64: [Select]

1. dado 10, 3
2. dado 40, 5
3.  
4. SUB dado (column, dots)
5.     LOCATE 10, column
6.     PRINT "É"; STRING$(15, 205); "»";
7.     LOCATE 16, column
8.     PRINT "È"; STRING$(15, 205); "¼";
9.     FOR i = 11 TO 15
10.         LOCATE i, column
11.         PRINT "º"; STRING$(15, 32); "º";
12.     NEXT i
13.     SELECT CASE dots
14.         CASE 1
15.             LOCATE 13, column + 8: PRINT "*"
16.         CASE 2
17.             LOCATE 13, column + 6: PRINT "*   *"
18.         CASE 3
19.             LOCATE 12, column + 6: PRINT "*"
20.             LOCATE 13, column + 8: PRINT "*"
21.             LOCATE 14, column + 10: PRINT "*"
22.         CASE 4
23.             LOCATE 12, column + 6: PRINT "*   *"
24.             LOCATE 14, column + 6: PRINT "*   *"
25.         CASE 5
26.             LOCATE 12, column + 6: PRINT "*   *"
27.             LOCATE 13, column + 8: PRINT "*"
28.             LOCATE 14, column + 6: PRINT "*   *"
29.         CASE 6
30.             LOCATE 12, column + 6: PRINT "* * *"
31.             LOCATE 14, column + 6: PRINT "* * *"
32.     END SELECT
33. END SUB
34.  
35.  
36.  

[bplus]

Now add our function

Code: QB64: [Select]

1. DO
2.  
3.     dado 2, randomNumber1to(6)
4.     dado 22, randomNumber1to(6)
5.     dado 42, randomNumber1to(6)
6.     dado 62, randomNumber1to(6)
7.     _LIMIT .5 'slow down to 1 every 2 secs
8. LOOP UNTIL _KEYDOWN(27) 'escape key press to quit
9.  
10. SUB dado (column, dots)
11.     LOCATE 10, column
12.     PRINT "É"; STRING$(15, 205); "»";
13.     LOCATE 16, column
14.     PRINT "È"; STRING$(15, 205); "¼";
15.     FOR i = 11 TO 15
16.         LOCATE i, column
17.         PRINT "º"; STRING$(15, 32); "º";
18.     NEXT i
19.     SELECT CASE dots
20.         CASE 1
21.             LOCATE 13, column + 8: PRINT "*"
22.         CASE 2
23.             LOCATE 13, column + 6: PRINT "*   *"
24.         CASE 3
25.             LOCATE 12, column + 6: PRINT "*"
26.             LOCATE 13, column + 8: PRINT "*"
27.             LOCATE 14, column + 10: PRINT "*"
28.         CASE 4
29.             LOCATE 12, column + 6: PRINT "*   *"
30.             LOCATE 14, column + 6: PRINT "*   *"
31.         CASE 5
32.             LOCATE 12, column + 6: PRINT "*   *"
33.             LOCATE 13, column + 8: PRINT "*"
34.             LOCATE 14, column + 6: PRINT "*   *"
35.         CASE 6
36.             LOCATE 12, column + 6: PRINT "* * *"
37.             LOCATE 14, column + 6: PRINT "* * *"
38.     END SELECT
39. END SUB
40.  
41. FUNCTION randomNumber1to (n)
42.     randomNumber1to = INT(RND * n) + 1
43. END FUNCTION
44.  
45.  

[bplus]

Add an array now to track dice numbers and add another Function to total an array of numbers, so now we roll dice until key press stops and shows dice and total, press another key and roll again, ...

Code: QB64: [Select]

1. REDIM dice(1 TO 4) 'so we can add them up
2. DO
3.     CLS
4.     WHILE LEN(INKEY$) = 0 ' roll 'em
5.         FOR d = 1 TO 4
6.             dice(d) = randomNumber1to(6)
7.         NEXT
8.         dado 2, dice(1)
9.         dado 22, dice(2)
10.         dado 42, dice(3)
11.         dado 62, dice(4)
12.         _LIMIT 20 ' CPU was getting worked up, this saves fan
13.     WEND
14.     LOCATE 20, 40: PRINT totalArray(dice())
15.     SLEEP 'pause and wait for key press
16.     _KEYCLEAR 'clear keys so start rolling again
17. LOOP UNTIL _KEYDOWN(27) 'escape key press to quit
18.  
19. SUB dado (column, dots)
20.     LOCATE 10, column
21.     PRINT "É"; STRING$(15, 205); "»";
22.     LOCATE 16, column
23.     PRINT "È"; STRING$(15, 205); "¼";
24.     FOR i = 11 TO 15
25.         LOCATE i, column
26.         PRINT "º"; STRING$(15, 32); "º";
27.     NEXT i
28.     SELECT CASE dots
29.         CASE 1
30.             LOCATE 13, column + 8: PRINT "*"
31.         CASE 2
32.             LOCATE 12, column + 6: PRINT "*"
33.             LOCATE 14, column + 10: PRINT "*"
34.         CASE 3
35.             LOCATE 12, column + 6: PRINT "*"
36.             LOCATE 13, column + 8: PRINT "*"
37.             LOCATE 14, column + 10: PRINT "*"
38.         CASE 4
39.             LOCATE 12, column + 6: PRINT "*   *"
40.             LOCATE 14, column + 6: PRINT "*   *"
41.         CASE 5
42.             LOCATE 12, column + 6: PRINT "*   *"
43.             LOCATE 13, column + 8: PRINT "*"
44.             LOCATE 14, column + 6: PRINT "*   *"
45.         CASE 6
46.             LOCATE 12, column + 6: PRINT "* * *"
47.             LOCATE 14, column + 6: PRINT "* * *"
48.     END SELECT
49. END SUB
50.  
51. FUNCTION randomNumber1to (n)
52.     randomNumber1to = INT(RND * n) + 1
53. END FUNCTION
54.  
55. FUNCTION totalArray (array())
56.     FOR i = LBOUND(array) TO UBOUND(array)
57.         totalArray = totalArray + array(i)
58.     NEXT
59. END FUNCTION
60.  

EDIT: Fix 2 dots dice face.

[MidnightOwl]

There is an excellent dice rolling routine in 'mboard.bas' in the samples directory in your qb64 directory. It even simulates rolling dice.

[bplus]

There is an excellent dice rolling routine in 'mboard.bas' in the samples directory in your qb64 directory. It even simulates rolling dice.

Guess I need full path to mboard.bas, I couldn't find it but no matter, here we are practicing SUBs and FUNCTIONs, I think?

I have excellent game of Pig with dice image rolling but try to find it with search here... :P

One more try with capital Pig, aha!
Boink!
https://www.qb64.org/forum/index.php?topic=712.msg6204#msg6204

[bplus]

There is an excellent dice rolling routine in 'mboard.bas' in the samples directory in your qb64 directory. It even simulates rolling dice.

Man get my curiosity going and

Inquiring minds need to know

If anyone wants a listing of Samples here it is:

Code: QB64: [Select]

1.  

mboard.bas is for Bob's excellent Monopoly Board which is magnificent, can't say that the dice are any more impressive than here though, and they squeak! LOL!
 

[FellippeHeitor]

Love that ASCII board.

[bplus]

Well the dado's were embarrassed by Bob's dice ;-))

Code: QB64: [Select]

1. REDIM dice(1 TO 6) 'so we can add them up
2. DO
3.     CLS
4.     WHILE LEN(INKEY$) = 0 ' roll 'em
5.         FOR d = 1 TO 6
6.             dice(d) = randomNumber1to(6)
7.         NEXT
8.         dado 3, dice(1)
9.         dado 16, dice(2)
10.         dado 29, dice(3)
11.         dado 42, dice(4)
12.         dado 55, dice(5)
13.         dado 68, dice(6)
14.         _LIMIT 20 ' CPU was getting worked up, this saves fan
15.     WEND
16.     LOCATE 20, 40: PRINT totalArray(dice())
17.     SLEEP 'pause and wait for key press
18.     _KEYCLEAR 'clear keys so start rolling again
19. LOOP UNTIL _KEYDOWN(27) 'escape key press to quit
20.  
21. SUB dado (column, dots)
22.     COLOR 15, 12
23.     LOCATE 11, column
24.  
25.     PRINT CHR$(218); STRING$(9, 196); CHR$(191);
26.     LOCATE 15, column
27.     PRINT CHR$(192); STRING$(9, 196); CHR$(217);
28.     FOR i = 12 TO 14
29.         LOCATE i, column
30.         PRINT CHR$(179); STRING$(9, 32); CHR$(179);
31.     NEXT i
32.     SELECT CASE dots
33.         CASE 1
34.             LOCATE 13, column + 5: PRINT "*"
35.         CASE 2
36.             LOCATE 12, column + 3: PRINT "*"
37.             LOCATE 14, column + 7: PRINT "*"
38.         CASE 3
39.             LOCATE 12, column + 3: PRINT "*"
40.             LOCATE 13, column + 5: PRINT "*"
41.             LOCATE 14, column + 7: PRINT "*"
42.         CASE 4
43.             LOCATE 12, column + 3: PRINT "*   *"
44.             LOCATE 14, column + 3: PRINT "*   *"
45.         CASE 5
46.             LOCATE 12, column + 3: PRINT "*   *"
47.             LOCATE 13, column + 5: PRINT "*"
48.             LOCATE 14, column + 3: PRINT "*   *"
49.         CASE 6
50.             LOCATE 12, column + 3: PRINT "* * *"
51.             LOCATE 14, column + 3: PRINT "* * *"
52.     END SELECT
53.     COLOR 15, 0
54. END SUB
55.  
56. FUNCTION randomNumber1to (n)
57.     randomNumber1to = INT(RND * n) + 1
58. END FUNCTION
59.  
60. FUNCTION totalArray (array())
61.     FOR i = LBOUND(array) TO UBOUND(array)
62.         totalArray = totalArray + array(i)
63.     NEXT
64. END FUNCTION
65.  
66.  
67.  

[MidnightOwl]

The ideal in programming is to avoid reinventing the wheel ie. reusable code.  The function returns dice total and shows just how complicated a function can be.  It can also be adapted to many uses with little alteration (reused) . Which was why I brought  it up in the  first place. Isn't that why there are code libraries?

[bplus]

The ideal in programming is to avoid reinventing the wheel ie. reusable code.  The function returns dice total and shows just how complicated a function can be.  It can also be adapted to many uses with little alteration (reused) . Which was why I brought  it up in the  first place. Isn't that why there are code libraries?

Wait are you saying we should have used this for dice from Monopoly (which is massive! and certainly not meant to be library):

Code: QB64: [Select]

1. FUNCTION RollDICE% (RRow%, CCol%)
2.  
3.     FOR ROLL = 1 TO 24
4.         Row = RRow% + FIX(RND * 2) - 1
5.         Col = CCol% + FIX(RND * 2) - 1
6.         Number1 = FIX(RND * 6) + 1
7.         Number = Number1
8.         GOSUB ShowDIE
9.         GOSUB Sides
10.         Row = RRow% + FIX(RND * 2) - 1
11.         Col = CCol% + 7 + FIX(RND * 2) - 1
12.         Number2 = FIX(RND * 6) + 1
13.         Number = Number2
14.         GOSUB ShowDIE
15.         GOSUB Sides
16.         PLAY "MBT160L64O6b"
17.         FOR Slow = 1 TO 6
18.             WAIT &H3DA, 8
19.             WAIT &H3DA, 8, 8
20.         NEXT Slow
21.     NEXT ROLL
22.     RollDICE% = Number1 + Number2
23.     IF Number1 = Number2 THEN Doubles% = TRUE
24.  
25.     EXIT FUNCTION
26.  
27.     ShowDIE:
28.     COLOR BackCOLOR%
29.     FOR x = Col - 2 TO Col + 4
30.         FOR y = Row - 1 TO Row + 4
31.             LOCATE y, x
32.             PRINT CHR$(219)
33.         NEXT y
34.     NEXT x
35.     COLOR 15, 4
36.     SELECT CASE Number
37.         CASE 1
38.             LOCATE Row, Col: GOSUB NoDOTS
39.             LOCATE Row + 1, Col: GOSUB OneDOT
40.             LOCATE Row + 2, Col: GOSUB NoDOTS
41.             LOCATE
42.         CASE 2
43.             LOCATE Row, Col: GOSUB Dot
44.             FOR Reps = 1 TO 2: GOSUB Blank: NEXT Reps
45.             LOCATE Row + 1, Col: GOSUB NoDOTS
46.             LOCATE Row + 2, Col
47.             FOR Reps = 1 TO 2: GOSUB Blank: NEXT Reps
48.             GOSUB Dot
49.         CASE 3
50.             LOCATE Row, Col: GOSUB Dot
51.             FOR Reps = 1 TO 2: GOSUB Blank: NEXT Reps
52.             LOCATE Row + 1, Col: GOSUB OneDOT
53.             LOCATE Row + 2, Col
54.             FOR Reps = 1 TO 2: GOSUB Blank: NEXT Reps
55.             GOSUB Dot
56.         CASE 4
57.             LOCATE Row, Col: GOSUB TwoDOTS
58.             LOCATE Row + 1, Col: GOSUB NoDOTS
59.             LOCATE Row + 2, Col: GOSUB TwoDOTS
60.         CASE 5
61.             LOCATE Row, Col: GOSUB TwoDOTS
62.             LOCATE Row + 1, Col: GOSUB OneDOT
63.             LOCATE Row + 2, Col: GOSUB TwoDOTS
64.         CASE 6
65.             LOCATE Row, Col: GOSUB TwoDOTS
66.             LOCATE Row + 1, Col: GOSUB TwoDOTS
67.             LOCATE Row + 2, Col: GOSUB TwoDOTS
68.     END SELECT
69.     RETURN
70.  
71.     OneDOT:
72.     GOSUB Blank
73.     GOSUB Dot
74.     GOSUB Blank
75.     RETURN
76.  
77.     TwoDOTS:
78.     GOSUB Dot
79.     GOSUB Blank
80.     GOSUB Dot
81.     RETURN
82.  
83.     NoDOTS:
84.     FOR Reps = 1 TO 3: GOSUB Blank: NEXT Reps
85.     RETURN
86.  
87.     Blank:
88.     PRINT CHR$(32);
89.     RETURN
90.  
91.     Dot:
92.     PRINT CHR$(254);
93.     RETURN
94.  
95.     Sides:
96.     COLOR 4, BackCOLOR%
97.     LOCATE Row, Col - 1: PRINT CHR$(222)
98.     LOCATE Row + 1, Col - 1: PRINT CHR$(222)
99.     LOCATE Row + 2, Col - 1: PRINT CHR$(222)
100.     LOCATE Row, Col + 3: PRINT CHR$(221)
101.     LOCATE Row + 1, Col + 3: PRINT CHR$(221)
102.     LOCATE Row + 2, Col + 3: PRINT CHR$(221)
103.     RETURN
104.  
105. END FUNCTION
106.