home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / sonderh1 / gsxlib2.pas < prev    next >
Pascal/Delphi Source File  |  1979-12-31  |  13KB  |  319 lines
  1. {---------------------------------------------------------------------------}
  2. {                  gsxlib2.pas - Pascal GSX Bibliothek:                     }
  3. {                       GDPs, Eingabe-Funktionen                            }
  4. {---------------------------------------------------------------------------}
  5.  
  6. { Inhalt:
  7.   Bar, Circle_Segment, Circle, Graph_Chars, Get_Color, Get_Cell_Array,
  8.   Set_Input_Mode, Locate, Valuate, Choice, Input_String                     }
  9.  
  10. {**-----------------------------------------------------------------------**}
  11. {** Hier folgen die Generalized-Drawing-Primitives. Diese Zeichenmakros   **}
  12. {** sind von 1 (= Bar) bis 5 (= GraphChar) durchnummeriert.               **}
  13. {** Dadurch kann man aus dem Wert von 'GDPs' unmittelbar entnehmen, bis   **}
  14. {** zu welchem GDP diese vom Treiber unterstuetzt werden.                 **}
  15. {** (siehe Begleitartikel: GSX, die unbek. Groesse, Teil 1, Heft 1/87.    **}
  16. {**-----------------------------------------------------------------------**}
  17.  
  18. { Zeichnen eines durch Eckkoordinaten bestimmten Rechtecks. Benutzt werden
  19.   die aktuellen 'Fill'-Attribute.                                           }
  20.  
  21. PROCEDURE Bar (xlb, ylb,                               { linke, untere Ecke }
  22.                xrt, yrt: INTEGER);                     { rechte, obere Ecke }
  23.  
  24. BEGIN
  25.   contrl[1] := 11;     contrl[2] := 2;        contrl[6] := 1;
  26.   ptsin[1] := xlb;     ptsin[2] := ylb;
  27.   ptsin[3] := xrt;     ptsin[4] := yrt;
  28.   VDI_Call(contrl, intin, intout, ptsin, ptsout);
  29. END;
  30.  
  31. {---------------------------------------------------------------------------}
  32. { Ein Kreissegment als Kreisbogen (Arc) oder Tortenstueck (PieSlice) zeich-
  33.   nen. 'xc', 'yc' = Kreismittelpunkt, 'xs', 'ys' gibt den Startpunkt des
  34.   Kreisbogens an, 'angle' den Winkel. Ist 'angle' positiv, wird das Kreis-
  35.   segment im Uhrzeigersinn gezeichnet, andernfalls gegen selbigen.          }
  36.  
  37. PROCEDURE Circle_Segment (SegmentType: Circle_Types;
  38.                           xc, yc, xs, ys, angle: REAL);
  39.  
  40. VAR xe, ye: INTEGER;
  41.     a, b, t, r: REAL;
  42.  
  43. BEGIN
  44.                 { die fehlenden, konsisdenten Parameter fuer GSX berechnen: }
  45.   t := ys-yc;
  46.   r := Sqrt(Sqr(xs-xc)+Sqr(t));
  47.   t := t/r;
  48.   a := ArcTan(t/Sqrt(1-t*t))*180.0/pi;
  49.   IF a < 0 THEN a := 360.0-a;
  50.   b := a-angle;
  51.   IF b < 0 THEN b := 360.0-b;
  52.   t := (180.0-b)*pi/180.0;
  53.   xe := -Round(r*cos(t)-xc);
  54.   ye := Round(r*sin(t)+yc);
  55.  
  56.   contrl[1] := 11;  contrl[2] := 4;  contrl[6] := SegmentType;
  57.   ptsin[1] := Round(xc);  ptsin[2]:= Round(yc);
  58.   IF angle < 0.0 THEN
  59.   BEGIN
  60.     intin[1] := Round(b*10);    intin[2] := Round(a*10);
  61.     ptsin[3] := xe;             ptsin[4] := ye;
  62.     ptsin[5] := Round(xs);      ptsin[6] := Round(ys);
  63.   END
  64.   ELSE
  65.   BEGIN
  66.     intin[1] := Round(a*10);    intin[2] := Round(b*10);
  67.     ptsin[3] := Round(xs);      ptsin[4] := Round(ys);
  68.     ptsin[5] := xe;             ptsin[6] := ye;
  69.   END;
  70.   ptsin[7] := Round(r);
  71.   ptsin[8] := 0;
  72.   VDI_Call(contrl, intin, intout, ptsin, ptsout);
  73. END;
  74.  
  75. {---------------------------------------------------------------------------}
  76. { Einen Kreis, der durch die Koordinaten xc,yc (Mittelpunkt) und xu,yu (auf
  77.   dem Kreis liegend) bestimmt ist, zeichnen. Es werden die aktuellen 'Fill'-
  78.   Attribute benutzt. Die Parameter sind vom Typ REAL, da Turbo-Pascal Pro-
  79.   bleme mit den Zwischenergebnissen bei der Berechnung des Radius (ptsin[5])
  80.   hat.                                                                      }
  81.  
  82. PROCEDURE Circle (xc, yc, xu, yu: REAL);
  83.  
  84. BEGIN
  85.   contrl[1] := 11;        contrl[2] := 3;            contrl[6] := 4;
  86.   ptsin[1] := Round(xc);  ptsin[2] := Round(yc);
  87.   ptsin[3] := Round(xu);  ptsin[4] := Round(yu);
  88.   ptsin[5] := Round(Sqrt(Sqr(xu-xc)+Sqr(yu-yc)));    ptsin[6] := 0;
  89.   VDI_Call(contrl, intin, intout, ptsin, ptsout);
  90. END;
  91.  
  92. {---------------------------------------------------------------------------}
  93. { Zeichenkette mit Grafikzeichen aus dem Sonderzeichensatz mancher Drucker
  94.   (Diablo, Epson) ab der Position x,y drucken.                              }
  95.  
  96. PROCEDURE Graph_Chars (x, y: INTEGER; VAR s: VDI_STRING);
  97.  
  98. BEGIN
  99.   contrl[1] := 11; contrl[2] := 1;  contrl[4] := Length(s);
  100.   ptsin[1] := x;   ptsin[2] := y;
  101.   FOR x := 1 TO Length(s) DO
  102.     intin[x] := Ord(s[x]);
  103.   VDI_Call(contrl, intin, intout, ptsin, ptsout);
  104. END;
  105.  
  106. {---------------------------------------------------------------------------}
  107. {                           Ende der GDPs                                   }
  108. {---------------------------------------------------------------------------}
  109. { Die Prozedur gibt zurueck, wie die Farbe 'Color_Index' aus Rot, Gruen
  110.   und Blau zusammengesetzt ist (s.a. Set_Color). Wenn im Parameter 'Rea-
  111.   lized' TRUE uebergeben wird, wird die vom Geraet tatsaechlich reali-
  112.   sierte Farbmischung zurueckgegeben, sonst die bei der Einstellung mit
  113.   'Set_Color' verlangte. Die Farbwerte werden in Promille (0-1000) zu-
  114.   rueck gegeben.                                                            }
  115.  
  116. PROCEDURE Get_Color (Color: Color_Index; Realized: BOOLEAN;
  117.                      VAR Red, Green, Blue: INTEGER);
  118.  
  119. BEGIN
  120.   contrl[1] := 26;       contrl[2] := 0;
  121.   intin[1] := Color;     intin[2] := Ord(Realized);
  122.   VDI_Call(contrl, intin, intout, ptsin, ptsout);
  123.   VDI_Error := (contrl[3] <> 0) OR (intout[1] <> Color);
  124.   Red := intout[2];
  125.   Green := intout[3];
  126.   Blue := intout[4]
  127. END;
  128.  
  129. {---------------------------------------------------------------------------}
  130. { Fol. Prozedur holt in Umkehrung von 'Cell_Array' die Farbmusterdefintion
  131.   einer Flaeche. Falls ein Pixel nicht eindeutig einer Farbe zugeordnet
  132.   werden kann, wird 'Invalid' gleich TRUE gesetzt. Falls im 'ColorIndex-
  133.   Array nach dem Prozedur-Aufruf fuer einen Pixel der Farbindex -1 steht,
  134.   konnte dieser nicht bestimmt werden. Weiteres siehe Begleittext.          }
  135.  
  136. PROCEDURE Get_Cell_Array (xlb, ylb,                    { linke, untere Ecke }
  137.                           xrt, yrt: INTEGER;           { rechte, obere Ecke }
  138.                           VAR Rows,
  139.                               Columns: INTEGER;
  140.                           VAR ColorIndexArray: VDI_intout;
  141.                           VAR Invalid: BOOLEAN);
  142.  
  143. BEGIN
  144.   contrl[1] := 27;  contrl[2] := 2;
  145.   contrl[4] := Rows*Columns;  contrl[6] := Columns;  contrl[7] := Rows;
  146.   ptsin[1] := xlb;  ptsin[2] := ylb;
  147.   ptsin[3] := xrt;  ptsin[4] := yrt;
  148.   VDI_Call(contrl, intin, ColorIndexArray, ptsin, ptsout);
  149.   Columns := contrl[8];           Rows := contrl[9];
  150.   Invalid := (contrl[10] = 1);
  151. END;
  152.  
  153. {---------------------------------------------------------------------------}
  154. {                          GSX-Eingabefunktionen                            }
  155. {---------------------------------------------------------------------------}
  156. { Eingabe-Modus fuer das logisches Geraet 'Device' setzen.
  157.   'Mode = Request' bewirkt, dass auf ein Eingabeereignis gewartet wird,
  158.   bevor zum Anwenderprogramm zurueckgekehrt wird. Bei 'Mode = Sample'
  159.   wird der aktuelle Status bzw. die aktuelle Position des Eingabe-Geraetes
  160.   o h n e  Warten zurueckgegeben.                                           }
  161.  
  162. FUNCTION Set_Input_Mode (Device: Input_Devices;
  163.                            Mode: Input_Modes): Input_Modes;
  164.  
  165. BEGIN
  166.   contrl[1] := 33;     contrl[2] := 0;
  167.   intin[1] := Device;  intin[2] := Mode;
  168.   VDI_Call(contrl, intin, intout, ptsin, ptsout);
  169.   Set_Input_Mode := intout[1];
  170. END;
  171.  
  172. {---------------------------------------------------------------------------}
  173. { Position des spez. Positionierungs-Gerates in Geraete-Koordinaten zurueck-
  174.   geben.
  175.   Request-Mode:
  176.     Auf dem Bildschirm erscheint ein Graphik-Cursor an der Position (x,y),
  177.     der abhaengig vom 'Locator_Device' mit den Cursortasten, Maus oder Joy-
  178.     stick manoevriert werden kann, bis ein Tastendruck folgt.
  179.     Die gedrueckte Taste wird als CHARacter in 'terminator' zurueckgegeben.
  180.     In x und y stehen die neuen Cursor-Koordinaten.
  181.   Sample-Mode:
  182.     Sinngemaess wie Request, der Cursor wird jedoch nicht dargestellt und
  183.     auch kein Abschluss der Eingabe durch Tastendruck erwartet.
  184.     Wenn die Koordinaten geaendert wurden, werden die neuen zurueckgegeben.
  185.     Findet ein Tastendruck statt, wird das entspr. Zeichen zurueckgegeben.
  186.     Geschieht nichts, wird auch nichts zurueckgegeben.
  187.  Fuer beide Modis gilt: 'terminator' = Char(0), wenn keine abschliessen-
  188.  de Taste gedrueckt wurde. Wenn das abschliessende Zeichen nicht von der
  189.  Tastatur sondern z.B. von einer Maus kommt, geben die Maustasten in auf-
  190.  steigender Reihenfolge char(32), char(33), char(34)... zurueck.            }
  191.  
  192. PROCEDURE Locate (Locator: Locator_Devices; InputMode: Input_Modes;
  193.                   VAR x, y: INTEGER; VAR terminator: CHAR);
  194.  
  195. BEGIN
  196.   contrl[1] := 28;     contrl[2] := 1;
  197.   intin[1] := Locator;
  198.   ptsin[1] := x;       ptsin[2] := y;
  199.   VDI_Call(contrl, intin, intout, ptsin, ptsout);
  200.   VDI_Error := FALSE;
  201.   terminator := Char(0);
  202.   IF InputMode = Request THEN
  203.     BEGIN
  204.       IF (contrl[5] = 0) THEN
  205.         VDI_Error := TRUE
  206.       ELSE
  207.         terminator := Char(intout[1]);
  208.       x := ptsout[1];
  209.       y := ptsout[2];
  210.     END
  211.   ELSE
  212.     BEGIN
  213.       IF (contrl[5] = 1) THEN
  214.         terminator := Char(intout[1]);
  215.       IF (contrl[3] = 1) THEN
  216.       BEGIN
  217.         x := ptsout[1];
  218.         y := ptsout[2];
  219.       END;
  220.     END;
  221. END;
  222.  
  223. {---------------------------------------------------------------------------}
  224. { Denn Wert der Variable 'Value' mit z.B einem Paddle oder den Cursor-up-
  225.   und Cursor-down-Tasten aendern. Auch hier die Unterscheidung zwischen den
  226.   beiden Input-Modis wie bei 'Locate'.
  227.   Typische Implementation der Cursor-Tasten:
  228.     Cursor-up addiert 10 zu 'Value', Cursor-down subtrahiert entsprechend.
  229.     Wird eine der beiden Tasten zusammen mit SHIFT gedrueckt, wird entspr.
  230.     1 addiert bzw. subtrahiert.                                             }
  231.  
  232. PROCEDURE Valuate (InputMode: Input_Modes;
  233.                    VAR Value: INTEGER; VAR terminator: CHAR);
  234.  
  235. BEGIN
  236.   contrl[1] := 29;  contrl[2] := 0;  intin[2] := Value;
  237.   VDI_Call(contrl, intin, intout, ptsin, ptsout);
  238.   terminator := Char(0);
  239.   IF InputMode = Request THEN
  240.     BEGIN
  241.       Value := intout[1];
  242.       terminator := Char(intout[2]);
  243.     END
  244.   ELSE
  245.     BEGIN
  246.       IF (contrl[5] = 1) THEN
  247.         Value := intout[1];
  248.       IF (contrl[5] = 2) THEN
  249.         terminator := Char(intout[2]);
  250.     END;
  251. END;
  252.  
  253. {---------------------------------------------------------------------------}
  254. { Auswahl vom selektierten 'Wahl'-Geraet. 'Device' = 1 entspricht den
  255.   Funktions-Tasten, 'Device' > 1 ist geraeteabhaengig. Die Funktions-
  256.   Tasten sind von 1 an aufsteigend durchnummeriert, wobei die Anzahl
  257.   geraeteabhaengig ist. Im Request-Modus wird solange gewartet, bis
  258.   eine gueltige Funktions-Taste gedrueckt wurde; ihre Nummer wird zu-
  259.   rueckgegeben. Im Sample-Modus wird ebenfalls die Nummer einer Funk-
  260.   tions-Taste zurueckgegeben, falls eine gedrueckt wurde. Wurde eine
  261.   Nicht-Funktions-Taste gedrueckt, so wird ihr  n e g a t i v e r  Wert
  262.   als Terminator zurueckgegeben. Wurde keine Taste gedrueckt, wird der
  263.   Wert 0 geliefert.                                                         }
  264.  
  265. FUNCTION Choice (Device: INTEGER; InputMode: Input_Modes): INTEGER;
  266.  
  267. BEGIN
  268.   contrl[1] := 30;  contrl[2] := 0;  intin[1] := Device;
  269.   VDI_Call(contrl, intin, intout, ptsin, ptsout);
  270.   IF InputMode = Request THEN
  271.     Choice := intout[1]
  272.   ELSE
  273.     CASE contrl[5] OF
  274.       0: Choice := 0;
  275.       1: Choice := intout[1];
  276.       2: Choice := -intout[2];
  277.     END;
  278. END;
  279.  
  280. {---------------------------------------------------------------------------}
  281. { Zeichenkette vom spez. Geraet einlesen, falls dieses dafuer geeignet.
  282.   'Device' = 1 ist die Tastatur der Konsole. Andere Werte fuer 'Device'
  283.   sind geraeteabhaengig.
  284.   Request-Modus:
  285.     Es werden solange Zeichen eingelesen, bis RETURN/ENTER eingegeben oder
  286.     'maxlen' erreicht wird. Wenn 'Echo' = TRUE, so wird der Text in den
  287.     aktuellen Text-Attributen ab der Position (x,y) auf dem Bildschirm
  288.     dargestellt.
  289.   Sample-Modus:
  290.     Es werden die im Puffer 'anstehenden' Zeichen eingelesen, bis eine
  291.     der folgenden Bedingungen eintritt:
  292.     - es ist kein weiteres Zeichen verfuegbar
  293.     - RETURN/ENTER wurde angetroffen
  294.     - 'maxlen' wurde erreicht
  295.     Es wird sofort zum Programm zurueckgekehrt, wenn keine Eingabe vorliegt.
  296.  
  297. PROCEDURE Input_String (Device, maxlen: INTEGER;
  298.                        InputMode: Input_Modes;
  299.                        Echo: BOOLEAN; x, y: INTEGER;
  300.                        VAR st: VDI_STRING);
  301.  
  302. BEGIN
  303.   contrl[1] := 31;  intin[1] := Device;  intin[2] := maxlen;
  304.   IF InputMode = Sample THEN
  305.     contrl[2] := 0
  306.   ELSE
  307.   BEGIN
  308.     contrl[2] := Ord(Echo);    intin[3] := contrl[2];
  309.     ptsin[1] := x;             ptsin[2] := y;
  310.   END;
  311.   VDI_Call(contrl, intin, intout, ptsin, ptsout);
  312.   st[0] := contrl[5];
  313.   FOR x := 1 TO contrl[5] DO
  314.     st[x] := Char(intout[x]);
  315. END;
  316.  
  317. {---------------------------------------------------------------------------}
  318. {                         Ende von gsxlib2.pas                              }
  319.