Turbo Toolbox/Turbo_Toolbox.iso/1990/12/praxis/grafik.mod

Modula Implementation | 1990-08-15 | 15.5 KB | 623 lines

(* ------------------------------------------------------ *)
(*                    GRAFIK.MOD                          *)
(*           Grafik-Modul für Fitted-Modula               *)
(* ------------------------------------------------------ *)
IMPLEMENTATION MODULE Grafik;

(* $T-, $S-, $R- *)

FROM SYSTEM IMPORT
  ADDRESS, BYTE, ADR, SEG, OFS, ASSEMBLER;

FROM System IMPORT
  TermProcedure, Move;

FROM Strings IMPORT
  Assign, (* Copy, *)  Length;

FROM Storage IMPORT
  Available, ALLOCATE, DEALLOCATE;

CONST
  MaxGrafWindow      = 10;
  GrafikInterrupt    = 60H;
  LF                 = 0AX;
  CR                 = 0DX;
                    (* Erkennungs-Code für Grafik-Befehle *)
  PutPixelCode       = 1;
  GetPixelCode       = 2;
  LineCode           = 3;
  CircleCode         = 4;
  ArcCode            = 5;
  SetColorCode       = 10;
  SetGraphModeCode   = 11;
  RestoreCrtModeCode = 12;
  SetViewPortCode    = 13;
  ClearViewPortCode  = 14;
  OutTextXYCode      = 15;
  ImageSizeCode      = 16;
  GetImageCode       = 17;
  PutImageCode       = 18;
  InstallCode        = 19;

TYPE
  Str80 = ARRAY[0..80] OF CHAR;
  GrafWindowType  = RECORD              (* Grafik-Fenster *)
                      x1, y1, x2, y2 : INTEGER;
                      Buffer         : ADDRESS;
                    END;
  ParameterRecord = RECORD    (* Tabelle für Übergabe     *)
                              (* aller nötigen Parameter  *)
                              (* an UNIGRAF               *)
                      BefehlsCode,
                      x1, y1, x2, y2,
                      w, Farbe        : INTEGER;
                      Zeiger          : ADDRESS;
                      Clipping        : BOOLEAN;
                      Text            : Str80;
                    END;
