PROGRAM BinaeRDezimaLundDezimaLBinaeRUmwandeln;                 {File db-bd01.pas}

{ Autor: Terror Kid     }
{ Datum: April/Mai 1996 }
{ Filename: db-bd01.pas }

{ Kurzbeschrieb: Das Programm hat die Aufgabe, Bin�re- in Dezimale Zahlen   }
{ und Dezimale- in Bin�re Zahlenumzuwandeln. Die h�chste dezimale Zahl darf }
{ 255 sein, die bin�re Zahl muss 8-stellig eingegeben werden.               }

USES crt;                                                       {Hardware initialisieren}
VAR Wahl                                                        : Integer;     {div. Variablen definieren}
VAR DezBin01, DezBinUmw1, BinDezUmw1                            : Real;
VAR RAM01, RAM02, RAM03, RAM04, RAM05, RAM06                    : Real;
VAR RAM07, RAM08, RAM09, RAM10, RAM11, Durchlauf                : Real;
VAR BinDez01, BinDez02, BinDez03, BinDez04                      : Real;
VAR BinDez05, BinDez06, BinDez07, BinDez08                      : Real;
VAR Frage, Abfrage, Fehler                                      : Char;

{    ACHTUNG ! Nun kommt ein kleiner grafischer Effekt, der "Real-time      }
{    color-mix-copper (5)" von Bas van Gaalen, Holland, als PD freigegeben  }
{---------------------------------------------------------------------------}
const size=350; step=250; bars=3;
var
  pal:array[0..3*size-1] of byte;
  stab:array[0..255] of word;
  bartab:array[0..bars-1] of word;

procedure createtab; var i:byte; begin
for i:=0 to 255 do stab[i]:=round(sin(2*pi*i/255)*105)+112; end;
procedure movebars;
var n,i:word;
begin;
  normvideo;
  fillchar(pal[6],3*size-13,0);
  for n:=0 to bars-1 do begin
    for i:=0 to 63 do pal[n mod 3+3*stab[bartab[n]]+3*i]:=i;
    for i:=0 to 63 do pal[n mod 3+3*stab[bartab[n]]+3*64+3*i]:=63-i;
    bartab[n]:=1+bartab[n] mod 255;
  end;
end;

procedure copperbars;
var cc,l:word;
begin
  asm cli end;
  while (port[$3da] and 8) <> 0 do;
  while (port[$3da] and 8) = 0 do;
  cc:=0;
  for l:=0 to size-1 do begin
    port[$3c8]:=0;
    port[$3c9]:=pal[cc];
    port[$3c9]:=pal[cc+1];
    while (port[$3da] and 1) <> 0 do;
    while (port[$3da] and 1) = 0 do;
    port[$3c9]:=pal[cc+2];
    inc(cc,3);
  end;
  asm sti end;
end;

var i:byte;
begin
  fillchar(pal,sizeof(pal),0);
  for i:=0 to bars-1 do bartab[i]:=step*i;
  pal[3*size-6]:=50; pal[3*size-5]:=50; pal[3*size-4]:=50;
  pal[3]:=50; pal[4]:=50; pal[5]:=50;
{---------------------------------------------------------------------------}

Clrscr;
Normvideo;                                                      {Benutzt wieder die Textfarbe wie am Anfang des Programms}
Clrscr;
Writeln;
Writeln ('    ������     �������    �������     ����    ��������    �������    ��      ');
Writeln ('  � �� � �� �� �� ����� ������ �� � �� �� ��� �� �� �� �� �� � �� �� �� �����');
Writeln ('  � �� � �� �� �� ����� ������ �� � �� �� ��� �� �� �� �� �� � �� �� �� �����');
Writeln ('  � �� � �� �� ����� �� ������ �� � �� �� ��� �� �� �� �� ������� �� �� �����');
Writeln ('  � �� � �� �� �� ����� ���� �� ��� �� �� ��� �� �� �� �� �� � �� �� �� �����');
Writeln ('  � �� � �� �� �� ����� �� �� ����� �� �� ��� �� �� �� �� �� � �� �� �� �����');
Writeln ('  � �� � �� �� �� ����� � �� ������ �� �� ��� �� �� �� �� �� � �� �� �� �����');
Writeln ('  � �� � �� �� �� ����� � �� ������ �� �� ��� �� �� �� �� �� � �� �� �� �����');
Writeln ('  � ������  �� �������  � ������� � � ���� �� �� �� �� �� �� � �� �� ������ �');
Writeln ('                                                                  ');
Textcolor (19);                                                 {Setzt eine Farbe f�r Textausgabe}
Writeln ('                                              .oO Oo.              ');
Normvideo;                                                      {Setzt Farbatributt zur�ck wie bei Programmbeginn}
Writeln ('                �������    ����    �������    �������    �������  ');
Writeln ('              � �� � �� ��� �� ��� �� � �� �� �� � �� �� �� � �� �');
Writeln ('              � �� � �� ��� �� ��� �� � �� �� �� � �� �� �� � �� �');
Writeln ('              � ������� ��� �� ��� �� � �� �� ������� �� �� � �� �');
Writeln ('              � �� � �� ��� �� ��� �� � �� �� �� � �� �� ������  �');
Writeln ('              � �� � �� ��� �� ��� �� � �� �� �� � �� �� �� � �� �');
Writeln ('              � �� � �� ��� �� ��� �� � �� �� �� � �� �� �� � �� �');
Writeln ('              � �� � �� ��� �� ��� �� � �� �� �� � �� �� �� � �� �');
Writeln ('              � ������� �� ���� �� �� � �� �� �� � �� �� �� � �� �');
Writeln ('');
Textcolor (19);                                                 {Setzt eine Farbe f�r Textausgabe}
Writeln ('');
Writeln ('                    und zur�ck...  U-M-W-A-N-D-E-L-N   !-!-!');
Normvideo;                                                      
  createtab;
  repeat
  movebars;
  copperbars;
until keypressed;                                               {Routine so lange ausf�hren bis eine Taste gedr�ckt wird}
Clrscr;
REPEAT
Clrscr;
     Writeln;                                                   {Leerzeile schreiben}
     Writeln ('Welche Umwandlung wollen Sie treffen ?');
     Writeln;
     Writeln (' 1 = Dezimal-Bin�r Umwandlung');
     Writeln (' 2 = Bin�r-Dezimal Umwandlung');
     Writeln;
     Write ('  ');
     Readln (Wahl);

     CASE Wahl of

	1 : BEGIN

        REPEAT
                DezBin01:=0;
                Writeln;
		Write ('Sie haben die Umwandlung "Dezimal-Bin�r"');
		Writeln (' gew�hlt.');
                Writeln;
                Write ('Dezimale Zahl eingeben: ');
                Readln (DezBin01);
                Writeln;
                IF DezBin01 > 255 then Writeln ('Dezimale Zahl max. 255, Resultat ung�ltig, nochmals ausrechnen !!!');
                Writeln;
                       Durchlauf:= 1;
                       REPEAT
                       DezBinUmw1:=DezBin01 / 2;
                       RAM01:=Trunc (DezBinUmw1);
                       RAM02:=DezBinUmw1 - RAM01;
                       IF RAM02=0.5 then RAM03:=1;
                       IF RAM02=0.0 then RAM03:=0;
                       IF Durchlauf = 1 THEN RAM04:=RAM03;
                       IF Durchlauf = 2 THEN RAM05:=RAM03;
                       IF Durchlauf = 3 THEN RAM06:=RAM03;
                       IF Durchlauf = 4 THEN RAM07:=RAM03;
                       IF Durchlauf = 5 THEN RAM08:=RAM03;
                       IF Durchlauf = 6 THEN RAM09:=RAM03;
                       IF Durchlauf = 7 THEN RAM10:=RAM03;
                       IF Durchlauf = 8 THEN RAM11:=RAM03;
                       DezBin01:=RAM01;
                       DezBinUmw1:=0;
                       RAM01:=0;
                       RAM02:=0;
                       RAM03:=0;
                       Durchlauf:=Durchlauf + 1;
                       UNTIL Durchlauf = 9;
                Writeln;
                Writeln;
                Write ('Bin�re Zahl=',RAM11:0:0, RAM10:0:0, RAM09:0:0, RAM08:0:0, RAM07:0:0, RAM06:0:0, RAM05:0:0, RAM04:0:0);
                Writeln;
                Writeln;
                Writeln;
                Write ('M�chten Sie noch einmal eine Dezimal-Bin�r Umwandlung ');
                Writeln ('durchf�hren?');
                Writeln;
                Writeln ('J/j oder N/n ?');
                Writeln;
                Readln (Frage);
        Clrscr;
        UNTIL Frage IN ['n', 'N'];
        END;


	2 : 	BEGIN

        REPEAT
                
                Writeln;
	        Writeln ('Sie haben die Berechnung "Bin�r-Dezimal" gew�hlt');
                Writeln;
		Write ('Bin�rzahl');
                Textcolor (12);
                Write (' ACHTSTELLIG ');
                Normvideo;
                Write ('eingeben !');
                Writeln;
                Writeln;
                Write ('1. Stelle der Bin�rzahl eingeben: ');
                Readln (BinDez01);
                IF BinDez01 > 1 then Writeln ('Bin�re Zahl nur 0 oder 1, Resultat ung�ltig, nochmals ausrechnen !!!');
                Write ('2. Stelle der Bin�rzahl eingeben: ');
                Readln (BinDez02);
                IF BinDez02 > 1 then Writeln ('Bin�re Zahl nur 0 oder 1, Resultat ung�ltig, nochmals ausrechnen !!!');
                Write ('3. Stelle der Bin�rzahl eingeben: ');
                Readln (BinDez03);
                IF BinDez03 > 1 then Writeln ('Bin�re Zahl nur 0 oder 1, Resultat ung�ltig, nochmals ausrechnen !!!');
                Write ('4. Stelle der Bin�rzahl eingeben: ');
                Readln (BinDez04);
                IF BinDez04 > 1 then Writeln ('Bin�re Zahl nur 0 oder 1, Resultat ung�ltig, nochmals ausrechnen !!!');
                Write ('5. Stelle der Bin�rzahl eingeben: ');
                Readln (BinDez05);
                IF BinDez05 > 1 then Writeln ('Bin�re Zahl nur 0 oder 1, Resultat ung�ltig, nochmals ausrechnen !!!');
                Write ('6. Stelle der Bin�rzahl eingeben: ');
                Readln (BinDez06);
                IF BinDez06 > 1 then Writeln ('Bin�re Zahl nur 0 oder 1, Resultat ung�ltig, nochmals ausrechnen !!!');
                Write ('7. Stelle der Bin�rzahl eingeben: ');
                Readln (BinDez07);
                IF BinDez07 > 1 then Writeln ('Bin�re Zahl nur 0 oder 1, Resultat ung�ltig, nochmals ausrechnen !!!');
                Write ('8. Stelle der Bin�rzahl eingeben: ');
                Readln (BinDez08);
                IF BinDez08 > 1 then Writeln ('Bin�re Zahl nur 0 oder 1, Resultat ung�ltig, nochmals ausrechnen !!!');
                BinDez01:= (BinDez01) *  128;
                BinDez02:= (BinDez02) *  64;
                BinDez03:= (BinDez03) *  32;
                BinDez04:= (BinDez04) *  16;
                BinDez05:= (BinDez05) *  8;
                BinDez06:= (BinDez06) *  4;
                BinDez07:= (BinDez07) *  2;
                BinDez08:= (BinDez08) *  1;
                Writeln;
                Writeln;
                Writeln;
                Writeln;
                BinDezUmw1:= BinDez04 + BinDez05 + BinDez06 + BinDez07 + BinDez08;
                Writeln ('Dezimale Zahl=', BinDez01 + BinDez02 + BinDez03 + BinDezUmw1:0:0);
                Writeln;
                Writeln;
                Writeln;
                BinDez01:= 0 ;
                BinDez02:= 0 ;
                BinDez03:= 0 ;
                BinDez04:= 0 ;
                BinDez05:= 0 ;
                BinDez06:= 0 ;
                BinDez07:= 0 ;
                BinDez08:= 0 ;
                BinDezUmw1:=0 ;
                Write ('M�chten Sie noch einmal eine Bin�r-Dezimal Umwandlung ');
                Writeln ('durchf�hren ?');
                Writeln;
                Writeln ('J/j oder N/n ?');
                Writeln;
                Readln (Frage);
        Clrscr;
        UNTIL Frage IN ['n', 'N'];
        END;


	END;
        Clrscr;
        Writeln;
        Writeln;
        Writeln;
        Write ('M�chten Sie noch einmal Berechnungen ');
        Writeln ('durchf�hren ?');
        Writeln;
        Writeln ('J/j oder N/n ?');
        Writeln;
        Readln (Frage);
        UNTIL Frage IN ['n', 'N'];

     Clrscr;
     Writeln;
     Writeln;
     Writeln;
     Writeln ('Vielen Dank, es war sch�n, mit Ihnen zu arbeiten.');
     Delay (5000) ;
END.

END.