home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 07 / vgraf / chr.mod < prev    next >
Encoding:
Modula Implementation  |  1989-05-03  |  8.6 KB  |  304 lines
  1. (*******************************************************)
  2. (*                      CHR.MOD                        *)
  3. (*       Implementationmodul des CHR-Moduls            *)
  4. (*       Treiberroutinen für BGI-Zeichensätze          *)
  5. (*         (C) 1989 R.Hensmann & TOOLBOX               *)
  6.  
  7. IMPLEMENTATION MODULE Chr;
  8.  
  9. FROM FIO      IMPORT IOcheck,Open,Close,Size,File, RdBin;
  10. FROM Storage  IMPORT ALLOCATE, DEALLOCATE;
  11. FROM Lib      IMPORT FatalError;
  12. FROM Str      IMPORT Concat, Compare, Length, Caps;
  13. FROM Graph    IMPORT Line, NumColor, Width, Depth;
  14.  
  15. CONST  MaxTable = 24;
  16.  
  17. TYPE Tiny       = SET OF [0..7];
  18.      ChrString  = ARRAY [0..3] OF CHAR;
  19.      (* Allgemeiner Datenpuffer *)
  20.      Buffer     = POINTER TO TBuffer;
  21.      TBuffer    = ARRAY CARDINAL OF SHORTCARD;
  22.      (* Interne Daten frei nach Arne Schäpers *)
  23.      PStart     = POINTER TO RECORD
  24.                    StartInhalt  : CARDINAL;
  25.                    Name         : ChrString;
  26.                    LengthInhalt,
  27.                    MinVersion,
  28.                    MaxVersion   : CARDINAL;
  29.                   END;
  30.      PHeader    = POINTER TO RECORD
  31.                    (* Unbekannter Zweck *)
  32.                    UnKnown      : BYTE;
  33.                    (* Anzahl der Zeichen *)
  34.                    TblSize      : SHORTCARD;
  35.                    Unused1      : WORD;
  36.                    (* Erstes definiertes Zeichen *)
  37.                    MinChar      : CHAR;
  38.                    (* Start der Vektortabelle *)
  39.                    VecStart     : CARDINAL;
  40.                    Unused2      : BYTE;
  41.                    (* Pixelhöhe *)
  42.                    PixelH       : SHORTCARD;
  43.                    Unused3      : BYTE;
  44.                    (* Unterlänge (negativ) *)
  45.                    UnderL       : SHORTINT;
  46.                    Unused4      : ARRAY [0..4] OF BYTE;
  47.                    (* Start der Vektor-Adresstab. *)
  48.                    VecAddress   : WORD;
  49.                   END;
  50.      (* Addresstabelle *)
  51.      PAddress   = POINTER TO ARRAY SHORTCARD OF CARDINAL;
  52.      (* Breitentabelle *)
  53.      PWidth     = POINTER TO ARRAY SHORTCARD OF SHORTCARD;
  54.      (* Einträge in interne Tabelle *)
  55.      ChrEntry   = RECORD
  56.                     Name     : ChrString;
  57.                     Header   : PHeader;
  58.                     Address  : PAddress;
  59.                     Width    : PWidth;
  60.                     Vec      : Buffer;
  61.                     Buf      : Buffer;
  62.                   END;
  63.      ChrTable   = ARRAY [0..MaxTable] OF ChrEntry;
  64.      TIdentTable = ARRAY[0..MaxTable] OF ChrString;
  65.  
  66. VAR TextStyles  : ChrTable;
  67.     MaxEntry    : CARDINAL;
  68.     ActStyle    : ChrEntry;
  69.     Horiz       : BOOLEAN;
  70.     ScaleX, ScaleY : CARDINAL;
  71.     IdentTable : TIdentTable;
  72.     i : INTEGER;
  73.  
  74.  
  75. (*$V-*)
  76. PROCEDURE LoadDriver( Name : ARRAY OF CHAR ) : ADDRESS;
  77.   (* Lädt File in internen Puffer *)
  78. VAR IOold    : BOOLEAN;
  79.     Data     : File;
  80.     SizeChr,
  81.     Hilf     : CARDINAL;
  82.     Satz     : Buffer;
  83. BEGIN
  84.   IOold:=IOcheck;
  85.   IOcheck:=FALSE;
  86.   Data:=Open(Name);
  87.   IF CARDINAL(Data) = MAX(CARDINAL) THEN
  88.     IOcheck:=IOold;
  89.     RETURN NIL;
  90.   END;
  91.   SizeChr := CARDINAL(Size(Data));
  92.   ALLOCATE(Satz, SizeChr);
  93.   Hilf := RdBin( Data, Satz^, SizeChr );
  94.   IF (Satz^[0]<>50H) OR (Satz^[1]<>4BH)
  95.      OR (Hilf <> SizeChr) THEN
  96.     DEALLOCATE(Satz, SizeChr);
  97.     IOcheck:=IOold;
  98.     RETURN NIL;
  99.   END;
  100.   Close(Data);
  101.   IOcheck:=IOold;
  102.   RETURN Satz;
  103. END LoadDriver;
  104.  
  105. PROCEDURE RegisterFont( BufAdr : ADDRESS );
  106.   (* Trägt Puffer in Tabelle ein *)
  107. VAR Hilf,Segment : Buffer;
  108.     Start        : CARDINAL;
  109.     HStart       : PStart;
  110. BEGIN
  111.  Hilf:=BufAdr;
  112.  Start:=3;
  113.  WHILE (Hilf^[Start] # 1AH) DO
  114.   INC(Start);
  115.  END;
  116.  HStart := ADR(Hilf^[Start+1]);
  117.  WITH ActStyle DO
  118.   Name := HStart^.Name;
  119.   Header := ADR( Hilf^[HStart^.StartInhalt] );
  120.   Segment := ADDRESS(Header);
  121.   Address := ADR( Segment^[10H] );
  122.   Width := ADR( Segment^[10H+2*CARDINAL(Header^.TblSize)] );
  123.   Vec := ADR( Segment^[Header^.VecStart] );
  124.   Buf := Hilf;
  125.  END; (* WITH *)
  126.  IF MaxEntry <= MaxTable THEN
  127.   TextStyles[MaxEntry] := ActStyle;
  128.   IdentTable[MaxEntry] := ActStyle.Name;
  129.   INC(MaxEntry);
  130.  ELSE
  131.   FatalError("Zu viele CHR-Zeichensätze");
  132.  END;
  133. END RegisterFont;
  134.  
  135. PROCEDURE InstallUserFont(Name : ARRAY OF CHAR) : INTEGER;
  136.  
  137. VAR Buffer : ADDRESS;
  138.  
  139. BEGIN
  140.   Buffer := LoadDriver(Name);
  141.   RegisterFont(Buffer);
  142.   RETURN (MaxEntry - 1);
  143. END InstallUserFont;
  144.  
  145. PROCEDURE TextStyle( Name       : ARRAY OF CHAR;
  146.                      Horizontal : BOOLEAN;
  147.                      NewScaleX,
  148.                      NewScaleY  : CARDINAL);
  149.  (* Wählt Font aus - nur die ersten vier Buchstaben
  150.     von Name sind signifikant                       *)
  151. VAR Lauf : CARDINAL;
  152.     Buf  : Buffer;
  153.     Filename : ARRAY [0..11] OF CHAR;
  154. BEGIN
  155.  Caps(Name);
  156.  Lauf:=0;
  157.  WHILE (Compare(TextStyles[Lauf].Name,Name) # 0)
  158.        AND (Lauf<MaxEntry) DO
  159.   INC(Lauf);
  160.  END;
  161.  IF Lauf = MaxEntry THEN
  162.   Concat(Filename,Name,".CHR");
  163.   Buf:=LoadDriver(Filename);
  164.   IF Buf=NIL THEN
  165.    FatalError("Datei nicht gefunden !");
  166.   END;
  167.   RegisterFont( Buf );
  168.  ELSE
  169.   ActStyle:=TextStyles[Lauf];
  170.  END;
  171.  Horiz:=Horizontal;
  172.  ScaleX:=NewScaleX;
  173.  ScaleY:=NewScaleY;
  174. END TextStyle;
  175.  
  176. PROCEDURE SetTextStyle(Font : CARDINAL;
  177.                        Direction : CARDINAL;
  178.                        CharSize : CARDINAL    );
  179. BEGIN
  180.    TextStyle(IdentTable[Font],
  181.              (Direction=HorizDir),
  182.              CharSize,CharSize);
  183. END SetTextStyle;
  184.  
  185. PROCEDURE OutCharXY( X,Y : CARDINAL; Ch : CHAR);
  186.   (* Gibt ein Zeichen an der vorgegebenen Stelle aus *)
  187. VAR Lvec         : CARDINAL;
  188.     XVec, YVec   : SHORTINT;
  189.     WertX, WertY,
  190.     OldX, OldY   : CARDINAL;
  191.     MinCh        : CHAR;
  192.     PixelH       : SHORTINT;
  193.     WriteIt      : BOOLEAN;
  194.  
  195. BEGIN
  196.  MinCh :=ActStyle.Header^.MinChar;
  197.  PixelH:=ActStyle.Header^.PixelH;
  198.  IF (Ch<MinCh)
  199.      OR (SHORTCARD(Ch)
  200.          >= SHORTCARD(MinCh)+ActStyle.Header^.TblSize) THEN
  201.    RETURN
  202.  END;
  203.  OldX:=X;
  204.  OldY:=Y;
  205.  WITH ActStyle DO
  206.    Lvec:=Address^[SHORTCARD(Ch)-SHORTCARD(MinCh)];
  207.    LOOP
  208.      XVec:=SHORTINT(Vec^[Lvec  ]);
  209.      YVec:=SHORTINT(Vec^[Lvec+1]);
  210.      IF 7 IN Tiny(XVec) THEN
  211.        WriteIt:= 7 IN Tiny(YVec);
  212.        XVec:=(XVec << 1) >> 1;
  213.        YVec:=(YVec << 1) >> 1;
  214.        WertX:= CARDINAL(INTEGER(X)
  215.                         +(INTEGER(XVec)
  216.                           *INTEGER(ScaleX)) DIV 16);
  217.        WertY:= CARDINAL(INTEGER(Y)
  218.                         -(INTEGER(YVec-PixelH)
  219.                           * INTEGER(ScaleY)) DIV 16);
  220.        IF WriteIt THEN
  221.          Line(OldX,OldY,WertX,WertY,NumColor-1);
  222.        END;
  223.        OldX:=WertX;
  224.        OldY:=WertY;
  225.        INC(Lvec,2);
  226.      ELSE
  227.        IF NOT (7 IN Tiny(YVec)) THEN
  228.         EXIT;
  229.        END;
  230.      END;
  231.    END; (* LOOP *)
  232.  END (* WITH *)
  233. END OutCharXY;
  234.  
  235. PROCEDURE OutTextXY( X,Y : CARDINAL; Text : ARRAY OF CHAR);
  236.   (* Gibt einen Text an der vorgegebenen Stelle aus *)
  237. VAR Lauf   : CARDINAL;
  238.     MinCh  : SHORTCARD;
  239.     TextH  : CARDINAL;
  240.  
  241. BEGIN
  242.  TextH:=TextHeight(Text);
  243.  MinCh := SHORTCARD(ActStyle.Header^.MinChar);
  244.  FOR Lauf:=0 TO Length(Text) DO
  245.   IF X >= Width THEN RETURN; END;
  246.   IF Y >= Depth THEN RETURN; END;
  247.   OutCharXY( X,Y,Text[Lauf]);
  248.   IF (Text[Lauf]>=CHAR(MinCh))
  249.       AND (SHORTCARD(Text[Lauf])
  250.            < MinCh+ActStyle.Header^.TblSize) THEN
  251.     IF Horiz THEN
  252.      INC(X,(INTEGER(ScaleX)
  253.             *INTEGER(ActStyle.Width
  254.                      ^[SHORTCARD(Text[Lauf])-MinCh]))
  255.              DIV 16 );
  256.     ELSE
  257.      INC(Y, TextH);
  258.     END;
  259.   END;
  260.  END;
  261. END OutTextXY;
  262.  
  263. PROCEDURE TextHeight(Text : ARRAY OF CHAR) : CARDINAL;
  264.   (* Gibt die Texthöhe zurück
  265.      (abhängig von Textart und Skalierung) *)
  266. BEGIN
  267.  WITH ActStyle.Header^ DO
  268.   RETURN
  269.    CARDINAL(((INTEGER(PixelH) - INTEGER(UnderL))
  270.              * INTEGER(ScaleY))) DIV 16;
  271.  END;
  272. END TextHeight;
  273.  
  274. PROCEDURE TextWidth( Text : ARRAY OF CHAR) : CARDINAL;
  275.   (* Gibt die Textbreite zurück *)
  276. VAR W,Lauf : CARDINAL;
  277.     MinCh  : SHORTCARD;
  278. BEGIN
  279.  MinCh:=SHORTCARD(ActStyle.Header^.MinChar);
  280.  Lauf:=1; W:=0;
  281.  FOR Lauf:=0 TO Length(Text) DO
  282.   IF (Text[Lauf]>=CHAR(MinCh))
  283.       AND (SHORTCARD(Text[Lauf])
  284.            < MinCh+ActStyle.Header^.TblSize) THEN
  285.     INC(W,CARDINAL(ActStyle.Width
  286.            ^[SHORTCARD(Text[Lauf]) - MinCh]));
  287.   END;
  288.  END;
  289.  RETURN ( W * CARDINAL(ScaleX)) DIV 16;
  290. END TextWidth;
  291. (*$V+*)
  292.  
  293. BEGIN
  294.  FOR i := 0 TO MaxTable DO
  295.    IdentTable[i] := "";
  296.  END;
  297.  IdentTable[0] := ""; (* Wäre der Rasterfont *)
  298.  IdentTable[1] := "TRIP";
  299.  IdentTable[2] := "LITT";
  300.  IdentTable[3] := "SANS";
  301.  IdentTable[4] := "GOTH";
  302.  MaxEntry:=5;
  303. END Chr.
  304.