|
DataMuseum.dkPresents historical artifacts from the history of: CP/M |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CP/M Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 9984 (0x2700)
Types: TextFile
Names: »PERSONER.PAS«
└─⟦08ea08c61⟧ Bits:30003924 PolyPascal programmer
└─⟦this⟧ »PERSONER.PAS«
PROGRAM personer;
CONST
max = 100;
TYPE
str30 = STRING(.30.);
str3 = STRING(.3.);
koentype = (mand, kvinde);
haarfarvetype = (lysblond, moerkeblond, hvidt, brunt, sort, roedt,
graat, skaldet);
oejenfarvetype = (blaa, graa, brune, groenne);
personpost = RECORD
navn : str30;
koen : koentype;
hoejde : INTEGER;
vaegt : INTEGER;
haarfarve : haarfarvetype;
oejenfarve : oejenfarvetype;
END;
personregister = ARRAY(.1 .. max.) OF personpost;
VAR
person : personregister;
antal : INTEGER;
PROCEDURE retur;
VAR
ch : CHAR;
BEGIN (* retur *)
WRITELN;
WRITE('Tast <RETURN>: ');
BUFLEN := 0;
READLN;
END; (* retur *)
PROCEDURE soegkoen;
VAR
i : INTEGER;
soeg_koen : koentype;
ch : CHAR;
fundet : BOOLEAN;
BEGIN (* soegkoen *)
REPEAT
GOTOXY(0, 20);
WRITE(CLREOL, 'Tast køn (m/k): ');
BUFLEN := 1;
READ(ch);
UNTIL (ch = 'm') OR (ch = 'k');
IF ch = 'm'
THEN soeg_koen := mand
ELSE soeg_koen := kvinde;
GOTOXY(0, 22);
WRITELN('Følgende personer er af det søgte køn:');
fundet := FALSE;
FOR i := 1 TO antal DO
IF person(.i.).koen = soeg_koen
THEN
BEGIN
WRITELN(person(.i.).navn);
fundet := TRUE;
END;
IF NOT fundet
THEN WRITELN('Der er ingen personer af det søgte køn');
retur;
END; (* soegkoen *)
PROCEDURE soeghoejde;
VAR
i, soeg_hoejde, test : INTEGER;
fundet : BOOLEAN;
str : str3;
BEGIN (* soeghoejde *)
REPEAT
GOTOXY(0, 20);
WRITE(CLREOL, 'Tast højde: ');
BUFLEN := 3;
READLN(str);
VAL(str, soeg_hoejde, test);
UNTIL (test = 0) AND (100 <= soeg_hoejde) AND (soeg_hoejde <= 220);
GOTOXY(0, 22);
WRITELN('Følgende personer har højden ', soeg_hoejde, ':');
fundet := FALSE;
FOR i := 1 TO antal DO
IF person(.i.).hoejde = soeg_hoejde
THEN
BEGIN
WRITELN(person(.i.).navn);
fundet := TRUE;
END;
IF NOT fundet
THEN WRITELN('Der er ingen personer med denne højde');
retur;
END; (* soeghoejde *)
PROCEDURE soegvaegt;
VAR
i, soeg_vaegt, test : INTEGER;
fundet : BOOLEAN;
str : str3;
BEGIN (* soegvaegt *)
REPEAT
GOTOXY(0, 20);
WRITE(CLREOL, 'Tast vaegt: ');
BUFLEN := 3;
READLN(str);
VAL(str, soeg_vaegt, test);
UNTIL (test = 0) AND (30 <= soeg_vaegt) AND (soeg_vaegt <= 200);
GOTOXY(0, 22);
WRITELN('Følgende personer har vægten ', soeg_vaegt, ':');
fundet := FALSE;
FOR i := 1 TO antal DO
IF person(.i.).vaegt = soeg_vaegt
THEN
BEGIN
WRITELN(person(.i.).navn);
fundet := TRUE;
END;
IF NOT fundet
THEN WRITELN('Der er ingen personer med denne vægt');
retur;
END; (* soegvaegt *)
PROCEDURE soeghaarfarve;
VAR
i : INTEGER;
soeg_haarfarve : haarfarvetype;
ch : CHAR;
fundet : BOOLEAN;
BEGIN (* soeghaarfarve *)
REPEAT
GOTOXY(0, 20);
WRITELN('Tast hårfarve: 1. Lysblond 2. Mørkeblond 3. Hvidt ');
WRITE(CLREOL, '4. Brunt 5. Sort 6. Rødt 7. Gråt 8. Skaldet: ');
BUFLEN := 1;
READ(ch);
UNTIL ('1' <= ch) AND (ch <= '8');
CASE ch OF
'1' : soeg_haarfarve := lysblond;
'2' : soeg_haarfarve := moerkeblond;
'3' : soeg_haarfarve := hvidt;
'4' : soeg_haarfarve := brunt;
'5' : soeg_haarfarve := sort;
'6' : soeg_haarfarve := roedt;
'7' : soeg_haarfarve := graat;
'8' : soeg_haarfarve := skaldet;
END;
WRITELN;
WRITELN('Følgende personer har denne hårfarve:');
fundet := FALSE;
FOR i := 1 TO antal DO
IF person(.i.).haarfarve = soeg_haarfarve
THEN
BEGIN
WRITELN(person(.i.).navn);
fundet := TRUE;
END;
IF NOT fundet
THEN WRITELN('Der er ingen personer med denne hårfarve');
retur;
END; (* soeghaarfarve *)
PROCEDURE soegoejenfarve;
VAR
i : INTEGER;
soeg_oejenfarve : oejenfarvetype;
ch : CHAR;
fundet : BOOLEAN;
BEGIN (* soegoejenfarve *)
REPEAT
GOTOXY(0, 20); WRITE(CLREOL);
WRITE('Tast øjenfarve: 1. Blå 2. Grå 3. Brune 4. Grønne: ');
BUFLEN := 1;
WRITE(CHR(8));
READLN(ch);
UNTIL ('1' <= ch) AND (ch <= '4');
CASE ch OF
'1' : soeg_oejenfarve := blaa;
'2' : soeg_oejenfarve := graa;
'3' : soeg_oejenfarve := brune;
'4' : soeg_oejenfarve := groenne;
END;
WRITELN;
WRITELN('Følgende personer har denne øjenfarve:');
fundet := FALSE;
FOR i := 1 TO antal DO
IF person(.i.).oejenfarve = soeg_oejenfarve
THEN
BEGIN
WRITELN(person(.i.).navn);
fundet := TRUE;
END;
IF NOT fundet
THEN WRITELN('Der er ingen personer med denne øjenfarve');
retur;
END; (* soegoejenfarve *)
PROCEDURE indlaes;
VAR
i, test : INTEGER;
str : str3;
ch : CHAR;
BEGIN (* indlaes *)
WRITE(CLRHOM);
i := 0;
WRITELN('Indtastning af oplysninger til personkartotek:');
WRITELN;
REPEAT
i := i + 1;
WITH person(.i.) DO
BEGIN
WRITE('Indtast navn (# stopper): ');
BUFLEN := 30;
READLN(navn);
IF navn <> '#'
THEN
BEGIN
WRITELN;
WRITE('Tast køn (m/k): ');
REPEAT
WRITE(CHR(8), ' ', CHR(8));
BUFLEN := 1;
READ(ch);
UNTIL (ch = 'm') OR (ch = 'k');
IF ch = 'm'
THEN koen := mand
ELSE koen := kvinde;
WRITELN;
WRITELN;
REPEAT
WRITE('Tast højde: ');
BUFLEN := 3;
READLN(str);
VAL(str, hoejde, test);
UNTIL (test = 0) AND (100 <= hoejde) AND (hoejde <= 220);
WRITELN;
REPEAT
WRITE('Tast vaegt: ');
BUFLEN := 3;
READLN(str);
VAL(str, vaegt, test);
UNTIL (test = 0) AND (30 <= vaegt) AND (vaegt <= 200);
WRITELN;
WRITELN('Tast hårfarve: 1. Lysblond 2. Mørkeblond ',
'3. Hvidt ');
WRITE('4. Brunt 5. Sort 6. Rødt 7. Gråt 8. Skaldet: ');
REPEAT
BUFLEN := 1;
WRITE(CHR(8), ' ', CHR(8));
READ(ch);
UNTIL ('1' <= ch) AND (ch <= '8');
CASE ch OF
'1' : haarfarve := lysblond;
'2' : haarfarve := moerkeblond;
'3' : haarfarve := hvidt;
'4' : haarfarve := brunt;
'5' : haarfarve := sort;
'6' : haarfarve := roedt;
'7' : haarfarve := graat;
'8' : haarfarve := skaldet;
END;
WRITELN;
WRITELN;
WRITE('Tast øjenfarve: 1. Blå 2. Grå 3. Brune ',
'4. Grønne: ');
REPEAT
BUFLEN := 1;
WRITE(CHR(8), ' ', CHR(8));
READ(ch);
UNTIL ('1' <= ch) AND (ch <= '4');
CASE ch OF
'1' : oejenfarve := blaa;
'2' : oejenfarve := graa;
'3' : oejenfarve := brune;
'4' : oejenfarve := groenne;
END;
WRITELN;
WRITELN;
END;
END;
UNTIL (person(.i.).navn = '#') OR (i = max);
IF person(.i.).navn = '#'
THEN antal := i - 1
ELSE antal := max;
END; (* indlaes *)
PROCEDURE menu;
VAR
ch : CHAR;
BEGIN (* menu *)
REPEAT
WRITE(CLRHOM);
GOTOXY(5, 2); WRITE('Hvad ønsker du at søge efter:');
GOTOXY(5, 5); WRITE('1. Køn');
GOTOXY(5, 7); WRITE('2. Højde');
GOTOXY(5, 9); WRITE('3. Vægt');
GOTOXY(5, 11); WRITE('4. Hårfarve');
GOTOXY(5, 13); WRITE('5. Øjenfarve');
GOTOXY(5, 15); WRITE('6. Afslutte programmet');
REPEAT
GOTOXY(5, 18); WRITE('Tast nummeret på den ønskede funktion: ');
WRITE(CHR(8), ' ', CHR(8)); (* Backspace *)
BUFLEN := 1;
READ(ch);
UNTIL ('1' <= ch) AND (ch <= '6');
CASE ch OF
'1' : soegkoen;
'2' : soeghoejde;
'3' : soegvaegt;
'4' : soeghaarfarve;
'5' : soegoejenfarve;
END;
UNTIL ch = '6';
WRITELN;
END; (* menu *)
BEGIN (* personer *)
indlaes;
menu;
END. (* personer *)
«eof»