TIP: Click on subject to list as thread! ANSI
echo: power_bas
to: MARCEL VELDHUIZEN
from: KURT KUZBA
date: 1996-08-12 16:34:00
subject: Random Numbers

MV> BS>   In any real game played with real dice and without a
MV> BS>   computer, there are infrequent occasions when, on the
MV> BS>   first throw of a player's turn when she/he throws all nine
MV> BS>   dice, it will happen that no points come up; no 1's, no
MV> BS>   5's, no triplets.
MV>   How do you do that??? If I throw a 1 or a 5, I allready
MV>   have points.. I can't throw 3 of a kind either, so:
mv>.......................
   If you want to emulate real dice, then set up an array to
emulate real dice. It is simple enough to do.
The shake routine I used here comes from Bill White (of Miami :),
who utilizes it for most cases where he is shuffling or
randomizing a finite number of elements, as in cards or dice.
'_|_|_|   DICE_EX.BAS   PUBLIC DOMAIN   by Kurt Kuzba  (8/12/96)
'_|_|_|   Random mixing routine borrowed from Quick Basic
'_|_|_|   code posted in FIDO_QBASIC by Bill White (of Miami :)
randomize timer: dim dice(6, 9) as integer: shared dice()
for die% = 0 to 8
   for face% = 0 to 5
      dice(die%, face%) = face% + 1
   next
next
color 9, 0: cls
print "Any key to toss dice  -  ESC to exit program"
do
   do: K$ = inkey$: loop while K$ = ""
   if K$ = chr$(27) then exit do
   ThrowDice
   for T% = 0 to 8: ShowDice T%, dice(T%, 5): next
   print
loop
print: print "Thank you for testing this program.": end
sub ThrowDice ()
   for shake% = 1 to 100
      for die% = 0 to 8
         swap dice(die%, shake% mod 6), dice(die%, rnd * 5)
      next
   next
end sub
sub ShowDice (T%, D%)
   Y% = T% * 9 + 1: color 15, 0
   dim spots$(5)
      spots$(0) = "|  o  |": spots$(1) = "|o   o|"
      spots$(2) = "|o    |": spots$(3) = "|    o|"
      spots$(4) = "|     |"
   locate 10, Y% + 1: print "_____";
   locate 11, Y%
   select case D%
      case 1: print spots$(4);
      case 2, 3: print spots$(2);
      case 4, 5, 6: print spots$(1);
   end select
   locate 12, Y%
   select case D%
      case 1, 3, 5: print spots$(0);
      case 2, 4: print spots$(4);
      case 6: print spots$(1);
   end select: locate 13, Y%
   select case D%
      case 1: print spots$(4);
      case 2, 3: print spots$(3);
      case 4, 5, 6: print spots$(1);
   end select
   locate 14, Y% + 1: print "~~~~~": color 10, 0
end sub
___
> ] Antimatter containment field failing. Dump standard .LIBs...
--- Maximus/2 3.01
1:278/216)
---------------
** A related thread FOLLOWS this message.

FIDO MESSAGE AREA==> TOPIC: 214 POWER BASIC   Ref: DCRD2850 Date: 08/22/96
From: KURT KUZBA                                            Time: 09:47am
\/To: KURT KUZBA (Rcvd)                                   (Read 5 times)
Subj: R: Random Numbers

KK>    If you want to emulate real dice,
kk>................
   I don't. I just hope to someday see a message posted from here. :)
'_|_|_|   HPTRAILZ.BAS
'_|_|_|   Happy Trailz. This program demonstrates one method
'_|_|_|   of creating a series of self-overwriting lines to
'_|_|_|   keep the CPU happy when there is nothing else to do.
'_|_|_|   Released to   PUBLIC DOMAIN   by Kurt Kuzba.  (2/10/96)
$lib com-,lpt-,graph+,cga-,ega-,vga+,herc-,fullfloat-,iprint-
$optimize speed
TYPE LNZ
   x1 AS INTEGER: x2 AS INTEGER: y1 AS INTEGER: y2 AS INTEGER
END TYPE
l$ = COMMAND$   '_|_|_|   REM this out if using QBasic
IF VAL(l$) < 1 THEN
   INPUT "Number of lines to display (1 TO 10)=> ", l$
