DataMuseum.dk

top - metrics - download

    Length: 4608 (0x1200)
    Types: TextFile
    Names: »FLETNING.PAS«

└─⟦08ea08c61⟧ Bits:30003924 PolyPascal programmer
    └─⟦this⟧ »FLETNING.PAS« 

TextFile

        PROGRAM fletning;
        
          (* Blanding af kort ved sammenfletning *)
        
          CONST
            antalkort = 52;
          
          TYPE
            kuloerer = (kloer, ruder, hjerter, spar);
            vaerdi = RECORD
                     kuloer : kuloerer;
                     nr : 1 .. 13;
                   END;
            pointer = ^ kort;
            kort = RECORD
                     billede : vaerdi;
                     naeste : pointer;
                   END;
          
          VAR
            top : pointer;
            antal : INTEGER;
            
          PROCEDURE opretspil;
          
            VAR
              farve : kuloerer;
              i : INTEGER;
              kp : pointer;
            
            BEGIN (* opretspil *)
              top := NIL;
              FOR farve := spar DOWNTO kloer DO
                FOR i := 13 DOWNTO 1 DO
                  BEGIN
                    NEW(kp);
                    WITH kp^ DO
                      BEGIN
                        naeste := top;
                        billede.kuloer := farve;
                        billede.nr := i;
                      END;
                    top := kp;
                  END; (* top er nu det første kort *)
            END; (* opretspil *)
            
          PROCEDURE udskriv(start : pointer);
              
            VAR
              i : INTEGER;
            
            BEGIN (* udskriv *)
              i := 0;
              WHILE start <> NIL DO
                BEGIN
                  WITH start^ DO
                    BEGIN
                      CASE billede.kuloer OF
                        kloer   : WRITE('  K');
                        ruder   : WRITE('  R');
                        hjerter : WRITE('  H');
                        spar    : WRITE('  S');
                      END;
                      WRITE(billede.nr : 2);
                    END;
                  start := start^.naeste;
                  i := i + 1;
                  IF i MOD 13 = 0
                    THEN WRITELN;
                END;
            END; (* udskriv *)
         
          PROCEDURE blande(antal : INTEGER);
          
            VAR
              kp, foerstedel, andendel : pointer;
              i, j : INTEGER;
            
            BEGIN (* blande *)
              FOR i := 1 TO antal DO
                BEGIN
                  kp := top;
                  FOR j := 1 TO (RANDOM(antalkort)- 1) DO
                    kp := kp^.naeste;
                  (* Kortene skilles efter kp^ *)
                  foerstedel := top;
                  andendel := kp^.naeste;
                  kp^.naeste := NIL;
                  IF RANDOM(2) = 0
                    THEN
                      BEGIN
                        kp := foerstedel;
                        foerstedel := andendel;
                        andendel := kp;
                      END;
                  top := foerstedel;
                  kp := foerstedel;
                  (* Nu flettes foerstedel og andendel sammen *)
                  WHILE (foerstedel^.naeste <> NIL) AND 
                          (andendel^.naeste <> NIL) DO
                    BEGIN
                      foerstedel := foerstedel^.naeste;
                      kp^.naeste := andendel;
                      kp := andendel;
                      andendel := andendel^.naeste;
                      kp^.naeste := foerstedel;
                      kp:=foerstedel;
                    END;
                  (* Efter sammenfletningen heftes halen på: *)
                  IF foerstedel^.naeste <> NIL
                    THEN
                      BEGIN
                        andendel^.naeste := foerstedel^.naeste;
                        kp^.naeste := andendel;
                      END;
                  IF andendel^.naeste <> NIL
                    THEN kp^.naeste := andendel;
                  IF (foerstedel^.naeste = NIL) AND (andendel^.naeste = NIL)
                    THEN foerstedel^.naeste := andendel;
                END;
            END; (* blande *)
          
          BEGIN (* bland *)
            WRITE(CLRHOM);
            RANDOMIZE;
            opretspil;
            WRITE('Hvor mange sammenfletninger ønskes: ');
            READLN(antal);
            blande(antal);
            WRITELN;
            udskriv(top);
          END. (* bland *)
«eof»