File t

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}( {|{9 zs y9yiCnzzx0wI5!!K w5*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   
p n^,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 A USDRUCK: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 A USDRUCK: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#p f /p$y0p  
p f|?1` =B^l<> OQ, | zH @  ((( $ B mZ i-0k
Zj [-J. W`!#f(V0! &VVnf
BVXnL0~;&f>l!d6CFf@4B(FzS HzX( 8t8@"(Xx?@<VJ fvb(wPn/w}B@az|b w (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
mZ i-0k Zj [-J. W`!#f(V0! &VVnf
BVXnL0~;&f>l!d6CFf@4B(FzS HzX( 8t8@"(Xx?@<VJ fvb(wPn/w}B@az|b w (trlXo=v[JXTjM,6"%&sL8<L0L(jX ls&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
8 PE`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<3J A,]@ @F&`y`x@`hnFFb]yyFrn]@yOyz'(`{''dik"`m2F`^ eJmFF`+X9jLRV`VVy8p t @ P b lY&~ nf cH J}"|({"z(Vb0it 
<6J2 64LC(u(8{2V ~N: qm  8 .2qm28tI[ 2xX0 ~ tmAH~H(o]H>xoq VqPtXXVQoN ]$]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@y8p t @ P b lY&~ nf cH J}"|({"z(Vb0it  <6J2 64LC(u(8{2V ~N: qm  8 .2qm28tI[ 2xX0 ~ tmAH~H(o]H>xoq VqPtXXVQoN ]$]@?}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 @ P b lY&~ nf cH J}"|({"z(Vb0it 
<6J2 64LC(u(8{2V ~N: qm  8 .2qm28tI[ 2xX0 ~ tmAH~H(o]H>xoq VqPtXXVQoN ]$]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@y8p t @ P b lY&~ nf cH J}"|({"z(Vb0it  <6J2 64LC(u(8{2V ~N: qm  8 .2qm28tI[ 2xX  ~ tmAH~H(o]H>xoq VqPtXXVQoN ]$]?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}m  p8@@_ :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.LPT a |pZa; }IwN}+}i8}i}izPo0p6G|Hph:A/X~k0 0f lB,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({L 0p&!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 @6P8h B l
6?@h{ghhb%Dg.`ghb@b #( oKJ%,~(/@,&@}(/B|"@{b oEN"DDnD bNKj%KNO&z "!FJ&NN1m&#+ hb#y
hb%Ff.#hnh dYS+ # (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"YbbOZ k 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^G PYB?<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=G HMG  wvwu |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'FpkP 0 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|b nIh?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 SsT s H !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"NNbQNiGuCJsPO J\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]BD A1\{'({ (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 yb xb
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#p f /p$y0p  
p f|?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#p f /p$y0p~TqDp(TDq(~TpTqTq3 R~TSD TSDF@~TqBBTBDF~1\pp 1\qp  ~u3Arp 3Asp ~5]tp5]up ~u7Qvp7Qwp TRDHPtL4 BTL@V~pPTPPp~(1
pp 1\qp  ~u3Arp 3Asp ~5]tp5]up ~u7Qvp7Qwp TRDHPtL4 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, )3 3,$)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)/,  )61 6 , )32)6 3,3, 6 )5 , $)67 3 )*6)6  $,3;,6 )*<3,  )= , )6A *3 )6C , )36E 6, 3)G,6
)+3K 6 , )3M,6   )3O 3,)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 )3 o+ 3 6)q)6 3*u)6 3,w*)3 ,6y*6 ),3 {
, $)6} 6, )3+)  ,*6,6 )*3 )36- 3, )3,  )6 $, )36 ,6  $)3 36), ,  $), 3 )6)6 *,+)3 *6+, )6,  $)6,)  6) 3$ ,6 ,3  )6 3$),6!) 6 +-#) 6 ,% ) 6,3-',3 )6)*6
)$+)* -36-)+ *,6/ 3$,61 6 , )33, 3 $)65 6, )$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 o9d q9d8d9pdqdyBd8d9Cd{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 G HQn}5e]xU,M}  +_rDh:G(z{jmfy'^61g8qMg7b;$g8CU
h[CL.(zJ/i&=b!_u1g;9# \xCvB+$~x HL48IUWCs$q<zaV59eY[\,<hgS:J t`EM5Uq]bY_.?.F- %]_]]Yl[\Lx a:4 ph (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]`|KN 7$G~H\0E R|1e[|xKR|q%__\>L$2m)e^ \
r Fk]&y,GzL2FsT&:h{R=+Df+hEsKym$'$::ssjZB5,g$|L2|7h\W|zJ5;kf)pF I[ ^04 V{*B_1iT%'7`L*<Wh>Pr8 OYIe#JbFn3.7 2 JyVi)Te'}$Q;6%|`XEbZ7o(>["H3SjN<?t&KBuio,wyo3Xv=eeK /h>j'eqFj5&u;a T(z9,8DGBO+XH68%PW( 04xZ*;";Z >p-0UWR7"H?&g9c X2CD,&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@D2 q8SfPe>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)Jc ON.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-/Vav2m gE9 my7TV/TO D,|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}#sky18YUX J~-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)w UZ,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[ x 63ic^zXv(FiU'_;hPc1g3"{K(G6Jw1.B +` A7.vkEdAR T}{,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<9alQM N/29#%WWTn?`ztCt-dTjy%?iqWTrj9e_8T2}'92CBe-_/rDe_6P0Td j9ey_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$^tT Ll,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;]lJ ut ^SE>J
Cz=7Nc$Ja3GOEk+DcV^gPb1rU 6F#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"G4q mJ mw d_KXHwc`~kJ`j3Q#
%Vf+r< }^#*4=ZA(7=_O'A4@'. (#UJFduTjOt9]X3Z]Nm.rxeg e nvm~^Bd1c1xo-Om U!)5ZFt}b0c{!6)sqd3Y:k]VjEx\v,ttp3>9,[H&fm UO||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'My s<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!_ Pb1 bg5_Tj 9 L *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?t SFtf2 8?eKW$q,XoeW WEd1(+ELG-R,q9X3TY Km'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+W TAxX)iRSjv%8}aisRj6|{[SKv>%T kS O-`t1H.<!4V(&5\Q7]N
kTI7o|dV.kIRabMd9Uy}YE :=D-@f\n3Rje u]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&kR i^ 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|xEfI Hn9}!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\*9qM FgH%`02t>Z;.mSjF#pJa=Q/Ezg=_]Hdru  Gfw\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$l t|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(:1ny cXF)b_V1'\s/d<L uH6\B+"8zGWmeXWR3{$<S %SP`rg,>O5%CYvW?7&=)x#X,z dhGXJ7b;9hGJ1zg^y+fdx'ODqc} ~EJ .$MqSXr>1ccd<GM"_Z,;(75m^e%u\| q4:Ly0 8|^UY#Zsn 7.FGmega#DdAJS\*xK_Xz xOt}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$l 065?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'6FmWVqdc4Ap H-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`uo C|=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`&nm UN|t4p7v5Aqz4R#y"0+T`j!wCe s= ]
MsQ 9xZ"~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/bU NcSDA*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~ M q&JxFm,@-\m;gKZ|rPq"o~It$k}#KYhCO;UP-1fyx s2CGKSW}zO&UT s+^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+v S3d!]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_*WTIXg6fR g0n )e1sx_.3LRA'xv(U@CNdQ@/6oZ A#[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.uBSTltAN 2DF(: 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#_sz OUTwy)f$xJ>r S Y(<J wbedV;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 >\ {"tdVp enrdnWI+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{BX e )/;Q1|RV|Ohu@ T|/Jf. cyu6C65 3-!URgTaBDxGL/UfGfFCg<.UU\iC3.WgZ` k'ufEx//'p!0a`.]UyE$U`WTD1N0Tru0z2:f g I >g 6 o`f@y}xClS!;UnSB.yQB.xL.kgBpKCf3 M)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`,DrN0pGtLZ uIo-;QS|Q {Nys<1Ll0+(?! q0f,#Ti.}e@EAN`BFwLWxl/ixTb}2 lx
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



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search