Power-Programmierung/CD1.mdf/pascal/library/dos/s5/s5.sim

Text File | 1990-12-28 | 14.4 KB | 507 lines

procedure get_bst_bit;

begin
  if mono then
    textattr       := $0F
  else
    textattr       := $07;
  write_screen(43,18,'Baustein:     ');
  gotoxy(53,18);
  bst              := read_int(false,3,0,0,9);
  write_screen(43,18,'Bitnr.  :     ');
  gotoxy(53,18);
  bit              := read_int(false,3,0,0,7);
  write_screen(43,18,'    Beenden     ');
  gotoxy (46,18);
end;



procedure led (on : boolean; max,bst,bit,offsp,offz : integer);

begin
  if (bst <= max) then
  begin
    if on then
      write_screen(bst*8+bit+offsp,offz,eins)
    else
      write_screen(bst*8+bit+offsp,offz,null)
  end;
end;



procedure ti_upd( bst,w : integer; b : boolean);

begin
  if b then
    t_[bst].wert   := t_[bst].wert + w
  else
    t_[bst].wert   := w;

  if (t_[bst].wert < 0) then
    t_[bst].wert   := 0;
  if (t_[bst].wert > maxkt) then
    t_[bst].wert   := maxkt;

  write_screen(ti,bst+tz,int_to_str(t_[bst].wert,5));
  if not b then
    write_screen(ts,bst+tz,int_to_str(t_[bst].wert,3)+'.'+int_to_str(t_[bst].einheit,1));
end;



procedure zi_upd( bst,w : integer; b : boolean);

begin
  if b then
    z_[bst].wert   := z_[bst].wert + w
  else
    z_[bst].wert   := w;

  if (z_[bst].wert < 0) then
    z_[bst].wert   := 0;
  if (z_[bst].wert > maxkz) then
    z_[bst].wert   := maxkz;

  write_screen(zi,bst+zz,int_to_str(z_[bst].wert,5));
  if not b then
    write_screen(zs,bst+zz,int_to_str(z_[bst].wert,5));
end;



procedure speed_upd( w : integer );

begin
  speed                  := speed + w;
  if (speed < 1) then
    speed                := 100
  else if (speed > 100) then
    speed                := 1;
  write_screen(42,4,int_to_str(speed,3));
end;



procedure akku_upd( w,e : integer );

begin
  akku.einheit           := e;
  akku.wert              := w;
  write_screen(42,21,int_to_str(akku.wert,3));
  if (akku.einheit > -1) then
    write_screen(45,21,'.'+int_to_str(akku.einheit,1))
  else
    write_screen(45,21,'  ');
end;



procedure displ_upd;

var
i,j                      :  integer;

begin
  for j                  := scrollstart to scrollende do
  begin
    i                    := j - scrollstart;
    with awl[j] do
    begin
      write_screen(23,disaw+i,int_to_str(j,4));
      write_screen(28,disaw+i,'          ');
      write_screen(28,disaw+i,operation);
      write_screen(31,disaw+i,operand);
      if (baustein >= 0) then
      begin
        write_screen(33,disaw+i,int_to_str(baustein,3));
        if (bitnr >= 0) then
          write_screen(36,disaw+i,'.'+int_to_str(bitnr,1));
      end;
      write_screen(39,disaw+i,null);
      write_screen(41,disaw+i,null);
    end;
  end;
end;



procedure sim_untermenue;

begin
  write_screen(43, 8,'    Eingang     ');
  write_screen(43,10,'    Ausgang     ');
  write_screen(43,12,'    Merker      ');
  write_screen(43,14,'                ');
  write_screen(43,16,'                ');
  write_screen(43,18,'    Beenden     ');
  gotoxy (47,18);
  repeat
    getkey;
    case upcase(key) of
      'E'                :  begin
                              get_bst_bit;
                              if (bst <= maxe) then
                              begin
                                e_[bst,bit]  := not e_[bst,bit];
                                led(e_[bst,bit],dise,bst,bit,es,ez);
                              end;
                            end;
      'A'                :  begin
                              get_bst_bit;
                              if (bst <= maxa) then
                              begin
                                a_[bst,bit]  := not a_[bst,bit];
                                led(a_[bst,bit],disa,bst,bit,as,az);
                              end;
                            end;
      'M'                :  begin
                              get_bst_bit;
                              if (bst <= maxm) then
                              begin
                                m_[bst,bit]  := not m_[bst,bit];
                                led(m_[bst,bit],dism,bst,bit,ms,mz);
                              end;
                            end;
    end;
    gotoxy (47,18);
  until (upcase(key) = 'B');
end;



procedure sim_anweisung;

var
dis_ja,
dis_aus                  :  boolean;
xoperation               :  awtyp;

