(* * ------------------------------------------------------------------------- * * :Program. ConTools.mod * :Contents. Ein- und Ausgaben auf einfache Art und Weise. * :Author. Reiner Nix * :Address. Geranienhof 2, 5000 Köln 71 Seeberg * :Copyright. Public Domain * :Language. Modula-2 * :Translator. M2Amiga A-L V3.3d * :History. V1.0 21.11.90 * :Imports. IntuitionTools siehe diese Diskette * :Imports. AmigaGraphik siehe diese Diskette * * ------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- * Alle Ein- und Ausgaben werden über das Console-Device vorgenommen. Dazu * muß ein Fenster geöffnet sein. Die Ausgabesteuerung erfolgt mit * ANSI-Steuersequenzen. Die Kommunikation mit dem Device läuft über zwei * getrennte Ports, einer zum Lesen und einer zum Schreiben. * -------------------------------------------------------------------------- *) IMPLEMENTATION MODULE ConTools; FROM SYSTEM IMPORT ADR, LONGSET; FROM Arts IMPORT Assert, TermProcedure, BreakPoint; FROM Exec IMPORT write, read, MsgPortPtr, IOStdReqPtr, OpenDevice, CloseDevice, SendIO, WaitIO, CheckIO, AbortIO, DoIO; FROM ExecSupport IMPORT CreatePort, DeletePort, CreateStdIO, DeleteStdIO; FROM Intuition IMPORT IDCMPFlags, IDCMPFlagSet, WindowFlags, WindowFlagSet, ScreenFlags, ScreenFlagSet, WindowPtr, NewWindow, Window; FROM ASCII IMPORT sp, lf, ff, esc, cr, bs, csi, del, bel; FROM Str IMPORT Length, Concat, Copy; FROM Strings IMPORT Delete, Insert; FROM Conversions IMPORT ValToStr, StrToVal; FROM IntuitionTools IMPORT initNewWindow; FROM AmigaGraphik IMPORT OpenWindow, CloseWindow; CONST keinFenster ="Konnte Fenster nicht öffnen."; keinWritePort ="Konnte WritePort nicht öffnen."; keinWriteReq ="Konnte WriteRequest nicht erzeugen."; keinReadPort ="Konnte ReadPort nicht öffnen."; keinReadReq ="Konnte ReadRequest nicht erzeugen."; DeviceGeschlossen ="Konnte Device nicht öffnen."; BenutzerStop ="Benutzerunterbrechung"; ControlC =3C; VAR Fenster :WindowPtr; WritePort, ReadPort :MsgPortPtr; WriteReq, ReadReq :IOStdReqPtr; ReadData :CHAR; ConsoleGeoeffnet :BOOLEAN; aVFarbe, aHFarbe :CARDINAL; (* -------------------------------------------------------------------------- *) PROCEDURE Write ( Zeichen :CHAR); BEGIN WITH WriteReq^ DO command := write; data := ADR (Zeichen); length := 1 END; DoIO (WriteReq) END Write; PROCEDURE WriteLn; BEGIN Write (lf) END WriteLn; PROCEDURE WriteString ( Satz :ARRAY OF CHAR); BEGIN WITH WriteReq^ DO command := write; data := ADR (Satz); length := Length (Satz) END; DoIO (WriteReq) END WriteString; PROCEDURE WriteCard ( Zahl :LONGCARD; n :INTEGER); VAR Fehler :BOOLEAN; Satz :ARRAY [0..10] OF CHAR; BEGIN ValToStr (Zahl, FALSE, Satz, 10, n, sp, Fehler); IF NOT Fehler THEN WriteString (Satz) ELSE WriteString ("FEHLER WriteCard") END END WriteCard; PROCEDURE WriteInt ( Zahl :LONGINT; n :INTEGER); VAR Fehler :BOOLEAN; Satz :ARRAY [0..10] OF CHAR; BEGIN ValToStr (Zahl, TRUE, Satz, 10, n, sp, Fehler); IF NOT Fehler THEN WriteString (Satz) ELSE WriteString ("FEHLER WriteInt") END END WriteInt; (* -------------------------------------------------------------------------- *) PROCEDURE ZeichenIstErlaubt ( Zeichen :CHAR; erlaubteZeichen :TZeichenMenge; VAR Status :TStatus) :BOOLEAN; BEGIN IF SonderEingabe THEN CASE Zeichen OF | func1..func10: Status := TStatus (CARDINAL (Zeichen) - CARDINAL (func1) + CARDINAL (Funktion1)) | sfunc1..sfunc10: Status := TStatus (CARDINAL (Zeichen) - CARDINAL (sfunc1) + CARDINAL (sFunktion1)) | help: Status := Hilfe | up: Status := Oben | down: Status := Unten | sup: Status := SeiteOben | sdown: Status := SeiteUnten | btab: Status := Links | left, right, sleft, sright: RETURN TRUE (* nur Steuerzeichen *) ELSE RETURN FALSE END ELSE CASE Zeichen OF | esc: Status := Zurueck | tab: Status := Rechts | cr: Status := Ende | bs,del,sp: RETURN TRUE (* nur Steuerzeichen *) ELSE IF (CAP (Zeichen) ="J") OR (CAP (Zeichen) = "N") THEN RETURN (JaNein IN erlaubteZeichen) OR (Buchstaben IN erlaubteZeichen) OR (alleZeichen IN erlaubteZeichen) ELSIF (("A" <= Zeichen) AND (Zeichen <= "Z")) OR (("a" <= Zeichen) AND (Zeichen <= "z")) THEN RETURN (Buchstaben IN erlaubteZeichen) OR (alleZeichen IN erlaubteZeichen) ELSIF ("0" <= Zeichen) AND (Zeichen <= "9") THEN RETURN (Ziffern IN erlaubteZeichen) OR (eZiffern IN erlaubteZeichen) OR (alleZeichen IN erlaubteZeichen) ELSIF (Zeichen = "+") OR (Zeichen = "-") OR (Zeichen = ".") THEN RETURN (eZiffern IN erlaubteZeichen) OR (alleZeichen IN erlaubteZeichen) ELSE RETURN alleZeichen IN erlaubteZeichen END END END; IF ((Status >= Funktion1) AND (Funktion IN erlaubteZeichen)) OR ((Status < Funktion1) AND (TZeichen (CARDINAL (Status) - CARDINAL (Ende)) IN erlaubteZeichen)) THEN RETURN TRUE ELSE Status := Normal; (* Zeichen nicht gestattet! *) RETURN FALSE END END ZeichenIstErlaubt; (* -------------------------------------------------------------------------- *) PROCEDURE StartRead; BEGIN WITH ReadReq^ DO command := read; data := ADR (ReadData); length := 1 END; SendIO (ReadReq) END StartRead; PROCEDURE TasteGedrueckt () :BOOLEAN; BEGIN RETURN CheckIO (ReadReq); END TasteGedrueckt; PROCEDURE Read (VAR Zeichen :CHAR); VAR Hilfe :CHAR; BEGIN WaitIO (ReadReq); Zeichen := ReadData; SendIO (ReadReq); IF Zeichen = ControlC THEN BreakPoint (ADR (BenutzerStop)) END; SonderEingabe := (Zeichen = csi); IF SonderEingabe THEN WaitIO (ReadReq); Zeichen := ReadData; SendIO (ReadReq); IF ("0" <= Zeichen) AND (Zeichen <= "9") OR (Zeichen = "?") THEN WaitIO (ReadReq); Hilfe := ReadData; SendIO (ReadReq); IF Hilfe # "~" THEN Zeichen := CHAR (CARDINAL (Hilfe)-16); WaitIO (ReadReq); Hilfe := ReadData; SendIO (ReadReq); END ELSIF Zeichen = " " THEN WaitIO (ReadReq); Zeichen := ReadData; SendIO (ReadReq); CASE Zeichen OF |"@" : Zeichen := "U" |"A" : Zeichen := "V" ELSE END END END END Read; PROCEDURE StopRead; BEGIN IF NOT TasteGedrueckt () THEN AbortIO (ReadReq) END; WaitIO (ReadReq) END StopRead; PROCEDURE ReadString ( X,Y, Laenge :CARDINAL; erlaubteZeichen :TZeichenMenge; VAR Satz :ARRAY OF CHAR); VAR i,Pos :CARDINAL; Zeichen :CHAR; BEGIN INCL (erlaubteZeichen, Return); Pos := 0; i := Length (Satz); IF i > Laenge THEN Satz[Laenge] := 0C ELSE WHILE i < Laenge DO Satz[i] := sp; INC (i) END; Satz[Laenge] := 0C END; InverseAusgabe; SetzePosition (X,Y); WriteString (Satz); Status := Normal; REPEAT SetzePosition (X+Pos,Y); CursorAn; REPEAT Read (Zeichen) UNTIL ZeichenIstErlaubt (Zeichen, erlaubteZeichen+TZeichenMenge{Funktion}, Status); CursorAus; IF SonderEingabe THEN CASE Zeichen OF | left: (* Zeichen links *) IF Pos > 0 THEN DEC (Pos) END | right: (* Zeichen rechts *) IF Pos < Laenge-1 THEN INC (Pos) END | func10: (* Ende *) Status := Normal; Pos := Laenge-1; WHILE (Pos > 0) AND (Satz[Pos] = sp) DO DEC (Pos) END; IF Pos < Laenge-1 THEN INC (Pos) END | sfunc10: (* Anfang *) Status := Normal; Pos := 0 | func9: (* Leerzeichen einfügen *) Status := Normal; Satz[Laenge-1] := 0C; Insert (Satz, Pos, " "); SetzePosition (X,Y); WriteString (Satz) | sfunc9: (* Alles löschen *) Status := Normal; Pos := Laenge; Satz[Laenge] := 0C; WHILE Pos > 0 DO DEC (Pos); Satz[Pos] := sp END; SetzePosition (X,Y); WriteString (Satz); | func8: (* Lösche bis Ende *) Status := Normal; i := Pos; WHILE i < Laenge DO Satz[i] := sp; INC (i) END; SetzePosition (X,Y); WriteString (Satz) | sfunc8: (* Lösche bis Anfang *) Status := Normal; IF Pos > 0 THEN Delete (Satz,0,Pos); i := Length (Satz); WHILE i < Laenge DO Satz[i] := sp; INC (i) END; Satz[Laenge] := 0C; SetzePosition (X,Y); WriteString (Satz); Pos := 0 END | sleft: (* Wort links *) WHILE (Pos > 0) AND ((Satz[Pos] < "A") OR (("Z" < Satz[Pos]) AND (Satz[Pos] < "a")) OR (("z" < Satz[Pos]) AND (Satz[Pos] < "À"))) DO DEC (Pos) END; WHILE (Pos > 0) AND ((("A" <= Satz[Pos]) AND (Satz[Pos] <= "Z")) OR (("a" <= Satz[Pos]) AND (Satz[Pos] <= "z")) OR ("À" <= Satz[Pos])) DO DEC (Pos) END | sright: (* Wort rechts *) WHILE (Pos < Laenge-1) AND ((Satz[Pos] < "A") OR (("Z" < Satz[Pos]) AND (Satz[Pos] < "a")) OR (("z" < Satz[Pos]) AND (Satz[Pos] < "À"))) DO INC (Pos) END; WHILE (Pos < Laenge-1) AND ((("A" <= Satz[Pos]) AND (Satz[Pos] <= "Z")) OR (("a" <= Satz[Pos]) AND (Satz[Pos] <= "z")) OR ("À" <= Satz[Pos])) DO INC (Pos) END ELSE IF (Status >= Funktion1) AND NOT (Funktion IN erlaubteZeichen) THEN Status := Normal END END ELSE (* NOT SonderEingabe *) CASE Zeichen OF | cr, esc: (* Leer; Status schon gesetzt *) | bs : (* Zeichen links löschen *) IF Pos > 0 THEN DEC (Pos); Delete (Satz, Pos, 1); Concat (Satz, " "); SetzePosition (X,Y); WriteString (Satz) END | del: (* Zeichen rechts löschen *) Delete (Satz, Pos, 1); Concat (Satz, " "); SetzePosition (X,Y); WriteString (Satz) ELSE (* Normale Eingabe *) Satz[Pos] := Zeichen; SetzePosition (X+Pos,Y); Write (Zeichen); IF Pos < Laenge-1 THEN INC (Pos) END END END UNTIL Status # Normal; NormaleAusgabe; SetzePosition (X,Y); WriteString (Satz); i := Laenge; WHILE (i > 0) AND (Satz[i-1] = sp) DO DEC (i); Satz[i] := 0C END END ReadString; PROCEDURE ReadCard ( X,Y, Laenge :CARDINAL; erlaubteZeichen :TZeichenMenge; VAR Zahl :CARDINAL); VAR Fehler, Vorzeichen :BOOLEAN; i :CARDINAL; iZahl :LONGINT; Satz :ARRAY [0..15] OF CHAR; BEGIN erlaubteZeichen := erlaubteZeichen - TZeichenMenge {alleZeichen,Buchstaben,JaNein} + TZeichenMenge {eZiffern}; IF Laenge > 15 THEN Laenge := 15 END; ValToStr (Zahl, TRUE, Satz, 10, -INTEGER (Laenge), sp, Fehler); REPEAT ReadString (X,Y, Laenge, erlaubteZeichen, Satz); WHILE (Length (Satz) > 1) AND (Satz[0] = sp) DO Delete (Satz,0,1) END; StrToVal (Satz, iZahl, Vorzeichen, 10, Fehler); Fehler := (Fehler OR (NOT Vorzeichen AND (Zahl < 0))); IF NOT Fehler THEN Fehler := (iZahl < LONGINT (MIN (CARDINAL))) OR (LONGINT (MAX (CARDINAL)) < iZahl); IF NOT Fehler THEN Zahl := CARDINAL (iZahl) END END; IF Fehler THEN Write (bel) END UNTIL NOT Fehler; SetzePosition (X,Y); WriteInt (Zahl, Laenge) END ReadCard; PROCEDURE ReadInt ( X,Y, Laenge :CARDINAL; erlaubteZeichen :TZeichenMenge; VAR Zahl :INTEGER); VAR Fehler, Vorzeichen :BOOLEAN; i :CARDINAL; iZahl :LONGINT; Satz :ARRAY [0..15] OF CHAR; BEGIN erlaubteZeichen := erlaubteZeichen - TZeichenMenge {alleZeichen,Buchstaben,JaNein} + TZeichenMenge {eZiffern}; IF Laenge > 15 THEN Laenge := 15 END; ValToStr (Zahl, TRUE, Satz, 10, -INTEGER (Laenge), sp, Fehler); REPEAT ReadString (X,Y, Laenge, erlaubteZeichen, Satz); WHILE (Length (Satz) > 1) AND (Satz[0] = sp) DO Delete (Satz,0,1) END; StrToVal (Satz, iZahl, Vorzeichen, 10, Fehler); Fehler := (Fehler OR (NOT Vorzeichen AND (Zahl < 0))); IF NOT Fehler THEN Fehler := (iZahl < LONGINT (MIN (INTEGER))) OR (LONGINT (MAX (INTEGER)) < iZahl); IF NOT Fehler THEN Zahl := INTEGER (iZahl) END END; IF Fehler THEN Write (bel) END UNTIL NOT Fehler; SetzePosition (X,Y); WriteInt (Zahl, Laenge) END ReadInt; PROCEDURE ReadLongInt ( X,Y, Laenge :CARDINAL; erlaubteZeichen :TZeichenMenge; VAR Zahl :LONGINT); VAR Fehler, Vorzeichen :BOOLEAN; i :CARDINAL; Satz :ARRAY [0..15] OF CHAR; BEGIN erlaubteZeichen := erlaubteZeichen - TZeichenMenge {alleZeichen,Buchstaben,JaNein} + TZeichenMenge {eZiffern}; IF Laenge > 15 THEN Laenge := 15 END; ValToStr (Zahl, TRUE, Satz, 10, -INTEGER (Laenge), sp, Fehler); REPEAT ReadString (X,Y, Laenge, erlaubteZeichen, Satz); WHILE (Length (Satz) > 1) AND (Satz[0] = sp) DO Delete (Satz,0,1) END; StrToVal (Satz, Zahl, Vorzeichen, 10, Fehler); Fehler := (Fehler OR (NOT Vorzeichen AND (Zahl < 0))); IF Fehler THEN Write (bel) END UNTIL NOT Fehler; SetzePosition (X,Y); WriteInt (Zahl, Laenge) END ReadLongInt; (* -------------------------------------------------------------------------- *) PROCEDURE LoescheAusgabe; BEGIN Write (ff); END LoescheAusgabe; PROCEDURE SetzePosition ( X, Y :CARDINAL); VAR Fehler :BOOLEAN; XSatz, YSatz :ARRAY [0..5] OF CHAR; BEGIN ValToStr (X, FALSE, XSatz, 10, -5, 0C, Fehler); ValToStr (Y, FALSE, YSatz, 10, -5, 0C, Fehler); Write (csi); WriteString (YSatz); Write (";"); WriteString (XSatz); Write ("H") END SetzePosition; PROCEDURE SetzeFarben ( VFarbe, HFarbe :CARDINAL); VAR Fehler :BOOLEAN; VSatz, HSatz :ARRAY [0..5] OF CHAR; BEGIN aVFarbe := VFarbe; aHFarbe := HFarbe; ValToStr ((VFarbe+30), FALSE, VSatz, 10, -5, 0C, Fehler); ValToStr ((HFarbe+40), FALSE, HSatz, 10, -5, 0C, Fehler); Write (csi); WriteString (VSatz); Write (";"); WriteString (HSatz); Write ("m") END SetzeFarben; PROCEDURE NormaleAusgabe; VAR Fehler :BOOLEAN; VSatz, HSatz :ARRAY [0..5] OF CHAR; BEGIN ValToStr ((aVFarbe+30), FALSE, VSatz, 10, -5, 0C, Fehler); ValToStr ((aHFarbe+40), FALSE, HSatz, 10, -5, 0C, Fehler); Write (csi); WriteString (VSatz); Write (";"); WriteString (HSatz); Write ("m") END NormaleAusgabe; PROCEDURE InverseAusgabe; VAR Fehler :BOOLEAN; VSatz, HSatz :ARRAY [0..5] OF CHAR; BEGIN ValToStr ((aVFarbe+40), FALSE, VSatz, 10, -5, 0C, Fehler); ValToStr ((aHFarbe+30), FALSE, HSatz, 10, -5, 0C, Fehler); Write (csi); WriteString (VSatz); Write (";"); WriteString (HSatz); Write ("m") END InverseAusgabe; PROCEDURE CursorAn; BEGIN Write (csi); WriteString (" p") END CursorAn; PROCEDURE CursorAus; BEGIN Write (csi); WriteString ("0 p") END CursorAus; PROCEDURE ZeileEinfuegen; BEGIN Write (csi); Write ("L") END ZeileEinfuegen; PROCEDURE ZeileLoeschen; BEGIN Write (csi); Write ("M"); END ZeileLoeschen; PROCEDURE ScrollHoch ( n :CARDINAL); VAR Fehler :BOOLEAN; nSatz :ARRAY [0..5] OF CHAR; BEGIN ValToStr (n, FALSE, nSatz, 10, -5, 0C, Fehler); Write (csi); WriteString (nSatz); Write ("S") END ScrollHoch; PROCEDURE ScrollRunter ( n :CARDINAL); VAR Fehler :BOOLEAN; nSatz :ARRAY [0..5] OF CHAR; BEGIN ValToStr (n, FALSE, nSatz, 10, -5, 0C, Fehler); Write (csi); WriteString (nSatz); Write ("T") END ScrollRunter; (* -------------------------------------------------------------------------- *) PROCEDURE DefiniereBereich (VAR Bereich :TBereich; Links, Oben, Breite, Hoehe, VFarbe, HFarbe :CARDINAL); VAR Fehler :BOOLEAN; lSatz,oSatz, rSatz,uSatz :ARRAY [0..6] OF CHAR; zSatz :ARRAY [0..1] OF CHAR; BEGIN Bereich.B[0] := 0C; zSatz[0] := "x"; zSatz[1] := 0C; ValToStr (Links*8+2, FALSE, lSatz, 10, -5, 0C, Fehler); Concat (lSatz,zSatz); zSatz[0] := "y"; ValToStr (Oben*8+2, FALSE, oSatz, 10, -5, 0C, Fehler); Concat (oSatz,zSatz); zSatz[0] := "u"; ValToStr (Breite, FALSE, rSatz, 10, -5, 0C, Fehler); Concat (rSatz,zSatz); zSatz[0] := "t"; ValToStr (Hoehe, FALSE, uSatz, 10, -5, 0C, Fehler); Concat (uSatz,zSatz); zSatz[0] := csi; Concat (Bereich.B, zSatz); Concat (Bereich.B, lSatz); Concat (Bereich.B, zSatz); Concat (Bereich.B, oSatz); Concat (Bereich.B, zSatz); Concat (Bereich.B, rSatz); Concat (Bereich.B, zSatz); Concat (Bereich.B, uSatz); Bereich.VFarbe := VFarbe; Bereich.HFarbe := HFarbe END DefiniereBereich; PROCEDURE BenutzeBereich ( Bereich :TBereich); BEGIN WITH Bereich DO SetzePosition (1,1); WriteString (B); SetzeFarben (VFarbe, HFarbe) END; END BenutzeBereich; PROCEDURE DefiniereZeile (VAR Zeile :TZeile; Wahl, Anzahl :CARDINAL; erlaubteZeichen :TZeichenMenge; P1,P2,P3,P4,P5, P6,P7,P8,P9,P10 :ARRAY OF CHAR); BEGIN Zeile.Wahl := Wahl; Zeile.Anzahl := Anzahl; Zeile.erlaubteZeichen := erlaubteZeichen; Copy (Zeile.Punkt[1], P1); Copy (Zeile.Punkt[2], P2); Copy (Zeile.Punkt[3], P3); Copy (Zeile.Punkt[4], P4); Copy (Zeile.Punkt[5], P5); Copy (Zeile.Punkt[6], P6); Copy (Zeile.Punkt[7], P7); Copy (Zeile.Punkt[8], P8); Copy (Zeile.Punkt[9], P9); Copy (Zeile.Punkt[10], P10) END DefiniereZeile; PROCEDURE DefiniereMenue (VAR Menue :TMenue; Wahl, Anzahl, XTitel,YTitel, XPunkt,YPunkt :CARDINAL; Bereich :TBereich; Titel, P1,P2,P3,P4,P5, P6,P7,P8,P9,P10 :ARRAY OF CHAR); BEGIN Menue.Wahl := Wahl; Menue.Anzahl := Anzahl; Menue.XTitel := XTitel; Menue.YTitel := YTitel; Menue.XPunkt := XPunkt; Menue.YPunkt := YPunkt; Menue.Bereich := Bereich; Copy (Menue.Titel, Titel); Copy (Menue.Punkt[1], P1); Copy (Menue.Punkt[2], P2); Copy (Menue.Punkt[3], P3); Copy (Menue.Punkt[4], P4); Copy (Menue.Punkt[5], P5); Copy (Menue.Punkt[6], P6); Copy (Menue.Punkt[7], P7); Copy (Menue.Punkt[8], P8); Copy (Menue.Punkt[9], P9); Copy (Menue.Punkt[10], P10) END DefiniereMenue; (* -------------------------------------------------------------------------- *) PROCEDURE Meldung ( Satz :ARRAY OF CHAR; Warte :BOOLEAN); VAR Zeichen :CHAR; BEGIN BenutzeBereich (Kommentar); LoescheAusgabe; SetzePosition (2,1); WriteString (Satz); IF Warte THEN SetzePosition (1,2); WriteString ("quetsch mal ijrend ein Knöppche ============-------------->"); CursorAn; IF TasteGedrueckt () THEN Read (Zeichen) END; Read (Zeichen); CursorAus END END Meldung; PROCEDURE MenueWahl (VAR Menue :TMenue; neuesMenue :BOOLEAN); VAR Zeichen :CHAR; i :CARDINAL; BEGIN WITH Menue DO BenutzeBereich (Kommentar); LoescheAusgabe; WriteString ("Wählen Sie mit den Pfeiltasten einen Punkt, und"); WriteLn; WriteString ("aktivieren Sie den ausgewählten Punkt mit "); BenutzeBereich (Bereich); IF neuesMenue THEN LoescheAusgabe; SetzePosition (XTitel,YTitel); WriteString (Titel); NormaleAusgabe; FOR i := 1 TO Anzahl DO SetzePosition (XPunkt, YPunkt-1+i); WriteString (Punkt[i]) END END; REPEAT InverseAusgabe; SetzePosition (XPunkt,YPunkt-1+Wahl); WriteString (Punkt[Wahl]); NormaleAusgabe; REPEAT Read (Zeichen) UNTIL ZeichenIstErlaubt (Zeichen, TZeichenMenge {Escape, Return, Hoch, Runter}, Status); IF Status # Ende THEN SetzePosition (XPunkt,YPunkt-1+Wahl); WriteString (Punkt[Wahl]) END; IF SonderEingabe THEN CASE Zeichen OF | up,left :IF Wahl = 1 THEN Wahl := Anzahl ELSE DEC (Wahl) END | down,right :IF Wahl = Anzahl THEN Wahl := 1 ELSE INC (Wahl) END ELSE END ELSE CASE Zeichen OF | esc :Wahl := Anzahl ELSE END END UNTIL NOT (SonderEingabe) AND (Zeichen = cr); BenutzeBereich (Kommentar); LoescheAusgabe; BenutzeBereich (Bereich) END END MenueWahl; PROCEDURE ZeilenWahl ( X,Y :CARDINAL; VAR Zeile :TZeile); VAR Zeichen :CHAR; BEGIN WITH Zeile DO erlaubteZeichen :=erlaubteZeichen + TZeichenMenge{Return}; Status := Normal; REPEAT InverseAusgabe; SetzePosition (X,Y); WriteString (Punkt[Wahl]); SetzePosition (X,Y); CursorAn; REPEAT Read (Zeichen) UNTIL ZeichenIstErlaubt (Zeichen, erlaubteZeichen, Status); CursorAus; IF SonderEingabe THEN CASE Zeichen OF | left :IF Wahl > 1 THEN DEC (Wahl) ELSE Wahl := Anzahl END | right :IF Wahl < Anzahl THEN INC (Wahl) ELSE Wahl := 1 END ELSE END ELSE CASE Zeichen OF | sp :IF Wahl < Anzahl THEN INC (Wahl) ELSE Wahl := 1 END ELSE END END UNTIL Status # Normal; NormaleAusgabe; SetzePosition (X,Y); WriteString (Punkt[Wahl]) END END ZeilenWahl; PROCEDURE ZeichenWahl ( X,Y :CARDINAL; Satz :ARRAY OF CHAR; erlaubteZeichen :TZeichenMenge; VAR Zeichen :CHAR); BEGIN SetzePosition (X,Y); WriteString (Satz); Write (" "); Write (bs); CursorAn; REPEAT Read (Zeichen) UNTIL ZeichenIstErlaubt (Zeichen, erlaubteZeichen, Status); IF NOT SonderEingabe AND (((37C <= Zeichen) AND (Zeichen <= 176C)) OR (240C <= Zeichen)) THEN Write (Zeichen) END; CursorAus END ZeichenWahl; (* -------------------------------------------------------------------------- *) PROCEDURE OpenConsole (VAR WriteReq, ReadReq :IOStdReqPtr; VAR Fenster :WindowPtr): BOOLEAN; BEGIN WriteReq^.data := Fenster; WriteReq^.length := SIZE (Window); OpenDevice (ADR ("console.device"), 0, WriteReq, LONGSET {}); ReadReq^.device := WriteReq^.device; ReadReq^.unit := WriteReq^.unit; RETURN (WriteReq^.error = 0) END OpenConsole; PROCEDURE CloseConsole (VAR WriteReq :IOStdReqPtr); BEGIN CloseDevice (WriteReq) END CloseConsole; PROCEDURE Schluss; BEGIN IF ConsoleGeoeffnet THEN StopRead; CloseConsole (WriteReq) END; IF ReadReq # NIL THEN DeleteStdIO (ReadReq) END; IF ReadPort # NIL THEN DeletePort (ReadPort) END; IF WriteReq # NIL THEN DeleteStdIO (WriteReq) END; IF WritePort # NIL THEN DeletePort (WritePort) END; CloseWindow (Fenster) END Schluss; PROCEDURE Start; VAR NeuFenster :NewWindow; BEGIN Fenster := NIL; WritePort := NIL; WriteReq := NIL; ReadPort := NIL; ReadReq := NIL; ConsoleGeoeffnet := FALSE; TermProcedure (Schluss); initNewWindow (NeuFenster, 0,12,640,244, (* X,Y, Breite,Höhe *) 0,1, (* Detailp., Blockp.*) IDCMPFlagSet {}, WindowFlagSet {windowSizing, windowDepth, windowDrag, windowRefresh, activate}, NIL, (* FirstGadget *) NIL, (* Checkmark *) NIL, (* Titel *) NIL, (* Screen *) NIL, 70, 30, -1, -1, (* min, max *) ScreenFlagSet {wbenchScreen}); Fenster := OpenWindow (NeuFenster); Assert (Fenster # NIL, ADR (keinFenster)); WritePort := CreatePort (ADR ("CT.WritePort"), 0); Assert (WritePort # NIL, ADR (keinWritePort)); WriteReq := CreateStdIO (WritePort); Assert (WriteReq # NIL, ADR (keinWriteReq)); ReadPort := CreatePort (ADR ("CT.ReadPort"), 0); Assert (ReadPort # NIL, ADR (keinReadPort)); ReadReq := CreateStdIO (ReadPort); Assert (ReadReq # NIL, ADR (keinReadReq)); ConsoleGeoeffnet := OpenConsole (WriteReq, ReadReq, Fenster); Assert (ConsoleGeoeffnet, ADR (DeviceGeschlossen)); StartRead END Start; (* -------------------------------------------------------------------------- *) (* MODULE *) BEGIN Start; CursorAus; DefiniereBereich (Kommentar, 2,26,75,3, 0,1) END ConTools.