home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / aeg020 / sps.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-11-28  |  4.8 KB  |  181 lines
  1. program sps;
  2.  
  3. (*$M 4096,0,65535 *)
  4.  
  5. uses
  6. crt,dos,extend;
  7.  
  8. const
  9. copyright = '|Peter Sieg 2-Aug-1990  Version 1.1; Alle Rechte vorbehalten|';
  10.  
  11. var
  12. xalt               :  byte;
  13. yalt               :  byte;
  14. attralt            :  byte;
  15.  
  16. (*$I sps.var *)
  17. (*$I sps.inc *)
  18. (*$I sps.sim *)
  19. (*$I sps.lst *)
  20.  
  21.  
  22. procedure einlesen;
  23.  
  24. begin
  25.   anzaw                  := 0;
  26.   klammern               := 0;
  27.   status                 := 0;
  28.   lastaw                 := '';
  29.   while ((status >= 0) and not eof(infile)) do
  30.   begin
  31.     readln (infile,aw);
  32.     repeat
  33.       gotoxy ( 1, 4);
  34.       clreol;
  35.       anzaw              := succ(anzaw);
  36.       write  (' [',anzaw:4,'] ',aw);
  37.       syntax_check(aw);
  38.       if (lastaw = aw) and not (aw = ')') then
  39.         status           := -1;
  40.       if (aw[1] = '=') and (lastaw[1] = '=') then
  41.         status           := -1;
  42.       if (pos('(',lastaw) > 0) and (aw = ')') then
  43.         status           := -1;
  44.       if (klammern > deep) then
  45.         status           := -2;
  46.       if (status = 0) and sende then
  47.         if (klammern <> 0) then
  48.           status         := -2;
  49.       if (status = 0) then
  50.         lastaw           := aw;
  51.       if (status < 0) then
  52.         fehlerbehandlung;
  53.     until (status <> 2);
  54.   end;
  55.   if (status <> 1) then
  56.   begin
  57.     if (status = 0) then
  58.       write  (' Unerwartetes Ende der Datei...')
  59.     else
  60.       write  (' Funktion abgebrochen...');
  61.     getkey;
  62.   end;
  63. end;
  64.  
  65.  
  66. procedure get_awl;
  67.  
  68. begin
  69.   status                 := 0;
  70.   korrektur              := false;
  71.   mask                   := '*.AWL';
  72.   askmask                := false;
  73.   filename               := dirwin;
  74.   if filename <> '<ESC>' then
  75.   begin
  76.   fenster(8,6,60,10);
  77.   writeln(' Einlesen von ',filename,'...');
  78.   assign (infile,filename);
  79.   reset  (infile);
  80.   einlesen;
  81.   window(1,1,80,25);
  82.   textattr         := normalattr;
  83.   close  (infile);
  84.   if (status = 1) then
  85.   begin
  86.     if korrektur then
  87.     begin
  88.       rewrite(infile);
  89.       for i            := 1 to anzaw do
  90.       begin
  91.         with awl[i] do
  92.         begin
  93.           write  (infile,operation);
  94.           write  (infile,operand);
  95.           if (kennzahl = -1) then
  96.             writeln(infile)
  97.           else
  98.             writeln(infile,kennzahl);
  99.         end;
  100.       end;
  101.       close  (infile);
  102.     end;
  103.     message(mess[1]);
  104.   end
  105.   else
  106.     message(mess[8]);
  107.   end
  108.   else
  109.     message(mess[7]);
  110. end;
  111.  
  112.  
  113. begin
  114.   clrscr;
  115.   init_screen(4);
  116.   normalattr             := $30;
  117.   if (computer = $FC) then
  118.     delay                := delay * 4;
  119.   status                 := -1;
  120.  
  121.   if exist('logo.scr') then
  122.   begin
  123.     cursor_aus;
  124.     ja                   := load_screen(2,'logo.scr');
  125.     restore_screen(2);
  126.     wait(2);
  127.     cursor_ein;
  128.   end;
  129.   ja                     := load_screen(2,'sps.scr');
  130.   if not ja then halt;
  131.   ja                     := load_screen(3,'sim.scr');
  132.   if not ja then halt;
  133.  
  134.   repeat
  135.     cursor_aus;
  136.     restore_screen(2);
  137.     getkey;
  138.     case upcase(key) of
  139.       'E'                :  get_awl;
  140.       'S'                :  begin
  141.                               if (status <> 1) then
  142.                                 get_awl;
  143.                               if (status = 1) then
  144.                                 simulation;
  145.                             end;
  146.       'G'                :  begin
  147.                               if (status <> 1) then
  148.                                 get_awl;
  149.                               if (status = 1) then
  150.                                 if ((diskfree(0) div 1024) > 20) then
  151.                                   dokumentation
  152.                                 else
  153.                                   message(mess[10]);
  154.                             end;
  155.       'L'                :  begin
  156.                               exec('procomm.exe',' /Fupload.cmd');
  157.                               case doserror of
  158.                                 2,3          :  message(mess[6]);
  159.                                 8            :  message(mess[9]);
  160.                                 0            :  message(mess[4]);
  161.                               else
  162.                                                 message(mess[11]);
  163.                               end;
  164.                             end;
  165.       'T'                :  begin
  166.                               exec('procomm.exe' ,'');
  167.                               case doserror of
  168.                                 2,3          :  message(mess[6]);
  169.                                 8            :  message(mess[9]);
  170.                                 0            :  message(mess[5]);
  171.                               else
  172.                                                 message(mess[11]);
  173.                               end;
  174.                             end;
  175.     end;
  176.   until (upcase(key)  = 'V');
  177.   normvideo;
  178.   clrscr;
  179.   cursor_ein;
  180. end.
  181.