(* $f- $n- $r- $s- $v- *) (************************************) (* *) (* graph V 2.01 22-aug-1989 *) (* *) (* (C) by Lothar Schwab *) (* created by Lothar Schwab *) (* *) (************************************) MODULE graph; FROM SYSTEM IMPORT ADR , FFP , ADDRESS; FROM Arts IMPORT TermProcedure; FROM Intuition IMPORT NewScreen , Screen , ScreenPtr , ScreenFlagSet , ScreenFlags , OpenScreen , CloseScreen ; FROM Graphics IMPORT TextAttrPtr , ViewModeSet , ViewModes , RastPort , RastPortPtr , Draw , Move , SetAPen , ClearScreen , ViewPort , ViewPortPtr , SetRGB4; FROM analyse IMPORT fehler , position , ok , x , y , z , varanzahl , varfeld , abhfeld , maxvar , codezeiger , knotenzeiger, parser , codegen , funktion , loesche , codeanf , codeloe , ableitung , fehlertypen , infix; FROM InOut IMPORT Read , WriteString , WriteLn , eol , Write , ReadInt , WriteInt , ReadString , WriteHex ; FROM FFPInOut IMPORT ReadReal , WriteReal; FROM MathTrans IMPORT Sin , Cos; CONST breite = 640; (* Hohe Auflösung *) hoehe = 512; (* volle PAL - Auflösung, Interlace *) zeichenzahl = 4096; (* 4096 Zeichen für die Funktion *) loeschen = CHAR ( 12 ); (* Dieses Zeichen löscht den Bildschirm *) maxabstand = 30.; TYPE string = ARRAY [0 .. zeichenzahl] OF CHAR; grafikdatentyp = RECORD ywerte : ARRAY [ 0 .. 2000 ] OF FFP; definiert : ARRAY [ 0 .. 2000 ] OF BOOLEAN; END (* RECORD *); longptr = POINTER TO LONGINT; VAR meinscr : NewScreen; (* Datenstruktur zum eröffnen des Screens*) handle : ScreenPtr; (* Zeiger auf Screenstruktur *) meinrpp : RastPortPtr; (* Rastport des Screens *) meinview : ViewPortPtr; (* Viewport des Screens *) eingabe : string; (* Da kommt der String des Anwenders rein*) xk , yk : INTEGER; x0 , y0 : FFP; (* linke untere Ecke des Bildschirms *) x1 , y1 : FFP; (* rechte obere Ecke des Bildschirms *) dx , dy : FFP; yf , summe : FFP; deltahalbe : FFP; helfer : FFP; deltax : FFP; parastep : FFP; alt : FFP; pv , pb : FFP; z1 , z2 : CHAR; (* Zeichen zum Einlesen der Menüpunkte *) f , g : knotenzeiger;(* Zeiger auf Baum der Funktion *) fstrich : knotenzeiger;(* Zeiger auf Baum der Ableitung *) fzwei : knotenzeiger;(* Zeiger auf Baum der 2. Ableitung *) abakus : codezeiger; (* UPN-Code für die Funktion *) abakusg : codezeiger; abakusstrich : codezeiger; (* UPN-Code für die Ableitung *) abakuszwei : codezeiger; (* UPN-Code für die 2. Ableitung *) ende : BOOLEAN; (* Der Benutzer hat keine Lust mehr *) illquan : BOOLEAN; (* Berechnung war nicht möglich *) stetig : BOOLEAN; index : CARDINAL; (* Zum Abzählen bis zum Fehlerort *) grafikdaten : grafikdatentyp; defstatus : BOOLEAN; pixstatus : BOOLEAN; hilfsptr : longptr; PROCEDURE termproc; BEGIN CloseScreen ( handle ); codeloe ( abakuszwei ); codeloe ( abakusstrich ); codeloe ( abakus ); codeloe ( abakusg ) END termproc; PROCEDURE menue; BEGIN Write ( loeschen ); WriteString ( 'Menü:' ); WriteLn; WriteLn; WriteString ( 'e --> Funktion eingeben' ); WriteLn; WriteString ( 'v --> untere Grenze von x ( von )' ); WriteLn; WriteString ( 'b --> obere Grenze von x ( bis )' ); WriteLn; WriteString ( 'u --> untere Grenze von y' ); WriteLn; WriteString ( 'o --> obere Grenze von y' ); WriteLn; WriteString ( 'Y --> y - Variable eingeben' ); WriteLn; WriteString ( 'Z --> z - Variable eingeben' ); WriteLn; WriteString ( 'k --> Kontrollausgabe der Grenzen' ); WriteLn; WriteString ( 's --> Standartgrenzen' ); WriteLn; WriteString ( '< --> kleine Grenzen' ); WriteLn; WriteString ( '- --> Winkel an von/bis anpassen' ); WriteLn; WriteString ( 'f --> Funktion zeichnen' ); WriteLn; WriteString ( 'a --> Ableitung zeichen' ); WriteLn; WriteString ( '2 --> 2. Ableitung zeichnen' ); WriteLn; WriteString ( 'i --> Stammfunktion ( Integral )' ); WriteLn; WriteString ( 'p --> Polarkoordinaten Funktion' ); WriteLn; WriteString ( 'l --> Grafik löschen' ); WriteLn; WriteString ( 'w --> Winkelgrenzen Polarkoord.' ); WriteLn; WriteString ( '0 --> Standart-winkelgrenzen' ); WriteLn; WriteString ( 'z --> zweite Parametergleichung' ); WriteLn; WriteString ( 'h --> Stepwert (Parameter-Polar)' ); WriteLn; WriteString ( 'm --> Parameterdarstellung "malen"'); WriteLn; WriteString ( 't --> Programm beenden (tschühüß)' ); WriteLn; WriteString ( 'H --> Dieses Hilfsmenü' ); WriteLn END menue; PROCEDURE wstandart; BEGIN pv := 0.; pb := 6.28; parastep := 0.1; y := 0.0; z := 0.0 END wstandart; (* Unterprogramm, das Standartgrenzen einstellt, die eine Darstellung *) (* erlaubt, bei der eine Längeneinheit etwa ein cm auf der Bildschirmober- *) (* fläche bedeutet. *) PROCEDURE standartgrenzen; BEGIN x0 := -13.; x1 := 13.; y0 := -9.25; y1 := 9.25; dx := x1 - x0; dy := y1 - y0 END standartgrenzen; (* Dieses Unterprogramm bewegt den Grafikcursor zu den geforderten *) (* Koordinaten. Liegen diese außerhalb des Bildschirmes, so bleibt der *) (* Cursor am Bildschirmrand 'kleben' *) PROCEDURE move ( x , y : INTEGER ); BEGIN IF x < 0 THEN x := 0 END; IF x > 639 THEN x := 639 END; IF y < 0 THEN y := 0 END; IF y > 511 THEN y := 511 END; Move ( meinrpp , x , y ) END move; (* Unterprogramm, das eine Linie bis zum gewünschten Punkt zieht. *) (* Liegt der Endpunkt aber außerhalb des Bildschirmbereiches, so bleibt der*) (* Grafikcursor wieder am Bildschirmrand kleben. *) PROCEDURE draw ( x , y : INTEGER ); BEGIN IF x < 0 THEN x := 0 ELSIF x > 639 THEN x := 639 END; IF y < 0 THEN y := 0; pixstatus := FALSE; ELSE IF y > 511 THEN y := 511; pixstatus := FALSE; ELSE pixstatus := TRUE; END END; IF defstatus THEN Draw ( meinrpp , x , y ); IF NOT ( pixstatus ) THEN defstatus := FALSE END ELSE IF pixstatus THEN Draw ( meinrpp , x , y ); defstatus := TRUE ELSE Move ( meinrpp , x , y ) END END END draw; PROCEDURE achsen; BEGIN (* Koordinatenachsen zeichnen *) SetAPen ( meinrpp , 1 ); IF ( x0 <= 0. ) AND ( x1 >= 0. ) THEN xk := TRUNC ( (-x0) / dx * 640. ); move ( xk , 0 ); draw ( xk , 511 ) END (* IF *); illquan := FALSE; IF ( y0 <= 0. ) AND ( y1 >= 0. ) THEN yk := TRUNC ( (-y0) / dy * 512. ); yk := 511 - yk; move ( 0 , yk ); draw ( 639 , yk ) END (* IF *) END achsen; (* Dieses Unterprogramm plottet die gewünschte Funktion *) PROCEDURE plot ( abakus : codezeiger ); BEGIN (* Funktion plotten *) x := x0; yf := funktion ( abakus ); xk := 0; yk := 511 - TRUNC ( ( yf- y0 ) / dy * 512. ); move ( xk , yk ); FOR xk := 0 TO 639 DO x := dx / 640. * FFP ( xk ) + x0; yf := funktion ( abakus ); yf := ( ( yf- y0 ) / dy * 512. ); IF ABS ( yf ) > 32000. THEN ok := FALSE ELSE yk := 511 - TRUNC ( yf ) END (* IF *); IF ok THEN IF illquan THEN move ( xk , yk ); illquan := FALSE ELSE draw ( xk , yk ) END (* IF *) ELSE illquan := TRUE END (* IF *) END (* FOR *); achsen END plot; PROCEDURE lese ( VAR eingabe : string ; VAR f : knotenzeiger ); BEGIN REPEAT WriteString ( 'Bitte geben Sie eine Funktion ein.' ); WriteLn; ReadString ( eingabe ); parser ( eingabe , f ); WriteString ( 'Addresse der Baumaddresse: ' ); hilfsptr := ADR ( f ); WriteHex ( hilfsptr^ , 8 ); WriteLn; IF NOT ok THEN loesche ( f ); FOR index := 1 TO position DO Write ( ' ' ) END (* FOR *); Write ( '|' ); WriteLn; CASE fehler OF klammerauferwartet : WriteString ( '( erwartet.' ) | klammerzuerwartet : WriteString ( ') erwartet.' ) | quatsch : WriteString ( 'Vorzeichen, Operator, Funktion, Zahl, '); WriteString ( 'Variable oder Konstante erwartet.' ) | woistdastermende : WriteString ( 'Ende des Termes erwartet.' ) | falscherindex : WriteString ( 'Index außerhalb des zugelassenen Bereiches.' ); END (* CASE *); WriteLn END (* IF *); UNTIL ok END lese; BEGIN (* des Hauptprogrammes *) (* Es folgen blöde Initialisierungsarbeiten für den Bildschirm *) meinscr.leftEdge := 0; meinscr.topEdge := 0; meinscr.width := breite; meinscr.height := hoehe; meinscr.depth := 2; meinscr.detailPen := 0; meinscr.blockPen := 0; meinscr.viewModes := ViewModeSet { genlocVideo , hires , lace }; meinscr.type := ScreenFlagSet { wbenchScreen , showTitle }; meinscr.font := NIL; meinscr.defaultTitle := ADR ( 'Funktionenplotter !!' ); meinscr.gadgets := NIL; meinscr.customBitMap := NIL; handle := OpenScreen ( meinscr ); meinrpp := ADR ( handle^.rastPort ); meinview := ADR ( handle^.viewPort ); (* Zeiger auf Viewport *) SetRGB4 ( meinview , 0 , 0 , 0 , 0 ); (* Hintergrund schwarz *) SetRGB4 ( meinview , 1 , 6 , 6 , 6 ); (* Funktion dunkelgrau *) SetRGB4 ( meinview , 2 , 8 , 8 , 8 ); (* Ableitung mittelgrau *) SetRGB4 ( meinview , 3 , 10 , 10 , 10 ); (* zweite Ableitung grau *) codeanf ( abakuszwei ); codeanf ( abakusstrich ); codeanf ( abakus ); codeanf ( abakusg ); TermProcedure ( termproc ); hilfsptr := ADR ( f ); hilfsptr^ := NIL; hilfsptr := ADR ( g ); hilfsptr^ := NIL; hilfsptr := ADR ( fstrich ); hilfsptr^ := NIL; hilfsptr := ADR ( fzwei ); hilfsptr := NIL; (* Defaultbelegungen *) ende := FALSE; standartgrenzen; wstandart; varfeld [0] := 0.5772156649; varfeld [1] := 0.915965594; menue; REPEAT (* Hauptschleife, die durchläuft, bis der Benutzer enden will *) WriteString ( 'Ihre Auswahl: ' ); Read ( z1 ); REPEAT Read ( z2 ) UNTIL z2 = eol; CASE z1 OF | 'e' : lese ( eingabe , f ); infix ( eingabe , f ); IF ok THEN WriteString ( 'Die Funktion lautet:' ); WriteLn; WriteString ( eingabe ) ELSE WriteString ( 'Fehler: Funktion nicht druckbar.' ) END (* IF *); WriteLn; codegen ( abakus , f ); IF NOT ( ok ) THEN WriteString ( 'Die Funktion ist zu komplex und steht ' ); WriteString ( 'daher nicht zur Verfügung !!' ) END (* IF *); WriteLn; ableitung ( f , fstrich , CHAR ( 253 ) ); IF ok THEN infix ( eingabe , fstrich ); IF ok THEN WriteString ( 'Die Ableitung lautet:' ); WriteLn; WriteString ( eingabe ) ELSE WriteString ( 'Fehler. Ableitung nicht druckbar.' ) END (* IF *); WriteLn; codegen ( abakusstrich , fstrich ); IF NOT ( ok ) THEN WriteString ( 'Die Ableitung ist zu komplex und steht ' ); WriteString ( 'daher nicht zur Verfügung !!' ) END (* IF *); WriteLn; ableitung ( fstrich , fzwei , CHAR ( 253 ) ); IF ok THEN infix ( eingabe , fzwei ); IF ok THEN WriteString ( 'Die 2. Ableitung lautet:' ); WriteLn; WriteString ( eingabe ) ELSE WriteString ( 'Fehler. 2. Ableitung nicht druckbar.' ) END (* IF *); WriteLn; codegen ( abakuszwei , fzwei ); IF NOT ( ok ) THEN WriteString ( 'Die 2. Ableitung ist zu komplex und steht ' ); WriteString ( 'daher nicht zur Verfügung !!' ) END (* IF *); WriteLn ELSE WriteString ( 'Das Ableiten hat nicht geklappt. Die ' ); WriteString ( '2. Ableitung steht nicht zur Verfügung !!' ); WriteLn; END (* IF *); ELSE WriteString ( 'Das Ableiten hat nicht geklappt. Die ' ); WriteString ( 'Ableitung steht nicht zur Verfügung !!' ); WriteLn; END (* IF *); loesche ( f ); loesche ( fstrich ); loesche ( fzwei ) | 'v' : WriteString ( 'untere x-Grenze eingeben. ' ); ReadReal ( x0 ); WriteLn; dx := x1 - x0 | 'b' : WriteString ( 'obere x-Grenze eingeben. ' ); ReadReal ( x1 ); WriteLn; dx := x1 - x0 | 'u' : WriteString ( 'untere y-Grenze eingeben. ' ); ReadReal ( y0 ); WriteLn; dy := y1 - y0 | 'o' : WriteString ( 'obere y-Grenze eingeben. ' ); ReadReal ( y1 ); WriteLn; dy := y1 - y0 | 'Y' : WriteString ( 'y - Variable eingeben: ' ); ReadReal ( y ); WriteLn | 'Z' : WriteString ( 'z - Variable eingeben: ' ); ReadReal ( z ); WriteLn | 'k' : WriteLn; WriteString ( 'x: von ' ); WriteReal ( x0 , 10 , 5 ); WriteString ( ' bis ' ); WriteReal ( x1 , 10 , 5 ); WriteLn; WriteString ( 'y: von ' ); WriteReal ( y0 , 10 , 5 ); WriteString ( ' bis ' ); WriteReal ( y1 , 10 , 5 ); WriteLn; WriteLn; WriteString ( 'pv: ' ); WriteReal ( pv , 10 , 5 ); WriteLn; WriteString ( 'pb: ' ); WriteReal ( pb , 10 , 5 ); WriteLn; WriteString ( 'Pstep: ' ); WriteReal ( parastep , 10 , 5 ); WriteLn; WriteLn; WriteString ( 'y - Variable: ' ); WriteReal ( y , 10 , 5 ); WriteLn; WriteString ( 'z - Variable: ' ); WriteReal ( z , 10 , 5 ); WriteLn; WriteLn; WriteString ( "maxvar: " ); WriteInt ( maxvar , 1 ); WriteLn; WriteString ( "abakus: " ); WriteHex ( ADR ( abakus ) , 8 ); WriteLn; WriteString ( "abakus': " ); WriteHex ( ADR ( abakusstrich ) , 8 ); WriteLn; WriteString ( "abakus'': " ); WriteHex ( ADR ( abakuszwei ) , 8 ); WriteLn; WriteString ( "abakusg: " ); WriteHex ( ADR ( abakusg ) , 8 ); WriteLn; | 'l' : move ( 0 , 6 ); (* Achtung: Ein move ( 0 , 0 ) mit *) (* anschließenden ClearScreen *) (* bringt den Rechner früher oder *) (* später zum Absturtz. Auch bei *) (* move ( 0 , 6 ) wird dann der *) (* ganze (!) Bildschirm gelöscht *) (* weiß der Guru warum ! *) ClearScreen ( meinrpp ); | 'f' : SetAPen ( meinrpp , 1 ); plot ( abakus ) | 'i' : SetAPen ( meinrpp , 1 ); deltax:= dx / 640.; x := x0; summe := 0.; ok := TRUE; deltahalbe := deltax / 2.; stetig := TRUE; alt := funktion ( abakus ); FOR xk := 0 TO ( breite - 1 ) DO grafikdaten.definiert [xk] := ok; IF ok THEN grafikdaten.ywerte [xk] := summe END (* IF *); helfer := funktion ( abakus ); IF ok THEN IF ( ABS ( helfer - alt ) > maxabstand ) AND ( helfer > y0 ) AND ( helfer < y1 ) THEN stetig := FALSE END (* IF *); alt := helfer; x := x + deltahalbe; helfer := helfer + 4. * funktion ( abakus ); IF ok THEN x := x + deltahalbe; helfer := helfer + funktion ( abakus ); IF ok THEN summe := summe + deltax * helfer / 6. END (* IF *) ELSE x := x + deltahalbe END (* IF *) ELSE x := x + deltax END (* IF *) END (* FOR *); (* Stammfunktion in Bildmitte zentrieren *) IF ( x0 < 0. ) AND ( x1 > 0. ) AND ( y0 < 0. ) AND ( y1 > 0. ) THEN xk := TRUNC ( 0.5 - x0 * 640. / dx ); IF grafikdaten.definiert [xk] THEN helfer := grafikdaten.ywerte [xk]; FOR xk := 0 TO 639 DO grafikdaten.ywerte [xk] := grafikdaten.ywerte [xk] - helfer END (* FOR *) END (* IF *) END (* IF *); IF stetig THEN (* Funktion plotten *) x := x0; yf := grafikdaten.ywerte [0]; xk := 0; yk := 511 - TRUNC ( ( yf- y0 ) / dy * 512. ); move ( xk , yk ); FOR xk := 0 TO 639 DO x := dx / 640. * FFP ( xk ) + x0; yf := grafikdaten.ywerte [xk]; yf := ( ( yf- y0 ) / dy * 512. ); IF ABS ( yf ) > 32000. THEN ok := FALSE ELSE yk := 511 - TRUNC ( yf ) END (* IF *); IF grafikdaten.definiert [xk] THEN IF illquan THEN move ( xk , yk ); illquan := FALSE ELSE draw ( xk , yk ) END (* IF *) ELSE illquan := TRUE END (* IF *) END (* FOR *); achsen END (* IF *) | 'p' : SetAPen ( meinrpp , 2 ); x := pv; achsen; illquan := TRUE; REPEAT yf := funktion ( abakus ); IF ok THEN helfer := yf * Cos ( x ); yf := yf * Sin ( x ); IF ( helfer < x0 ) OR ( helfer > x1 ) THEN ok := FALSE END (* IF *); IF ( yf < y0 ) OR ( yf > y1 ) THEN ok := FALSE END (* IF *) END (* IF *); IF ok THEN xk := TRUNC ( ( helfer - x0 ) / dx * 640. ); yk := 511 - TRUNC ( ( yf- y0 ) / dy * 512. ); IF illquan THEN Move ( meinrpp , xk , yk ); illquan := FALSE ELSE Draw ( meinrpp , xk , yk ) END (* IF *) ELSE illquan := TRUE END (* IF *); x := x + parastep UNTIL ( ABS ( x - pb ) <= ( parastep*3. ) ); | 'a' : SetAPen ( meinrpp , 2 ); plot ( abakusstrich ) | '2' : SetAPen ( meinrpp , 3 ); plot ( abakuszwei ) | 's' : standartgrenzen | '<' : x0 := -1.48; x1 := 1.48; y0 := -1.05; y1 := 1.05; dx := x1 - x0; dy := y1 - y0 | '-' : pv := x0; pb := x1 | '0' : wstandart | 'w' : WriteString ( 'Startwinkel eingeben: ' ); ReadReal ( pv ); WriteLn; WriteString ( 'Endwinkel eingeben: ' ); ReadReal ( pb ); WriteLn | 't' : ende := TRUE | 'z' : lese ( eingabe , g ); codegen ( abakusg , g ); IF ok THEN WriteString ( 'gut. Funktion verstanden.' ) ELSE WriteString ( 'Fehler: Funktion ist zu komplex.' ) END (* IF *); loesche ( g ) | 'h' : WriteString ( 'Bitte geben sie den Parameter Stepwert ein.' ); WriteLn; ReadReal ( parastep ); WriteLn | 'm' : achsen; SetAPen ( meinrpp , 3 ); x := pv; illquan := TRUE; REPEAT yf := funktion ( abakus ); IF ok THEN helfer := funktion ( abakusg ); IF ok THEN IF ( helfer < x0 ) OR ( helfer > x1 ) THEN ok := FALSE END (* IF *); IF ( yf < y0 ) OR ( yf > y1 ) THEN ok := FALSE END (* IF *) END (* IF *) END (* IF *); IF ok THEN xk := TRUNC ( ( helfer - x0 ) / dx * 640. ); yk := 511 - TRUNC ( ( yf- y0 ) / dy * 512. ); IF illquan THEN Move ( meinrpp , xk , yk ); illquan := FALSE ELSE Draw ( meinrpp , xk , yk ) END (* IF *) ELSE illquan := TRUE END (* IF *); x := x + parastep UNTIL ( ABS ( x - pb ) <= ( parastep*3. ) ); | 'H' : menue ELSE WriteString ( 'ungültige Eingabe. wird ignoriert.' ); WriteLn END (* CASE *); UNTIL ende END graph.