Groan

[johnno56]

Here is a preliminary conversion of the TRS80 game of the same name.

Apologies for the colours. Not a real fan of mono-chrome... lol  Might have got a little carried away.

The "delays" within the game may seem a "little too quick". Line numbers 830 and 840 are the culprits... lol  Speaking of line numbers. I have not applied any 'beautification' to the code yet. Just want to see how it run first... Let me know if you discover any "random features" and feel free to make or suggest any changes?

Warning: At times, the machine, will play a wicked game... It is rare but it has happened!

screen 0
Cls

Declare SUB trs(var)

'	Give the colours a name...
black = 0
dkBlue = 1
dkGreen = 2
dkCyan = 3
dkRed = 4
Purple = 5
Brown = 6
Grey = 7
dkGrey = 8
Blue = 9
Green = 10
Cyan = 11
Red = 12
Magenta = 13
Yellow = 14
White = 15
frame = Grey

'
'	Convert TRS80 "print@" to "locate"
'
sub trs (var)
    Locate var \ 64 + 1, var Mod 64 + 1
end sub

sub centre(txt$,row,colr)
	locate row, (80 - len(txt$)) / 2
	color colr: Print txt$
end sub

sub header()
	centre(" GGG  RRR    OO    AA   N  N", 1, Green)
	centre("G     R  R  O  O  A  A  NN N", 2, Green)
	centre("G  G  RRR   O  O  AAAA  N NN", 3, Green)
	centre(" GGG  R  R   OO   A  A  N  N", 4, Green)
end sub

header()
?
?:color Cyan
?"We will take turns rolling a set of dice until a set score is reached.         "
?: color Yellow
?"Each time we roll we will be given a choice to either continue rolling or to   "
?"pass to the next player. Passing adds and saves the current series score."
?: color Cyan
?"There is one small wrinkle... "
?: color Yellow
?"If a '1' is rolled by either dice then the score for that series is lost.      "
?"If a pair of ones are rolled then ALL of the accumulated score is lost and that"
?"player must start again from zero."
?:color cyan
?"By the way... A '1' will de displayed as a 'sad' or 'frowning' face...
?: color Yellow
?"Why is the game called GROAN? Wait until a pair of ones are rolled..."
?:color Green
input "                       Press ENTER to play... ";AA

REM   CC$ = "="  BB$ = "|" or ":"  II$ = "_"  MM$ = "-"  UU$ = ";"  NN$ = " "

