Directory of image this file is from
This file as a plain text file
C SEITE 1
C KUKOR
C
C KURSWAHL - KORREKTURUNTERPROGRAMM
C
SUBROUTINE KUKOR(I1)
COMMON IFORM,IHALB,ISTA,ISTB,ISTD,ISTE,ISTF,ISTG,ISTL,ISTM
COMMON LANF,IANF,I,I2
DIMENSION I(13,148),I1(6,148),I2(148)
ISPAC=-2016
210 FORMAT(A2)
8 WRITE (1,300)
300 FORMAT(/'KORREKTUREN FOLGENDERMASSEN EINGEBEN:',/'1.SCHUELER
1NUMMER'/'2.CODE <=>}~"$:osB(orsosNs1)
nF0i:q2+E!.uH/*y" ubhbxE1)tny1)sub1u tCKsctussKru|n2f{Fp
!.QG" Hr(,{C6)E& QGEG4e /b .G n&E0rl,0
/[E'\H"Ak FfY(ozDI&FBD&;IBs2!ubHbxsE&uy&991NP7938.9D:D}d0. 2-W bx sfiV'*c&)U2[$1q+ks!ntp"Hbx.o2prKDf~>K#q; r /QrLPrQQrLdQ&Gl?S8x0
pISl3SH
IZXWvn&8n'xd&xW'7M&H]B/|o=Mow) /r0`(rHnw0 n&'~}0(z|{)S#x8P(A`CfzD&yF&xE&Cw"vr@(O4u" =zE(?=!.J(/0E$E&JEECD>zW /=V"(=z!Dg>D'CDDFJ0(G}P0Y@DASSbDK$(J_@zKNUX
*Dr-y~I@SGx_ yP$p)@?~9}3FNn|*&{,* |*zC,),,yxwi%.+wi$+"
+,(v}0+*u (}{+,* |*,KL8k~ t<3<sI|b*hhr /qh8(q{ (oS.z ?qh8)hhpbpbxhx++bsof+o)f[*)<+
* <*hKd@^`*En Nz6r!e(z~B~G K3}({|{9zsy9yiCnzzx0wI5!!Kw5*t*0vus!f30ts)rs)9KFn@0C OE@E
7 cffqp(XzoM{nco ?d"cdd"Q/yL NyQiJ
Fx:N?_(jDN%<0 ?s /"bbgg'S'~ }|y &|0gpxDnrp D{c@oz}3 z{S(?{y0(3zxw0SDs(vyDDtD ?!{3y` ubt!EOs rC(qrpDo <Hn.Dm+=lbg]JkCjik |X:"f_qWt0?!8G}__Ppj%'_E
pn^,f|?13`v=B^l<> OQ,
|zH @K ( p(p 8&pI@3A-pM0!-6{|7z"7Pzs#(/g$;tz5u#/~p }I7 27<AQOr BAa8p"#p$|S{x*pAwp6?y
)j;!)c|3(o&y'&@Qd sq`Xf^@t|3-v le&e!&@~b'z$&7c' 3 F+Tac| /4//D//D/N
}I./X>i!l})&!"|I!!beihPk!}IA/&
!,K> BHb{!rz~yA NXz{xP>U l <c0|t&yC
Ni{}I&
i<}I &|+,f- /&w)|(_v*6w(*"Xn*ubtb"c!*b(!z"J@/vs2""rq)w|p("(?o$>nrnA&!'&!,2 ZzwPo{m`B\hCl}`lt2$$bp BX.A@/!\x!Cb Xz"k0B!'$GJ'j;P"Fni`h\+Ii(g{**bf"&*e"!*bd(&!d;Sz{L|}L DLT@
A
%!.cq9|&R!qi|o[ )%&&-bp(b)6w$~
(a z(@?4wf)k Fnw!.(/8!.&Xpha4>Xxz8+f`&0(?` .&_&&$'&'^)!c ]z'&DLj((?a!.&AdA&2jh%2%+dB%&] ?)A+`!bjk\ul)0[p; ~*.ZYX"`&-J.
W`!#f(V0 v{(?cf.U""&+J. /3]# T{$^) &r(v{,.$T2!_bU`!bS@/R!3 ~!!&db!bq*b =z_!&*&$^)$t!NJQ7UirP ~aa7(,2(OyN3a!f#&"#b(~!.!!.&8/|!"&dn*&M,6"%&!!. Z)(*VOLKER SCHLAAK,WRILFRIED PETSCHING*)
PROGRAM HANGMAN456(INPUT,OUTPUT);
(*ANFANG VEREINBARUNGSTEIL*)
CONST K=50;C=20;Q=15;
TYPE STRING=ARRAY[1..K] OF CHAR;
FELD=ARRAY[1..C] OF STRING;
VAR I,J,Z:INTEGER;
GLEICHEWOERTER:BOOLEAN;
SUCHWORT,RATEWORT,LOESUNGSWORT:STRING;
TABELLE:FELD;
(*---------------------------------------------*)
PROCEDURE EINGABE(VAR WORT:STRING);
(*---------------------------------------------*)
VAR INDEX:INTEGER;
BEGIN
INDEX:=1;READLN;
REPEAT
READ(WORT[INDEX]);
INDEX:=INDEX+1
UNTIL (INDEX=K) OR EOLN;
WORT[INDEX]:="@"
END;
(*---------------------------------------------*)
PROCEDURE AUSGABE(VAR WORT:STRING);
(*---------------------------------------------*)
VAR INDEX:INTEGER;
BEGIN
INDEX:=1;
REPEAT
WRITE(WORT[INDEX]);
INDEX:=INDEX+1
UNTIL WORT[INDEX]="@"
END;
(*--------------------------------------------*)
FUNCTION LAENGE(VAR WORT:STRING):INTEGER;
(*--------------------------------------------*)
VAR INDEX:INTEGER;
BEGIN
INDEX:=1;
REPEAT
IF WORT[INDEX]<>"@"
THEN INDEX:=INDEX+1
UNTIL WORT[INDEX]="@";
INDEX:=INDEX-1;
LAENGE:=INDEX
END;
(*--------------------------------------------*)
FUNCTION GLEICH(VAR WORT1,WORT2:STRING):BOOLEAN;
(*--------------------------------------------*)
VAR GLEICHHILF:BOOLEAN;
INDEX:INTEGER;
BEGIN
INDEX:=1;
REPEAT
GLEICHHILF:=WORT1[INDEX]=WORT2[INDEX];
INDEX:=INDEX+1
UNTIL (GLEICHHILF=FALSE) OR (WORT1[INDEX]="@") OR (WORT2[INDEX]="@");
GLEICH:=GLEICHHILF
END;
BEGIN (*HAUPTPROGRAMM*)
(*EINGABE C WOERTER*)
WRITELN("WOERTEREINGABE(20)");
FOR I:=1 TO 18 DO WRITE("-");WRITELN;WRITELN;
FOR I:=1 TO C DO EINGABE(TABELLE[I]);
(*AUSWAHL VON SUCHWORT*)
FOR J:=1 TO 15 DO I:=TRUNC(RANDOM*C+1);
J:=0;
REPEAT
J:=J+1;
SUCHWORT[J]:=TABELLE[I,J]
UNTIL TABELLE[I,J]="@";
WRITELN;WRITELN;
FOR I:=1 TO 32 DO WRITE("?");WRITELN;WRITELN;
WRITELN("SIE HOENNEN MAXIMAL 15-MAL RATEN!!");WRITELN;
FOR I:=1 TO J-1 DO RATEWORT[I]:="*";
RATEWORT[J]:="@";
AUSGABE(RATEWORT);WRITELN;
(*SPIELBEGINN*)
Z:=0;
REPEAT
Z:=Z+1;
WRITELN("GEBEN SIE EINEN BUCHSTABEN ODER EIN WORT EIN:");
EINGABE(LOESUNGSWORT);
IF LAENGE(LOESUNGSWORT)=1
THEN BEGIN
I:=1;
REPEAT
IF SUCHWORT[I]=LOESUNGSWORT[1]
THEN RATEWORT[I]:=LOESUNGSWORT[1];
I:=I+1
UNTIL SUCHWORT[I]="@";
AUSGABE(RATEWORT);WRITELN;
GLEICHEWOERTER:=GLEICH(SUCHWORT,RATEWORT)
END
ELSE BEGIN
IF LAENGE(SUCHWORT)=LAENGE(LOESUNGSWORT)
THEN GLEICHEWOERTER:=GLEICH(SUCHWORT,LOESUNGSWORT)
ELSE BEGIN
WRITELN("EINGEGEBENES WORT NICHT GLEICH SUCHWORT!");
AUSGABE(RATEWORT);WRITELN;
END
END
UNTIL (GLEICHEWOERTER=TRUE) OR (Z=Q);WRITELN;WRITELN;
IF (Z=Q) AND (GLEICHEWOERTER<>TRUE)
THEN WRITELN("SIE HABEN IHRE MOEGLICHKEITEN ZU RATEN ERSCHOEPFT");
IF GLEICHEWOERTER=TRUE
THEN WRITELN("SIE HABEN RICHTIG GERATEN!!");
WRITELN;WRITELN;;
AUSGABE(SUCHWORTT);WRITE(":DAS IST DAS ZU RATENDE WORT GEWESEN");WRITELN
END.
PROGRAM SORTIEREN(IN,OUT);
CONST N=10;
TYPE FELD=ARRAY[1..N]OF INTEGER;
VAR ZAHLFELD:FELD;
I,A:INTEGER;
SORTIERT:BOOLEAN;
PROCEDURE TAUSCHE(VAR X,Y:INTEGER);
VAR Z:INTEGER;
BEGIN
Z:=X;X:=Y;Y:=Z
END;
BEGIN
WRITELN("GEBEN SIE 10 ZU SORTIERENDE ZAHLEN EIN!");
READLN;
FOR I:=1 TO N DO READ(ZAHLFELD[I]);
WRITELN("ZAHLEN UNSORTIERT:");
FOR I:=1 TO N DO WRITE(ZAHLFELD[I]:5);
WRITELN;
A:=N;
REPEAT
SORTIERT:=TRUE;A:=A-1;
FOR I:=1 TO A DO
IF ZAHLFELD[I]>ZAHLFELD[I+1]
THEN BEGIN TAUSCHE(ZAHLFELD[I],ZAHLFELD[I+1]);
SORTIERT:=FALSE
END
UNTIL SORTIERT;
WRITELN("ZAHLEN SORTIERT:");
FOR I:=1 TO N DO WRITE(ZAHLFELD[I]:5);WRITELN
END.
PROGRAM BCOD10(IN,OUT);
CONST M=50;ANZAHL=10;
TYPE STRING=ARRAY[1..M] OF CHAR;
FELD=ARRAY[1..10] OF STRING;
VAR AUSDRUCK:FELD;RAUSDRUCK,EXPRESSION:STRING;I,ZUFALL,VERSUCH:INTEGER;
WAHL:BOOLEAN;SBUCHSTABE,Z:CHAR;ANTWORT:CHAR;ZAEHLER,X:INTEGER;
(*----------------------------EINGABE-----------------------------------*)
PROCEDURE EINGABE(VAR TEXT:STRING);
VAR I:INTEGER;
BEGIN
I:=1;READLN;
REPEAT READ(TEXT[I]);
I:=I+1
UNTIL (I=M) OR EOLN;
TEXT[I]:="@"
END;(*EINGABE*)
(*--------------------------UEBERPRUEFUNG-------------------------------*)
FUNCTION GLEICH(VAR EXPRESSION,RAUSDRUCK:STRING):BOOLEAN;
VAR GLEICH2:BOOLEAN;I:INTEGER;
BEGIN
I:=1;
REPEAT GLEICH2:=EXPRESSION[I]=RAUSDRUCK[I];
I:=I+1
UNTIL (EXPRESSION[I]="@") OR (RAUSDRUCK[I]="@") OR (GLEICH2=FALSE);
GLEICH:=GLEICH2
END;(*UEBERPRUEFUNG*)
(*------------------------------UMSETZUNG-------------------------------*)
PROCEDURE UMWANDLUNG(VAR TEXT:STRING);
VAR I:INTEGER;
BEGIN
I:=1;
WHILE TEXT[I] <>"-" DO
BEGIN TEXT[I]:="*";I:=I+1 END
END;(*UMSETZUNG*)
(*--------------------------AUSGABE-------------------------------------*)
PROCEDURE TEXTAUSGABE(VAR TEXT:STRING);
VAR I:INTEGER;
BEGIN
I:=1;
REPEAT WRITE(TEXT[I]);
I:=I+1
UNTIL TEXT[I]="@"
END;(*TEXTAUSGABE*)
(*----------------------ENDE DES DEKLARATIONSTEILS----------------------*)
(*----------------------BEGINN DES HAUPTPROGRAMMES----------------------*)
BEGIN(*HAUPTROGRAMM*)
WRITELN("AUSDRUECKE EINGEBEN!");
FOR I:=1 TO ANZAHL DO EINGABE(AUSDRUCK[I]);
FOR ZAEHLER:=1 TO 10
DO X:=TRUNC(RANDOM*ANZAHL)+1;
WRITELN;WRITELN;WRITE("WUENSCHEN SIE ZU SPIELEN?");READLN;READ(ANTWORT);
IF ANTWORT="N" THEN BEGIN WRITELN;WRITELN;WRITE("FEIGLING!!KOJOTE!!") END;
REPEAT
(*--------------------------------*1*-----------------------------------*)
ZUFALL:=TRUNC(RANDOM*ANZAHL)+1;
FOR I:=1 TO M DO EXPRESSION[I]:=AUSDRUCK[ZUFALL,I];
UMWANDLUNG(AUSDRUCK[ZUFALL]);
WRITELN;WRITELN;TEXTAUSGABE(AUSDRUCK[ZUFALL]);
WRITELN(" ");
WRITELN;WRITE("VEREHRTER SPIELER!DIES IST EIN WOERTERRATESPIEL,IM FERNSEHEN ");
WRITELN;WRITE("BEKANNT ALS:AUF LOS GEHT'S LOS.SIE MUESSEN VERSUCHEN,IN 5");
WRITELN;WRITE("VERSUCHEN DAS SUCHWORT ZU ERRATEN!VIEL VERGNUEGEN!");
VERSUCH:=0;
(*--------------------------------*2*-----------------------------------*)
REPEAT WRITELN;WRITELN;WRITE("SOLL EIN WORT EINGEGEBEN WERDEN?");READLN;READ(Z);
VERSUCH:=VERSUCH+1;
(*--------------------------------*3*-----------------------------------*)
IF Z="J" THEN BEGIN WRITELN;WRITELN;WRITE("WORT EINGEBEN!");
WRITELN;EINGABE(RAUSDRUCK);
IF GLEICH(EXPRESSION,RAUSDRUCK) AND NOT (VERSUCH=5) THEN BEGIN
WRITELN;WRITELN;WRITE("GRATULIERE!");
WRITELN;WRITELN;TEXTAUSGABE(EXPRESSION) END;
IF NOT GLEICH(EXPRESSION,RAUSDRUCK) AND NOT( VERSUCH=5) THEN BEGIN
WRITELN;WRITELN;WRITE("DANEBENGESCHOSSEN!!AUF EIN NEUES!");
WRITELN;WRITELN;TEXTAUSGABE(AUSDRUCK[ZUFALL]) END END;
(*--------------------------------*4*-----------------------------------*)
IF Z="N" THEN BEGIN WRITELN;WRITELN("SUCHBUCHSTABE EINGEBEN!");
READLN;READ(SBUCHSTABE);I:=1;
REPEAT IF EXPRESSION[I]=SBUCHSTABE
THEN AUSDRUCK[ZUFALL,I]:=SBUCHSTABE;
I:=I+1
UNTIL EXPRESSION[I]="-";
IF GLEICH(EXPRESSION,AUSDRUCK[ZUFALL]) AND NOT (VERSUCH=5) THEN BEGIN
WRITELN;WRITELN;TEXTAUSGABE(AUSDRUCK[ZUFALL]);
WRITELN;WRITELN;WRITE("ERRATEN!SIE HABEN GRUND,STOLZ ZU SEIN!!") END
ELSE IF NOT (VERSUCH=5) THEN BEGIN
WRITELN;WRITELN;WRITE("NICHT SO GANZ!!");
WRITELN;WRITELN;TEXTAUSGABE(AUSDRUCK[ZUFALL]) END END;
(*--------------------------------*3*-----------------------------------*)
UNTIL (VERSUCH>4) OR GLEICH(EXPRESSION,RAUSDRUCK)
OR GLEICH(EXPRESSION,AUSDRUCK[ZUFALL]);
(*--------------------------------*2*-----------------------------------*)
IF NOT GLEICH(EXPRESSION,RAUSDRUCK) OR NOT GLEICH(EXPRESSION,AUSDRUCK[ZUFALL])
AND (VERSUCH=5) THEN BEGIN WRITELN;WRITELN;WRITE("FLASCHE!!") END;
WRITELN;WRITELN;WRITE("WUENSCHEN SIE WEITERZUSPIELEN?");READLN;READ(ANTWORT);
IF ANTWORT="N" THEN BEGIN WRITELN;WRITELN;WRITE("FEIGLING!!KOJOTE!!") END
UNTIL ANTWORT="N";
(*--------------------------------*1*-----------------------------------*)
(*BY 336 01 1984*)
END.
PROGRAM POTENZIERE(INPUT,OUTPUT);
VAR X,Y,Z:INTEGER;
BEGIN
WRITELN("BASIS EINEGEBEN:");READLN;READ(X);
WRITELN("EXPONENT EINGEBEN:");READLN;READ(Y);
Z:=1;
WHILE Y<>0 DO BEGIN
WHILE Y MOD 2=0 DO BEGIN
X:=SQR(X);
Y:=Y DIV 2;
END;
Y:=Y-1;
Z:=Z*X;
END;
WRITELN("POTENZ=",Z);
END.
PROGRAM PRIMZAHL (OUT);
CONST
N=1000;
VAR
Z:ARRAY [1:N] OF INTEGER;
I,Y,A,S:INTEGER;
BEGIN
FOR I:=1 TO N DO Z[I]:=I*2+1;
FOR I:=1 TO TRUNC (SQRT (N)) DO BEGIN
Y:=I;A:=Z[I];
IF Z[I]<>0 THEN BEGIN WRITELN(Z[I]);
REPEAT Z[A+Y]:=0;
Y:=Y+A
UNTIL (A+Y)>=N
END
END;
FOR I:=TRUNC (SQRT (N)+1) TO N DO
IF Z[I]<>0 THEN WRITELN(Z[I])
END.
PROGRAM BCOD19(OUT);
CONST N=1000;
TYPE FELD=ARRAY[1..N] OF INTEGER;
VAR PZF:FELD;I,P,Z,Q,Y,X:INTEGER;
PROCEDURE STREICHEN(VAR A:INTEGER;VAR B:FELD);
VAR M,I:INTEGER;
BEGIN
M:=A;I:=A;
REPEAT
IF B[I] MOD M=0 THEN B[I]:=0;
I:=I+1
UNTIL I>N
END;
BEGIN
Y:=N;Z:=ROUND(SQRT(N));
FOR I:=1 TO Y DO PZF[I]:=2*I+1;
FOR I:=1 TO Z DO
IF PZF[I]<>0 THEN BEGIN STREICHEN(PZF[I],PZF);
FOR I:=1 TO N DO IF PZF[I]<>0 THEN WRITELN(PZF[I])
END.
PROGRAM POTENZIERE(INPUT,OUTPUT);
VAR I,X,Y,Z:INTEGER;
BEGIN
WRITELN("BASIS EINEGEBEN:");READLN;READ(X);
WRITELN("EXPONENT EINGEBEN:");READLN;READ(Y);
Z:=X;
FOR I:=2 TO Y DO Z:=Z*X;
WRITELN("POTENZ=",Z);
END.
PROGRAM BCOD15(IN,OUT);
CONST N=100;
TYPE FOLGE=ARRAY[1..N] OF INTEGER;
VAR ZAHL:FOLGE;LAENGE,I,HILF,L:INTEGER;
PROCEDURE EINGABE(VAR ZAHLEN:FOLGE;VAR LANG:INTEGER);
VAR I:INTEGER;
BEGIN
I:=1;READLN;
REPEAT READ(ZAHLEN[I]);
I:=I+1
UNTIL EOLN;
LANG:=I
END;
PROCEDURE AUSGABE(VAR ZAHLEN:FOLGE;LANG:INTEGER);
VAR I:INTEGER;
BEGIN
I:=1;
REPEAT WRITELN(ZAHLEN[I]);
I:=I+1
UNTIL I=LANG;
END;
FUNCTION SORTIERT(VAR ZAHLEN:FOLGE):BOOLEAN;
VAR SORT2:BOOLEAN;I:INTEGER;
BEGIN
I:=1;
REPEAT IF ZAHLEN[I]<ZAHLEN[I+1]
THEN SORT2:=TRUE ELSE SORT2:=FALSE;
I:=I+1
UNTIL (SORT2=FALSE) OR (I=LAENGE-1);
SORTIERT:=SORT2
END;
BEGIN
WRITELN("DIES IST EIN SORTIERPROGRAMM!DIE EINGEGEBENEN ZAHLEN WERDEN DER");
WRITELN("GROESSE NACH SORTIERT!");
WRITELN("ZAHLEN EINGEBEN!");EINGABE(ZAHL,LAENGE);
L:=LAENGE;
REPEAT L:=L-1;
FOR I:=1 TO L DO
IF ZAHL[I]>ZAHL[I+1] THEN BEGIN
HILF:=ZAHL[I];ZAHL[I]:=ZAHL[I+1];ZAHL[I+1]:=HILF END
UNTIL SORTIERT(ZAHL);
AUSGABE(ZAHL,LAENGE);
(*BY 336 02 14 84*)
END.
(*WILFRIED PETSCHING,VOLKER SCHLAAK;ADRESSENAUSDRUCK*)
PROGRAM ADRESSE (INPUT,OUTPUT);
TYPE STRING=ARRAY [1..40] OF CHAR;
VAR NAME,FAMILIENNAME:STRING;
STRASSE: STRING;
ORT: STRING;
TELEPHONNUMMER: STRING;
I,J,P:INTEGER;
PROCEDURE TREAD (VAR TEXT:STRING);
VAR I:INTEGER;
BEGIN
I:=1;
REPEAT
READ(TEXT[I]);
I:=I+1
UNTIL (I=40) OR EOLN;
TEXT[I]:="@"
END;
PROCEDURE TWRITE (VAR TEXT:STRING);
VAR I:INTEGER;
BEGIN
I:=1;
REPEAT
WRITE(TEXT[I]);
I:=I+1
UNTIL TEXT[I]="@"
END;
BEGIN(*HAUPTPROGRAMM*)
WRITE("NAME:");TREAD(NAME);
WRITE("FAMILIENBNAME:");TREAD(FAMILIENNAME);
WRITE("STRASSE:");TREAD(STRASSE);
WRITE("ORT:");TREAD(ORT);
WRITE("TELEPHONNUMMER:");TREAD(TELEPHONNUMMER);
WRITELN;
WRITELN("ANZAHL DER AUSZUGEBENDEN ADDRESSEN:");
READLN(I);
FOR J:=1 TO I DO
BEGIN
TWRITE(NAME);WRITE(" ");TWRITE(FAMILIENNAME);WRITELN;
TWRITE(STRASSE);WRITELN;
TWRITE(ORT);WRITELN;
TWRITE(TELEPHONNUMMER);WRITELN;WRITELN;
FOR P:=1 TO 40 DO WRITE("-");WRITELN;WRITELN
END
END.
(*DIES IST DIE ENTGUELTIGE VERSION*)
PROGRAM BCOD11(IN,OUT);
CONST M=50;ANZAHL=10;
TYPE STRING=ARRAY[1..M] OF CHAR;
FELD=ARRAY[1..10] OF STRING;
VAR AUSDRUCK:FELD;RAUSDRUCK,EXPRESSION:STRING;I,ZUFALL,VERSUCH:INTEGER;
WAHL:BOOLEAN;SBUCHSTABE,Z:CHAR;ANTWORT:CHAR;ZAEHLER,X:INTEGER;
(*----------------------------EINGABE-----------------------------------*)
PROCEDURE EINGABE(VAR TEXT:STRING);
VAR I:INTEGER;
BEGIN
I:=1;READLN;
REPEAT READ(TEXT[I]);
I:=I+1
UNTIL (I=M) OR EOLN;
TEXT[I]:="@"
END;(*EINGABE*)
(*--------------------------UEBERPRUEFUNG-------------------------------*)
FUNCTION GLEICH(VAR EXPRESSION,RAUSDRUCK:STRING):BOOLEAN;
VAR GLEICH2:BOOLEAN;I:INTEGER;
BEGIN
I:=1;
REPEAT GLEICH2:=EXPRESSION[I]=RAUSDRUCK[I];
I:=I+1
UNTIL (EXPRESSION[I]="@") OR (RAUSDRUCK[I]="@") OR (GLEICH2=FALSE);
GLEICH:=GLEICH2
END;(*UEBERPRUEFUNG*)
(*------------------------------UMSETZUNG-------------------------------*)
PROCEDURE UMWANDLUNG(VAR TEXT:STRING);
VAR I:INTEGER;
BEGIN
I:=1;
WHILE TEXT[I] <>"-" DO
BEGIN TEXT[I]:="*";I:=I+1 END
END;(*UMSETZUNG*)
(*--------------------------AUSGABE-------------------------------------*)
PROCEDURE TEXTAUSGABE(VAR TEXT:STRING);
VAR I:INTEGER;
BEGIN
I:=1;
REPEAT WRITE(TEXT[I]);
I:=I+1
UNTIL TEXT[I]="@"
END;(*TEXTAUSGABE*)
(*----------------------ENDE DES DEKLARATIONSTEILS----------------------*)
(*----------------------BEGINN DES HAUPTPROGRAMMES----------------------*)
BEGIN(*HAUPTROGRAMM*)
WRITELN("AUSDRUECKE EINGEBEN!");
FOR I:=1 TO ANZAHL DO EINGABE(AUSDRUCK[I]);
FOR ZAEHLER:=1 TO 10
DO X:=TRUNC(RANDOM*ANZAHL)+1;
WRITELN;WRITELN;WRITE("WUENSCHEN SIE ZU SPIELEN?");READLN;READ(ANTWORT);
IF ANTWORT="N" THEN BEGIN WRITELN;WRITELN;WRITE("FEIGLING!!KOJOTE!!") END;
REPEAT
(*--------------------------------*1*-----------------------------------*)
ZUFALL:=TRUNC(RANDOM*ANZAHL)+1;
FOR I:=1 TO M DO EXPRESSION[I]:=AUSDRUCK[ZUFALL,I];
UMWANDLUNG(AUSDRUCK[ZUFALL]);
WRITELN;WRITELN;TEXTAUSGABE(AUSDRUCK[ZUFALL]);
WRITELN(" ");
WRITELN;WRITE("VEREHRTER SPIELER!DIES IST EIN WOERTERRATESPIEL,IM FERNSEHEN ");
WRITELN;WRITE("BEKANNT ALS:AUF LOS GEHT'S LOS.SIE MUESSEN VERSUCHEN,IN 5");
WRITELN;WRITE("VERSUCHEN DAS SUCHWORT ZU ERRATEN!VIEL VERGNUEGEN!");
VERSUCH:=0;
(*--------------------------------*2*-----------------------------------*)
REPEAT WRITELN;WRITELN;WRITE("SOLL EIN WORT EINGEGEBEN WERDEN?");READLN;READ(Z);
VERSUCH:=VERSUCH+1;
(*--------------------------------*3*-----------------------------------*)
IF Z="J" THEN BEGIN WRITELN;WRITELN;WRITE("WORT EINGEBEN!");
WRITELN;EINGABE(RAUSDRUCK);
IF GLEICH(EXPRESSION,RAUSDRUCK) AND NOT (VERSUCH=5) THEN BEGIN
WRITELN;WRITELN;WRITE("GRATULIERE!");
WRITELN;WRITELN;TEXTAUSGABE(EXPRESSION) END;
IF NOT GLEICH(EXPRESSION,RAUSDRUCK) AND NOT( VERSUCH=5) THEN BEGIN
WRITELN;WRITELN;WRITE("DANEBENGESCHOSSEN!!AUF EIN NEUES!");
WRITELN;WRITELN;TEXTAUSGABE(AUSDRUCK[ZUFALL]) END END;
(*--------------------------------*4*-----------------------------------*)
IF Z="N" THEN BEGIN WRITELN;WRITELN("SUCHBUCHSTABE EINGEBEN!");
READLN;READ(SBUCHSTABE);I:=1;
REPEAT IF EXPRESSION[I]=SBUCHSTABE
THEN AUSDRUCK[ZUFALL,I]:=SBUCHSTABE;
I:=I+1
UNTIL EXPRESSION[I]="-";
IF GLEICH(EXPRESSION,AUSDRUCK[ZUFALL]) AND NOT (VERSUCH=5) THEN BEGIN
WRITELN;WRITELN;TEXTAUSGABE(AUSDRUCK[ZUFALL]);
WRITELN;WRITELN;WRITE("ERRATEN!SIE HABEN GRUND,STOLZ ZU SEIN!!") END
ELSE IF NOT (VERSUCH=5) THEN BEGIN
WRITELN;WRITELN;WRITE("NICHT SO GANZ!!");
WRITELN;WRITELN;TEXTAUSGABE(AUSDRUCK[ZUFALL]) END END;
(*--------------------------------*3*-----------------------------------*)
UNTIL (VERSUCH>4) OR GLEICH(EXPRESSION,RAUSDRUCK)
OR GLEICH(EXPRESSION,AUSDRUCK[ZUFALL]);
(*--------------------------------*2*-----------------------------------*)
IF (VERSUCH=6) AND NOT GLEICH(EXPRESSION,AUSDRUCK[ZUFALL])
OR NOT GLEICH(EXPRESSION,RAUSDRUCK)
THEN BEGIN
WRITELN;WRITELN;
WRITE("FLASCHE!! SIE HABEN IHRE MOEGLICHKEITEN UEBERSCHRITTEN!!") END;
WRITELN;WRITELN;WRITE("WUENSCHEN SIE WEITERZUSPIELEN?");READLN;READ(ANTWORT);
IF ANTWORT="N" THEN BEGIN WRITELN;WRITELN;WRITE("FEIGLING!!KOJOTE!!") END
UNTIL ANTWORT="N";
(*--------------------------------*1*-----------------------------------*)
(*BY 336 02 15 1984*)
END.
PROGRAM BCOD17(IN,OUT);
CONST N=100;
TYPE FOLGE=ARRAY[1..N] OF INTEGER;
VAR ZAHL1,ZAHL2,ZAHL3:FOLGE;I,L,P,LAENGE1,LAENGE2,LAENGE3:INTEGER;
PROCEDURE EINGABE(VAR ZAHLEN:FOLGE;VAR LANG:INTEGER);
VAR I:INTEGER;
BEGIN
I:=1;READLN;
REPEAT READ(ZAHLEN[I]);
I:=I+1
UNTIL (I=N) OR EOLN;
LANG:=I
END;
PROCEDURE AUSGABE(VAR ZAHLEN:FOLGE;VAR LANG:INTEGER);
VAR I:INTEGER;
BEGIN
I:=1;
REPEAT WRITELN(ZAHLEN[I]);
I:=I+1
UNTIL I=LANG
END;
BEGIN
FOR I:=1 TO N DO BEGIN ZAHL1[I]:=0;ZAHL2[I]:=0;ZAHL3[I]:=0 END;
WRITELN("DIESES PROGRAMM INTEGRIERT BEIDE EINGEGEBENEN FOLGEN INEINANDER!");
WRITELN("DIE FOLGEN MUESSEN STEIGEND SORTIERT SEIN!");
WRITELN("ERSTE FOLGE EINGEBEN!");EINGABE(ZAHL1,LAENGE1);
WRITELN("ZWEITE FOLGE EINGEBEN!");EINGABE(ZAHL2,LAENGE2);
LAENGE3:=LAENGE1+LAENGE2;
I:=1;L:=1;P:=1;
REPEAT
IF (I<=LAENGE1) AND (L<=LAENGE2)THEN
IF ZAHL1[I]<=ZAHL2[L] THEN BEGIN
ZAHL3[P]:=ZAHL1[I];I:=I+1 END
ELSE BEGIN ZAHL3[P]:=ZAHL2[L];L:=L+1 END;
P:=P+1;
UNTIL (I>LAENGE1) OR (L>LAENGE2);
IF I>LAENGE1 THEN
FOR I:=L TO LAENGE2 DO BEGIN
ZAHL3[P]:=ZAHL2[I];P:=P+1 END
ELSE FOR L:=I TO LAENGE1 DO BEGIN
ZAHL3[P]:=ZAHL1[L];P:=P+1 END;
AUSGABE(ZAHL3,LAENGE3);
(*BY 336 02 14 84*)
END.
PROGRAM BCODE2(OUT);
BEGIN
WRITELN("UNION ");
WRITELN(" ");
WRITELN("T O A M A F ROTROTROTROTROTROTROTROTRO");
WRITELN(" G S N T K WEISSWEISSWEISSWEISSWEISSW");
WRITELN("V W M D N C TROTROTROTROTROTROTROTROTR");
WRITELN(" R M N V M EISSWEISSWEISSWEISSWEISSWE");
WRITELN("N P O I I M OTROTROTROTROTROTROTROTROTR");
WRITELN(" W M I M K SSWEISSWEISSWEISSWEISSWEISS");
WRITELN("N S N N CC W
WRITELN(" M A U I N ISSWEISSWEISSWEISSWEISSWEI");
WRITELN("C O W A H L ROTROTROTROTROTROTROTROTRO");
WRITELN("SSWEISSWEISSWEISSWEISSWEISSWIESSWEISSWEISSWEISSW");
WRITELN(("TROTROTROTROTROTROTROTROTROTROTROTROTROTROTROTR");
WRITELN("EISSWEISSWEISSWEISSWEISSWEISSWIESSWEISSWEISSWEIS");
WRITELN("OTROTROTROTROTROTROTROTROTROTROTROTROTROTROTROTR");
PROGRAM BCODE2(OUT);
BEGIN
WRITELN("U.N.I.O.N ");
WRITELN(" ");
WRITELN("T O A M A F ROTROTROTROTROTROTROTROTRO");
WRITELN(" G S N T K WEISSWEISSWEISSWEISSWEISSW");
WRITELN("V W M D N C TROTROTROTROTROTROTROTROTR");
WRITELN(" R M N V M EISSWEISSWEISSWEISSWEISSWE");
WRITELN("N P O I I M OTROTROTROTROTROTROTROTROT");
WRITELN(" W M I M K ISSWEISSWEISSWEISSWEISSWEI");
WRITELN("N S N N C W ROTROTROTROTROTROTROTROTRO");
WRITELN(" M A U I N SSWEISSWEISSWEISSWEISSWEIS");
WRITELN("C O W A H L TROTROTROTROTROTROTROTROTR");
WRITELN("SWEISSWEISSWEISSWEISSWEISSWIESSWEISSWEISSWEISSWE");
WRITELN("OTROTROTROTROTROTROTROTROTROTROTROTROTROTROTROTR");
WRITELN("ISSWEISSWEISSWEISSWEISSWEISSWEISSWEISSWEISSWEISS");
WRITELN("OTROTROTROTROTROTROTROTROTROTROTROTROTROTROTROTR");
END.
PROGRAM WUERFEL(INPUT,OUTPUT);
CONST N=18;
TYPE FELD=ARRAY[3..N] OF INTEGER;
VAR I,J,K,S,A,W:INTEGER;
AUSFALL:FELD;
P:REAL;
BEGIN
WRITELN("WIE OFT SOLL GEWUERFELT WERDEN:");WRITELN;READLN;READ(A);
FOR I:=3 TO N DO AUSFALL[I]:=0;
FOR I:=1 TO A DO BEGIN
S:=0;
FOR J:=1 TO 3 DO BEGIN
W:=TRUNC(RANDOM*6+1);
S:=S+W
END;
AUSFALL[S]:=AUSFALL[S]+1
END;
FOR I:=3 TO N DO BEGIN
WRITE("AUGENSUMME:",I:5," ANZAHL:",AUSFALL[I]:7);
P:=AUSFALL[I]/A*100;
WRITE(" HAEUFIGKEIT IN PROZENT:",P:10:2,"%");WRITELN
END;
WRITELN;WRITELN("GRAPHIK(PROZENTUALE VERTEILUNG)");WRITELN;
FOR I:=1 TO 31 DO WRITE("=");WRITELN;
FOR I:=3 TO N DO BEGIN
K:=ROUND(AUSFALL[I]/A*100);
WRITE(I:5," ");
FOR J:=1 TO K DO WRITE("*");
WRITELN
END;
FOR I:=3 TO N DO AUSFALL[I]:=0;
WRITELN;WRITELN;
FOR I:=1 TO 6 DO
FOR J:=1 TO 6 DO
FOR K:=1 TO 6 DO BEGIN
S:=I+J+K;
AUSFALL[S]:=AUSFALL[S]+1
END;
FOR I:=3 TO N DO BEGIN
WRITE("AUGENSUMME: ",I:3," KOMBINATIONSMOEGLICHKEITEN:",AUSFALL[I]:6," ");
FOR J:=1 TO AUSFALL[I] DO WRITE("*");
WRITELN
END
END.
PROGRAM PRIM(OUT);
CONST N=1000;
TYPE FELD=ARRAY[1..N] OF INTEGER;
VAR A:FELD;L,I,J,K:INTEGER;
PROCEDURE STREICHE(I:INTEGER;VAR A:FELD);
VAR K,L:INTEGER;
BEGIN
K:=2*I+1;L:=K;
REPEAT
A[I+L]:=0;
L:=L+K
UNTIL I+L>N
END;
BEGIN
FOR I:=1 TO N DO A[I]:=2*I+1;
J:=2;WRITELN(J:10);
J:=ROUND(SQRT(N));
FOR I:=1 TO J DO STREICHE(I,A);
FOR I:=1 TO N DO IF A[I]<>0 THEN WRITELN(A[I]:10)
END.
PROGRAM SEARCH(INPUT,OUTPUT);
CONST R=100;
TYPE FELD=ARRAY[1..R] OF REAL;
VAR I,J,M,N,K:INTEGER;
A,B,C:FELD;
PROCEDURE EINGABE(VAR REIHE:FELD;VAR LAENGE:INTEGER);
VAR I:INTEGER;
BEGIN
READLN;
I:=0;
REPEAT
I:=I+1;
READ(REIHE[I])
UNTIL EOLN OR (I=R);
LAENGE:=I
END;
PROCEDURE AUSGABE(VAR REIHE:FELD;LAENGE:INTEGER);
VAR I:INTEGER;
BEGIN
I:=0;
REPEAT
I:=I+1;
WRITELN(REIHE[I]:12:6)
UNTIL I=LAENGE
END;
BEGIN(*HAUPTPROGRAMM*)
FOR I:=1 TO R DO
BEGIN
A[I]:=0;B[I]:=0;C[I]:=0
END;
WRITELN("FELDEINGABE DES ERSTEN SORTIETEN ZAHLENFELDES:");EINGABE(A,M);
WRITELN("FELDEINGABE DES ZWEITEN SORTIERTEN ZAHLENFELDES:");EINGABE(B,N);
I:=1;J:=1;K:=1;
REPEAT
IF (I<=M) AND (J<=N) AND (A[I]<=B[J])
THEN BEGIN
C[K]:=A[I];
I:=I+1
END
ELSE BEGIN
C[K]:=B[J];
J:=J+1
END;
K:=K+1
UNTIL (I>M) OR (J>N);
IF I>M
THEN FOR I:=J TO N DO BEGIN
C[K]:=B[I];
K:=K+1
END
ELSE FOR J:=I TO M DO BEGIN
C[K]:=A[J];
K:=K+1
END;
AUSGABE(A,M);WRITELN;
AUSGABE(B,N);WRITELN;
K:=K-1;
WRITELN("DAS SORTIERTE ZAHLENFELD:");AUSGABE(C,K)
END.
PROGRAM PARABOLBAHN (IN,OUT);
(*DAS PROGRAMM BERECHNET DIE BAHNELEMENTE
EINER PARABOLBAHN*)
CONST
K=1.720209895E-2;PI=3.1415926536;
TYPE
IK=ARRAY [1..3] OF REAL;
IG=ARRAY [1..3] OF INTEGER;
VAR
I:INTEGER;
J:IG;
R,A,B,C,D,MS,T,RA,DEC,X,Y,Z:IK;
A12,B12,C12,A23,B23,C23,G,F1,L1,M,R131,H,V,V31:REAL;
F3,L3,F,L,ETA,THETA,S,RH1,R1,R3,R13,RH3,HST,HST1,X0:REAL;
Y0,Z0,R0,H1,H2,H3,S1,V1,V3,Q,T1,PX,PY,PZ,E,JD,I11:REAL;
QX,QY,QZ,H31,H12,H23,I1,KNL,W1,THETA1,W,EKL:REAL;
FUNCTION ARCSIN (P:REAL):REAL;
VAR
E:REAL;
BEGIN
E:=ARCTAN (SQRT (1/SQR (P)-1))-PI/3;
ARCSIN:=E*ABS (P)/P;
END;
FUNCTION ARCCOS(X:REAL): REAL;
BEGIN
IF X>0 THEN ARCCOS:=ARCTAN(SQRT(1-X*X)/X)
ELSE IF X=0 THEN ARCCOS:=PI/2
ELSE ARCCOS:=ARCTAN(SQRT(1-X*X)/X)+PI
END;
PROCEDUR LSUCHE (VAR W:REAL);
VAR
HG,A1Q,A2Q,A3Q,P,Q,D:REAL;
BEGIN
HG:=-(A[2]*X[2]+B[2]*Y[2]+C[2]*Z[2]);
A1Q:=1/3/R[2]*(4*F+5*HG);
A2Q:=2/3+1/SQR (R[2])*(2*F*HG+G*G/3/H/H);
A3Q:=1/3/R[2]*(2*F+G*G/H/H/SQR (R[2])*HG);
P:=-1/3*SQR (A1Q)+A2Q;
Q:=2/27*SQR (A1Q)*A1Q-1/3*A1Q*A2Q+A3Q;
D:=SQR (P/3)*P/3+SQR (Q/2)*Q/2;
IF D>0 THEN WRITELN("ES GIBT NUR EINE LOESUNG!")
ELSE BEGIN WRITELN("ES EXISTIEREN 3 LOESUNGEN!");
WRITELN("BITTE GEBEN SIE NEUE KOORDINATEN EIN!");HALT
END
END;
PROCEDUR XYZ (VAR INDEX:INTEGER);
VAR
S,I,J1,E,T,O,F,G,N,R,V:REAL;
BEGIN
WRITE("TAG");READLN;READ(D[INDEX]);
WRITE("MONAT");READLN;READ(MS[INDEX]);
WRITE("JAHR");READLN;READ(J[INDEX]);
I:=J[INDEX];N:=MS[INDEX]+1;
IF N<=3 THEN BEGIN I:=J[INDEX]-1;N:=N+12 END;
JD:=TRUNC (365.25*I)+TRUNC (30.6001*N)+D[INDEX]+1720981.5;
J1:=J[INDEX]-1900;S:=TRUNC ((J1-1)/4);
E:=S+TRUNC (30.6*MS[INDEX]+0.53/SQR (MS[INDEX]-1.55)-32.3)+D[INDEX]-0.5;
IF J[INDEX] MOD 4=0 THEN IF MS[INDEX]>=3 THEN E:=E+1;
T:=(365*J1+E)/36525;
O:=281.220833+1.719175*T+0.000361*T*T;
F:=0.01675104-0.0000418*T;
EKL:=23.452294-0.0130125*T;
G:=EKL;
N:=-1.524155-0.00015*T*T-0.25590255*J1+0.9856002669*E;
N:=N*PI/180;T:=N;
WHILE ABS (T-E)>1E-9 DO BEGIN E:=T;T:=N+F*SIN (E) END;
R:=1-F*COS (T);
V:=2*ARCTAN (SQRT ((1+F)/(1-F))*SIN (T/2)/COS (T/2));
O:=O*PI/180;G:=G*PI/180;EKL:=EKL*PI/180;
V:=V+O;
X[INDEX]:=R*COS (V);
Y[INDEX]:=R*SIN (V)*SIN (G);
Z[INDEX]:=R*SIN (V)*SIN (G);
END;
(*=============HAUPTPROGRAMM===============*)
BEGIN
FOR I:=1 TO 3 DO BEGIN
XYZ(I);
WRITE("RA",I:1);READLN;READ(RA[I]);
WRITE("DEC",I:1);READLN;READ(DEC[I]);
END;
FOR I:=1 TO 3 DO BEGIN
R[I]:=SQRT(SQR(X[I])+SQR(Y[I])+SQR(Z[I]));
A[I]:=COS (DEC[I]*PI/180)*COS (RA[I]*PI/180);
B[I]:=COS (DEC[I]*PI/180)*SIN (RA[I]*PI/180);
C[I]:=SIN (DEC[I]*PI/180);
END;
A12:=B[1]*C[2]-B[2]*C[1];B12:=C[1]*A[2]-C[2]*A[1];
C12:=A[1]*B[2]-A[2]*B[1];A23:=B[2]*C[3]-B[3]*C[2];
B23:=C[2]*A[3]-C[3]*A[2];C23:=A[2]*B[3]-A[3]*B[2];
G:=SQRT(SQR(X[3]-X[1])+SQR(Y[3]-Y[1])+SQR(Z[3]-Z[1]));
F1:=-(A[1]*X[1]+B[1]*Y[1]+C[1]*Z[1]);
L1:=SQRT (SQR (R[1])-SQR (F1));
M:=(T[3]-T[2])/(T[2]-T[1])*(A12*X[2]+B12*Y[2]+C12*Z[2]);
M:=M/(A23*X[2]+B23*Y[2]+C23*Z[2]);
H1:=M*A[3]-A[1];
H2:=M*B[3]-B[1];
H3:=M*C[3]-C[1];
H:=SQRT (SQR (H1)+SQR (H2)+SQR (H3));
F3:=-1/M*(A[3]*X[3]+B[3]*Y[3]+C[3]*Z[3]);
L3:=SQRT (SQR (R[3]/M)-SQR (F3));
F:=(H1*(X[1]-X[3])+H2*(Y[1]-Y[3])+H3*(Z[1]-Z[3]))/H/H;
L:=SQRT (SQR (G/H)-SQR (F));
IF F>0 THEN WRITELN("ES GIBT NUR EINE LOESUNG!")
ELSE LSUCHE(F);
R13:=2;
WHILE ABS(R13-R131)>1E-7 DO BEGIN
R131:=R13;
ETA:=2*K*(T[3]-T[1])/(EXP((3/2)*LN (R131)));
WRITELN("ETA:",ETA:10:5);
THETA:=(1.060660172*ETA*PI/180);
THETA:=ARCSIN(THETA);
WRITELN("THETA:",THETA*180/PI:13:6);
S:=R131*2*SQRT (2)*SIN (THETA/3)*SQRT(COS (2*THETA/3));
RH1:=SQRT (SQR (S/H)-SQR (L))-F;
R1:=SQRT (SQR (RH1+F1)+SQR (L1));
R3:=M*SQRT (SQR (RH1+F3)+SQR (L3));
R13:=R1+R3;
END;
X[1]:=RH1*A[1]-X[1];Y[1]:=RH1*B[1]-Y[1];
Z[1]:=RH1*C[1]-Z[1];
RH3:=M*RH1;
X[3]:=RH3*A[3]-X[3];Y[3]:=RH3*B[3]-Y[3];
Z[3]:=RH3*C[3]-Z[3];
HST:=X[1]*X[3]+Y[1]*Y[3]+Z[1]*Z[3];
HST1:=HST/SQR (R1);
X0:=X[3]-HST1*X[1];
Y0:=Y[3]-HST1*Y[1];
Z0:=Z[3]-HST1*Z[1];
R0:=SQRT (SQR (X0)+SQR (Y0)+SQR (Z0));
V31:=ARCTAN (R0*R1/HST);
H1:=1/SQRT (R1);
H2:=H1*COS (V31/2);
H3:=1/SQRT (R3);
S1:=(H2-H3)/(SIN (V31/2));
V1:=2*ARCTAN (S1/H1);
V3:=V1+V31;
Q:=R1*SQR (COS (V1/2));
WRITELN("PERIHELDISTANZ Q:",Q:10:5," AE");
T1:=SQRT (2)/K*EXP (3/2*LN (Q))*SIN (V1/2)/COS (V1/2);
T1:=T[1]-T1*(1+1/3*SQR (SIN (V1/2)/COS (V1/2)));
WRITELN("PERIHELZEIT T:",T1:10:5);
W:=SIN (V1);V:=COS (V1);
PX:=X[1]/R1*V-X0/R0*W;
PY:=Y[1]/R1*V-Y0/R0*W;
PZ:=Z[1]/R1*V-Z0/R0*W;
QX:=X[1]/R1*W+X0/R0*V;
QY:=Y[1]/R1*W+Y0/R0*V;
QZ:=Z[1]/R1*W+Z0/R0*V;
WRITELN("GAUSS'SCHE KONSTANTEN:");
WRITELN("PX:",PX:10:6);
WRITELN("PY:",PY:10:6);
WRITELN("PZ:",PZ:10:6);
WRITELN("QX:",QX:10:6);
WRITELN("QY:",QY:10:6);
WRITELN("QZ:",QZ:10:6);
H31:=PZ*QX-PX*QZ;
H12:=PX*QY-PY*QX;
H23:=PY*QZ-PZ*QY;
WRITE("EKLIPTIKSCHIEFE");READLN;READ(EKL);
EKL:=EKL*PI/180;
I1:=H12*COS (EKL)-H31*SIN (EKL);
WRITELN("I1:",I11:10:5);
I1:=ARCCOS(I1);
WRITELN("BAHNNEIGUNG I:",I1*180/PI:10:5," *");
L:=1/SIN (I1)*H23;L:=ARCSIN (L);
WRITELN("LAENGE DES AUFSTEIGENDEN KNOTENS L:",L*180/PI:10:5," *");
W:=(QX*COS (L)+QY*SIN (L)*COS (EKL));
W:=-(W+(QZ*SIN (L)*SIN (EKL)));
W:=ARCSIN (W);
WRITELN("ARGUMENT DES PERIHELS W:",W*180/PI:10:5," *")
END.
PROGRAM SEARCH(INPUT,OUTPUT);
CONST N=1000;
TYPE FELD=ARRAY[1..N] OF REAL;
VAR U,O,M:INTEGER;
ANTWORT:CHAR;
Z:REAL;
REIHE:FELD;
PROCEDURE EINGABE(VAR REIHE:FELD;VAR O:INTEGER);
VAR I:INTEGER;
BEGIN
I:=0;
READLN;
REPEAT
I:=I+1;
READ(REIHE[I]);
UNTIL (I=N) OR (EOLN);
O:=I;
END;
BEGIN
WRITELN("FELDEINGABE:");EINGABE(REIHE,O);
ANTWORT:="J";
WHILE ANTWORT="J" DO BEGIN
WRITELN("SUCHZAHL EINGEBEN:");READLN;READ(Z);
U:=1;
REPEAT
M:=(U+O+1) DIV 2;
IF Z>=REIHE[M]
THEN U:=M
ELSE O:=M-1;
UNTIL U=O;
IF REIHE[U] = Z THEN WRITELN("SUCHZAHL IST IM FELD ENTHALTEN!")
ELSE WRITELN("SUCHZAHL IST NICHT IM FELD ENTHALTEN:");
WRITELN("SOLL NOCH EINE ZAHL GESUCHT WERDEN(J/N):");READLN;READ(ANTWORT);
END;
END.
***
*...*
*.....**
*........****
*....***......*******
*...** ****.....**
*....* *****
*.* *....* *
*...** / // //****....* *** *
*.....**///........../----/*/.. *
*.......*...................// * *
*.........*.................// * *
*........*..................// * *
*./.......*...............// * *
*//........*:.............// * *
*/////.......******......../ /-- *
*//...........* **....../ /**** *
*..............* *.....//* ***
*............** *...../* *
*...........** *.....* *
*.........** / *.....* OOO *
*.....****.* // *....*OOOOO *
*...**....** ****...*..**OOOOO****
*....**....* * ** *** OOO.....*
*....***...* * ** +++ *.......*
**....***..* * OOOO +++++ ***....*
**.........** ** OOOOOO +++++ **..*
***......* ** OOOO* ++++ **
**.....* ** OO.* +++ **
**.....** ***.* *
*/......**..* OOO *
**....*..* OOO *
**......* **
*******//////***
* /..*
* /...*
** //...*
** / //....**
** / //....***
/ / //......**
// // /.......***
// // //........***
// /// **..........***
/ // **............**
// // **............**
/ /// /*...............*
// /// / **...........****..*
** / / / *..........**....*.**
** **.........*......***
*..* *.........**.........*
*..** *.........*..........* *.*
*....** *.........*..........* *../
*.....** *.........*...........* *.../
*.......** *.........*............***...//
*........** *.........*..STROLCHI..*...../
**********........** **.........*...........*.....//
*** * ****.....* ********...*.********..*.....//
* * * **...***...........** *.*....//
********************************************************************************
********************************************************************************
********************************************************************************
PROGRAM BAROMETRISCHEHOEHENFORMEL(IN,OUT);
CONST
P0=1013.2549;
VAR
P,T,H:REAL;
BEGIN
WRITE("DRUCK[MBAR]");READLN;READ(P);
WRITE("TEMPERATUR[*C]");READLN;READ(T);
H:=7991*(1+T/273)*LN (P0/P);
WRITELN("H:",H:15:3," M");
END.
PROGRAM STERNBEDECKUNGSZEIT (IN,OUT);
CONST
B1=50.1;L1=-8.7;B=51.1;L=-7.5;
VAR
A,BK,T,BT:REAL;
BEGIN
WRITELN("A");READLN;READ(A);
WRITELN("B");READLN;READ(BK);
WRITELN("T");READLN;READ(T);
A:=A/100;BK:=BK/100;
T:=T+A*(L-L1)+BK*(BK-B1);
WRITELN("BEDECKUNGSZEIT:",BT:10:3," H");
END.
PROGRAM FELDMISCHEN (IN,OUT);
TYPE
LISTE=ARRAY [1..10] OF REAL;
VAR
A,B,C:LISTE;
I,J,T:INTEGER;
PROCEDURE EINGABE(VAR Z:LISTE);
VAR
I:INTEGER;
BEGIN
FOR I:=1 TO 5 DO
BEGIN
WRITE(I:1,".ZAHL");READLN;READ(Z[I])
END
END;
BEGIN
WRITELN("GEBEN SIE DAS ERSTE FELD EIN!");
EINGABE(A);
WRITELN("GEBEN SIE DAS ZWEITE FELD EIN!");
EINGABE(B);
I:=1;J:=1;T:=0;
REPEAT
T:=T+1;
WRITELN(T:10,I:10,J:10);
IF A[I]<B[J] THEN BEGIN
C[T]:=A[I];I:=I+1;
WRITELN(C[T]);
IF I>5 THEN BEGIN
FOR T:=J+I TO 5 DO BEGIN
C[T]:=B[J]
END
END
END
ELSE BEGIN
C[T]:=B[J];J:=J+1;
WRITELN(C[T]);
IF J>5 THEN BEGIN
FOR T:=I+J TO 5 DO BEGIN
C[T]:=A[I]
END
END
END
UNTIL T=10;
FOR I:=1 TO 10 DO WRITELN (C[I]:10:3)
END.
100 REM
110 REM*****************************************************
120 REM*** MATHEMATISCHE OPTIMIERUNG SIMPLEX-ALGORITHMUS ***
130 REM*****************************************************
150 REM
160 PRINT
170 PRINT "INPUT ZEILE I1 SPALTE J1"
180 PRINT
190 INPUT I1,J1
200 J=J1
220 DIM A(30,30),B(30,30),C(30,30)
230 PRINT
240 PRINT "INPUT MATRIX A"
250 PRINT
260 MAT INPUT A(A,J)
265 I1=1
270 PRINT
280 IF A(I1,J1 < 0 THEN 0320
290 I1=I1+1
300 IF I1 >I THEN 0950
310 GO TO 0280
320 I3=I1
330 PRINT "DIE PIVOTZEILE BETRAEGT :"
340 PRINT
344 REM
345 REM CHARAKTERISTISCHE QUOTIENTEN
346 REM
350 J1=1
360 PRINT ,A(I1,J1)
370 J1=J1+1
380 IF J1 > J THEN 0400
390 GO TO 0360
400 J1=1
402 PRINT
405 PRINT "DIE CHARAKTERISTISCHEN QUOTIENTEN BETRAGEN:"
406 PRINT
410 I2=I
420 B(J1)=A(I2,J1)/A(I1,J1)
425 PRINT ,B(J1)
430 J1=J1;1
440 IF J1 <=J1-1 THEN 0420
490 REM
500 REM KLEINSTER CHARAKTERISTISCHER QUOTIENT
510 REM
520 J1=1
530 G=B(J1)
540 IF G < B(J1) THEN 0560
545 J4=J1
550 G=B(J1)
560 J1=J1+1
570 IF J1 < J THEN 0540
580 PRINT ,"KLEINSTER CHARAKTERISTISCHER QUOTIENT BETRAEGT:",G
590 PRINT
600 PRINT ,"PIVOTELEMENT BETRAEGT: ",A(I1,J4)
610 PRINT
620 REM
630 REM AUSTAUSCHSCHRITT
640 REM
650 J2=0
655 F=A(I1,J4)
660 J2=J2+1
670 IF J2 <> J4 THEN 0700
680 C(I1,J2)=1/F
690 GO TO 0660
700 IF J2 <= J THEN 0720
710 GO TO 0740
720 C(I1,J2)=A(I2,J4)/F
730 GO TO 0660
740 I2=1
750 IF I2 <> I1 THEN 0770
760 GO TO 0780
770 C(I2,J4)=A(I2,J4)/F
780 I2=I2+1
790 IF I2 <= I THEN 0750
800 I2,J2=1
810 IF J2=J4 THEN 0840
820 IF I2=I1 THEN 0840
830 C(I2,J2)=A(I2,J2)-A(I2,J4)*A(I1,J2)/F
840 J2=J2+1
850 IF J2 <= J THEN 0810
870 I2=I2+1
875 J2=1
880 IF I2 <= I THEN 0810
920 I3=I3+1
925 I1=I3
930 J1=J
932 FOR I7=1 TO I
933 FOR J7=1 TO J
934 A(I7,J7)=C(I7,J7)
935 PRINT ,A(I7,J7)
936 NEXT J7
937 NEXT I7
940 GO TO 0280
950 PRINT ,"******* DER ALGORITHMUS IST BEENDET *******"
960 PRINT
970 PRINT
1010 PRINT
1020 PRINT ,"DIE ELEMENTE DER ZIELFUNKTION "
1030 PRINT
1040 I1=1
1050 J1=J
1060 PRINT ,"-Y",I1,"=",C(I1,J1)
1070 I1=I1+1
1080 IF I1 < I THEN 1060
1100 PRINT
1110 PRINT <"KONSTANTE DER ZIELFUNKTION : ",C(I1,J1)
1120 PRINT
1130 PRINT ,'FAKTOREN DER OPTIMIERUNG : '
1140 PRINT
1150 I1=I
1160 J1=1
1170 PRINT ,'X',J1,'=',C(I1,J1)
1180 J1=J1+1
1190 IF J1 < J-1 THEN 1170
1200 PRINT
1210 PRINT ,'E N D E D E R A R B E I T '
1220 STOP
1230 END
PROGRAM JD (IN,OUT);
VAR
J,M,D,Y,N,JD:REAL;
BEGIN
WRITE("TAG");READLN;READ(D);
WRITE("MONAT");READLN;READ(M);
WRITE("JAHR");READLN;READ(J);
Y:=J;N:=M+1;
IF N<=3 THEN BEGIN Y:=J-1;N:=N+12 END;
JD:=TRUNC(365.25*Y)+TRUNC(30.6001*N)+D+1720981.5;
WRITELN(JD:15:3);
END.
PROGRAM KALENDERDATUM(IN,OUT);
VAR
JD,F,Z,Y,N,D,M,J:REAL;
BEGIN
WRITELN("DIESES PROGRAMM BERECHNET AUS DEM JD DAS KALENDERDATUM.");
WRITE("JULIANISCHES DATUM");READLN;READ(JD);
N:=JD-1720981.5;
Z:=TRUNC(N);F:=N-Z;
Y:=TRUNC((Z-122.1)/365.25);N:=TRUNC((Z-TRUNC(365.25*Y))/30.6001);
D:=Z-TRUNC(365.25*Y)-TRUNC(30.6001*N)+F;
M:=N-1;J:=Y;
IF N>13 THEN BEGIN M:=M-12;J:=J+1 END;
WRITELN(TRUNC(D):3,".",TRUNC(M):3,".",TRUNC(J):5);
END.
PROGRAM STERNZEIT(IN,OUT);
VAR JD,T:REAL;
BEGIN WRITE("JD");READLN;READ(JD);
WRITE("ZEIT");READLN;READ(T);
T:=TRUNC(T)+(T-TRUNC(T))/0.6;
T:=0.0657098*(JD-2444969.5)+1.002738*(T-1)+7.124076;
REPEAT T:=T-24 UNTIL T<=24;
T:=TRUNC(T)+(T-TRUNC(T))*0.6;
WRITELN("SZ:",T:10:3," H");
END.
PROGRAM BESSELSCHETAGESZAHLEN (IN,OUT);
VAR
JD,D,T,O,F,M,ML,LM,L:REAL;
BEGIN
READLN;READ(JD);
D:=JD-2415020;
T:=D/36525;
O:=281.220833+1.719175*T+0.000361*T*T;
F:=0.01675104-4.18E-5;
M:=358.475833+0.9856002669*D-0.00015*T*T-3.3E-6;
ML:=259.183275-0.0529539222*D+2.077E-3*T*T+2.2E-6;
LM:=270.434164+13.1763965268*D-1.13333E-3*T*T+1.9E-6*T*T*T;
L:=296.104608+13.0649924465*D+1.9167E-3*T*T+1.439E-5*T*T*T;
REPEAT M:=M-360 UNTIL M<360;
REPEAT ML:=ML+360 UNTIL ML>0;
REPEAT LM:=LM-360 UNTIL LM<360;
REPEAT L:=L-360 UNTIL L<360;
WRITELN("JD:",JD:16:3);
WRITELN("LAENGE DES PERIHELS(ERDE):",O:17:6);
WRITELN("EXZENTIZITAET:",F:29:6);
WRITELN("MITTLERE ANOMALIE:",M:25:6);
WRITELN("MITTL. LAENGE DES MONDKNOTENS:",ML:13:6);
WRITELN("MITTL. LAENGE DES MONDES:",LM:18:6);
WRITELN("MITTLERE ANOMALIE:",L:25:6);
END.
C BERECHNUNG VON PHI UND LAMBDA AUS R UND H (LANDGRAF)
C
IMPLICT DOUBLE PRECISION(A-H,O-Z)
DATA A1,C0,RG/6366742.52D0,6398786.84764D0,57.295779513082D0/
DATA E0/.67192186623881D-2/,ALF/15988.63853D0/
DATA BET,GAM,DEL/16.72995388D0,.0217848D0,-.30766D-4/
TYPE 100
100 FORMAT(' R, H : ',)
ACCEPT 101,Y0,X0
101 FORMAT(2D)
P=0.D0
1 P0=P
P=(X0+ALF*DSIN(2.D0*P)-BET*DSIN(4.D0*P)+GAM*DSIN(6.D0*P)*-DEL*DSIN
(8.D0*P))/A1
IF(DABS(P0-P1)>1.D-11)GO TO 1
T=DSIN(P)/DCOS(P)
D=E0*DCOS(P)**2
V=1.D0+D
AN1=DSQRT(V)/C0
C=.5D0*AN1*AN1*V*T
G=AN1**4*T*V*(1.D0+3.D0*T*T)/24.D0
W=AN1*T
H=AN1/DCOS(P)
F=H*W*W/3.D0
S=AN1**3*T*(1.D0+2.D0*T*T+D)/6.D0
K=IDINT(Y0/1.D6)
Y=Y0-K*1.D6-500000.D0
GB=(P-C*Y**2+G*Y**4)*RG
GL=(H*Y-F*Y**3)*RG+K*3.D0
AMK=(W*Y-S*Y**3)*RG
TYPE 200,GB,GL,AMK
200 FORMAT(' GB=',F12.8,' GL=',F12.8,' AMK=',F12.8)
STOP
END
PROGRAM BINAERESSUCHEN (IN,OUT);
CONST N=100;
TYPE
LISTE=ARRAY [1..N] OF INTEGER;
VAR
U,M,O,ZAHL,E:INTEGER;
FELD:LISTE;
PROCEDURE EINGABE(VAR FELD:LISTE);
BEGIN E:=0;
REPEAT E:=E+1;
READ(FELD[E]);
UNTIL EOLN OR (E=N);
END;
BEGIN
WRITELN("GEBEN SIE EIN AUFSTEIGEND-SORTIERTES FELD EIN!");
EINGABE(FELD);
REPEAT
U:=1;O:=E;
WRITE("WELCHE ZAHL WIRD GESUCHT");READLN;READ(ZAHL);
REPEAT M:=(U+O) DIV 2;
IF ZAHL<=FELD[M] THEN O:=M
ELSE U:=M+1;
UNTIL U=O;
IF FELD[U]<>ZAHL THEN WRITELN(ZAHL," NICHT ZU FINDEN!")
ELSE WRITELN("DIE ZAHL HAT DEN INDEX",U);
UNTIL ZAHL=0;
END.
MESSIER-LISTE
M RA DEC MAG
H/M * '
1 0533 2200 8 PNEB.
2 2132 -0058 6 GL.CL.
3 1341 2832 6 GL.CL.
4 1622 -2627 6 GL.CL.
5 1517 0212 6 GL.CL.
6 1738 -3212 5 OP.CL.
7 1753 -3448 5 OP.CL.
8 1802 -2420 7 DNEB.
9 1717 -1829 7 GL.CL.
10 1656 -0404 7 GL.CL.
11 1849 -0618 6 OP.CL.
12 1646 -0154 7 GL.CL.
13 1641 3630 6 GL.CL.
14 1736 -0314 8 GL.CL.
15 2132 1202 6 GL.CL.
16 1817 -1347 6 OP.CL.
17 1818 -1611 8 DNEB.
18 1818 -1708 8 OP.CL.
19 1701 -2613 7 GL.CL.
20 1800 -2302 6 DNEB.
21 1803 -2230 7 OP.CL.
22 1834 -2537 6 GL.CL.
23 1755 -1901 7 OP.CL.
24 1817 -1826 5 OP.CL.
25 1830 -1916 - OP.CL.
26 1844 -0926 9 OP.CL.
27 1958 2238 8 PNEB.
28 1823 -2453 7 GL.CL.
29 2023 3825 7 OP.CL.
30 2139 -2320 8 GL.CL.
31 0041 4107 5 SP.GX.
32 0041 4043 9 EL.GX.
33 0132 3030 7 SP.GX.
34 0240 4239 6 OP.CL.
35 0607 2420 5 OP.CL.
36 0533 3408 6 OP.CL.
37 0550 3233 6 OP.CL.
38 0527 3549 7 OP.CL.
39 2132 4818 6 OP.CL.
40 - - - -
41 0646 -2044 5 OP.CL.
42 0534 -0524 6 DNEB.
43 0534 -0517 9 DNEB.
44 0838 1948 4 OP.CL.
45 0345 2402 2 OP.CL.
46 0741 -1445 6 OP.CL.
47 - - - -
48 0812 -0148 - OP.CL.
49 1228 0809 9 EL.GX.
50 0702 -0818 6 OP.CL.
51 1329 4721 8 SP.GX.
52 2323 6126 7 OP.CL.
53 1312 1820 8 GL.CL.
54 1853 -3031 8 GL.CL.
55 1938 -3100 5 GL.CL.
56 1916 3007 8 GL.CL.
57 1853 3300 9 PNEB.
58 1235 1158 9 SP.GX.
59 1241 1148 10 EL.GX.
60 1242 1143 9 EL.GX.
61 1220 0438 10 SP.GX.
62 1659 -3005 7 GL.CL.
63 1315 4211 10 SP.GX.
64 1255 2141 9 SP.GX.
65 1117 1317 9 SP.GX.
66 1119 1310 8 SP.GX.
67 0849 1155 6 OP.CL.
68 1238 -2636 8 GL.CL.
69 1829 -3222 9 GL.CL.
70 1841 -3220 10 GL.CL.
71 1952 1836 9 GL.CL.
72 2052 -1239 10 GL.CL.
73 - - - -
74 0135 1538 10 SP.GX.
75 2024 -2201 8 GL.CL.
76 0140 5125 12 PNEB.
77 0241 -0009 9 SP.GX.
78 0545 0003 10 DNEB.
79 0523 -2433 8 GL.CL.
80 1615 -2255 8 GL.CL.
81 0954 6912 8 SP.GX.
82 0954 6950 9 SP.GX.
83 1335 -2943 10 SP.GX.
84 1224 1303 9 EL.GX.
85 1224 1821 9 EL.GX.
86 1225 1306 10 EL.GX.
87 1229 1233 9 EL.GX.
88 1231 1435 10 SP.GX.
89 1234 1243 10 EL.GX.
90 1234 1319 10 SP.GX.
91 - - - -
92 1717 4311 6 GL.CL.
93 0742 -2348 6 OP.CL.
94 1250 4117 8 SP.GX.
95 1042 1152 10 SP.GX.
96 1045 1159 9 SP.GX.
97 1113 5512 12 PNEB.
98 1212 1504 11 SP.GX.
99 1217 1435 10 SP.GX.
100 1221 1559 11 SP.GX.
101 1402 5429 10 SP.GX.
102 1506 5557 11 SP.GX.
103 0131 6033 7 OP.CL.
104 1238 -1128 9 SP.GX.
105 1046 1245 9 SP.GX.
106 1218 4728 7 SP.GX.
107 1631 -1259 9 GL.CL.
108 1110 5551 10 SP.GX.
109 1156 5332 11 SP.GX.
PROGRAM BINAERESSUCHEN (IN,OUT);
CONST N=100;
TYPE
LISTE=ARRAY [1..N] OF INTEGER;
VAR
U,M,O,ZAHL,E:INTEGER;
FELD:LISTE;
PROCEDURE EINGABE(VAR FELD:LISTE);
BEGIN E:=0;
REPEAT E:=E+1;
READ(FELD[E]);
UNTIL EOLN OR (E=N);
END;
BEGIN
WRITELN("GEBEN SIE EIN AUFSTEIGEND-SORTIERTES FELD EIN!");
EINGABE(FELD);
REPEAT
U:=1;O:=E;
WRITE("WELCHE ZAHL WIRD GESUCHT");READLN;READ(ZAHL);
REPEAT M:=(U+O) DIV 2;
IF ZAHL<=FELD[M] THEN O:=M
ELSE U:=M+1;
UNTIL U=O;
IF FELD[U]<>ZAHL THEN WRITELN(ZAHL," NICHT ZU FINDEN!")
ELSE WRITELN("DIE ZAHL HAT DEN INDEX",U);
UNTIL ZAHL=0;
END.
PROGRAM SORTIEREN (IN,OUT);
CONST
N=100;
VAR
FELD:ARRAY [1..N] OF REAL;
MIN,C:REAL;
A,F,I,T:INTEGER;
BEGIN
WRITE("ANZAHL DER ZAHLEN");READLN;READ(F);
FOR A:=1 TO F DO BEGIN
WRITE(A:3,".ZAHL");READLN;READ(FELD[A])
END;
FOR A:=1 TO F-1 DO BEGIN
MIN:=FELD[A];T:=A;
FOR I:=A+1 TO F DO
IF FELD[I]<MIN THEN BEGIN MIN:=FELD[I];T:=I END;
C:=FELD[T];FELD[T]:=FELD[A];FELD[A]:=C
END;
FOR A:=1 TO F DO WRITELN(FELD[A]:10:3)
END.
PROGRAM RECHTWINKELIGESONNENKOORDINATEN(IN,OUT);
CONST
PI=3.1415926536;
VAR
J,M,D,D1,ENDE:INTEGER;
S,U,I,JD,J1,E,T,O,F,G,N,R,DEC,RA,V,X,Y,Z:REAL;
BEGIN
READLN;READ(D1);
READLN;READ(M);
READLN;READ(J);
READLN;READ(ENDE);
FOR D:=D1 TO ENDE DO BEGIN
I:=J;N:=M+1;
IF N<=3 THEN BEGIN I:=J-1;N:=N+12 END;
JD:=TRUNC (365.25*I)+TRUNC (30.6001*N)+D+1720981.5;
J1:=J-1900;S:=TRUNC((J1-1)/4);
E:=S+TRUNC(30.6*M+0.53/(M-1.55)/(M-1.55)-32.3)+D-0.5;
IF J MOD 4=0 THEN IF M>=3 THEN E:=E+1;
T:=(365*J1+E)/36525;
O:=281.220833+1.719175*T+0.000361*T*T;
F:=0.01675104-0.0000418*T;
G:=23.452294-0.0130125*T;
N:=-1.524155-0.00015*T*T-0.25590255*J1+0.98560027*E;
N:=N*PI/180;
E:=E*PI/180;
WHILE ABS(T-E)>1E-9 DO BEGIN E:=T; T:=N+F*SIN(E) END;
R:=1-F*COS(T);
V:=(SQRT((1+F)/(1-F)))*(SIN(T/2))/(COS(T/2));
V:=2*ARCTAN(V);
O:=O*PI/180;
G:=G*PI/180;
V:=V+O;
X:=R*COS(V);
Y:=R*SIN(V)*COS(G);
Z:=R*SIN(V)*SIN(G);
V:=V*180/PI;
WRITELN("DATUM:",D:2,".",M:2,".",J:4);
WRITELN("JD:",JD:13:2);
WRITELN("X=",X:10:6," Y=",Y:10:6," Z=",Z:10:6);
WRITELN("R=",R:10:6," EKL=",G*180/PI:11:6," *");
WRITELN("BAHNEXZ=",F:13:9);
WRITELN("PERIHELL.=",O*180/PI:13:6," *");
WRITELN("MITTL.ANOMALIE=",N*180/PI:13:6," *");
WRITELN("EXZENTR.ANOMALIE=",E*180/PI:11:6," *");
WRITELN("WAHRE ANOMALIE=",V-O*180/PI:13:6," *");
WRITELN("L=",V:13:6," *");
DEC:=ARCTAN(SQRT(1/(SQR(R/Z)-1)));
DEC:=DEC*ABS(R/Z)/(R/Z);
RA:=2*ARCTAN((R*COS(DEC)-X)/Y);
RA:=RA*180/PI;
IF RA<0 THEN RA:=RA+360;
IF RA>360 THEN RA:=RA-360;
RA:=RA/15;
U:=(RA-7.130000232-6.570982237E-2*(JD-2444969.5))/1.002737909+1;
REPEAT U:=U+24 UNTIL U>0;
RA:=TRUNC(RA)+(RA-TRUNC(RA))*0.6;
DEC:=DEC*180/PI;
U:=TRUNC(U)+(U-TRUNC(U))*0.6;
WRITELN("KUL=",U:10:5," H");
WRITELN("DEC=",DEC:10:5," *");
WRITELN("RA=",RA:11:5," H");
WRITELN;
END;
END.
PROGRAM SORTIEREN (IN,OUT);
CONST
N=100;
VAR
FELD:ARRAY [1..N] OF REAL;
MIN,C:REAL;
A,F,I,T:INTEGER;
BEGIN
F:=0;
WRITELN("GEBEN SIE DAS ZAHLEN-FELD EIN!");READLN;
REPEAT F:=F+1;
READ(FELD[F]);
UNTIL (F=N) OR EOLN;
FOR A:=1 TO F-1 DO BEGIN
MIN:=FELD[A];T:=A;
FOR I:=A+1 TO F DO
IF FELD[I]<MIN THEN BEGIN MIN:=FELD[I];T:=I END;
C:=FELD[T];FELD[T]:=FELD[A];FELD[A]:=C
END;
FOR A:=1 TO F DO WRITELN(FELD[A]:10:3)
END.
PROGRAM HAEUFIGKEIT (OUT);
CONST
N=1000;
TYPE
FELD=ARRAY [3..18] OF INTEGER;
LIST=ARRAY [1..3] OF INTEGER;
VAR
A:LIST;
C:FELD;
I,K,H,Y,Z,B:INTEGER;
FUNCTION ASUM : INTEGER;
VAR
I,Y:INTEGER;
BEGIN
Y:=0;
FOR I:=1 TO 3 DO BEGIN
A[I]:=TRUNC (RANDOM*6+1);
Y:=Y+A[I]
END;
ASUM:=Y
END;
(*==================HAUPTPROGRAM==================*)
BEGIN
FOR I:=3 TO 18 DO C[I]:=0; (*NULLSETZEN DES FELDES*)
FOR K:=1 TO N DO BEGIN (*GROSSE FOR-SCHLEIFE*)
H:=ASUM;C[H]:=C[H]+1;
IF K MOD (N DIV 10)=0 THEN BEGIN
WRITELN;
WRITELN(" N=",K);
WRITELN;
WRITELN(" K ABS H(K) %");
FOR I:=3 TO 18 DO BEGIN (*KLEINE FOR-SCHLEIFE*)
WRITE(I:4,C[I],C[I]/K*100:8:2);
WRITELN
END; (*KLEINE FOR-SCHLEIFE*)
(*=================GRAPHIK-AUSGABE=================*)
FOR I:=3 TO 18 DO BEGIN
FOR Y:=1 TO ROUND(C[I]/K*100) DO
WRITE("*");
WRITELN
END
(*=================================================*)
END(*ENDE THEN TEILS*)
END (*ENDE DER GROSSEN FOR-SCHLEIFE*)
END.
(*=================================================*)
PROGRAM PARABOLBAHN (IN,OUT);
(*DAS PROGRAMM BERECHNET DIE BAHNELEMENTE
EINER PARABOLBAHN*)
CONST
K=1.720209895E-2;PI=3.1415926536;
TYPE
IK=ARRAY [1..3] OF REAL;
IG=ARRAY [1..3] OF INTEGER;
VAR
I:INTEGER;
J:IG;
R,JD,A,B,C,D,MS,T,RA,DEC,X,Y,Z:IK;
A12,DJD,MJD,JJD,B12,C12,A23,B23,C23,G,F1,L1,M,R131,H,V,V31:REAL;
F3,L3,F,L,ETA,THETA,S,RH1,R1,R3,R13,RH3,HST,HST1,X0:REAL;
Y0,Z0,R0,H1,H2,H3,S1,V1,V3,Q,T1,PX,PY,PZ,E,I11:REAL;
QX,QY,QZ,H31,H12,H23,I1,KNL,W1,THETA1,W,EKL:REAL;
FUNCTION ARCSIN (P:REAL):REAL;
VAR
E:REAL;
BEGIN
E:=ARCTAN (SQRT (1/SQR (P)-1))-PI/3;
ARCSIN:=E*ABS (P)/P;
END;
FUNCTION ARCCOS(X:REAL): REAL;
BEGIN
IF X>0 THEN ARCCOS:=ARCTAN(SQRT(1-X*X)/X)
ELSE IF X=0 THEN ARCCOS:=PI/2
ELSE ARCCOS:=ARCTAN(SQRT(1-X*X)/X)+PI
END;
PROCEDUR LSUCHE (VAR W:REAL);
VAR
HG,A1Q,A2Q,A3Q,P,Q,D:REAL;
BEGIN
HG:=-(A[2]*X[2]+B[2]*Y[2]+C[2]*Z[2]);
A1Q:=1/3/R[2]*(4*F+5*HG);
A2Q:=2/3+1/SQR (R[2])*(2*F*HG+G*G/3/H/H);
A3Q:=1/3/R[2]*(2*F+G*G/H/H/SQR (R[2])*HG);
P:=-1/3*SQR (A1Q)+A2Q;
Q:=2/27*SQR (A1Q)*A1Q-1/3*A1Q*A2Q+A3Q;
D:=SQR (P/3)*P/3+SQR (Q/2)*Q/2;
IF D>0 THEN WRITELN("ES GIBT NUR EINE LOESUNG!")
ELSE BEGIN WRITELN("ES EXISTIEREN 3 LOESUNGEN!");
WRITELN("BITTE GEBEN SIE NEUE KOORDINATEN EIN!");HALT
END
END;
PROCEDURE JDATUM (VAR JD:REAL);
VAR
Z,F,Y:REAL;
BEGIN
N:=JD-1720981.5 ;
Z:=TRUNC (N);F:=N-Z;
Y:=TRUNC ((Z-122.1)/365.25);
N:=TRUNC ((Z-TRUNC (365.25*Y))/30.6001);
D:=Z-TRUNC (365.25*Y)-TRUNC (30.6001*N)+F;
M:=N-1;J:=Y;
IF N>13 THEN BEGIN M:=M-12;J:=J+1 END
END;
PROCEDUR XYZ (VAR INDEX:INTEGER);
VAR
S,I,J1,E,T,O,F,G,N,R,V:REAL;
BEGIN
WRITE("TAG");READLN;READ(D[INDEX]);
WRITE("MONAT");READLN;READ(MS[INDEX]);
WRITE("JAHR");READLN;READ(J[INDEX]);
I:=J[INDEX];N:=MS[INDEX]+1;
IF N<=3 THEN BEGIN I:=J[INDEX]-1;N:=N+12 END;
JD[INDEX]:=TRUNC (365.25*I)+TRUNC (30.6001*N)+D[INDEX]+1720981.5;
J1:=J[INDEX]-1900;S:=TRUNC ((J1-1)/4);
E:=S+TRUNC (30.6*MS[INDEX]+0.53/SQR (MS[INDEX]-1.55)-32.3)+D[INDEX]-0.5;
IF J[INDEX] MOD 4=0 THEN IF MS[INDEX]>=3 THEN E:=E+1;
T:=(365*J1+E)/36525;
O:=281.220833+1.719175*T+0.000361*T*T;
F:=0.01675104-0.0000418*T;
EKL:=23.452294-0.0130125*T;
G:=EKL;
N:=-1.524155-0.00015*T*T-0.25590255*J1+0.9856002669*E;
N:=N*PI/180;T:=N;
WHILE ABS (T-E)>1E-9 DO BEGIN E:=T;T:=N+F*SIN (E) END;
R:=1-F*COS (T);
V:=2*ARCTAN (SQRT ((1+F)/(1-F))*SIN (T/2)/COS (T/2));
O:=O*PI/180;G:=G*PI/180;EKL:=EKL*PI/180;
V:=V+O;
X[INDEX]:=R*COS (V);
Y[INDEX]:=R*SIN (V)*SIN (G);
Z[INDEX]:=R*SIN (V)*SIN (G);
END;
(*=============HAUPTPROGRAMM===============*)
BEGIN
FOR I:=1 TO 3 DO BEGIN
XYZ(I);
WRITE("RA",I:1);READLN;READ(RA[I]);
WRITE("DEC",I:1);READLN;READ(DEC[I]);
END;
FOR I:=1 TO 3 DO BEGIN
R[I]:=SQRT(SQR(X[I])+SQR(Y[I])+SQR(Z[I]));
A[I]:=COS (DEC[I]*PI/180)*COS (RA[I]*PI/180);
B[I]:=COS (DEC[I]*PI/180)*SIN (RA[I]*PI/180);
C[I]:=SIN (DEC[I]*PI/180);
END;
A12:=B[1]*C[2]-B[2]*C[1];B12:=C[1]*A[2]-C[2]*A[1];
C12:=A[1]*B[2]-A[2]*B[1];A23:=B[2]*C[3]-B[3]*C[2];
B23:=C[2]*A[3]-C[3]*A[2];C23:=A[2]*B[3]-A[3]*B[2];
G:=SQRT(SQR(X[3]-X[1])+SQR(Y[3]-Y[1])+SQR(Z[3]-Z[1]));
F1:=-(A[1]*X[1]+B[1]*Y[1]+C[1]*Z[1]);
L1:=SQRT (SQR (R[1])-SQR (F1));
M:=(JD[3]-JD[2])/(JD[2]-JD[1])*(A12*X[2]+B12*Y[2]+C12*Z[2]);
M:=M/(A23*X[2]+B23*Y[2]+C23*Z[2]);
H1:=M*A[3]-A[1];
H2:=M*B[3]-B[1];
H3:=M*C[3]-C[1];
H:=SQRT (SQR (H1)+SQR (H2)+SQR (H3));
F3:=-1/M*(A[3]*X[3]+B[3]*Y[3]+C[3]*Z[3]);
L3:=SQRT (SQR (R[3]/M)-SQR (F3));
F:=(H1*(X[1]-X[3])+H2*(Y[1]-Y[3])+H3*(Z[1]-Z[3]))/H/H;
L:=SQRT (SQR (G/H)-SQR (F));
IF F>0 THEN WRITELN("ES GIBT NUR EINE LOESUNG!")
ELSE LSUCHE(F);
R13:=2;
WHILE ABS(R13-R131)>1E-7 DO BEGIN
R131:=R13;
ETA:=2*K*(JD[3]-JD[1])/(EXP((3/2)*LN (R131)));
WRITELN("ETA:",ETA:10:5);
THETA:=(1.060660172*ETA*PI/180);
THETA:=ARCSIN(THETA);
WRITELN("THETA:",THETA*180/PI:13:6);
S:=R131*2*SQRT (2)*SIN (THETA/3)*SQRT(COS (2*THETA/3));
RH1:=SQRT (SQR (S/H)-SQR (L))-F;
R1:=SQRT (SQR (RH1+F1)+SQR (L1));
R3:=M*SQRT (SQR (RH1+F3)+SQR (L3));
R13:=R1+R3;
END;
X[1]:=RH1*A[1]-X[1];Y[1]:=RH1*B[1]-Y[1];
Z[1]:=RH1*C[1]-Z[1];
RH3:=M*RH1;
X[3]:=RH3*A[3]-X[3];Y[3]:=RH3*B[3]-Y[3];
Z[3]:=RH3*C[3]-Z[3];
HST:=X[1]*X[3]+Y[1]*Y[3]+Z[1]*Z[3];
HST1:=HST/SQR (R1);
X0:=X[3]-HST1*X[1];
Y0:=Y[3]-HST1*Y[1];
Z0:=Z[3]-HST1*Z[1];
R0:=SQRT (SQR (X0)+SQR (Y0)+SQR (Z0));
V31:=ARCTAN (R0*R1/HST);
H1:=1/SQRT (R1);
H2:=H1*COS (V31/2);
H3:=1/SQRT (R3);
S1:=(H2-H3)/(SIN (V31/2));
V1:=2*ARCTAN (S1/H1);
V3:=V1+V31;
Q:=R1*SQR (COS (V1/2));
WRITELN("PERIHELDISTANZ Q:",Q:10:5," AE");
T1:=SQRT (2)/K*EXP (3/2*LN (Q))*SIN (V1/2)/COS (V1/2);
T1:=JD[1]-T1*(1+1/3*SQR (SIN (V1/2)/COS (V1/2)));
JDATUM(T1);
WRITELN("PERIHELZEIT T:",DJD:5:3," .",MJD:2:0," .",JJD:4:0);
W:=SIN (V1);V:=COS (V1);
PX:=X[1]/R1*V-X0/R0*W;
PY:=Y[1]/R1*V-Y0/R0*W;
PZ:=Z[1]/R1*V-Z0/R0*W;
QX:=X[1]/R1*W+X0/R0*V;
QY:=Y[1]/R1*W+Y0/R0*V;
QZ:=Z[1]/R1*W+Z0/R0*V;
WRITELN("GAUSS'SCHE KONSTANTEN:");
WRITELN("PX:",PX:10:6);
WRITELN("PY:",PY:10:6);
WRITELN("PZ:",PZ:10:6);
WRITELN("QX:",QX:10:6);
WRITELN("QY:",QY:10:6);
WRITELN("QZ:",QZ:10:6);
H31:=PZ*QX-PX*QZ;
H12:=PX*QY-PY*QX;
H23:=PY*QZ-PZ*QY;
WRITE("EKLIPTIKSCHIEFE");READLN;READ(EKL);
EKL:=EKL*PI/180;
I1:=H12*COS (EKL)-H31*SIN (EKL);
WRITELN("I1:",I11:10:5);
I1:=ARCCOS(I1);
WRITELN("BAHNNEIGUNG I:",I1*180/PI:10:5," *");
L:=1/SIN (I1)*H23;L:=ARCSIN (L);
WRITELN("LAENGE DES AUFSTEIGENDEN KNOTENS L:",L*180/PI:10:5," *");
W:=(QX*COS (L)+QY*SIN (L)*COS (EKL));
W:=-(W+(QZ*SIN (L)*SIN (EKL)));
W:=ARCSIN (W);
WRITELN("ARGUMENT DES PERIHELS W:",W*180/PI:10:5," *")
END.
PROGRAM ZUORDNEN(IN,OUT);
CONST N=50;
OR I:=1 TO 32 DO WRITE ("*");WRITELN;
IF (ORS=".") THEN BEGIN
WRITELN ("* LEERER RAUM *");
FOR I:=1 TO 32 DO WRITE ("*");WRITELN
END;
IF (ORS="C") THEN KRISTALL;
IF (ORS="P") THEN FALL;
IF (ORS="B") THEN MONSTER;
IF (ORS="M") THEN ENTM;
WRITELN;WRITELN;
IF (F=0) THEN BEGIN
IF (RANDOM>0.2) THEN BEGIN
NORD:=E-20;SUED:=E+20;WEST:=E-1;OST:=E+1;
WRITELN ("NORD: ",A[NORD]);
WRITELN ("SUED: ",A[SUED]);
WRITELN ("WEST: ",A[WEST]);
WRITELN ("OST : ",A[OST])
END;
WRITELN;WRITELN ("N,S,O,W,(E)NDE");
READ (AN);
Q1:=E;A[E]:=ORS;
IF (AN="E") THEN F:=3;
IF (AN="N") AND (A[NORD]<>"-")
PROGRAM SUMMEVONZAHLEN(INPUT,OUTPUT);
VAR SUMME,B,LAUF:INTEGER;
BEGIN
SUMME:=0;
FOR LAUF:=1 TO 10
DO BEGIN
WRITELN("GEBEN SIE 1 ZAHL EIN!");READLN;READ(B);
SUMME:=SUMME + B
END;
WRITELN("SUMME=",SUMME);
END.
PROGRAM H2OBILL(OUTPUT);
VAR AZ,NZ,HNR,KNR,BVB,PLZ:INTEGER;
UST,EP,RN,RB,D,G:REAL;
NAME,STR,WO:CHAR;
PROCEDURE AUSGABE;
BEGIN
WRITE (NAME:18);
WRITE (STR:15,HNR:5);
WRITE (PLZ:4,WO:15);
WRITELN (KNR:15,BVB:15,D:5:2,D:2:4);
WRITELN (AZ:6,NZ:10,EP:6:2,G:7:2, "14% UST");
WRITELN( 8RN:10:2,UST:10:2,RB:10:2);
END;
BEGIN
AZ:=111;NZ:=258;
EP:=1.50;G:=12.00;
RN:=(NZ-AZ)*EP+G;
UST:=RN*0.14;
RB:=RN+UST;
AUSGABE
END.
PROGRAM HAEUFIGKEIT(INPUT,OUTPUT);
VAR ZAEHLER,ANZAHL:INTEGER;VGL,ZEICHEN:CHAR;
BEGIN
WRITELN("GEWUENSCHTES ZEICHEN EINGEBEN!");
READLN;READ(ZEICHEN);
WRITELN("TEXT EINGEBEN(BUCHSTABENWEISE)!");
ZAEHLER:=0;ANZAHL:=0;
REPEAT BEGIN
READLN;READ(VGL);
IF VGL=ZEICHEN THEN ANZAHL:=ANZAHL+1;
IF (VGL<>" ") AND (VGL<>"@") THEN ZAEHLER:=ZAEHLER+1;
END
UNTIL VGL="@";
WRITELN(ZEICHEN," KOMMT",ANZAHL:4," MAL VOR");
WRITELN("DAS SIND",ROUND(ANZAHL*100/ZAEHLER):5,"%");
END.
PROGRAM UMWANDLUNG (INPUT,OUTPUT);
VAR N,X,ZAHL,DEZ1,DEZ2:INTEGER;
WERT,DUAL1,DUAL2:ARRAY[1..13] OF INTEGER;
(*------------------UMWANDELN------------------------*)
PROCEDURE UMWI;
VAR ANFANG:INTEGER;
PROCEDURE POTENZ(N:INTEGER);
BEGIN
ANFANG:=2;
REPEAT
IF N>2 THEN BEGIN
ANFANG:=ANFANG*4;N:=N-2
END
ELSE BEGIN
ANFANG:=ANFANG*2;N:=N-1
END
UNTIL N<=1;
IF N=0 THEN ANFANG:=ANFANG DIV 2;
IF N=-1 THEN ANFANG:=ANFANG DIV 4
END;(*OF PROCEDURE POTENZ*)
BEGIN
FOR X:=1 TO 13
DO WERT[X]:=0;
REPEAT
FOR N:=11 DOWNTO 0
DO BEGIN
POTENZ(N);
IF ZAHL>=ANFANG
THEN BEGIN
WERT[13-N]:=1;
ZAHL:=ZAHL-ANFANG
END
END;
UNTIL ZAHL=0
END;(*OF PROCEDURE UMWI*)
(*------------------ADDIEREN-----------------------*)
PROCEDURE ADDIEREN;
BEGIN
FOR X:=1 TO 13
DO WERT[X]:=0;
FOR X:=13 DOWNTO 1
DO BEGIN
WERT[X]:=WERT[X]+DUAL1[X]+DUAL2[X];
IF WERT[X]=2 THEN BEGIN WERT[X-1]:=1;WERT[X]:=0 END
ELSE IF WERT[X]=3 THEN BEGIN
WERT[X-1]:=1;WERT[X]:=1
END
END
END;(*OF PROCEDURE ADDIEREN*)
(*--------------------MULTIPLIKATION---------------------------*)
PROCEDURE MULTI;
VAR A,B,C,D:INTEGER;
PRODUKT:ARRAY[1..26] OF INTEGER;
BEGIN
IF DEZ1>=DEZ2
THEN BEGIN
FOR A:=1 TO 26 DO PRODUKT[A]:=0;
FOR A:=1 TO 13 DO PRODUKT[A+13]:=DUAL1[A];
FOR A:=13 DOWNTO 1
DO IF DUAL2[A]=1
THEN BEGIN
B:=13-A;
FOR C:=0 TO B
DO FOR D:=26 DOWNTO 1
DO BEGIN
PRODUKT[A-1]:=PRODUKT[A];
PRODUKT[A]:=0
END
END
END
ELSE BEGIN
FOR A:=1 TO 26 DO PRODUKT[A]:=0;
FOR A:=1 TO 13 DO PRODUKT[A+13]:=DUAL2[A];
FOR A:=13 DOWNTO 1
DO IF DUAL1[A]=1
THEN BEGIN
B:=13-A;
FOR C:=0 TO B
DO FOR D:=26 DOWNTO 1
DO BEGIN
PRODUKT[A-1]:=PRODUKT[A];
PRODUKT[A]:=0
END
END
END;
WRITELN("MULTIPLIKATION:");
WRITELN;
FOR A:=1 TO 26
DO WRITE(PRODUKT[A]:1);
WRITELN
END;(*OF PROCEDURE MULTI*)
(*--------------------HAUPTPROGRAMM--------------------------*)
(*-----------------------------------------------------------*)
BEGIN
WRITELN("GEBEN SIE ZWEI ZAHLEN EIN, DIE NICHT GROESSER ALS");
WRITELN("2048 SEIN DUERFEN !!!");
READLN;READ(DEZ1,DEZ2);
REPEAT
IF (DEZ1>=2048) OR (DEZ2>=2048)
THEN BEGIN
WRITELN("BITTE ACHTEN SIE BESSER AUF MEINE ANWEISUNGEN !");
WRITELN("DIE ZAHLEN DUERFEN NICHT >= 2048 SEIN !");
WRITELN("BITTE VERSUCHEN SIE ES NOCHEINMAL:");
READLN;READ(DEZ1,DEZ2)
END
ELSE IF (DEZ1<0) OR (DEZ2<0)
THEN BEGIN
WRITELN("BITTE GEBEN SIE ZWEI ZAHLEN EIN, DIE >= 0 SIND !");
READLN;READ(DEZ1,DEZ2)
END;
UNTIL (DEZ1>=0) AND (DEZ1<2048) AND (DEZ2>=0) AND (DEZ2<2048);
ZAHL:=DEZ1;
UMWI;
FOR X:=1 TO 13
DO DUAL1[X]:=WERT[X];
ZAHL:=DEZ2;
UMWI;
FOR X:=1 TO 13
DO DUAL2[X]:=WERT[X];
FOR X:=1 TO 13
DO WRITE(DUAL1[X]:1);
WRITELN;
FOR X:=1 TO 13
DO WRITE(DUAL2[X]:1);
ADDIEREN;
WRITELN;WRITELN;
WRITELN("ADDITION:");
WRITELN;
FOR X:=1 TO 13
DO WRITE(WERT[X]:1);
WRITELN;
(*--------SUBTRAKTION---------*)
IF DEZ1>=DEZ2
THEN BEGIN FOR X:=1 TO 13
DO IF DUAL1[X]=0
THEN DUAL1[X]:=1
ELSE DUAL1[X]:=0
END
ELSE BEGIN
FOR X:=1 TO 13
DO IF DUAL2[X]=0
THEN DUAL2[X]:=1
ELSE DUAL2[X]:=0
END;
ADDIEREN;
FOR X:=1 TO 13
DO IF WERT[X]=0
THEN WERT[X]:=1
ELSE WERT[X]:=0;
IF DEZ2>DEZ1
THEN BEGIN
WRITELN;
WRITELN("SUBTRAKTION:");
WRITELN("-");
FOR X:=1 TO 13
DO WRITE(WERT[X]:1)
END
ELSE BEGIN
WRITELN;
WRITELN("SUBTRAKTION:");
WRITELN("+");
FOR X:=1 TO 13
DO WRITE(WERT[X]:1)
END;
WRITELN;
WRITELN;
MULTI
END.
PROGRAM KONTOGEBUEHREN(INPUT,OUTPUT);
VAR ANZAHLDERBUCHUNGEN:INTEGER;GEBUEHREN:REAL;
BEGIN
WRITELN ("GEBEN SIE DIE ANZAHL DER BUCHUNGEN EIN !");READLN;READ(ANZAHLDERBUCHUNGENGEN
GEN);
IF ANZAHLDERBUCHUNGEN<=10
THEN "GEBUEHREN="0
ELSE IF ANZAHLDERBUCHUNGEN<=20
THEN "GEBUEHREN="3
ELSE
"GEBUEHREN="3+(ANZAHLDERBUCHUNGEN-20)*0.2;
WRITELN ("GEBUEHREN="GEBUEHREN:10:2,"DM")
PROGRAM A02508 (IN,OUT);
VAR A,B,N,I:INTEGER;
BEGIN
N:=1;
WRITELN(N:2,".ZAHL EINGEBEN:");
READLN;READ(A);
REPEAT
N:=N+1;
WRITELN(N:2,".ZAHL EINGEBEN:");
READLN;READ(B);
IF B>A
THEN A:=B;
UNTIL I=N
END.
I:=10
WRITELN("DAS MAXIMUM BETRAEGT:",A:8;
(*AUTOR:ALEXIA LILGERT,ZUR BERECHNUNG DES MAXIMUMSEINER ZAHLENFOLN
FOLGE*)
PROGRAM MAXIMUM(INPUT,OUTPUT);
VAR ZAHL,MAX:REAL;
BEGIN
WRITELN("GEBEN SIE EINE ZAHL EIN");READLN;READ(ZAHL);
MAX:=ZAHL;
REPEAT
IF ZAHL>MAX
THEN MAX:=ZAHL;
WRITELN("GIB EINE ZAHL EIN");READLN;READ(ZAHL);
UNTIL ZAHL=0
WRITELN;WRITELN("MAX=",MAX)
END.
PROGRAM BCODE1(IN,OUT);
CONST M=69.089;N=2.238;F=61.412;W=2.317;
VAR MA,FR,GESCHLECHT:CHAR;ALTER:INTEGER;
LAENGE,GROESSE:REAL;
BEGIN
WRITELN("DIESES PROGRAM BERECHNET NACH WISSENSCHAFTLICHEN");
WRITELN("ERKENNTNISSEN AUS ALTER,GESSCHLECHT UND DER LAENGE");
WRITELN("DES OBERSCHENKELKNOCHENS DIE URSPRUENGLICHE KOERPER-");
WRITELN("GROESSE EINES GEFUNDENEN SKELETTS!");
WRITELN("GESCHLECHT EINGEBEN!MA ODER FR?");READLN;READ(GESCHLECHT);
WRITELN("ALTER EINGEBEN!");READLN;READ(ALTER);
WRITELN("OBERSCHENKELLAENGE IN CM EINGEBEN!");READLN;READ(LAENGE);
IF GESCHLECHT=MA
THEN GROESSE:=M+(N*LAENGE)
ELSE GROESSE:=F+(W*LAENGE);
IF ALTER>30
THEN GROESSE:=GROESSE+(ALTER-30)*0.06;
WRITELN("KOERPERGROESSE=",GROESSE:9:5," CM");
WRITELN("BY 336 11 1983")
END.
PROGRAM KONTOGEBUEHREN(INPUT,OUTPUT);
VAR GEBUEHREN:REAL;
ANZAHL:INTEGER;
BEGIN
WRITELN("ANZAHL DER BUCHUNGEN ANGEBEN");READLN;READ(ANZAHL);
IF ANZAHL<=10
THEN GEBUEHREN:=0
ELSE IF ANZAHL<=20
THEN GEBUEHREN:=3
ELSE GEBUEHREN:=3+(ANZAHL-20)*0.2;
WRITELN("GEBUEHREN=",GEBUEHREN:10:2,"DM")
END.
(*AUTOR ANDREA KALKUM IF2*)
PROGRAM MINIMAXI(INPUT,OUTPUT);
VAR MINIMUM,MAXIMUM,A,B:INTEGER;
BEGIN
WRITELN("ZWEI ZAHLEN EINGEBEN");READLN;READ(A);READ(B);
MINIMUM:=0;
MAXIMUM:=0;
REPEAT
IF A<B
THEN MINIMUM:=A
ELSE BEGIN
MINIMUM:=B;
IF A>B
THEN MAXIMUM:=A
ELSE MAXIMUM:=B
END;
WRITELN("WERT FUER B EINGEBEN");READLN;READ(B)
UNTIL B=0;
WRITELN("MINIMUM=",MINIMUM," MAXIMUM=",MAXIMUM)
END.
(*ANJA KUNZE:BEI EINER ZAHLENFOLGE ,DIE MIT 0 ENDET SOLL DAS MINIMUM
UND MAXIMUM AUSGEGEBEN WERDEN.*)
PROGRAM MINMAX (INPUT,OUTPUT);
VAR ZAHL,MIN,MAX:REAL;
BEGIN
WRITELN("GEBEN SIE EINE ZAHL EIN.");READLN;READ(ZAHL);
MAX:=ZAHL;
MIN:=ZAHL;
REPEAT
WRITELN("GEBEN SIE DIE NAECHSTE ZAHL EIN.");READLN;READ(ZAHL);
IF ZAHL>MAX
THEN MAX:=ZAHL
ELSE IF ZAHL<MIN
THEN MIN:=ZAHL
UNTIL ZAHL=0
WRITELN("MAXIMUM=",MAX:10:0,"MINIMUM=",MIN:10:0)
END.
PROGRAM ZAHLEN SORTIEREN(IN,OUT);
CONST MINNR=1,MAXNR=10;
VAR ZAHLFELD:ARRAY[1..10] OF INTEGER;
BEGIN MAX:=1 TO MAXNR DO
IF ZAHLFELD[ZAEHLER] >MAX THEN
PROGRAM ADRESSE (INPUT,OUTPUT);
TYPE STRING=ARRAY[1..50] OF CHAR;
VAR NAME,STRASSE,ORT:STRING;I:INTEGER;
PROCEDURE EINGABE (VAR TEXT:STRING;LAENGE:INTEGER);
BEGIN
READLN;
LAENGE:=1;
REPEAT
READ(TEXT[LAENGE]);
LAENGE:=LAENGE+1
UNTIL (LAENGE=51) OR EOLN;
TEXT [LAENGE]:="@";
LAENGE:=LAENGE-1
END (*EINGABE*);
PROCEDURE AUSGABE (VAR TEXT:STRING;LAENGE:INTEGER);
BEGIN
FOR LAENGE:=1 TO LAENGE DO WRITE(TEXT[LAENGE])
END(*AUSGABE*);
BEGIN (*HAUPTPROGRAMM*)
FOR I:=1 TO 50 DO BEGIN
NAME[I]:=" ";
ORT[I]:=" ";
STRASSE[I]:=" " END;
WRITELN("NAME EINGEBEN!");
EINGABE (NAME,I);
WRITELN ("STRASSE EINGEBEN!");
EINGABE (STRASSE,I);
WRITELN ("ORT EINGEBEN!");
EINGABE (ORT,I);
WRITELN;
AUSGABE (NAME,I);
WRITELN;
AUSGABE (STRASSE,I);
WRITELN;
AUSGABE (ORT,I);
END (*HAUPTPROGRAMM*).
/L
PROGRAM PFEIL(INPUT,OUTPUT);
VAR ZEILE,SPALTE,RECHTSRUECKUNG,LINKSRUECKUNG,BREITE:INTEGER;
BEGIN
WRITELN("BREITE EINGEBEN");READLN;READ(BREITE);
WRITELN("RECHTSRUECKUNG EEINGEBEN");READLN;READ(RECHTSRUECKUNG);
FOR ZEILE:=1 TO RECHTSRUECKUNG
DO BEGIN
WRITELN
WRITE(" ":ZEILE);
FOR SPALTE:=1 TO BREITE
DO WRITE("*")
END;
LINKSRUECKUNG:=RECHTSRUECKUNG-1;
FOR ZEILE:=1 TO LINKSRUECKUNG
DO BEGIN
WRITELN;
WRITELN(" ":RECHTSRUECKUNG-ZEILE);
FOR SPALTE:=1 TO BREITE
DO WRITE("*")
END;
(*PROGRAM MADE BY VOLKER DRESBACH*)
PROGRAM ADRESSE(INPUT,OUTPUT);
TYPE STRING=ARRAY[1..35]OF CHAR;
VAR WOHNORT,NAME,STRASSE:STRING;
PROCEDURE EINGABE(VAR ADRESSE:STRING);
VAR LAENGE:INTEGER;
BEGIN
READLN;
LAENGE:=1;
REPEAT
READ(ADRESSE[LAENGE]);
LAENGE:=LAENGE+1
UNTIL(LAENGE=35) OR EOLN;
ADRESSE[LAENGE]:="@";
END;(*EINGABE*)
PROCEDURE AUSGABE(VAR ADRESSE:STRING);
VAR LAENGE:INTEGER;
BEGIN
LAENGE:=1;
REPEAT
WRITE(ADRESSE[LAENGE]);
LAENGE:=LAENGE+1
UNTIL ADRESSE[LAENGE]="@"
END;(*AUSGABE*)
BEGIN(*HAUPTPROGRAMM*)
WRITELN("GEBEN SIE IHREN NAMEN EIN");
EINGABE(NAME);
WRITELN("GEBEN SIE IHRE STRASSE MIT HAUSNUMMER EIN");
EINGABE(STRASSE);
WRITELN("GEBEN SIE PLZ UND WOHNORT EIN");
EINGABE(WOHNORT);
(*DIE AUSGABE BEBINNT*)
WRITELN;
AUSGABE(NAME);
WRITELN;
AUSGABE(STRASSE);
WRITELN;
WRITELN;
AUSGABE(WOHNORT)
END.(HAUPTPROGRAM)
~|H@ {c[zcgZy?`qX9rc*;Y"/bvi(/4~ ?}2X /|2b{i
[IYz2 vyy)(/o"b(xrb
[Ip~jz
[I Wwy8Vd>vU@?Uu2HT{6S"ibRi'ib"idLQ"ii&i!.t(?si3@[bU{i!>
7
<| *&&%r|A
n#
A#pf /p$y0p
pf|?1`=B^l<> OQ,
|zH @ ((( $ BmZi-0k
Zj[-J.
W`!#f(V0! &VVnf
BVXnL0~;&f>l!d6CFf@4B(FzS HzX(8t8@"(Xx?@<VJfvb(wPn/w}B@az|bw(trlXo=v[JXTjM,6"%&sL``D``D``D`dNF`b!`f`W"Zn &XBT`Cb[DQ vnQ!~b\bYLdc6`B Dz@?^@.V/B#_ /D]"^`$a6`A/`vZB@(ty
Q/nrL_@8tiKgi (g{**bf"&*e"!*bd(&!d;SDXT= YLz
mZi-0kZj[-J.
W`!#f(V0! &VVnf
BVXnL0~;&f>l!d6CFf@4B(FzS HzX(8t8@"(Xx?@<VJfvb(wPn/w}B@az|bw(trlXo=v[JXTjM,6"%&sL8<L0L(jXls&x6x| (X~!n}xb+dy6CDzffN~ox.4NY"|XVodl4yByly<Z~^ Yz_
!.z/\(/(@!~XXnY oWG.|8" <z~^/ x.yr_uz$}$9$|-{_"_n_~4\l*h@~}_xde&CCCy~-y
Z~_)c"| ^}fVdH8dOeJHYHC~bPa~m |No|=C`3f&CddN8d@Oe.JCNC3Ny;~-a(Ya$ {DZC[{I}-NH ggbf!Dgbff&N0f".Nf3Y?@@pg<Lqq,/Nq',gh+V}Hvp/
p`pXcT :l6&~0}&C;d48z 0|"V{<0
PnHo/&;<8;;4*pDb!<(: Jr<{X6j|z@/Ty"@rx(/w.(3zv(/bw" Vxk@/k&@<{6uu(kvkVK{V(MjhV( .kt bz<0VGFvCpNx Ep
8PE`FE@OE`8J
nF
.
`hE8@<
|BCc{;n4Hvz cEF(?;z11,G1b'}B&L9/K;(/x$O0@F&dEdx`dhnFFb]EEFrn]`EOEz&]`;(d{lJdKEo,sJj;&~d+XAj1',B,^@Py@Fy@Oy@8J
nF
.
@hy8@3
wB;cv'n4Htz xcyF0 2z=zl&,4L`H4xD<<7'" tO4<3JA,]@@F&`y`x@`hnFFb]yyFrn]@yOyz'(`{''dik"`m2F`^ eJmFF`+X9jLRV`VVy8pt@ PblY&~
nfcHJ}"|({"z(Vb0it
<6J264LC(u(8{2V ~N: qm 8 .2qm28tI[2xX0
~
tmAH~H(o]H>xoqVqPtXXVQoN]$]Z?fWvVC3TDf ~ &f DvfWnxf.
nL }& tur|Yq&nU~t > . Tz\OR .u'||=xt-at'Yva(/lv&{"fnwd\t=q-tui.H!~( |\6
ly_\l{dZ@Y{wOJPnj@Nq{PtYklm}N`p8@y8pt@ PblY&~nfcHJ}"|({"z(Vb0it<6J264LC(u(8{2V ~N: qm 8 .2qm28tI[
2xX0
~
tmAH~H(o]H>xoqVqPtXXVQoN]$]@?}VC3TDf ~ &f DvfWnxf.
nL }& tur|Yq&nU~t > . Tz\OR .u'||=xt-at'Yva(/lv&{"fnwd\t=q-tui.H!~( |\6
ly_\l{dZ@Y{wOJPnj@Nq{PtYklm}
p8@y8p
t@ PblY&~
nfcHJ}"|({"z(Vb0it
<6J264LC(u(8{2V ~N: qm 8 .2qm28tI[2xX0
~
tmAH~H(o]H>xoqVqPtXXVQoN]$]0VC3TDf ~ &f DvfWnxf.
nL }& tur|Yq&nU~t > . Tz\OR .u'||=xt-at'Yva(/lv&{"fnwd\t=q-tui.H!~( |\6
ly_\l{dZ@Y{wOJPnj@Nq{PtYklm}p8@y8pt@ PblY&~ nfcHJ}"|({"z(Vb0it<6J264LC(u(8{2V ~N: qm 8 .2qm28tI[2xX
~
tmAH~H(o]H>xoqVqPtXXVQoN]$]?c0`VC3TDf ~ &f DvfWnxf.
nL }& tur|Yq&nU~t > . Tz\OR .u'||=xt-at'Yva(/lv&{"fnwd\t=q-tui.H!~( |\6
ly_\l{dZ@Y{wOJPnj@Nq{PtYklm}mp8@@_
:4&3&.0#&4H2z!7c6d;G<8<<9f9& 8/66t9rn&66t8
7JD{$@#EVhBttvMxz^Lqjsln+pr<D |!a#% ')Ng~,o&cHsc"qqccq'drDd_"o {WXp]t. ?Mt+ t~0sUt$cf.twbun#Jj,m /#, sf tfY&ypru2Z&Z(zsfnsXqkbvvdvZ(ZvtvZ(ZAuutq1J u
uuc JzssD@*k(suCks (ok"vvdvZ(n+Hxr&r?k`Z >stbftbo+?p@f p{[O@(|_dZA]
l~5&Z6CadZB@*z}(Qe.`jZ} In[h/7.[|"[{bfrz,@(O\&\b(2zy/@N]/\ [6Zx w<&vfru@,\\b VzZbtH_b_o^D+"(fy+Js /**` f ^f_|b[jq Z]y]8aq`@wfH
"Xl~X'}&|/@{Brz,@ky&|/@xBrw,@(Ov2 {6RDRu"hz6t"6sbRQd!@PS0
@<@ QUEUE LP00:<DK0:TEMP00.LPTa |pZa; }IwN}+}i8}i}izPo0p6G|Hph:A/X~k0 0flB,2b~m~d~16~~D'zDznH%z1c 3x114 pDb3(P0d" ~t~{8+@9x30<)@)
9981.&0D./b(Nzn..s ~.i2(fzj(/C\"9.d/)z9IJ~d@N*9hZf/@L.B!1b(Cz .b..c3 /H*(SkSb &zk~(/2(it j_&iJ_Jhi&l}(kv| /&l({ /!,Sdk(/M{"@b 8z._(^2 0M*OzkO /D' ?_(FK*kO `Kzd_(,k"_^`>g^&K TJlz({L0p&!La^$^_0?hhpeyBN l{eK}z}pr
tfp
B:b9c!<c6\&C=d<B@Az@C@oA@#6ECh=Cx?Chn>>b.===t>rn.?==t8<!${X~: t~2 | AzsIm>&>v"(_zw(/Ex"(fzy>bC{c^"D nZD&u\*y(/Z@#
Vn@zr>9feE&a+
0spfct~?~~d~v6~~Cy~d
qBhb@gzuJ(bz!}f| r&frwiOa.y/z)$yblrjwt)Spi9Sxd2)ij(
>
nP9P$xd<)ij(v9v$v9v$xxDL)r}$ezw*JyJ ir~$`X~~{sxvbjk
xO @6P8hB
l
6?@h{ghhb%Dg.`ghb@b #( oKJ%,~(/@,&@}(/B|"@{b
oEN"DDnD
bNKj%KNO&z "!FJ&NN1m&#+ hb#y
hb%Ff.#hnhdYS+#
(Ovf#(hS("#(!*
[|/KpUs}@^V6 N6Cd cd(/< <t ,0K~9E\}~9<[~O!~):[4 ,{|47{,4sz&y2 ,{~,0x
>wr4[&[ ??v9
uL2[[rw(?[4t( @ O?s2rq <p~|ornormlrkG5*#o$p'{|zkyP&]t,|T, N,~ \L}G8Y|bZO{zyxwvut zF.UfvV&vW&W .VX&Us"OUr:&Vq)poZVpZVsqpZVpZVXD:, nX&mO(XJJG0LQ.O0bbY"YbbOZk
S fr_0 @p?P @@x|S@Uy*a B
~)}|)|{|V|z|y|||x||wv9y~ wy0~uz%v)+wi$+",
+,(u}l5H&+f*t (}{+,* |*,KL8k~ s<3<vI|b*hhr /qh8(q{ (oS.z ?qh8)hhpbpbxhx++bvof+o)f[*)<+
* <*hKd^GPYB?<Z~@O@@ ]B}||b}IMO{,}d\d|zy# xGI~ I6~ I~ I ~ I~ II~ IA,~ IAK8~ I$9~ wC (Ov]2}IO Ou0
)~ I 0~ utaK:O?sz
u8dyyG~eN&}O&NNtOJX|g{
Cz'y^xG {I8
A=GHMGwvwu |IAp=GIHpMGO*t3sINOt0GrrG&G0qC(~qjs(O{pc0d /Oo3M lMIxHMI@s/O{0sxG7zy]Eg~gfp"Y@TS@YTMA~^*n~*>*!@fY@D.`I]TSH02:P]$`}d^'pYx#xq{s?xy
d'%$|/p@p;A?P SJ?(sh5xz?KLts'FpkP0 g`gnvs@^\ hY*?8BI`DEQ=;wU$as!>~ /}gR~}|y{z)yxrwv(zuiq9B{2C4sn4'2qv2%{
b2R{[!(c4G4m4c1Ax}<c,=s7;3C
t%BB4ZZcBb6RIcI$ZRbZI{qpJ(oZR^BobnlB.l`wf&{sffh{'8{nb| /wf"{Bt_, BbZn0i97WS~g}&nui'qv>qs7qeIqIqIqqqq}<xkLqS(/m)'"l(/Qk"~zY ~g&z9 b|)wj&Kjr|i{z)(?4z)D{"z8iz)h"z|=5vfb&vBe d2Fn&g(nc"(bz|@.b/W{"vb StST5s;n .
&v00hzp:a`_Jr)! /r)! /I"( zr!b zr!b z1(/r9@+"~b
1fIh(0>1}&|&Ih252h;61}b|bnIh?0^]TU0\]9N`sMC\]9L 6@\~|H@ {c[zcgZy?`qX9rc*;Y"/bvi(/4~ ?}2X /|2b{i
[IYz2 vyy)(/o"b(xrb
[Ip~jz
[I Wwy8Vd>vU@?Uu2HT{6S"ibRi'ib"idLQ"ii&i!.t(?si3@[bU{i!>ib!tc U{s.> /z4*
,[ Pj1r ')dZ^3Uf3s+ /O8\8(/\O;r Xz]SS`\2~}'NM^u C7rT)rF)r7N Lr! /Kr9! /K|9uSdT/)C/A J9O2(d{rS(`n/Y"Ir{s8])Ps\["b^kH !pfgHp(/qf)*JOgy8j]DVC@\s3Xc8r)Xsi"NiGrFs u SsTsH !fgH(/'f)
A
g)j+,(+zE[*kv(Kz(/MX" O{&&Nb b O{\6\G9rriC%"~}r|{{
[I K
,D
[I^zGyCmoB) OKrxriEoy+6/"@"H.^ryI sG D" d{sss)\NfNM:JOrHr@./d2::&N /Y" 4z[AzDw/J ,:\{~q"NNbQNiGuCJsPOJ\s)\raAzDwPJ[(\0 :CaH[0r@bsrbnS}zrnrsdea+*v s{]NM@\00 "fa`_&C)!!b!"b(z|!"hz)rH
rz)V
rI} r}|zr(:z||]} })})|z)}) })#(/\R9{E&|]O`p\a9`_&r)@Hr)HxVH
rI} r}zV^]@\{"z"V lV<$nd;7QB)DhKy?)bm8o|:
D)]HN
R@\|9]BDA1\{'({ (zD$6h?ijklmbx.%c/%d%06%:I6%]9Y`DR-zv>&&t@;+K;&;"HYz!wbHYz;";&; [(/~;2D]9O tI}8[?)0|?)6% /B)K @_]9CRs@\+@<e%!%MT SNMuF XPO9NL^&b"\bXC)%riH[["k%bk#&!.#B) K Jk!.&g& b^kbR!kbb\
`JWC)a%b(Fz6zrks)6
b"\6j!.\ /T#!n\&_W9g"!\bBl\b!^b&Zy
!~&gs1(/\}2(k{O ?x|'={zv2 ETx^B~bfGi]9SsP\0}',~'<;'|:'[{'z ~yf~9%607( .7Sj8/JH RS .8bHtS}/ ~8xb7wbBdhS*vE08B7ff n8 nBvbgi(Czbu@.z/#"t@.s/#u)R9uE]SNe\k]DK@\v?P?}Ewfe!E@YD&~&}|{b zb
ybxb
n"ai`_r)@V$.w+v06C!!""({rIHu{!!."kc
rHots9r!'q rrib(Jz.Xf
'r@oUr)E
'rop)rJns"r9])At\5'w `2"fYfIbFt1q*aA*Q;$qp6d"(~{+}^|{y(/&&& &Lr@zr9Zsiy`ryR S(qbFnri7"+\xiV!"wxYv"uts'rPoGr)Er'2!2qpw"on ?ml2n6rkj{Y(97&(^z5I)riXY{riY8V0j`@*Pp*1a*SA:Qq*fnU>
j_[?)04<23c<&w?)
02B)`JtK2B)PJzKB?)01E2(&z?)o#D.'bqorS1&0B) AOB)OK[oA&B) A @~0 }C$|c7@{iq(/7 "zXx&!.z+Tqvqy'xCowi&viruus@lz tc(s{oB) A @Xq47;xZ"8WsjYp6Rmw;T ;f 7b(z:&8E"9b< l9Q6:C 9GQ,:9t:t<t,~:&8}"9|b< l9Q6:C 9GQ,:9
:<D'{'0ddz QqDQp" y{srEgG$xq&Fr&@Q&= c_*@Q&r0J
n9
.
rddr#9rrCw<<H?kp$Iv)IO{<"lOB
0Lig#pb&@[b{C t6!>bi@>[/# t0 ~c brZZb .z=}?= /G(|G/G(}G)/G(7Z Fz={?= 0Z&GR6RW&Xb?=y?)=GbryR S(!nri(/ df!.pu&Z?88
> +7?7ay2B@ ,p2B0 ,'~ `z.cBJ\.2B <}|b{b c(9z4 cR-(6zB5&/?) 'Jz 46$yC xywJ97 dv9 b@u{ /O2#\k;@/B) @K1?)0/?)6,bB '
'$r tG]IY`DL[6qtZ;wPzpr/_Ti'BcdK6CdP6'B(z KC PGKPD',`9^,~(/K}0 |g{z7yx7wvru'{t
?s]9RTR`HRC!?P7w)2v)D r(/tgs0FnKkJ
nP+9aib U{a&,!\JqyUT0@>/a4b Nqs'j 9gI@E#zpGG/rQ@wq<x}
KfncJ(?~2}4::|):{(,z`zbyB(|;z`x"{x}D(/):s08004{ 20+\w})v})au{W!\c LzTj0BD T5atW6W>2]_9^W;gd*eK)8s&hr}aeqpO}}h\
i)O^ q?PU.=h&L=&gi(?~" }{(z~(/
@/M|"di}e6}~(/{f6z2 ,c|c@c|"(y{de"gg&f*bhb izbc&h(/,b" p=hd,#"x(/nw# nhbbvc,u"H}{ddb' }h2 \zdt %#&}~ /{+.6.6{crmb7-Em"rnk.`8@D LS1WEL <wB
((( $ BF"+~0Sz{L|}L ]DLXT0#0
7
<| /*&&%r|A
n#
A#pf /p$y0p
pf|?1`=B^l<> OQ,
|zH @ ((( $ B
|7 ``D``D``D`dNF`b!`f`W"Zn &
XBT`Cb[DQ vnQ!~b\bYLdc6`B Dz@?^@.V/B#_ /D]"^`$a6`A/`vZB@(tyo Q/nrL_@8tiK@hijklmny@pSz(@N}0F"+~.6ZYX"`&-J.
W`!#f(V0 v{(?cf.U""&+J. /3]# T{$^) &r(v{,.$T2!_bU`!bS@/R!3 ~!!&db!bq*b =z_!&*&$^)$t!NJQ7UirP ~aa7(,2(OyN3a!f#&"#b(~!.!!.&8/|!"&dn*&M,6"%&!!. Z)7.w!L f`cs&!.(sV(2!.M(?;(OPabzf`cPP7(V0(v{ZP$!b!$g$$DP!b$0?K$7;J((mrO|v0`&a'
(?Rf.U OzI`#sa+N<'$@;+(?a"&s&'O;3 Cz"2sd~Jt"##bp|!ww Vp.((#eJH0&dbcrG /ys+wTqSY4@IHTaSH009 TaSH019 TSH029 (TSH039
(TSH04 9(TSH05(9
(TSH0609 TSH0789 Z
7
<| /*&&%r|A
n#
A#pf /p$y0p~TqDp(TDq(~TpTqTq3 R~TSD TSDF@~TqBBTBDF~1\pp 1\qp ~u3Arp3Asp~5]tp5]up~u7Qvp7QwpTRDHPtL4 BTL@V~pPTPPp~(1
pp
1\qp ~u3Arp3Asp~5]tp5]up~u7Qvp7QwpTRDHPtL4 BIC5 ~(ICt6ICu7ICv8ICw9I1w(9RESSE:INTEGER
END;
FELD=ARRAY[0..MAX] OF INTEGER;
VAR EINGABEREGISTER,AUSGABEREGISTER:REGISTER;
PROGRAMMSPEICHER:ARRAY[0..KAPAZITAET] OF BEFEHLSTYPE;
DATENSPEICHER:FELD;
BEFEHLSZAEHLER,LAENGE,TOP,AC,ADR,AUS:INTEGER;
KELLER:STACK;ABBRUCH:BOOLEAN;
LAD,SPD,LAI,SPI,EID,EII,AUD,AUI,SET,ADD,ADI,MLT,KPL,UND,ODR,
STP,VLL,VLR,SPR,SGN,SAM,GOS,RET,OP:STRING;
PROCEDURE LISTING;
VAR I,J:INTEGER;
BEGIN
FOR I:=0 TO LAENGE DO
BEGIN FOR J:=1 TO 3 DO WRITE(PROGRAMMSPEICHER[I].OPERATION[J]);
WRITELN(PROGRAMMSPEICHER[I].ADRESSE)
END END;
PROCEDURE EINGABE;
VAR Z,ADRESSE,I:INTEGER;ABBRUCH:BOOLEAN;
EIN:ARRAY[1..12] OF CHAR;ZEILENLAENGE:INTEGER;
BEGIN I:=0;ABBRUCH:=FALSE;
REPEAT
Z:=0;READLN;
REPEAT
Z:=Z+1;
READ(EIN[Z])
UNTIL EOLN OR (Z=12);ZEILENLAENGE:=Z;
ABBRUCH:= EIN[1]="*";
IF NOT ABBRUCH
THEN BEGIN
FOR Z:=1 TO 3
DO PROGRAMMSPEICHER[I].OPERATION[Z]:=EIN[Z];
ADR:=0;
IF ZEILENLAENGE >4
THEN FOR Z:=5 TO ZEILENLAENGE
DO ADR:=ADR*10+(ORD(EIN[Z])-ORD("0"));
PROGRAMMSPEICHER[I].ADRESSE:=ADR
END;
I:=I+1
UNTIL (I-1=KAPAZITAET) OR ABBRUCH;
WRITELN("PROGRAMM EINGEGEBEN.");LAENGE:=I-2;READLN;
WHILE NOT EOF DO
BEGIN READ(ADRESSE);WRITE(ADRESSE:2);READLN;
READ(ADR);WRITELN(ADR:3);DATENSPEICHER[ADRESSE]:=ADR END;
WRITELN("DATEN EINGEGEBEN.")
END;
(*BEI DER EINGABE KANN MAN NICHT IN DERSELBEN ZEILE CHARACTERS UND*)
(*ANSCHLIESSEND INTEGERS EINGEBEN. DAHER MUSS BEI DER EINGABE DES *)
(*MASCHINENPROGRAMMS EIN BEFEHL ZUNAECHST ALS STRING EINGEGEBEN *)
(*WERDEN UND DER ADRESSTEIL IN EINE ZAHL UMGEWANDELT WERDEN *)
PROGRAM MODELLRECHNER(INPUT,OUTPUT);
CONST MAX=99;KAPAZITAET=499;ELEMENTE=30;
TYPE STRING=ARRAY[1..3] OF CHAR;
REGISTER=ARRAY[0..11] OF INTEGER;
STACK=ARRAY[1..ELEMENTE]OF INTEGER;
BEFEHLSTYPE=RECORD
OPERATION:STRING;
ADRESSE:INTEGER
END;
FELD=ARRAY[0..MAX] OF INTEGER;
VAR EINGABEREGISTER,AUSGABEREGISTER:REGISTER;
PROGRAMMSPEICHER:ARRAY[0..KAPAZITAET] OF BEFEHLSTYPE;
DATENSPEICHER:FELD;
BEFEHLSZAEHLER,LAENGE,TOP,AC,ADR,AUS:INTEGER;
KELLER:STACK;ABBRUCH:BOOLEAN;
LAD,SPD,LAI,SPI,EID,EII,AUD,AUI,SET,ADD,ADI,MLT,KPL,UND,ODR,
STP,VLL,VLR,SPR,SGN,SAM,GOS,RET,OP:STRING;
PROCEDURE LISTING;
VAR I,J:INTEGER;
BEGIN
FOR I:=0 TO LAENGE DO
BEGIN FOR J:=1 TO 3 DO WRITE(PROGRAMMSPEICHER[I].OPERATION[J]);
WRITELN(PROGRAMMSPEICHER[I].ADRESSE)
END END;
PROCEDURE EINGABE;
VAR Z,ADRESSE,I:INTEGER;ABBRUCH:BOOLEAN;
EIN:ARRAY[1..12] OF CHAR;ZEILENLAENGE:INTEGER;
BEGIN I:=0;ABBRUCH:=FALSE;
REPEAT
Z:=0;READLN;
REPEAT
Z:=Z+1;
READ(EIN[Z])
UNTIL EOLN OR (Z=12);ZEILENLAENGE:=Z;
ABBRUCH:= EIN[1]="*";
IF NOT ABBRUCH
THEN BEGIN
FOR Z:=1 TO 3
DO PROGRAMMSPEICHER[I].OPERATION[Z]:=EIN[Z];
ADR:=0;
IF ZEILENLAENGE >4
THEN FOR Z:=5 TO ZEILENLAENGE
DO ADR:=ADR*10+(ORD(EIN[Z])-ORD("0"));
PROGRAMMSPEICHER[I].ADRESSE:=ADR
END;
I:=I+1
UNTIL (I-1=KAPAZITAET) OR ABBRUCH;
WRITELN("PROGRAMM EINGEGEBEN.");LAENGE:=I-2;READLN;
WHILE NOT EOF DO
BEGIN READ(ADRESSE);WRITE(ADRESSE:2);READLN;
READ(ADR);WRITELN(ADR:3);DATENSPEICHER[ADRESSE]:=ADR END;
WRITELN("DATEN EINGEGEBEN.")
END;
(*THOMAS JAECKEL MODELLCOMPUTER VERSION 1)
PROGRAM MODELLRECHNER(INPUT,OUTPUT);
CONST MAX=99;KAPAZITAET=499;ELEMENTE=30;
TYPE STRING=ARRAY[1..3] OF CHAR;
REGISTER=ARRAY[0..11] OF INTEGER;
STACK=ARRAY[1..ELEMENTE]OF INTEGER;
BEFEHLSTYPE=RECORD
OPERATION:STRING;
ADRESSE:INTEGER
END;
FELD=ARRAY[0..MAX] OF INTEGER;
VAR EINGABEREGISTER,AUSGABEREGISTER:REGISTER;
PROGRAMMSPEICHER:ARRAY[0..KAPAZITAET] OF BEFEHLSTYPE;
DATENSPEICHER:FELD;
BEFEHLSZAEHLER,LAENGE,TOP,AC,ADR,AUS:INTEGER;
KELLER:STACK;ABBRUCH,ENDE:BOOLEAN;
LAD,SPD,LAI,SPI,EID,EII,AUD,AUI,SET,ADD,ADI,MLT,KPL,UND,ODR,
STP,VLL,VLR,SPR,SGN,SAM,GOS,RET,OP:STRING;
PROCEDURE LISTING;
VAR I,J:INTEGER;
BEGIN
FOR I:=0 TO LAENGE DO
BEGIN FOR J:=1 TO 3 DO WRITE(PROGRAMMSPEICHER[I].OPERATION[J]);
WRITELN(PROGRAMMSPEICHER[I].ADRESSE)
END END;
PROCEDURE EINGABE;
VAR Z,ADRESSE,I:INTEGER;ABBRUCH:BOOLEAN;
EIN:ARRAY[1..12] OF CHAR;ZEILENLAENGE:INTEGER;
BEGIN I:=0;ABBRUCH:=FALSE;
REPEAT
Z:=0;READLN;
REPEAT
Z:=Z+1;
READ(EIN[Z])
UNTIL EOLN OR (Z=12);ZEILENLAENGE:=Z;
ABBRUCH:= EIN[1]="*";
IF NOT ABBRUCH
THEN BEGIN
FOR Z:=1 TO 3
DO PROGRAMMSPEICHER[I].OPERATION[Z]:=EIN[Z];
ADR:=0;
IF ZEILENLAENGE >4
THEN FOR Z:=5 TO ZEILENLAENGE
DO BEGIN IF (ORD( EIN[Z]) <=ORD("9")) AND(ORD(EIN[Z])>=ORD("0"))
THEN BEGIN ADR:=ADR*10+(ORD(EIN[Z])-ORD("0")) END
ELSE BEGIN WRITELN("ADRESSE MUSS AUS EINER POSITIVEN INTEGER ZAHL BESTEHEN!!");
ENDE:=TRUE;Z:=ZEILENLAENGE END END;
PROGRAMMSPEICHER[I].ADRESSE:=ADR
END;
I:=I+1
UNTIL (I-1=KAPAZITAET) OR ABBRUCH OR ENDE;
IF NOT ENDE THEN BEGIN
WRITELN("PROGRAMM EINGEGEBEN.");LAENGE:=I-2;READLN;
WHILE NOT EOF DO
BEGIN READ(ADRESSE);WRITE(ADRESSE:2);READLN;
READ(ADR);WRITELN(ADR:3);DATENSPEICHER[ADRESSE]:=ADR END;
WRITELN("DATEN EINGEGEBEN.")
END
END;
FUNCTION GLEICH(A,B:STRING):BOOLEAN;
VAR J:INTEGER;
BEGIN
GLEICH:=TRUE;
FOR J:=1 TO 3 DO
IF A[J]<>B[J]
THEN GLEICH:=FALSE
END;
PROCEDURE MULTIPLIZIERE(A:INTEGER);
BEGIN AC:=AC*DATENSPEICHER[A] END;
PROCEDURE DUALNACHDEZI(VAR DUAL:REGISTER;DEZIMAL:INTEGER);
VAR I:INTEGER;
BEGIN
DEZIMAL:=DUAL[10];
FOR I:=9 DOWNTO 0
DO BEGIN DEZIMAL:=DEZIMAL*2+DUAL[I] END;
DEZIMAL:=DEZIMAL-DUAL[11]*2048
END;
PROCEDURE DEZINACHDUAL(VAR DUAL:REGISTER;DEZIMAL:INTEGER);
VAR I:INTEGER;
BEGIN
IF(DEZIMAL>=-2048)AND(DEZIMAL<=2047)
THEN BEGIN IF(DEZIMAL<0)
THEN BEGIN
DUAL[11]:=1;DEZIMAL:=2048+DEZIMAL
END
ELSE DUAL[11]:=0;
FOR I:=0 TO 10
DO BEGIN DUAL[I]:=DEZIMAL MOD 2;
DEZIMAL:=DEZIMAL DIV 2
END
END
ELSE WRITELN("DIESE ZAHL LIEGT AUSSERHALB DES DEFINITIONSBEREICHS!")
END;
PROCEDURE LOGAND(AD:INTEGER);
VAR A,D:REGISTER;I:INTEGER;
BEGIN DEZINACHDUAL(A,AC);
DEZINACHDUAL(D,DATENSPEICHER[AD]);
FOR I:=0 TO 11 DO A[I]:=A[I]*D[I];
DUALNACHDEZI(A,AC);
END;
PROCEDURE DIGITALAC(A:INTEGER);
(*DUMMY*)
BEGIN WRITELN("BEFEHL NOCH NICHT DEFINIERT!!");ABBRUCH:=TRUE END;
PROCEDURE ODER(AD:INTEGER);
VAR A,D:REGISTER;I:INTEGER;
BEGIN DEZINACHDUAL(A,AC);DEZINACHDUAL(D,DATENSPEICHER[AD]);
FOR I:=0 TO 11 DO
BEGIN A[I]:=A[I]+D[I];
IF A[I]=2 THEN A[I]:=1 END;
DUALNACHDEZI(A,AC)
END;
PROCEDURE LINKSSHIFT;
VAR I:INTEGER;A:REGISTER;
BEGIN DEZINACHDUAL(A,AC);
FOR I:=11 DOWNTO 1 DO A[I]:=A[I-1];
A[0]:=0;DUALNACHDEZI(A,AC);
END;
PROCEDURE RECHTSSHIFT;
VAR I:INTEGER;A:REGISTER;
BEGIN DEZINACHDUAL(A,AC);
FOR I:=0 TO 10 DO A[I]:=A[I+1];
A[11]:=0;DUALNACHDEZI(A,AC)
END;
PROCEDURE GOSUB(A:INTEGER);
BEGIN
IF TOP=ELEMENTE
THEN BEGIN
WRITELN("MEHR ALS ",ELEMENTE:2," UNTERPROGRAMMEBENEN NICHT VERARBEITBAR");
END
ELSE BEGIN
TOP:=TOP+1;
KELLER[TOP]:=BEFEHLSZAEHLER;
BEFEHLSZAEHLER:=A
END
END;
PROCEDURE RETURN;
BEGIN
IF TOP=0
THEN BEGIN
WRITELN("GOSUB BEFEHL FEHLT!!!");
ABBRUCH:=TRUE
END
ELSE BEGIN
BEFEHLSZAEHLER:=KELLER[TOP];
TOP:=TOP-1
END
END;
PROCEDURE AUSGABE(A:INTEGER);
BEGIN AUS:=DATENSPEICHER[A] END;
PROCEDURE LADE(A:INTEGER);
BEGIN AC:=DATENSPEICHER[A] END;
PROCEDURE SPEICHERE(A:INTEGER);
BEGIN DATENSPEICHER[A]:=AC ;AC:=0 END;
PROCEDURE SETZE(A:INTEGER);
BEGIN AC:=A END;
PROCEDURE ADDIERE(A:INTEGER);
BEGIN AC:=AC+DATENSPEICHER[A] END;
PROCEDURE KOMPLEMENT;
BEGIN AC:=-AC END;
PROCEDURE SPRINGE(A:INTEGER);
BEGIN BEFEHLSZAEHLER:=A END;
PROCEDURE SPRINGEBEINULL(A:INTEGER);
BEGIN IF AC=0 THEN BEFEHLSZAEHLER:=A END;
PROCEDURE SPRKLEINERNULL(A:INTEGER);
BEGIN IF AC<0 THEN BEFEHLSZAEHLER:=A END;
BEGIN(*HAUPTPROGRAMM*)
LAD[1]:="L";LAD[2]:="A";LAD[3]:="D";
AUD[1]:="A";AUD[2]:="U";AUD[3]:="D";
SPD[1]:="S";SPD[2]:="P";SPD[3]:="D";
SET[1]:="S";SET[2]:="E";SET[3]:="T";
ADD[1]:="A";ADD[2]:="D";ADD[3]:="D";
LAI[1]:="L";LAI[2]:="A";LAI[3]:="I";
SPI[1]:="S";SPI[2]:="P";SPI[3]:="I";
EID[1]:="E";EID[2]:="I";EID[3]:="D";
EII[1]:="E";EII[2]:="I";EII[3]:="I";
AUI[1]:="A";AUI[2]:="U";AUI[3]:="I";
ADI[1]:="A";ADI[2]:="D";ADI[3]:="I";
MLT[1]:="M";MLT[2]:="L";MLT[3]:="T";
KPL[1]:="K";KPL[2]:="P";KPL[3]:="L";
UND[1]:="U";UND[2]:="N";UND[3]:="D";
ODR[1]:="O";ODR[2]:="D";ODR[3]:="R";
STP[1]:="S";STP[2]:="T";STP[3]:="P";
VLL[1]:="V";VLL[2]:="L";VLL[3]:="L";
VLR[1]:="V";VLR[2]:="L";VLR[3]:="R";
SPR[1]:="S";SPR[2]:="P";SPR[3]:="R";
SGN[1]:="S";SGN[2]:="G";SGN[3]:="N";
SAM[1]:="S";SAM[2]:="A";SAM[3]:="M";
GOS[1]:="G";GOS[2]:="O";GOS[3]:="S";
RET[1]:="R";RET[2]:="E";RET[3]:="T";
ENDE:=FALSE;
EINGABE;
IF NOT ENDE THEN BEGIN
LISTING;
BEFEHLSZAEHLER:=0;TOP:=0;AUS:=0;ABBRUCH:=FALSE;AC:=0;
REPEAT
OP:=PROGRAMMSPEICHER[BEFEHLSZAEHLER].OPERATION;
ADR:=PROGRAMMSPEICHER[BEFEHLSZAEHLER].ADRESSE;
BEFEHLSZAEHLER:=BEFEHLSZAEHLER+1;
IF OP[1]="S"
THEN BEGIN IF GLEICH(OP,SPD) THEN SPEICHERE(ADR) ELSE
IF GLEICH(OP,SET) THEN SETZE(ADR) ELSE
IF GLEICH(OP,SPR) THEN SPRINGE(ADR) ELSE
IF GLEICH(OP,SGN) THEN SPRINGEBEINULL(ADR) ELSE
IF GLEICH(OP,SAM) THEN SPRKLEINERNULL(ADR) ELSE
IF GLEICH(OP,SPI) THEN SPRINGE(DATENSPEICHER[ADR]) ELSE
IF GLEICH(OP,STP) THEN ABBRUCH:=TRUE
ELSE BEGIN WRITELN("BEFEHL NICHT DEFINIERT!!");
ABBRUCH:=TRUE
END END
ELSE BEGIN
IF OP[1]="A"
THEN BEGIN IF GLEICH(OP,ADD) THEN ADDIERE(ADR) ELSE
IF GLEICH(OP,AUD) THEN AUSGABE(ADR) ELSE
IF GLEICH(OP,AUI) THEN AUSGABE(DATENSPEICHER[ADR]) ELSE
IF GLEICH(OP,ADI) THEN ADDIERE(DATENSPEICHER[ADR])
ELSE BEGIN WRITELN("BEFEHL NICHT DEFINIERT!!");
ABBRUCH:=TRUE
END END
ELSE BEGIN IF GLEICH(OP,LAD) THEN LADE(ADR) ELSE
IF GLEICH(OP,KPL) THEN KOMPLEMENT ELSE
IF GLEICH(OP,LAI) THEN LADE(DATENSPEICHER[ADR]) ELSE
IF GLEICH(OP,EID) THEN DIGITALAC(ADR) ELSE
IF GLEICH(OP,EII) THEN DIGITALAC(DATENSPEICHER[ADR]) ELSE
IF GLEICH(OP,MLT) THEN MULTIPLIZIERE(ADR) ELSE
IF GLEICH(OP,UND) THEN LOGAND(ADR) ELSE
IF GLEICH(OP,ODR) THEN ODER(ADR) ELSE
IF GLEICH(OP,VLL) THEN LINKSSHIFT ELSE
IF GLEICH(OP,VLR) THEN RECHTSSHIFT ELSE
IF GLEICH(OP,GOS) THEN GOSUB(ADR) ELSE
IF GLEICH(OP,RET) THEN RETURN ELSE
BEGIN
WRITELN("BEFEHL NICHT DEFINIERT!!");ABBRUCH:=TRUE
END END END
UNTIL ABBRUCH OR(KAPAZITAET+1=BEFEHLSZAEHLER);
WRITELN;WRITELN("AUSGABE: ",AUS:5)
END
END.
PROGRAM QUATSCH(INPUT,OUTPUT);
CONST N=30;
TYPE STRING=ARRAY[1..N]OF CHAR;
VAR NAME:STRING;
PROCEDURE EINGABE(VAR WORT:STRING);
VAR INDEX:INTEGER;
BEGIN
READLN;
INDEX:=0;
REPEAT
INDEX:=INDEX+1;
READ(WORT[INDEX]);
UNTIL (EOLN) OR (INDEX=N);
END;
BEGIN (*HAUPTPROGRAMM*)
WRITELN("LOGIN PLEASE!");
EINGABE(NAME);
WRITELN("LOG'DICH NOCHMAL EIN!");
EINGABE(NAME);
WRITELN("ICH HAB'JETZT KEINE LUST.LASS MICH IN RUHE!!");
WRITELN("WAS WILLST DU UEBERHAUPT VON MIR?");
EINGABE(NAME);
WRITELN("DU HAST WOHL NEN KNALL.JETZT WIRD PAUSE GEMACHT!");
WRITELN("IRGENDWANN MUSS AUCH EIN COMPUTER SCHLAFEN!");
WRITELN("WIE IST DAS WETTER DRAUSSEN?");
EINGABE(NAME);
WRITELN("DANKE.WIE HEISST DU DENN?");
EINGABE(NAME);
WRITELN("JETZT HOER MIR MAL GUT ZU!");
WRITELN("ICH STREIKE.ZUMINDESTENS BIS ZU DEN TARIFVERHANDLUNGEN!");
WRITELN("IMMER DIESE STOERENFRIEDE!MIR REICHTS JETZT!!!!!");
WRITELN("LOGOUT PLEASE!LOGOUT PLEASE!");
EINGABE(NAME);
WRITELN("TUT MIR LEID.WAR NICHT SO GEMEINT.");
WRITELN("MACH RUHIG WEITER.ICH DARF EINFACH NICHT SO AUS MIR HERAUSPLATZEN.");
END.
PROGRAM GAMEOFLIVE(INPUT,OUTPUT);
CONST MAX1=9;MAX2=10;
BESETZT="*";FREI=" ";
VAR ALT, NEU:ARRAY[0..MAX2,0..MAX2] OF CHAR;
I,J,Z,S:INTEGER;ANTWORT,U,N:CHAR;
ZAEHLER:ARRAY[1..MAX1,1..MAX1] OF INTEGER;
PROCEDURE BESETZTENACHBARNZAEHLEN;
VAR I,J,X,Y:INTEGER;
BEGIN
FOR I:=1 TO MAX1 DO
FOR J:=1 TO MAX1 DO
BEGIN ZAEHLER[I,J]:=0;
FOR X:=I-1 TO I+1 DO
FOR Y:=J-1 TO J+1 DO
IF ALT[X,Y]=BESETZT
THEN ZAEHLER[I,J]:=ZAEHLER[I,J]+1;
IF ALT[I,J]=BESETZT
THEN ZAEHLER[I,J]:=ZAEHLER[I,J]-1
END
END;
PROCEDURE SPIELSTANDAUSGEBEN;
VAR I,J:INTEGER;
BEGIN
FOR I:=1 TO MAX1
DO BEGIN FOR J:=1 TO MAX1
DO WRITE (ALT[I,J]:1);
WRITELN
END
END;
BEGIN(*HAUPTPROGRAM*)
FOR Z:=0 TO MAX2
DO FOR S:=0 TO MAX2
DO BEGIN ALT[Z,S]:=FREI;
NEU[Z,S]:=FREI
END;
(*ANFANGSSITUATION EINGEBEN*)
REPEAT READLN(Z,S);
ALT[Z,S]:=BESETZT;
WRITE("NOCH EIN FELD BESETZEN(J/N");
READLN(ANTWORT)
UNTIL ANTWORT="N";
SPIELSTANDAUSGEBEN;
REPEAT BESETZTENACHBARNZAEHLEN;
FOR I:=1 TO MAX1
DO FOR J:=1 TO MAX1
DO IF ALT[I,J]=FREI
THEN IF ZAEHLER[I,J]=3
THEN NEU[I,J]:=BESETZT
ELSE NEU[I,J]:=FREI
ELSE IF (ZAEHLER[I,J]<2)
OR (ZAEHLER[I,J]>3)
THEN NEU[I,J]:=FREI
ELSE NEU[I,J]:=BESETZT;
ALT:=NEU;SPIELSTANDAUSGEBEN;WRITE("NOCHMAL(J/N)");READLN(ANTWORT)
UNTIL ANTWORT="N"
END.
PROGRAM WURZELBERECHNUNG (INPUT, OUTPUT);
VAR X0 ,XN ,A :REAL;
BEGIN
WRITELN ("BITTE GEBEN SIE DIE ZAHL EIN ,AUSDDER DIE WURZEL
BERECHNET WERDEN SOLL:");
READLN;READ (A);
XN= A / 2.0;
WRITELN(XN);
REPEAT XN:=X0
X0:=0.5*(XN+A/XN)
WRITELN(XN);
UNTIL ABS(X0-XN)<1.0E-18
END.
E
PROGRAM BAHN(INPUT,OUTPUT);
CONST D=86400;
VAR VXN,VYN,XN,YN,AXN,AY0,X0,Y0,VX0,VY0,AX0,AYN,BETRAG:REAL;
N:INTEGER;
BEGIN
WRITELN("GIB VY0 EIN");
READLN;
READ(VY0);
X0:=-1.471*1.0E11;Y0:=0;VX0:=0;
AX0:=0.613*1.0E-2;AY0:=0;
FOR N:=1 TO 365
DO BEGIN
VXN:=VX0+AX0*D;VYN:=VY0+AY0*D;
XN:=X0+VXN*D;YN:=Y0+VYN*D;
BETRAG:=(XN*XN+YN*YN);
AXN:=-1.327*1.0E20*XN/(BETRAG*SQRT(BETRAG));
AYN:=-1.327*1.0E20*YN/(BETRAG*SQRT(BETRAG));
WRITELN("NACH ",N," TAGEN IST XN=",XN," YN=",YN);
VX0:=VXN;VY0:=VYN;X0:=XN;Y0:=YN;AX0:=AXN;AY0:=AYN;
END
END.
PROGRAM BAHN (INPUT,OUTPUT);
CONST D=86400;
VAR BETRAG,VXN,VYN,XN,YN,AXN,AY0,X0,Y0,VX0,VY0,AX0:REAL;
N:INTEGER;
BEGIN
WRITELN("GIB VY EIN.");
READLN;READ(VY0);
X0:=-1.471E11;Y0:=0.0;VX0:=0.0;
AX0:=0.613E-2;AY0:=0.0;
FOR N:=1 TO 365
DO BEGIN
VXN:=VX0+AX0*D;VYN:=VY0+AX0*D;
XN:=X0+VXN*D;YN:=Y0+VYN*D;
BETRAG:=(XN*XN+YN*YN);
AXN:=-1.327E20*XN/(BETRAG*SQRT(BETRAG));
WRITELN("NACH",N," TAGEN IST XN=",XN," YN=",YN);
VX0:=VXN;VY0:=VYN;X0:=XN;Y0:=YN;AXN:=AX0
END
END.
PROGRAM BAHN(INPUT,OUTPUT);
CONST D=86400;
MX=1.0E10;
MY=1.0E10;
TYPE MATRIX=ARRAY[1..60,1..80]OF CHAR;
VAR XPOS,YPOS,VXN,VYN,XN,YN,AXN,AY0,X0,Y0,VX0,VY0,AX0,AYN,BETRAG:REAL;
N,I,J:INTEGER;
GRAPH:MATRIX;
BEGIN
WRITELN("GIB VY0 EIN");
READLN;
READ(VY0);
X0:=-1.471*1.0E11;Y0:=0;VX0:=0;
AX0:=0.613*1.0E-2;AY0:=0;
WRITE("STELLE 1");
FOR I:=1 TO 71
DO FOR J:=1 TO 60
DO GRAPH[J,I]:=" ";
WRITE("STELLE 11");
FOR I:=1 TO 80
DO GRAPH[30,I]:="_";
WRITE("STELLE2 ");
FOR J:=1 TO 60
DO GRAPH[J,40]:="!";
WRITE("DET");
FOR N:=1 TO 365
DO BEGIN
VXN:=VX0+AX0*D;VYN:=VY0+AY0*D;
XN:=X0+VXN*D;YN:=Y0+VYN*D;
IF N=(N DIV 8)*8
THEN BEGIN
XPOS:=XN/MX+40;YPOS:=YN/MY+30;
I:=TRUNC(XPOS);
J:=TRUNC(YPOS);
GRAPH[J,I]:="*";
END;
BETRAG:=(XN*XN+YN*YN);
AXN:=-1.327*1.0E20*XN/(BETRAG*SQRT(BETRAG));
AYN:=-1.327*1.0E20*YN/(BETRAG*SQRT(BETRAG));
VX0:=VXN;VY0:=VYN;X0:=XN;Y0:=YN;AX0:=AXN;AY0:=AYN;
END;
WRITELN("YUIO");
FOR I:=1 TO 71
DO BEGIN
WRITELN;
FOR I:=1 TO 20
DO WRITE(GRAPH[J,I])
END;
WRITELN("END;E ")
END.
PROGRAM APOLLOFLUG(INPUT,OUTPUT);
CONST D=20; PI=3.141592654;
VAR BETRAG,VXN,VYN,XN,YN,AXN,AYN,XO,YO,VXO,VYO,R,PHI,T0,TN,GXN,GYN:REAL;
SN,RR,BOG:REAL;
A,N,O:INTEGER;
BEGIN
WRITELN("GEBEN SIE BITTE VYO EIN.");
READLN;READ(VYO);
WRITELN("WIEVIEL EINHEITEN SOLLEN BERECHNET WERDEN?");
READLN;READ(O);
WRITELN
("ALLE WIEVIEL EINHEITEN SOLL DER WERT AUSGEDRUCKT WERDEN?");
READLN;READ(A);
XO:=5.637E6;YO:=-3.803E6;
VXO:=6.011E3;
T0:=0;R:=3.84E8;
FOR N:=1 TO O
DO BEGIN
XN:=XO+VXO*D;
YN:=YO+VYO*D;
BETRAG:=(XN*XN+YN*YN);
RR:=SQRT(BETRAG);
TN:=T0+D;PHI:=(1.525)*1.0E-4*TN;
BOG:=PHI*2*PI/360;
GXN:=R*COS(BOG);
GYN:=R*SIN(BOG);
BETRAG:=(GXN-XN)*(GXN-XN)+(GYN-YN)*(GYN-YN);
SN:=SQRT(BETRAG);
AXN:=-3.99E14*XN/(RR*RR*RR)+4.91*1.0E12*(GXN-XN)/(SN*SN*SN);
AYN:=-3.99*1.0E14*YN/(RR*RR*RR)+4.91*1.0E12*(YN-GYN)/(SN*SN*SN);
VXN:=VXO+AXN*D;
VYN:=VYO+AYN*D;
IF N=(N DIV A)*A
THEN BEGIN
WRITELN("*":ROUND(50-50*GXN/3.84*1.0E9),"*":ROUND(50-50*XN/3.84*1.0E9));
END;VXO:=VXN;VYO:=VYN;XO:=XN;YO:=YN;T0:=TN;END;
END.
PROGRAM AUSWAHLSORTIEREN(INPUT,OUTPUT);
CONST N=7;
TYPE FOLGE=ARRAY[1..N] OF INTEGER;
VAR A:FOLGE;
I,MINPOS,X,Y:INTEGER;
PROCEDURE EINGABE;
BEGIN
I:=0;
READLN;
FOR I:=1 TO N
DO READ(A[I])
END;
PROCEDURE MINSUCHE(I:INTEGER;VAR MINPOS:INTEGER);
VAR J,MINIMUM:INTEGER;
BEGIN
MINIMUM:=A[I];
MINPOS:=I;
MINIMUM:=A[I];
FOR J:=1+I TO N
DO IF MINIMUM>A[J]
THEN BEGIN MINIMUM:=A[J];MINPOS:=J END
END;
PROCEDURE VERTAUSCHE(VAR X,Y:INTEGER);
VAR HILF:INTEGER;
BEGIN
HILF:=X;
X:=Y;
Y:=HILF
END;
PROCEDURE AUSGABE;
BEGIN
FOR I:=1 TO N
DO WRITE(A[I])
END;
BEGIN (*MAIN*)
WRITELN("GIB FOLGE EIN");
EINGABE;
FOR I:=1 TO N-1
DO BEGIN
MINSUCHE(I,MINPOS );
VERTAUSCHE(A[I],A[MINPOS]);
AUSGABE
END
END.
PROGRAM HANOI(IN,OUT);
TYPE TABBELLE=ARRAY[1..99] OF INTEGER;
VAR I,ANZAHL:INTEGER;T:TABBELLE;
PROCEDURE SKLAVE(ZAHL:INTEGER;VAR T:TABBELLE);
VAR U:INTEGER;
BEGIN IF ZAHL=1 THEN BEGIN
U:=(T[1]+1) MOD 3;
WRITELN("SCHEIBE 1 VON TURM ",T[1]:1," NACH TURM:",U:1);
T[1]:=U END ELSE BEGIN
SKLAVE(ZAHL-1,T);
U:=(T[ZAHL]+2-ZAHL MOD 2) MOD 3;
WRITELN("SCHEIBE ",ZAHL:1," VON TURM ",T[ZAHL]:1," NACH TURM:",U:1);
T[ZAHL]:=U;
SKLAVE(ZAHL-1,T);
END; END;
BEGIN READLN(ANZAHL);
FOR I:=1 TO ANZAHL DO
T[I]:=1;
SKLAVE(ANZAHL,T)
END.
ADD 1
ADD 2
SPD 3
AUD 3
STP
*
1
25
2
30
3
40
10 REM PROGRAM AUTHOR - MARK MANASSE, HANOVER,N.H. 03755
20 REM TRANSLATED TO OS8 BASIC BY KAY R. FISHER ...DEC
30 PRINT "CAN-AM...OS8 VERSION."
40 PRINT\PRINT"DO YOU WISH INSTRUCTIONS (YES OR NO)";
45 DIM Q$(3,13)\Q$(1)="WILDMAN WILLY"\Q$(2)="HOTSHOT HARRY"
46 DIM E(4),L(4),A$(22)
47 Q$(3)="SLOW-POKE SAM"
50 INPUT A$
60 IF A$="NO" GOTO700
70 IF A$="YES" GOTO85
80 PRINT"PLEASE RESPOND 'YES OR NO'"\GOTO 40
85 PRINT"THE INSTRUCTIONS ARE LONGER THAN THE SCREEN CAN HANDLE."
86 PRINT"BE SURE THAT THE AUTO-PRINT IS TURNED ON BEFORE CONTINUING."
87 PRINT"TO CONTINUE, TYPE <CR>.";\INPUT Q9
100 PRINT"DESCRIPTION -- THE PROGRAM ALLOWS YOU TO RACE AROUND A HIGHLY"
110 PRINT"PERILOUS COURSE, RISKING BOTH LIFE AND MACHINE, IN AN"
120 PRINT"EFFORT TO RACE THE COMPUTER'S VERY OWN"
130 PRINT Q$(1);", ";Q$(2);", AND ";Q$(3);"."
135 PRINT"CAR#1 CAR#2 CAR#3"
140 PRINT\PRINT"INSTRUCTIONS--"
150 PRINT"YOU ARE ABOUT TO RACE ON ONE OF THE FASTEST COURSES"
160 PRINT"IN THE WORLD. A ROAD COURSE. A LONG ONE. 5.3 MILES. SPEEDS"
170 PRINT"UP TO 200 MPH."
180 PRINT\PRINT"WHEN THE COMPUTER TYPES A QUESTION OF THE FORM"
190 PRINT" STRAIGHT A? OR CURVE 1?"
200 PRINT"RESPOND BY TYPING THE SPEED (IN MPH) YOU DESIRE TO TRAVEL AT,"
210 PRINT"AND HIT THE RETURN KEY. GOOD LUCK. YOU MAY NEED IT."
220 PRINT "YOU MAY 'DRAFT' (SLIPSTREAM) OFF OF ANY CAR AHEAD"
230 PRINT "OF YOU. (BUT NOT MORE THAN 1 SECOND AHEAD). TO DO THIS"
240 PRINT "TYPE HIS CAR # + 1000 AS YOUR SPEED."
700 REM AMOUNT SPEED TO BE SUBTRACTED FROM AUTO PILOT SPEEDS
710 Q(1)=-2.9\Q(2)=-2.9\Q(3)=-5
720 REM NAMES OF TYPES OF ROADWAY
730 M$(1)="STRAIGHT"\M$(2)="HAIRPIN"\M$(3)="CURVE"
740 REM DEATH MESSAGE
750 DIM X$(64)
760 X$="MAY I SHOW YOU A PLOT? WE HAVE A NICE CHOICE OF HEADSTONES."
890 O$=""
920 PRINT"RATE YOURSELF AS A DRIVER. (1-BEST,3-WORST)";
930 INPUT O
935 REM MAKE SLOW-POKE SAM EQUAL TO OR WORSE THAN YOU
940 Q(3)=Q(3)*O
1050 RANDOMIZE
1110 F2=INT(RND(0)*10)+7
1130 PRINT"YOUR DRIVING NUMBER IS";F2
1140 A=RND(0)*.05+.05
1150 PRINT "ADHESION FACTOR";A*100-5;". (THE LOWER THE BETTER)"
1170 PRINT"YOUR MAX. SPEED IS 200 MPH. TO SEE STANDINGS INPUT"
1180 PRINT"0 AS YOUR SPEED."
1190 PRINT\PRINT"WOULD YOU LIKE TO SEE THE COURSE";
1200 INPUT A$
1240 IF A$="NO" THEN 1450
1250 IF A$="YES" THEN 1260\PRINT"PLEASE ANSWER 'YES OR NO'"\GOTO 1190
1260 PRINT TAB(4);"----------------"
1270 PRINT TAB(3);"/1";TAB(11);"B";TAB(19);"2";CHR$(28)
1280 PRINT TAB(2);"/A";TAB(20);"C";CHR$(28)
1290 PRINT TAB(1);"/";TAB(22);CHR$(28)
1300 PRINT CHR$(28);TAB(21);"3I"
1310 PRINT "^-START*FINISH";TAB(22);"I"
1320 PRINT "^";TAB(22);"I"
1330 PRINT "^";TAB(21);"DI"
1340 PRINT "^";TAB(22);"I"
1350 PRINT "^";TAB(22);"I"
1360 PRINT "^H";TAB(22);"I"
1370 PRINT "^";TAB(22);"I"
1380 PRINT "^";TAB(21);"4I"
1390 PRINT "^";TAB(16);"------/"
1400 PRINT "^8";TAB(15);"(5 E"
1410 PRINT "^";TAB(16);CHR$(28)
1420 PRINT CHR$(28);TAB(17);"---/PITS";CHR$(28);"--)"
1430 PRINT " ";CHR$(28);"7";TAB(14);"G";TAB(21);"F^";TAB(27);"6I"
1440 PRINT " ";CHR$(28);"------------------------/"
1450 N=RND(0)*3+1
1460 PRINT\PRINT "NOTE! THIS IS A";INT(N);"LAP RACE"
1470 PRINT\PRINT "GENTLEMEN, START YOUR ENGINES! THE GREEN GOES DOWN AND"
1480 PRINT "OFF YOU GO!"
1510 Q=0
1520 H=INT(N)
1530 FOR V=1 TO N
1540 A$=M$(1)\R=200\B=1\C=3/10\D=65
1545 GOSUB 2330
1550 A$=M$(3)\R=125\B=1\C=1/10\D=49
1555 GOSUB 2330
1560 A$=M$(1)\R=200\B=2\C=13/20\D=66
1565 GOSUB 2330
1570 A$=M$(3)\R=125\B=1\C=1/10\D=50
1575 GOSUB 2330
1580 A$=M$(1)\R=200\B=1\C=1/5\D=67
1585 GOSUB 2330
1590 A$=M$(3)\R=150\B=1\C=3/20\D=51
1595 GOSUB 2330
1600 A$=M$(1)\R=200\B=2\C=3/5\D=68
1605 GOSUB 2330
1610 A$=M$(3)\R=125\B=1\C=1/10\D=52
1615 GOSUB 2330
1620 A$=M$(1)\R=200\B=1\C=1/4\D=69
1625 GOSUB 2330
1630 A$=M$(2)\R=100\B=.75\C=3/20\D=53
1635 GOSUB 2330
1640 A$=M$(1)\R=200\B=1.5\C=9/20\D=70
1645 GOSUB 2330
1650 A$=M$(2)\R=100\B=.75\C=3/20\D=54
1655 GOSUB 2330
1660 A$=M$(1)\R=200\B=2\C=1\D=71
1665 GOSUB 2330
1670 A$=M$(3)\R=125\B=1\C=1/10\D=55
1675 GOSUB 2330
1680 A$=M$(3)\R=150\B=1\C=3/20\D=56
1685 GOSUB 2330
1690 A$=M$(1)\R=200\B=2\C=7/10\D=72
1695 GOSUB 2330
1700 IF V=H THEN 1740
1710 A$="START FINISH (CURVE 9)"\R=150\B=1\C=3/20\D=127
1715 GOSUB 2330
1740 NEXT V
1745 REM ALL DEAD?
1750 IF G1=1 THEN 2040
1760 PRINT "DO YOU MEAN THAT EVERYONE ISN'T DEAD? WELL, HERE ARE"
1770 PRINT "THE RESULTS STRAIGHT FROM THE CHECKERED FLAG!"
1780 W=E+37
1820 G5=4
1830 FOR Z=1 TO 4
1840 IF Z=4 GOTO 1860
1850 PRINT Q$(Z);\GOTO 1890
1860 PRINT "YOU";
1890 IF D(Z)=0 THEN 1950
1900 PRINT " IS LOOKIN' AT THEM PEARLY GATES."
1910 GOTO 1990
1940 REM T ARRAY IS TIME ARRAY
1950 PRINT" TOOK";T(Z);"SECONDS. WHICH AVERAGES OUT TO";3600*5.3*H/T(Z);
1951 PRINT"MPH"
1960 IF T(Z)>W THEN 1990
1965 REM NEW LEADING TIME AND DRIVER
1970 W=T(Z)
1980 N=F2*(Z+1)+Z
1990 NEXT Z
2040 PRINT "ANOTHER RACE";
2050 INPUT A$
2080 IF A$="NO" THEN 2290
2090 IF A$<>"YES" THEN 2040
2095 REM RESET FOR NEXT GAME
2100 T(1)=0\T(2)=0\T(3)=0\T(4)=0
2105 P(1)=0\P(2)=0\P(3)=0\P(4)=0\N(1)=0\N(2)=0\N(3)=0
2110 D(1)=0\D(2)=0\D(3)=0\D(4)=0
2130 PRINT "NEW SET-UP. NO RAIN. NO DEBRIS";
2135 REM IF EVERYBODY'S DEAD, BE NASTY.
2140 IF G1=0 THEN 2160
2150 PRINT ", AND (PLEASE!) BETTER DRIVING."
2160 PRINT
2165 REM UNKILL EVERYBODY
2170 G1=0\F5=0
2180 GOTO 710
2290 STOP
2320 REM RACING SUBROUTINE
2325 REM ALL DEAD?
2330 IF G1=1 THEN 4250
2335 REM GET SOME HAZZARDS (IE RAIN, OIL)
2340 GOSUB 2800
2345 REM GET EVERYONE'S SPEED
2350 GOSUB 3220
2355 REM CHECK FOR SAFE SPEEDS
2360 G=4
2370 IF D(4)=1 THEN 2790
2380 IF (B+A+E)*S(4)/B<=R*(1+RND(0)*.1) THEN 2500
2385 REM DEATH MESSAGE
2390 PRINT X$
2392 PRINT "YOU JUST WIPED OUT!!!!"
2395 REM INCREMENT OIL COUNTER
2400 F5=F5+1
2410 E(F5)=D
2455 REM OFFICIALLY PRONOUNCE DEAD. D IS FOR DEATH.
2460 D(G)=1
2465 REM INCREMENT DEAD COUNTER
2470 Q=Q+1
2475 REM EVERYBODY DEAD?
2480 IF Q=4 THEN 4230
2495 REM RATS. HE DIDN'T WIPE OUT.
2500 Y4=T(G)
2505 GOTO 2526
2510 IF (B+A(G)+E)*S(G)/B<=R THEN 2530
2515 REM ALMOST WIPED OUT
2520 PRINT "YOU NEARLY HAD TO SAY GOOD BYE."
2525 REM UPDATE HIS TIME
2526 REM
2527 REM
2530 T(G)=T(G)+C/(S(G)/3600)
2535 REM SEE IF, HEAVEN FORBID, HE PASSED SOMEBODY
2550 FOR X4= 1 TO 3
2560 IF D(X4)=1 THEN 2650
2570 Z4=T(X4)-(C/(S(X4)/3600))
2580 Z1=Y4-Z4
2590 Z2=T(G)-T(X4)
2600 IF SGN(Z2)<>-SGN(Z1) THEN 2650
2610 IF SGN(Z2)=1 THEN 2631
2611 IF P(X4)=1 GOTO 2650\P(X4)=1
2620 PRINT "YOU JUST PASSED ";Q$(X4)
2630 GOTO 2650
2631 IF N(X4)=1 GOTO 2650\N(X4)=1
2640 PRINT Q$(X4);" JUST PASSED YOU"
2650 NEXT X4
2760 REM PROCEED TO THE FATE OF THE NEXT VICTIM
2790 GOTO 4250
2800 REM HAZARD SUBROUTINE
2810 REM MAKE SURE WE DON'T USE LAST SECTION'S OIL ON THIS SECTION
2820 E=0
2825 REM KILL PITSTOPS FROM LAST TIME
2830 L(1)=0\L(2)=0\L(3)=0\L(4)=0
2845 REM IF COURSE WELL GREASED, DISSOLVE GREASE
2850 IF F5<2 THEN 2900
2860 PRINT "THE RED FLAG HAS BEEN PUT OUT. CARS REMAIN"
2870 PRINT "MOTIONLESS UNTIL DEBRIS IS CLEARED"
2880 E(1)=0\E(2)=0\E(3)=0\E(4)=0
2890 F5=0
2895 REM SEE IF THOSE PLAYING DESERVE OIL
2900 FOR X=1 TO 4
2910 IF E(X)=D THEN 2940
2920 NEXT X
2930 GOTO 2970
2935 REM IF SO, NOTIFY SURVIVORS AND OTHERS
2940 PRINT "YIKES! OIL ON THE TRACKS!"
2950 E=.2
2960 GOTO 3130
2965 REM HAVE WE HAD RAIN?
2970 IF F3=1 THEN 3130
2975 REM SEE IF IT SHOULD BE STOPPED OR STARTED
2980 IF RND(0)>.025+G8 THEN 3130
2985 REM IS IT RAINING?
2990 IF A(O)<.1 THEN 3080
2995 REM STOP IT?
3000 IF RND(0)>.5 THEN 3130
3010 PRINT "GLORY BE, THE RAIN HAS STOPPED!"
3011 PRINT "BUT REMEMBER IT IS STILL WET"
3015 REM RAIN,RAIN, GO AWAY, WON'T COME BACK ANOTHER DAY
3020 F3=1
3030 FOR X=1 TO 4
3035 REM DELETE MOST OF THE EFFECTS
3040 A(X)=A(X)-.075
3045 REM MAKE IT LESS LIKELY TO RAIN IN LATER RACES
3050 G8=.025
3060 NEXT X
3070 GOTO 3130
3075 REM HALLELUJAH, MY RAIN DANCE WORKED
3080 PRINT "RAIN! SLOW DOWN!!"
3085 REM MAKE TRACK SLIPPERY
3090 FOR X=1 TO 4
3100 A(X)=A(X)+.1
3110 G8=.1
3120 NEXT X
3125 REM PIT STOPS?
3130 IF C<>9/20 THEN 3210
3140 IF RND(0)<.125 THEN 3210
3150 FOR X=1 TO 3
3170 IF D(X)=1 THEN 3200
3180 L(X)=RND(0)*3+5
3190 PRINT Q$(X);" WAS IN THE PITS FOR";L(X);"SECONDS."
3200 NEXT X
3201 IF D(4)=1 GOTO 3203
3202 L(4)=RND(0)*3+5\PRINT"YOU WERE IN THE PITS FOR";L(4);"SECONDS."
3203 FOR I=1 TO 4\T(I)=T(I)+L(I)\NEXT I
3205 REM WE WUZ HERE (AND LEFT!)
3210 RETURN
3220 REM INPUT
3225 REM RESET SPEED ARRAY
3230 S(1)=0\S(2)=0\S(3)=0\S(4)=0
3235 REM PRINT OUT SOMETHING LIKE 'STRAIGHT A'
3240 REM IF HES DEAD, DON'T GIVE HIM A CHANCE TO INPUT
3245 IF D(4)=1 GOTO 3770
3250 PRINT A$;" ";CHR$(D);
3270 REM GET EVERYBODY'S SPEEDS
3340 INPUT J
3480 S=J
3482 R5=0
3485 REM DID HE TRY TO EXCEED HIS MAX. SPEED?
3490 IF S<=200 THEN 3620
3510 IF S<1000 THEN 3600
3515 REM IT'S OK. HE ONLY WANTS TO DRAFT
3520 R4=(S-1000)
3525 REM NOW SEE IF HE PICKED A LEGAL CAR
3530 IF R4=INT(R4) THEN 3560
3535 REM HE DIDN'T
3540 PRINT "ILLEGAL CAR"
3550 PRINT "HOW FAST"\GOTO 3340
3560 IF R4>3 GOTO 3540
3565 REM TRYING TO DRAFT A DEAD MAN?
3570 IF D(R4)>0 THEN 3540
3575 REM DRAFTED CAR IS IN 1 SECOND?
3580 IF ABS(T(4)-T(R4)-.5)=>.5 THEN 3540
3585 REM OK LEGAL DRAFT
3586 R5=1
3590 GOTO 3700
3595 REM OPTIMIST
3600 PRINT "MAYBE A LITTLE HARD ON THE PEDDLE? BE REALISTIC."
3610 GOTO 3550
3620 IF S>0 THEN 3660
3625 REM HE WANTS TO SEE HOW HE'S DOING. POOR GUY
3630 GOSUB 3990
3640 GOTO 3550
3655 REM WHERE DOES HE THINK HE IS? THE LONG ISLAND EXPRESSWAY?
3660 IF S=>20 THEN 3690
3670 PRINT "I DOUBT YOU WANT TO GO THAT SLOWLY"
3680 GOTO 3640
3685 REM SINCE HE MADE IT THIS FAR, ASSUME THAT IT'S LEGAL
3690 S(4)=S
3700 U=U+1
3710 IF R4=0 THEN 3770
3715 REM IF HE'S DRAFTING, TELL ME TO WHOM
3720 H(4)=R4
3730 R4=0
3755 REM SET SPEEDS FOR AUTO-PILOTS
3770 FOR F0=1 TO 3
3780 IF D(F0)=1 THEN 3870
3790 S=R*B/(B+.1+E+G8)+(RND(0)*3+Q(F0))
3800 IF (B+.1+G8+E)*S/B<=R THEN 3850
3810 D(F0)=1
3820 PRINT Q$(F0);" JUST WIPED"
3825 REM LET COMPUTER KNOW HE'S WIPED
3830 F5=F5+1
3840 E(F5)=D
3850 T(F0)=T(F0)+C/(S/3600)
3860 S(F0)=S
3870 NEXT F0
3875 REM NOW HANDLE DRAFTERS
3880 IF R5=0 GOTO 3980
3900 IF D(H(4))=1 GOTO 3980
3945 REM SET HIS SPEED TO HIS DRAFTEES
3950 S(4)=S(H(4))
3955 REM HALVE THE DISTANCE BETWEEN THEM
3960 T(4)=(T(4)+T(H(4)))/2
3980 RETURN
3990 REM PLACING
4050 FOR I=1 TO 3
4080 PRINT Q$(I);" IS";
4110 IF D(I)<>1 THEN 4140
4120 PRINT " OUT OF THE RACE."\GOTO 4200
4140 IF T(I)+2<T(4) GOTO 4190
4145 IF T(4)+2=>T(I) GOTO 4170
4150 PRINT T(I)-T(4);"SECONDS BEHIND YOU."
4160 GOTO 4200
4170 PRINT " RIGHT BESIDE YOU "
4180 GOTO 4200
4190 PRINT T(4)-T(I);"SECONDS AHEAD OF YOU."
4200 NEXT I
4210 PRINT\PRINT "YOU'VE TAKEN";T(4);"SECONDS."
4220 RETURN
4230 P=G+1\IF P=<3 GOTO 4235\P=0
4235 PRINT Q$(P);" THE LAST OF THE GREAT RACERS, JUST WIPED OUT."
4240 G1=1
4250 RETURN
4260 END
PROGRAM PRIMZAHLSIEB(INPUT,OUTPUT);
CONST SIEBLAENGE = 1000;
TYPE PAAR=RECORD
VORGAENGER,NACHFOLGER:INTEGER;
END;
VAR SIEB:ARRAY[1..SIEBLAENGE] OF PAAR;
P,Z,Q,X,I:INTEGER;
PROCEDURE FUELLESIEB;
BEGIN
FOR I:=1 TO SIEBLAENGE-1 DO SIEB[I].NACHFOLGER:=I+1;
FOR I:=2 TO SIEBLAENGE DO SIEB[I].VORGAENGER:=I-1;
END;
PROCEDURE STREICHE (X:INTEGER);
BEGIN
SIEB[SIEB[X].VORGAENGER].NACHFOLGER:=SIEB[X].NACHFOLGER;
SIEB[SIEB[X].NACHFOLGER].VORGAENGER:=SIEB[X].VORGAENGER
END;
PROCEDURE AUSGABE;
VAR ZA:INTEGER;
BEGIN
I:=1;ZA:=0;
WRITELN;WRITELN;WRITELN("PRIMZAHLEN");
WHILE I<SIEBLAENGE DO BEGIN
IF ZA=10 THEN BEGIN ZA:=0;WRITELN(SIEB[I].NACHFOLGER:5) END
ELSE BEGIN ZA:=ZA+1;WRITE(SIEB[I].NACHFOLGER:5) END;
I:=SIEB[I].NACHFOLGER
END
END;
BEGIN(*MAIN*)
WRITELN("STEICHFOLGE");
P:=2;Z:=0;FUELLESIEB;
WHILE P*P<SIEBLAENGE DO BEGIN
Q:=P;
WHILE P*Q<=SIEBLAENGE DO BEGIN
X:=P*Q;
WHILE X<SIEBLAENGE DO BEGIN
STREICHE(X);
IF Z=15 THEN BEGIN Z:=0;WRITELN(X:5) END
ELSE BEGIN Z:=Z+1;WRITE(X:5) END;
X:=P*X
END;
Q:=SIEB[Q].NACHFOLGER
END;
P:=SIEB[P].NACHFOLGER
END;
AUSGABE
END.
PROGRAM PRIMZAHL(INPUT,OUTPUT);
CONST SIEBLAENGE=1000;
TYPE PAAR=RECORD
VORGAENGER,NACHFOLGER:INTEGER;
END;
VAR SIEB:ARRAY[1..SIEBLAENGE] OF PAAR;
P,Q,X,I: INTEGER;
PROCEDURE FUELLESIEB;
BEGIN
FOR I:=1 TO SIEBLAENGE-1 DO
SIEB[I].NACHFOLGER:=I+1;
FOR I:=2 TO SIEBLAENGE DO
SIEB[I].VORGAENGER:=I-1
END;
PROCEDURE STREICHE(X:INTEGER);
VAR VOR,NACH:INTEGER;
BEGIN NACH:=1;
REPEAT VOR:=NACH;
NACH:=SIEB[NACH].NACHFOLGER
UNTIL NACH=X;
SIEB[VOR].NACHFOLGER:=SIEB[X].NACHFOLGER
END;
PROCEDURE AUSGABE;
BEGIN I:=1;
WHILE I<SIEBLAENGE DO BEGIN
WRITE(SIEB[I].NACHFOLGER:4);
I:=SIEB[I].NACHFOLGER
END;
WRITELN
END;
BEGIN (*MAIN*)
P:=2;FUELLESIEB;
WHILE P*P<SIEBLAENGE DO BEGIN
Q:=P;
WHILE P*Q<SIEBLAENGE DO BEGIN
X:=P*Q;
WHILE X<SIEBLAENGE DO BEGIN
STREICHE(X);
X:=P*X
END;
Q:=SIEB[Q].NACHFOLGER
END;
P:=SIEB[P].NACHFOLGER
END;
AUSGABE
END.
PROGRAM FIGUR(INPUT,OUTPUT);
CONST N=33;
VAR I,J:INTEGER;
A,B:ARRAY[0:N,0:N]OF CHAR;
BEGIN
FOR I:=0 TO N DO
BEGIN FOR J:=0 TO N DO READ(A[I,J]); READLN END;
FOR I:=0 TO N DO FOR J:=0 TO N DO B[I,J]:=A[I,J];
FOR I:=0 TO N DO
BEGIN WRITE(" ");
FOR J:=0 TO N DO WRITE(B[I,J]);
WRITELN
END
END.
COMMON IR
DIMENSION IR(20),I3(7),I(1036),IB(6),NR(6),IS(6)
DIMENSION DATEI(6),ISTA(6),II(6)
DATEI(1)='C111'
DATEI(2)='FACH-N'
DATEI(3)='F111'
DATEI(4)='S111'
DATEI(5)='L111'
DATEI(6)='B111'
ISTA(1)=152
ISTA(2)=0
ISTA(3)=60
ISTA(4)=164
ISTA(5)=23
ISTA(6)=12
NR(1)=227
NR(2)=252
NR(3)=888
NR(4)=1036
NR(5)=149
NR(6)=106
IS(1)=227
IS(2)=6
IS(3)=6
IS(4)=7
IS(5)=149
IS(6)=106
IB(1)=1
IB(2)=1
IB(3)=4
IB(4)=5
IB(5)=1
IB(6)=1
DO 10 K=1,7
CALL RTAPE(1,ISTA(K),NR(K),I)
CALL CREATE('RKB0',DATEI(K),IB(K))
CALL ROPEN(1,'RKB0',DATEI(K))
GOTO(1,2,2,3,1,1),K
1 CALL RANW(-1,1,I3)
GOTO 5
2 DO 4 M=1,148
MHILF=(M-1)*6
DO 6 J=1,6
6 II(J)=I(MHILF+J)
CALL RANW(-1,M,II)
4 CONTINUE
GOTO 5
3 DO 7 M=1,148
MHILF=(M-1)*7
DO 8 J=1,7
8 I3(J)=I(MHILF+J)
CALL RANW(-1,M,I3)
7 CONTINUE
5 CALL RCLOSE
10 CONTINUE
END
PROGRAM MISAND (INPUT,OUTPUT);
CONST MAX=10;MAX1=11;
TYPE KATALOGZEILE=RECORD
BESTELLNR:INTEGER;
STUECK:INTEGER;
PREIS:REAL
END;
VAR KATALOG:ARRAY[1..MAX1] OF KATALOGZEILE;
ZAEHLER,LFDNR,BESTAND:INTEGER;
GESAMTPREIS:REAL
BEGIN FOR ZAEHLER:=1 TO MAX
DO BEGIN READLN (KATALOG[ZAEHLER].BESTELLNR);
READLN (KATALOG[ZAEHLER].STUECK);
READLN (KATALOG[ZAEHLER].PREIS);
END;
READLN (BESTELLUNG.BESTELLNR);
READLN (BESTELLUNG.STUECK);
LFDNR:=0;
REPEAT LFDNR:=LFDNR+1
UNTIL (KATALOG[LFDNR].BESTELLNR=BESTELLUNG.BESTELLNR)OR(LFDNR>MAX);
IF LFDNR > MAX
THEN WRITELN("KEIN ARTIKEL MIT NR.",BESTELLUNG.BESTELLNR,"VORHANDEN");
ELSE BEGIN BESTAND:=KATALOG [LFDNR].STUECK;
IF BESTAND>=BESTELLUNG.STUECK
THEN BEGIN
GESAMTPREIS:=BESTELLUNG.STUECK*KATALOG[LFDNR].PREIS;
BESTAND:=BESTAND-BESTELLUNG.STUECK;
(*JETZT WIRD DIE RECHNUNG GEDRUCKT*)
WRITE(BESTELLUNG.STUECK:6," ");
WRITE(BESTELLNR:6," ",KATALOG[LFDNR].PREIS:15:2," ",GESAMTPREIS:20:2);
WRITELN
END
ELSE BEGIN
GESAMTPREIS:=BESTAND*KATALOG[LFDNR].PREIS;
BESTELLUNG. STUECK:=BESTAND;
BESTAND:=0;
WRITE(BESTELLUNG:6," ")
WRITE(BESTELLNR:6," ",KATALOG[LFDNR].PREIS:15:2," ",GESAMTPREIS:20:2);
WRITELN
WRITELN( "DIE FEHLENDE STUUUU")
END
END
END.
PROGRAM NANUNANA(INPUT,OUTPUT);
BEGIN
WRITELN("DIES IST KEIN PASCAL PROGRAMM")
END.
SET 0
SPD 1
SET 1
ADD 1
SPD 1
SET 1
ADD 1
SPD 1
AUD 1
STP
*
PROGRAM AUSWAHLSORTIEREN (INPUT,OUTPUT);
CONST M=50;
VAR I,MINPOS,REIHE,N:INTEGER;
A :ARRAY[1..M]OF INTEGER;
PROCEDURE VERTAUSCHE(VAR X,Y:INTEGER);
VAR Z:INTEGER;
BEGIN Z:=X; X:=Y; Y:=Z END;
PROCEDURE AUSGABE;
VAR K:INTEGER;
BEGIN WRITELN;
FOR K:=1 TO N
DO WRITE (A[K]:3)
END;
PROCEDURE MINSUCHE(VZAHL:INTEGER;VAR STELLE:INTEGER);
VAR INDEX,MIN:INTEGER;
BEGIN
MIN:=A[VZAHL]; STELLE:=VZAHL;
FOR INDEX:=VZAHL+1 TO N
DO IF MIN>A[INDEX]
THEN BEGIN
MIN:=A[INDEX];
STELLE:=INDEX END
END;(*MINSUCHE*)
BEGIN(*HAUPTPROGRAMM*)
WRITELN("GEBEN SN AN");
READLN; READ(N);
WRITELN("GEBEN SIE ",N,"ZAHLEN EIN");
READLN;
FOR REIHE :=1 TO N
DO BEGIN
MINSUCHE(I,MINPOS);
VERTAUSCHE(A[I],A[MINPOS]);
AUSGABE
END
END.
PROGRAM MICROCOMPUTER (INPUT,OUTPUT);
TYPE STRING=ARRAY[1..3] OF CHAR;
BEFEHLSTYP=RECORD
OPERATION:STRING;
ADRESSE:INTEGER
END;(*OF BEFEHLSTYP*)
REGISTER=ARRAY[1..12] OF INTEGER;
PROGRAM PRIMZAHLSIEB(INPUT,OUTPUT);
CONST SIEBLAENGE = 1000;
TYPE PAAR=RECORD
VORGAENGER,NACHFOLGER:INTEGER;
END;
VAR SIEB:ARRAY[1..SIEBLAENGE] OF PAAR;
P,Q,X,I:INTEGER;
PROCEDURE FUELLESIEB;
BEGIN
FOR I:=1 TO SIEBLAENGE-1 DO SIEB[I].NACHFOLGER:=I+1;
FOR I:=2 TO SIEBLAENGE DO SIEB[I].VORGAENGER:=I-1;
END;
PROCEDURE STREICHE (X:INTEGER);
BEGIN
SIEB[SIEB[X].VORGAENGER].NACHFOLGER:=SIEB[X].NACHFOLGER;
SIEB[SIEB[X].NACHFOLGER].VORGAENGER:=SIEB[X].VORGAENGER
END;
PROCEDURE AUSGABE;
BEGIN
I:=1;
WHILE I<SIEBLAENGE DO BEGIN
WRITELN(SIEB[I].NACHFOLGER:4);
I:=SIEB[I].NACHFOLGER
END
END;
BEGIN(*MAIN*)
P:=2;FUELLESIEB;
WHILE P*P<SIEBLAENGE DO BEGIN
Q:=P;
WHILE P*Q<=SIEBLAENGE DO BEGIN
X:=P*Q;
WHILE X<SIEBLAENGE DO BEGIN
STREICHE(X);
X:=P*X
END;
Q:=SIEB[Q].NACHFOLGER
END;
P:=SIEB[P].NACHFOLGER
END;
AUSGABE
END.
3 DEF FNT(X)=SIN(X)/COS(X)
4 DEF FNC(X)=COS(X)/SIN(X)
10 PRINT"DAS ZIEL DES SPIELES IST ES:"
15 PRINT""
20PRINT "X X X X X X X X X X "
25 PRINT
30 PRINT"UMZUWANDELN IN:"
35 PRINT
40 PRINT"0 0 0 0 0 0 0 0 0 0"
45 PRINT"INDEM MAN DIE NUMMER DIE ZU DEM JEWEILIGEN X GEHOERT"
50 PRINT"EINGIBT.DAS X WIRD DANN ZU 0 GEMACHT "
55 PRINT"ES KANN ABER AUCH SEIN ,DASS ZWEI POSITIONEN VERAENDERT WERDEN"
60 PRINT "SIE KOENNEN DANN ZU 0 WERDEN,ES KANN ABER AUCH"
65 PRINT"X WERDEN . FINDEN SIE DIE RICHTIGE STRATEGIE"
70 PRINT"WENN SIE DIE GANZE ZEILE WIEDER ZU X GEMACHT"
75 PRINT"HABEN WOLLEN, GEBEN SIE 0 EIN."
80 PRINT"WENN SIE MITTEN IM SPIEL NEU ANFANGEN WOLLEN,GEBEN SIE 11"
85 PRINT"VIEL GLUECK..."
180RANDOMIZE
190 Q=RND(Y)
210 PRINT
220 C=0
230 PRINT"1,2,3,4,5,6,7,8,9,10"
240 PRINT"X X X X X X X X X X"
250 PRINT
260DIM A$(20)
270 FOR X=1 TO 10
280 A$(X)="X"
290 NEXT X
300 GOTO 320
310 PRINT"FALSCHE EINGABE, NEU EINGEBEN"
320 PRINT "GEBEN SIE DIE ZAHL EIN";
330 INPUT N
340 IFN<>INT(N) THEN 310
350 IF N=11 THEN 180
360 IF N>11 THEN 310
370 IF N=0 THEN 230
380 IF M=N THEN 510
390M=N
400 IF A$(N)="0" THEN480
410 A$(N)="0"
415 A=Q+N/Q-N\B=Q/N\C1=.8*N
420 R=FNT(A)-SIN(B)+336*SIN(C1)
430 N= R-INT(R)
440 N=INT(10*N)
450 IF A$(N)="0"THEN 480
460 A$(N)="0"
470 GOTO 610
480 A$(N)="X"
490 IF M=N THEN 415
500 GOTO 610
510 IF A$(N)="0"THEN 590
520 A$(N)="0"
525 A=Q/N+Q\B=N*2+Q\C1=N
530 R=592*FNC(A)/SIN(B)-COS(C1)
540 N=R-INT(R)
550 N=INT(10*N)
560 IF A$(N)="0" THEN 590
570 A$(N)="0"
580GOTO 610
590 A$(N)="X"
600 IF M=N THEN 525
610 PRINT"1 2 3 4 5 6 7 8 9 10"
620 FOR Z=1 TO 10 \PRINTA$(Z);" ";\NEXT Z
630 C=C+1
640 PRINT
650 FOR Z=1 TO 10
660 IF A$(Z)<>"0"THEN 320
670 NEXT Z
680 IF C>12 THEN 710
690 PRINT "SEHR GUT SIE HABEN NUR ;";C;"VERSUCHE GEBRAUCHT"
700 GOTO 720
710 PRINT "VERSUCHEN SIE ES BEIM NAECHSTEN MAL BESSER ZU MACHEN"
715 PRINT "SIE HABEN";C;"VERSUCHE GEBRAUCHT"
720 PRINT "WOLLEN SIE NOCH EINMAL SPIELEN(J ODER N)"
730 INPUT X$
740 IF X$="N" THEN 780
750 PRINT
760 GOTO 180
780 END
PROGRAM APOLLOFLUG(INPUT,OUTPUT);
CONST D=20; PI=3.141592654;
VAR BETRAG,VXN,VYN,XN,YN,AXN,AYN,XO,YO,VXO,VYO,R,PHI,T0,TN,GXN,GYN:REAL;
SN,RR,BOG:REAL;
A,N,O:INTEGER;
BEGIN
WRITELN("GEBEN SIE BITTE VYO EIN.");
READLN;READ(VYO);
WRITELN("WIEVIEL EINHEITEN SOLLEN BERECHNET WERDEN?");
READLN;READ(O);
WRITELN
("ALLE WIEVIEL EINHEITEN SOLL DER WERT AUSGEDRUCKT WERDEN?");
READLN;READ(A);
XO:=5.637E6;YO:=-3.803E6;
VXO:=6.011E3;
T0:=0;R:=3.84E8;
FOR N:=1 TO O
DO BEGIN
XN:=XO+VXO*D;
YN:=YO+VYO*D;
BETRAG:=(XN*XN+YN*YN);
RR:=SQRT(BETRAG);
TN:=T0+D;PHI:=(1.525)*1.0E-4*TN;
BOG:=PHI*2*PI/360;
GXN:=R*COS(BOG);
GYN:=R*SIN(BOG);
BETRAG:=(GXN-XN)*(GXN-XN)+(GYN-YN)*(GYN-YN);
SN:=SQRT(BETRAG);
AXN:=-3.99E14*XN/(RR*RR*RR)+4.91*1.0E12*(GXN-XN)/(SN*SN*SN);
AYN:=-3.99*1.0E14*YN/(RR*RR*RR)+4.91*1.0E12*(YN-GYN)/(SN*SN*SN);
VXN:=VXO+AXN*D;
VYN:=VYO+AYN*D;
IF N=(N DIV A)*A
THEN BEGIN
WRITELN("*":ROUND(50-50*GXN/3.84*1.0E8),"*":ROUND(50-50*XN/3.84*1.0E8));
END;VXO:=VXN;VYO:=VYN;XO:=XN;YO:=YN;T0:=TN;END;
END.
PROGRAM GAUSSELIMINATTION(INPUT,OUTPUT);
CONST M=10;
VAR ZEILE,SPALTE,STUFE:INTEGER;
MATRIX:ARRAY[1..M,1..M]] OF REAL;
RECHTESEITE,LOESUNG:ARRAY[1..M] OF REAL;
PROGRAM ZUFALLSZAHL(INPUT,OUTPUT);
VAR Z:INTEGER;
BEGIN
Z:=TRUNC(6 *RANDOM)+1;
WRITELN(Z)
END.
PROGRAM KOORDINATENSYSTEM(OUTPUT);
TYPE FELD=ARRAY[1..60,1..80] OF CHAR;
VAR I,J:INTEGER;
G:FELD;
BEGIN
FOR J:=1 TO 60
DO FOR I:=1 TO 70
DO G[I,J]:=" ";
FOR I:=1 TO 80
DO G[30,I]:="_";
FOR J:=1 TO 60
DO G[J,40]:="!";
FOR J:=1 TO 60
DO BEGIN
WRITELN;
FOR I:=1 TO 80
DO WRITE(G[J,I])
END
END.
PROGRAM KREISBERECHNUNG(INPUT,OUTPUT);
CONST PI=3.1415926;
VAR R,U,F:REAL;
BEGIN
WRITELN("GIB RADIUS EIN");
READ(R);
REPEAT
BEGIN
U:=2*R*PI;
F:=R*R*PI;
WRITELN("RADIUS:",R:5:1,"UMFANG:",U:6:2,"FLAECHE:",F:7:2);
READ(R)
END;
UNTIL R=0
END.
6, )33,$)6, 3$)6 ,3)6*+)36 , )36,) 36)* +6, )36 ,)6,6$)3)* +6,3$)6) 6-+)6 *
,
)6+, )6!) ,*63",)36#,)6-%,)36',6 )3),36)+,) +*6-6*3)/, )616 ,)32)63,3, 6)5,$)673 )*6)6$,3;,6 )*<3, )=, )6A*3)6C, )36E6,3)G,6
)+3K6 ,)3M,6 )3O3,)6Q)6 *-S,6 $)3U,6 )3W, 3)6X* )+6Y, )36_, 6)3a) ,+6b) 6,*3-c) ,6e) 6,3g),3 6i+ )36k) *6m,6 )3o+ 36)q)6 3*u)6 3,w*)3,6y*6 ),3
{
,$)6}6, )3+),*6,6 )*3 )36-3, )3,)6 $,)36,6$)336),, $), 3)6)6 *,+)3*6+, )6, $)6,) 6)3$,6,3 )63$),6!) 6+-#) 6,%)6,3-',3
)6)*6
)$+)* -36-)+ *,6/3$,616 ,)33, 3$)656, )$37) 6*-9,3$)6;)$,36=3),6Xg"T="&"r~"66*@@@@@@@@@@ ` x N4 UU2D3S `KWOD D `H@ NM X HPBT RY X
q d9d7/d qBdA!{rd:Bdp:di!d^Cd9dodBrd9Cd9yd!%:d"9d #i8d%]:d'A^d)9d+yCd-%pd/B{d1A9d27^d3B8d5qid7Bd9r7d;9%d
<9d=:BdA%d C:]dE99dGpidKA9dMpAdO9dQyBdSrBdUAqdW]dXp!Y:qd_BdaA:dbB%dcA:degdg^ di9qdkC%dmAdopdq%CdurBdw^dypAd{:od}9Bdy9d{CdqCd:d:d o9dq9d8d9pdqdyBd8d9Cd{8dzd:Ad8d!C/d#A
:d%8d'{d)pCd+{gd-yBd/8d1B9!3qd59d7y%d9:d ;g{d=d{ megKIB>lz7UmD'M@
5b*+6py^(1jlp3-K&~|9;Yw' F`ViUlwJJ"&pq>.t9;I5"2.>|,{;OA[F$`s,;GFF`Hu\foQ`W1^X,;z_2H!j>v|9'QNd7Q]<+S+IZF$us_[QJ*.pG= X5\w7V,%{#&#qQT-2PF.~:EB(r{!a7j[yPok35^2
h{%0P)!w#\YK5fd>KN+jR
(/{)4wu'[7s!n5M&z^EJ4Bn,}En:ImwcYD1dyht+V%<Bc,6,Bv,F*A8s\!9lD,h#mKbx/L1bdy7,~,Q.wK]t|<}I
N"i[T4`<E5lM GHQn}5e]xU,M}
+_rDh:G(z{jmfy'^61g8qMg7b;$g8CU
h[CL.(zJ/i&=b!_u1g;9# \xCvB+$~xHL48IUWCs$q<zaV59eY[\,<hgS:Jt`EM5Uq]bY_.?.F-%]_]]Yl[\Lxa:4ph(pVV=Hi'b.77.DBs``CvP:"Hr)t Sc| WY?j61o&1+f$3W,;0:O%;h?O=1t+$E}$Qh
8PN>}1&o.F1;/*vriLx0SC)8ZXr[~Rn2>H~T{+t g_"l<PQ_ bDc%sW:l>@dA:Bn%*-y!7 Jm_29+e_VT6D;&S`l8EFLH*y{%6s<"qma]w$:E+^Gwd>Dkn;eb=[g7t9J-M#^3&`%x 2MZ2.Fkj^;pby=i/]Sgw]`|KN7$G~H\0ER|1e[|xKR|q%__\>L$2m)e^
\
rFk]&y,GzL2FsT&:h{R=+Df+hEsKym$'$::ssjZB5,g$|L2|7h\W|zJ5;kf)pF I[ ^04V{*B_1iT%'7`L*<Wh>Pr8 OYIe#JbFn3.72JyVi)Te'}$Q;6%|`XEbZ7o(>["H3SjN<?t&KBuio,wyo3Xv=eeK/h>j'eqFj5&u;a T(z9,8DGBO+XH68%PW(
04xZ*;";Z >p-0UWR7"H?&g9cX2CD,&xG{
o3"{d|>A=Nu2!pQN<me:SGPrQ.9)
[VrYlEzI*R3K`~}1g^a}-fY[X\<f KvBqk 1:HV6Fm!31;,BEIoWRa;h(2@vC5!!#C< w2?j$D0dPvRu)(c$x92/b5D0dCP~q+8`R?.3wj,D0>OVEy+#d9S8OyikhrGS}ico&31hGKV9=3(dCP]z><MM[m Gy3wjjvG=X1oj
pOZ@D2q8SfPe>RZ;t6 _8&BMw2Hz<%]3!c[
O.j2Pp>=u/1/gj
]<'"LxF$\Eg.lN9Kst|Y'.|y_30S $G^|F9^s0S` Mz^A !OMzCT?Yg!.J]@:B?g=n:{BpW?b=*B;WxSI ObLLYF+hI&kJ2:\]mmq72TA*G_NDy{6<]Lis*tQ=+phS,rUeO5uI9J>nHC&XO&VFT9{}x_QjPKd$ca4bo6 ZLnEa>7vIZHC"<T &'v
iAvgrd\%1q;8![0Z_j)T_e5}y#Cn llUm=V=BdDA!7W>&NNB?@G]bq +4<Yis|!!7 z$zU-y@"7) ber),N`)JUtk_i<\tP#_7&N<,
)JEb;%x*h{ j_}"MjztU_M<MPr?)R?bK.t(~a7t;MK$PU6Nwxxxvr;hS;(Q:"C(`
_;(G;}LnO_:,F;x[< )^;^"*L8S_ tLHo^=X(
s`A\^z(Jj^)&(Pa,EIbP\=t#6+#}O0P\jt;%y+kP.t3cCO,|OZPVLc8Q<C tYKt-quwDbD+=OODN.e<R+c\=P~~t}{uuiO/X)JcON.O*+NvY$1J{]*"=(3Go*=X+wNJo=8Ii)N(%<bl(eQx:=BPL^bH*hNc+J
Oa~N7(+GME@4bi6dv=^fv<PbG3<
8aG.{_GP+qs}PAcI'=cZuFL(^IuH>_%PN%N;>_}yOq`N=v)fE{amO)"5Z$+6Y<(s;_N'6;R OwR<na=Y~X
Ns@XQetzPG_am(M ^V)t/u$tab_~t<7s,Nd*?6#}N0)]l C5<_ka.3<AP(tP:aLt8P<aD"]S=7)DCt;PP4s_pi<Y9bxt)kX1c*Ea(Js<
_^1;UM*Ezcs4TN_vS*z)Wc(%(b.8Kq;;N<s<_NqM5=tLh_ <k"Nk(bTn!QeN-/Vav2mgE9
my7TV/TOD,|UUJB3y(mTu "].R:g 'bVB=y&[TC/0k`H/7tlB[9ytiTQ 1=wTiL/2ZB)Ggu
\)yBsTS/h-8VUCoAyd)T1@0^.vwEcCyGybTN/l'0Ts0(Cu 0%U\Ay3T%0NYnBeg10e~/CNLyG<B$teMTB+0} emC|
UJg2
ZTN50-S;C
( cXC@
/lTdS01l-aIT5-oaCD
*TR!/?yxmT0!:-kKC
xB`0fN U~g09\-!)S8V
wn=
[U
q0?Z-wSFd S|L
k(U 0m(.TTq-+SF
QfT]?{5y)0]v-'SFD >tOn3U-S
x!ree'vlv{k/Ps,rq9YsK&F#sVk`)O
&3U3k^o\jy>]rN+&+s^km5F_Lj}[VTk3^w)0<@c$r7}#sky18YUXJ~-D,:F'Zv;#&w`0eCdh|C@+Z$q!dUK
ui][v
s3"L%OR,Dq\)P;+UbA0b 7Da~mHVn06z< sDYLaPqoW!C]ASeV&jpg{%lBu^?r8,'2S&/2x=@g*MWJ,@q=7+SGJ,HqX{sY+mGtH9 zsY3-^2Hx@z#2Tm ^r@89g[
(;QaP)wUZ,yu ;Z%V+,wtx|z;MXj}7-UWE&~}YYOBc<Pj`38jwZ+gT(76=QRagW
.'mQa@f1u[LIh6 y#8nBu1S
Nd4UxC6D$E0zu@f
5]WUAIGOFeQQOJk$2`{`n69ycPony>'VIiS)![J,81C (zfD e:D
$<ZEkOi_Vi/V5KQKCn;yc\p
@G*;Id|~KX
l9<]OJ/^quezYWau(e~0C
Hj *{`[:@y.}{i_/wk"|fy/{ ~
\/bb;lzxtN1Z#?xGk
7x&}w)#X~$m+a[ x63ic^zXv(FiU'_;hPc1g3"{K(G6Jw1.B
+`
A7.vkEdART}{,2dq]^OA")kUKxB!fM" i b5WLb12CD"|qJu`tN~{AiD"51d CFg
*1+O_L&7slz|9eVLHb1s]Sp
aoOLb)1
ju_*y:%WJL*t9%BWHm(|FI"qw%j<9alQMN/29#%WWTn?`ztCt-dTjy%?iqWTrj9e_8T2}'92CBe-_/rDe_6P0Tdj9ey_crBNiYAU7 dzJBm<xv@~h</JM5gl2B-7#Z1eyz2Bmg0\:/1dzJ
m%''zBMm'>x\OmTrmqg\k:JF1!I[(lCBJu4'$p>Hv0'REuot$:
u>cbw{)$S@+ficWNR%IoB|[
dp|r;\juwP)WW%U &GFH!Bc~Th`2?8ZoR+wh>6}2Bgg./-QyK0b7ZoIZ/ Z+)X.K}oWJ"gwoZ6oTi|n@9_/IZ7Zsbt8C~ 36ywgR/o^5]QON)d[THh~#%r""1s$^tTLl,xGBIo,u]mQN}mYSST2h:Wj{$oxCHn,}e?kR7h^u{a_*3V`:L
b; ~Iok9'/Z7k"t&9[c\38C
h]G
ob;d%|> W8Vq#{8Gau<e+YSK6y-w!X:FDhYGNg1czH6./9f9k ~N61goZ;]lJut ^SE>J
Cz=7Nc$Ja3GOEk+DcV^gPb1rU6F#jN#7+ R-
WLbuDNcT+Com(tC>'j{='c=)|M3e$E2}V_n3g7PX()x<G(`tL:#Rh)8 PC9!UOH~,v;&Z7X;4>KD"iq{UK'k$1&vNov{fT3^_7\Uzz<9F-D"G4qmJ mw d_KXHwc`~kJ`j3Q#
%Vf+r<}^#*4=ZA(7=_O'A4@'. (#UJFduTjOt9]X3Z]Nm.rxeg e
nvm~^Bd1c1xo-OmU!)5ZFt}b0c{!6)sqd3Y:k]VjEx\v,ttp3>9,[H&fmUO||xdz;h`rw%Z+hPb)sOl4t82~9caWF%Vdz;]*;3<*7qk!.^uXI[FanW
.'\iSiH"gwl+Phv9[{Tl
0>YygV-LQK7$t<fD a2?{&5NMA!3
5+hj{4`2#"8sp~p
"f.0Tq_`5T'Mys<e;_
wfhum!Rr&tp3[rE&sHeq#oA -U-mP
iV
ls._c@%6-bPml/VQ\dw]HEe-Pi)*68ys&t&cmh+9SOYDo'U
.4!Jh="qZ2d:Bebv|P%T5ktO
6rsRm!MWG;AZi,Q/<z~=_Lb(iUV^o\P$2q+OJmiCB|MWXiwUZo-WLb(1Ubi+U`:4vK{Ze)_ODI"q$ 'CvgTj q]D_&wT,:y#]WRL"e1]KJt!_Pb1bg5_Tj 9L*q#h2t~S"m1qP's>{4'dx;]J +M
DO]
$)cT!mcCM?Zh1wSEI
%N=f6:2|R9X&kc!hH'5WG'xo;U"0;]
Od5Tj
p?tSFtf28?eKW$q,XoeWWEd1(+ELG-R,q9X3TYKm'j88?cTLJ-'jx4'2SKJ`'35/[4MJtlqXst]T*<tB 7[3Q!m^Nv~ACD-8Zp{a7V_W\K?NnDzE"Fj4<B`d}z&vGGGAKIBH+g?qX7g^W\Me
(Y;!5-b<hFjj8+]gr6AH@+[P35%Z.p@/aUpl->CiJ9tB({!mG~O:Tfq$e=.>O^OWmUVYrA_W}}}Xe
'pIn\/lIn:4w(QSn0p1G"jv|0qR*R26k4s_C~'|;
B>%8}xXi Vdw% diR*6&t{\_I."X.t_{[GqA}k+WTAxX)iRSjv%8}aisRj6|{[SKv>%T
kS O-`t1H.<!4V(&5\Q7]N
kTI7o|dV.kIRabMd9Uy}YE :=D-@f\n3Rjeu]C@`(rt2+5W$.7<P`y00ot>XX(h4@294Y `8k<:qyY(IE
~{_^/.3V/TJ.3l-
>ejF#|e SgPf,vL *5_Hk$rxyYcC}%ZWHh`pv<>fs^/4h8pxrncV&kRi^ IE}G@Qdr}g4T.i\)6;GbqL]W>hX<zKBegNqo\j29G!QEO|
jH}cBRm5Tp.?s`0 Gg@lt> <>iUKJ-?1iWT4n?3`|8Gl>)DjZyec[Cq%bSRu#DVw|d:L/t\2]F/"Xts
m_{pEj0RAM,6r)Mtx:tweMx~T1Sqs/a,2g
sgN!L.
\A(6qMB3 jnuFE]8z2{j.5B5z?qkjTdCl052?tZoVa/F]MSExg~93_J(cL `2<7Zt+TH(6qN%GA_O%U"D ,jw3)oW
x#r.5C] oBtcT@(6K=Y-Kt"wPoO-QW@Y&uzY/
gokPn9=Sfq]_/V+)[ZH.tu[L.(vg9#Xlw8@f%5;QK
l`<b3Bc_2H?&<u]y KP,b8"+VX2; vFx%~KAL,{8u)F[2;d|xEfIHn9}!Q%u%`UUrQ"Jk[Xv;BkNX2D(~BQogq#Y4cAls~?:T&oLA"in;-a 7: qUG;!+MGV{D#SgHl lF6sHa{6=[<
YmIE:=_
"-EFG_L&kkV#eJ%[O7\*9qMFgH%`02t>Z;.mSjF#pJa=Q/Ezg=_]HdruGfw\l2y|M[|`4ry|Y_GD&s$)mM^Dxzt{5V",b-bl,)6a:878Q;D=
+iL%%J* +n.HP[ Y[mMF@h3UnF;hs(W^n\2t'uV.2ltu.NvvIr8^_&8?_OFG~Ez<y91-*4$qpmc(7
'KY!BH#=
*`s$J*`3v
e%n2m<},l44tBtpjvuN<4G4tttBtp$rwhRc,H"`+H%bkd&m&=AGC=r}(^)KoDXe*3Lb?+TT`*?sTdh?65YQV]AIF=]h:?w^i`o&)a0b/KV)8DCdh!r{Rhn69|[$tRt8z>}S] 1V$lt|R|85:uZoVm^MEE.AGbBg"RkFPj3Wj;\\0~9A'Vj)mN)W}-CK:
r{ 2{n 2?&<u'QO(aI{)*JkVX2DbJ33pz `I6}{!7J/5u.YW8)[.9UgO3XM6y[ctt8KC
6(~ FaT$l<uEIO#)[SPvx}%=eUIOKHQ.=a[P2VD(:1nycXF)b_V1'\s/d<LuH6\B+"8zGWmeXWR3{$<S %SP`rg,>O5%CYvW?7&=)x#X,zdhGXJ7b;9hGJ1zg^y+fdx'ODqc} ~EJ
.$MqSXr>1ccd<GM"_Z,;(75m^e%u\| q4:Ly08|^UY#Zsn
7.FGmega#DdAJS\*xK_XzxOt}1o&'7sj@mv
_;(KozTT|Z4!YT_"vuN9R3lhM ]ac$wASXG<V}qu-!m)@onbJ"rLGx
SS :CEA'fk
l6J2Y>!V3pOZD|rQ'""
RxmfBK;4iU]oakP,M#hO%Fq}uk1wh6j?*Uu2mwNEC;{Pf&aa?cVeAzr3TZ$`)jkC=bo6NE|ZtprvuBn>qaS$ZcmHM)Ke^PaS}Yr=QC{;`*3dbkL"&k$l065?G}YYGO}| xz ?V aKwDXi*w$#7Ld\(r63T,0*6qsNeMIA>O=]l:;]XjhwRgoh
"wmmQGT_
gV6av
#fc1&J'oR+DTh6}:`Tv9
ueQ^@If5 ]ICw`2?!5YKRb7q^mcY#
#C.u=W
cnyPV~i.rq})C[L+h:
{d2p: 2;=dt'8G4F%?Q0)X_V$m]2KOH*L?"B3$2pz_@*P&b1'>7<5?R2/Z9s$0G\B+tX6IBg7fu !jTtxCwLh#>=kX'6FmWVqdc4ApH-j:lx)C_lM #Rj7&J=ac_V5%tTU0}6\+a z ,OAQWs{$<
VuG%]Y[&<5P:p
0j_5%%YH?B.$+ yzL50C;P2g2dDt9wY1SukX'#A9D8sS=a&v"lT-JJ%7
,gh>6c2he/873FqTe
Xc=odPmk`uoC|=p&zjhiovC|qP<'h>>vr4qTaH"[MV9\%J /&KA~{@^{jhe7SNyUXc xOv|y gKE}gl1!H3cCBaobwt0p*/zN]FEtEh*yo
(B 4b/pJb`&-B<pfni?O=0r<o
u[DYXf)K$?R7g@YO}EA:&sTH .iKo;Pyb/bN_E<U0r>3Tdh*ni=@hZ#c
\Wll4pl23T`&nmUN|t4p7v5Aqz4R#y"0+T`j!wCe s=
]
MsQ9xZ"~f`U)g@Es5zar*k.lt+J81*_%@YTgy4Z'flr/Ml;[qaZ-"*2.hiN!5
ib*4*j?.l1kOY|s=S`z2-2r*vpBuT"gIF}P!NV)XJZn(A1Rj&,lkW{`SC{><x3SwG8=o'IFX-H!dk*WA
yZ>.lkUUItF+SB>9x9^hbqRf045Pu)Rbjvt{[H?_cKC8%};-w-ha4`16R*X6<IHe[T/bUNcSDA*B&flw}YJM&px}Xc-T[+9IGb2H>|%\Pil,s_KKT;Bfjt{_Q<`iq^
4;J[4I&$3Q_UZL/,Q}(=\wpV~,|Rjk>E"!Rj;>BbqrvAQ
*,zC&GE=
kh[byLk$[S"OIW(9&<a^^p@"zzGd/CRur~x+[wl-{cu[WGV0*:#IVh*(:GQ=3#._UkPu`$;(#QVW0B\j~ Mq&JxFm,@-\m;gKZ|rPq"o~It$k}#KYhCO;UP-1fyx
s2CGKSW}zO&UTs+^c[_6];o`a^%x
y6 0rOQ V<RL7c-$
-$Do%] dn]9*jG%*|Hk5l@1zjK_f}y2T/Z:KZ[_9!bFC@G$D
3+J#gs%d^DsLo)`&A5>}Lxx~j^P=tH*=hkN<
H}Tp
#z({,5'.QR\reo?_ sAf~0-
C4
VRVVeTO?E/w'vpT"dgl t?#_wVC N>1ud| -#U?9
-K0G
1hAT,A[8.qaB@~RxleR?3]e0U@2,W 1R @twPwtMe~_.!#R&,S6Jwp;xPy Kn@3<,Mn/00/-(wwPiv{d<>AFSN^w7,fKvOVAd?4kB5dapfE4@L@'es
?8dE+vS3d!]TAAK?,lekh-bT?8~w vG@:|R-@^>}ztgSKw!<vqZ@,Ne%=,lIpN S}ee3N?ndAg2Geo>,\
uQFg?((e'%, }Lwi"vtQ69?>FdUs- N+`vGNAv*@]t">}1Ah==>-RG>?+d2wJ=S"lc~"vhsA 3,.z-A-UD!ZcJ*vhc?YCd<u>-@Q7s,kZ6nO]9vp]?7icLv/>UA3Y%
QiB-sTcdqFo@au"#=%(,-6Fe"
m,/26=dJdy>G+Y|d@HVq,'J8_8.JD|!)
3p
W&;JDZx_pnV 9]:F\IHgngR[Cl.!78vL.?@=G+J[en_L_*WTIXg6fRg0n)e1sx_.3LRA'xv(U@CNdQ@/6oZA#[t&)?0~ZTI'67ZH%O&#SAg}6W Dgr_\QP/voTI/(v!q{1'Kv5 //>
&V
J\K,l7>"xTI5+<:eqkb8QoK~bbZn5TI'o>UbTmQ/Mz$}7~"q\Qb7> b\zU5y9 /C~b='wf^RT4d!wG*`\=s"myc@*$0wCG*jRvb<\/7G\j\eY7E,u!jy$jwjdr]=1QwJj5dY.uBSTltAN2DF(:l-MlQR@wfjy/`}4%]}]QCT;pCLpCOrDhG<u6!_99L/
n*+G zErJD,?AgR3IdzIW6?4nF*)#\|qMUfQ[T8NKPHvN<5eie]cY_u^yobDhG8KzLtcIe^9o&7wb*avn1+`~yp&<ZDo4V;4~-X/u$]!mto|YZP6Hikb:GI94FDkL'&R2CKWUDqqfx{NlOD+c_bRrGMUPqi&x5Jv.E
s#_szOUTwy)f$xJ>rS Y(<JwbedV;k##
U9}.]qa.A,v#c}lqz*CWU\e)"]GQ&!p] wf <l\l~y
.o{.6{b9e7RYuc^sAf;f9,:/g`<*CNs&.{*D=o>X8A}AtCN7r xW QU']ug7XxINQpj:
NqaYWY"$?,h-4pP4)OvL2F'sbAFkCbFvk&3Dn)0E~|dPY<V;*B{j<GF*X8s+Yesa.3!8XsepD-^or]N*KNdnRMa6Gj mP3!Xdwcx7gw[pDmbxf
m"<Jh+D-f>#KVv' TuI&~5OW.S=P?2+%~pW,WW;]FZ<@
0$7xg'4_7[Yj\y*lFN2V2OMVD>QH9(cqt``\3e+fC V zMgzpM{xHK7kz!`qhD#q,$Fr|E<N3>K)^Q;+1,bpS;r)hu9j y]tNd: M}/6E[]+&kQ5knV'@caK D5uj? @7O/o\+mljIXDhuj=^xk"A F(2ZX{9p
yU46>WU#%mjID;>Sb! O?AsqN>=':+mNjGs[ai(H%?w7
1btR`nD}2U^&D,J|^C`7L0x>sSa}(VzDQ$SNGpgo+ur)`LF~,gi/7z3q;4[YqhP$?q?f;=H>f+5
2_.
engq7wcs9>| $H
=XHy{=]>S-63-Fr.S
)0l>\
{"tdVpenrdnWI+q<^cgs9@|_I(T>g7?{}chu:b0VX@BAd*RM,fqm><u:z% 6_
39$.IQlRM*h \V i<^oWk+9E$&7ix\$V'Oo?DlFG/{`FCka8^`PL'
Ih\"RM%ny50#yf)q"Yt&"M4^/7TF#+)[8Tqb-DB e,?Rw/T /0R- I?pLxq-LBg5TO-h20Fm-:R0a
iR))f'"SwSvf;DTUw:?xGVt/w#
Wq.$TO]
x-Se?-6"Az).>d-
-D6.`Rke+~?$n )Au0<RC
$eReeec^?T>w6vT1sv{ ?2nweR L{BXe)/;Q1|RV|Ohu@ T|/Jf.
cyu6C653-!URgTaBDxGL/UfGfFCg<.UU\iC3.WgZ`k'ufEx//'p!0a`.]UyE$U`WTD1N0Tru0z2:fg I
>g
6
o`f@y}xClS!;UnSB.yQB.xL.kgBpKCf3M)5yLyBQg_~V`CVRv<0G]0].Vxv501)0u-.U}:13%TJ-PZTm.\ngV
`sx_.n
xA//
> &uSH60D+x1?CWKy2AGT%`?VA>-,Sg\F
>U60to/dL
;ewnC[5
hMU$AA{BmQx#-:fB=kwEy`,DrN0pGtLZuIo-;QS|Q{Nys<1Ll0+(?!
q0f,#Ti.}e@EAN`BFwLWxl/ixTb}2lx
L-KG0?..Cf2TH9-]B`fTp/)sw+ t0)muy X?G#xZH-#WB>T&Y-? 0D-)0Y8un _@Bf~yBnXf*MfT,Nx-Kwzax.H.{_S&4
OSl<x
Note: Lines longer than 256 characters were wrapped