Localize file www.TrSek.com/pas/1inca.pas

{ 1stInCa.PAS                Copyleft (c) Zdeno Sekerák, <etrsek@gmail.com> }
{ 1st INfinity CAlculator                                                   }
{                                                                           }
{ Tento program je slobodný software. Mo¾ete ho ïalej distribuova» a/alebo  }
{ upravova» pod podmienkou licence GNU General Public License vydanej       }
{ organizáciou Free Software Foundation, verzia licencie 3 alebo vy¹¹ej.    }
{                                                                           }
{ Tento program je distribuvaný v nádeji, ¾e bude u¾itoèným, ale            }
{ NEPOSKYTUJE ®IADNE ZÁRUKY. Bez akejkoµvek vyplývajúcej záruky na          }
{ OBCHODOVATE¥NOS« alebo VHODNOS« PRE KONKRÉTNE POU®ITIE. Pre viac          }
{ podrobností si preèítajte licenciu GNU General Public Licence.            }
{                                                                           }
{  http://www.gnu.org/copyleft/gpl.html                                     }
{                                                                           }
{ Author: Zdeno Sekerák (TrSek)                                             }
{ Datum : 08.01.2010                                                        }
{ Verzia: 0.91 RC1                                     http://www.trsek.com }

program fInCa;
uses crt, dos, math, trsek;

const
    BACK_COLOR  = Black;        { pozadie                  }
    BBACK_COLOR = Blue;         { pozadie buttonov         }
    TEXT_COLOR  = DarkGray;     { farba obycajneho textu   }
    ITEXT_COLOR = Red;          { farba zvyrazneneho textu }

look : array[1..25] of string = (
' +----------------------------------------------------------------------------+',
' |############################################################################|',
' |############################################################################|',
' |############################################################################|',
' |############################################################################|',
' +-[#80]Up/doWn-precision-----------------[o]Degree---[o]Radian---[o]gradient-+',
'                                                                               ',
'  #S### #C### #T### #G### #A### #F1##   ##Z##   ##### ##### ##### ##### #I###  ',
'  #sin# #cos# #tan# #cotg #abs# #help   ##mc#   ##7## ##8## ##9## ##/## #int#  ',
'                                                                               ',
'  #@### #$### #&### #:### #V### #DEL#   ##M##   ##### ##### ##### ##### #F###  ',
'  #asin #acos #atan acotg #eul# clear   ##mr#   ##4## ##5## ##6## ##*## #frac  ',
'                                                                               ',
'  #X### #L### #N### #%### #P### #H###   ##K##   ##### ##### ##### ##### #O###  ',
'  #e^x# #ln## #neg# #1/x# #pi## pi#c#   ##ms#   ##1## ##2## ##3## ##-## round  ',
'                                                                               ',
'  #Q### #^### #B### #Y### #!### #E###   ##J##   ##### ##### ##### ##### ENTER  ',
'  #sqrt #x^2# #x^y# #x^3# #x!## 10^x#   ##m+#   ##0## ##-## ##.## ##+## ##=##  ',
'+-debug------------------------------------------------------------------------+',
'|##############################################################################|',
'|##############################################################################|',
'|##############################################################################|',
'|##############################################################################|',
'|##############################################################################|',
'1st#Infinity#Calculator,#ver#0.92Beta,#Copyleft(c)#Zdeno#Sekerak,#www.trsek.com'
);

var a,b: infinity;
      m: infinity;
     op: char;
  oldop: char;
     rb: boolean;

procedure ViewLook;
var x,y:integer;
begin
  window(1,1,80,25);
  textbackground( BACK_COLOR );
  clrscr;

  for y:=1 to 25 do begin
    gotoxy(1,y);
    for x:=1 to length(look[y]) do begin
       { farba textu }
       if(look[y][x] in ['A'..'Z','@','$','&',':','!','%']) and (y<25)then
            textcolor(ITEXT_COLOR)
       else textcolor(TEXT_COLOR);

       { farba pozadia }
       if(look[y][x] <> ' ')then
            textbackground( BBACK_COLOR )
       else textbackground( BACK_COLOR );

       { text }
       if(look[y][x]<>'#')then
            write(look[y][x])
       else write(' ');
    end;
  end;
end;

procedure ViewHelp;
var x:integer;
begin
  save_win;
  window(1,1,80,25);

  textcolor(TEXT_COLOR);
  textbackground( BBACK_COLOR );
  clrscr;

  writeln; write(' ');
  for x:=1 to length(look[25]) do
    if(look[25][x]<>'#')then
         write(look[25][x])
    else write(' ');

  writeln;
  writeln(' Help:');
  writeln(' -----');
  writeln(' Pre pou¾itie funkcií stláèajte písmenka ktoré sú zvýraznené èervenou farbou');
  writeln(' Enter  - ukonèenie zadávania èísla (ako =)');
  writeln(' Delete - zmazanie èísla');
  writeln(' ESC    - koniec programu (alebo dlho trvajúcej operácie)');
  writeln;
  writeln(' Licencia:');
  writeln(' ---------');
  writeln(' Tento program je slobodný software. Mo¾ete ho ïalej distribuova» a/alebo');
  writeln(' upravova» pod podmienkou licence GNU General Public License vydanej');
  writeln(' organizáciou Free Software Foundation, verzia licencie 3 alebo vy¹¹ej.');
  writeln;
  writeln(' Tento program je distribuvaný v nádeji, ¾e bude u¾itoèným, ale');
  writeln(' NEPOSKYTUJE ®IADNE ZÁRUKY. Bez akejkoµvek vyplývajúcej záruky na');
  writeln(' OBCHODOVATE¥NOS« alebo VHODNOST PRE KONKRÉTNE POU®ITIE. Pre viac');
  writeln(' podrobností si preèítajte licenciu GNU General Public Licence.');
  writeln;
  writeln(' http://www.gnu.org/copyleft/gpl.html');
  writeln;
  writeln('');
  readkey;

  ViewLook;
  old_win;
end;

{ zobrazi ako je nastaveny }
procedure ViewSet;
begin
  save_win;
  window(1,1,80,25);
  textcolor(TEXT_COLOR);
  textbackground( BBACK_COLOR );

  writexy(44,6,'o');
  writexy(56,6,'o');
  writexy(68,6,'o');

  case a.GetRDG of
    BN_DEGREE:   writexy(44,6,'x');
    BN_RADIAN:   writexy(56,6,'x');
    BN_GRADIENT: writexy(68,6,'x');
  end;

  gotoxy(5,6);
  write(a.GetEpsilon:3);

  gotoxy(36,6);
  if(m._bn.zero)then
       write('-')
  else write('M');

  old_win;
  textcolor(TEXT_COLOR);
  textbackground( BBACK_COLOR );
end;

begin
  { initialize }
  a.Init('0');
  b.Init('0');
  m.Init('0');
  a.SetDegree;
  b.SetDegree;
  a.ScroolBarInit(1,1,78);
  b.ScroolBarInit(1,1,78);
  oldop:=#0;

  ViewLook;
  ViewSet;

  repeat
    repeat
      Window(3,2,78,5);
      rb:=false;
      op:=readkey;

      if((op in ['0'..'9',',','.'])
      or ((op='-') and a._bn.zero)) then begin
         clrscr;
         op:=a.Readln(op);
      end;

      { repeat operation }
      if(op=#13)then begin
        case UpCase(oldop) of
          '+': a.Plus    (b);
          '-': a.Minus   (b);
          '*': a.Multiply(b);
          '/': a.Divide  (b);
        end;

        { vypis vysledok }
        Window(3,2,78,5);
        clrscr;
        a.Write(BN_INFINITY, BN_INFINITY);
      end;
    until(op <>#13);

    Window(2,20,79,24);
    clrscr;
    oldop:=op;

    case UpCase(op) of
      'A': a.Abs;
      'B': rb:=true;
      'C': a.Cos;
      'D': begin a.SetDegree; b.SetDegree; ViewSet; end;
      'E': ;{ not use }
      'F': a.Frac;
      'G': a.CoTan; {a.SetGradient; b.SetGradient; ViewSet;}
      'H': a.PiCompute;
      'I': a.Int;
      'J': m.Plus(a);
      'K': m.Copy_bn(a);
      'L': a.Ln;
      'M': a.Copy_bn(m);
      'N': a.Negation;
      'O': a.Round;
      'P': a.Pi;
      'R': begin a.SetRadian; b.SetRadian; end;
      'S': a.Sin;
      'T': a.Tan;
      'Q': a.Sqrt;
      'U': begin a.SetEpsilon(a.GetEpsilon+1);
                 b.SetEpsilon(a.GetEpsilon); end;
      'V': a.E;
      'X': a.Exp;
      'Y': begin b.Copy_bn(a); a.Multiply(b); a.Multiply(b); end;
      'W': begin a.SetEpsilon(a.GetEpsilon-1);
                 b.SetEpsilon(a.GetEpsilon); end;
      'Z': m.Copy(0);
      '#': a.Random;
      '!': a.Factorial;
      '^': a.Sqr;
      '%': begin b.Copy_bn(a); a.Copy(1); a.Divide(b); end;
      '@': a.ArcSin;
      '$': a.ArcCos;
      '&': a.ArcTan;
      ':': a.ArcCoTan;
      '+': rb:=true;
      '-': rb:=true;
      '*': rb:=true;
      '/': rb:=true;
      #0 : case(readkey) of
            'S': a.Copy(0);    { delete }
            #59: ViewHelp;
           end;
    end;

    { nastavenia }
    ViewSet;

    if(rb)then
    begin
      a.ScroolBarStart;
      a.ScroolbarFinish;
      Window(3,2,78,5);
      rb:=false;
      clrscr;
      b.Readln(#0);
      Window(2,20,79,24);

      case UpCase(op) of
        'B': a.SqrY(b);
        'J': m.Plus(a);
        'K': m.Copy_bn(a);
        'M': b.Copy_bn(m);
        'Z': m.Copy(0);
        '+': a.Plus    (b);
        '-': a.Minus   (b);
        '*': a.Multiply(b);
        '/': a.Divide  (b);
      else a.Copy_bn(b);
      end;
    end;

    { vypis vysledok }
    Window(3,2,78,5);
    clrscr;
    a.Write(BN_INFINITY, BN_INFINITY);
  until (op = #27);
end.

Copyrigth by Zdeno Sekerak 2007, http://www.trsek.com