VAR
  AktivesFenster   : INTEGER;
  GrafWindow       : ARRAY [1..MaxGrafWindow] OF
                                             GrafWindowType;
  FontDeltaX,
  FontDeltaY       : INTEGER;
  Parameter        : ParameterRecord;
  ParameterPointer : ADDRESS;
  ParameterSeg,
  ParameterOfs     : CARDINAL;
  StiftFarbe       : Colour;
  GrafikInstalled  : BOOLEAN;
  CA : ColArray;
  CI : Colour;

  PROCEDURE UniGraf;
  BEGIN
    (* Zeiger auf Parameter-Tabelle in Register schreiben
       und Interrupt an UNIGRAF ausführen                 *)
    ASM
      MOV   AX, ParameterSeg
      MOV   BX, ParameterOfs
      INT   GrafikInterrupt
    END;
  END UniGraf;

  (* für die folgenden Befehle wurde die Turbo-Pascal-
     Bezeichnung beibehalten                              *)

  PROCEDURE PutPixel(x, y : INTEGER; Color : Colour);
  BEGIN
    (* Parameter in Parameter-Tabelle übertragen und
       Ausführung starten                                 *)
    WITH Parameter DO
      BefehlsCode := PutPixelCode;
      x1 := x;
      y1 := y;
      Farbe := ORD(Color);
    END;
    UniGraf;
  END PutPixel;

  PROCEDURE GetPixel(x, y : INTEGER) : Colour;
  VAR
    c : Colour;
  BEGIN
    WITH Parameter DO
      BefehlsCode := GetPixelCode;
      x1 := x;
      y1 := y;
    END;
    UniGraf;
    c := CA[Parameter.Farbe];
    RETURN c;           (* VAL(Colour, Parameter.Farbe); *)
  END GetPixel;

  PROCEDURE DrawLine(x1, y1, x2, y2 : INTEGER);
  BEGIN
    Parameter.BefehlsCode := LineCode;
    Parameter.x1 := x1;
    Parameter.y1 := y1;
    Parameter.x2 := x2;
    Parameter.y2 := y2;
    UniGraf;
  END DrawLine;

  PROCEDURE TCircle(x, y, Radius : INTEGER);  (* Circle() *)
  BEGIN
    WITH Parameter DO
      BefehlsCode := CircleCode;
      x1 := x;
      y1 := y;
      x2 := Radius;
    END;
    UniGraf;
  END TCircle;

  PROCEDURE TArc(x, y, StartWinkel, EndWinkel,
                 Radius : INTEGER);              (* Arc() *)
  BEGIN
    WITH Parameter DO
      BefehlsCode := ArcCode;
      x1 := x;
      y1 := y;
      x2 := StartWinkel;
      y2 := EndWinkel;
      w  := Radius;
    END;
    UniGraf;
  END TArc;

  PROCEDURE SetColor(Color : Colour);
  BEGIN
    WITH Parameter DO
      BefehlsCode := SetColorCode;
      Farbe := ORD(Color);
    END;
    StiftFarbe := Color;
    UniGraf;
  END SetColor;

  PROCEDURE SetViewPort(x1, y1, x2, y2 : INTEGER;
                                            Clip : BOOLEAN);
  BEGIN
    Parameter.BefehlsCode := SetViewPortCode;
    Parameter.x1 := x1;
    Parameter.y1 := y1;
    Parameter.x2 := x2;
    Parameter.y2 := y2;
    Parameter.Clipping := Clip;
    UniGraf;
  END SetViewPort;

  PROCEDURE ClearViewPort;
  BEGIN
    WITH Parameter DO
      BefehlsCode := ClearViewPortCode;
    END;
    UniGraf;
  END ClearViewPort;

  PROCEDURE OutTextXY(x, y : INTEGER; s : ARRAY OF CHAR);
  BEGIN
    WITH Parameter DO
      BefehlsCode := OutTextXYCode;
      x1 := x;
      y1 := y;
      Assign(s, Text);
    END;
    UniGraf;
  END OutTextXY;

  PROCEDURE ImageSize(x1, y1, x2, y2 : INTEGER) : CARDINAL;
  BEGIN
    Parameter.BefehlsCode := ImageSizeCode;
    Parameter.x1 := x1;
    Parameter.y1 := y1;
    Parameter.x2 := x2;
    Parameter.y2 := y2;
    UniGraf;
    RETURN Parameter.x1;
  END ImageSize;

  PROCEDURE GetImage(x1, y1, x2, y2 : INTEGER; p : ADDRESS);
  BEGIN
    Parameter.BefehlsCode := GetImageCode;
    Parameter.x1 := x1;
    Parameter.y1 := y1;
    Parameter.x2 := x2;
    Parameter.y2 := y2;
    Parameter.Zeiger := p;
    UniGraf;
  END GetImage;

  PROCEDURE PutImage(x, y : INTEGER; p : ADDRESS);
  BEGIN
    WITH Parameter DO
      BefehlsCode := PutImageCode;
      x1 := x;
      y1 := y;
      Zeiger := p;
    END;
    UniGraf;
  END PutImage;

  PROCEDURE InitGrafik(VAR xMax, yMax : INTEGER);
  BEGIN
    WITH Parameter DO
      BefehlsCode := InstallCode;
      UniGraf;
      xMax := x1;
      yMax := y1;
    END;
  END InitGrafik;

  PROCEDURE SetGraphMode;
  BEGIN
    WITH Parameter DO
      BefehlsCode := SetGraphModeCode;
    END;
    UniGraf;
  END SetGraphMode;

  PROCEDURE RestoreCrtMode;
  BEGIN
    WITH Parameter DO
      BefehlsCode := RestoreCrtModeCode;
    END;
    UniGraf;
  END RestoreCrtMode;

  (* jetzt folgen die Grafik-Befehle für MODULA-2.        *)
  (* UNIGRAF darf nicht im Textmodus mit einem Grafik-    *)
  (* Befehl aufgerufen werden, da Turbo-Pascal sonst      *)
  (* sofort mit einem Laufzeitfehler abbricht             *)

  PROCEDURE Plot(x, y: INTEGER);
  BEGIN
    IF GrafikModus THEN
      PutPixel(x, y, StiftFarbe);
    END;
  END Plot;

  PROCEDURE Line(x1, y1, x2, y2: INTEGER);
  BEGIN
    IF GrafikModus THEN
      DrawLine(x1, y1, x2, y2);
    END;
  END Line;

  PROCEDURE DotColor(x, y : INTEGER) : Colour;
  BEGIN
    IF GrafikModus THEN
      RETURN GetPixel(x, y);
    ELSE
      RETURN Black;
    END;
  END DotColor;

  PROCEDURE Circle(x, y, Radius : INTEGER);
  BEGIN
    IF GrafikModus THEN
      TCircle(x, y, Radius);
    END;
  END Circle;

  PROCEDURE Arc(x, y, StartWinkel, EndWinkel,
                                   Radius : INTEGER);
  BEGIN
    IF GrafikModus THEN
      TArc(x, y, StartWinkel, EndWinkel, Radius);
    END;
  END Arc;

  PROCEDURE PenColor(Farbe : Colour);
  BEGIN
    IF GrafikModus THEN
      SetColor(Farbe);
    END;
  END PenColor;

  (* liegt der x-Wert innerhalb des Grafikschirms?        *)
  (* wenn nicht, dann ändern                              *)

  PROCEDURE ZulaessigerXWert(x: INTEGER): INTEGER;
  BEGIN
    IF x < 0 THEN
      x := 0;
    END;
    IF x > xMaxScr THEN
      x := xMaxScr;
    END;
    RETURN x;
  END ZulaessigerXWert;

  (* liegt der y-Wert innerhalb des Grafikschirms?        *)
  (* wenn nicht, dann ändern                              *)

  PROCEDURE ZulaessigerYWert(y: INTEGER): INTEGER;
  BEGIN
    IF y < 0 THEN
      y := 0;
    END;
    IF y > yMaxScr THEN
      y := yMaxScr;
    END;
    RETURN y;
  END ZulaessigerYWert;

  (* MODULA-2-String ins Turbo-Pascal-Format konvertieren *)

  PROCEDURE TurboString(s : ARRAY OF CHAR; VAR t : Str80);
    VAR
      l : CARDINAL;
  BEGIN
    l := Length(s);
    IF l > 80 THEN
      l := 80;
    END;
    Move(ADR(s[0]), ADR(t[1]), l);
    t[0] := CHR(l);
  END TurboString;

  PROCEDURE WriteText(x, y: INTEGER;
                      s : ARRAY OF CHAR);
    VAR
      OldWindow, Laenge, x1, x2, y1, y2: INTEGER;
      t : Str80;
      i : INTEGER;
  BEGIN
    IF  NOT GrafikModus THEN
      RETURN;
    END;
    OldWindow := GetGrafWindow();
    IF INTEGER(Length(s)) > 80 - x THEN