begin
  with awl[aktaw] do
  begin
    if (operation[1] = 'B') then
    begin
      fillchar(ausgang,deep,#255);
      if (operation = 'BE') or lastausgang then
      begin
        aktaw            := 1;
        lastausgang      := false; (* ??? *)
        oder_von_und     := false;
      end;
    end;
  end;
  with awl[aktaw] do
  begin
    xoperation           := operation;
    dis_ja               := false;
    dis_aus              := false;

    if (operand[1] = 'T') then ti_upd(baustein,-1,true); (* Pseudo Timer *)

    if (operand[1] in ['E','A','M','T','Z']) THEN
    begin
      case operand[1] of
        'E'              :  ja         := e_[baustein,bitnr];
        'A'              :  ja         := a_[baustein,bitnr];
        'M'              :  ja         := m_[baustein,bitnr];
        'T'              :  ja         := (t_[baustein].wert = 0);
        'Z'              :  ja         := (z_[baustein].wert = 0);
      end;
      dis_ja             := ja;
    end;
    if (xoperation = ')') then
    begin
      ja                 := ausgang[klammern];
      xoperation         := opr[klammern];
      klammern           := pred(klammern);
    end;
    if (xoperation = 'U') then
      ausgang[klammern]  := (ausgang[klammern] and ja)
    else
    if (xoperation = 'O') then
    begin
      if (operand = '') then                 (* Oder von Und *)
      begin
        oder_von_und     := (oder_von_und or lastausgang);
        fillchar(ausgang,deep,#255);
      end
      else
        ausgang[klammern]:= (ausgang[klammern] or  ja);
    end
    else if (xoperation = 'UN') then
      ausgang[klammern]  := (ausgang[klammern] and not ja)
    else if (xoperation = 'ON') then
      ausgang[klammern]  := (ausgang[klammern] or  not ja);

    i                    := pos('(',operation);
    if (i > 1) then
    begin
      klammern           := succ(klammern);
      opr[klammern]      := copy(operation,1,i-1);
    end;

    if ((operation <> '=') and (operation[1] <> 'S') and (operation <> 'R')) then
      dis_aus            := ausgang[klammern];

    if (operation = '=') then
    begin
      dis_ja             := false;
      dis_aus            := (dis_aus or lastausgang or oder_von_und);
      case operand[1] of
        'E'              :  begin
                              e_[baustein,bitnr] := dis_aus;
                              led(e_[baustein,bitnr],disa,baustein,bitnr,es,ez);
                            end;
        'A'              :  begin
                              a_[baustein,bitnr] := dis_aus;
                              led(a_[baustein,bitnr],disa,baustein,bitnr,as,az);
                            end;
        'M'              :  begin
                              m_[baustein,bitnr] := dis_aus;
                              led(m_[baustein,bitnr],dism,baustein,bitnr,ms,mz);
                            end;
      end;
      fillchar(ausgang,deep,#255);
      oder_von_und       := false;
    end;

    if ((operation[1] = 'S') or (operation = 'R')) then
    begin
      dis_ja             := false;
      dis_aus            := (dis_aus or lastausgang or oder_von_und);
      if dis_aus then
      begin
      case operand[1] of
        'E'              :  begin
                              if (operation = 'S') then
                                e_[baustein,bitnr] := true
                              else
                                e_[baustein,bitnr] := false;
                              led(e_[baustein,bitnr],dise,baustein,bitnr,es,ez);
                            end;
        'A'              :  begin
                              if (operation = 'S') then
                                a_[baustein,bitnr] := true
                              else
                                a_[baustein,bitnr] := false;
                              led(a_[baustein,bitnr],disa,baustein,bitnr,as,az);
                            end;
        'M'              :  begin
                              if (operation = 'S') then
                                m_[baustein,bitnr] := true
                              else
                                m_[baustein,bitnr] := false;
                              led(m_[baustein,bitnr],dism,baustein,bitnr,ms,mz);
                            end;
        'T'              :  begin
                              if (operation[1] = 'S') then
                              begin
                                t_[baustein].einheit := akku.einheit;
                                ti_upd(baustein,akku.wert,false);
                              end
                              else
                                ti_upd(baustein,0,false);
                            end;
        'Z'              :  begin
                              if (operation[1] = 'S') then
                                zi_upd(baustein,akku.wert,false)
                              else
                                zi_upd(baustein,0,false);
                            end;
      end;
      end;
      fillchar(ausgang,deep,#255);
      oder_von_und       := false;
    end;

    if ((operation = 'L') and (operand[1] = 'K')) then
    begin
      dis_ja             := false;
      dis_aus            := (dis_aus or lastausgang);
      if dis_aus then       (* ??? *)
      akku_upd(baustein,bitnr);
    end;

    if (operation[1] = 'Z') then
    begin
      dis_ja             := false;
      dis_aus            := (dis_aus or lastausgang or oder_von_und);
      if dis_aus then
      begin
      case operation[2] of
        'R'              :  begin
                              zi_upd(baustein,-1,true);
                            end;
        'V'              :  begin
                              zi_upd(baustein,+1,true);
                            end;
      end;
      end;
      fillchar(ausgang,deep,#255);
      oder_von_und       := false;
    end;

    lastausgang          := dis_aus;

    if (aktaw in [scrollstart..scrollende]) then
    begin
      j                  := disaw + (aktaw - scrollstart);
      led(dis_ja ,80,0,0,39,j);
      led(dis_aus,80,0,0,41,j);
    end;
    write_screen(44,10,int_to_str(aktaw,3));
    write_screen(48,10,operation + '        ');
    write_screen(51,10,operand + '      ');
    if (baustein >= 0) then
    begin
      write_screen(53,10,int_to_str(baustein,3));
      if (bitnr >= 0) then
        write_screen(56,10,'.'+int_to_str(bitnr,1));
    end;
  end;

  aktaw                  := succ(aktaw);
  if (aktaw > anzaw) then
    aktaw                := 1;
  for i                  := speed to 100 do
    for j                := 1 to delay do;
end;


procedure change_e(bst,bit : integer);

begin
  e_[bst,bit]  := not e_[bst,bit];
  led(e_[bst,bit],dise,bst,bit,es,ez);
end;


procedure ftaste;

begin
  case ord(key) of
   84.. 91 (* sf1-sf8 *) :  change_e(0,ord(key)-84);
   94..101 (* cf1-cf8 *) :  change_e(1,ord(key)-94);
  104..111 (* af1-af8 *) :  change_e(2,ord(key)-104);
    72                   :  if (scroll and (scrollstart > 1)) then
                            begin
                              dec(scrollstart);
                              dec(scrollende);
                              displ_upd;
                            end;
    80                   :  if (scroll and (scrollende < anzaw)) then
                            begin
                              inc(scrollstart);
                              inc(scrollende);
                              displ_upd;
                            end;
    77                   :  speed_upd(1);
    75                   :  speed_upd(-1);
  end;
end;



procedure sim_hauptmenue;

var
i,j                      :  integer;

begin
  write_screen(43, 8,'   Veraendern   ');
  write_screen(43,10,'[   ]           ');
  write_screen(43,12,'   Einzelanw.   ');
  write_screen(43,14,'   Start Prg.   ');
  write_screen(43,16,'   Stop  Prg.   ');
  write_screen(43,18,'   Quittieren   ');
  displ_upd;
  repeat
    gotoxy (46,18);
    getkey;
    if fkey then
      ftaste
    else
    begin
      case upcase(key) of
        'E'              :  sim_anweisung;
        'S'              :  repeat
                              while ((aktaw <= anzaw) and not keypressed) do
                                sim_anweisung;
                              if keypressed then
                                if (key = #0) then
                                begin
                                  key  := readkey;
                                  ftaste;
                                end
                                else
                                  key  := upcase(readkey);
                            until (key = 'S');
      end;
    end;
  until ((upcase(key) = 'Q') or (upcase(key) = 'V')) and not fkey;
end;



procedure sim_init;

begin
  for j            := 0 to maxe do
    for i          := 0 to 7 do
      e_[j,i]      := false;
  for j            := 0 to maxa do
    for i          := 0 to 7 do
      a_[j,i]      := false;
  for j            := 0 to maxm do
    for i          := 0 to 7 do
      m_[j,i]      := false;
  for j            := 0 to maxt do
  begin
    t_[j].wert     := 0; (* ??? *)
    t_[j].einheit  := 0;
  end;
  for j            := 0 to maxz do
    z_[j].wert     := 0; (* ??? *)

  fillchar(ausgang,deep,#255);
  lastausgang            := false;
  oder_von_und           := false;
  aktaw                  := 1;
  klammern               := 1;
  scrollstart            := 1;
  if (anzaw < 15) then
  begin
    scroll               := false;
    scrollende           := anzaw;
  end
  else
  begin
    scroll               := true;
    scrollende           := 14;
  end;
end;


procedure simulation;

begin
  cursor_aus;
  window(1,1,80,25);
  restore_screen(3);
  sim_init;
  repeat
    sim_hauptmenue;
    if (upcase(key) = 'V') then
    begin
      cursor_ein;
      sim_untermenue;
      cursor_aus;
    end;
  until (upcase(key) = 'Q');
  cursor_ein;
  message(mess[2])
end;