Program výpočtu logaritmu troma spôsobmi

{ LOG.PAS                                Copyright (c) Jan Benkovic }
{ Program vypoctu logaritmu troma sposobmi.                         }
{ - vypocet logaritmu s neznamym VYSLEDKOM                          }
{ - vypocet logaritmu s neznamym B                                  }
{ - vypocet logaritmu s neznamym A                                  }
{                                                                   }
{ Datum:06.02.2000                             http://www.trsek.com }
 
uses crt;
 
var
 c: char;
 posun,kon: byte;
 a,b,vysledok,eps,x,x1,q,pom1:real;
 d,i,e:longint;
 pom: extended;
 
procedure Koniec1;
 begin
  clrscr;
  gotoxy(30,10);
  Writeln('CREATED BY TRIO CREW ');
  gotoxy(36,11);
  Writeln('Macko 007        ');
  gotoxy(24,12);
  Writeln('http://freeweb.coco.cz/triocrew ');
  gotoxy(30,13);
  Writeln('Benkovic@internet.sk ');
  readkey;
  exit;
 end;
 
procedure logaritmus;
 begin
  clrscr;
  posun:=0;
  kon:=0;
  a:=0;
  b:=0;
  i:=0;
  vysledok:=0;
  pom:=0;
  pom1:=0;
  Textcolor(Red);
  Writeln('Logaritmi >');
  Writeln('Logaritmus A so zakladom B je VYSLEDOK');
  Writeln;
  Textcolor(lightgray);
  Writeln('Ratat s neznamym VYSLEDKOM');
  Writeln('Ratat s neznamym B');
  Writeln('Ratat s neznamym A');
  Writeln('Exit to OS');
  gotoxy(30,4);
  Writeln('<-');
  repeat
   repeat c:=readkey until (c='P')or(c='H')or(c=#13);
   case c of
    'P': begin
          if posun=3 then
          else
           begin
            posun:=posun+1;
            gotoxy(30,4+posun);
            Writeln('<-');
            gotoxy(30,4+posun-1);
            Writeln('  ');
           end;
         end;
    'H': begin
          if posun=0 then
          else
           begin
            posun:=posun-1;
            gotoxy(30,4+posun);
            Writeln('<-');
            gotoxy(30,4+posun+1);
            Writeln('  ');
           end;
         end;
    #13 :kon:=kon+1;
   end;
 until kon=1;
 if posun=0 then
  begin
   clrscr;
   Writeln('Logaritmus A so zakladom B je');
   Write('Zadaj A ');
   Readln(a);
   Write('Zadaj B ');
   Readln(b);
   if (a=0)or(b=0)or(a=1) then
    begin
     gotoxy(1,1);
     Writeln('Logaritmus nema zmisel                    ');
    end
   else
    begin
     vysledok:=ln(b)/ln(a);
     gotoxy(31,1);
     Writeln(vysledok:10:20);
    end;
   readkey;
   logaritmus;
  end
 else if posun=1 then
  begin
   clrscr;
   Writeln('Logaritmus B so zakladom .. je VYSLEDOK');
   Write('Zadaj B ');
   Readln(a);
   Write('Zadaj VYSLEDOK ');
   Readln(b);
   if b=3 then
    begin
     eps:=1;
     i:=20;
     repeat
      eps := eps/10;
      i:=i-1;
     until i=0;
     x1:= 1;
     repeat
      x:= x1;
      x1 := x+(a/(x*x)-x)/3;
     until abs(x1-x) < eps;
     gotoxy(1,1);
     Writeln('Logaritmus B so zakladom ',x1:10:20,' je VYSLEDOK');
     readkey;
     logaritmus;
    end
   else if b=1 then
    begin
     gotoxy(1,1);
     Writeln('Logaritmus B so zakladom ',a:10:20,' je VYSLEDOK');
     readkey;
     logaritmus;
    end
   else if b=0 then
    begin
     gotoxy(1,1);
     Writeln('Logaritmus nema zmisel                    ');
     readkey;
     logaritmus;
    end
   else
    begin
     pom:=b;
     repeat
      q:=b/2;
      b:=q;
      i:=i+1;
     until (b<=2);
     if b=1 then
      begin
       pom:=sqrt(a);
       gotoxy(1,1);
       Writeln('Logaritmus ',a:10:10,' so zakladom ',pom:10:10,' je VYSLEDOK');
       readkey;
       logaritmus;
      end
     else if b<2 then
      begin
       gotoxy(1,1);
       Writeln('Logaritmus je ',pom:10:10,'-ta odmocnina s ',a:10:10);
      end
     else
      begin
       for d:= 1 to i+1 do
        begin
         pom1:=sqrt(pom);
         pom:=pom1;
        end;
       gotoxy(1,1);
       Writeln('Logaritmus ',a:10:10,' so zakladom ',pom1:10:10,' je VYSLEDOK');
      end;
     readkey;
     logaritmus;
    end;
  end
 else if posun=2 then
  begin
   pom:=1;
   clrscr;
   Writeln('Logaritmus .. so zakladom B je VYSLEDOK');
   Write('Zadaj B ');
   Readln(a);
   Write('Zadaj VYSLEDOK ');
   Readln(e);
   for i:= 1 to e do
    pom:=a*pom;
   gotoxy(1,1);
   Writeln('Logaritmus ',pom,' so zakladom B je VYSLEDOK');
   readkey;
   logaritmus;
  end
 else if posun=3 then
  Koniec1;
end;
 
procedure Help;
 begin
  clrscr;
  gotoxy(13,1);
  Writeln('--------------------------HELP-------------------------');
  gotoxy(13,2);
  Writeln('Logaritmi : ');
  gotoxy(13,3);
  Writeln('Program bol vytvoreny pre ulahcenie ratania logaritmov,');
  gotoxy(13,4);
  Writeln('ktore sa na kalkulacke rataju zlozitejsie.');
  gotoxy(13,5);
  Writeln;
  gotoxy(13,6);
  Writeln('V jednolivych urovniach sa pohybuje sipkami hore a ');
  gotoxy(13,7);
  Writeln('dole postup sa potvrdzuje ENTERom.');
  gotoxy(13,8);
  WRiteln('Pri pisani jednotlivych cisle sa kurzor nezobrazuje');
  gotoxy(13,9);
  Writeln;
  gotoxy(13,10);
  Writeln('Datum : 6.2.2000');
  gotoxy(13,11);
  Writeln('Den   : Nedela');
  gotoxy(13,12);
  Writeln('Cas   : 16.16');
  gotoxy(13,13);
  Writeln('--------------------------EXIT-------------------------');
  readkey;
  Koniec1;
 end;
 
procedure Koniec;
 begin
  clrscr;
  gotoxy(30,10);
  Writeln('CREATED BY TRIO CREW ');
  gotoxy(36,11);
  Writeln('Macko 007        ');
  gotoxy(24,12);
  Writeln('http://freeweb.coco.cz/triocrew ');
  gotoxy(30,13);
  Writeln('Benkovic@internet.sk ');
  readkey;
  exit;
 end;
 
begin
 asm
  mov ah,1
  mov cx,2000h
  int 10h
 end;
 clrscr;
 gotoxy(33,8);
 Textcolor(Red);
 Writeln('L O G A R I T M I');
 Textcolor(lightgray);
 gotoxy(36,10);
 Writeln('Logaritmus');
 gotoxy(39,11);
 Writeln('Help');
 gotoxy(36,12);
 Writeln('Exit to OS');
 gotoxy(28,10);
 Writeln('->');
 repeat
  repeat c:=readkey until (c='P')or(c='H')or(c=#13);
  case c of
   'P': begin
         if posun=2 then
         else
          begin
           posun:=posun+1;
           gotoxy(28,10+posun);
           Writeln('->');
           gotoxy(28,10+posun-1);
           Writeln('  ');
          end;
        end;
   'H': begin
         if posun=0 then
         else
          begin
           posun:=posun-1;
           gotoxy(28,10+posun);
           Writeln('->');
           gotoxy(28,11-posun);
           Writeln('  ');
           gotoxy(28,12);
           Writeln('  ');
          end;
        end;
   #13: kon:=kon+1;
  end;
 until kon=1;
 if posun=0 then Logaritmus
  else if posun=1 then Help
        else Koniec;
end.