{ R/2R-Netzwerk Berchnungsprogramm
  Berechnet die Ausgangsspannung eines R/2R Netzwerks
  das als D/A-Wandler eingesetzt wird
  Free-Pascal www.free-pascal.org
  (C)2004 by DG4FAC }
  
Program r2r;
Uses Crt,Dos,SysUtils;

Const
  maxBits=11;
  
Var r1,r2:Extended;
  ub,uh,ul:Extended;
  i:Array[0..maxBits] Of Extended;
  ue:Array[0..maxBits] Of Extended;
  u:Array[0..maxBits] Of Extended;
  c:Char;
  sb:String;
  nr:Byte;

Function FormatR(e:Extended):String;
Begin
Str(e:5:1,FormatR);
FormatR[Pos('.',FormatR)]:='k';
While FormatR[2]=' ' Do Delete(FormatR,2,1);
End;

Procedure SetVoltages(f:Boolean);
Var k:Byte;
Begin
If f Then Writeln('Spannungen setzen');
For k:=1 To nr Do 
  Begin
  Case sb[k] Of
    '+':ue[nr-k]:=ub;
    '-':ue[nr-k]:=0.0;
    '0':ue[nr-k]:=ul;
    '1':ue[nr-k]:=uh;
    End;
  End;
If f Then
  Begin
  Writeln('Spannung (Bit 0 to ',nr,'):');
  For k:=0 To nr-1 Do Write(' ',ue[k]:5:3);
  Writeln;
  End;
End;

Procedure InitVars;
Begin
sb:='-+0000';
nr:=6;
r1:=47;
r2:=100;
ub:=5.0;
uh:=5.0;
ul:=0.0;
SetVoltages(True);
End;

Procedure GetBits;
Var k:Byte;
  f:Boolean;
Begin
Repeat
  Writeln('Eingabe der Bits, 0=Low, 1=High, +=Ub, -=GND');
  Write('Bit Kombination eingeben (z.B. -+0111) ... ');
  Readln(sb);
  If Length(sb)<>nr Then Writeln('Falsche Laenge!');
  f:=True;
  For k:=1 To Length(sb) Do
    Case sb[k] Of
      '0','1','+','-':;
      Else
      f:=False;
      End;
  If Not f Then Writeln('Ungueltige Zeichen in der Eingabe!');
  Until (Length(sb)=nr) And f;
SetVoltages(True);
End;

Procedure GetVoltages;
Begin
Write('Betriebsspannung eingeben ... ');
Readln(ub);
Write('Eingangsspannung bei Port-Ausgang logisch 0 ... ');
Readln(ul);
Write('Eingangsspannung bei Port-Ausgang logisch 1 ... ');
Readln(uh);
SetVoltages(True);
End;

Procedure GetResistors;
Begin
Write('R1 in kOhm eingeben ... ');
Readln(r1);
Write('R2 in kOhm eingeben ... ');
Readln(r2);
Writeln('Widerstand R1 = ',FormatR(r1),', R2 =',FormatR(r2));
End;

Procedure GetResolution;
Var k:Byte;
Begin
Repeat
  Write('Aufloesung des Netzwerks in Bits eigeben (2..12) ... ');
  Readln(nr);
  If nr<2 Then Writeln('Aufloesung zu gering!');
  If nr>12 Then Writeln('Aufloesung zu grosz!');
  Until (nr>1) And (nr<13);
sb:='';
For k:=1 To nr Do sb:='0'+sb;
End;

Function Simulate(fstep,fw:Boolean):Extended;
Var k:Byte;
  n:LongInt;
Begin
n:=0;
For k:=0 to nr-1 Do u[k]:=(uh+ul)/4.0;
Repeat
  For k:=0 To nr-1 Do
    Begin
    If k=0 Then
      i[k]:=(ue[k]-u[k])/r2+(u[k+1]-u[k])/r1+(-u[k])/r2 Else
      If k=nr-1 Then
        i[k]:=(ue[k]-u[k])/r2+(u[k-1]-u[k])/r1 Else
        i[k]:=(ue[k]-u[k])/r2+(u[k+1]-u[k])/r1+(u[k-1]-u[k])/r1;
    End;
  For k:=0 To nr-1 Do
    u[k]:=u[k]+i[k]*r2/10.0;
  Inc(n);
  If n=200 Then c:=Char(27) Else c:=' '; 
  If fstep Then
    Begin
    Write(n:4,':');
    For k:=0 to nr-1 Do Write(' ',u[k]:5:3);
    Write(' <'' '',I,ESC> ... ');
    c:=UpCase(Readkey);
    Writeln;
    If c='I' Then
      Begin
      Write(n:4,':');
      For k:=0 to nr-1 Do Write(' ',i[0]);
      Writeln;
      End;
    End;
  Until c=Char(27);
If fw Then Writeln(u[nr-1]:5:3,'[V]');
Simulate:=u[nr-1];
c:=' ';
End;

Procedure AllCombinations;
Var k:Byte;
  ns:LongInt;
  eNew,eOld,e1:Extended;
Begin
Writeln;
Writeln('Eingabekombinationen und Ausgabespannungen');
For k:=1 To Length(sb) Do If sb[k]='1' Then sb[k]:='0';
SetVoltages(False);
Write(sb,': ');
eNew:=Simulate(False,False);
e1:=eNew;
ns:=0;
Writeln(eNew:5:3,'[V]');
While Pos('0',sb)>0 Do
  Begin
  eOld:=eNew;
  k:=Length(sb)+1;
  Repeat Dec(k) Until (k<1) Or (sb[k]='0');
  If k>0 Then
    Begin
    sb[k]:='1';
    Inc(k);
    While k<=Length(sb) Do
      Begin
      If sb[k]='1' Then sb[k]:='0';
      Inc(k);
      End;
    SetVoltages(False);
    Write(sb,': ');
    eNew:=Simulate(False,False);
    Write(eNew:5:3,'[V]');
    eOld:=eNew-eOld;
    Writeln(' (Delta=',1000*eOld:8:2,'[mV])');
    Inc(ns);
    End;
  End;
