{ MAXONPascal3-Anpassung / Test:  Falk Zühlsdorff (PackMAN) 1994 }
 
Program ConsoleToolDemo;

Const
  Length = 80;

Type
  String80 = String[80];

Var
  Win: Ptr;
  Con: Ptr;
  St: String[80];
  z: Long;

 Procedure WriteConInt(Con: ptr;    { Devicehandle }
                       i: Long;     { Zahl, die ausgegeben werden soll }
                       b: integer;  { Basis }
                       f: integer); { Mindest-Feldbreite }
 Var
  s: String[40];
  j,k,z,len: integer;
  i2: Long;
 Begin
  j:=40;
  s[40]:=chr(0);    { Nullbyte am Ende }
  i2:=abs(i);
  Repeat
    j:= j-1;
    z:= i2 mod b;   { letzte Ziffer von i2 }
    If z<10 Then
      s[j]:=chr(z+ord('0'))     { Ziffern 0 bis 10 }
    Else
      s[j]:=chr(z-10+ord('A')); { Hexziffern A bis F }
    i2:= i2 Div b;
  Until i2=0;
  If b=16 Then
    Begin
      j:=j-1;
      s[j]:='$'     { Hexzahlen automatisch mit "$" }
    End;
  If b=2 Then
    Begin
      j:=j-1;
      s[j]:='%'     { Binärzahlen mit "%" }
    End;
  If i<0 Then
    Begin
      j:=j-1;
      s[j]:='-'     { Minuszeichen bei neg. Zahlen }
    End;
  len:=40-j;        { Gesamtlänge der Zahl }
  For k:=1 to f-len Do
    WriteCon(Con, ' ');     { Am Anfang mit Spaces auffüllen }
  WriteCon(Con, Str(^s[j])) { String ab j-tem Zeichen ausgeben }
 End;

 Procedure ReadConString(Con:Ptr; Var s: String80);
   Const
     Backspace = chr(8);
     Return = chr(13);
   Var
     ch: Char;
     i: integer;
     Sig: Long;
   Begin
     i:=1;
     Repeat
       Sig:=Wait(-1);
       ch:=ReadCon(Con);
       If ( (ch >= chr(32)) and (ch < chr(127)) ) or (ch>=chr(160)) Then
         Begin
           WriteCon(Con,ch);
           s[i]:=ch;
           i:=i+1
         End;
       If (ch=BackSpace) and (i>1) Then
         Begin
           WriteCon(Con,''\8' '\8);  { Ein Zeichen zurück, mit Space
                                       überschreiben und wieder zurück }
           i:=i-1
         End;
     Until (ch=Return) or (i>=79);
     s[i]:=chr(0);    { mit Space abschließen }
   End;

 Function Convert(s: String80): Long;
 Var
   i:Long;
   j, b, z, sign: integer;
 Begin
   i:= 0;
   b:= 10;  { Basis }
   j:= 1;   { Stringanfang }
   While s[j]=' ' Do
     j:=j+1;           { führende Spaces überlesen }
   If s[j]='-' Then
     Begin   { negatives Vorzeichen }
       sign:= -1;
       j:=j+1
     End
   Else
     Begin
       sign:= 1;
       If s[j]='+' Then j:=j+1   { Pluszeichen überlesen }
     End;
   If s[j] = '$' Then   { Hexzahl }
     Begin
       b:=16; j:=j+1
     End;
   If s[j] = '%' Then   { Binärzahl }
     Begin
       b:=2; j:=j+1
     End;
   Repeat
     If (s[j] >= '0') and (s[j] <= '9') Then
       z := ord(s[j]) - ord('0')
     Else
     If (s[j] >= 'a') and (s[j] <= 'z') Then
       z := ord(s[j]) - ord('a') + 10
     Else
     If (s[j] >= 'A') and (s[j] <= 'Z') Then
       z := ord(s[j]) - ord('A') + 10
     Else
       z:= -1;  { ungültige Ziffer }
     If z >= b Then
       z:= -1;  { zu groß für Basis }
     If z >= 0 Then
       i:= b*i + z;
     j:= j+1
   Until z<0;
   Convert:= sign*i
 End;


Begin
  Win := Open_Window(0,0,640,200,1,0,$1006,'Test',Nil,640,200,640,200);
  Con := OpenConsole(Win);
  Repeat
    WriteCon(Con, 'Eingabe: ');
    ReadConString(Con, St);
    If St <> '' Then
      Begin
        z:=Convert(St);
        WriteCon(Con,''\n\n); { eine Leerzeile }
        WriteConInt(Con, z, 10, 12); { dezimal, rechtsbündig }
        WriteConInt(Con, z, 16, 12);
        WriteCon(Con,'  ');
        WriteConInt(Con, z,  2,  1); { binär und linksbündig }
        WriteCon(Con, ''\n\n)
      End
  Until St='';        { bei Leerzeile beenden }
  CloseConsole(Con);
  Close_Window(Win)
End.