100 ' GROAN
110 ' (C) 1979 BY PHIL FELDMAN AND TOM RUGG
120 Randomize Timer
140 BB$ = CHR$(186): CC$ = "O": LL$ = "_": MM$ = "-"
150 UU$ = ";": NN$ = " ": 
160 D1$ = BB$ + String$(7, "-") + BB$: D2$ = BB$ + String$(7, 32) + BB$
170 D3$ = BB$ + String$(7, "-") + BB$: E1$ = String$(4, 32) + LL$ + MM$ + LL$ + String$(4, 32)
180 E2$ = NN$ + LL$ + MM$ + UU$ + NN$ + NN$ + NN$ + UU$ + MM$ + LL$ + NN$: E3$ = UU$ + MM$ + LL$ + String$(5, 32) + LL$ + MM$ + UU$
185 E4$ = NN$ + NN$ + NN$ + UU$ + MM$ + LL$ + MM$ + UU$ + NN$ + NN$ + NN$
'190 F1$ = BB$ + String$(40, "-") + BB$: F2$ = BB$ + String$(40, "-") + BB$: F3$ = BB$ + String$(40, "-") + BB$
F1$ = chr$(201) + String$(40, chr$(205)) + chr$(187)
F2$ = chr$(204) + String$(40, chr$(205)) + chr$(185)
F3$ = chr$(200) + String$(40, chr$(205)) + chr$(188)
'?"F1$ = "; F1$
'?"F2$ = "; F2$
'?"F3$ = "; F3$
'end
200 Cls: header() ' locate ,25:print"G R O A N"
210 centre("HOW MUCH NEEDED TO WIN", 9, Yellow)
220 color Brown: print: Input "                          (BETWEEN 50-100 IS BEST) "; W: If W <= 0 Then GoTo 200
230 cls: header(): centre("LET'S TOSS FOR FIRST ROLL", 9, white): GoSub 830
240 centre("THE COIN IS IN THE AIR AND", 11, white)
250 QQ$ = "YOU": Q = Int(Rnd * 2) + 1: If Q = 2 Then QQ$ = "I"
260 locate ,35: color Green: For J = 1 To 5: Print ". ";: GoSub 830: Next
270 centre(QQ$ + " GET FIRST ROLL", 14, Blue): GoSub 840: T = 0: If Q = 2 Then GoTo 400
300 PP$ = " YOU": Cls: locate ,25: color Cyan: print"YOU'RE ROLLING": GoSub 830: GoSub 500
310 T = T + R1 + R2: If F > 0 Then T = 0
320 If F = 2 Then H = 0
330 GoSub 850: If F > 0 Then color Yellow: Print "DICE PASS TO ME": GoSub 840: GoTo 400
340 color Yellow: Print "(P=PASS DICE - R=ROLL AGAIN)": color Green: Print "YOUR DECISION (P OR R) ?"
350 QQ$ = InKey$: QQ$ = UCase$(QQ$): If QQ$ = "" Then GoTo 350
360 If QQ$ = "R" Then GoTo 300
370 If QQ$ <> "P" Then GoTo 350
380 Print: H = H + T: If H >= W Then GoTo 970
390 T = 0: F = 1: Cls: GoTo 330
400 T = 0: PP$ = "I"
410 Cls: locate ,26: color Red: print"I'M ROLLING": GoSub 830: GoSub 500
420 T = T + R1 + R2: If F > 0 Then T = 0
430 If F = 2 Then P = 0
440 GoSub 850: If F > 0 Then Print "DICE PASS TO YOU": GoSub 840: T = 0: GoTo 300
450 GoSub 1000: If X = 1 Then Print "I'LL ROLL AGAIN": GoSub 840: GoTo 410
460 Print "I'LL STOP WITH THIS": GoSub 840: P = P + T: If P >= W Then GoTo 970
470 Print: Print "DICE PASS TO YOU": T = 0: GoSub 840: GoTo 300
500 D = 266: R1 = Int(Rnd * 6) + 1: R2 = Int(Rnd * 6) + 1: GoTo 540
530 C = D + K: GoSub 650: C = C + 384: GoSub 650: GoSub 600: Cls
535 GoSub 660: C = C - 384: GoSub 660: GoSub 600: Cls
540 C = D + 48: GoSub 650: C = C + 384: GoSub 650
550 C = D + 48: R = R1: GoSub 700
560 C = C + 384: R = R2: GoSub 700: F = 0: If R1 = 1 Then F = 1: GoSub 800
570 If R2 = 1 Then F = F + 1: GoSub 810
580 If F = 2 Then GoSub 820: GoSub 830
590 Return
600 For J = 1 To DL: Next: Return
649 Rem  Display the dice "frame"?
650 Return 'trs (C - 136): Print D1$: trs (C - 72): Print D2$: trs (C - 8): Print D3$: Return
660 'trs (C - 197): Print E1$: trs (C - 133): Print E2$: trs (C - 69): Print E3$
670 Return 'trs (C - 5): Print E4$: Return
700 On R GOSUB 710, 730, 740, 750, 760, 770: Return
710 color Magenta: trs (C - 134): Print CC$;: trs (C - 130): Print CC$;: trs (C - 68): Print "(";: trs (C - 6): Print "+";
720 For Q = 3 To 5: trs (C - Q): Print "=": Next: trs (C - 2): Print "+": Return
730 color Blue: trs (C - 134): Print CC$;: trs (C - 2): Print CC$;: Return
740 color Blue: trs (C - 68): Print "O";: GoSub 730: Return
750 color Blue: trs (C - 130): Print CC$;: trs (C - 6): Print CC$: GoSub 730: Return
760 GoSub 740: GoSub 750: Return
770 color Blue: trs (C - 70): Print "O";: trs (C - 66): Print "O";: GoSub 750: Return
800 trs (52): color White: Print "GROAN";: Return
810 trs (820): color White: Print "GROAN";: Return
820 trs (434): color Magenta: Print "-DISPAIR-";: Return
830 _Delay 1: Return
840 _Delay 2: Return
'
'		DISPLAY THE SCOREBOARD
'
850 color frame:trs (64): Print F1$;
color White: G = 128: GoSub 960
trs (135): color Green: Print "- - S C O R E B O A R D - -";
860 color frame: trs (192): Print F2$;
862 G = 256: GoSub 960
864 trs (264): color Green: Print W; " POINTS NEEDED TO WIN";
870 trs (320): color frame: Print F2$;: G = 384: GoSub 960
880 trs (386): color Green: Print "   POINTS SCORED         YOU     ME";: G = 448: GoSub 960
890 trs (450): color Green: Print "BEFORE THIS SERIES";: trs (475): color Cyan: Print H;
900 trs (482): color Red: Print P;
902 trs (512): color frame: Print F2$;: G = 576: GoSub 960
910 trs (582): color Green: Print PP$; " HAVE ";
If PP$ = "I" Then 
	color Red
