`L i=L\Ʃx ? N'i  ͭЅ?0ȱ Ѕ?iȱi lԠԠ͠ԠϠŠͮŠ SYSTEM.APPLE   L$JO^ccMP.E8.TEXTvguEXAMP.E6B.TEXTgEXAMP.E6A.TEXTg EXAMP.E5.TEXTvg EXAMP.E7.TEXTvgTEXT^oC| ASS2.1.TEXT^oC ASS3.1.TEXT^oC ASS5.1.TEXT^oC ASS4.1.TEXT^oCEXAMP.E3B.TEXTguEXAMP.E3A.TEXTgu EXAMP.E1.TEXTvgu EXAMP.E2.TEXTvgu EXAMP.E4.TEXTvgu EXA^oCTX PAS2.0.TEXT^oCX\ PAS3.0.TEXT^oC\` PAS4.0.TEXT^oC`d PAS1.1.TEXT^oCdh PAS2.1.TEXT^oChl PAS3.1.TEXT^oClp PAS5.0.TEXT^oCpt PAS4.1.TEXT^oCtx PAS5.1.TEXT^oCx| ASS1.1.c*. EXAMP.S2.TEXTvgc.2 EXAMP.S3.TEXTvgc28 EXAMP.S4.TEXTvgc8< EXAMP.S5.TEXT^oT<@ EXAMP.S6.TEXT^oT@D EXAMP.S7.TEXT^oTDH EXAMP.S8.TEXT^oTHL EXAMP.S9.TEXT^oTLP PAS0.0.TEXT^oCPT PAS1.0.TEXTPSCAL14+  EXAMP.3E.TEXTvgc  EXAMP.3F.TEXTvgc EXAMP.3H.TEXTvgc EXAMP.3I.TEXTvgc EXAMP.4B.TEXTvgc EXAMP.5B.TEXTvgc" EXAMP.6C.TEXTvgc"&EXAMP.6D1.TEXTgc&* EXAMP.S1.TEXTvg&꽌ɪɖ'*&%&,E'зЮ꽌ɪФ`+*xH&x'8*7Ixix&&  ') + &п x) ++`FG8`0($ p,&") (jJJ>L+ "?I>  N `  ` x V Nx .x- z `V0^*^*>` aI꽌ɪVɭ&Y&&Y& 꽌ɪ\8`&(* BEISPIEL 1 *)  (* GROESSTER GEMEINSAMER TEILER *)  PROGRAM EX3E (INPUT, OUTPUT);  VAR A,B: INTEGER;  BEGIN !READ (A,B); !REPEAT "WHILE A > B DO A:=A-B; "WHILE B > A DO B:=B-A !UNTIL A=B; !WRITELN ('GGT = ',A)  END.  O^cc(* BEISPIEL 2 *)  (* MAXIMUM AUS N ZAHLEN *)  PROGRAM EX3F (INPUT, OUTPUT);  VAR N,MAX,ZAHL,I: INTEGER;  BEGIN !READ(N); !READ(MAX); !FOR I:=2 TO N DO "BEGIN #READ(ZAHL); #IF ZAHL > MAX THEN MAX:=ZAHL "END; !WRITELN('MAXIMUM = ',MAX)  END.  O^cc(* BEISPIEL 3 *)  (* GETRENNTE SUMMATION POSITIVER UND NEGATIVER #ZAHLEN UND ZAEHLUNG DER AUFTRETENDEN NULLEN *)   PROGRAM EX3H (INPUT, OUTPUT);  VAR I,N,ZAHL,SUMMEPOS,SUMMENEG,NULL : INTEGER;  BEGIN !READ(N); !SUMMEPOS:=0; SUMMENEG:=0; !NULL:=0;O^cc'); "5: WRITELN('FREITAG'); "6: WRITELN('SAMSTAG'); "7: WRITELN('SONNTAG') !END  END.  (* BEISPIEL 4 *)  (* LIES ZAHLEN UND DRUCKE DEN WOCHENTAG *)   PROGRAM EX3I (INPUT,OUTPUT);  VAR TAGNR:INTEGER;  BEGIN !READ(TAGNR); !CASE TAGNR OF "1: WRITELN('MONTAG'); "2: WRITELN('DIENSTAG'); "3: WRITELN('MITTWOCH'); "4: WRITELN('DONNERSTAGO^ccUMMENEG); !WRITELN('ANZAHL DER NULLEN = ',NULL)  END.  !FOR I:=1 TO N DO "BEGIN #READ(ZAHL); #IF ZAHL = 0 THEN NULL:=NULL+1 #ELSE $IF ZAHL>0 THEN SUMMEPOS:=SUMMEPOS+ZAHL $ELSE SUMMENEG:=SUMMENEG+ZAHL "END; !WRITELN('SUMME DER POSITIVEN ZAHLEN = ',SUMMEPOS); !WRITELN('SUMME DER NEGATIVEN ZAHLEN = ',S(* BEISPIEL 5 *)  (* SIMULATION EINES TASCHENRECHNERS *)   PROGRAM EX4B (INPUT,OUTPUT);  VAR OPERATOR : CHAR; $ERGEBNIS,ZAHL:REAL;  BEGIN !ERGEBNIS:=0; !OPERATOR:='+'; !REPEAT "READ(ZAHL); "CASE OPERATOR OF #'+': ERGEBNIS := ERGEBNIS + ZAHLO^cc CELSIUS : INTEGER; &FAHRENHEIT: REAL;  BEGIN !WRITELN ('CELSIUS FAHRENHEIT'); !FOR CELSIUS:=0 TO 99 DO "BEGIN #FAHRENHEIT:=CELSIUS*FAKTOR+STARTPUNKT; #WRITELN(CELSIUS:2,' ':6,FAHRENHEIT:6:1) "END  END.  (* BEISPIEL 6 *)  (* STELLT DIE TEMPERATURSKALA IN CELSIUS VON #0 BIS 99 DEN FAHRENHEIT-WERTEN IN EINER TABELLE #GEGENUEBER. DIE FAHRENHEIT-WERTE SIND AUF ZEHNTEL #GENAU *)   PROGRAM EX5B (INPUT,OUTPUT);  CONST FAKTOR=1.8; &STARTPUNKT=32.0;  VAR O^cc; #'-': ERGEBNIS := ERGEBNIS - ZAHL; #'*': ERGEBNIS := ERGEBNIS * ZAHL; #'/': ERGEBNIS := ERGEBNIS / ZAHL "END;  REPEAT #READ (OPERATOR) ! UNTIL OPERATOR<>' ' !UNTIL OPERATOR = '='; !WRITELN; !WRITELN('ERGEBNIS = ',ERGEBNIS)  END.  (* BEISPIEL 7 *)  (* UMORDNEN VON ZAHLENPAAREN *)  PROGRAM EX6C (INPUT,OUTPUT);  VAR I,N: INTEGER; $X,Y: REAL; $ !PROCEDURE VERTAUSCHE (VAR P,Q:REAL); "VAR TEMP: REAL; "BEGIN #TEMP:=P; #P:=Q; #Q:=TEMP "END; "  BEGIN !READ(N); !FOR I:=1 TO NO^cc1, ' FUSS UND ', )INCHES:2,' ZOLL.')  END.  MOD 12; INP:=INP DIV 12; "F := INP MOD 3; INP:=INP DIV 3;  Y := INP MOD 1760; "M := INP DIV 1760 !END;   BEGIN !READ(EINGABE); !UMWANDELN(MILES, YARDS, FEET, INCHES, EINGABE); !WRITELN(MILES:4,' MEILEN, ', )YARDS:4,' YARDS, ', )FEET:(* BEISPIEL 8 *)  (* UMWANDLUNG EINER ZAHL VON INCHES IN #MILES, YARDS, FEET, INCHES *) #  PROGRAM EX6D (INPUT, OUTPUT);  VAR MILES, YARDS, FEET, INCHES, EINGABE: INTEGER;  !PROCEDURE UMWANDELN(VAR M,Y,F,I:INTEGER; INP: INTEGER); !BEGIN "I := INPO^cc DO "BEGIN #READ(X,Y); #IF X>Y THEN VERTAUSCHE(X,Y); #WRITELN(X,Y) "END; !WRITELN('ALLE PAARE GEORDNET')  END.  (* BEISPIEL 9 *)  (* HEXADEZIMAL NACH DEZIMAL UMWANDELN *)  (* SIEHE SKRIPTUM SEITE IV/11 *)   PROGRAM EXS1 (INPUT, OUTPUT);  VAR ZAHL, HEXZIFFER: INTEGER;  CH:CHAR;   BEGIN !WRITELN('BITTE GEBEN SIE NACHEINANDER DIE'); !WRITELN('ZU DEN HEXO^ccEPEAT "I:=I+1;  REST[I]:=ZAHL MOD 16; "ZAHL:=ZAHL DIV 16 !UNTIL ZAHL=0; !WRITE('HEXADEZIMALZAHL = '); !WHILE I>=1 DO "BEGIN #IF REST[I]>9 THEN WRITE(CHR(REST[I]-10+ORD('A'))) #ELSE WRITE(REST[I]:1); #I:=I-1 "END;  END.  (* BEISPIEL 10 *)  (* DEZIMAL NACH HEXADEZIMAL UMWANDELN *)  (* SIEHE SKRIPTUM SEITE IV/11 *)   PROGRAM EXS2 (INPUT, OUTPUT);  VAR ZAHL,I: INTEGER;  REST: ARRAY [1..20] OF INTEGER; $  BEGIN  I:=0; !WRITE('DEZIMALZAHL ? '); READLN(ZAHL); !RO^ccTIL CH='J'; ! !WRITELN('WERT DER DEZIMALZAHL = ',ZAHL)  END.  ADEZIMALZIFFERN GEHOERENDEN'); !WRITELN('DEZIMALEN AEQUIVALENTE EIN.'); ! !ZAHL:=0; ! !REPEAT "WRITE('DEZIMALER WERT DER HEX.ZIFFER: '); "READLN(HEXZIFFER);  ZAHL := ZAHL * 16 + HEXZIFFER; "WRITELN; "WRITE('FERTIG ? '); READ(CH); "WRITELN !UN(* BEISPIEL 11 *)  (* AUFSTELLEN EINER WAHRHEITSTAFEL *)  (* SIEHE SKRIPTUM SEITE I/20 *)   PROGRAM EXS3 (INPUT, OUTPUT);  VAR A,B,C,D,E: BOOLEAN; $X:CHAR; $L0,L1:PACKED ARRAY [1..6] OF CHAR; $  PROCEDURE DRUCK(B:BOOLEAN); !BEGIN "IF B THEN WRER ZAHL *) ! END; #PRIMFAKTOR:=SQR(PRIM [I]) > ZAHL "UNTIL (I=TABELLENENDE) OR PRIMFAKTOR (* GEFUNDEN *); "IF ZAHL > 1 THEN (* REST BERUECKSICHTIGEN *) #IF PRIMFAKTOR THEN DRUCKE(ZAHL) (* ALS PRIMFAKTOR *) #ELSE GROSSERREST(ZAHL); (* D.H. NICHT GEKZAHLENTABELLE; (* INITIALISIEREN *) !WRITELN; !READ(ZAHL); !REPEAT "WRITE(' FAKTOR(EN) VON ',ZAHL,'...'); "I:=0; "DRUCKZAEHLER:=0; "REPEAT #I:=I+1; #WHILE ZAHL MOD PRIM [I]=0 DO $BEGIN %DRUCKE(PRIM [I]); %ZAHL:=ZAHL DIV PRIM [I] (* REDUZIEREN D PROCEDURE GROSSERREST (Z:INTEGER); !BEGIN "(* DRUCKT DEN VERBLEIBENDEN REST SAMT KOMMENTAR *) " "WRITELN; "IF DRUCKZAEHLER <> 0 THEN WRITE(' DER RESTFAKTOR '); "WRITELN(Z,' IST ZU GROSS.') !END; !  BEGIN !(* BEGINN DES HAUPTPROGRAMMES *) !PRIMEDUR SORGT DAFUER, DASS NUR 6 ZAHLEN IN EINER ZEILE *) "(* GEDRUCKT WERDEN. *) " "IF DRUCKZAEHLER MOD 6=0 THEN WRITELN; "WRITE(Z:4); "DRUCKZAEHLER:=DRUCKZAEHLER+1 !END; ! ) "(* EINGEFUEGT WERDEN. VORERST WERDEN DIE PRIMZAHLEN VORGEGEBEN *) % "(* PRIM IST HIER EINE GLOBALE GROESSE *) "PRIM [1]:=2; PRIM [2]:=3; PRIM [3]:=5; "PRIM [4]:=7; PRIM [5]:=11 !END; !  PROCEDURE DRUCKE (Z:INTEGER); !BEGIN "(* DIESE PROZER" *) &PRIM: ARRAY [1..TABELLENENDE] OF INTEGER; &PRIMFAKTOR: BOOLEAN; &  PROCEDURE PRIMZAHLENTABELLE; !BEGIN "(* AN DIESER STELLE KANN ZU EINEM SPAETEREN ZEITPUNKT EIN *) "(* VOLLSTAENDIGES PROGRAMM ZUR BERECHNUNG DER PRIMZAHLEN *(* BEISPIEL 12 *)  (* BERECHNEN DER PRIMFAKTOREN *)  (* SIEHE SKRIPTUM SEITE VI/2 *)   PROGRAM PRIMFAK (INPUT,OUTPUT);  CONST TABELLENENDE=5;  VAR ZAHL, DRUCKZAEHLER: INTEGER; &I:0..TABELLENENDE; +(* BEISPIEL EINES DATENTYPS "TEILMENGE VON INTEGN^rcE TO TRUE DO #BEGIN $C:=A AND B; $D:=NOT B; $E:=C OR D; $DRUCK(A); DRUCK(B); DRUCK(C); DRUCK(D); DRUCK(E); $WRITELN #END  END.  B': BEGIN L0:='FALSCH'; L1:='WAHR ' END; "'C': BEGIN L0:='FALSE '; L1:='TRUE ' END; !END; !WRITELN; !WRITELN; !WRITELN('WAHRHEISTAFEL');  WRITELN('VAR A':10,'VAR B':10,'VAR C':10,'VAR D':10,'VAR E':10); !FOR A:=FALSE TO TRUE DO "FOR B:=FALSITE(L1:10) "ELSE WRITE(L0:10) !END;   BEGIN  WRITELN('WAEHLEN SIE DIE DARSTELLUNG:'); !WRITELN; !WRITELN('A...0/1'); !WRITELN('B...FALSCH/WAHR'); !WRITELN('C...FALSE/TRUE'); !READ(X); !CASE X OF "'A': BEGIN L0:='0 '; L1:='1 ' END; "'LAERTER REST *) "WRITELN; "READ(ZAHL); !UNTIL ZAHL=0 (* ABBRECHBEDINGUNG GEAENDERT *)  END. ! N^TT "ANZEIGE([ROT,GELB]) !UNTIL FALSE  END.  =ROT TO GRUEN DO "IF F IN LAMPEN THEN #CASE F OF $ROT: WRITE('ROT'); $GELB: WRITE('GELB'); $GRUEN: WRITE('GRUEN') #END; !WRITELN  END; (* ANZEIGE *)   BEGIN (* VERKEHRSAMPEL *) !REPEAT "ANZEIGE([GRUEN]); "ANZEIGE([GELB]); "ANZEIGE([ROT]);(* DIESESBEISPIEL ZEIGT DIE VERWENDUNG VON MENGEN #UND VON AUFZAEHLUNGSTYPEN *)  PROGRAM VERKEHRSAMPEL (OUTPUT);  TYPE FARBEN=(ROT,GELB,GRUEN); %AMPEL =SET OF FARBEN; %  PROCEDURE ANZEIGE(LAMPEN:AMPEL);  VAR F:FARBEN;  BEGIN (* ANZEIGE *) !FOR F:N^TT  BEGIN (* FIBONACCI *) !REPEAT "WRITE('WELCHE FIBONACCI-ZAHL? '); READLN(Z); "WRITELN('DIE ',Z:1,'.FIBONACCHI-ZAHL IST ',FIB(Z)); "WRITELN !UNTIL Z=0  END.  (* BEISPIEL FUER EINE REKURSIVE PROZEDUR *)  PROGRAM FIBONACCI (INPUT,OUTPUT);  VAR Z:INTEGER;   FUNCTION FIB(I:INTEGER): INTEGER;  BEGIN (* FIB *) !IF I=0 THEN FIB:=0 !ELSE "IF I=1 THEN FIB:=1 "ELSE #FIB:=FIB(I-1) + FIB(I-2)  END; (* FIB *)  N^TTT EOF(F) DO "BEGIN WITH F^ DO WRITELN('ZAHL= ',I,' BUCHSTABE=',C); #GET(F) "END; !CLOSE(F)  END.  GRAM FILEDEMO2 (INPUT, OUTPUT);  TYPE R=RECORD &I:INTEGER; &C:CHAR %END;  VAR F:FILE OF R;  BEGIN !REWRITE(F,'DEMO'); !REPEAT "WRITE('ZAHL UND EINEN BUCHSTABEN EINGEBEN '); "WITH F^ DO READLN(I,C); "PUT(F) !UNTIL F^.I=0; !RESET (F); !WHILE NO(* FILES UND RECORDS: #DAS PROGRAMM OEFFNET EIN FILE, LIEST #ZAHLEN UND ZEICHEN EIN, SCHREIBT SIE AUF DAS FILE #UND LIEST ANSCHLIESSEND DAS FILE. # #DAS OEFFNEN DES FILES KANN IN DEN #EINZELNEN IMPLEMENTATIONEN UNTERSCHIEDLICH #ERFOLGEN *) #  PRON^TTVAR F:FILE OF INTEGER; $I:INTEGER;  BEGIN !REWRITE(F,'DEMO'); !REPEAT "WRITE('ZAHL EINGEBEN '); "READ(I); "F^:=I; "PUT(F) !UNTIL I=0; !RESET (F); !WHILE NOT EOF(F) DO "BEGIN WRITELN('ZAHL ',F^); #GET(F) "END; !CLOSE(F)  END.  (* DAS PROGRAMM OEFFNET EIN FILE, LIEST #ZAHLEN EIN, SCHREIBT SIE AUF DAS FILE #UND LIEST ANSCHLIESSEND DAS FILE. # #DAS OEFFNEN DES FILES KANN IN DEN #EINZELNEN IMPLEMENTATIONEN UNTERSCHIEDLICH #ERFOLGEN *) #  PROGRAM FILEDEMO (INPUT, OUTPUT);  N^TTEAD(N) "END  END. (* OHNE PROZEDUREN *)  PROGRAM DEMO;  VAR N,I,SUM: INTEGER;  BEGIN !WRITE('BITTE N EINGEBEN '); !READ(N); !WHILE NOT EOF DO "BEGIN #SUM:=0; #FOR I:=1 TO N DO SUM:=SUM+I; #WRITELN('DIE SUMME IST ',SUM); #WRITELN; #WRITE('BITTE N EINGEBEN '); #RN^CC',K^.VAL); #K:=K^.N "END  END.  HL ? '); READLN(I); !NEW(K); !PTALT:=K; !PTALT^.VAL:=I; !PTALT^.N:=NIL; !REPEAT "WRITE('ZAHL ? '); READLN(I); "NEW(K); "K^.VAL:=I; "K^.N:=PTALT; "PTALT:=K !UNTIL I=0;  WRITELN; !WRITELN('KETTE LESEN'); !WHILE K<>NIL DO "BEGIN WRITELN('ZAHL (* DIESES PROGRAMM DEMONSTRIERT VERKETTETE LISTEN *)  PROGRAM POINTER (INPUT,OUTPUT);  TYPE KETTE=RECORD &VAL: INTEGER; &N: ^KETTE %END;  VAR I:INTEGER;  K,PTALT:^KETTE;  BEGIN !PTALT:=NIL; !WRITELN('KETTE AUFBAUEN'); !WRITELN; !WRITE('ZAN^CCEBEN '); !READ(N); !WHILE NOT EOF DO "BEGIN #SUMME; #WRITELN('DIE SUMME IST ',SUM); #WRITELN; #WRITE('BITTE N EINGEBEN '); #READ(N) "END  END. (* MIT PROZEDUR, VERWENDUNG VON GLOBALEN #UND LOKALEN GROESSEN *)  PROGRAM DEMO;  VAR N,SUM: INTEGER;   PROCEDURE SUMME; !VAR I:INTEGER; !BEGIN (* SUMME *) "SUM:=0; "FOR I:=1 TO N DO SUM:=SUM+I !END; (* SUMME *) !  BEGIN !WRITE('BITTE N EINGN^CCT EOF DO "BEGIN #SUMME; #WRITELN('DIE SUMME IST ',SUM); #WRITELN; #WRITE('BITTE N EINGEBEN '); #READ(N) "END  END. (* MIT PROZEDUR, VERWENDUNG VON GLOBALEN GROESSEN *)  PROGRAM DEMO;  VAR N,I,SUM: INTEGER;   PROCEDURE SUMME; !BEGIN (* SUMME *) "SUM:=0; "FOR I:=1 TO N DO SUM:=SUM+I !END; (* SUMME *) !  BEGIN !WRITE('BITTE N EINGEBEN '); !READ(N); !WHILE NON^CC BEGIN !WRITE('BITTE N EINGEBEN '); !READ(N); !WHILE NOT EOF DO "BEGIN #SUMME(N,SUM); #WRITELN('DIE SUMME IST ',SUM); #WRITELN; #WRITE('BITTE N EINGEBEN '); #READ(N) "END  END. (* MIT PROZEDUR, VERWENDUNG VON LOKALEN GROESSEN UND PARAMETERN *)  PROGRAM DEMO;  VAR N,SUM: INTEGER;   PROCEDURE SUMME(N: INTEGER; VAR SUM: INTEGER); !VAR I:INTEGER; !BEGIN (* SUMME *) "SUM:=0; "FOR I:=1 TO N DO SUM:=SUM+I !END; (* SUMME *) ! N^CCBEGIN !WRITE('BITTE N EINGEBEN '); !READ(N); !WHILE NOT EOF DO "BEGIN #SUMME(N); #WRITELN('DIE SUMME IST ',SUM); #WRITELN; #WRITE('BITTE N EINGEBEN '); #READ(N) "END  END. (* MIT PROZEDUR, VERWENDUNG VON GLOBALEN #UND LOKALEN GROESSEN UND PARAMETERN *)  PROGRAM DEMO;  VAR N,SUM: INTEGER;   PROCEDURE SUMME(N: INTEGER); !VAR I:INTEGER; !BEGIN (* SUMME *) "SUM:=0; "FOR I:=1 TO N DO SUM:=SUM+I !END; (* SUMME *) !  N^CCUM); #WRITELN; #WRITE('BITTE N EINGEBEN '); #READ(N) "END  END. (* MIT PROZEDUR, VERWENDUNG VON GLOBALEN #UND LOKALEN GROESSEN *)  PROGRAM DEMO;  VAR N,SUM: INTEGER;   PROCEDURE SUMME; !EXTERNAL; !  BEGIN !WRITE('BITTE N EINGEBEN '); !READ(N); !WHILE NOT EOF DO "BEGIN #SUMME; #WRITELN('DIE SUMME IST ',SN^CCN; #WRITE('BITTE N EINGEBEN '); #READ(N) "END  END. (* MIT PROZEDUR, VERWENDUNG VON GLOBALEN GROESSEN *)  PROGRAM DEMO;  VAR N,I,SUM: INTEGER;   PROCEDURE SUMME; !EXTERNAL; !  BEGIN !WRITE('BITTE N EINGEBEN '); !READ(N); !WHILE NOT EOF DO "BEGIN #SUMME; #WRITELN('DIE SUMME IST ',SUM); #WRITELN^CC!  BEGIN !WRITE('BITTE N EINGEBEN '); !READ(N); !WHILE NOT EOF DO "BEGIN #WRITELN('DIE SUMME IST ',SUMME(N)); #WRITELN; #WRITE('BITTE N EINGEBEN '); #READ(N) "END  END. (* MIT FUNKTION, VERWENDUNG VON LOKALEN GROESSEN UND PARAMETERN *)  PROGRAM DEMO;  VAR N: INTEGER;   FUNCTION SUMME(N: INTEGER):INTEGER; !VAR SUM,I:INTEGER; !BEGIN (* SUMME *) "SUM:=0; "FOR I:=1 TO N DO SUM:=SUM+I; "SUMME:=SUM !END; (* SUMME *) N^CC; #WRITELN('DIE SUMME IST ',SUM); #WRITELN; #WRITE('BITTE N EINGEBEN '); #READ(N) "END  END. (* MIT PROZEDUR, VERWENDUNG VON GLOBALEN #UND LOKALEN GROESSEN UND PARAMETERN *)  PROGRAM DEMO;  VAR N,SUM: INTEGER;   PROCEDURE SUMME(N: INTEGER); !EXTERNAL; !  BEGIN !WRITE('BITTE N EINGEBEN '); !READ(N); !WHILE NOT EOF DO "BEGIN #SUMME(N)N^CCT ',SUMME(N)); #WRITELN; #WRITE('BITTE N EINGEBEN '); #READ(N) "END  END. (* MIT FUNKTION, VERWENDUNG VON LOKALEN GROESSEN UND PARAMETERN *)  PROGRAM DEMO;  VAR N: INTEGER;   FUNCTION SUMME(N: INTEGER):INTEGER; !EXTERNAL; !  BEGIN !WRITE('BITTE N EINGEBEN '); !READ(N); !WHILE NOT EOF DO "BEGIN #WRITELN('DIE SUMME ISN^CCN,SUM); #WRITELN('DIE SUMME IST ',SUM); #WRITELN; #WRITE('BITTE N EINGEBEN '); #READ(N) "END  END. (* MIT PROZEDUR, VERWENDUNG VON LOKALEN GROESSEN UND PARAMETERN *)  PROGRAM DEMO;  VAR N,SUM: INTEGER;   PROCEDURE SUMME(N: INTEGER; VAR SUM: INTEGER); !EXTERNAL; !  BEGIN !WRITE('BITTE N EINGEBEN '); !READ(N); !WHILE NOT EOF DO "BEGIN #SUMME(N^CC SUM+1 (ADC I+1 (STA SUM+1 (CLC (LDA I (ADC #1 (STA I (LDA I+1 (ADC #0 (STA I+1 (JMP LOOP  FERTIG RTS  I .WORD (.END  .PROC SUMME (.PUBLIC SUM,N (LDA #0 (STA SUM (STA SUM+1 (STA I+1 (LDA #1 (STA I  LOOP SEC (LDA N (SBC I (LDA N+1 (SBC I+1 (BMI FERTIG (CLC (LDA SUM (ADC I (STA SUM (LDA N^CCLDA I (SBC #1 (BNE $01 (LDX #0  $01 STA I (LDA I+1 (SBC #0 (STA I+1 (BNE LOOP (CPX #0 (BNE LOOP (RTS (.END  .PROC SUMME (.PUBLIC SUM,I,N (LDX #1 (LDA #0 (STA SUM (STA SUM+1 (LDA N (STA I (LDA N+1 (STA I+1  LOOP CLC (LDA SUM (ADC I (STA SUM (LDA SUM+1 (ADC I+1 (STA SUM+1 (SEC (N^CC (STA I (LDA I+1 (ADC #0 (STA I+1 (JMP LOOP  FERTIG PUSH SUM  PUSH RET (RTS  I .WORD  N .WORD  SUM .WORD  RET .WORD (.END  A SUM+1 (STA I+1 (LDA #1 (STA I  LOOP SEC (LDA N (SBC I (LDA N+1 (SBC I+1 (BMI FERTIG (CLC (LDA SUM (ADC I (STA SUM (LDA SUM+1 (ADC I+1 (STA SUM+1 (CLC (LDA I (ADC #1 .FUNC SUMME,1 ( (.MACRO POP (PLA (STA %1 (PLA (STA %1+1 (.ENDM ( (.MACRO PUSH (LDA %1+1 (PHA (LDA %1 (PHA (.ENDM ( (POP RET (POP SUM (POP SUM (POP N (LDY #0 (LDA #0 (STA SUM (STN^CC RET (PHA (RTS  I .WORD  N .WORD  RET .WORD (.END  C I+1 (BMI FERTIG (CLC (LDA SUM (ADC I (STA SUM (LDA SUM+1 (ADC I+1 (STA SUM+1 (CLC (LDA I (ADC #1 (STA I (LDA I+1 (ADC #0 (STA I+1 (JMP LOOP  FERTIG LDA RET+1 (PHA (LDA .PROC SUMME,1 (.PUBLIC SUM (PLA (STA RET (PLA (STA RET+1 (PLA (STA N (PLA (STA N+1 (LDA #0 (STA SUM (STA SUM+1 (STA I+1 (LDA #1 (STA I  LOOP SEC (LDA N (SBC I (LDA N+1 (SBN^CC); "WRITELN('BEENDEN SIE DAS PROGRAMM MIT "E".') !END; (* ERKLAERUNG *) !  PROCEDURE MASKE; (* BAUT DIE BILDSCHIRMMASKE AUF *) !BEGIN (* MASKE *) "GOTOXY(0,10); WRITELN('SPANNUNG IN VOLT:',CHR(LOEEZ)); "GOTOXY(0,12); WRITELN('STROM IN AMPERE:',CHR(LR; $  PROCEDURE ERKLAERUNG; (* GIBT DEN BEGRUESSUNGSTEXT AUS *)  BEGIN (* ERKLAERUNG *) "PAGE(OUTPUT); (* LOESCHEN DES SCHIRMS *) "WRITELN('OHMSCHES GESETZ'); "WRITELN('==============='); "WRITELN; "WRITELN('WAEHLEN SIE, WAS SIE BERECHNEN WOLLEN.'PROGRAM E3B;  (* OHMSCHES GESETZ *)  (* KOMFORTABLE VERSION *)  (* DIESES PROGRAMM LIEST VON DEN DREI #GROESSEN U,I UND R ZWEI EIN UND #BESTIMMT DIE DRITTE *)   CONST LOEEZ=29; (* LOESCHEN BIS ZUM ENDE DER ZEILE *)   VAR U,I,R: REAL; $CH: CHAO^ԣuA @SUM,Y (CLC (LDA I (ADC #1 (STA I (LDA I+1 (ADC #0 (STA I+1 (JMP LOOP  FERTIG PUSH RET (RTS  I .WORD  N .WORD  RET .WORD (.END  UM,Y (INY (STA @SUM,Y (STA I+1 (LDA #1 (STA I  LOOP SEC (LDA N (SBC I (LDA N+1 (SBC I+1 (BMI FERTIG (CLC (LDY #0 (LDA @SUM,Y (ADC I (STA @SUM,Y (INY (LDA @SUM,Y (ADC I+1 (ST .PROC SUMME,2 ( (.MACRO POP (PLA (STA %1 (PLA (STA %1+1 (.ENDM ( (.MACRO PUSH (LDA %1+1 (PHA (LDA %1 (PHA (.ENDM (  SUM .EQU 0 (POP RET (POP SUM (POP N (LDY #0 (LDA #0 (STA @SOEEZ)); "GOTOXY(0,14); WRITELN('WIDERSTAND IN OHM:',CHR(LOEEZ)) !END; (* MASKE *) !  PROCEDURE SCHREIBEN (ZL:INTEGER; WERT:REAL); !BEGIN (* SCHREIBEN *) "GOTOXY(20,ZL); "WRITELN(CHR(LOEEZ),WERT:20:10) !END; (* SCHREIBEN *) !  PROCEDURE LESEN (ZL:INTEGER; VAR WERT:REAL); !BEGIN (* LESEN *) "REPEAT #GOTOXY(20,ZL); #WRITELN(CHR(LOEEZ)); #GOTOXY(20,ZL); #(*$I- DAMIT FUEHREN FEHLERHAFTE EINGABEN NICHT ZUM ABBRUCH *) #READLN(WERT); #(*$I+ *) #SCHREIBEN(ZL,WERT)  UNTIL WO^uu=',U/R) %END; #'R': %BEGIN &WRITELN('U=?'); READLN(U); &WRITELN('I=?'); READLN(I); &WRITELN('R=',U/I) %END "END; "WRITELN !UNTIL CH='E'  END. (* E3A *) " MSCHES GESETZ: U I R GESUCHT, E(NDE) ?'); "READLN(CH); "CASE CH OF #'U': %BEGIN &WRITELN('I=?'); READLN(I); &WRITELN('R=?'); READLN(R); &WRITELN('U=',I*R) %END; " 'I': %BEGIN &WRITELN('U=?'); READLN(U); &WRITELN('R=?'); READLN(R); &WRITELN('IPROGRAM E3A;  (* OHMSCHES GESETZ *)  (* EINFACHE VERSION *)  (* DIESES PROGRAMM LIEST VON DEN DREI #GROESSEN U,I UND R ZWEI EIN UND #BESTIMMT DIE DRITTE *)   VAR U,I,R: REAL; $CH: CHAR; $  BEGIN (* E3A *) !PAGE(OUTPUT); !REPEAT "WRITELN('OHO^ԣuD; #'E': EXIT(PROGRAM) "END " !UNTIL FALSE (* ENDLOSSCHLEIFE *)  END. (* E3B *) " " ,'R','E']; " "MASKE; " "CASE CH OF #'U': %BEGIN &LESEN(12,I); &LESEN(14,R); &SCHREIBEN(10,I*R) %END; " 'I': %BEGIN &LESEN(10,U); &LESEN(14,R); &SCHREIBEN(12,U/R) %END; #'R': %BEGIN &LESEN(10,U); &LESEN(12,I); &SCHREIBEN(14,U/I) %ENERT <> 0 (* 0 NICHT ZUGELASSEN *)  END; (* LESEN *) "  BEGIN (* E3B *) !ERKLAERUNG; !REPEAT " "(* FESTSTELLEN, WELCHER WERT GESUCHT IST *) "REPEAT #GOTOXY(0,7); #WRITELN('AUSWAHL: U I R BERECHNEN ODER ENDE: '); #READLN(CH) "UNTIL CH IN ['U','I'PROGRAM E1; !(* WIDERSTANDSBERECHNUNG *)  VAR RHO,L,A,R:REAL;  BEGIN !WRITELN('WIDERSTANDSBERECHNUNG'); !WRITELN; !WRITELN('LAENGE L IN M = ?'); READLN(L); !WRITELN; !WRITELN('FLAECHE A IN MM*MM = ?'); READLN(A); !WRITELN; !WRITELN('SPEZ. WIDERSTO^uuETA-20) > 50 THEN "BEGIN #WRITELN('TEMPERATURKOEFF. BETA IN 1/(K*K) = ?');  READLN(BETA); #WRITELN "END !ELSE BETA:=0; ! !WRITELN('WIDERSTAND BEI ',THETA,' GRAD CELSIUS:'); !WRITELN(R20*(1+ALPHA*(THETA-20)+BETA*SQR(THETA-20)),' OHM')  END.  ); !WRITELN; ! !WRITELN('TEMPERATUR IN GRAD CELSIUS = ?'); !READLN(THETA); !WRITELN; ! !WRITELN('TEMPERATURKOEFF. ALPHA IN 1/K = ?'); !READLN(ALPHA); !WRITELN; ! !(* FESTELLEN, OB DIE TEMPERATURDIFFERENZ 50 KELVIN $UEBERSTEIGT *) $ !IF ABS(THPROGRAM E2; !(* TEMPERATURABHAENGIGKEIT EINES $WIDERSTANDES *)  VAR R20,THETA,ALPHA,BETA:REAL;  BEGIN !WRITELN('TEMPERATURABHAENGIGKEIT EINES'); !WRITELN('WIDERSTANDES'); !WRITELN; !WRITELN('WIDERSTAND BEI 20 GRD CELSIUS IN OHM = ?'); !READLN(R20O^uuAND IN OHM*MM*MM/M = ?'); READLN(RHO); !WRITELN; !WRITELN('WIDERSTAND IN OHM = ',L*RHO/A)  END. ! !  PROGRAM E4; !(* SERIEN UND PARALLELSCHALTUNG *)  CONST SER='SERIENSCHALTUNG '; &PAR='PARALLELSCAHLATUNG ';  VAR CH:CHAR; $W1,W2,WRES:REAL;   PROCEDURE REZIPR(W1,W2:REAL; VAR W3:REAL); !BEGIN (* REZIPR *) "W3:=1/(1/W1+1/W2) !END; (* REZIPR *)ANDELT X-KOORDINATE IN OMEGA UM *) "BEGIN (* XOM *) #OM:=EXP(LN(10)*(X-140)/130)*OMEGA0 "END; (* XOM *)   "PROCEDURE VY(V:REAL; VAR Y:INTEGER); #(* WANDELT VERSTAERKUNG IN DB IN Y-KOORDINATE UM *) "BEGIN (* VY *) #Y:=190+ROUND((V-V0)*18) "END; HSE: OMEGA IN 1/S'); "MOVETO(120,170); "WSTRING('Y-ACHSE: VERST. IN DB') " !END; (* BESCHRIFTEN *) !  PROCEDURE ZEICHNEN; "VAR V,OMEGA: REAL; (* AKTUELLE WERTE *) &X,Y: INTEGER; (* KOORDINATEN *) " "PROCEDURE XOM(X:INTEGER; VAR OM:REAL); #(* W"STR(OMEGA0*10,ST); "MOVETO(275-LENGTH(ST)*7,0); "WSTRING(ST); " "STR(V0,ST); "MOVETO(12,181); "WSTRING(ST); " "STR(V0-5,ST); "MOVETO(12,97); "WSTRING(ST); " "STR(V0-10,ST); "MOVETO(12,10); "WSTRING(ST); " "MOVETO(120,180); "WSTRING('X-ACTO(140,7) !END; (* INIT *) !  PROCEDURE BESCHRIFTEN; !VAR ST:STRING; !BEGIN (* BESCHRIFTEN *) "PENCOLOR(NONE);  STR(OMEGA0 DIV 10,ST); "MOVETO(10,0); "WSTRING(ST); " "STR(OMEGA0,ST); "MOVETO(140-LENGTH(ST)*7 DIV 2,0); "WSTRING(ST); " INIT *) "INITTURTLE; "MOVETO(7,190); "PENCOLOR(WHITE); "MOVETO(10,190); "MOVETO(10,100); "MOVETO(7,100); "MOVETO(10,100); "MOVETO(10,7); "MOVETO(10,10); "MOVETO(7,10); "MOVETO(270,10); "MOVETO(270,7); "MOVETO(270,10); "MOVETO(140,10); "MOVEERSTAERKUNG IN DB = ?'); "READLN(V0); "WRITELN; " "WRITELN('GRENZKREISFREQUENZ BIS 3000 1/S'); "WRITELN('GRENZFREQUENZ IN 1/S = ?'); "READLN(OMEGA0); "IF OMEGA0>3000 THEN EXIT(PROGRAM); "WRITELN !END; (* WERTE *) ! ! !PROCEDURE INIT; !BEGIN (*PROGRAM E8; !(* EINFACHE FILTERKURVE: TIEFPASS *)  USES TURTLEGRAFICS,TRANSCENDET;  VAR V0, (* GLEICHSPANNUNGSVERSTAERKUNG IN DB *) $OMEGA0:INTEGER; (* GRENZKREISFREQUENZ *) ! !PROCEDURE WERTE; !BEGIN (* WERTE *) "WRITELN('GLEICHSPANNUNGSVO^uuD.  IE ',CH,'2 EIN:'); !READLN(W2); !WRITELN; !  CASE CH OF "'R','L': #BEGIN  WRITELN(SER,W1+W2);  REZIPR(W1,W2,WRES); $WRITELN(PAR,WRES) #END;  'C': #BEGIN $REZIPR(W1,W2,WRES); $WRITELN(SER,WRES); $WRITELN(PAR,W1+W2) #END !END  EN   BEGIN (* E4 *) !WRITELN('SERIEN UND PARALLELSCHALTUNG'); !WRITELN; !REPEAT "WRITELN('WAEHLEN SIE: R C L'); "READLN(CH); "WRITELN !UNTIL CH IN ['R','L','C']; ! !WRITELN('GEBEN SIE ',CH,'1 EIN:'); !READLN(W1); !WRITELN; ! !WRITELN('GEBEN S(* VY *) !  BEGIN (* ZEICHNEN *) "PENCOLOR(NONE); "MOVETO(10,190); "PENCOLOR(WHITE); "FOR X:=10 TO 270 DO #BEGIN XOM(X,OMEGA); $V:=V0+10/LN(10)*LN(1/(1+SQR(OMEGA/OMEGA0))); $VY(V,Y); $MOVETO(X,Y) #END; "PENCOLOR(NONE); "MOVETO(120,160); "WSTRING(' DRUECKEN'); "READLN !END; (* ZEICHNEN *) ! #  BEGIN (* E8 *) !WERTE; !INIT; !BESCHRIFTEN; !ZEICHNEN;  END. ! MMA,Y); $MOVETO(X,Y) #END; "MOVETO(260,180); "PENCOLOR(NONE); "MOVETO(40,160); "WSTRING(' DRUECKEN'); "READLN !END; (* ZEICHNEN *) ! #  BEGIN (* E6B *) !INIT; !BESCHRIFTEN; !WERTE; !REPEAT "ZEICHNEN; "WERTE  UNTIL EOF  END. (* E6B *) "BEGIN (* GAY *) #Y:=30+ROUND(GA*150) "END; (* GAY *) !  BEGIN (* ZEICHNEN *) "GRAFMODE; "BETA:=RL/R; "PENCOLOR(NONE); "MOVETO(30,30); "PENCOLOR(WHITE); "FOR X:=31 TO 259 DO #BEGIN XAL(X,ALPHA); $GAMMA:=BETA/(1+BETA/ALPHA-ALPHA); $GAY(GA&X,Y: INTEGER; (* KOORDINATEN *) " "PROCEDURE XAL(X:INTEGER; VAR AL:REAL); #(* WANDELT X-KOORDINATE IN ALPHA UM *) "BEGIN (* XAL *) #AL:=(X-30)/230 "END; (* XAL *)   "PROCEDURE GAY(GA:REAL; VAR Y:INTEGER); #(* WANDELT GAMMA IN Y-KOORDINATE UM "TEXTMODE; "WRITELN('SPANNUNGSTEILERWIDERSTAND IN OHM = ?'); "READLN(R); "WRITELN; "WRITELN('LASTWIDERSTAND IN OHM = ?'); "READLN(RL); "WRITELN !END; (* WERTE *) ! !  PROCEDURE ZEICHNEN; "VAR ALPHA,BETA,GAMMA: REAL; (23,20); "WSTRING('0%'); "MOVETO(246,20); "WSTRING('100%'); "MOVETO(40,180); "WSTRING('X-ACHSE: POTENTIOMETEREINSTELLUNG'); "MOVETO(40,170); "WSTRING('Y-ACHSE: SPANNUNGSTEILERVERH.') !END; (* BESCHRIFTEN *) ! !PROCEDURE WERTE; !BEGIN (* WERTE *); "MOVETO(30,27); "MOVETO(30,30); "MOVETO(27,30); "MOVETO(260,30); "MOVETO(260,27) !END; (* INIT *) !  PROCEDURE BESCHRIFTEN; !BEGIN (* BESCHRIFTEN *) "PENCOLOR(NONE); "MOVETO(0,24); "WSTRING('0%'); "MOVETO(0,174); "WSTRING('100%'); "MOVETOPROGRAM E6B; !(* BELASTETER SPANNUNGSTEILER *)  USES TURTLEGRAFICS;  VAR R, (* SPANNUNGSTEILERWIDERSTAND *) $RL:REAL; (* LASTWIDERSTAND *) ! !PROCEDURE INIT; !BEGIN (* INIT *) "INITTURTLE; "MOVETO(27,180); "PENCOLOR(WHITE); "MOVETO(30,180)O^u*) ! O^uO^uMMA,Y); $MOVETO(X,Y) #END; "MOVETO(260,180); "PENCOLOR(NONE); "MOVETO(40,160); "WSTRING(' DRUECKEN'); "READLN !END; (* ZEICHNEN *) ! #  BEGIN (* E6A *) !WERTE; !INIT; !BESCHRIFTEN; !ZEICHNEN  END. (* E6A *) ! *) "BEGIN (* GAY *) #Y:=30+ROUND(GA*150) "END; (* GAY *) !  BEGIN (* ZEICHNEN *) "GRAFMODE; "BETA:=RL/R; "PENCOLOR(NONE); "MOVETO(30,30); "PENCOLOR(WHITE); "FOR X:=31 TO 259 DO #BEGIN XAL(X,ALPHA); $GAMMA:=BETA/(1+BETA/ALPHA-ALPHA); $GAY(GA&X,Y: INTEGER; (* KOORDINATEN *) " "PROCEDURE XAL(X:INTEGER; VAR AL:REAL); #(* WANDELT X-KOORDINATE IN ALPHA UM *) "BEGIN (* XAL *) #AL:=(X-30)/230 "END; (* XAL *)   "PROCEDURE GAY(GA:REAL; VAR Y:INTEGER); #(* WANDELT GAMMA IN Y-KOORDINATE UM "TEXTMODE; "WRITELN('SPANNUNGSTEILERWIDERSTAND IN OHM = ?'); "READLN(R); "WRITELN; "WRITELN('LASTWIDERSTAND IN OHM = ?'); "READLN(RL); "WRITELN !END; (* WERTE *) ! !  PROCEDURE ZEICHNEN; "VAR ALPHA,BETA,GAMMA: REAL; (23,20); "WSTRING('0%'); "MOVETO(246,20); "WSTRING('100%'); "MOVETO(40,180); "WSTRING('X-ACHSE: POTENTIOMETEREINSTELLUNG'); "MOVETO(40,170); "WSTRING('Y-ACHSE: SPANNUNGSTEILERVERH.') !END; (* BESCHRIFTEN *) ! !PROCEDURE WERTE; !BEGIN (* WERTE *); "MOVETO(30,27); "MOVETO(30,30); "MOVETO(27,30); "MOVETO(260,30); "MOVETO(260,27) !END; (* INIT *) !  PROCEDURE BESCHRIFTEN; !BEGIN (* BESCHRIFTEN *) "PENCOLOR(NONE); "MOVETO(0,24); "WSTRING('0%'); "MOVETO(0,174); "WSTRING('100%'); "MOVETOPROGRAM E6A; !(* BELASTETER SPANNUNGSTEILER *)  USES TURTLEGRAFICS;  VAR R, (* SPANNUNGSTEILERWIDERSTAND *) $RL:REAL; (* LASTWIDERSTAND *) ! !PROCEDURE INIT; !BEGIN (* INIT *) "INITTURTLE; "MOVETO(27,180); "PENCOLOR(WHITE); "MOVETO(30,180)PROGRAM E5; !(* SPANNUNGSQUELLE - KENNLINIE *)  USES TURTLEGRAFICS; ! !PROCEDURE INIT; !BEGIN (* INIT *) "INITTURTLE; "MOVETO(27,180); "PENCOLOR(WHITE); "MOVETO(30,180); "MOVETO(30,27); "MOVETO(30,30); "MOVETO(27,30); "MOVETO(260,30); "MOVETO#WRITELN('STATION 1, ALSO ',NAME1,', GELOESCHT.'); #WRITELN; #WRITELN('SIND SIE DAMIT EINVERSTANDEN? ',CHR(7)); #NEXTCH; WRITE(LC); #IF LC='J' THEN $BEGIN %FOR I:=0 TO 13 DO &BEGIN 'UNITREAD(10,BUF,10240,I*20); 'UNITWRITE(9,BUF,10240,I*20) &END;#UNITREAD(10,DIR,512,2); NAME2:=DIR [0].VOLNAME; #WRITELN; #WRITELN('DIE DISKETTE IN STATION 1 HEISST ',NAME1); #WRITELN('DIE DISKETTE IN STATION 2 HEISST ',NAME2); #WRITELN; #WRITELN('BEIM SICHERN WIRD DIE DISKETTE IN'); ED ARRAY [0..10239] OF CHAR; (* 20 BLOECKE *) $DIR: DIRECTORY; $I: INTEGER; $NAME1, NAME2: STRING [7]; $ !PROCEDURE KOPIEREN; "BEGIN FORM('SK',TRUE); NEXTCH; #DISKWECHSEL(1,'DIE SICHERUNGSDISKETTE'); #UNITREAD(9,DIR,512,2); NAME1:=DIR [0].VOLNAME; ; !V1:=1/(1/V+R1/RN); !RE1:=R1+1/(1/RBE+V/RN); !RA1:=V/(V1*(1/RC+1/RCE)); !WRITELN('V = ',V); !WRITELN; !WRITELN('V1 = ',V1); !WRITELN; !WRITELN('RE1 = ',RE1); !WRITELN; !WRITELN('RA1 = ',RA1)  END. !WRITELN('RC IN OHM = ? '); READLN(RC); !WRITELN; !WRITELN('RCE IN OHM = ? '); READLN(RCE); !WRITELN; !WRITELN('RBE IN OHM = ? '); READLN(RBE); !WRITELN; !WRITELN('VERSAERKUNG BETA = ? '); READLN(BETA); !WRITELN;  V:=BETA/((1/RC+1/RN+1/RCE)*RBE)PROGRAM E7; !(* VERSTAERKERBERECHNUNG *)  VAR V,V1,R1,RN,RC,RCE,RBE,BETA,RE1,RA1:REAL;  BEGIN (* E7 *) !WRITELN('VERSTAERKERBERECHNUNG'); !WRITELN; !WRITELN('R1 IN OHM = ? '); READLN(R1); !WRITELN; !WRITELN('RN IN OHM = ? '); READLN(RN); !WRITELN;N^MOVETO(140,160); "WSTRING(' DRUECKEN'); "READLN !END; (* ZEICHNEN *) ! #  BEGIN (* E5 *) !INIT; !BESCHRIFTEN; !ZEICHNEN  END. (* E5 *) ! STRING('X-ACHSE: STROM'); "MOVETO(140,170); "WSTRING('Y-ACHSE: SPANNUNG') !END; (* BESCHRIFTEN *) !  PROCEDURE ZEICHNEN;  BEGIN (* ZEICHNEN *) "GRAFMODE; "PENCOLOR(NONE); "MOVETO(30,180); "PENCOLOR(WHITE); "MOVETO(260,30); "PENCOLOR(NONE); "(260,27) !END; (* INIT *) !  PROCEDURE BESCHRIFTEN; !BEGIN (* BESCHRIFTEN *) "PENCOLOR(NONE); "MOVETO(0,24); "WSTRING('0'); "MOVETO(0,174); "WSTRING('U0'); "MOVETO(23,20); "WSTRING('0'); "MOVETO(246,20); "WSTRING('IK'); "MOVETO(140,180); "W %(* AN DIESER STELLE GGF DF^.GESICHERT:=TRUE EINFUEGEN *) %UNITREAD(9,DIR,512,2); %(* AUTOMATISCHES UMBENENNEN AUF DEN URSPRUENGLICHEN NAMEN *) %DIR [0].VOLNAME:=NAME1; %UNITWRITE(9,DIR,512,2); $END; #PAGE(OUTPUT); #WRITELN('BITTE ENTFERNEN SIE DIE DISKETTE IN'); #WRITELN; #WRITELN('STATION NR. 1 UND LEGEN SIE DIE SYSTEM-'); #WRITELN; #WRITELN('DISKETTE WIEDER EIN.'); #WRITELN; #WRITELN; #WRITELN('DRUECKEN SIE EINE TASTE.'); #WRITELN; #NEXTCH; #PAGE(OUTPUT); "END; (* PROCEDURE KOPIEREN *#UNTIL ((SATZNR>=1) AND (SATZNR<=SATZNRMAX)) OR ESC; #IF NOT ESC THEN NEU:=TRUE "END; (* PROCEDURE SATZNRLESEN *) " "PROCEDURE ABSCHLUSS(LCT:CHTYP); FORWARD; #(* SCHLIESST EINEN DATENSATZ AB, SCHREIBT #IHN GGF AUF DIE DISKETTE UND HOLT (WENN IM #KOBS *) (END %END (* CASE *) $UNTIL (LCT=CURLF) OR (ST=4) OR ESC; $IF NOT ESC AND ((SATZNR<1) OR (SATZNR>SATZNRMAX)) THEN %BEGIN WRITE(CHR(7)); &WRITEXY(0,4,'UNGUELTIGE SATZNUMMER'); &FEHLERALT:=TRUE %END &ZIFFER: 'BEGIN (IF LC IN ['0'..'9'] THEN )SATZNR:=SATZNR*10 + ORD(LC) - ORD0; (ST:=ST+1; (WRITE(LC) 'END; &BUCHST,SZEICHEN: WRITE(CHR(7)); (* BEL *) &CURLI: 'IF ST>0 THEN (BEGIN )SATZNR:=SATZNR DIV 10; ST:=ST-1; )WRITE(CHR(8),' ',CHR(8)) (* "END; (* PROCEDURE CURPOS *) " "PROCEDURE SATZNRLESEN; (* HOLT IM KONTROLLMODUS #DIE NUMMER DES NAECHSTEN SATZES VON DER TASTATUR *) "VAR ST:INTEGER; "BEGIN #REPEAT $GOTOXY(13,7); WRITE(CHR(29)); $SATZNR:=0; ST:=0; $REPEAT %NEXTCH; %CASE LCT OF,GOTOXY(IND+13,11); $27,28,29,30,31: ,GOTOXY(IND-7,12); $32,33,34,35,36,37,38,39,40,41,42, $43,44,45,46,47,48,49,50,51: ,GOTOXY(IND-12,14); $52,53,54,55,56,57,58,59,60: ,GOTOXY(IND-32,15); $61,62,63,64,65,66: ,GOTOXY(20,IND-43) #END (* CASE *) =TRUE; #IND:=I+1 "END; " "PROCEDURE CURPOS; (* POSITIONIERT DEN CURSOR *) "BEGIN #CASE IND OF $1,2: GOTOXY(IND+19,10); $3,4: GOTOXY(IND+20,10); $5,6: GOTOXY(IND+21,10); $7,8,9,10,11,12,13,14,15,16,17,18, $19,20,21,22,23,24,25,26: ER,FEHLERALT,NEU: BOOLEAN; ! IND,WERT,I: INTEGER; %BUF: ARRAY [1..INDMAX] OF CHAR; % "PROCEDURE ZEILELOESCHEN (I:INTEGER); "VAR J:INTEGER; "BEGIN #WRITE(CHR(29)); (* CTRL-] LOESCHT BIS ZEILENENDE *) #FOR J:=IND TO I DO BUF [J]:=' '; #AENDERUNG: END; (* PROCEDURE SICHERN *)   (**************************************)  SEGMENT PROCEDURE ERFKONTR;  VAR VOLL,WDH,OPEN,KONTR,ABGESCHL,NEUSATZ: BOOLEAN; $NFREISATZNR, SATZNR: INTEGER; $ !PROCEDURE KONTROLLE; !CONST INDMAX=66; !VAR AENDERUNG,FEHL"DISKWECHSEL(2,'DIE URSPRUENGLICHE DISKETTE'); !END; (* PROCEDURE LOESCHEN *)   BEGIN (* PROCEDURE SICHERN *) !REPEAT "FORM('S',TRUE); "NEXTCH; "CASE LC OF #'K': KOPIEREN; #'L': LOESCHEN; #'?': ERGAENZUNG('S'); "END !UNTIL ESC; !ESC:=FALSE =TRUE; 'DF^.KENNZEICHEN.UEBERTRAGEN:=FALSE; 'DF^.KENNZEICHEN.RESERVE:= []; 'GOTOXY(9,10); WRITE(I:4); 'PUT(DF) &END; %SEEK(DF,0); %DF^.NFREISATZNR:=1; %DF^.ABGESCHLOSSEN:=TRUE; %PUT(DF); %CLOSE(DF,LOCK) $END; '; 'DF^.SIGNATUR:='? '; 'DF^.KENNZEICHEN.BEWERTUNG:=NEUT; 'DF^.KENNZEICHEN.ZITAT:=FALSE; 'DF^.KENNZEICHEN.KOMMENTAR:=FALSE; 'DF^.KENNZEICHEN.PARLAMENT:=FALSE; 'DF^.KENNZEICHEN.PARTEI:=OP; 'DF^.KENNZEICHEN.AKTIV:=TRUE; 'DF^.KENNZEICHEN.FREI:NR. WIRD GELOESCHT.'); %FOR I:=1 TO SATZNRMAX DO &BEGIN 'SEEK(DF,I); 'DF^.STELLE.DATUM.JAHR:=100; 'DF^.STELLE.DATUM.MONAT:=0; 'DF^.STELLE.DATUM.TAG:=0; 'DF^.STELLE.SEITE:=0; 'DF^.QUELLE:='? '; 'DF^.NAME:='? %DISKWECHSEL(2,'DIE ZU LOESCHENDE DISKETTE'); %(*$I-*) %RESET(DF,'#10:DATEN'); %IF IORESULT=0 THEN CLOSE(DF,PURGE); %(*$I+*) %PAGE(OUTPUT); %GOTOXY(0,8); %WRITE(SATZNRMAX,' SAETZE SIND ZU LOESCHEN'); %REWRITE(DF,'#10:DATEN'); %WRITEXY(0,10,'SATZ ) " !PROCEDURE LOESCHEN; (* SCHREIBT SATZNRMAX LEERE SAETZE UND "ERZEUGT DAS FILE ".DATEN" AUF DISKETTE IN DRIVE 2 *) " "VAR I:INTEGER; " "BEGIN FORM('SL',TRUE); (* "WOLLEN SIE DAS WIRKLICH?" *) #NEXTCH; #IF LC='J' THEN $BEGIN NTROLL-MODUS) DEN NAECHSTEN *) " "PROCEDURE NUMSTR(AIND,EIND,WERT: INTEGER); #(* WANDELT EINEN "WERT" IN EINE ZEICHENKETTE #UM UND SCHREIBT DAS ERGENIS NACH #BUF [AIND] BIS BUF [EIND]. (ANFANGS- #INDEX UND ENDINDEX) *) "VAR I:INTEGER; "BEGIN #FOR I:=EIND DOWNTO AIND DO $BEGIN %BUF [I]:=CHR(WERT MOD 10 + ORD0); %WERT:=WERT DIV 10 $END "END; (* PROCEDURE NUMSTR *) " "FUNCTION BUFFEHLER(BEREICH:CHSET; AIND,EIND:INTEGER):BOOLEAN; #(* PRUEFUNG AUF ZULAESSIGE ZEICHEN. #AIND UND EIND SIND INDIZE#END; (* FUNCTION TEST2 *) # "BEGIN (* PROCEDURE BUFFERTOFILE *) #TEST1([' ','0'..'9'],1,6); #TEST1([' ','0'..'9'],27,31); #TEST1(['+','-','0','?'],61,61); #TEST1(['J','N'],62,64); #TEST1(['V','S','F','0'],65,65); #TEST1(['J','N'],66,66); #SEEK(DNTEGER; $(* PRUEFUNG, OB EIN NUMERISCHER WERT $IM ZULAESSIGEN BEREICH LIEGT *) #VAR WERT:INTEGER; 'FEHLER:BOOLEAN; #BEGIN (* FUNCTION TEST2 *) $STRNUM(MINWERT,MAXWERT,AIND,EIND,WERT,FEHLER); $IF FEHLER THEN EXIT(ABSCHLUSS) ELSE TEST2:=WERT TEGER); $(* PRUEFUNG AUF ZULAESSIGE ZEICHEN. $AIND UND EIND SIND INDIZES VON BUF *) #BEGIN (*PROCEDURE TEST1 *) $IF BUFFEHLER(BEREICH,AIND,EIND) THEN EXIT(ABSCHLUSS) #END; (*PROCEDURE TEST1 *) # #FUNCTION TEST2(MINWERT,MAXWERT,AIND,EIND:INTEGER):IER *) # "PROCEDURE BUFFERTOFILE; #(* SCHREIBT DEN INHALT DES PUFFERS BUF #AUF DAS DATENFILE DF; VORHER WERDEN #PLAUSIBILITAETSPRUEFUNGEN DURCHGEFUEHRT *) $ #TYPE CHSET=SET OF CHAR; # #VAR I:INTEGER; # #PROCEDURE TEST1(BEREICH:CHSET; AIND,EIND:IN%WRITE(BUF [IND]) $END; #GOTOXY(20,14); WRITE(DF^.NAME); #GOTOXY(20,15); WRITE(DF^.SIGNATUR); #FOR IND:=61 TO 66 DO $BEGIN CURPOS; %WRITE(BUF [IND]) $END; #NEU:=FALSE; " IF KONTR THEN IND:=1 ELSE IND:=32; #CURPOS; "END; (* PROCEDURE FILETOBUFFEN BUF [66] := 'J' %ELSE BUF [66] := 'N'; $END; (* WITH *) #FOR IND:=1 TO 6 DO (* GGF NOCH VERBESSERN ****************) $BEGIN CURPOS; %WRITE(BUF [IND]) $END; #GOTOXY(20,11); WRITE(DF^.QUELLE); #FOR IND:=27 TO 31 DO $BEGIN CURPOS; SE BUF [62] := 'N'; %IF ZITAT THEN BUF [63] := 'J' %ELSE BUF [63] := 'N'; %IF PARLAMENT THEN BUF [64] := 'J' %ELSE BUF [64] := 'N'; %CASE PARTEI OF &VP: BUF [65]:='V'; &SP: BUF [65]:='S'; &FP: BUF [65]:='F'; &OP: BUF [65]:='0' %END; %IF AKTIV TH TO 20 DO $BUF [I+31]:=DF^.NAME [I]; #FOR I:=1 TO 9 DO $BUF [I+51]:=DF^.SIGNATUR [I]; #WITH DF^.KENNZEICHEN DO $BEGIN %CASE BEWERTUNG OF &POS: BUF [61]:='+'; &NEG: BUF [61]:='-'; &NEUT:BUF [61]:='0'; %END; %IF KOMMENTAR THEN BUF [62] := 'J' %EL#SEEK(DF,SATZNR); GET(DF); #I:=DF^.STELLE.DATUM.JAHR; NUMSTR(1,2,I); #I:=DF^.STELLE.DATUM.MONAT; NUMSTR(3,4,I); #I:=DF^.STELLE.DATUM.TAG; NUMSTR(5,6,I); #I:=DF^.STELLE.SEITE; NUMSTR(27,31,I); #FOR I:=1 TO 20 DO $BUF [I+6]:=DF^.QUELLE [I]; #FOR I:=1,MINWERT:1,' UND ',MAXWERT:1); %FEHLERALT:=TRUE; IND:=AIND; $END; #WERT:=W; "END; (* FUNCTION TEST2 *) " "PROCEDURE FILETOBUFFER; #(* LIEST EINEN SATZ VOM DATENFILE DF, #SCHREIBT IHN IN DEN PUFFER UND AUF #DEN SCHIRM *) "VAR I:INTEGER; "BEGIN EHLER:=TRUE %ELSE W:=W*10 + ORD(BUF [I]) - ORD0; $I:=I+1 #UNTIL (I>EIND) OR FEHLER; #FEHLER:=FEHLER OR (WMAXWERT); #IF FEHLER THEN $BEGIN %GOTOXY(0,4); %WRITELN(CHR(7),'EINGABEFEHLER! ZULAESSIG SIND NUR'); %WRITE('ZAHLEN ZWISCHEN 'TEGER; #VAR WERT:INTEGER; VAR FEHLER:BOOLEAN); #(* PRUEFUNG, OB EIN NUMERISCHER WERT #IM ZULAESSIGEN BEREICH LIEGT *) "VAR I,W: INTEGER; "BEGIN (* FUNCTION TEST2 *) #W:=0; FEHLER:=FALSE; #I:=AIND; #REPEAT $IF BUF [I] <> ' ' THEN %IF W>3276 THEN F%WRITELN(CHR(7),'EINGABEFEHLER! ZULAESSIG SIND NUR:'); %FOR CH:=' ' TO '^' DO &IF CH IN BEREICH THEN WRITE(CH,' '); %FEHLERALT:=TRUE; %IND:=I-1; $END; #BUFFEHLER:=FEHLER "END; (*PROCEDURE TEST1 *) " "PROCEDURE STRNUM(MINWERT,MAXWERT,AIND,EIND:INS VON BUF *) "VAR I: INTEGER; &CH:CHAR; &FEHLER:BOOLEAN; "BEGIN (*FUNCTION BUFFEHLER *) #I:=AIND; FEHLER:=FALSE; #REPEAT $FEHLER:=NOT(BUF[I] IN BEREICH); $I:=I+1 #UNTIL FEHLER OR (I>EIND); #IF FEHLER THEN $BEGIN %GOTOXY(0,4); F,SATZNR); #DF^.STELLE.DATUM.JAHR:=TEST2(0,99,1,2); #DF^.STELLE.DATUM.MONAT:=TEST2(0,12,3,4); #DF^.STELLE.DATUM.TAG:=TEST2(0,31,5,6); #DF^.STELLE.SEITE:=TEST2(0,31999,27,31); #FOR I:=1 TO 20 DO $DF^.QUELLE [I]:=BUF [I+6]; #FOR I:=1 TO 20 DO $DF^.NAME [I]:=BUF [I+31]; #FOR I:=1 TO 9 DO $DF^.SIGNATUR [I]:=BUF [I+51]; #WITH DF^.KENNZEICHEN DO $BEGIN %CASE BUF [61] OF &'+':BEWERTUNG:=POS; &'-':BEWERTUNG:=NEG; &'0':BEWERTUNG:=NEUT; %END; %KOMMENTAR:=BUF [62] = 'J'; %ZITAT:=BUF [63] = 'J'; %PA END; (* PROCEDURE KONTROLLE *)   BEGIN (* PROCEDURE ERFKONTR *) !OPEN:=FALSE; NEUSATZ:=FALSE; !REPEAT WDH:=FALSE; PAGE(OUTPUT); "(*$I-*) "RESET(DF,'#10:DATEN'); "IF IORESULT <> 0 THEN #BEGIN $WRITEXY(4,7,'GESUCHTE DATEI NICHT VORHANDEN.'); $D FEHLER THEN )BEGIN WERT:=WERT+1000; *NUMSTR(27,31,WERT); *GOTOXY(20,12); *FOR I:=27 TO 31 DO WRITE(BUF[I]); *CURPOS )END 'END; %CURUP:ZEILEMINUS; %CURLF:ZEILEPLUS; $END; (* CASE LCT *) " CURPOS "END; (* WHILE NOT ESC *) ! ESC:=FALSE LI: &IF IND>1 THEN IND:=IND-1; %CURRE: &IF INDINDMAX THEN ABSCHLUSS(NSATZ) &END; %CUR"NEU:=TRUE; "AENDERUNG:=FALSE; "IF KONTR THEN FORM('EK',TRUE) ELSE FORM('EE',TRUE); "IF KONTR THEN SATZNRLESEN; "GOTOXY(13,7); WRITE(SATZNR:4); "IND:=1; CURPOS; "WHILE NOT ESC DO #BEGIN $IF KONTR AND NEU THEN FILETOBUFFER; $NEXTCH; $IF FEHLERALTCHEN(51); %52: IND:=61; %53,54,55,56,57,58,59,60: 3ZEILELOESCHEN(60); %61,62,63,64,65: 3IND:=IND+1; %66: ABSCHLUSS(NSATZ) $END (* CASE IND *) ! END (* ZEILEPLUS *); ! !BEGIN (* PROCEDURE KONTROLLE *) "FEHLERALT:=FALSE; IND:=27; %8,9,10,11,12,13,14,15,16,17,18,19,20, %21,22,23,24,25,26: 3ZEILELOESCHEN(26); %27: IND:=32; %28,29,30,31: ZEILELOESCHEN(31); %32: IND:=52; %33,34,35,36,37,38,39,40,41,42,43,44, %45,46,47,48,49,50,51: 3ZEILELOES,35,36,37,38,39,40,41,42, %43,44,45,46,47,48,49,50,51: 3IND:=27; %52,53,54,55,56,57,58,59,60: 3IND:=32; %61: IND:=52; %62,63,64,65,66: 3IND:=IND-1 $END #END; "PROCEDURE ZEILEPLUS; #BEGIN $CASE IND OF %1,2,3,4,5,6: IND:=7; %7: #IF KONTR THEN IND:=1 ELSE IND:=32; #ESC:=FALSE "END; (* PROCEDURE ABSCHLUSS *) # ! PROCEDURE ZEILEMINUS; #BEGIN $CASE IND OF %1,2,3,4,5,6,7,8,9,10,11,12,13,14, %15,16,17,18,19,20,21,22,23,24,25,26: 3IND:=1; %27,28,29,30,31: 3IND:=7; %32,33,34LCT *) #AENDERUNG:=FALSE; #IF SATZNR=SATZNRMAX THEN $BEGIN FEHLERALT:=TRUE; %WRITEXY(1,4,'ACHTUNG! LETZTER DATENSATZ!'); $END; #IF NOT ESC THEN $BEGIN %GOTOXY(13,7); WRITE(SATZNR:4); %IF KONTR OR (LCT<>NSATZ) THEN FILETOBUFFER; $END; '); (WRITE(CHR(7)); (FEHLERALT:=TRUE 'END; &IF SATZNR1 THEN SATZNR:=SATZNR-1; $NSATZ: $ BEGIN &IF NOT AENDERUNG AND NOT KONTR THEN 'BEGIN (WRITEXY(1,4,'DA SIE KEIN ZEICHEN EINGEGEBEN HABEN,'); (WRITEXY(1,5,'WURDE NICHTS GESPEICHERT.%DF^.ABGESCHLOSSEN:=FALSE; %PUT(DF); %SEEK(DF,20); (* SCHREIBEN GARANTIEREN *) $ ABGESCHL:=TRUE $END; #IF NFREISATZNR<=SATZNR THEN $NFREISATZNR:=SATZNR+1 "END; (* PROCEDURE BUFFERTOFILE *) # "PROCEDURE ABSCHLUSS; "BEGIN (* PROCEDURE ABSCHLUSS *)RLAMENT:=BUF [64] = 'J'; %CASE BUF [65] OF &'V':PARTEI:=VP; &'S':PARTEI:=SP; &'F':PARTEI:=FP; &'0':PARTEI:=OP %END; %AKTIV:=BUF [66] = 'J'; %FREI:=FALSE $END; (* WITH DF *) #PUT(DF); #IF NOT NEUSATZ THEN $BEGIN NEUSATZ:=TRUE; %SEEK(DF,0); ISKWECHSEL(2,'DIE AKTUELLE DATENDISKETTE'); $WDH:=TRUE " END "ELSE #BEGIN $ABGESCHL:=DF^.ABGESCHLOSSEN; ! IF ABGESCHL THEN NFREISATZNR:=DF^.NFREISATZNR $ELSE NFREISATZNR:=1; $VOLL:=NFREISATZNR>SATZNRMAX; $IF VOLL THEN %BEGIN &REPEAT PAGE(OUTPUT); 'WRITEXY(4,1,'DIE DISKETTE IST VOLL.'); 'WRITEXY(4,2,'WUENSCHEN SIE EINE ANDERE? '); 'NEXTCH; WRITE(LC); 'WDH:=LC='J' &UNTIL LC IN ['J','N']; &IF WDH THEN 'BEGIN CLOSE(DF); (DISKWECHSEL(2,'DIE NEUE DATENDISKETTE') 'END; %END (* IF VOLL *) #!UNTIL C IN ['J','N']  END;   FUNCTION BOOLESC;  BEGIN !REPEAT "WRITE(S,'? (J,N,)'); NEXTCH; WRITELN; "BOOL:=(LC='J') OR ESC !UNTIL (LC IN ['J','N']) OR ESC  END;  PROCEDURE WRITEXY;  BEGIN !GOTOXY(X,Y); !WRITE(S)  END;   PROCEDUR P.A.TEXT *)   (**************************************)   FUNCTION CR;  VAR C:CHAR;  BEGIN !WRITE(S,'? '); READ(C); WRITELN; !CR:=C  END;   FUNCTION BOOL;  VAR C:CHAR;  BEGIN !REPEAT "WRITE(S,'? (J,N)'); READ(C); WRITELN; "BOOL:=C='J' ***********************)   (* SICHERN ,ERFASSEN, KONTROLLIEREN *) !  (*$I P.S.TEXT *)   (**************************************)   (* UEBERTRAGEN *)   (*$I P.U.TEXT *)   (**************************************)   (* ANFRAGE *)   (*$I DISKWECHSEL (DRIVE:INTEGER; S:STRING); !FORWARD; !  PROCEDURE SUCHE; EXTERNAL;   FUNCTION CR(S:STRING):CHAR;  FORWARD;   FUNCTION BOOL(S:STRING):BOOLEAN;  FORWARD;   FUNCTION BOOLESC(S:STRING):BOOLEAN;  FORWARD;  !  (***************!  (* DATENSTRUKTUR *)   (*$I P.D.TEXT *) !  PROCEDURE FORM (S:STRING; LOESCH:BOOLEAN); FORWARD;   PROCEDURE ERGAENZUNG (S:STRING); FORWARD;   PROCEDURE NEXTCH; FORWARD; !  PROCEDURE WRITEXY (X,Y:INTEGER; S:STRING); !FORWARD; !  PROCEDUREFORM1 FORM2 T1 T2 M1A M1E M2A M2E ;EN^Q&HLOSSEN:=TRUE; #DF^.NFREISATZNR:=NFREISATZNR; #PUT(DF); "END; (* IF NEUSATZ *) !CLOSE(DF);  ESC:=FALSE  END; (* PROCEDURE ERFKONTR *) # #SATZNR:=NFREISATZNR; #NEXTCH; #IF LC IN ['E','K'] THEN $BEGIN %KONTR:=VOLL OR NOT ABGESCHL OR (LC='K'); %KONTROLLE; %PAGE(OUTPUT) $END; #IF LC='?' THEN ERGAENZUNG('E'); "END; (* WHILE NOT ESC *) !IF NEUSATZ THEN "BEGIN SEEK(DF,0); #DF^.ABGESCEND (* IORESULT=0 *) !UNTIL ESC OR ((IORESULT=0) AND NOT WDH); !WHILE NOT ESC DO "BEGIN #IF NOT ABGESCHL THEN $BEGIN FORM('ENA',TRUE); $NEXTCH #END; #FORM('E',TRUE); #IF VOLL OR NOT ABGESCHL THEN $WRITEXY(08,12,'NUR "KONTROLLE" ZULAESSIG.'); E FORM; !(* SCHREIBT EINEN TEXT VON EINEM FILE !AUF DEN SCHIRM. VERWENDUNG: VOR ALLEM FUER !ERKLAERENDE TEXTE. DER SCHIRM WIRD AUF WUNSCH !GELOESCHT *)  VAR FF:FILE OF RECORD (ZNR:INTEGER; (TXT:STRING [40] 'END;  BEGIN !(*$I-*) !RESET(FF,CONCAT('SYS.',S)); !IF LOESCH THEN PAGE(OUTPUT); !WHILE NOT EOF(FF) DO "BEGIN GOTOXY(0,FF^.ZNR); #WRITE(FF^.TXT,CHR(29)); #GET(FF) "END; !CLOSE(FF)  (*$I+*)  END; !  PROCEDURE ERGAENZUNG;  VAR FF:FILE OF RECORD (ZNR:INTEGER; (TXT:STRING [40] 'END; (*$S+*)  PROGRAM AKS;  (*$C(C)ZEMA GESMBH,M WEISSENBOECK;WIEN1980*)  CONST QULAENGE=20; (* QUELLE *) &NALAENGE=20; (* NAME *) &SILAENGE=9; (* SIGNATUR *)  MAXSEITE=32767; (* HOECHSTE SEITENNUMMER *)  SATZNRMAX=2500; (* HOEC FORM1 FORM2 T1 T2 M1A M1E M2A M2E M1 M2 N^Q&NFRAGE; "END !UNTIL ESC; !PAGE(OUTPUT); !WRITEXY(0,12,'SIE KOENNEN JETZT AUSSCHALTEN ODER'); !WRITEXY(0,15,'MIT "RESET" WIEDER STARTEN.'); !WRITE(CHR(7),CHR(7),CHR(7)); !FOR I:=1 TO 2000 DO;  END. ! " #  BEGIN (* HAUPTPROGRAMM AUSKUNFT *) !PAGE(OUTPUT); !FORM('GRUSS',TRUE); !NEXTCH; !IF LC='J' THEN ERGAENZUNG('GR'); !REPEAT "FORM('0',TRUE); "NEXTCH; "CASE LC OF #'E': ERFKONTR; #'S': SICHERN; #'?': ERGAENZUNG('0'); " 'U': UEBERTRAGEN; #'A': AAR ? *) !ESC:=LCT=ESCAPE  END; (* PROCEDURE NEXTCH *)   PROCEDURE DISKWECHSEL;  BEGIN !FORM('DW',TRUE); !GOTOXY(37,07); !WRITE(DRIVE:2); !WRITEXY(4,13,S); !WRITE(CHR(7)); !NEXTCH;  PAGE(OUTPUT);  END; (* PROCEDURE DISKWECHSEL *)  ; (* CTRL-M *) ' 9: LCT:=CURUP; (* CTRL-I *) '20: LCT:=NZIT; (* CTRL-T *) '27: LCT:=ESCAPE;(* CTRL-[ ODER ESC *) '14: LCT:=NSATZ; (* CTRL-N *) '12: LCT:=LSATZ; (* CTRL-L *) '23: LCT:=WSATZ; (* CTRL-W *) &END (* CASE ORD(LC) *) %END; (* CONTROL-CH"ELSE #IF LC IN ['0'..'9',' '] THEN LCT:=ZIFFER #ELSE $IF LC IN ['!'..'/','='..'@','['..'^'] %THEN LCT:=SZEICHEN $ELSE %BEGIN LCT:=UNDEF; &CASE ORD(LC) OF (8: LCT:=CURLI; (* CTRL-H ODER <- *) '21: LCT:=CURRE; (* CTRL-U ODER -> *) '13: LCT:=CURLF'WRITE(FF^.TXT); ZNRALT:=FF^.ZNR; 'GET(FF) $ END; %NEXTCH; PAGE(OUTPUT) $END; #CLOSE(FF); "END;  (*$I+*)  END;   PROCEDURE NEXTCH;  BEGIN !READ(KEYBOARD,LC); !IF LC IN ['A'..'Z'] THEN LCT:=BUCHST !ELSE "IF EOLN(KEYBOARD) THEN LCT:=CURLF  ZNRALT:INTEGER;  BEGIN !(*$I-*) !RESET(FF,CONCAT('SYS.',S,'/')); !IF IORESULT=0 THEN "BEGIN #PAGE(OUTPUT); #WHILE NOT EOF(FF) DO $BEGIN ZNRALT:=0; %WHILE (FF^.ZNR>=ZNRALT) AND NOT EOF(FF) DO $ BEGIN GOTOXY(0,FF^.ZNR); HSTE SATZNUMMER PRO DISKETTE *)  ORD0=48; (* ORD('0') *) &NAMINDMAX= 3001; &SIGINDMAX= 2039; &QUEINDMAX= 0307;  HASHFAKTOR= 23;  TYPE  CHSET=SET OF CHAR; !CHTYP=(BUCHST,ZIFFER,SZEICHEN, "CURLI, (* CURSOR NACH LINKS, CTRL-H *) "CURRE, (* CURSOR NACH RECHTS,CTRL-U *) "CURLF, (* LINE FEED *) "CURUP, (* CURSOR NACH OBEN, CTRL-I *) "NZIT, (* NAECHSTES ZITAT, D.H. +1000, CTRL-T *) "ESCAPE, "NSATZ, (* NAECHSTER SATZ, CTRL-N *) "LSATZ, (* LETZTERER SATZ, CTR!(*-----------------------------------------------------*)  ATUREN *) !NAMLISTE, (* LISTE DER NAMEN *) !SIGLISTE, (* LISTE DER SIGNATUREN *) !QUELISTE: (* LISTE DER QUELLEN *) 3ARRAY [1..10] OF PACKDATEN; .. *) !ADAT, (* ANFANGSDATUM *) !EDAT, (* ENDDATUM *) !QSUCH: PACKDATEN; (* SUCHBEGRIFFE *) ! !SMASK, (* MASKE FUER SIGN *) !NAMZAHL, (* ANZAHL DER NAMEN *) !SIGZAHL, (* ANZAHL DER SIGNATUREN *) !QUEZAHL: INTEGER; (* ANZAHL DER QUELLEN *) ! !QMASK, (* MASKE FUER QUEETC.!I: INTEGER; ! !(*-----GLOBALE GROESSEN FUER ASSEMBLERPROGRAMM---------*) !BUFPTR: ^DATENPUFFER; ! !STATUS, (* STATUS 0..4 *) !AIND, (* ANFANGSINDEX -- ACHTUNG!! *) ?(* --> BYTEINDEX <-- *) 8BOOLEAN; 0PARTEI: PARTEINAME)) (* BIT 9... 7 *) ')) "END;  "DATENPUFFER=ARRAY [0..2303] OF PACKDATEN;  VAR  LC: CHAR; (* LETZTES ZEICHEN *) !LCT: CHTYP; (* TYP DES LETZTEN ZEICHENS *) !DF: FILE OF DATEN; !ESC: BOOLEAN; AX); (* BIT 15... 5 *) *QUEETC: +(CASE -BITFLAG: BOOLEAN OF .FALSE: /(QUEIND: 00..QUEINDMAX); (* BIT 15... 4 *) .TRUE: /(ZITAT, (* BIT 4 *) 0KOMMENTAR, (* BIT 5 *) 0PARLAMENT: (* BIT 6 7 *) ,MONAT: 00..12); (* BIT 15...12 *) *NAMDATEN: +(AKTIV: BOOLEAN; (* BIT 3 *) ,NAMIND: 00..NAMINDMAX); (* BIT 15... 4 *) *SIGDATEN: +(BEWERTUNG: BEWART; (* BIT 4... 3 *) ,SIGIND: 00..SIGINDM%CASE INTEGER OF &0: '(SEITE: 00..MAXSEITE); (* BIT 15... 1 *) &1: '(CASE )ART: SATZART OF (* BIT 2... 1 *) *DATUMETC: +(OFFSET: 00..15; (* BIT 6... 3 *) ,TAG: 00..31; (* BIT 11...ANGEGEBEN. DIE BITS WERDEN VON 15 BIS 0 $NUMMERIERT *) ! !PACKDATEN=PACKED RECORD "CASE BOOLEAN OF " FALSE: $(BITS: SET OF 0..15); #TRUE: $(SEITENFLAG: BOOLEAN; (* BIT 0 *) 8(* TRUE...SEITE *) 8(* FALSE..REST *) UEBERTRAGEN: 3BOOLEAN; (RESERVE: SET OF 0..4 'END) "END; ! !SATZART= (QUEETC,NAMDATEN, "SIGDATEN,DATUMETC); ! !(* DIESE DATENSTRUKTUR WURDE IN HINBLICK AUF DAS ASSEMBLER- $UNTERPROGRAMM FESTGELEGT. FUER JEDES DATENELEMENT WIRD $DIE BITNUMMER OF CHAR; &NAME: PACKED ARRAY [1..NALAENGE] OF CHAR; &SIGNATUR: PACKED ARRAY [1..SILAENGE] OF CHAR; &KENNZEICHEN: (* 2 BYTES *) 'PACKED RECORD (BEWERTUNG: BEWART; (ZITAT, PARLAMENT: 3BOOLEAN; (PARTEI: PARTEINAME; (KOMMENTAR,AKTIV,FREI,"PACKED RECORD CASE INTEGER OF #0:(ERSTER, NFREISATZNR: INTEGER; &ERSTDATUM: DATE; &ABGESCHLOSSEN, GESICHERT: BOOLEAN); #1:(STELLE: (* 4 BYTES *) 'RECORD (DATUM: DATE; (SEITE: 000..MAXSEITE; 'END; &QUELLE: PACKED ARRAY [1..QULAENGE] L-L *) "WSATZ, (* WELCHER SATZ, CTRL-W *) "UNDEF); !BEWART=(POS,NEG,NEUT,OBEW); !PARTEINAME=(VP,SP,FP,OP,RES1,RES2,RES3,RES4);  DATE= "PACKED RECORD #JAHR: 00..100; #MONAT:00..12; #TAG: 00..31 "END; !DATEN= (* 56 BYTES *) #UNTIL (I>10) OR (ERSTERVERSUCH AND (LENGTH(S)=0)); #ERSTERVERSUCH:=FALSE; #GOTOXY(0,23) "UNTIL BOOLESC('SIND SIE DAMIT EINVERSTANDEN'); "IF ESC THEN EXIT(AUSGABE) !END;   PROCEDURE CHWERT(VAR Z:CHAR; BEZEICHNUNG:STRING; !BEREICH:CHSET);  VAR V:ENTRIEREN *) #FOR I:=1 TO 10 DO $BEGIN %WRITELN; %WRITELN(I:3,'.',BEZEICHNUNG,': ',LI[I]); $END; #I:=1; #REPEAT GOTOXY(LENGTH(BEZEICHNUNG)+6,2*I); $INSTR(S); $IF LENGTH(S)>0 THEN %IF S[1]=' ' THEN LI[I]:='' %ELSE &LI[I]:=S; $I:=I+1 LN(CHR(29)) ! ELSE WRITELN !END; ! !PROCEDURE LISTE(VAR LI:STRA; UEBERSCHRIFT, BEZEICHNUNG: STRING); !VAR I:INTEGER; %S:STRING; ! ERSTERVERSUCH: BOOLEAN; !BEGIN  ERSTERVERSUCH:=TRUE; "REPEAT #PAGE(OUTPUT); #WRITELN(UEBERSCHRIFT); (* EVT ZRMULIEREN;  !PROCEDURE INSTR(VAR S:STRING); !VAR C:CHAR; %I:INTEGER; !BEGIN "S:=''; "READ(KEYBOARD,C); "WHILE NOT EOLN(KEYBOARD) DO #BEGIN $WRITE(C); $S:=CONCAT(S,' '); $S[LENGTH(S)]:=C; $READ(KEYBOARD,C); ! END; "IF LENGTH(S)>0 THEN WRITE#AKTQUELISTE [I]:=''; #AKTSIGLISTE [I]:='';  END; !KOMMCH:='N'; !ZITATCH:='N'; !PARLCH:='*'; !PARTEICH:='*'; !FRCH:='P'; !FRCH1:='P'; !ADATJ:=80; ADATM:= 1; ADATT:=1; !EDATJ:=99; EDATM:=12; EDATT:=31; !NEUFRAGE:=TRUE;  END;   PROCEDURE FOTEGER; ! !WEITER, !NEUFRAGE, !INDEF: BOOLEAN;(* INDEX DEFINIERT *)  PREFIX: STRING[3]; !FRCH,FRCH1: CHAR; !    PROCEDURE INITIAL;  VAR I:INTEGER;  BEGIN !FOR I:=1 TO 10 DO "BEGIN " AKTNAMLISTE [I]:=''; ANFANGSDATUM, JAHR *) !ADATM, (* D.G. MONAT *) !ADATT, (* D.G. TAG *) !EDATJ, (* ENDDATUM, JAHR *) !EDATM, (* D.G. MONAT *) !EDATT, (* D.G. TAG *) !TREFFER: INISTE: STRA; (* LISTE DER AKTUELLEN SIGNATUREN *)  !KOMMCH, (* KOMMENTAR-CHARACTER *) !ZITATCH, (* ZITZAT *)  PARLCH, (* PARLAMENT *) !PARTEICH: CHAR; (* PARTEI *) ! !ADATJ, (* (*************************************)  SEGMENT PROCEDURE ANFRAGE;   TYPE STRA=PACKED ARRAY[1..10] OF STRING[20];   VAR !AKTNAMLISTE, (* LISTE DER AKTUELLEN NAMEN *)  AKTQUELISTE, (* LISTE DER AKTUELLEN QUELLEN *) !AKTSIGL FORM1 FORM2 T1 T2 M1A M1E M2A M2E M1 M2  +.N^Q&STRING; OK:BOOLEAN;  BEGIN !REPEAT "WRITELN; "WRITE(BEZEICHNUNG,': ',Z,CHR(8)); "INSTR(V); "OK:=LENGTH(V)=0; "IF NOT OK THEN OK:=V[1] IN BEREICH;  UNTIL OK; !IF LENGTH(V)=1 THEN Z:=V[1];  END;   PROCEDURE INTWERT(VAR I:INTEGER; BEZEICHNUNG:STRING; !UGR, OGR:INTEGER);  VAR V,J:INTEGER; !OK:BOOLEAN; !S:STRING;  BEGIN !REPEAT "WRITELN; "WRITE(BEZEICHNUNG,': ',I:2,CHR(8),CHR(8)); "INSTR(S); "OK:=TRUE; "V:=0; J:=1; "WHILE OK AND (J<=LENGTH(S)) DO #BEGIN $OK:=S[J] IN ['0'..'9',' ']; $(HASH:=(HASH+1) MOD NAMINDMAX 'ELSE (BEGIN ENDE:=TRUE; )NAMZAHL:=NAMZAHL+1; )WITH NAMLISTE[NAMZAHL] DO *BEGIN +BITS:=[]; +SEITENFLAG:=FALSE; +ART:=NAMDATEN; +AKTIV:=AKTNAMLISTE[I,L] <> '@'; +NAMIND:=HASH *END & END; &UNTIL ENDE OR (NOT NAMDENAMINDMAX; &ENDE:=FALSE; &REPEAT 'SEEK(F,HASH); 'GET(F); 'IF F^=SP20 THEN NAMDEF[I]:=FALSE; 'GLEICH:=TRUE; 'K:=1; 'WHILE (K<=L1) AND (K<=20) AND GLEICH DO (BEGIN GLEICH:=AKTNAMLISTE[I,K]=F^[K]; )K:=K+1 (END; 'IF NOT GLEICH THEN FOR I:=1 TO 10 DO #BEGIN $HASH:=0; $L:=LENGTH(AKTNAMLISTE[I]); $IF L>0 THEN %BEGIN &IF AKTNAMLISTE[I,L]='@' THEN L1:=L-1 &ELSE L1:=L; &FOR K:=1 TO L1 DO 'IF AKTNAMLISTE[I,K]<>' ' THEN (HASH:=(HASH*HASHFAKTOR + ORD(AKTNAMLISTE[I,K]) - ORD0) )MOD +QUEIND:=HASH *END & END &UNTIL ENDE OR (NOT QUEDEF[I]) %END #END; "CLOSE(F) !END;  !PROCEDURE NAMSUCHEN; !VAR I,K,L,L1,HASH: INTEGER; "ENDE,GLEICH: BOOLEAN; "F:FILE OF PACKED ARRAY[1..20] OF CHAR; !BEGIN "RESET(F,'NAMEN'); "NAMZAHL:=0; ")GLEICH:=AKTQUELISTE[I,K]=F^[K]; ' K:=K+1 (END; 'IF NOT GLEICH THEN (HASH:=(HASH+1) MOD QUEINDMAX 'ELSE (BEGIN ENDE:=TRUE; )QUEZAHL:=QUEZAHL+1; )WITH QUELISTE[QUEZAHL] DO *BEGIN +BITS:=[]; +SEITENFLAG:=FALSE; +ART:=QUEETC; +BITFLAG:=FALSE; ISTE[I,K]<>' ' THEN (HASH:=(HASH*HASHFAKTOR + ORD(AKTQUELISTE[I,K]) - ORD0) )MOD QUEINDMAX; &ENDE:=FALSE; &REPEAT 'SEEK(F,HASH); 'GET(F); 'IF F^=SP20 THEN QUEDEF[I]:=FALSE; 'GLEICH:=TRUE; 'K:=1; 'WHILE (K<=L)AND (K<=20) AND GLEICH DO (BEGIN !VAR I,K,L,HASH: INTEGER; "ENDE,GLEICH: BOOLEAN; "F:FILE OF PACKED ARRAY[1..20] OF CHAR; !BEGIN "RESET(F,'QUELLEN'); "QUEZAHL:=0; "FOR I:=1 TO 10 DO #BEGIN $HASH:=0; $L:=LENGTH(AKTQUELISTE[I]); $IF L>0 THEN %BEGIN &FOR K:=1 TO L DO 'IF AKTQUELRAGE); !NEUFRAGE:=NEUFRAGE OR (FRCH<>FRCH1); !FRCH1:=FRCH;  END; (* FORMULIERUNG *)   PROCEDURE INDEXSUCHEN;  CONST SP20=' ';  TYPE DEF=PACKED ARRAY[1..10]OF BOOLEAN;  VAR NAMDEF, QUEDEF, SIGDEF: DEF; ! !PROCEDURE QUESUCHEN;  CHWERT(PARTEICH,'PARTEI (V,S,F,0,*)',['V','S','F','0','*']);  WRITELN; "UNTIL BOOLESC('SIND SIE DAMIT EINVERSTANDEN'); "IF ESC THEN EXIT(ANFRAGE); "WRITELN !UNTIL (NOT BOOLESC('WUENSCHEN SIE EINE WIEDERHOLUNG')) OR ESC; !IF ESC THEN EXIT(ANFATUREN UND BEWERTUNGEN', #'SIG; BEW(+,-,0,*)'); "REPEAT #PAGE(OUTPUT); #CHWERT(KOMMCH, 'KOMMENTAR (J,N,*)',['J','N','*']); #CHWERT(ZITATCH, 'ZITAT (J,N,*)',['J','N','*']); #CHWERT(PARLCH, 'PARLAMENT (J,N,*)',['J','N','*']); ATUM - MONAT',1,12);  INTWERT(EDATT,'ENDDATUM - TAG ',1,31);  LISTE(AKTQUELISTE,'LISTE DER ZU BERUECKSICHTIGENDEN QUELLEN','QUELLE'); "LISTE(AKTNAMLISTE,'LISTE DER NAMEN; "@" BEDEUTET "PASSIV"','NAME');  LISTE(AKTSIGLISTE,'LISTE DER SIGNX:='BPL'; #'P': PREFIX:='PAR' "END; "WRITELN; "INTWERT(ADATJ,'ANFANGSDATUM - JAHR ',0,99); "INTWERT(ADATM,'ANFANGSDATUM - MONAT',1,12);  INTWERT(ADATT,'ANFANGSDATUM - TAG ',1,31); "INTWERT(EDATJ,'ENDDATUM - JAHR ',0,99); "INTWERT(EDATM,'ENDD!REPEAT "PAGE(OUTPUT); "WRITELN('FORMULIEREN DER ABFRAGE'); "WRITELN; "WRITELN('ABFRAGE AUS WELCHEM DATENBESTAND?'); "CHWERT(FRCH,'PARLAMENT/BUNDESPARTEILEITUNG (P,B,)',['B','P',CHR(27)]); "IF ESC THEN EXIT(ANFRAGE); "CASE FRCH OF #'B': PREFIIF S[J] IN ['0'..'9'] THEN %V:=V*10 + ORD(S[J])-ORD0; $J:=J+1 #END; "IF ((VOGR)) AND (LENGTH(S)>0) THEN OK:=FALSE; "IF NOT OK THEN WRITELN('EINGABEFEHLER!') !UNTIL OK; !IF LENGTH(S) > 0 THEN I:=V  END;   BEG