home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / aeg020 / sps.sim < prev    next >
Encoding:
Text File  |  1990-11-28  |  12.1 KB  |  420 lines
  1.  
  2. procedure get_i (w : boolean);
  3.  
  4. begin
  5.   textattr         := $30;
  6.   if w then
  7.   begin
  8.     write_screen(41,18,'Sollwert:     ');
  9.     gotoxy(51,18);
  10.     i              := read_int(false,5,0,0,65535);
  11.   end
  12.   else
  13.   begin
  14.     write_screen(41,18,'Kennzahl:     ');
  15.     gotoxy(51,18);
  16.     i              := read_int(false,3,0,1,128);
  17.   end;
  18.   write_screen(41,18,'   Beenden     ');
  19.   gotoxy (44,18);
  20. end;
  21.  
  22.  
  23.  
  24. procedure led (on : boolean; m,s,p,z : integer);
  25.  
  26. begin
  27.   if (s < m) then
  28.   begin
  29.     if on then
  30.       write_screen(s+p,z,eins)
  31.     else
  32.       write_screen(s+p,z,null);
  33.   end;
  34. end;
  35.  
  36.  
  37.  
  38. procedure ti_upd (k,w : integer);
  39.  
  40. begin
  41.   if (w < 0) then
  42.     t_[k].ist            := t_[k].ist + w
  43.   else
  44.     t_[k].ist            := w;
  45.   if (k < dist) then
  46.     write_screen(ti,k+tz,int_to_str(t_[k].ist,5));
  47. end;
  48.  
  49.  
  50.  
  51. procedure zi_upd (k,w : integer);
  52.  
  53. begin
  54.   if (w < 0) then
  55.     z_[k].ist            := z_[k].ist + w
  56.   else
  57.     z_[k].ist            := w;
  58.   if (k < disz) then
  59.     write_screen(zi,k+zz,int_to_str(z_[k].ist,5));
  60. end;
  61.  
  62.  
  63.  
  64. procedure speed_upd( w : integer );
  65.  
  66. begin
  67.   speed            := speed + w;
  68.   if (speed < 1) then
  69.     speed          := 100
  70.   else if (speed > 100) then
  71.     speed          := 1;
  72.   write_screen(42,4,int_to_str(speed,3));
  73. end;
  74.  
  75.  
  76.  
  77. procedure displ_upd;
  78.  
  79. var
  80. i,j                      :  integer;
  81.  
  82. begin
  83.   for j                  := scrollstart to scrollende do
  84.   begin
  85.     i                    := j - scrollstart;
  86.     with awl[j] do
  87.     begin
  88.       write_screen(25,disaw+i,int_to_str(j,3));
  89.       write_screen(29,disaw+i,'       ');
  90.       write_screen(29,disaw+i,operation);
  91.       write_screen(32,disaw+i,operand);
  92.       if (kennzahl > 0) then
  93.         write_screen(33,disaw+i,int_to_str(kennzahl,3));
  94.     end;
  95.   end;
  96. end;
  97.  
  98.  
  99.  
  100. procedure sim_untermenue;
  101.  
  102. begin
  103.   write_screen(42, 8,'  Eingang   ');
  104.   write_screen(42,10,'  Ausgang   ');
  105.   write_screen(42,12,'  Merker    ');
  106.   write_screen(42,14,'  Timer     ');
  107.   write_screen(42,16,'  Zaehler   ');
  108.   write_screen(42,18,'  Beenden   ');
  109.   gotoxy (44,18);
  110.   repeat
  111.     getkey;
  112.     case upcase(key) of
  113.       'E'                :  begin
  114.                               get_i(false);
  115.                               if (i <= maxe) then
  116.                               begin
  117.                                 e_[i]        := not e_[i];
  118.                                 led(e_[i],dise,i,es,ez);
  119.                               end;
  120.                             end;
  121.       'A'                :  begin
  122.                               get_i(false);
  123.                               if (i <= maxa) then
  124.                               begin
  125.                                 a_[i]        := not a_[i];
  126.                                 led(a_[i],disa,i,as,az);
  127.                               end;
  128.                             end;
  129.       'M'                :  begin
  130.                               get_i(false);
  131.                               if (i <= maxm) then
  132.                               begin
  133.                                 m_[i]        := not m_[i];
  134.                                 led(m_[i],dism,i,ms,mz);
  135.                               end;
  136.                             end;
  137.       'T'                :  begin
  138.                               get_i(false);
  139.                               if (i <= maxt) then
  140.                               begin
  141.                                 j            := i;
  142.                                 get_i(true);
  143.                                 t_[j].soll   := i;
  144.                                 if (j < dist) then
  145.                                   write_screen(ts,j+tz,int_to_str(t_[j].soll,5));
  146.                                 ti_upd(j,i);
  147.                               end;
  148.                             end;
  149.       'Z'                :  begin
  150.                               get_i(false);
  151.                               if (i <= maxz) then
  152.                               begin
  153.                                 j            := i;
  154.                                 get_i(true);
  155.                                 z_[j].soll   := i;
  156.                                 if (j < disz) then
  157.                                   write_screen(zs,j+zz,int_to_str(z_[j].soll,5));
  158.                                 zi_upd(j,i);
  159.                               end;
  160.                             end;
  161.  
  162.     end;
  163.     gotoxy (44,18);
  164.   until (upcase(key) = 'B');
  165. end;
  166.  
  167.  
  168.  
  169. procedure sim_anweisung;
  170.  
  171. var
  172. dis_ja,
  173. dis_aus                  :  boolean;
  174. xoperation               :  awtyp;
  175.  
  176. begin
  177.   with awl[aktaw] do
  178.   begin
  179.     if (operation = 'PE') then
  180.     begin
  181.       fillchar(ausgang,deep,#255);
  182.       aktaw              := 1;
  183.     end;
  184.     if (operation = 'SW') and ausgang[klammern] then
  185.     begin
  186.       fillchar(ausgang,deep,#255);
  187.       if (kennzahl < anzaw) then
  188.         aktaw            := kennzahl
  189.       else
  190.         aktaw            := 1;
  191.     end;
  192.   end;
  193.   with awl[aktaw] do
  194.   begin
  195.     xoperation           := operation;
  196.     dis_ja               := false;
  197.     dis_aus              := false;
  198.     if (operand[1] in ['E','A','M','T','Z']) THEN
  199.     begin
  200.       case operand[1] of
  201.         'E'              :  ja         := e_[kennzahl];
  202.         'A'              :  ja         := a_[kennzahl];
  203.         'M'              :  ja         := m_[kennzahl];
  204.         'T'              :  ja         :=(t_[kennzahl].ist = 0);
  205.         'Z'              :  ja         :=(z_[kennzahl].ist = 0);
  206.       end;
  207.       dis_ja             := ja;
  208.     end;
  209.     if (xoperation = ')') then
  210.     begin
  211.       ja                 := ausgang[klammern];
  212.       xoperation         := opr[klammern];
  213.       klammern           := pred(klammern);
  214.     end;
  215.     if (xoperation = 'U') then
  216.       ausgang[klammern]  := (ausgang[klammern] and ja)
  217.     else if (xoperation = 'O') then
  218.       ausgang[klammern]  := (ausgang[klammern] or  ja)
  219.     else if (xoperation = 'UN') then
  220.       ausgang[klammern]  := (ausgang[klammern] and not ja)
  221.     else if (xoperation = 'ON') then
  222.       ausgang[klammern]  := (ausgang[klammern] or  not ja);
  223.  
  224.     i                    := pos('(',operation);
  225.     if (i > 1) then
  226.     begin
  227.       klammern           := succ(klammern);
  228.       opr[klammern]      := copy(operation,1,i-1);
  229.     end;
  230.     dis_aus              := ausgang[klammern];
  231.     if (operation[1] = '=') then
  232.     begin
  233.       dis_ja             := false;
  234.       if (operation[2] = 'N') then
  235.         ausgang[klammern]:= not ausgang[klammern];
  236.       case operand[1] of
  237.         'A'              :  begin
  238.                               a_[kennzahl]   := ausgang[klammern];
  239.                               led(a_[kennzahl],disa,kennzahl,as,az);
  240.                             end;
  241.         'M'              :  begin
  242.                               m_[kennzahl]   := ausgang[klammern];
  243.                               led(m_[kennzahl],dism,kennzahl,ms,mz);
  244.                             end;
  245.         'E'              :  begin
  246.                               e_[kennzahl]   := ausgang[klammern];
  247.                               led(e_[kennzahl],disa,kennzahl,es,ez);
  248.                             end;
  249.         'L'              :  if (ausgang[klammern]) then
  250.                               zi_upd(kennzahl,z_[kennzahl].soll);
  251.         'I'              :  if (ausgang[klammern] and (z_[kennzahl].ist > 0)) then
  252.                               zi_upd(kennzahl,-1);
  253.         'T'              :  if (ausgang[klammern]) then
  254.                             begin
  255.                               if (t_[kennzahl].ist > 0) then
  256.                                 ti_upd(kennzahl,-1);
  257.                             end
  258.                             else
  259.                               ti_upd(kennzahl,t_[kennzahl].soll);
  260.       end;
  261.       fillchar(ausgang,deep,#255);
  262.     end;
  263.     if ((operation = 'SL') or (operation = 'RL')) then
  264.     begin
  265.       dis_ja             := false;
  266.       if (ausgang[klammern]) then
  267.       case operand[1] of
  268.         'A'              :  begin
  269.                               if (operation[1] = 'S') then
  270.                                 a_[kennzahl] := true
  271.                               else
  272.                                 a_[kennzahl] := false;
  273.                               led(a_[kennzahl],disa,kennzahl,as,az);
  274.                             end;
  275.         'M'              :  begin
  276.                               if (operation[1] = 'S') then
  277.                                 m_[kennzahl] := true
  278.                               else
  279.                                 m_[kennzahl] := false;
  280.                               led(m_[kennzahl],dism,kennzahl,ms,mz);
  281.                             end;
  282.       end;
  283.       fillchar(ausgang,deep,#255);
  284.     end;
  285.     if (aktaw in [scrollstart..scrollende]) then
  286.     begin
  287.       j                  := disaw + (aktaw - scrollstart);
  288.       led(dis_ja ,80,0,37,j);
  289.       led(dis_aus,80,0,39,j);
  290.     end;
  291.     write_screen(43,10,int_to_str(aktaw,3));
  292.     write_screen(47,10,operation + '      ');
  293.     write_screen(50,10,operand);
  294.     if (kennzahl > 0) then
  295.       write_screen(51,10,int_to_str(kennzahl,3));
  296.   end;
  297.  
  298.   aktaw                  := succ(aktaw);
  299.   if (aktaw > anzaw) then
  300.     aktaw                := 1;
  301.   for i                  := speed to 100 do
  302.     for j                := 1 to delay do;
  303. end;
  304.  
  305.  
  306.  
  307. procedure ftaste;
  308.  
  309. begin
  310.   case ord(key) of
  311.     84..103              :  begin
  312.                               i        := ord(key) - 83;
  313.                               e_[i]    := not e_[i];
  314.                               led(e_[i],dise,i,es,ez);
  315.                             end;
  316.     72                   :  if (scroll and (scrollstart > 1)) then
  317.                             begin
  318.                               dec(scrollstart,1);
  319.                               dec(scrollende ,1);
  320.                               displ_upd;
  321.                             end;
  322.     80                   :  if (scroll and (scrollende < anzaw)) then
  323.                             begin
  324.                               inc(scrollstart,1);
  325.                               inc(scrollende ,1);
  326.                               displ_upd;
  327.                             end;
  328.     77                   :  speed_upd(1);
  329.     75                   :  speed_upd(-1);
  330.   end;
  331. end;
  332.  
  333.  
  334.  
  335. procedure sim_hauptmenue;
  336.  
  337. var
  338. i,j                      :  integer;
  339.  
  340. begin
  341.   write_screen(42, 8,' Veraendern ');
  342.   write_screen(42,10,'[   ]       ');
  343.   write_screen(42,12,' Einzelanw. ');
  344.   write_screen(42,14,' Start Prg. ');
  345.   write_screen(42,16,' Stop  Prg. ');
  346.   write_screen(42,18,' Quittieren ');
  347.   displ_upd;
  348.   repeat
  349.     gotoxy (43,18);
  350.     getkey;
  351.     if fkey then
  352.       ftaste
  353.     else
  354.     begin
  355.       case upcase(key) of
  356.         'E'              :  sim_anweisung;
  357.         'S'              :  repeat
  358.                               while ((aktaw <= anzaw) and not keypressed) do
  359.                                 sim_anweisung;
  360.                               if keypressed then
  361.                                 if (key = #0) then
  362.                                 begin
  363.                                   key  := readkey;
  364.                                   ftaste;
  365.                                 end
  366.                                 else
  367.                                   key  := upcase(readkey);
  368.                             until (key = 'S');
  369.       end;
  370.     end;
  371.   until ((upcase(key) = 'Q') or (upcase(key) = 'V')) and not fkey;
  372. end;
  373.  
  374.  
  375.  
  376. procedure sim_init;
  377.  
  378. begin
  379.   fillchar(e_,maxe,#0);
  380.   fillchar(a_,maxa,#0);
  381.   fillchar(m_,maxm,#0);
  382.   fillchar(t_,maxt * 2 * intsize,#0);
  383.   fillchar(z_,maxz * 2 * intsize,#0);
  384.   fillchar(ausgang,deep,#255);
  385.   aktaw                  := 1;
  386.   klammern               := 1;
  387.   scrollstart            := 1;
  388.   if (anzaw < 15) then
  389.   begin
  390.     scroll               := false;
  391.     scrollende           := anzaw;
  392.   end
  393.   else
  394.   begin
  395.     scroll               := true;
  396.     scrollende           := 14;
  397.   end;
  398. end;
  399.  
  400.  
  401. procedure simulation;
  402.  
  403. begin
  404.   cursor_aus;
  405.   window(1,1,80,25);
  406.   restore_screen(3);
  407.   sim_init;
  408.   repeat
  409.     sim_hauptmenue;
  410.     if (upcase(key) = 'V') then
  411.     begin
  412.       cursor_ein;
  413.       sim_untermenue;
  414.       cursor_aus;
  415.     end;
  416.   until (upcase(key) = 'Q');
  417.   cursor_ein;
  418.   message(mess[2])
  419. end;
  420.