else
	color Cyan
end if
Print T;
color Green: Print " POINTS THIS SERIES";
920 trs (640): color frame: Print F3$;: trs (768): Print "";: Return
960 trs (G): color frame: Print CHR$(186);: trs (G + 41): Print CHR$(186);: Return
970 T = 0: Cls: GoSub 850: If P >= W Then trs (768): color Red: Print "SKILL WINS AGAIN"
980 If H >= W Then trs (768): color Cyan: Print "YOU WIN - IT WAS SHEER LUCK"
990 End
1000 V = P + T: If V >= W Then GoTo 1100
1010 If (W - H) < 10 Then GoTo 1110
1020 If P >= H Then L = T / 25: GoTo 1050
1030 If V < H Then L = T / 35: GoTo 1050
1040 L = T / 30
1050 If Rnd > L Then GoTo 1110
1100 X = 0: Return
1110 X = 1: Return

Instructions are contained within the game.  Basically: Enter a total game score. During the game, respond with either "R" roll again or "P" pass.

[CharlieJV]

Oh boy, I do look forward to trying this out!

[CharlieJV]

I very much enjoy that!  The choice of colours I find really excellent, and the game is a bunch of fun.

If it's okay, I'd like to add that to sample BAM programs.

So much fun to see gems like these getting resurrected!



Aside:  Took me a while to get to it.  Got a new toy today: a portable/personal voice amplifier with an "echo" feature, something I hoped would be good with my Native American flute.  It turns out to be absolutely fantastic!

[CharlieJV]

I'm enjoying this so much, I could not wait: https://basicanywheremachine.neocities.org/sample_programs/BAM_SamplePrograms?page=groan

[CharlieJV]

Hey, when somebody takes some of their time to test/try/create things in BAM that I find really helpful, I like to (for lack of a budget!) show my appreciation publicly.


Would it be okay if I added you to my "Acknowledgements" page?

With your online handle or your name?

[johnno56]

um.. ok...

[CharlieJV]

There you are:

https://basicanywheremachine.neocities.org/BAM_ProgReference?target=Introduction%3A%3A%F0%9F%A5%87%20Acknowledgements#Home

[johnno56]

You are too kind... I will try not to disappoint...

[CharlieJV]

You are too kind... I will try not to disappoint...

Nah nah nah, them are tokens of appreciation for present gifts on display, not about cranking the screws for the fun surprises of tomorrow.

Virtual hugs thrown in, too.  Or virtual fist-bumps, because we can't all be huggers...