home *** CD-ROM | disk | FTP | other *** search
/ Fifty: Elektronik / FIFTY Elektronik (PS_Computer_Vertrieb).iso / ps8 / fty1017 / gepackt.exe / DISK2 / PLOTSRC.EXE / PLOTSYS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-11-10  |  4.7 KB  |  184 lines
  1. Unit PLOTSYS;
  2.  
  3. Interface
  4.  
  5. uses
  6.   Crt,
  7.   Dos,
  8.   StrTool,
  9.   GEDDEFS,
  10.   LibMan,
  11.   KEYSCRN;
  12.  
  13. Const GrafmodeGlb=false;
  14.  
  15. Type  SinTab     = Array[0..90] of Real;
  16.       GrColor    = 0..9;        (* Zeichenfarbe 1..9, 0= farblos *)
  17.  
  18. Var
  19.       GrRotPhi                 :integer; (*Drehwinkel für Rotate/RotReal*)
  20.       GrRot11,GrRot12,
  21.       GrRot21,GrRot22          :Real;    (* Drehmatrix   für ""         *)
  22.       GrSinus                  :SinTab;  (* Sinustabelle *)
  23.       PlotRes,InvPlotRes,                (* Plotterauflösung und Kehrwert*)
  24.       PlotScale                :Real;    (* Plotmaßstab  *)
  25.       GrWindowX1,                        (* Plotterausgabefenster in     *)
  26.       GrWindowX2,                        (* Plotterkoordinaten *)
  27.       GrWindowY1,
  28.       GrWindowY2               :Real;
  29.       MinFormX,
  30.       MinFormY                 :Integer;
  31.  
  32. Type CharKante=Record
  33.                 CharX,CharY :Byte;
  34.                end;
  35.               { Bit 0..6 von X ist X-koordinate }
  36.               { Bit 7 von X ist 1 : Info -  Vektor }
  37.                               { 0 : Aktiver Vektor}
  38.               { Bit 0..6 von Y ist Y-koordinate }
  39.               { Bit 7 von y ist PEN }
  40.               { erster Vektor ist immer Info-Vektor }
  41.               { X gibt Proportionalbreite an 16 = 100%}
  42.               { Y gibt Anzahl der Vektoren+Infovektor  an }
  43.               { = Anzahl Worte des Zeichens  max.127      }
  44.  
  45.      ChFeld = Array[0..500] of charkante;
  46.      ChIndex =Array[0..224] of Integer;
  47.      ChInfo  =Record
  48.                 F:Array[0..223] of Integer;
  49.                 Size:Word;
  50.               end;
  51.      ChFPtr  = ^Chfeld;
  52.      ChIPtr  = ^ChIndex;
  53.  
  54. var    GrafSet1,Grafset2:  ChFPtr;   { grafische Zeichensätze }
  55.        CharIndex1,CharIndex2 :ChIPtr;
  56.  
  57. Const Batch :Boolean=false;
  58.       OutDevice   :PathStr='';
  59.       OutPath     :PathStr='';
  60.       
  61.  
  62. procedure error(ErrCode:integer);
  63. (* Error-Handler, führt zu hartem Programmabbruch *)
  64.  
  65. Procedure Normalize(Var Phi :Integer);
  66. (* normalisiert Winkel in Bereich 0..360 *)
  67.  
  68. Procedure SinusCosinus(Phi :integer; Var Si,Co :Real);
  69. (*Bestimmt Sinus und Cosinus aus Tabelle, Phi in ganzen Grad*)
  70.  
  71. Procedure CircleCoord(RX,RY,Phi :Integer  ;Var CX,CY :Real);
  72. (*bestimmt PolarKoord. auf einer Ellipse (RX,RY) *)
  73.  
  74. Procedure Turnto(Phi :Integer);
  75. (*Initialisiert Drehmatrix gemäß Phi *)
  76.  
  77. Procedure Rotreal(Var X,Y :Real);
  78. (*Rotiert X,Y um durch Turnto festgelegten Winkel Phi *)
  79.  
  80. Procedure Rotate(Var X,Y :Integer);
  81.  
  82. Function PlotKoord(X:Real):Real;
  83. (*Bestimmt Potterkoordinate aus Zeichnungskoordinate in mm*)
  84.  
  85. Function Ungleich(A,B:Real):Boolean;
  86. (*Prüft Gleichheit zweier Zeichnungskoordinaten*)
  87.  
  88. Function PlotLimit(X:Real):Real;
  89. (*Begrenzt Maß auf >= Plotterauflösung*)
  90.  
  91. Function CalcPhi(X,Y :Real):Integer;
  92. (*bestimmt Winkel aus X,Y (arctan) *)
  93.  
  94. Procedure GrafWindow(X1,Y1,X2,Y2 :Integer);
  95. (* legt Plotterausgabefenster fest *)
  96.  
  97. Procedure WhichField(X,Y :Real;Var WoX,WoY :Integer);
  98. (* wird für Clip-Funktion (Randabschneiden) benötigt  *)
  99.  
  100. Function InWindow(X,Y :Real) :Boolean;
  101. (* Prüft ob Punkt im Ausgabe-Fenster *)
  102.  
  103. Function Clip(Var X1,Y1,X2,Y2: Real ):Boolean;
  104. (* schneidet Gerade X1,Y1,X2,Y2 an den Rändern des Ausgabefensters ab *)
  105. (* oder meldet wenn Gerade nicht gezeichnet werden muß (Clip=false )  *)
  106.  
  107. Procedure  CheckPath(Var P :PathStr);
  108.  
  109. Procedure CheckDirs;
  110.  
  111.  
  112. Procedure ErrorInit;
  113.  
  114. Procedure TextMode;
  115.  
  116. procedure NormVideo;
  117.  
  118. procedure LowVideo;
  119.  
  120. {===========================================================================}
  121.  
  122. Implementation
  123.  
  124. Procedure TextMode;
  125. begin
  126. end;
  127.  
  128.  
  129. (*$I PLOTSYS.INC *)
  130.  
  131. Var ExitSave :Pointer;
  132.  
  133. {$F+} Procedure Myexit;{$F-}
  134. begin
  135.   Crt.Normvideo;
  136.   Crt.Clrscr;
  137.   ErrorMSG;
  138.   SetCursor(CursorInital);
  139.   ExitProc:=ExitSave;
  140. end;
  141.  
  142. begin
  143.   ExitSave:=ExitProc;
  144.   ExitProc:=@Myexit;
  145.   NormVideo;
  146.   If MODECO80 then EditForeground:=Crt.Yellow else EditForeground:=Crt.White;
  147.   Editbackground:=Crt.black;
  148.   OutDevice:='';
  149.   If ParamCount>0 then
  150.   begin
  151.     OutDevice:=UpcaseStr(ParamStr(ParamCount));
  152.     If Pos('/O',OutDevice)=1 then
  153.      begin
  154.        Delete(OutDevice,1,2);
  155.        Batch:=ParamCount>1;
  156.      end
  157.     else
  158.     If Pos('/P',OutDevice)=1 then
  159.      begin
  160.        Delete(OutDevice,1,2);
  161.        If  PathExists(OutDevice) then
  162.          OutPath:=OutDevice;
  163.        OutDevice:='';
  164.        Batch:=ParamCount>1;
  165.      end
  166.     else
  167.       begin
  168.         OutDevice:='';
  169.         Batch:=ParamCount>0;
  170.       end;
  171.   end;
  172.   
  173.   If Not(Batch) then
  174.   begin
  175.     LoadFilesetUp;
  176.     CheckDirs;
  177.   end;
  178.   LoadSetup;
  179.   InitCharNames;
  180.   PlotSysInit;
  181.   KeyScrn.Maus_Ratio:=SetupInfo.MausInfo.MausRatio shr 4;
  182.   CheckBreak:=false;
  183. end.
  184.