home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / spezial / 09 / schrift / plscript.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1989-03-22  |  10.4 KB  |  335 lines
  1. UNIT PlScript;
  2. (* V.1.0.a vom 07.01.1989 *)
  3. (* Überarbeitete Version von MyVec.Pas / (c) 1988 D. Bückart u. DMV-Verlag *)
  4. (* ..  veröffentlicht auf der Disk. FontEdit V.2.0 *)
  5.  
  6. INTERFACE
  7.  
  8. USES HPGL, GRAPH, DOS;
  9.  
  10. TYPE
  11.     ByteArray = ARRAY [0..30000] OF BYTE;
  12.  
  13.     ByteArrayPtr= ^ByteArray;
  14.         FontRec = RECORD
  15.                    Offset,
  16.                    CHR_Pos,
  17.                    Anzahl,
  18.            Min_Char,
  19.                    VecStart,
  20.                    Hoehe,
  21.                    Unter,
  22.                    VecTab,
  23.                    Breiten   : INTEGER;
  24.                    Loaded    : BOOLEAN;
  25.                    CHR_Length: INTEGER;
  26.                    RamFont   : BOOLEAN;
  27.                    Puffer    : ByteArrayPtr;
  28.                   END;
  29.         FontPtr = ^FontRec;
  30.  
  31. FontDescribeRec = RECORD
  32.                    Name      : String[4];
  33.                    FileName  : String[64];
  34.                    Font      : FontPtr;
  35.                   END;
  36.  
  37. CONST MaxFonts = 7;
  38.        FontArray: ARRAY [1..MaxFonts] OF FontDescribeRec =
  39.          ( (Name: 'TRIP'; FileName: 'TRIP.CHR'; Font: NIL),
  40.            (Name: 'LITT'; FileName: 'LITT.CHR'; Font: NIL),
  41.            (Name: 'SANS'; FileName: 'SANS.CHR'; Font: NIL),
  42.            (Name: 'GOTH'; FileName: 'GOTH.CHR'; Font: NIL),
  43.        (Name: 'GREK'; FileName: 'GREK.FE2'; Font: NIL),
  44.        (Name: 'SCRI'; FileName: 'SCRI.FE2'; Font: NIL),
  45.        (Name: 'SCR2'; FileName: 'SCR2.FE2'; Font: NIL)
  46.          );
  47.  
  48.      Trip : INTEGER = 1;   Litt : INTEGER = 2;   Sans : INTEGER = 3;
  49.      Goth : INTEGER = 4;   Grek : INTEGER = 5;   Scri : INTEGER = 6;
  50.      Scr2 : INTEGER = 7;
  51.  
  52. VAR Farbe : ARRAY [1..80] OF BYTE;
  53.     (* Stiftnummer / Zeichen des Textes *)
  54.  
  55.   PROCEDURE SetTextStyle (Font, Direction, CharSize: INTEGER);
  56.   PROCEDURE SetUserCharSize (MultX,DivX, MultY,DivY: INTEGER);
  57.   PROCEDURE SetTextJustIFy (Horiz, Vert: INTEGER);
  58.   FUNCTION TextHeight(Text: String): INTEGER;
  59.   FUNCTION TextWidth (Text: String): INTEGER;
  60.   PROCEDURE OuttextXY (x,y: INTEGER; Text: STRING);
  61.   PROCEDURE GetTextSettings (VAR TextInfo : TextSettingsType);
  62. (*-----------------------------------------------*)
  63. IMPLEMENTATION
  64.  
  65.  CONST
  66.        VDONE = 0;
  67.        VDUMMY= 1;
  68.        VMOVE = 2;
  69.        VLINE = 3;
  70.  
  71.     SizeArray : ARRAY [1..26] OF REAL =
  72.         (  0.571428571, 0.642857143, 0.75, 1, 1.321428571,
  73.            1.642857143, 2, 2.5, 3, 4, 5, 6, 7, 8, 9, 10, 11,
  74.            12, 13, 14, 15, 16, 17, 18, 19, 20  );
  75.  
  76. VAR
  77.    _Font_,
  78.    _JustX_,_JustY_,
  79.    _UserMultX_, _UserMultY_,
  80.    _UserDivX_, _UserDivY_ ,
  81.    _Direction_,
  82.    _CharSize_                 : INTEGER;
  83.  
  84.    DrawFont : FontPtr;
  85.    TextInfo : TextSettingsType;
  86. (*-----------------------------------------------*)
  87. PROCEDURE SwapVars (VAR a,b: INTEGER);
  88. VAR x: INTEGER;
  89. BEGIN  x:=a;  a:=b;  b:=x;  END;
  90. (*-----------------------------------------------*)
  91. FUNCTION CHR_Laden (VAR a: FontDescribeRec) : INTEGER;
  92. VAR  x        : INTEGER;
  93.      CHR_File : File;
  94. BEGIN
  95.   WITH a.Font^ DO
  96.   BEGIN
  97.     ASSIGN (CHR_File, a.FileName);
  98.     {$I-} RESET (CHR_File,1); {$I+}
  99.     DosError := IOResult;
  100.  
  101.     IF DosError <>0 THEN BEGIN CHR_Laden := -8; EXIT; END;
  102.  
  103.     CHR_Length := FileSize (CHR_File);
  104.  
  105.     IF CHR_Length > MaxAvail THEN BEGIN CHR_Laden := -9; EXIT; END;
  106.  
  107.     GetMem (Puffer, CHR_Length);
  108.     BlockRead (CHR_File, Puffer^, CHR_Length);
  109.     Close(CHR_File);
  110.  
  111.     x:= 0;
  112.     WHILE (x<$80) AND (Puffer^[x] <> $1A) DO INC (x);
  113.     IF x=$80 THEN BEGIN  CHR_Laden:= -2;  EXIT;  END;
  114.  
  115.     INC (x);
  116.     OffSet:= Puffer^[x] + Puffer^[x+1] SHL 8;
  117.     INC (x,6);
  118.     CHR_Pos:= x;                     { Start der Daten }
  119.  
  120. { ********** diese zusätzliche Prüfung kostet überfüssige Zeit ***** }
  121. {       IF Puffer^[x] + Puffer^[x+1] SHL 8 + OffSet <> CHR_Length THEN
  122.     BEGIN CHR_Laden:= -3;  EXIT;  END;
  123. }
  124.  
  125.     Anzahl     := Puffer^[OffSet+1];            { Anzahl der Definitionen }
  126.     MIN_Char   := Puffer^[OffSet+4];            { kleinstes ASCII-Zeichen }
  127.     VecStart   := Puffer^[OffSet+5] + Puffer^[OffSet+6] SHL 8; { Vektorenstart }
  128.     Hoehe      := Puffer^[OffSet+8];            { Höher der Großbuchstaben }
  129.     Unter      := ShortInt(Puffer^[OffSet+10]); { Unterlänge der Zeichen }
  130.     VecTab     := OffSet + $10;                 { Vektor-Tabelle für Adressen }
  131.     Breiten    := VecTab + Anzahl SHL 1;        { Breitentabelle }
  132.     Loaded     := True;
  133.     RamFont    := False;
  134.     CHR_Laden  := 0;
  135.   END;
  136. END;
  137. (*-----------------------------------------------*)
  138. PROCEDURE Use_nth_Font (n: INTEGER);
  139. {Wird von Settextstyle aufgerufen}
  140. VAR Error: INTEGER;
  141. BEGIN
  142.   NEW (FontArray[n].Font);
  143.   Error := CHR_Laden (FontArray[n]);
  144.  
  145.   (* hier kann eine Fehlerausgabe eingefügt werden ! *)
  146.  
  147.   DrawFont := FontArray[n].Font;
  148. END;
  149. (*-----------------------------------------------*)
  150. PROCEDURE SetTextStyle (Font, Direction, CharSize: INTEGER);
  151. BEGIN
  152.   _Font_      := Font;
  153.   _Direction_ := Direction;
  154.   _CharSize_  := CharSize;
  155.   IF (Font IN [1..MaxFonts]) THEN Use_nth_Font (Font) ELSE Halt;
  156.   Graph.SetTextStyle (Font, Direction, CharSize);
  157. END;
  158. (*-----------------------------------------------*)
  159. PROCEDURE SetUserCharSize (MultX, DivX, MultY, DivY: INTEGER);
  160. BEGIN
  161.   _UserMultX_:= MultX;
  162.   _UserMultY_:= MultY;
  163.   _UserDivY_ := DivY;
  164.   _UserDivX_ := DivX;
  165.   Graph.SetUserCharSize (MultX, DivX, MultY, DivY);
  166. END;
  167. (*-----------------------------------------------*)
  168. PROCEDURE SetTextJustify (Horiz, Vert: INTEGER);
  169. BEGIN
  170.   _JustX_:= Horiz;
  171.   _JustY_:= Vert;
  172.   Graph.SetTextJustify (Horiz, Vert);
  173. END;
  174. (*-----------------------------------------------*)
  175. FUNCTION CharIndex (ch : Char) : INTEGER;
  176. {Berechnen der Adresse der Definitionen}
  177. VAR x : INTEGER;
  178. BEGIN
  179.   WITH DrawFont^ DO
  180.   BEGIN
  181.     x:= (Ord(ch) - MIN_Char) SHL 1;
  182.     CharIndex :=
  183.       Puffer^[x+VecTab] + 256*Puffer^[x+VecTab+1] + VecStart + OffSet;
  184.   END;
  185. END;
  186. (*-----------------------------------------------*)
  187. FUNCTION CharBreite (ch : Char) : INTEGER;
  188. {Holt die Breite aus der Breiten-Tabelle}
  189. VAR x : INTEGER;
  190. BEGIN
  191.   WITH DrawFont^ DO
  192.   BEGIN
  193.     x:= (Ord(ch) - MIN_Char);
  194.     CharBreite := Puffer^[x+Breiten];
  195.   END;
  196. END;
  197. (*-----------------------------------------------*)
  198. FUNCTION CharWidth (c: Char): INTEGER;
  199. {Berechnet die Breite eines einzelnen Zeichens.}
  200. VAR ComSizeX: Real;
  201. BEGIN
  202.   IF _CharSize_ = 0 THEN ComSizeX:= _UserMultX_ / _UserDivX_
  203.                     ELSE ComSizeX:= SizeArray[_CharSize_];
  204.  
  205.   CharWidth:= Round (CharBreite (c)*ComSizeX);
  206. END;
  207. (*-----------------------------------------------*)
  208. FUNCTION TextHeight (Text: STRING) : INTEGER;
  209. VAR ComSizeY: Real;
  210. BEGIN
  211.   IF _CharSize_ = 0 THEN ComSizeY:= _UserMultY_ / _UserDivY_
  212.                     ELSE ComSizeY:= SizeArray[_CharSize_];
  213.   TextHeight:= Trunc ( (DrawFont^.Hoehe - DrawFont^.Unter) * ComSizeY);
  214. END;
  215. (*-----------------------------------------------*)
  216. FUNCTION TextWidth (Text: STRING) : INTEGER;
  217. VAR i,r: INTEGER;
  218. BEGIN
  219.   r:=0;
  220.   FOR i:=1 TO LENGTH (Text) DO INC (r,CharWidth(Text[i]));
  221.   TextWidth:= r;
  222. END;
  223. (*-----------------------------------------------*)
  224. PROCEDURE GetTextSettings (VAR TextInfo : TextSettingsType);
  225. BEGIN
  226.   WITH TextInfo DO
  227.   BEGIN
  228.     Font      := _font_;
  229.     Direction := _direction_;
  230.     CharSize  := _CharSize_;
  231.     Horiz     := _justX_;
  232.     Vert      := _justY_;
  233.   END;
  234. END;
  235. (*-----------------------------------------------*)
  236. PROCEDURE PaintChar (Pos, X, Y, Size : INTEGER);
  237. VAR
  238.    XVec, YVec, Code   : INTEGER;
  239.    ComSizeX, ComSizeY : REAL;
  240. BEGIN
  241.   IF Size = 0 THEN BEGIN
  242.                      ComSizeX:= _UserMultX_ / _UserDivX_;
  243.                      ComSizeY:= _UserMultY_ / _UserDivY_;
  244.                    END
  245.               ELSE BEGIN
  246.                      ComSizeX:= SizeArray[Size];
  247.                      ComSizeY:= ComSizeX;
  248.                    END;
  249.   REPEAT
  250.     WITH DrawFont^ DO
  251.     BEGIN
  252.       XVec := Puffer^[Pos];
  253.       INC (Pos);
  254.       YVec := Puffer^[Pos];
  255.       INC (Pos);
  256.     END;
  257.  
  258.     Code := (XVec AND $80) SHR 6 + (YVec AND $80) SHR 7;
  259.     XVec := XVec AND $7F;
  260.     YVec := YVec AND $7F;
  261.     IF XVec >= $40 THEN XVec := -128 + XVec;  { geht schneller so }
  262.     IF YVec >= $40 THEN YVec := -128 + YVec;
  263.  
  264.     XVec := TRUNC (XVEC * ComSizeX);
  265.     YVec := TRUNC (YVec * ComSizeY);
  266.  
  267.     IF _Direction_= VertDir THEN
  268.        BEGIN SwapVars (XVec,YVec);  XVec:= -XVec;  END;
  269.  
  270.      CASE Code of
  271.      VMOVE : P_MoveTo (X + XVec, Y + YVec);
  272.      VLINE : P_LineTo (X + XVec, Y + YVec);
  273.      END;
  274.  
  275.   UNTIL Code = VDONE;
  276. END;
  277. (*-----------------------------------------------*)
  278. PROCEDURE _Outtext (x,y : INTEGER; Text : String);
  279. VAR i : INTEGER;
  280. BEGIN
  281.   IF _Direction_ = HorizDir THEN
  282.   BEGIN
  283.     IF _JustY_ = TopText THEN INC (y, TextHeight (Text));
  284.     IF _JustY_ = CenterText THEN INC (y, TextHeight (Text) DIV 2);
  285.     IF _JustX_ = RightText  THEN DEC(x, TextWidth  (Text));
  286.     IF _JustX_ = CenterText THEN DEC(x, TextWidth  (Text) DIV 2);
  287.   END
  288.   ELSE
  289.   BEGIN
  290.     IF _JustY_ = TopText THEN INC (y, TextWidth  (Text));
  291.     IF _JustY_ = CenterText THEN INC (y, TextWidth  (Text) DIV 2);
  292.     IF _JustX_ = RightText  THEN DEC(x, TextHeight (Text));
  293.     IF _JustX_ = CenterText THEN DEC(x, TextHeight (Text) DIV 2);
  294.   END;
  295.  
  296.   FOR i:=1 TO LENGTH (Text) DO
  297.     BEGIN
  298.      P_SetColor (Farbe [i]);
  299.      (* ^ siehe Anmerkung im Beitrag ! *)
  300.      PaintChar (CharIndex (Text[i]), X, Y, _CharSize_);
  301.      IF _Direction_ = HorizDir THEN x := x + CharWidth (Text [i])
  302.                    ELSE y := y + CharWidth (Text [i]);
  303.     END;
  304.  
  305.   IF _Direction_ = HorizDir THEN
  306.   BEGIN
  307.     IF _JustY_ = TopText    THEN DEC (y, TextHeight (Text));
  308.     IF _JustY_ = CenterText THEN DEC (y, TextHeight (Text) DIV 2);
  309.     IF _JustX_ = CenterText THEN DEC (x, TextWidth  (Text) DIV 2);
  310.   END
  311.   ELSE
  312.   BEGIN
  313.     IF _JustY_ = BottomText THEN INC (y, TextWidth (Text));
  314.     IF _JustY_ = CenterText THEN INC (y, TextWidth (Text) DIV 2);
  315.     IF _JustX_ = RightText  THEN INC (x, TextHeight (Text));
  316.     IF _JustX_ = CenterText THEN INC (x, TextHeight (Text) DIV 2);
  317.   END;
  318. END;
  319. (*-----------------------------------------------*)
  320. PROCEDURE OutTextXY (x, y : INTEGER; Text: STRING);
  321. BEGIN  _OutText (x, y, Text);  END;
  322. (*-----------------------------------------------*)
  323.  BEGIN { Initialisierungen }
  324.    DrawFont     := NIL;
  325.    _Font_       := 0;
  326.    _JustX_      := 0;
  327.    _JustY_      := 2;
  328.    _UserMultX_  :=1;
  329.    _UserMultY_  :=1;
  330.    _UserDivX_   :=1;
  331.    _UserDivY_   :=1;
  332.    _Direction_  :=0;
  333.    _CharSize_   :=4;
  334.  END.
  335.