|
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: 2432 (0x980)
Names: »NAVNSOEG.PAS«
└─⟦f983c2ef3⟧ Bits:30004681 Pascal opgaver (Butler)
└─⟦this⟧ »NAVNSOEG.PAS«
0x000…020 (0,) 50 52 4f 47 52 41 4d 20 6e 61 76 6e 73 6f 65 67 3b 0d 0a 0d 0a 20 20 43 4f 4e 53 54 0d 0a 20 20 ┆PROGRAM navnsoeg; CONST ┆
0x020…040 20 20 6d 61 78 20 3d 20 32 30 30 3b 0d 0a 20 20 0d 0a 20 20 54 59 50 45 0d 0a 20 20 20 20 73 74 ┆ max = 200; TYPE st┆
0x040…060 72 33 30 20 3d 20 53 54 52 49 4e 47 28 2e 33 30 2e 29 3b 0d 0a 20 20 20 20 61 72 72 61 79 74 79 ┆r30 = STRING(.30.); arrayty┆
0x060…080 70 65 20 3d 20 41 52 52 41 59 28 2e 31 20 2e 2e 20 6d 61 78 2e 29 20 4f 46 20 73 74 72 33 30 3b ┆pe = ARRAY(.1 .. max.) OF str30;┆
0x080…0a0 0d 0a 20 20 0d 0a 20 20 56 41 52 0d 0a 20 20 20 20 6b 61 72 74 6f 74 65 6b 20 3a 20 61 72 72 61 ┆ VAR kartotek : arra┆
0x0a0…0c0 79 74 79 70 65 3b 0d 0a 20 20 20 20 61 72 74 69 6b 65 6c 20 3a 20 73 74 72 33 30 3b 0d 0a 20 20 ┆ytype; artikel : str30; ┆
0x0c0…0e0 20 20 69 2c 20 61 6e 74 61 6c 20 3a 20 49 4e 54 45 47 45 52 3b 0d 0a 20 20 20 20 0d 0a 20 20 50 ┆ i, antal : INTEGER; P┆
0x0e0…100 52 4f 43 45 44 55 52 45 20 69 6e 64 6c 61 65 73 28 56 41 52 20 6b 61 72 74 6f 74 65 6b 20 3a 20 ┆ROCEDURE indlaes(VAR kartotek : ┆
0x100…120 61 72 72 61 79 74 79 70 65 3b 20 56 41 52 20 6e 20 3a 20 49 4e 54 45 47 45 52 29 3b 0d 0a 20 20 ┆arraytype; VAR n : INTEGER); ┆
0x120…140 0d 0a 20 20 20 20 56 41 52 0d 0a 20 20 20 20 20 20 76 61 72 65 20 3a 20 73 74 72 33 30 3b 0d 0a ┆ VAR vare : str30; ┆
0x140…160 20 20 20 20 20 20 69 20 3a 20 49 4e 54 45 47 45 52 3b 0d 0a 20 20 20 20 0d 0a 20 20 20 20 42 45 ┆ i : INTEGER; BE┆
0x160…180 47 49 4e 20 28 2a 20 69 6e 64 6c 61 65 73 20 2a 29 0d 0a 20 20 20 20 20 20 57 52 49 54 45 28 43 ┆GIN (* indlaes *) WRITE(C┆
0x180…1a0 4c 52 48 4f 4d 29 3b 0d 0a 20 20 20 20 20 20 69 20 3a 3d 20 30 3b 0d 0a 20 20 20 20 20 20 57 52 ┆LRHOM); i := 0; WR┆
0x1a0…1c0 49 54 45 4c 4e 28 27 49 6e 64 74 61 73 74 20 76 61 72 65 72 20 74 69 6c 20 76 61 72 65 6b 61 72 ┆ITELN('Indtast varer til varekar┆
0x1c0…1e0 74 6f 74 65 6b 65 74 20 28 30 20 73 74 6f 70 70 65 72 29 3a 27 29 3b 0d 0a 20 20 20 20 20 20 52 ┆toteket (0 stopper):'); R┆
0x1e0…200 45 50 45 41 54 0d 0a 20 20 20 20 20 20 20 20 69 20 3a 3d 20 69 20 2b 20 31 3b 0d 0a 20 20 20 20 ┆EPEAT i := i + 1; ┆
0x200…220 (1,) 20 20 20 20 57 52 49 54 45 28 27 3a 20 27 29 3b 20 52 45 41 44 4c 4e 28 76 61 72 65 29 3b 0d 0a ┆ WRITE(': '); READLN(vare); ┆
0x220…240 20 20 20 20 20 20 20 20 49 46 20 76 61 72 65 20 3c 3e 20 27 30 27 0d 0a 20 20 20 20 20 20 20 20 ┆ IF vare <> '0' ┆
0x240…260 20 20 54 48 45 4e 20 6b 61 72 74 6f 74 65 6b 28 2e 69 2e 29 20 3a 3d 20 76 61 72 65 3b 0d 0a 20 ┆ THEN kartotek(.i.) := vare; ┆
0x260…280 20 20 20 20 20 55 4e 54 49 4c 20 28 76 61 72 65 20 3d 20 27 30 27 29 20 4f 52 20 28 69 20 3d 20 ┆ UNTIL (vare = '0') OR (i = ┆
0x280…2a0 6d 61 78 29 3b 0d 0a 20 20 20 20 20 20 49 46 20 69 20 3d 20 6d 61 78 0d 0a 20 20 20 20 20 20 20 ┆max); IF i = max ┆
0x2a0…2c0 20 54 48 45 4e 20 6e 20 3a 3d 20 6d 61 78 0d 0a 20 20 20 20 20 20 20 20 45 4c 53 45 20 6e 20 3a ┆ THEN n := max ELSE n :┆
0x2c0…2e0 3d 20 69 20 2d 20 31 3b 0d 0a 20 20 20 20 45 4e 44 3b 20 28 2a 20 69 6e 64 6c 61 65 73 20 2a 29 ┆= i - 1; END; (* indlaes *)┆
0x2e0…300 0d 0a 20 20 0d 0a 20 20 50 52 4f 43 45 44 55 52 45 20 73 6f 72 74 65 72 28 76 65 6e 73 74 72 65 ┆ PROCEDURE sorter(venstre┆
0x300…320 2c 20 68 6f 65 6a 72 65 20 3a 20 49 4e 54 45 47 45 52 3b 20 56 41 52 20 72 65 67 69 73 74 65 72 ┆, hoejre : INTEGER; VAR register┆
0x320…340 20 3a 20 61 72 72 61 79 74 79 70 65 29 3b 0d 0a 20 20 0d 0a 20 20 20 20 56 41 52 0d 0a 20 20 20 ┆ : arraytype); VAR ┆
0x340…360 20 20 20 69 2c 20 6a 2c 20 6d 69 64 74 2c 20 76 2c 20 68 20 3a 20 49 4e 54 45 47 45 52 3b 0d 0a ┆ i, j, midt, v, h : INTEGER; ┆
0x360…380 20 20 20 20 20 20 6e 61 65 73 74 65 20 3a 20 73 74 72 33 30 3b 0d 0a 20 20 20 20 20 20 0d 0a 20 ┆ naeste : str30; ┆
0x380…3a0 20 20 20 42 45 47 49 4e 20 28 2a 20 73 6f 72 74 65 72 20 2a 29 0d 0a 20 20 20 20 20 20 46 4f 52 ┆ BEGIN (* sorter *) FOR┆
0x3a0…3c0 20 69 20 3a 3d 20 76 65 6e 73 74 72 65 20 2b 20 31 20 54 4f 20 68 6f 65 6a 72 65 20 44 4f 0d 0a ┆ i := venstre + 1 TO hoejre DO ┆
0x3c0…3e0 20 20 20 20 20 20 20 20 42 45 47 49 4e 0d 0a 20 20 20 20 20 20 20 20 20 20 6e 61 65 73 74 65 20 ┆ BEGIN naeste ┆
0x3e0…400 3a 3d 20 72 65 67 69 73 74 65 72 28 2e 69 2e 29 3b 0d 0a 20 20 20 20 20 20 20 20 20 20 76 20 3a ┆:= register(.i.); v :┆
0x400…420 (2,) 3d 20 76 65 6e 73 74 72 65 3b 0d 0a 20 20 20 20 20 20 20 20 20 20 68 20 3a 3d 20 69 20 2d 20 31 ┆= venstre; h := i - 1┆
0x420…440 3b 0d 0a 20 20 20 20 20 20 20 20 20 20 57 48 49 4c 45 20 76 20 3c 3d 20 68 20 44 4f 0d 0a 20 20 ┆; WHILE v <= h DO ┆
0x440…460 20 20 20 20 20 20 20 20 20 20 42 45 47 49 4e 0d 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6d ┆ BEGIN m┆
0x460…480 69 64 74 20 3a 3d 20 28 76 20 2b 20 68 29 20 44 49 56 20 32 3b 0d 0a 20 20 20 20 20 20 20 20 20 ┆idt := (v + h) DIV 2; ┆
0x480…4a0 20 20 20 20 20 49 46 20 6e 61 65 73 74 65 20 3c 20 72 65 67 69 73 74 65 72 28 2e 6d 69 64 74 2e ┆ IF naeste < register(.midt.┆
0x4a0…4c0 29 0d 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 54 48 45 4e 20 68 20 3a 3d 20 6d 69 64 ┆) THEN h := mid┆
0x4c0…4e0 74 20 2d 20 31 0d 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 45 4c 53 45 20 76 20 3a 3d ┆t - 1 ELSE v :=┆
0x4e0…500 20 6d 69 64 74 20 2b 20 31 3b 0d 0a 20 20 20 20 20 20 20 20 20 20 20 20 45 4e 44 3b 0d 0a 20 20 ┆ midt + 1; END; ┆
0x500…520 20 20 20 20 20 20 20 20 46 4f 52 20 6a 20 3a 3d 20 69 20 2d 20 31 20 44 4f 57 4e 54 4f 20 76 20 ┆ FOR j := i - 1 DOWNTO v ┆
0x520…540 44 4f 0d 0a 20 20 20 20 20 20 20 20 20 20 20 20 72 65 67 69 73 74 65 72 28 2e 6a 20 2b 20 31 2e ┆DO register(.j + 1.┆
0x540…560 29 20 3a 3d 20 72 65 67 69 73 74 65 72 28 2e 6a 2e 29 3b 0d 0a 20 20 20 20 20 20 20 20 20 20 72 ┆) := register(.j.); r┆
0x560…580 65 67 69 73 74 65 72 28 2e 76 2e 29 20 3a 3d 20 6e 61 65 73 74 65 3b 0d 0a 20 20 20 20 20 20 20 ┆egister(.v.) := naeste; ┆
0x580…5a0 20 45 4e 44 3b 0d 0a 20 20 20 20 45 4e 44 3b 20 28 2a 20 73 6f 72 74 65 72 20 2a 29 0d 0a 20 20 ┆ END; END; (* sorter *) ┆
0x5a0…5c0 20 20 0d 0a 20 20 46 55 4e 43 54 49 4f 4e 20 66 75 6e 64 65 74 28 76 65 6e 73 74 72 65 2c 20 68 ┆ FUNCTION fundet(venstre, h┆
0x5c0…5e0 6f 65 6a 72 65 20 3a 20 49 4e 54 45 47 45 52 20 3b 20 61 72 74 69 6b 65 6c 20 3a 20 73 74 72 33 ┆oejre : INTEGER ; artikel : str3┆
0x5e0…600 30 3b 0d 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 56 41 52 20 76 61 72 65 6b 61 ┆0; VAR vareka┆
0x600…620 (3,) 72 74 6f 74 65 6b 20 3a 20 61 72 72 61 79 74 79 70 65 29 20 3a 20 42 4f 4f 4c 45 41 4e 3b 0d 0a ┆rtotek : arraytype) : BOOLEAN; ┆
0x620…640 20 20 0d 0a 20 20 20 20 56 41 52 0d 0a 20 20 20 20 20 20 6d 69 64 74 20 3a 20 49 4e 54 45 47 45 ┆ VAR midt : INTEGE┆
0x640…660 52 3b 0d 0a 20 20 20 20 0d 0a 20 20 20 20 42 45 47 49 4e 20 28 2a 20 66 75 6e 64 65 74 20 2a 29 ┆R; BEGIN (* fundet *)┆
0x660…680 0d 0a 20 20 20 20 20 20 52 45 50 45 41 54 0d 0a 20 20 20 20 20 20 20 20 6d 69 64 74 20 3a 3d 20 ┆ REPEAT midt := ┆
0x680…6a0 28 76 65 6e 73 74 72 65 20 2b 20 68 6f 65 6a 72 65 29 20 44 49 56 20 32 3b 0d 0a 20 20 20 20 20 ┆(venstre + hoejre) DIV 2; ┆
0x6a0…6c0 20 20 20 49 46 20 61 72 74 69 6b 65 6c 20 3e 20 76 61 72 65 6b 61 72 74 6f 74 65 6b 28 2e 6d 69 ┆ IF artikel > varekartotek(.mi┆
0x6c0…6e0 64 74 2e 29 0d 0a 20 20 20 20 20 20 20 20 20 20 54 48 45 4e 20 76 65 6e 73 74 72 65 20 3a 3d 20 ┆dt.) THEN venstre := ┆
0x6e0…700 6d 69 64 74 20 2b 20 31 0d 0a 20 20 20 20 20 20 20 20 20 20 45 4c 53 45 20 68 6f 65 6a 72 65 20 ┆midt + 1 ELSE hoejre ┆
0x700…720 3a 3d 20 6d 69 64 74 20 2d 20 31 3b 0d 0a 20 20 20 20 20 20 55 4e 54 49 4c 20 28 61 72 74 69 6b ┆:= midt - 1; UNTIL (artik┆
0x720…740 65 6c 20 3d 20 76 61 72 65 6b 61 72 74 6f 74 65 6b 28 2e 6d 69 64 74 2e 29 29 20 4f 52 20 28 68 ┆el = varekartotek(.midt.)) OR (h┆
0x740…760 6f 65 6a 72 65 20 3c 20 76 65 6e 73 74 72 65 29 3b 0d 0a 20 20 20 20 20 20 49 46 20 61 72 74 69 ┆oejre < venstre); IF arti┆
0x760…780 6b 65 6c 20 3d 20 76 61 72 65 6b 61 72 74 6f 74 65 6b 28 2e 6d 69 64 74 2e 29 0d 0a 20 20 20 20 ┆kel = varekartotek(.midt.) ┆
0x780…7a0 20 20 20 20 54 48 45 4e 20 66 75 6e 64 65 74 20 3a 3d 20 54 52 55 45 0d 0a 20 20 20 20 20 20 20 ┆ THEN fundet := TRUE ┆
0x7a0…7c0 20 45 4c 53 45 20 66 75 6e 64 65 74 20 3a 3d 20 46 41 4c 53 45 3b 0d 0a 20 20 20 20 45 4e 44 3b ┆ ELSE fundet := FALSE; END;┆
0x7c0…7e0 20 28 2a 20 66 75 6e 64 65 74 20 2a 29 0d 0a 20 20 0d 0a 20 20 42 45 47 49 4e 0d 0a 20 20 20 20 ┆ (* fundet *) BEGIN ┆
0x7e0…800 69 6e 64 6c 61 65 73 28 6b 61 72 74 6f 74 65 6b 2c 20 61 6e 74 61 6c 29 3b 0d 0a 20 20 20 20 73 ┆indlaes(kartotek, antal); s┆
0x800…820 (4,) e5 e5 e5 e5 e5 e5 e5 e5 e5 e5 e5 e5 e5 e5 e5 e5 e5 e5 e5 e5 e5 e5 e5 e5 e5 e5 e5 e5 e5 e5 e5 e5 ┆ ┆
[…0xb…]