home *** CD-ROM | disk | FTP | other *** search
/ Atari FTP / ATARI_FTP_0693.zip / ATARI_FTP_0693 / Tex / td187src.lzh / CSSPECIA.I < prev    next >
Text File  |  1991-12-14  |  33KB  |  1,013 lines
  1. IMPLEMENTATION MODULE CSspecial;
  2.  
  3. FROM BezierCurve     IMPORT ComputeRealBezier;
  4. FROM Dialoge         IMPORT BusyStart, BusyEnd;
  5. FROM Diverses        IMPORT round, GetFSelText, NumAlert, min, max;
  6. FROM FileIO          IMPORT Fopen, EOF, AgainChar, Reset, Close, ReadChar,
  7.                             ReadLn, AgainLine, Rewrite, WriteLn;
  8. FROM ObjectUtilities IMPORT FillObject;
  9. FROM Types           IMPORT TextPosTyp, DrawObjectTyp,
  10.                             LatexSpecials,
  11.                             CodeAryTyp, ObjectPtrTyp;
  12. FROM SYSTEM          IMPORT BYTE, WORD, ADDRESS , ADR ;
  13. FROM Storage         IMPORT ALLOCATE , DEALLOCATE ;
  14. IMPORT CommonData ;
  15. IMPORT GetFile;
  16. IMPORT MathLib0 ;
  17. IMPORT MagicConvert ;
  18. IMPORT MagicDOS ;
  19. IMPORT MagicStrings ;
  20. IMPORT MagicSys ;
  21. IMPORT Variablen ;
  22. IMPORT mtAlerts;
  23. (**
  24. IMPORT Debug;
  25. IMPORT RTD;
  26. **)
  27.  
  28. (**
  29. VAR UseCSspecial : BOOLEAN;
  30. **)
  31.  
  32. CONST CSBug  = TRUE;  (* Sobald Treiber Werte der unit mit Vorfaktoren *)
  33.       BugMsg = FALSE; (* erkennen auf FALSE setzen... (für cond.comp.) *)
  34.  
  35. TYPE  chset = SET OF CHAR;
  36. CONST Magic            = -29564;   (* Test auf ungültige Zahl *)
  37.       FMagic           = -29564.0; (* Test auf ungültige Zahl *)
  38.       Integers         = chset{'0'..'9','+','-'};
  39.       Reals            = chset{'0'..'9','+','-','.'};
  40.       CS1Idlong        = 'CS-Graphics V 1';
  41. (*
  42.       CS2Idlong        = 'CS-Graphics V 2';
  43. *)
  44.       CSIdshort        = 'CS-Graphics';
  45.  
  46. VAR FileHandle, oldlineval, oldthickval : INTEGER;
  47.  
  48. (* $D+*)
  49. PROCEDURE OpenFile(REF FileName : ARRAY OF CHAR);
  50. VAR Line, temp : ARRAY [0..29] OF CHAR;
  51. BEGIN
  52.   Rewrite(FileHandle, FileName);
  53. (*
  54.   IF CommonData.Usespecial = cstrunk2 THEN
  55.     WriteLn(FileHandle, CS2Idlong);
  56.    ELSE
  57.     WriteLn(FileHandle, CS1Idlong);
  58.   END;
  59. *)
  60.   WriteLn(FileHandle, CS1Idlong);
  61.   WriteLn(FileHandle, "% Created by TeX-Draw by Jens Pirnay");
  62.   temp := "r";
  63.   WriteLn(FileHandle, temp); (* Reset *)
  64. (*$? CSBug AND BugMsg:
  65.   WriteLn(FileHandle, "% Bug in Driver? Only pure units e.g. 1mm are recognized!"); (* Reset *)
  66. *)
  67. (*$? CSBug:
  68.   Line := 'u 1';
  69. *)
  70. (*$? NOT CSBug:
  71.   Line := 'u ';
  72.   Variablen.FactorToStr(temp);
  73.   MagicStrings.Append ( temp, Line);
  74. *)
  75.   Variablen.UnitToStr(temp);
  76.   MagicStrings.Append ( temp, Line);
  77.   WriteLn(FileHandle, Line); (* Unitlength *)
  78.   oldlineval  := 0;
  79.   oldthickval := 1; (* 0.4 pt *)
  80. END OpenFile;
  81. (* $D-*)
  82.  
  83. PROCEDURE Do1Line (x : INTEGER; VAR temp : ARRAY OF CHAR);
  84. VAR i : INTEGER; found : INTEGER;
  85. BEGIN
  86. (*$?     CSBug:  Variablen.ValueToStr       ( x , temp ) ; *)
  87. (*$? NOT CSBug:  Variablen.SimpleValueToStr ( x , temp ) ; *)
  88.  END Do1Line;
  89.  
  90. PROCEDURE DoLine(x1, y1, x2, y2 : INTEGER);
  91. VAR line : ARRAY [0..255] OF CHAR;
  92.     temp : ARRAY [0..19] OF CHAR;
  93.  
  94.  
  95. BEGIN
  96.   Do1Line(x1, line);
  97.   Do1Line(y1, temp);
  98.   MagicStrings.Append(' ', line);
  99.   MagicStrings.Append(temp, line);
  100.   MagicStrings.Append(' l ', line);
  101.   Do1Line(x2-x1, temp);
  102.   MagicStrings.Append(temp, line);
  103.   Do1Line(y2-y1, temp);
  104.   MagicStrings.Append(' ', line);
  105.   MagicStrings.Append(temp, line);
  106.   WriteLn(FileHandle, line);
  107. END DoLine;
  108.  
  109. PROCEDURE DoBetterLine(x1, y1, x2, y2 : MagicSys.lINTEGER);
  110. (* Werte sind das 10-fache des normalen *)
  111. VAR line : ARRAY [0..255] OF CHAR;
  112.     temp : ARRAY [0..19] OF CHAR;
  113.  
  114.   PROCEDURE Do10Line (x : MagicSys.lINTEGER; VAR temp : ARRAY OF CHAR);
  115.   VAR i : CARDINAL; found : BOOLEAN;
  116.   BEGIN
  117. (*$?     CSBug:  Variablen.Value10ToStr       ( x , temp ) ; *)
  118. (*$? NOT CSBug:  Variablen.SimpleValue10ToStr ( x , temp ) ; *)
  119. (**
  120.    (* Aus 30.12 wird nun 3.012 *)
  121.     i := 0;
  122.     found := FALSE;
  123.     REPEAT
  124.       IF (temp[i] = '.') THEN
  125.         found := TRUE;
  126.         IF (i>0) THEN
  127.           temp[i  ] := temp[i-1];
  128.           temp[i-1] := '.';
  129.           (* CS mag kein .3 sondern will 0.3 *)
  130.           IF (i-1 = 0) THEN
  131.             MagicStrings.Insert('0', temp, i-1);
  132.            ELSE
  133.             (* Keine Zahl ? Vorzeichen o.ä. ? *)
  134.             IF NOT ((temp[i-2]>='0') AND (temp[i-2]<='9')) THEN
  135.               MagicStrings.Insert('0', temp, i-1);
  136.             END;
  137.           END;
  138.  
  139.          ELSE
  140.           MagicStrings.Insert('0', temp, 1);
  141.         END;
  142.       END;
  143.       INC(i);
  144.     UNTIL (i>=LENGTH(temp)) OR found;
  145.     IF NOT found THEN
  146.       (* Aus 30 wird 3.0 *)
  147.       i := LENGTH(temp);
  148.       temp[i+1] := 0C; (* um eins länger *)
  149.       temp[i  ] := temp[i-1];
  150.       temp[i-1] := '.';
  151.     END;
  152. **)
  153.   END Do10Line;
  154.  
  155. BEGIN
  156.   Do10Line(x1, line);
  157.   Do10Line(y1, temp);
  158.   MagicStrings.Append(' ', line);
  159.   MagicStrings.Append(temp, line);
  160.   Do10Line(x2-x1, temp);
  161.   MagicStrings.Append(' l ', line);
  162.   MagicStrings.Append(temp, line);
  163.   Do10Line(y2-y1, temp);
  164.   MagicStrings.Append(' ', line);
  165.   MagicStrings.Append(temp, line);
  166.   WriteLn(FileHandle, line);
  167. END DoBetterLine;
  168.  
  169. PROCEDURE DoIt ( Object  : ObjectPtrTyp;
  170.                  dx, dy  : INTEGER ) ;
  171. CONST deltaangle = 3;
  172. VAR txt                      : ARRAY [0..9] OF CHAR;
  173.     FirstX, FirstY, x, y, i  : INTEGER;
  174.     startangle, endangle     : INTEGER;
  175.     xradius, yradius         : INTEGER;
  176.     CurrX, CurrY, OldX, OldY : MagicSys.lINTEGER;
  177.     x1,  x2,  x3,  x4   : INTEGER;
  178.     px1, px2, px3, px4  : INTEGER;
  179.     y1,  y2,  y3,  y4   : INTEGER;
  180.     py1, py2, py3, py4  : INTEGER;
  181.  
  182.   PROCEDURE myentier ( x : LONGREAL ) : MagicSys.lINTEGER;
  183.   VAR result: MagicSys.lINTEGER;
  184.   BEGIN
  185.     result := INT(ABS(x) + 0.5);
  186.     IF x<0.0 THEN
  187.       RETURN -result;
  188.      ELSE
  189.       RETURN result;
  190.     END;
  191.   END myentier;
  192.  
  193.  
  194.   PROCEDURE WriteBezier(anzahl, x1, y1, x2, y2, x3, y3 : INTEGER);
  195.   CONST MaxBezPts = 1000;
  196.   VAR Number      : ARRAY [0..19] OF CHAR;
  197.       BezierArray : ARRAY [0..2*MaxBezPts+1] OF LONGREAL;
  198.       i           : INTEGER;
  199.       Line, temp  : ARRAY [0..255] OF CHAR;
  200.   BEGIN
  201.     IF CommonData.Usespecial = cstrunk2 THEN
  202.       Do1Line(dx + x1, Line);
  203.       Do1Line(dy + y1, temp);
  204.       MagicStrings.Append(' ', Line);
  205.       MagicStrings.Append(temp, Line);
  206.       MagicStrings.Append(' b2 ', Line);
  207.       Do1Line(x2 - x1, temp);
  208.       MagicStrings.Append(temp, Line);
  209.       Do1Line(y2 - y1, temp);
  210.       MagicStrings.Append(' ', Line);
  211.       MagicStrings.Append(temp, Line);
  212.       Do1Line(x3 - x1, temp);
  213.       MagicStrings.Append(' ', Line);
  214.       MagicStrings.Append(temp, Line);
  215.       Do1Line(y3 - y1, temp);
  216.       MagicStrings.Append(' ', Line);
  217.       MagicStrings.Append(temp, Line);
  218.       WriteLn(FileHandle, Line);
  219.      ELSE
  220.       IF anzahl<=MaxBezPts THEN
  221.         i := anzahl;
  222.        ELSE
  223.         i := MaxBezPts;
  224.       END;
  225.       ComputeRealBezier(BezierArray, i, x1, y1, x2, y2, x3, y3);
  226.       OldX := myentier(10.0 * BezierArray[0]);
  227.       OldY := myentier(10.0 * BezierArray[1]);
  228.       FOR i:=1 TO anzahl DO
  229.         CurrX := myentier(10.0 * BezierArray[2*i  ]);
  230.         CurrY := myentier(10.0 * BezierArray[2*i+1]);
  231.         DoBetterLine(10 * LONG(dx + Object^.Code[1]) + OldX,
  232.                      10 * LONG(dy + Object^.Code[2]) + OldY,
  233.                      10 * LONG(dx + Object^.Code[1]) + CurrX,
  234.                      10 * LONG(dy + Object^.Code[2]) + CurrY);
  235.         OldX := CurrX;
  236.         OldY := CurrY;
  237.       END;
  238.     END;
  239.   END WriteBezier;
  240.  
  241.   PROCEDURE MakeCircles1(Object : ObjectPtrTyp);
  242.   VAR startangle, endangle, xradius, yradius, i : INTEGER;
  243.   BEGIN
  244.     startangle := 0;
  245.     endangle   := 360;
  246.     xradius    := Object^.Code [3];
  247.     yradius    := Object^.Code [3];
  248.     CASE VAL(DrawObjectTyp, Object^.Code [0]) OF
  249.      Arc :
  250.            startangle := Object^.Code [4];
  251.            endangle   := startangle + Object^.Code [5]; |
  252.      Ellipse :
  253.            yradius    := Object^.Code [4]; |
  254.      Oval :
  255.            CASE VAL(TextPosTyp, Object^.Code[4]) OF
  256.              LeftTop  : startangle := 090; endangle := 180; |
  257.              Left     : startangle := 090; endangle := 270; |
  258.              LeftBot  : startangle := 180; endangle := 270; |
  259.              Top      : startangle := 000; endangle := 180; |
  260.              Bottom   : startangle := 180; endangle := 360; |
  261.              RightTop : startangle := 000; endangle := 090; |
  262.              Right    : startangle := 270; endangle := 450; |
  263.              RightBot : startangle := 270; endangle := 360; |
  264.            ELSE
  265.            END; |
  266.      ELSE
  267.     END;
  268.     i := startangle;
  269.     OldX := myentier(10.0 * MathLib0.real(xradius) *
  270.                    MathLib0.cos(MathLib0.rad(
  271.                    MathLib0.real(i MOD 360))));
  272.     OldY := myentier(10.0 * MathLib0.real(yradius) *
  273.                    MathLib0.sin(MathLib0.rad(
  274.                    MathLib0.real(i MOD 360))));
  275.     INC(i, deltaangle);
  276.     REPEAT
  277.       CurrX := myentier(10.0 * MathLib0.real(xradius) *
  278.                      MathLib0.cos(MathLib0.rad(
  279.                      MathLib0.real(i MOD 360))));
  280.       CurrY := myentier(10.0 * MathLib0.real(yradius) *
  281.                      MathLib0.sin(MathLib0.rad(
  282.                      MathLib0.real(i MOD 360))));
  283.       DoBetterLine(10 * LONG(dx + Object^.Code[1]) + OldX,
  284.                    10 * LONG(dy + Object^.Code[2]) + OldY,
  285.                    10 * LONG(dx + Object^.Code[1]) + CurrX,
  286.                    10 * LONG(dy + Object^.Code[2]) + CurrY);
  287.       OldX := CurrX;
  288.       OldY := CurrY;
  289.       INC(i, deltaangle);
  290.       IF (i>endangle) THEN
  291.         IF i<>endangle + deltaangle THEN
  292.           i := endangle;
  293.         END;
  294.       END;
  295.     UNTIL i>endangle;
  296.   END MakeCircles1;
  297.  
  298.   PROCEDURE MakeCircles2(Object : ObjectPtrTyp);
  299.   VAR startangle, deltaangle, xradius, yradius, i : INTEGER;
  300.  
  301.  
  302.     PROCEDURE WriteFilledEllipse(mx, my, rx, ry : INTEGER);
  303.     VAR line, temp : ARRAY [0..255] OF CHAR;
  304.     BEGIN
  305.       Do1Line(mx, line);
  306.       Do1Line(my, temp);
  307.       MagicStrings.Append(' ', line);
  308.       MagicStrings.Append(temp, line);
  309.       MagicStrings.Append(' e ', line);
  310.       Do1Line(rx, temp);
  311.       MagicStrings.Append(temp, line);
  312.       Do1Line(ry, temp);
  313.       MagicStrings.Append(' ', line);
  314.       MagicStrings.Append(temp, line);
  315.       WriteLn(FileHandle, line);
  316.     END WriteFilledEllipse;
  317.  
  318.     PROCEDURE WriteAngle(mx, my, rx, ry, sa, sd : INTEGER);
  319.     VAR line, temp : ARRAY [0..255] OF CHAR;
  320.     BEGIN
  321.       Do1Line(mx, line);
  322.       Do1Line(my, temp);
  323.       MagicStrings.Append(' ', line);
  324.       MagicStrings.Append(temp, line);
  325.       MagicStrings.Append(' a ', line);
  326.       Do1Line(rx, temp);
  327.       MagicStrings.Append(temp, line);
  328.       Do1Line(ry, temp);
  329.       MagicStrings.Append(' ', line);
  330.       MagicStrings.Append(temp, line);
  331.       MagicStrings.Append(' 0 ', line);
  332.       Variablen.NumberToStr(sa, temp);
  333.       MagicStrings.Append(' ', line);
  334.       MagicStrings.Append(temp, line);
  335.       Variablen.NumberToStr(sd, temp);
  336.       MagicStrings.Append(' ', line);
  337.       MagicStrings.Append(temp, line);
  338.       WriteLn(FileHandle, line);
  339.     END WriteAngle;
  340.  
  341.     PROCEDURE WriteCircle(mx, my, r : INTEGER; IsCircle : BOOLEAN);
  342.     VAR line, temp : ARRAY [0..255] OF CHAR;
  343.     BEGIN
  344.       Do1Line(mx, line);
  345.       Do1Line(my, temp);
  346.       MagicStrings.Append(' ', line);
  347.       MagicStrings.Append(temp, line);
  348.       IF IsCircle THEN
  349.         MagicStrings.Append(' c ', line);
  350.        ELSE
  351.         MagicStrings.Append(' d ', line);
  352.       END;
  353.       Do1Line(r, temp);
  354.       MagicStrings.Append(temp, line);
  355.       WriteLn(FileHandle, line);
  356.     END WriteCircle;
  357.  
  358.   BEGIN
  359.     xradius    := Object^.Code [3];
  360.     yradius    := Object^.Code [3];
  361.     CASE VAL(DrawObjectTyp, Object^.Code [0]) OF
  362.      Circle, Disk:
  363.            WriteCircle(Object^.Code[1] + dx, Object^.Code[2] + dy,
  364.                        xradius,
  365.                        VAL(DrawObjectTyp, Object^.Code [0]) = Circle); |
  366.      Arc : startangle := Object^.Code [4];
  367.            deltaangle := Object^.Code [5];
  368.            WriteAngle(Object^.Code[1] + dx, Object^.Code[2] + dy,
  369.                       xradius, yradius, startangle, deltaangle); |
  370.      Ellipse :
  371.            startangle := Object^.Code [5];
  372.            deltaangle := Object^.Code [6];
  373.            yradius    := Object^.Code [4];
  374.            IF  (Object^.Code[7] <> 0) THEN
  375.              WriteFilledEllipse(Object^.Code[1] + dx, Object^.Code[2] + dy,
  376.                                 xradius, yradius);
  377.             ELSE
  378.              WriteAngle(Object^.Code[1] + dx, Object^.Code[2] + dy,
  379.                         xradius, yradius, startangle, deltaangle);
  380.            END; |
  381.      Oval :
  382.            CASE VAL(TextPosTyp, Object^.Code[4]) OF
  383.              LeftTop  : startangle := 090; deltaangle := 090; |
  384.              Left     : startangle := 090; deltaangle := 180; |
  385.              LeftBot  : startangle := 180; deltaangle := 090; |
  386.              Top      : startangle := 000; deltaangle := 180; |
  387.              Bottom   : startangle := 180; deltaangle := 180; |
  388.              RightTop : startangle := 000; deltaangle := 090; |
  389.              Right    : startangle := 270; deltaangle := 180; |
  390.              RightBot : startangle := 270; deltaangle := 090; |
  391.            ELSE
  392.            END;
  393.            WriteAngle(Object^.Code[1] + dx, Object^.Code[2] + dy,
  394.                       xradius, yradius, startangle, deltaangle); |
  395.      ELSE
  396.     END;
  397.   END MakeCircles2;
  398.  
  399. BEGIN
  400.   CASE VAL(DrawObjectTyp, Object^.Code [0]) OF
  401.     Dashbox        : i := 1; |
  402.     EpicDashedLine : i := 1; |
  403.     EpicDottedLine : i := 2; |
  404.    ELSE
  405.     i := 0;
  406.   END;
  407.  
  408.   IF i<>oldlineval THEN
  409.     oldlineval := i;
  410.     txt := 't x';
  411.     txt[2] := CHR(ORD('0') + MagicSys.CastToCard(i));
  412.     WriteLn(FileHandle, txt);
  413.   END;
  414.  
  415.   IF (Object^.Code[8]<>oldthickval) AND
  416.      (CommonData.Usespecial = cstrunk2) THEN
  417.     CASE Object^.Code[8] OF
  418.      1,2 : oldthickval := 1;
  419.            txt         := 'w 0.4pt'; |
  420.      3,4 : oldthickval := 3;
  421.            txt         := 'w 0.6pt'; |
  422.      5,6 : oldthickval := 5;
  423.            txt         := 'w 0.8pt'; |
  424.      ELSE
  425.       oldthickval := 1;
  426.       txt         := 'w 0.4pt';
  427.     END;
  428.     WriteLn(FileHandle, txt);
  429.   END;
  430.  
  431.   CASE VAL(DrawObjectTyp, Object^.Code [0]) OF
  432.    Beziercurve:
  433.       WriteBezier(Object^.Code [ 7 ],
  434.                   Object^.Code [ 1 ] , Object^.Code [ 2 ] ,
  435.                   Object^.Code [ 1 ] + Object^.Code [ 3 ] ,
  436.                   Object^.Code [ 2 ] + Object^.Code [ 4 ] ,
  437.                   Object^.Code [ 1 ] + Object^.Code [ 5 ] ,
  438.                   Object^.Code [ 2 ] + Object^.Code [ 6 ] ); |
  439.    Bezierellipse:
  440.       (* Bezierellipse, etwas komplizierter                *)
  441.       (* Gegeben sind drei Punkte der umgebenden Raute     *)
  442.       (* Der vierte Punkt lä₧t sich dann berechnen, damit  *)
  443.       (* sind dann die vier Kontrollpkte gegeben. Die an-  *)
  444.       (* deren Punkte sind dann die Seitenmitten. Insge-   *)
  445.       (* samt kriegen wir also vier Bezierkurven.          *)
  446.       x1 := Object^.Code[1];      y1 := Object^.Code[2];
  447.       x2 := Object^.Code[3] + x1; y2 := Object^.Code[4] + y1;
  448.       x3 := Object^.Code[5] + x1; y3 := Object^.Code[6] + y1;
  449.       x4 := x2 + (x1 - x2) + (x3 - x2);
  450.       y4 := y2 + (y1 - y2) + (y3 - y2);
  451.       px1 := (x1 + x2) DIV 2; py1 := (y1 + y2) DIV 2;
  452.       px2 := (x1 + x4) DIV 2; py2 := (y1 + y4) DIV 2;
  453.       px3 := (x3 + x4) DIV 2; py3 := (y3 + y4) DIV 2;
  454.       px4 := (x3 + x2) DIV 2; py4 := (y3 + y2) DIV 2;
  455.       WriteBezier(Object^.Code [ 7 ], px1, py1, x1, y1, px2, py2);
  456.       WriteBezier(Object^.Code [ 7 ], px2, py2, x4, y4, px3, py3);
  457.       WriteBezier(Object^.Code [ 7 ], px3, py3, x3, y3, px4, py4);
  458.       WriteBezier(Object^.Code [ 7 ], px4, py4, x2, y2, px1, py1); |
  459.    Arc, Circle, Ellipse, Oval:
  460.       IF CommonData.Usespecial = cstrunk2 THEN
  461.         MakeCircles2(Object);
  462.        ELSE
  463.         MakeCircles1(Object);
  464.       END; |
  465.    Disk:
  466.       IF CommonData.Usespecial = cstrunk2 THEN
  467.         MakeCircles2(Object);
  468.       END; |
  469.    EpicGrid:
  470.       FirstX := 0;
  471.       REPEAT
  472.         DoLine(FirstX + Object^.Code[1] + dx, Object^.Code[2] + dy,
  473.              FirstX + Object^.Code[1] + dx, Object^.Code[2] + Object^.Code[4] + dy);
  474.         FirstX := FirstX + Object^.Code[5];
  475.       UNTIL FirstX>Object^.Code[3];
  476.       FirstY := 0;
  477.       REPEAT
  478.         DoLine(Object^.Code[1] + dx,
  479.                FirstY + Object^.Code[2] + dy,
  480.                Object^.Code[1] + Object^.Code[3] + dx,
  481.                FirstY + Object^.Code[2] + dy);
  482.         FirstY := FirstY + Object^.Code[6];
  483.       UNTIL FirstY>Object^.Code[4]; |
  484.    Arrow,
  485.    Line:
  486.       IF Object^.Code [ 5 ] < 0 THEN x := -1 ELSE x := +1 END ;
  487.       IF Object^.Code [ 6 ] < 0 THEN y := -1 ELSE y := +1 END ;
  488.       DoLine(dx + Object^.Code[1], dy + Object^.Code[2],
  489.              dx + Object^.Code[1] + x * Object^.Code[3],
  490.              dy + Object^.Code[2] + y * Object^.Code[4]); |
  491.    Framebox,
  492.    Dashbox :
  493.       IF (VAL(DrawObjectTyp, Object^.Code [0]) = Dashbox) OR
  494.          (Object^.Code[6] <> 1) THEN
  495.         DoLine(dx + Object^.Code[1],
  496.                dy + Object^.Code[2],
  497.                dx + Object^.Code[1],
  498.                dy + Object^.Code[2] + Object^.Code[4]);
  499.         DoLine(dx + Object^.Code[1],
  500.                dy + Object^.Code[2] + Object^.Code[4],
  501.                dx + Object^.Code[1] + Object^.Code[3],
  502.                dy + Object^.Code[2] + Object^.Code[4]);
  503.         DoLine(dx + Object^.Code[1] + Object^.Code[3],
  504.                dy + Object^.Code[2] + Object^.Code[4],
  505.                dx + Object^.Code[1] + Object^.Code[3],
  506.                dy + Object^.Code[2]);
  507.         DoLine(dx + Object^.Code[1] + Object^.Code[3],
  508.                dy + Object^.Code[2],
  509.                dx + Object^.Code[1],
  510.                dy + Object^.Code[2]);
  511.       END; |
  512.    ELSE (* EpicLines *)
  513.       FirstX := Object^.Code[1] + dx;
  514.       FirstY := Object^.Code[2] + dy;
  515.       x      := FirstX;
  516.       y      := FirstY;
  517.       FOR i := 1 TO Object^.Code[3] DO
  518.         DoLine( x, y, FirstX + Object^.EPtr^[(i-1)*2    ],
  519.                       FirstY + Object^.EPtr^[(i-1)*2 + 1]);
  520.         x := FirstX + Object^.EPtr^[(i-1)*2    ];
  521.         y := FirstY + Object^.EPtr^[(i-1)*2 + 1];
  522.       END;
  523.   END;
  524. END DoIt;
  525.  
  526. PROCEDURE CompilePic(StartObj : ObjectPtrTyp;
  527.                      dx, dy : INTEGER);
  528. (* wird bei jedem Picture bzw. Subpicture aufgerufen, *)
  529. (* evtl. auch rekursiv                                *)
  530. VAR Object : ObjectPtrTyp;
  531.     TempStr: ARRAY [0..129] OF CHAR;
  532.     i      : INTEGER;
  533.     lines  : BOOLEAN;
  534. BEGIN
  535.   Object := StartObj;
  536.  
  537.   WHILE Object <> NIL DO
  538.  
  539.     CASE VAL(DrawObjectTyp, Object^.Code [0]) OF
  540.      Picture:
  541.        CompilePic(Object^.Children,
  542.                   dx + Object^.Code[1], dy + Object^.Code[2]); |
  543.      Beziercurve,
  544.      Bezierellipse,
  545.      Oval,
  546.      Arc,
  547.      Circle,
  548.      Disk,
  549.      Ellipse,
  550.      Line,
  551.      Arrow,
  552.      EpicSolidLine,
  553.      EpicDottedLine,
  554.      EpicGrid,
  555.      Spline,
  556.      EpicDashedLine :  DoIt(Object, dx, dy); |
  557.     ELSE
  558.     END;
  559.  
  560.     Object := Object^.Next ;
  561.  
  562.   END ; (* WHILE *)
  563. END CompilePic;
  564.  
  565. (* $D+*)
  566. PROCEDURE WriteCSspecial(REF FileName : ARRAY OF CHAR);
  567. VAR dx, dy : INTEGER; tmp : ARRAY [0..255] OF CHAR;
  568. BEGIN
  569.   IF ((CommonData.Usespecial = cstrunk1) OR
  570.       (CommonData.Usespecial = cstrunk2)) AND
  571.       (Variablen.FirstObject^.Next<>NIL) THEN
  572.     OpenFile(FileName);
  573.     dx := 0;
  574.     dy := 0;
  575.     CompilePic(Variablen.FirstObject^.Next, dx, dy);
  576.     Close(FileHandle);
  577.   END;
  578. END WriteCSspecial;
  579. (* $D-*)
  580.  
  581. PROCEDURE ParseFile(name : ARRAY OF CHAR) : BOOLEAN;
  582. CONST strlen = 255;
  583. TYPE UnitTyp = (mm, cm, pt, pc, in, bp, dd, cc, sp, pp, em, ex);
  584. VAR i          : INTEGER;
  585.     ok, first  : BOOLEAN;
  586.     upperleft  : BOOLEAN;
  587.     pixperinch : INTEGER;
  588.     c          : CHAR;
  589.     str, num   : ARRAY [0..strlen] OF CHAR;
  590.     intArray   : ARRAY [1..19] OF INTEGER;
  591.     forwArray  : ARRAY [1..5] OF INTEGER;
  592.     backwArray : ARRAY [1..5] OF INTEGER;
  593.     realArray  : ARRAY [1..19] OF LONGREAL;
  594.     charBuffer : ARRAY [0..255] OF CHAR;
  595.     Code       : CodeAryTyp;
  596.     obj        : ObjectPtrTyp;
  597.     Surround   : ARRAY [0..3] OF INTEGER;
  598.     wx         : INTEGER ;
  599.     wy         : INTEGER ;
  600.     ww         : INTEGER ;
  601.     wh         : INTEGER ;
  602.     dum        : INTEGER ;
  603.     pos        : CARDINAL;
  604.     Version    : CARDINAL;
  605.     maxx, minx,
  606.     maxy, miny : INTEGER;
  607.     MinX, MinY : INTEGER;
  608.     deltaX,
  609.     deltaY     : INTEGER;
  610.     CurrLineTyp: DrawObjectTyp;
  611.     unit       : UnitTyp;
  612.     BaseUnitTyp: UnitTyp;
  613.     UnitChar   : ARRAY UnitTyp,[0..2] OF CHAR;
  614.  
  615.     (* $D+*)
  616.     PROCEDURE SkipBlanks;
  617.     BEGIN
  618.       WHILE (str[0] = ' ') OR (str[0]=7C) DO
  619.         MagicStrings.Delete(str, 0, 1);
  620.       END;
  621.     END SkipBlanks;
  622.     (* $D-*)
  623.  
  624.     PROCEDURE GetNumber(reals: BOOLEAN; VAR temp : ARRAY OF CHAR);
  625.     VAR i, j : INTEGER;
  626.     BEGIN
  627.       (* Zunächst Spaces weg *)
  628.       i := 0;
  629.       WHILE (str[i]=' ') OR (str[i] = 07C) DO INC(i); END;
  630.       temp[0] := 0C;
  631.       j := 0;
  632.       IF reals THEN
  633.         WHILE str[i] IN Reals DO
  634.           temp[j] := str[i];
  635.           INC(i);
  636.           INC(j);
  637.         END;
  638.        ELSE
  639.         WHILE str[i] IN Integers DO
  640.           temp[j] := str[i];
  641.           INC(i);
  642.           INC(j);
  643.         END;
  644.       END;
  645.       temp[j] := 0C;
  646.       WHILE (str[i]=' ') OR (str[i] = 07C) DO INC(i); END;
  647. (**
  648.       RTD.Write('Line before:', str);
  649. **)
  650.       IF i>0 THEN
  651.         MagicStrings.Delete(str, 0, i);
  652.       END;
  653. (**
  654.       RTD.Write('Line after :', str);
  655.       RTD.Write('Line back  :', temp);
  656. **)
  657.     END GetNumber;
  658.  
  659.     (* $D+*)
  660.     PROCEDURE GetRealNumber() : LONGREAL;
  661.     VAR res  : LONGREAL;
  662.         temp : ARRAY [0..19] OF CHAR;
  663.     BEGIN
  664.       GetNumber(TRUE, temp);
  665.       IF temp[0]<>0C THEN
  666.         res := MagicConvert.StrToReal(temp);
  667.        ELSE
  668.         res := FMagic;
  669.       END;
  670.       RETURN res;
  671.     END GetRealNumber;
  672.  
  673.     PROCEDURE GetIntNumber() : INTEGER;
  674.     VAR res  : INTEGER;
  675.         temp : ARRAY [0..19] OF CHAR;
  676.     BEGIN
  677.       GetNumber(FALSE, temp);
  678.       IF temp[0]<>0C THEN
  679.         res := MagicConvert.StrToInt(temp);
  680.        ELSE
  681.         res := Magic;
  682.       END;
  683.       RETURN res;
  684.     END GetIntNumber;
  685.     (* $D-*)
  686.  
  687.     PROCEDURE GetLine;
  688.     BEGIN
  689.       str[0] := 0C;
  690.       IF NOT EOF THEN
  691.         ReadLn (FileHandle, str);
  692.       END;
  693.     END GetLine;
  694.  
  695.     PROCEDURE GetNewLine;
  696.     BEGIN
  697.       REPEAT
  698.         GetLine;
  699.       UNTIL str[0] <> '%';
  700.       SkipBlanks;
  701.     END GetNewLine;
  702.  
  703.     PROCEDURE ScanStr;
  704.     CONST cmdlen = 19;
  705.     VAR i, nrint, nrreal : INTEGER;
  706.         dx, dy, x, y     : LONGREAL;
  707.         ix, iy, idx, idy : INTEGER;
  708.         cmd              : ARRAY [0..cmdlen] OF CHAR;
  709.         unit             : UnitTyp;
  710.         crdarray         : ARRAY [0..5] OF INTEGER;
  711.         okay             : BOOLEAN;
  712.  
  713.  
  714.         PROCEDURE Crd(r : LONGREAL) : INTEGER;
  715.         CONST Internal =  5.0; (* 5 Pixel per Units *)
  716.               Factor   = 10.0; (* 1/10 unitlength *)
  717.         VAR res : INTEGER;
  718.         BEGIN
  719.           res := round(r * Factor * Internal);
  720.           RETURN res;
  721.         END Crd;
  722.  
  723.  
  724.         PROCEDURE InitCode(typus : DrawObjectTyp; x, y : INTEGER);
  725.         VAR (*$Reg*) i : CARDINAL;
  726.         BEGIN
  727.           FOR i := 0 TO 9 DO Code[i]     := 0; END;
  728.           FOR i := 0 TO 3 DO Surround[i] := 0; END;
  729.           Code[0] := MagicSys.CastToInt(ORD(typus)); (* Typus *)
  730.           Code[1] := x;
  731.           Code[2] := y;
  732.         END InitCode;
  733.  
  734.         PROCEDURE GetCrds(      anzahl : CARDINAL;
  735.                           VAR crdarray : ARRAY OF INTEGER;
  736.                           VAR okay     : BOOLEAN);
  737.         VAR c : CARDINAL; r : REAL;
  738.         BEGIN
  739.           okay := TRUE;
  740.           FOR c:=1 TO anzahl DO
  741.             SkipBlanks;
  742.             r := GetRealNumber();
  743.             IF (r<>FMagic) THEN
  744.               crdarray[c-1] := Crd(r);
  745.              ELSE
  746.               okay := FALSE;
  747.               crdarray[c-1] := Magic;
  748.             END;
  749.           END;
  750.         END GetCrds;
  751.  
  752.  
  753.         PROCEDURE GetInts(      anzahl : CARDINAL;
  754.                           VAR intarray : ARRAY OF INTEGER;
  755.                           VAR okay     : BOOLEAN);
  756.         VAR c : CARDINAL; i : INTEGER;
  757.         BEGIN
  758.           okay := TRUE;
  759.           FOR c:=1 TO anzahl DO
  760.             SkipBlanks;
  761.             i := GetIntNumber();
  762.             IF (i<>Magic) THEN
  763.               intarray[c-1] := i;
  764.              ELSE
  765.               okay := FALSE;
  766.               crdarray[c-1] := Magic;
  767.             END;
  768.           END;
  769.         END GetInts;
  770.  
  771.     BEGIN
  772.       CASE str[0] OF
  773.         'r' : (* Reset      *)
  774.                   BaseUnitTyp := pt;
  775.                   CurrLineTyp := EpicSolidLine; |
  776.         'u' : (* Unit       *)
  777.               FOR unit := mm TO ex DO
  778.                 IF MagicStrings.Pos(UnitChar[unit], str) < strlen THEN
  779.                   BaseUnitTyp := unit;
  780.                 END;
  781.               END; |
  782.         'w' : (* Linien-Breite *) |
  783.         't' : (* Linien-Typ *)
  784.               SkipBlanks;
  785.               i := GetIntNumber();
  786.               IF (i<>Magic) THEN
  787.                 CASE i OF
  788.                   0 : CurrLineTyp := EpicSolidLine;  |
  789.                   1 : CurrLineTyp := EpicDashedLine; |
  790.                   2 : CurrLineTyp := EpicDottedLine; |
  791.                   3 : CurrLineTyp := EpicDashedLine; |
  792.                   4 : CurrLineTyp := EpicDashedLine; |
  793.                   5 : CurrLineTyp := EpicDottedLine; |
  794.                   6 : CurrLineTyp := EpicDottedLine; |
  795.                  ELSE
  796.                   CurrLineTyp := EpicSolidLine;
  797.                 END;
  798.               END;|
  799.        ELSE
  800.         (* Also wahrscheinlich eine Linie *)
  801.         (* Zunächst Ausgangsposition      *)
  802.         GetCrds(2, crdarray, okay);
  803.         IF okay THEN
  804.           (* Jetzt der Befehlscode *)
  805.           SkipBlanks;
  806.           i := 0;
  807.           WHILE (str[i]<>' ') AND (i<cmdlen) DO
  808.             cmd[i] := str[i];
  809.             INC(i);
  810.           END;
  811.           cmd[i] := 0C;
  812.           IF i>0 THEN
  813.             MagicStrings.Delete(str, 0, i);
  814.           END;
  815.           IF (cmd[1] = 0C) THEN (* 1 Buchstabe *)
  816.             CASE cmd[0] OF
  817.              'l':
  818.               InitCode(CurrLineTyp, crdarray[0], crdarray[1]);
  819.               GetCrds(2, crdarray, okay);
  820.               IF okay THEN
  821.                 FOR i:=0 TO 1 DO
  822.                   Variablen.ebuffer[i] := crdarray[i];
  823.                 END;
  824.                 Code[3] := 1; (* Anzahl Punkte in ebuffer *)
  825.                 Code[8] := 1; (* Thickness *)
  826.                 Variablen.NewObject(Code, NIL, ADR(Variablen.ebuffer), Surround);
  827.                 Variablen.LastObject^.SurrDirty := TRUE;
  828.               END; |
  829.              'e' : (* Filled Ellipse *)
  830.               InitCode(Ellipse, crdarray[0], crdarray[1]);
  831.               GetCrds(2, crdarray, okay);
  832.               IF okay THEN
  833.                 Code[3] := crdarray[0];
  834.                 Code[4] := crdarray[1];
  835.                 Code[5] := 0;
  836.                 Code[6] := 360;
  837.                 Code[7] := 1; (* Fillflag *)
  838.                 Variablen.NewObject(Code, NIL, NIL, Surround);
  839.                 Variablen.LastObject^.SurrDirty := TRUE;
  840.               END; |
  841.              'a' : (* Arc *)
  842.               InitCode(Arc, crdarray[0], crdarray[1]);
  843.               GetCrds(2, crdarray, okay);
  844.               IF okay THEN
  845.                 ix := crdarray[0];
  846.                 iy := crdarray[1];
  847.                 GetInts(3, crdarray, okay);
  848.                 IF okay THEN
  849.                   IF ix = iy THEN
  850.                     (* Kreis-Bogen *)
  851.                     Code[3] := ix;
  852.                     Code[4] := crdarray[1];
  853.                     Code[5] := crdarray[2];
  854.                    ELSE
  855.                     (* Ellipsen-Bogen *)
  856.                     Code[0] := MagicSys.CastToInt(ORD(Ellipse)); (* Typus *)
  857.                     Code[3] := ix;
  858.                     Code[4] := iy;
  859.                     Code[5] := crdarray[1];
  860.                     Code[6] := crdarray[2];
  861.                   END;
  862.                 END;
  863.               END; |
  864.              'c', 'd': (* Circle / Disk *)
  865.               IF cmd[0] = 'c' THEN
  866.                 InitCode(Circle, crdarray[0], crdarray[1]);
  867.                ELSE
  868.                 InitCode(Disk, crdarray[0], crdarray[1]);
  869.               END;
  870.               GetCrds(1, crdarray, okay);
  871.               IF okay THEN
  872.                 Code[3] := crdarray[0];
  873.                 Variablen.NewObject(Code, NIL, ADR(Variablen.ebuffer), Surround);
  874.                 Variablen.LastObject^.SurrDirty := TRUE;
  875.               END; |
  876.              'i': (* Include nicht unterstützt *) |
  877.              ELSE
  878.             END;
  879.            ELSIF LENGTH(cmd)=2 THEN
  880.             IF (cmd[0] = 'b') AND (cmd[1]='2') THEN
  881.               InitCode(Beziercurve, crdarray[0], crdarray[1]);
  882.               GetCrds(4, crdarray, okay);
  883.               IF okay THEN
  884.                 FOR i:=0 TO 3 DO
  885.                   Code[i + 3] := crdarray[i];
  886.                 END;
  887.                 Code[7] := 50; (* Anzahl Punkte *)
  888.                 Variablen.NewObject(Code, NIL, ADR(Variablen.ebuffer), Surround);
  889.                 Variablen.LastObject^.SurrDirty := TRUE;
  890.               END;
  891.             END;
  892.           END;
  893.         END;
  894.       END;
  895.     END ScanStr;
  896.  
  897. BEGIN
  898.   UnitChar[mm] := 'mm';  UnitChar[cm] := 'cm';
  899.   UnitChar[pt] := 'pt';  UnitChar[pc] := 'pc';
  900.   UnitChar[in] := 'in';  UnitChar[bp] := 'bp';
  901.   UnitChar[dd] := 'dd';  UnitChar[cc] := 'cc';
  902.   UnitChar[sp] := 'sp';  UnitChar[pp] := 'pp';
  903.   UnitChar[em] := 'em';  UnitChar[ex] := 'ex';
  904.   Reset(FileHandle, name);
  905.   IF FileHandle >= 6 THEN
  906.     GetLine;
  907.     (* steht in der ersten Zeile ein "CS-Graphics" ? *)
  908.     pos := MagicStrings.Pos(CSIdshort, str);
  909. (**
  910.     RTD.Write('str', str);
  911. **)
  912. (**
  913.     RTD.Write('id ', CSIdshort);
  914. **)
  915. (**
  916.     RTD.ShowVar('pos', pos);
  917. **)
  918.     Close(FileHandle);
  919.     ok := pos = 0;
  920. (**
  921.     RTD.ShowVar('pos', pos);
  922. **)
  923.     IF ok THEN
  924. (**
  925.       RTD.Message('ok!');
  926. **)
  927.      ELSE
  928. (**
  929.       RTD.Message('Not ok!');
  930. **)
  931.     END;
  932.     IF NOT ok THEN
  933.       mtAlerts.SetIcon(mtAlerts.Graphic);
  934. (**
  935.       RTD.Message('Now NumAlert');
  936. **)
  937.       i := NumAlert(27, 1);
  938.       ok := i = 2;
  939.     END;
  940.     IF ok THEN
  941.  
  942.       BusyStart(name, TRUE);
  943.  
  944.       minx := 0;      miny := 0;
  945.       maxx := 0;      maxy := 0;
  946.  
  947.       CurrLineTyp := EpicSolidLine;
  948.       BaseUnitTyp := pt;
  949.  
  950.       Reset(FileHandle, name);
  951.       EOF            := FALSE;
  952.       Variablen.DeleteWholeTree;
  953.       WHILE NOT EOF DO
  954.     (* $D+*)
  955.         GetNewLine;
  956. (**
  957.         RTD.Write('Line:', str);
  958. **)
  959.         IF str[0]<>0C THEN
  960.           ScanStr;
  961.         END;
  962.     (* $D-*)
  963.       END;
  964.       Close(FileHandle);
  965.       Variablen.FirstObject^.Code[3] := maxx;
  966.       Variablen.FirstObject^.Code[4] := maxy;
  967.       Variablen.FirstObject^.Code[6] := MagicSys.CastToInt(ORD(BaseUnitTyp)) +
  968.                                         0100H * 1; (* 1/10 Aufloesung *)
  969.       Variablen.FirstObject^.Code[7] := 5;
  970.       CommonData.InternalResolution  := 5;
  971.       BusyEnd;
  972.       RETURN TRUE;
  973.     END;
  974.     RETURN FALSE;
  975.   END;
  976. END ParseFile;
  977.  
  978. PROCEDURE ImportCSspecial():BOOLEAN;
  979. (*
  980.   Fragt nach Dateinamen, lädt Datei ein, versucht sie zu interpretieren,
  981.   und die Objekte abzulegen. Unbekannte Objekte werden ignoriert.
  982.   Die bisherigen Objekte werden gelöscht.
  983. *)
  984. VAR input, titel, msg : ARRAY [0..255] OF CHAR;
  985.     tmp1, tmp2        : ARRAY [0..14] OF CHAR;
  986.     res, exist        : BOOLEAN;
  987.     dum               : INTEGER;
  988. BEGIN
  989.   res := FALSE;
  990.   GetFSelText(10, msg);
  991.   tmp1 := '*.';
  992.   tmp2 := '*.';
  993.   MagicStrings.Append(CommonData.Extensions[8], tmp1);
  994.   MagicStrings.Append(CommonData.Extensions[8], tmp2);
  995.   IF GetFile.GetFileName(input, titel, tmp1, tmp2,
  996.                          CommonData.CSGPath, msg,
  997.                          exist, FALSE, TRUE, TRUE, FALSE) THEN
  998.     IF exist THEN
  999.       res := ParseFile(input);
  1000.       IF res THEN
  1001.         MagicStrings.Assign(input, CommonData.FileName);
  1002.         GetFile.ReplaceExtension(CommonData.FileName, CommonData.Extensions[1]);
  1003.         GetFile.ReplacePath(CommonData.FileName, '');
  1004.       END;
  1005.      ELSE
  1006.       res := FALSE;
  1007.     END;
  1008.   END;
  1009.   RETURN res;
  1010. END ImportCSspecial;
  1011.  
  1012. END CSspecial.
  1013.