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