END IF
l% = VAL(l$)
IF l% > 10 THEN l% = 10
IF l% < 4 THEN l% = 4
HappyTrails l%
SUB HappyTrails (l%)
   DIM la(1 TO l%, 11) AS LNZ, C(6) AS INTEGER, K(6) AS INTEGER
   DIM dx1(1 TO l%) AS INTEGER, dx2(1 TO l%) AS INTEGER
   DIM dy1(1 TO l%) AS INTEGER, dy2(1 TO l%) AS INTEGER
   C(0) = 15: C(1) = 11: C(2) = 3: C(3) = 9: C(4) = 1: C(5) = 0
   K(0) = 14: K(1) = 13: K(2) = 12: K(3) = 4: K(4) = 5: K(5) = 0
   RANDOMIZE (TIMER + INP(64))
   FOR ln% = 1 TO l%
      dx1(ln%) = 9: dx2(ln%) = 9: dy1(ln%) = 9: dy2(ln%) = 9
      FOR fade% = 0 TO 10
         la(ln%, fade%).x1 = 320 + fade% * 2
         la(ln%, fade%).y1 = 240 + fade% * 2
         la(ln%, fade%).x2 = 320 - fade% * 2
         la(ln%, fade%).y2 = 240 - fade% * 2
      NEXT
   NEXT: SCREEN 12
   k$ = INKEY$
   WHILE k$ = ""
      FOR ln% = 1 TO l%
      k$ = INKEY$: IF k$  "" THEN EXIT FOR
      FOR fade% = 10 TO 1 STEP -1
         x1% = la(ln%, fade%).x1: y1% = la(ln%, fade%).y1
         x2% = la(ln%, fade%).x2: y2% = la(ln%, fade%).y2
         la(ln%, fade%).x1 = la(ln%, fade% - 1).x1
         la(ln%, fade%).y1 = la(ln%, fade% - 1).y1
         la(ln%, fade%).x2 = la(ln%, fade% - 1).x2
         la(ln%, fade%).y2 = la(ln%, fade% - 1).y2
         IF (ln% AND 1) = 0 THEN
            LINE (x1%, y1%)-(x2%, y2%), C(fade%\2)
         ELSE
            LINE (x1%, y1%)-(x2%, y2%), K(fade%\2)
         END IF
      NEXT
      x1% = la(ln%, 0).x1 + dx1(ln%): y1% = la(ln%, 0).y1 + dy1(ln%)
      x2% = la(ln%, 0).x2 + dx2(ln%): y2% = la(ln%, 0).y2 + dy2(ln%)
      IF x1% > 639 THEN dx1(ln%) = -(RND * 7 + 9): x1% = 639
      IF x1% < 0 THEN dx1(ln%) = RND * 7 + 9: x1% = 0
      IF x2% > 639 THEN dx2(ln%) = -(RND * 7 + 9): x2% = 639
      IF x2% < 0 THEN dx2(ln%) = RND * 7 + 9: x2% = 0
      IF y1% > 479 THEN dy1(ln%) = -(RND * 7 + 9): y1% = 479
      IF y1% < 0 THEN dy1(ln%) = RND * 7 + 9: y1% = 0
      IF y2% > 479 THEN dy2(ln%) = -(RND * 7 + 9): y2% = 479
      IF y2% < 0 THEN dy2(ln%) = RND * 7 + 9: y2% = 0
      la(ln%, 0).x1 = x1%: la(ln%, 0).y1 = y1%
      la(ln%, 0).x2 = x2%: la(ln%, 0).y2 = y2%
      IF (ln% AND 1) = 0 THEN
         LINE (x1%, y1%)-(x2%, y2%), C(0)
      ELSE
         LINE (x1%, y1%)-(x2%, y2%), K(0)
      END IF
      NEXT
   WEND
   SCREEN 0
END SUB
'_|_|_|   end   HPTRAILZ.BAS

---
> ] I'm heavily sedated and seriously thinking about blinking...

---------------
>>>>>>>>>>>>>>>>>>>>>> LAST Message In Thread <<<<<<<<<<<<<<<<<<<<<<

FIDO MESSAGE AREA==> TOPIC: 214 POWER BASIC   Ref: DCL00001 Date: 08/15/96
From: RONALD SCHLEGEL                                       Time: 03:49pm
\/To: ALL                                                 (Read 4 times)
Subj: Again...

Hi,
  After months of trying, I *THINK* my feed to this echo is finally working.
 
IF ANYONE$ SEES THIS THEN
 PRINT "LET ME KNOW"
ELSE
 PRINT "I'LL KEEP TRYING"
END IF

 
Thanks...
-Ron
 
... The highest bidder catches the most politicians.
--- TriToss (tm) Professional 10.0 - #229
---------------
* Origin: The Programmer's Mark * Brooklyn, NY, USA: 718-921-9267
* Origin: * Dynasty BBS * The home of Dungeon Software * (1:110/1065.0)

SOURCE: echomail via exec-pc

Email questions or comments to sysop@ipingthereforeiam.com
All parts of this website painstakingly hand-crafted in the U.S.A.!
IPTIA BBS/MUD/Terminal/Game Server List, © 2025 IPTIA Consulting™.