(*      Copy(s, 0, 80 - x, s);
                          aus STRINGS.DEF, wenn vorhanden *)
      FOR i := 0 TO 80 - x DO
        s[i] := s[i];
      END;
    END;
    TurboString(s, t);
    Laenge := ORD(t[0]);    (* jetzt Turbo-Pascal-Format! *)
    x := x - 1;
    y := y - 1;
    x1 := ZulaessigerXWert(x * FontX);
    x2 := ZulaessigerXWert(x1 + Laenge * FontX);
    y1 := ZulaessigerYWert(y * FontY);
    y2 := ZulaessigerYWert(y1 + FontY - 1);
                              (* Text-Hintergrund löschen *)
    SetViewPort(x1, y1, x2, y2, TRUE);
    ClearViewPort;
    SetViewPort(0, 0, xMaxScr, yMaxScr, TRUE);
                               (* Text zentriert ausgeben *)
    OutTextXY(x1 + FontDeltaX, y1 + FontDeltaY, t);
    SelectGrafWindow(OldWindow);
  END WriteText;

  PROCEDURE WriteGrafText(x, y: INTEGER;
                          Farbe : Colour;
                          s: ARRAY OF CHAR);
    VAR
      AlteFarbe : Colour;
      t : Str80;
  BEGIN
    IF  NOT GrafikModus THEN
      RETURN;
    END;
    AlteFarbe := StiftFarbe;
    TurboString(s, t);
    SetColor(Farbe);
    OutTextXY(x, y, t);
    SetColor(AlteFarbe);
  END WriteGrafText;

  PROCEDURE ClearGrafScreen;
    VAR
      OldWindow: INTEGER;
  BEGIN
    IF  NOT GrafikModus THEN
      RETURN;
    END;
    OldWindow := GetGrafWindow();
    SetViewPort(0, 0, xMaxScr, yMaxScr, TRUE);
    ClearViewPort;
    SelectGrafWindow(OldWindow);
  END ClearGrafScreen;

  PROCEDURE ClearGrafWindow;
  BEGIN
    IF  NOT GrafikModus THEN
      RETURN;
    END;
    ClearViewPort;
  END ClearGrafWindow;

  PROCEDURE WindowSize(Nr: INTEGER): CARDINAL;
  BEGIN
    IF  NOT GrafikModus THEN
      RETURN 0;
    END;
    IF (Nr < 1) OR (Nr > MaxGrafWindow) THEN
      RETURN 0;
    ELSE
      WITH GrafWindow[Nr] DO
         RETURN ImageSize(x1, y1, x2, y2);
      END;
    END;
  END WindowSize;

  PROCEDURE DefineGrafWindow(Nr, xl, yu, xr, yo: INTEGER);
  BEGIN
    IF (Nr < 1) OR (Nr > MaxGrafWindow) THEN
      RETURN;
    END;
    WITH GrafWindow[Nr] DO
         (* für altes Fenster Speicherbereich freigeben,  *)
         (* sofern benötigt                               *)
      IF Buffer <> NIL THEN
        DEALLOCATE(Buffer, WindowSize(Nr));
      END;
        (* nur Eck-Koordinaten innerhalb des Bildschirms  *)
        (* zulassen                                       *)
      x1 := ZulaessigerXWert(xl);
      y1 := ZulaessigerYWert(yu);
      x2 := ZulaessigerXWert(xr);
      y2 := ZulaessigerYWert(yo);
    END;
  END DefineGrafWindow;

  PROCEDURE SelectGrafWindow(Nr: INTEGER);
  BEGIN
    IF  NOT GrafikModus THEN
      RETURN;
    END;
    IF (Nr < 1) OR (Nr > MaxGrafWindow) THEN
      RETURN;
    END;
    AktivesFenster := Nr;
    WITH GrafWindow[Nr] DO
      SetViewPort(x1, y1, x2, y2, TRUE);
    END;
  END SelectGrafWindow;

  PROCEDURE FullGrafScreen;
  BEGIN
    SetViewPort(0, 0, xMaxScr, yMaxScr, TRUE);
  END FullGrafScreen;

  PROCEDURE StoreGrafWindow(Nr: INTEGER);
    VAR
      OldWindow: INTEGER;
  BEGIN
    IF  NOT GrafikModus THEN
      RETURN;
    END;
    IF (Nr < 1) OR (Nr > MaxGrafWindow) THEN
      RETURN;
    END;
    OldWindow := GetGrafWindow();
    SelectGrafWindow(Nr);
    WITH GrafWindow[Nr] DO
      (* Speicher-Bereich anfordern, wenn nicht genügend  *)
      (* zur Verfügung steht, nicht Speichern             *)
      IF Buffer = NIL THEN
        IF NOT Available(WindowSize(Nr)) THEN
          RETURN
        END;
        ALLOCATE(Buffer, WindowSize(Nr));
      END;
      FullGrafScreen;
      GetImage(x1, y1, x2, y2, Buffer);
    END;
    SelectGrafWindow(OldWindow);
  END StoreGrafWindow;

  PROCEDURE RestoreGrafWindow(Nr: INTEGER);
    VAR
      OldWindow: INTEGER;
  BEGIN
    IF  NOT GrafikModus THEN
      RETURN;
    END;
    OldWindow := GetGrafWindow();
    IF (Nr < 1) OR (Nr > MaxGrafWindow) THEN
      RETURN;
    END;
    SelectGrafWindow(Nr);
    FullGrafScreen;
    WITH GrafWindow[Nr] DO
      PutImage(x1, y1, Buffer);
    END;
    SelectGrafWindow(OldWindow);
  END RestoreGrafWindow;

  PROCEDURE MoveGrafWindow(Nr, x, y: INTEGER);
    VAR
      OldWindow: INTEGER;
  BEGIN
    IF  NOT GrafikModus THEN
      RETURN;
    END;
    OldWindow := GetGrafWindow();
    IF (Nr < 1) OR (Nr > MaxGrafWindow) THEN
      RETURN;
    END;
    FullGrafScreen;
    WITH GrafWindow[Nr] DO
      PutImage(x, y, Buffer);
    END;
    SelectGrafWindow(OldWindow);
  END MoveGrafWindow;

  PROCEDURE GetGrafWindow(): CARDINAL;
  BEGIN
    RETURN AktivesFenster;
  END GetGrafWindow;

  PROCEDURE InitGraphic;
    VAR
      n : CARDINAL;
  BEGIN
    IF GrafikInstalled THEN
      RETURN;
    END;
    (* BGI-Treiber laden und Variablen initialisieren     *)
    (* ACHTUNG: xMaxScr und yMaxScr sind erst NACH dem    *)
    (* ersten Umschalten auf den Grafikschirm definiert!  *)
    InitGrafik(xMaxScr, yMaxScr);
    FontX := 8;
    FontY := (yMaxScr + 1) DIV 25;
    FontDeltaX := (FontX - 8) DIV 2;
    FontDeltaY := (FontY - 8) DIV 2;
                            (* alle Fenster vordefinieren *)
    FOR n := 1 TO MaxGrafWindow DO
      WITH GrafWindow[n] DO
        Buffer := NIL;
        DefineGrafWindow(n, 0, 0, xMaxScr, yMaxScr);
      END;
    END;
    SelectGrafWindow(1);
    GrafikInstalled := TRUE;
  END InitGraphic;

  PROCEDURE GrafScreen;
  BEGIN
    IF GrafikModus THEN
      RETURN;
    END;
    IF NOT GrafikInstalled THEN
      InitGraphic;
    END;
    SetGraphMode;
    GrafikModus := TRUE;
  END GrafScreen;

  PROCEDURE TextScreen;
  BEGIN
    IF GrafikModus THEN
      RestoreCrtMode;
      GrafikModus := FALSE;
    END;
  END TextScreen;

  (* in den Textschirm zurückschalten und Bildspeicher    *)
  (* wieder freigeben                                     *)

  PROCEDURE GrafExit;
    VAR
      n : CARDINAL;
  BEGIN
    TextScreen;
    FOR n := 1 TO MaxGrafWindow DO
      WITH GrafWindow[n] DO
        IF Buffer # NIL THEN
        DEALLOCATE(Buffer, WindowSize(n));
        END;
      END;
    END;
  END GrafExit;

BEGIN
                                  (* Variablen vorbelegen *)
  AktivesFenster   := 1;
  GrafikInstalled  := FALSE;
  GrafikModus      := FALSE;
  StiftFarbe       := White;
  ParameterPointer := ADR(Parameter);
  ParameterSeg     := ParameterPointer.SEG;
  ParameterOfs     := ParameterPointer.OFS;
  CA[0]  := Black;         CA[1]  := Blue;
  CA[2]  := Green;         CA[3]  := Cyan;
  CA[4]  := Red;           CA[5]  := Magenta;
  CA[6]  := Brown;         CA[7]  := LightGray;
  CA[8]  := DarkGray;      CA[9]  := LightBlue;
  CA[10] := LightGreen;    CA[11] := LightCyan;
  CA[12] := LightRed;      CA[13] := LightMagenta;
  CA[14] := Yellow;        CA[15] := White;
  (* Programm-Abbruch muß in den Textschirm zurückführen  *)
  TermProcedure(GrafExit);
END Grafik.
(* ------------------------------------------------------ *)
(*                  Ende von GRAFIK.MOD                   *)