DataMuseum.dk

top - download

    Length: 4224 (0x1080)
    Types: TextFile
    Names: »IDEAL.PAS«

└─⟦092727b26⟧ Bits:30005927 Demoprogrammer til Pascal bog (Jet-80)
    └─ ⟦this⟧ »IDEAL.PAS« 

TextFile

PROGRAM ideal;
  
  TYPE
    str6 = STRING(.6.);
  
  VAR
    koen : str6;
    ch : CHAR;
    hoejde : INTEGER;
  
  PROCEDURE forside;
   
    CONST
      x = 10;
      y = 4;
    
    VAR
      ch : CHAR;
    
    BEGIN (* forside *)
      WRITE(CLRHOM);
      GOTOXY(x, y);
      WRITE('*********************************************************');
      GOTOXY(x, y + 1);
      WRITE('****                                                 ****');
      GOTOXY(x, y + 2);
      WRITE('****                                                 ****');
      GOTOXY(x, y + 3);
      WRITE('****                I D E A L V Æ G T                ****');
      GOTOXY(x, y + 4);
      WRITE('****                                                 ****');
      GOTOXY(x, y + 5);
      WRITE('****                      H O S                      ****');
      GOTOXY(x, y + 6);
      WRITE('****                                                 ****');
      GOTOXY(x, y + 7);
      WRITE('****            K V I N D E R  &  M Æ N D            ****');
      GOTOXY(x, y + 8);
      WRITE('****                                                 ****');
      GOTOXY(x, y + 9);
      WRITE('****                                                 ****');
      GOTOXY(x, y + 10);
      WRITE('*********************************************************');
      GOTOXY(x, 20);
      WRITE('Programmet udskriver idealvægten hos kvinder og mænd, når');
      GOTOXY(x, 21);
      WRITE('man indtaster højden i cm.');
      GOTOXY(65, 22);
      WRITE('Tast <RETURN>!');
      REPEAT
        READ(KBD, ch);
      UNTIL ch = CHR(13);
    END; (* forside *)
  
  PROCEDURE udskrift(koen : str6; hoejde : INTEGER);
  
    PROCEDURE unormal;
  
      BEGIN (* unormal *)
        WRITE(CLRHOM);
        GOTOXY(5, 9);
        WRITE('Du ligger uden for de normale rammer. Prøv igen!');
      END; (* unormal *)
    
    PROCEDURE ud;
    
      VAR
        vaegt : REAL;
        
      BEGIN (* ud *)
        IF koen = 'mand'
          THEN vaegt := (hoejde - 100) * 0.90
          ELSE vaegt := (hoejde - 100) * 0.88;
        GOTOXY(0, 9);
        WRITELN('     *****************************************************');
        WRITELN('     ****                                             ****');
        WRITELN('     ****                                             ****');
        WRITELN('     ****       Du skal med en højde på ', hoejde, ' cm.', 
                '       ****');
        WRITELN('     ****                                             ****');
        WRITELN('     ****                 veje ', ROUND(vaegt), ' kg.',
                '                 ****');
        WRITELN('     ****                                             ****');
        WRITELN('     ****                                             ****');
        WRITELN('     *****************************************************');
     END; (* ud *)
  
    BEGIN (* udskrift *)
      IF (hoejde < 140) OR (200 < hoejde)
        THEN unormal
        ELSE ud;
    END; (* udskrift *)
    
  PROCEDURE spoerg(VAR koen : str6; VAR hoejde : INTEGER);
  
    VAR
      streng : str6;
      test : INTEGER;
      
    BEGIN (* spoerg *)
      WRITE(CLRHOM);
      REPEAT
        GOTOXY(5, 2);
        WRITE('Indtast køn (kvinde/mand): ', CLREOL);
        BUFLEN := 6;
        READ(koen);
      UNTIL (koen = 'kvinde') OR (koen = 'mand');
      REPEAT
        GOTOXY(5, 5);
        WRITE('Indtast din højde i hele cm.: ', CLREOL);
        READ(streng);
        VAL(streng, hoejde, test);
      UNTIL test = 0;
      udskrift(koen, hoejde);
    END; (* spoerg *)
    
  BEGIN (* ideal *)
    REPEAT
      forside;
      spoerg(koen, hoejde);
      udskrift(koen, hoejde);
      GOTOXY(5, 20);
      WRITE('Ønsker du at prøve igen (j/n): ');
      REPEAT
        READ(KBD, ch);
      UNTIL ch IN (.'J', 'j', 'N', 'n'.);
    UNTIL ch IN (.'N', 'n'.);
    GOTOXY(5, 21);
    WRITELN('Så slutter vi for i dag.');
  END. (* ideal *)
«eof»