home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / dtx9202 / 3dgraf / plot / plot.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-01-01  |  22.9 KB  |  724 lines
  1. {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S-,V-,X-}
  2. {$M 16384,0,655360}
  3. (* ----------------------------------------------------------- *)
  4. (*                          PLOT.PAS                           *)
  5. (*            (C) 1992 Norbert Braun & DMV-Verlag              *)
  6. (*                  Compiler: Turbo Pascal 6.0                 *)
  7. (*                                                             *)
  8. (*    Das Programm zeichnet HPGL-Dateien auf den Bildschirm    *)
  9. (*    entweder in weiß oder mit Rot-Grün-Effekt.  Es werden    *)
  10. (*    alle Grafikkarten unterstützt. Für 3D-Bilder wird EGA,   *)
  11. (*    VGA oder IBM/8514A benötigt.  Das Programm unterstützt   *)
  12. (*    zusätzlich  SVGA-Karten mit 512 und 1024 kBytes  Bild-   *)
  13. (*    schirmspeicher in 800x600-Pixeln Auflösung.              *)
  14. (* ----------------------------------------------------------- *)
  15.  
  16. PROGRAM Plot;
  17.  
  18. USES
  19.   Crt, Dos, Graph;
  20.  
  21. TYPE
  22.   tXYCoord    = (nx, ny, nyr);
  23.   tTokens     = (Command, Number, CharArray, SpecChars);
  24.   tTokenSet   = ARRAY[tTokens] OF SET OF CHAR;
  25.  
  26. CONST
  27.   GM800x600   = 4;                (* 800x600 SuperVGA 1MByte  *)
  28.   FirstMode   = 0;                (* 800x600 SuperVGA 512 kB  *)
  29.   PreDefGreen = $12;              (* vordefinierte Farben für *)
  30.   PreDefRed   = $55;              (* abgedunkelten Raum und   *)
  31.   PreDefBlue  = $0E;              (* SVGA, ggf. anpassen      *)
  32.   NewGreen    : INTEGER = PreDefGreen;   (* Farbeinstellungen *)
  33.   NewRed      : INTEGER = PreDefRed;
  34.   BluePart    : INTEGER = PreDefBlue;
  35.   Color1      : WORD    = Red;
  36.   Color2      : WORD    = Green;
  37.   Terminator  : CHAR    = ';';
  38.   DTerminator : CHAR    = #3;
  39.   DefaultCorrector      = 10;
  40.   Corrector   : INTEGER = DefaultCorrector;
  41.   hpMaxXDef             = 1104;
  42.   hpMaxYDef             = 796;
  43.   hpMinX      : INTEGER = 0;
  44.   hpMaxX      : INTEGER = hpMaxXDef; (* Plotterformat X-Achse *)
  45.   hpMinY      : INTEGER = 0;
  46.   hpMaxY      : INTEGER = hpMaxYDef; (* Plotterformat Y-Achse *)
  47.   scMaxX      : INTEGER = 640;    (* Standardauflösung X      *)
  48.   scMaxY      : INTEGER = 480;    (* Standardauflösung Y      *)
  49.   xCount      : INTEGER = 0;      (* X-Abst. Rot/Grün Default *)
  50.   yCount      : INTEGER = 0;      (* Y-Abst. Rot/Grün Default *)
  51.   CCSet       : tTokenSet = ([#27, '.', 'A'..'Z'], ['.', '-',
  52.                            '0'..'9'], [' '..#254], [#0 ..#255]);
  53.   SVGAName    : STRING[8] = 'SUPERVGA';
  54.  
  55. VAR
  56.   CmdLine           : ComStr;
  57.   HPGLFile          : PathStr;
  58.   HPGLDir           : DirStr;
  59.   HPGLName          : NameStr;
  60.   HPGLExt           : ExtStr;
  61.   OldChrSet, i, r,
  62.   wa, we, Test,
  63.   x1, x0, y1, y0    : INTEGER;
  64.   c, ch             : CHAR;
  65.   sx,  xVer, yVer,
  66.   Value, LastToken,
  67.   Ignore, TokenRead : STRING;
  68.   f, mf             : Text;
  69.   ThisToken         : tTokens;
  70.   PaintMode         : (AbsPaint, RelPaint);
  71.   Pen               : (Up, Down);
  72.  
  73. PROCEDURE ClearBuffer;
  74. (* Löschen des Tastaturpuffers *)
  75. VAR
  76.   key: CHAR;
  77. BEGIN
  78.   IF KeyPressed THEN WHILE KeyPressed DO key := ReadKey;
  79. END;
  80.  
  81. PROCEDURE SetPrefColors;
  82. (* Setzen der Palettenfarben für Rot und Grün *)
  83. BEGIN
  84.   SetRGBPalette(Red,   BYTE(NewRed),   0, 0);
  85.   SetRGBPalette(Green, 0, BYTE(NewGreen), BYTE(BluePart));
  86. END;
  87.  
  88. PROCEDURE ModifyColors;
  89. (* Wechseln der Palettenfarben für Rot und Grün *)
  90. CONST
  91.   Max     = $FF;
  92.   Min     = $01;
  93.   MaxBlue = $F0;
  94.   MinBlue = $00;
  95. BEGIN
  96.   ClearBuffer;
  97.   REPEAT
  98.     ch := ReadKey;
  99.     CASE ch OF
  100.       '+': BEGIN
  101.              NewGreen := PreDefGreen;
  102.              NewRed   := PreDefRed;
  103.              BluePart := PreDefBlue;
  104.            END;
  105.       '-': BEGIN
  106.              NewGreen := Min; NewRed := Min;
  107.              BluePart := MinBlue;
  108.            END;
  109.       '*': BEGIN
  110.              NewGreen := Max; NewRed := Max;
  111.              BluePart := MaxBlue;
  112.            END;
  113.  
  114.       '/': BEGIN
  115.              Dec(NewRed); Dec(NewGreen);
  116.              Dec(BluePart);
  117.            END;
  118.        #0: BEGIN
  119.              ch := ReadKey;
  120.              CASE ch OF
  121. {up }          'H': Inc(NewRed);
  122. {down}         'P': Dec(NewRed);
  123. {<-}           'K': Inc(NewGreen);
  124. {->}           'M': Dec(NewGreen);
  125. {left/up}      'G': BEGIN Inc(NewRed); Inc(NewGreen); END;
  126. {right/down}   'Q': BEGIN Dec(NewRed); Dec(NewGreen); END;
  127. {rright/up}    'I': BEGIN Inc(NewRed); Dec(NewGreen); END;
  128. {left/down}    'O': BEGIN Dec(NewRed); Inc(NewGreen); END;
  129. {Ins}          'R': Inc(BluePart);
  130. {Del}          'S': Dec(BluePart);
  131.              END;
  132.            END;
  133.     END;
  134.     SetPrefColors;
  135.   UNTIL ch IN [#13, #27, #32];
  136. END;
  137.  
  138. PROCEDURE Draw(xDiv, yDiv: INTEGER);
  139. (* Setzt die ermittelten Werte in Bildschirmgrafik um *)
  140. BEGIN
  141.   MoveTo(x0 + xDiv, y0 + yDiv);
  142.   SetColor(Color1);
  143.   IF Pen = Down THEN
  144.     CASE PaintMode OF
  145.       AbsPaint : LineTo(x1 + xDiv, y1 + yDiv);
  146.       RelPaint : BEGIN
  147.                    MoveTo(x0 + xDiv, y0 + yDiv);
  148.                    LineRel(x1 + xDiv, y1 + yDiv);
  149.                  END;
  150.     END;
  151.   MoveTo(x0, y0);
  152.   SetColor(Color2);
  153.   IF Pen = Up THEN BEGIN
  154.     CASE PaintMode OF
  155.       AbsPaint : MoveTo(x1, y1);
  156.       RelPaint : BEGIN
  157.                    MoveTo(x0, y0);
  158.                    MoveRel(x1, y1);
  159.                  END;
  160.     END;
  161.   END ELSE
  162.     CASE PaintMode OF
  163.       AbsPaint : LineTo(x1, y1);
  164.       RelPaint : BEGIN
  165.                    MoveTo(x0, y0);
  166.                    LineRel(x1, y1);
  167.                  END;
  168.     END;
  169.   x0 := GetX;
  170.   x1 := x0;
  171.   y0 := GetY;
  172.   y1 := y0;
  173. END;
  174.  
  175. FUNCTION ReadToken(t : tTokens) : STRING;
  176. (* liest einen Token aus der Datei *)
  177. BEGIN
  178.   ThisToken := t;
  179.   IF (t = SpecChars) THEN BEGIN
  180.     Ignore    := '';
  181.     TokenRead := c;
  182.     ReadToken := c;
  183.     Read(f, c);
  184.   END ELSE BEGIN
  185.     Ignore := '';
  186.     WHILE NOT (c IN CCSet[t]) AND NOT EoF(f) DO BEGIN
  187.       IF NOT (c IN [#32..#126]) THEN c := '_';
  188.       Ignore := Ignore + c;
  189.       Read(f, c);
  190.     END;
  191.     TokenRead := '';
  192.     IF (t = Command) AND NOT EoF(f) THEN BEGIN
  193.       IF (c = #27) THEN c := '!';
  194.       TokenRead := TokenRead + c;
  195.       Read(f, c);
  196.       TokenRead := TokenRead + c;
  197.       Read(f, c);  (* damit c das nächste Zeichen enthält *)
  198.     END ELSE WHILE (c IN CCSet[t]) AND NOT EoF(f) DO BEGIN
  199.       TokenRead := TokenRead + c;
  200.       Read(f, c);
  201.     END;
  202.     IF (TokenRead[1] = '.') AND (TokenRead[2] = '5') THEN {}
  203.     ELSE IF (Length(Ignore) > 0) AND NOT
  204.             (Ignore[1] IN [DTerminator, ' ', ',', ';']) THEN ;
  205.   END;
  206.   ReadToken := TokenRead;
  207. END;
  208.  
  209. FUNCTION Translate(n: INTEGER; k: tXYCoord): INTEGER;
  210. (* Setzt die HPGL-Koordinaten in Bildschirmkoordinaten um *)
  211. VAR
  212.   fx, fy : INTEGER;
  213. BEGIN
  214.   fx := Trunc((hpMaxX - hpMinX) / scMaxX);
  215.   fy := Trunc((hpMaxY - hpMinY) / scMaxY);
  216.   IF (fx = 0) THEN fx := 1;
  217.   IF (fy = 0) THEN fy := 1;
  218.   CASE k OF
  219.     nx : Translate := Trunc((n - hpMinX) / fx);
  220.     ny : Translate := scMaxY - Trunc((n - hpMinY) / fy);
  221.     nyr: Translate :=        - Trunc((n - hpMinY) / fy);
  222.     ELSE Translate := 0;
  223.   END;
  224. END;
  225.  
  226. FUNCTION Digit: INTEGER;
  227. (* Setzt die eingelesenen Zahlenwerte um *)
  228. VAR
  229.   num, t: INTEGER;
  230. BEGIN
  231.   IF (c <> Terminator) THEN
  232.     Val(ReadToken(Number), num, t)
  233.   ELSE
  234.     num := 0;
  235.   Digit := num;
  236. END;
  237.  
  238. PROCEDURE GetXY(xDiff, yDiff: INTEGER);
  239. BEGIN
  240.   WHILE NOT (c = Terminator)      AND
  241.         NOT (c IN CCSet[Command]) AND
  242.         NOT EoF(f) DO BEGIN
  243.     IF (PaintMode = AbsPaint) THEN BEGIN
  244.       x1 := Translate(Digit, nx);
  245.       y1 := Translate(Digit, ny)
  246.     END ELSE BEGIN
  247.       x1 := Translate(Digit, nx);
  248.       y1 := Translate(Digit, nyr);
  249.     END;
  250.     Draw(xDiff, yDiff);
  251.   END;
  252. END;
  253.  
  254. PROCEDURE Parse(xDiff, yDiff: INTEGER);
  255. (* der eigentliche Parser für die HPGL-Befehle *)
  256. VAR
  257.   Test: INTEGER;
  258. BEGIN
  259.   LastToken := TokenRead;
  260.   sx := ReadToken(Command);
  261.   CASE TokenRead[1] OF
  262.     '.' : IF TokenRead[2] = '5' THEN ;
  263.     '!' : BEGIN  
  264.             TokenRead := TokenRead + c;
  265.             Read(f, c);
  266.             CASE TokenRead[2] OF
  267.               '.' : BEGIN
  268.                       WHILE NOT (c = ':')             AND
  269.                             NOT (c IN CCSet[Command]) AND
  270.                             NOT EoF(f) DO
  271.                         Val(ReadToken(Number), i, Test);
  272.                     END;
  273.             END;
  274.           END;
  275.     'A' : CASE TokenRead[2] OF
  276.             'A', 'R': ;
  277.           END;
  278.     'C' : CASE TokenRead[2] OF
  279.             'A' : OldChrSet := Digit;
  280.             'I' : BEGIN
  281.                     r := Digit;
  282.                     IF (Pen = Down) THEN Circle(x0, y0, r);
  283.                   END;
  284.             'C',
  285.             'S' : ;
  286.             'P' : BEGIN
  287.                     wa := Digit;
  288.                     we := Digit;
  289.                     x0 := wa * TextWidth(' ');
  290.                     y0 := we * TextHeight(',');
  291.                   END;
  292.           END;
  293.     'D' : CASE TokenRead[2] OF
  294.             'C',
  295.             'P',
  296.             'F' : ;
  297.             'I' : BEGIN
  298.                     wa := Digit; we := Digit;
  299.                   END;
  300.             'R' : BEGIN
  301.                     wa := Digit; we := Digit;
  302.                   END;
  303.             'T' : BEGIN
  304.                     sx := ReadToken(SpecChars);
  305.                     DTerminator := sx[1];
  306.                   END;
  307.           END;
  308.     'E' : CASE TokenRead[2] OF
  309.               'A', 'E', 'W' : ;
  310.           END;
  311.     'F' : CASE TokenRead[2] OF
  312.             'T' : ;
  313.           END;
  314.     'I' : CASE TokenRead[2] OF
  315.             'M' : ;
  316.             'N' : BEGIN
  317.                     PaintMode := AbsPaint;
  318.                     Pen := Up;
  319.                     x0 := Translate(250, nx);
  320.                     y0 := Translate(596, ny);
  321.                     hpMinX :=      0;
  322.                     hpMinY :=      0;
  323.                     hpMaxX :=  hpMaxXDef * Corrector;
  324.                     hpMaxY :=  hpMaxYDef * Corrector;
  325.                   END;
  326.             'I', 'P', 'W' : ;
  327.           END;
  328.     'L' : CASE TokenRead[2] OF
  329.             'B' : BEGIN
  330.                     sx := ReadToken(CharArray);
  331.                     Read(f, c);
  332.                     x0 := x1;
  333.                     y0 := y1;
  334.                     OutTextXY(x1, y1, sx);
  335.                     x0 := x0 + TextWidth(sx);
  336.                   END;
  337.             'T' : ;
  338.           END;
  339.     'O' : CASE TokenRead[2] OF
  340.             'A', 'C'..'F', 'H', 'I',
  341.             'O', 'P', 'S', 'W': ;
  342.           END;
  343.     'P' : CASE TokenRead[2] OF
  344.             'A' : BEGIN
  345.                     PaintMode := AbsPaint;
  346.                     GetXY(xDiff, yDiff);
  347.                   END;
  348.             'D' : BEGIN
  349.                     Pen := Down;
  350.                     GetXY(xDiff, yDiff);
  351.                   END;
  352.             'R' : BEGIN
  353.                     PaintMode := RelPaint;
  354.                     GetXY(xDiff, yDiff);
  355.                   END;
  356.             'S' : ; (* Paperformat ignorieren *)
  357.             'U' : BEGIN
  358.                     Pen := Up;
  359.                     GetXY(xDiff, yDiff);
  360.                    END;
  361.           END;
  362.     'R' : CASE TokenRead[2] OF
  363.             'A', 'R': ;
  364.           END;
  365.     'S' : CASE TokenRead[2] OF
  366.             'A' : ;
  367.             'C' : IF (c = Terminator) THEN
  368.                   BEGIN
  369.                     hpMinX :=     0;
  370.                     hpMinY :=     0;
  371.                     hpMaxX := hpMaxXDef * Corrector;
  372.                     hpMaxY := hpMaxYDef * Corrector;
  373.                   END
  374.                   ELSE
  375.                   BEGIN
  376.                     hpMinX := Digit; hpMaxX := Digit;
  377.                     hpMinY := Digit; hpMaxY := Digit;
  378.                   END;
  379.             'I' : BEGIN
  380.                     wa := Digit; we := Digit;
  381.                   END;
  382.             'L',
  383.             'M' : ;
  384.             'P' : ;
  385.             'R',
  386.             'S' : ;
  387.           END;
  388.     'T' : IF TokenRead[2] = 'L' THEN ;
  389.     'U' : IF TokenRead[2] = 'C' THEN ;
  390.     'V' : IF TokenRead[2] = 'S' THEN wa := Digit;
  391.     'W' : IF TokenRead[2] = 'G' THEN ;
  392.     'X' : IF TokenRead[2] = 'T' THEN ;
  393.     'Y' : IF TokenRead[2] = 'T' THEN ;
  394.   END;
  395.   LastToken := TokenRead;
  396. END;
  397.  
  398. FUNCTION UpString(s: STRING): STRING;
  399. VAR
  400.   i: BYTE;
  401.   u: STRING;
  402. BEGIN
  403.   IF s <> '' THEN BEGIN
  404.     u := s;
  405.     FOR i := 1 TO Length(u) DO u[i] := UpCase(u[i]);
  406.   END ELSE u := '';
  407.   UpString := u
  408. END;
  409.  
  410. PROCEDURE PlotFile(xDiv, yDiv: INTEGER);
  411. BEGIN
  412.   x0 := Translate(0, nx); x1 := Translate(0, nx);
  413.   y0 := Translate(0, ny); y1 := Translate(0, ny);
  414.   Assign(f, HPGLFile);
  415.   Reset(f);
  416.   IF IOResult = 0 THEN BEGIN
  417.     scMaxX := GetMaxX; scMaxY := GetMaxY;
  418.     wa := GetBkColor;
  419.     SetBkColor(Black);
  420.     Read(f, c);
  421.     LastToken := '*Start*';
  422.     REPEAT
  423.       Parse(xDiv, yDiv);
  424.     UNTIL EoF(f);
  425.     Close(f);
  426.   END;
  427. END;
  428.  
  429. PROCEDURE Copyright;
  430. BEGIN
  431.   TextColor(Yellow);
  432.   WriteLn(#13#10'3D-Plot v1.0, (C) 1992 '
  433.               + 'Norbert Braun & DMV-Verlag.'#10);
  434.   TextColor(LightGray);
  435. END;
  436.  
  437. PROCEDURE InitBGI;
  438. (* Initialisierung der Grafik; für die Verwendung von SuperVGA *)
  439. (* muß die entsprechende Environment-Variable »BGIDRIVER« ge-  *)
  440. (* setzt sein. Der Grafiktreiber wird in dem Verzeichnis ge-   *)
  441. (* sucht, das mit der Environment-Variablen »BGIPATH« defi-    *)
  442. (* niert ist. Ist »BGIPATH« nicht gesetzt, wird im aktuellen   *)
  443. (* Verzeichnis gesucht.                                        *)
  444. (* SUPERVGA benötigt eine Trident-, Paradise- oder Tseng-Karte *)
  445. (* mit 1 MByte Bildschirmspeicher, die anderen Treiber für 800 *)
  446. (* x 600 eine SVGA-Karte mit 512 kByte Bildschirmspeicher.     *)
  447. (* ----------------------------------------------------------- *)
  448. (* SUPERVGA: 800x600 in 256 Farben; Karte = SVGA autodetect    *)
  449. (* PVGA800:  800x600 in 16 Farben;  Karte = Paradise Prof. VGA *)
  450. (* TRID800:  800x600 in 16 Farben;  Karte = Trident-Chipsatz   *)
  451. (* TSENG800: 800x600 in 16 Farben;  Karte = Tseng ETx000       *)
  452.  
  453. VAR
  454.   GraphDone,
  455.   GraphDriver,
  456.   GraphMode    : INTEGER;
  457.   BGIPath      : PathStr;
  458.   UserBGI      : NameStr;
  459.   ErrMsg       : STRING;
  460.   BGIFile      : FILE;
  461.   Attr         : WORD;
  462. BEGIN
  463.   UserBGI := UpString(GetEnv('BGIDRIVER'));
  464.   BGIPath := UpString(GetEnv('BGIPATH'));
  465.  
  466.   IF UserBGI <> '' THEN BEGIN   (* Install Userdriver *)
  467.     IF UserBGI = SVGAName THEN
  468.       GraphMode := GM800x600    (* aus DOS Extra 17   *)
  469.     ELSE
  470.       GraphMode := FirstMode;   (* Sondertreiber      *)
  471. {$IFDEF VER60}
  472.     GraphDriver := InstallUserDriver(UserBGI, NIL);
  473. {$ELSE}         (* bei Turbo 5.0/5.5 noch fehlerhaft: *)
  474.     GraphDriver := InstallUserDriver(UserBGI, NIL) + 5;
  475. {$ENDIF}
  476.     (* Wenn ein externer BGI-Treiber ReadOnly gesetzt *)
  477.     (* ist, steigt das Programm mit Fehler 3 aus:     *)
  478.     Assign(BGIFile, BGIPath + '\' + UserBGI + '.BGI');
  479.     GetFAttr(BGIFile, Attr);
  480.     IF Attr <> Archive THEN SetFAttr(BGIFile, Archive);
  481.   END ELSE DetectGraph(GraphDriver, GraphMode);
  482.  
  483.   InitGraph(GraphDriver, GraphMode, BGIPath);
  484.   GraphDone := GraphResult;
  485.  
  486.   IF GraphDone <> grOk THEN BEGIN
  487.     Copyright;
  488.     WriteLn('Grafik-Initialisierungsfehler Nr. ',
  489.             Abs(GraphDone), ':');
  490.     CASE GraphDone OF
  491.       -1:  ErrMsg := 'Grafiktreiber nicht geladen.';
  492.       -2:  ErrMsg := 'Grafik-Hardware nicht ermittelt.';
  493.       -3:  ErrMsg := 'BGI-Treiber nicht gefunden.';
  494.       -4:  ErrMsg := 'Falscher Grafiktreiber.';
  495.       ELSE ErrMsg := 'unerwarteter Fehler!';
  496.     END;
  497.     WriteLn(ErrMsg);
  498.     Halt(2);
  499.   END;
  500. END;
  501.  
  502. PROCEDURE UseMakroFile;
  503. VAR
  504.   MacroFile : ComStr;
  505.   MacroDir  : DirStr;
  506.   MacroName : NameStr;
  507.   MacroExt  : ExtStr;
  508.   Wait      : WORD;
  509.  
  510.   PROCEDURE ColorSel;
  511.   BEGIN
  512.     IF Pos('GREEN', Value) > 0 THEN BEGIN
  513.       Color1 := Green; Color2 := Green;
  514.     END ELSE IF Pos('RED', Value) > 0 THEN BEGIN
  515.       Color1 := Red;   Color2 := Red;
  516.     END ELSE IF Pos('WHITE', Value) > 0 THEN BEGIN
  517.       Color1 := White; Color2 := White;
  518.     END ELSE IF Pos('BOTH', Value) > 0 THEN BEGIN
  519.       Color1 := Green; Color2 := Red;
  520.     END ELSE Write(#7);  (* Fehler gefunden! *)
  521.   END;
  522.  
  523.   PROCEDURE Pause;
  524.   VAR
  525.     key: CHAR;
  526.   BEGIN
  527.     ClearBuffer;
  528.     key := #0;
  529.     Sound(800); Delay(25); Sound(400); Delay(25); NoSound;
  530.     REPEAT
  531.       key := ReadKey;
  532.     UNTIL key <> #0;
  533.   END;
  534.  
  535. BEGIN
  536.   MacroFile := ParamStr(1);
  537.   Delete(MacroFile, 1, 2);     (* »-M« entfernen *)
  538.   FSplit(MacroFile, MacroDir, MacroName, MacroExt);
  539.   IF MacroExt = '' THEN
  540.     MacroFile := MacroFile + '.PMC';
  541.   Assign(mf, MacroFile);
  542.   Reset(mf);
  543.   IF IOResult <> 0 THEN BEGIN
  544.     RestoreCrtMode;
  545.     Copyright;
  546.     WriteLn('Beschreibungsdatei nicht gefunden!');
  547.     WriteLn('Programm wird abgebrochen');
  548.     Halt(2);
  549.   END;
  550.   WHILE NOT SeekEoF(mf) DO BEGIN
  551.     ReadLn(mf, CmdLine);
  552.     IF Length(CmdLine) > 0 THEN BEGIN
  553.       WHILE Pos(' ', CmdLine) > 0 DO
  554.         Delete(CmdLine, Pos(' ', CmdLine), 1);
  555.       Value := UpString(CmdLine);
  556.       IF Length(Value) > 2 THEN Delete(Value, 1, 2);
  557.       CASE UpCase(CmdLine[1]) OF
  558.         ';' : (* Kommentar *);
  559.         'X' : Val(Value, xCount, Test);
  560.         'Y' : Val(Value, yCount, Test);
  561.         'F' : BEGIN
  562.                 HPGLFile := Value;
  563.                 IF Pos('.', HPGLFile) = 0 THEN
  564.                   HPGLFile := HPGLFile + '.PLT';
  565.               END;
  566.         'D' : ColorSel;
  567.         '*' : BEGIN
  568.                 IF HPGLFile <> '' THEN PlotFile(xCount, yCount);
  569.                 Color1 := Red; Color2 := Green; (* alle Werte *)
  570.                 xCount := 0;   yCount := 0;   (* zurücksetzen *)
  571.                 Corrector := DefaultCorrector;
  572.               END;
  573.        'W'  : BEGIN
  574.                 Val(Value, Wait, Test);
  575.                 IF Wait > 0 THEN Delay(Wait * 1000);
  576.               END;
  577.        'P'  : IF Pos('PAUSE', UpString(CmdLine)) > 0 THEN Pause;
  578.        'C'  : IF Pos('CLS', UpString(CmdLine)) > 0 THEN
  579.                 ClearDevice;
  580.        'K'  : Val(Value, Corrector, Test);
  581.       END;
  582.     END;
  583.   END;
  584. END;
  585.  
  586. PROCEDURE Help;
  587. VAR
  588.   ProgDir:  DirStr;
  589.   ProgName: NameStr;
  590.   ProgExt:  ExtStr;
  591. BEGIN
  592.   Copyright;
  593.   FSplit(ParamStr(0), ProgDir, ProgName, ProgExt);
  594.   IF Pos('M', UpString(ParamStr(1))) > 1 THEN BEGIN
  595.     WriteLn('Makrobefehle von ', Progname, ':');
  596.     WriteLn(' ': 3, ';', ' ':11, 'Kommentarzeile mit beliebigem'
  597.           + ' Inhalt');
  598.     WriteLn(' ': 3, 'X=zahl', ' ':6,
  599.             'X-Differenz bei rot/grün');
  600.     WriteLn(' ': 3, 'Y=zahl', ' ':6,
  601.             'Y-Different bei rot/grün');
  602.     WriteLn(' ': 3, 'F=Name', ' ':6,
  603.             'Dateiname des HPGL-Files');
  604.     WriteLn(' ': 3, 'W=zahl', ' ':6,
  605.             'Wartezeit in vollen Sekunden');
  606.     WriteLn(' ': 3, 'K=zahl', ' ':6,
  607.             'Bildgrößen-Korrekturfaktor (Default=10)');
  608.     WriteLn(' ': 3, 'CLS', ' ':9, 'Löschen des Bildschirms');
  609.     WriteLn(' ': 3, 'PAUSE', ' ':7, 'Warten auf Tastendruck');
  610.     WriteLn(' ': 3, '*', ' ':11, 'Startbefehl zum Zeichnen '
  611.           + 'mit den aktuellen Werten');
  612.     WriteLn(' ': 3, 'D=farbe     '
  613.           + 'Diese muß als Zeichenkette angegeben werden:');
  614.     WriteLn(' ': 20, 'GREEN für grüne Farbe');
  615.     WriteLn(' ': 20, 'RED   für rote Farbe');
  616.     WriteLn(' ': 20, 'WHITE für weiße Farbe');
  617.     WriteLn(' ': 20, 'BOTH  für Anzeige in rot und grün');
  618.     WriteLn('Groß-/Kleinschreibung wird nicht beachtet.');
  619.     Write  ('Die Grafik wird erst mit dem Startbefehl mit den');
  620.     WriteLn(' aktuellen Werten gezeichnet,');
  621.     WriteLn('nach jedem Bild werden die Parameter wieder '
  622.           + 'zurückgesetzt.');
  623.     WriteLn('Pause, W(ait) und CLS werden sofort ausgeführt.');
  624.     Write  ('Für X=, Y=, K= und W= dürfen nur ganze Zahlen '
  625.           + 'angegeben werden!');
  626.   END ELSE BEGIN
  627.     WriteLn('Syntax:');
  628.     FSplit(ParamStr(0), ProgDir, ProgName, ProgExt);
  629.     WriteLn(' ':3, ProgName, ' dateiname[.ext] [x-Differenz '
  630.           + '[y-Differenz]] | -Mmakrodatei[.ext]');
  631.     WriteLn('B':4, 'eispiele: ', ProgName, ' 3DIM.PLT 20 2'
  632.           + '   Darstellung eines Bildes mit 3D-Effekt');
  633.     WriteLn(' ':14, ProgName, ' 3DIM', ' ': 12,
  634.             'Darstellung des selben Bildes in weiß');
  635.     WriteLn(' ':14, ProgName, ' -mMAKRO', ' ':9,
  636.             'Verwendung einer Makrodatei »MAKRO.PMC«');
  637.     WriteLn(' ':14, ProgName, ' [-?]', ' ' :12,
  638.           + 'Anzeige dieses Hilfebildschirms');
  639.     WriteLn(' ':14, ProgName, ' -?M[ACRO]', ' ' :7,
  640.           + 'Übersicht über die Makrobefehle'#10);
  641.     Write  ('Das Programm zeichnet HPGL-Plotterdateien auf den'
  642.           + ' Bildschirm. Dabei kann zusätz-');
  643.     Write  ('lich ein 3D-Effekt erzeugt werden. Um diesen zu n'
  644.           + 'utzen, wird eine Rotgrün-Brille');
  645.     WriteLn('benötigt.');
  646.     Write  ('Bei Aufruf einer Plot-Datei ohne Angabe einer X-D'
  647.           + 'ifferenz wird die Datei in weiß');
  648.     WriteLn('ohne 3D-Effekt wiedergegeben. Farbangaben in der '
  649.           + 'Plot-Datei werden übergangen.');
  650.     Write  ('Die Angabe eines Y-Wertes ist optional.  Wird Y n'
  651.           + 'icht angegeben, wird der X-Wert');
  652.     WriteLn('für Y mit übernommen.');
  653.     Write  ('Für die Darstellung des 3D-Effektes wird eine EGA'
  654.           + ', VGA, IBM/8514 oder SVGA-Karte');
  655.     WriteLn('mit Farbmonitor benötigt.');
  656.     WriteLn('Voreingestellte Dateiendung ist bei HPGL-Dateien '
  657.           + '».PLT« und bei Makros ».PLC«.');
  658.     WriteLn('Parameter in eckigen Klammern sind optional.');
  659.   END;
  660. END;
  661.  
  662. BEGIN
  663.   IF (ParamCount < 1) OR (Pos('?', ParamStr(1)) > 0) THEN
  664.     Help
  665.   ELSE BEGIN
  666.     InitBGI;
  667.     SetPrefColors;
  668.     IF (Pos('-m', ParamStr(1)) = 1) OR
  669.        (Pos('/m', ParamStr(1)) = 1) OR
  670.        (Pos('-M', ParamStr(1)) = 1) OR
  671.        (Pos('/M', ParamStr(1)) = 1) THEN UseMakroFile
  672.     ELSE BEGIN
  673.       IF ParamCount > 1 THEN BEGIN
  674.         Val(ParamStr(2), xCount, Test);
  675.         IF Test <> 0 THEN xCount := 0;
  676.         IF ParamCount > 2 THEN BEGIN
  677.           Val(ParamStr(3), yCount, Test);
  678.           IF Test <> 0 THEN yCount := xCount;
  679.         END ELSE yCount := xCount;
  680.       END ELSE BEGIN
  681.         xCount := 0; yCount := xCount;
  682.       END;
  683.       HPGLFile := ParamStr(1);
  684.       FSplit(HPGLFile, HPGLDir, HPGLName, HPGLExt);
  685.       IF HPGLExt = '' THEN 
  686.         HPGLFile := HPGLFile + '.PLT';
  687.       IF xCount = 0 THEN BEGIN
  688.         Color1 := White; Color2 := Color1;
  689.       END;
  690.       x0 := Translate(0, nx); x1 := Translate(0, nx);
  691.       y0 := Translate(0, ny); y1 := Translate(0, ny);
  692.       Assign(f, HPGLFile);
  693.       Reset(f);
  694.       IF IOResult = 0 THEN BEGIN
  695.         scMaxX := GetMaxX;
  696.         scMaxY := GetMaxY;
  697.         wa := GetBkColor;
  698.         SetBkColor(Black);
  699.         Read(f, c);
  700.         LastToken := '*Start*';
  701.         REPEAT
  702.           Parse(xCount, yCount);
  703.         UNTIL EoF(f);
  704.         Close(f);
  705.       END ELSE BEGIN
  706.         RestoreCrtMode;
  707.         Copyright;
  708.         Write('Fehler: ');
  709.         WriteLn('Datei nicht gefunden, ' +
  710.                 'Programm abgebrochen!');
  711.         Exit;
  712.       END;
  713.     END;
  714.     Sound(800); Delay(100);          (* Hallo, ich bin fertig! *)
  715.     Sound(400); Delay(100);
  716.     NoSound;
  717.     ModifyColors;
  718.     RestoreCrtMode;
  719.   END;
  720. END.
  721.  
  722. (* ----------------------------------------------------------- *)
  723. (*                     Ende von PLOT.PAS                       *)
  724.