home *** CD-ROM | disk | FTP | other *** search
/ BMUG Revelations / BMUG Revelations.toast / Programming / Programming Languages / UCB Logo 3.0 / CSLS / cards < prev    next >
Encoding:
Text File  |  1992-09-04  |  1.4 KB  |  64 lines  |  [TEXT/JV01]
  1. PROGRAM CARDS(OUTPUT);
  2.  {SHUFFLE A DECK OF CARDS}
  3.  
  4. VAR RANKS:ARRAY [0..51] OF INTEGER;
  5.     SUITS:ARRAY [0..51] OF CHAR;
  6.     I:INTEGER;
  7.  
  8. PROCEDURE SHOWDECK;
  9.  {PRINT THE DECK ARRAYS}
  10.  
  11.    BEGIN {SHOWDECK}
  12.       FOR I := 0 TO 51 DO
  13.          BEGIN
  14.             IF I MOD 13 = 0 THEN WRITELN;
  15.             WRITE(RANKS[I]:3,SUITS[I]);
  16.          END;
  17.       WRITELN;
  18.       WRITELN
  19.    END; {SHOWDECK}
  20.  
  21. PROCEDURE DECK;
  22.  {CREATE THE DECK IN ORDER}
  23.  
  24.    VAR I,J:INTEGER;
  25.        SUITNAMES:PACKED ARRAY [0..3] OF CHAR;
  26.  
  27.    BEGIN {DECK}
  28.       SUITNAMES := 'HSDC';
  29.       FOR I := 0 TO 12 DO
  30.          FOR J := 0 TO 3 DO
  31.             BEGIN
  32.                RANKS[13*J+I] := I+1;
  33.                SUITS[13*J+I] := SUITNAMES[J]
  34.             END;
  35.       WRITELN('THE INITIAL DECK:');
  36.       SHOWDECK
  37.    END; {DECK}
  38.  
  39. PROCEDURE SHUFFLE;
  40.  {SHUFFLE THE DECK RANDOMLY}
  41.  
  42.    VAR RANK,I,J:INTEGER;
  43.        SUIT:CHAR;
  44.  
  45.    BEGIN {SHUFFLE}
  46.       FOR I := 51 DOWNTO 1 DO {FOR EACH CARD IN THE DECK}
  47.          BEGIN
  48.             J := RANDOM(I+1); {PICK A RANDOM CARD BEFORE IT}
  49.             RANK := RANKS[I]; {INTERCHANGE RANKS}
  50.             RANKS[I] := RANKS[J];
  51.             RANKS[J] := RANK;
  52.             SUIT := SUITS[I]; {INTERCHANGE SUITS}
  53.             SUITS[I] := SUITS[J];
  54.             SUITS[J] := SUIT
  55.          END;
  56.       WRITELN('THE SHUFFLED DECK:');
  57.       SHOWDECK
  58.    END; {SHUFFLE}
  59.  
  60. BEGIN {MAIN PROGRAM}
  61.    DECK;
  62.    SHUFFLE
  63. END.
  64.