Writeln('Start:',e1:5:3,'[V] Ende:',eNew:5:3,'[V] Bereich:',eNew-e1:5:3,'[V], ',ns,' Schritte, ',1000*(eNew-e1)/ns:5:2,'[mV] Durchschnitt');
End;

Procedure FileSave;
Var k:Byte;
  ns:LongInt;
  eNew,eOld,e1:Extended;
  f:Text;
  s:String;
  fw:Boolean;
Begin
Writeln;
Write('Sichern der Ergebnisse in einer Datei. Gib Dateiname ein ... ');
Readln(s);
fw:=s<>'';
If fw And FileExists(s) Then
  Begin
  Write('Datei vorhanden, ueberschreiben (y/n) ... ');
  c:=UpCase(ReadKey);
  Writeln(c);
  fw:=c='Y';
  End;
If fw Then
  Begin
  Assign(f,s);
  Rewrite(f);
  Writeln(f,'R2R-Netzwerk Berechnungsprogramm, (C)2004 info@avr-asm-tutorial.net');
  Writeln(f,'-------------------------------------------------------------------');
  Writeln(f);
  Writeln(f,'Bits Aufloesung: nr=',nr,'[bits], <B>its=',sb);
  Writeln(f,'Spannungen: ub=',ub:5:3,'[V], ul=',ul:5:3,'[V], uh=',uh:5:3,'[V]');
  Writeln(f,'Widerstaende: R1=',FormatR(r1),', R2=',FormatR(r2));
  Writeln(f);
  Writeln(f,'Eingabekombinationen und Ausgabespannungen');
  For k:=1 To Length(sb) Do If sb[k]='1' Then sb[k]:='0';
  SetVoltages(False);
  eNew:=Simulate(False,False);
  e1:=eNew;
  ns:=0;
  Writeln(f,sb,': ',eNew:5:3,'[V]');
  While Pos('0',sb)>0 Do
    Begin
    eOld:=eNew;
    k:=Length(sb)+1;
    Repeat Dec(k) Until (k<1) Or (sb[k]='0');
    If k>0 Then
      Begin
      sb[k]:='1';
      Inc(k);
      While k<=Length(sb) Do
        Begin
        If sb[k]='1' Then sb[k]:='0';
        Inc(k);
        End;
      SetVoltages(False);
      eNew:=Simulate(False,False);
      Write(f,sb,': ',eNew:5:3,'[V]');
      eOld:=eNew-eOld;
      Writeln(f,' (Delta=',1000*eOld:8:2,'[mV])');
      Inc(ns);
      End;
    End;
  Writeln(f);
  Writeln(f,'Start:',e1:5:3,'[V] Ende:',eNew:5:3,'[V] Bereich:',eNew-e1:5:3,'[V], ',ns,' Schritte, ',1000*(eNew-e1)/ns:5:2,'[mV] Durchschnitt');
  Close(f);
  Writeln('Ergebnisse in Datei "',s,'" gespeichert.');
  End;
End;

Procedure Help;
Begin
Writeln;
Writeln('R/2R-Netzwerk Berechnungsprogramm, (C)2004 by DG4FAC');
Writeln('----------------------------------------------------');
Writeln('Berechnet die Ausgabespannung eines R/2R-Netzwerks fuer');
Writeln('- beliebige Aufloesungen des Netzwerks von 2 bis 12 Bits,');
Writeln('- jede beliebige Bitkombination am Eingang, einschlieszlich');
Writeln('  fest auf Null oder die Betriebsspannung eingestellte,');
Writeln('- waehlbare High- und Low-Spannungen an den Eingaengen,');
Writeln('- jeder beliebigen Widerstandskombination des Netzwerks,');
Writeln('- fuer eine einzelne Eingangskombination oder alle Kombinationen,');
Writeln('- beliebige Listenausgaben in eine Datei.');
Writeln;
Writeln('Aendern der Rechenparameter durch Auswahl des entsprechenden');
Writeln('Menupunktes.');
End;

Begin
InitVars;
Repeat
  Writeln;
  Writeln('R/2R-Netzwerk-Berechnungsprogramm, (C)2004 DG4FAC');
  Writeln('-------------------------------------------------');
  Writeln('<N> bits Aufloesung: nr=',nr,'[bits], <B>its=',sb);
  Writeln('<V> Spannungen: ub=',ub:5:3,'[V], ul=',ul:5:3,'[V], uh=',uh:5:3,'[V]');
  Writeln('<R> Widerstaende: R1=',FormatR(r1),', R2=',FormatR(r2));
  Write('<C>berechnen <S>imulieren <A>lle Kombinationen <F>ile <H>ilfe <ESC> ... ');
  c:=UpCase(Readkey);
  If c<>Char(27) Then Writeln(c);
  Case c Of
    'B':GetBits;
    'V':GetVoltages;
    'R':GetResistors;
    'N':GetResolution;
    'S':Simulate(True,True);
    'C':Simulate(False,True);
    'A':AllCombinations;
    'F':FileSave;
    'H':Help;
    End;
  Until c=Char(27);
Writeln;
End.