{THIS PROGRAM SHOWS HOW YOU CAN CALCULATE THE 6 TRIG FUNCTIONS. I DID THIS
FOR A COMPUTER PROJECT AND THEREFORE PUT SOME GRAPHICS. THIS INCLUDES
A FADING UNIT FOR 640 X 480 X 16 COLOUR PCX FILES WHICH I CAN ALSO DISPLAY.
I HAVE CREATED A UNIT GAPP2 WHICH CONTAINS A LOT OF NEAT FUNCTIONS AND PROCS.

HAVE MANY OTHER NEAT GENERIC STUFF INCLUDING PLAYING HSC FILES IN BACKGROUND.
THIS IS AL DONE BY MYSELF ELLI LECHTMAN AND KEVIN EPSTEIN WHO IS AN EXPERT
DELPHI PROGRAMMER.

FOR MORE INTERESTING STUFF E - MAIL ME AT  ELLI@ICON.CO.ZA

ENJOY !!!!!}    





{$N+,E+,G+,F+,O+}
{$M 32768,0,655360}

{Compiler directives, are comments with a
          special syntax, and can be used wherever
          comments are allowed.}

PROGRAM Trig;
USES crt,graph,gapp2,screen_d;

{Constant used for the Do_Chan procedure which writes numbers next to the
graphic buttons.}

CONST Chan : ARRAY[1..7] OF Char = ('1','2','3','4','5','6','7');

{Variables used.}

VAR radians,cos_radians1,sIN_radians1,deg:real;
    place,i:INteger;

{Initializes Graphics mode.}

PROCEDURE DO_graph;
VAR gd,gm:INteger;
BEGIN
   gd:=detect;
   INitgraph(gd,gm,''); {Stick your bgi directory in here}
   IF GraphResult <> GrOk THEN
     BEGIN
          Clrscr;
          writeln('SomethINg wrong WITH Graphics');
          Writeln('Check INitlINe');
          Halt(1);
     END;
END;

{Function used to calculate n!.}

FUNCTION FacTOrial(number:INteger):extENDed;
VAR counter:INteger;
    TOtal:extENDed;
BEGIN
   TOtal:=1;
   counter:=0;
   FOR counter:=1 TO number DO TOtal:=TOtal*counter;
   FacTOrial:=TOtal;
END;

{Function used to calculate the the result of a base to the power.}

FUNCTION Exponent(base,power:real):extENDed;
VAR no,i:extENDed;
BEGIN
   no:=base;
   i:=1;
   WHILE i <= power-1 DO
   BEGIN
      no:=no * base;
      i:=i+1;
   END;
   Exponent:=no;
END;

{The Cos function.}

FUNCTION CosINe(rad:real;places:INteger):real;
VAR expo:INteger;
    str1,str2:STRING;
    Accurate:boolean;  {Accuracy to what user wants.}
    ans:real;
    j:INteger;
BEGIN
   expo:=2;
   ans:=1-(exponent(rad,expo)/facTOrial(expo));
   str(ans,str1);
   str1:=copy(str1,0,places+1);
   j:=1;
   Accurate:=false;
   WHILE NOT Accurate DO
   BEGIN
      INc(expo,2);
      IF j MOD 2 = 0 THEN ans:=ans- (exponent(rad,expo)/facTOrial(expo)) ELSE
                              ans:=ans + (exponent(rad,expo)/facTOrial(expo));
      INc(j);
      str(ans,str2);
      str2:=copy(str2,0,places+1);
      accurate:=str1=str2;
      str1:=str2;
      str2:='';
   END;
   cosINe:=ans;
END;

{The Sin Function}

FUNCTION sINe(rad:real;places:INteger):real;
VAR expo,j:INteger;
    str1,str2:STRING;
    Accurate:boolean;
    ans:real;
BEGIN
   expo:=3;
   j:=1;
   ans:=rad-(exponent(rad,expo)/facTOrial(expo));
   str(ans,str1);
   str1:=copy(str1,0,places+1);
   accurate:=false;
   WHILE NOT Accurate DO
   BEGIN
      INc(expo,2);
      IF j MOD 2 = 0 THEN ans:=ans- (exponent(rad,expo)/facTOrial(expo)) ELSE
                              ans:=ans + (exponent(rad,expo)/facTOrial(expo));
      INc(j);
      str(ans,str2);
      str2:=copy(str2,0,places+1);
      accurate:=str1=str2;
      str1:=str2;
      str2:='';
   END;
   sINe:=ans;
END;

{Reduction formulae for the Sin function. Used to deterimine which quadrant
the number is situated. Quadrant 1 is always positive.}

FUNCTION SINCheck(VAR num:real):real;
BEGIN
   IF (num<=180) AND (num>90) THEN num:=180-num ELSE {Quadrant 2}
   IF (num >180) AND (num<=270) THEN num:=-(num-180) ELSE {Quadrant 3}
   IF (num>270) AND (num<=360) THEN num:=-(360 -num); {Quadrant 4}
   SINcheck:=num;
END;

{Reduction formulae for the Cos Function. Same as Sin Function.}

FUNCTION CosCheck(VAR num:real):real;
BEGIN
   IF (num<=180) AND (num>90) THEN num:=-num ELSE {Quadrant 1}
   IF (num >180) AND (num<=270) THEN num:=-(180 - num)ELSE {Quadrant 2}
   IF (num > 270) AND (num <=360) THEN num:=360 - num; {Quadrant 3}
   CosCheck:=num;
END;

{Reduction formulae for Tan. As well as to check the different quadrants
of the individual Cos and Sin values.}

FUNCTION Tan_check(VAR num,sIN_radians,cos_radians:real):real;
BEGIN
   IF (num > 90) AND (num <=180) THEN num:=-(180-num); {Quadrant 2}
   IF (num >180) AND (num <=270) THEN num:=num-180; {Quadrant 3}
   IF (cos_radians >-1) AND (cos_radians < 1) AND
   (sIN_radians >=0) AND (sIN_radians<1) THEN
   Tan_check:=sINe(sIN_radians,place)/cosINe(cos_radians,place) ELSE
   IF (sIN_radians <0) OR (sIN_radians >1) AND (cos_radians<-1) OR (cos_radians>1)
   THEN BEGIN
           SINcheck(deg);
           sIN_radians:=(num*pi)/180;
           Coscheck(deg);
           cos_radians:=(num*pi)/180;
           Tan_check:=sINe(sIN_radians,place)/cosINe(cos_radians,place);
        END;
END;

{Function to convert a Real number to String. Works better than str and
is more easier in Assembler.}

FUNCTION RTOS( nNum: REAL; nLength, nDec: INTEGER ): STRING;
VAR
   s: ^STRING;
BEGIN
     ASM
          mov     sp, bp
          push    ss
          push    WORD PTR @RESULT
     END;
     STR( nNum:nLength:nDec, s^ );
END;

{Lets the user enter the degrees.}

PROCEDURE Write_degs(VAR degrees:real;VAR st:STRING);
VAR s:STRING;
    x,y,x1,y1,err:INteger;
BEGIN
   SETtextstyle(6,0,1);
   x:=30;
   x1:=30+120;
   y:=40;
   y1:=40 +120;
   SETcolOR(black);
   SETfillstyle(solidfill,blue);
   bar(x+550,y+225,x1-100,y1-20);
   frame(x+550,y+225,x1-100,y1-20,White,darkgray);
   Outtextxy(x+10,y+100,'   Please enter degrees : ');
   s:='';
   WHILE s = '' DO readlnxy(x+208,y+114,10,s,blue,white);
   st:=s;
   val(st,degrees,err);
END;

{Lets the user enter accuracy of decimal places.}

PROCEDURE Write_place(VAR deci:INteger);
VAR s:STRING;
    x,y,x1,y1,err:INteger;
BEGIN
     SETtextstyle(6,0,1);
     x:=30;
     x1:=30+120;
     y:=40;
     y1:=40 +120;
     SETcolOR(black);
     Outtextxy(x+23,y+135,' Please enter accuracy of decimal places : ');
     s:='';
     WHILE s = '' DO readlnxy(x+355,y+148,10,s,blue,white);
     val(s,deci,err);
END;

{Displays all the results of Sin Function.}

PROCEDURE DO_sINe;
VAR st,st2:STRING;
    x,y:INteger;
BEGIN
   x:=30;
   y:=40;
   st:='';
   SETtextstyle(6,0,1);
   write_degs(deg,st);
   write_place(place);
   radians:=(deg*pi)/180;
   SETcolOR(black);
   SETtextstyle(6,0,1);
   IF (radians >=0) AND (radians<1) THEN
   BEGIN
   Outtextxy(x+28,y+175,'The Sine of ');
   st:=st + 'ø';
   Outtextxy(x+120,y+175,st);
   Outtextxy(x+240,y+175,'is');
   SETcolOR(red);
   Outtextxy(x+220+50,y+175,rTOs(sINe(radians,place),5,place));
   END;
   IF (radians <0) OR (radians >1) THEN
   BEGIN
      SINcheck(deg);
      radians:=(deg*pi)/180;
      Outtextxy(x+28,y+175,'The Sine of ');
      st:=st + 'ø';
      Outtextxy(x+120,y+175,st);
      Outtextxy(x+240,y+175,'is');
      SETcolOR(red);
      Outtextxy(x+220+50,y+175,rTOs(sINe(radians,place),5,place));
   END;
   readln;
END;

{Same as Do_Sine but for Cos Function.}

PROCEDURE DO_Cos;
VAR st,st2:STRING;
    x,y:INteger;
BEGIN
   x:=30;
   y:=40;
   st:='';
   write_degs(deg,st);
   write_place(place);
   radians:=(deg*pi)/180;
   SETcolOR(black);
   SETtextstyle(6,0,1);
   IF (radians >-1) AND (radians < 1) THEN
   BEGIN
      Outtextxy(x+28,y+175,'The Cosine of ');
      st:=st + 'ø';
      Outtextxy(x+140,y+175,st);
      Outtextxy(x+240,y+175,'is');
      SETcolOR(red);
      Outtextxy(x+220+50,y+175,rTOs(cosINe(radians,place),5,place));
   END;
   IF (radians<-1) OR (radians>1) THEN
   BEGIN
      Coscheck(deg);
      radians:=(deg*pi)/180;
      Outtextxy(x+28,y+175,'The Cosine of ');
      st:=st + 'ø';
      Outtextxy(x+140,y+175,st);
      Outtextxy(x+240,y+175,'is');
      SETcolOR(red);
      Outtextxy(x+220+50,y+175,rTOs(cosINe(radians,place),5,place));
   END;
   readln;
END;

{Same as above}

PROCEDURE DO_Tan;
VAR x,y:INteger;
    st:STRING;
BEGIN
   x:=30;
   y:=40;
   st:='';
   write_degs(deg,st);
   SETtextstyle(6,0,1);
   {Due to assimptote situation.}
   IF (deg = 90) OR (deg = 270) OR (deg =450) OR (deg= 630) THEN
   Outtextxy(x+25,y+135,'Sorry, the result of this function is undefined !!!') ELSE
   BEGIN
      write_place(place);
      radians:=(deg*pi)/180;
      SETtextstyle(6,0,1);
      SETcolOR(black);
      cos_radians1:=(deg*pi)/180;
      sIN_radians1:=(deg*pi)/180;
      Outtextxy(x+28,y+175,'The Tan of ');
      st:=st + 'ø';
      Outtextxy(x+120,y+175,st);
      Outtextxy(x+240,y+175,'is');
      SETcolOR(red);
      Outtextxy(x+220+50,y+175,rTOs(tan_check(deg,sIN_radians1,cos_radians1),5,place));
   END;
   readln;
END;

{Inverse of Sin function. Cannot invert 0 so if answer is 0 then keep it.}

PROCEDURE DO_Cosec;
VAR st,st2:STRING;
    x,y:INteger;
BEGIN
   radians:=0;
   x:=30;
   y:=40;
   st:='';
   SETtextstyle(6,0,1);
   write_degs(deg,st);
   write_place(place);
   radians:=(deg*pi)/180;
   SETcolOR(black);
   SETtextstyle(6,0,1);
   IF (radians >=0) AND (radians<1) THEN
   BEGIN
     Outtextxy(x+28,y+175,'The Cosec of ');
     st:=st + 'ø';
     Outtextxy(x+136,y+175,st);
     Outtextxy(x+240+length(st)+20,y+175,'is');
     IF ((trunc(deg) MOD 360 = 0)) OR ((trunc(deg) MOD 360 = 180)) THEN
     BEGIN
       SETcolOR(red);
       Outtextxy(x+220+100,y+175,rTOs(sINe(radians,place),5,place));
     END;
     IF ((trunc(deg) MOD 360 <> 0)) OR ((trunc(deg) MOD 360 <> 180 )) THEN
     BEGIN
        SETcolOR(red);
        Outtextxy(x+220+100,y+175,rTOs(1/(sINe(radians,place)),5,place));
     END;
   END;
     IF (radians <0) OR (radians >1) THEN
     BEGIN
        SINcheck(deg);
        radians:=(deg*pi)/180;
        Outtextxy(x+28,y+175,'The Cosec of ');
        st:=st + 'ø';
        Outtextxy(x+136,y+175,st);
        Outtextxy(x+240+length(st)+20,y+175,'is');
        IF (trunc(deg) MOD 360 = 0) OR (trunc(deg) MOD 360 = 180) THEN
        BEGIN
          SETcolOR(red);
          Outtextxy(x+220+50,y+175,rTOs(sINe(radians,place),5,place));
        END;
        IF (trunc(deg) MOD 360 <> 0) OR (trunc(deg) MOD 360 = 180 ) THEN
        BEGIN
          SETcolOR(red);
          Outtextxy(x+220+50,y+175,rTOs(1/(sINe(radians,place)),5,place));
        END;
     END;
   readln;
END;

{Inverse of Cos Function.}

PROCEDURE DO_Sec;
VAR st,st2:STRING;
    x,y:INteger;
BEGIN
   radians:=0;
   x:=30;
   y:=40;
   st:='';
   SETtextstyle(6,0,1);
   write_degs(deg,st);
   write_place(place);
   radians:=(deg*pi)/180;
   SETcolOR(black);
   SETtextstyle(6,0,1);
   IF (radians >=0) AND (radians<1) THEN
   BEGIN
     Outtextxy(x+28,y+175,'The Sec of ');
     st:=st + 'ø';
     Outtextxy(x+116,y+175,st);
     Outtextxy(x+240,y+175,'is');
     IF ((trunc(deg) MOD 90 = 0)) OR ((trunc(deg) MOD 90 = 45)) THEN
     BEGIN
       SETcolOR(red);
       Outtextxy(x+220+50,y+175,rTOs(cosINe(radians,place),5,place));
     END;
     IF ((trunc(deg) MOD 90 <> 0)) OR ((trunc(deg) MOD 360 <> 45 )) THEN
     BEGIN
        SETcolOR(red);
        Outtextxy(x+220+50,y+175,rTOs(1/(cosINe(radians,place)),5,place));
     END;
   END;
     IF (radians <0) OR (radians >1) THEN
     BEGIN
        SINcheck(deg);
        radians:=(deg*pi)/180;
        Outtextxy(x+28,y+175,'The Sec of ');
        st:=st + 'ø';
        Outtextxy(x+116,y+175,st);
        Outtextxy(x+240,y+175,'is');
        IF (trunc(deg) MOD 90 = 0) OR (trunc(deg) MOD 90 = 45) THEN
        BEGIN
          SETcolOR(red);
           Outtextxy(x+220+50,y+175,rTOs(cosINe(radians,place),5,place));
        END;
        IF (trunc(deg) MOD 90 <> 0) OR (trunc(deg) MOD 90 = 45 ) THEN
        BEGIN
          SETcolOR(red);
          Outtextxy(x+220+50,y+175,rTOs(1/(cosINe(radians,place)),5,place));
        END;
     END;
   readln;
END;

{Inverse of Cot Function.}

PROCEDURE DO_Cot;
VAR x,y:INteger;
    st:STRING;
BEGIN
   x:=30;
   y:=40;
   st:='';
   write_degs(deg,st);
   SETtextstyle(6,0,1);
   IF (deg = 90) OR (deg = 270) OR (deg =450) OR (deg= 630) THEN
   Outtextxy(x+25,y+135,'Sorry, the result of this function is undefINed !!!') ELSE
   BEGIN
      write_place(place);
      radians:=(deg*pi)/180;
      SETtextstyle(6,0,1);
      SETcolOR(black);
      cos_radians1:=(deg*pi)/180;
      sIN_radians1:=(deg*pi)/180;
      Outtextxy(x+28,y+175,'The Cot of ');
      st:=st + 'ø';
      Outtextxy(x+120,y+175,st);
      Outtextxy(x+240,y+175,'is');
      IF (trunc(deg) MOD 180 = 0) THEN
      BEGIN
        SETcolOR(red);
        Outtextxy(x+220+50,y+175,rTOs(tan_check(deg,sIN_radians1,cos_radians1),5,place));
      END;
      IF (trunc(deg) MOD 180 <>0) THEN
      BEGIN
         SETcolOR(red);
        Outtextxy(x+220+50,y+175,rTOs(1/(tan_check(deg,sIN_radians1,cos_radians1)),5,place));
      END;
   END;
   readln;
END;

{Used to draw numbers next to a button to let user use program with keyboard
only.}

PROCEDURE DOChan(x,y : INteger;s : STRING);
BEGIN
     SETfillstyle(solidfill,black);
     Bar(x-2,y-2,x+25,y+25);
     Bar(x-2,y-2,x+25,y+25);
     Frame(x-2,y-2,x+25,y+25,White,darkgray);
     SETcolOR(White);
     SETtextstyle(6,0,2);
     Outtextxy(x+6,y-4,s);
END;

{Main menu. Loads a PCX file 640 X 480 X 16 dimensions. Then displays buttons.}

PROCEDURE Menu;
VAR i:INteger;
BEGIN
     Fadeout;
     readscr('background.pcx');
     DOButTOn(230,100,'Sin Function ');
     DOButTOn(230,100,'Sin Function ');
     DOButTOn(230,150,'Cos Function ');
     DObutTOn(230,200,'Tan Function');
     DOButTOn(230,250,'Cosec Function');
     DOButTOn(230,300,'Sec Function ');
     DOButTOn(230,350,'Cot Function ');
     DObutTOn(230,400,'Quit');
     ShowmousecursOR;
     FOR i := 1 TO 7 DO DOChan(180,50 + (i*50),Chan[i]);
     FadeIN;
END;

Procedure SetUpScreen;
Begin
     ClrScr;
     textcolor(blue);
     writeln;
     Writeln('                      Program written by Elli Lechtman         ');
     writeln;
     textcolor(lightred);
     Writeln('                                  STD 10 ');
     writeln('                          Sandringham High School');
     writeln('                                   1997');
     writeln;
     textcolor(lightblue);
     writeln('                                 Home Page');
     writeln('                    http://www.icon.co.za/~elli/welcome.htm');
     GotoXY (1,5);
     TextColor (yellow);
     GotoXY(21, 19);
     Writeln('This Program is Copyrighted by Elli Lechtman');
     GotoXY(13,21);
     Writeln('This Program is Public Domain as long as not sold for profit.');
End;

{This is where the user controls the Functions that he wants.}

PROCEDURE Menu_Screen;
VAR
   ch : Char;
   rep : INteger;
   quit:boolean;

   PROCEDURE Proc1;
   BEGIN
        Banimate(230,100,'Sin Function ');
        hidemousecursOR;
        DO_Sine;
        menu;
        showmousecursOR;
   END;

   PROCEDURE Proc2;
   BEGIN
        BAnimate(230,150,'Cos Function ');
        hidemousecursOR;
        DO_cos;
        menu;
        showmousecursOR;
   END;

   PROCEDURE Proc3;
   BEGIN
        Banimate(230,200,'Tan Function');
        hidemousecursOR;
        DO_tan;
        menu;
        showmousecursOR;
   END;

   PROCEDURE Proc4;
   BEGIN
        Banimate(230,250,'Cosec Function');
        hidemousecursOR;
        DO_cosec;
        menu;
        showmousecursOR;
   END;

   PROCEDURE proc5;
   BEGIN
       Banimate(230,300,'Sec Function ');
       hidemousecursOR;
       DO_sec;
       menu;
       showmousecursOR;
   END;

   PROCEDURE proc6;
   BEGIN
        Banimate(230,350,'Cot Function ');
        hidemousecursOR;
        DO_cot;
        menu;
        showmousecursOR;
   END;

   PROCEDURE MaINProc;
   BEGIN
     Quit := False;
     FOR i := 1 TO 6 DO DOChan(180,50 + (i*50),Chan[i]);
     REPEAT
           Ch := ' ';
           REPEAT
                 ShowmousecursOR;
                 IF Keypressed THEN Ch := readkey;
           UNTIL (GetbutTOnpressed = 1) OR (Ch <> ' ');
           IF (CButTOn(230,100,'Sin Function ') AND
           (getbutTOnpressed = 1))  OR (Ch = '1') THEN Proc1;
           IF (CbutTOn(230,150,'Cos Function ') AND
           (getbutTOnpressed = 1)) OR (Ch = '2') THEN Proc2;
           IF (CbutTOn(230,200,'Tan Function') AND
           (getbutTOnpressed = 1)) OR (Ch = '3') THEN Proc3;
           IF (CButTOn(230,250,'Cosec Function') AND
           (getbutTOnpressed = 1)) OR (Ch = '4') THEN Proc4;
           IF (CButTOn(230,300,'Sec Function') AND
           (getbutTOnpressed = 1)) OR (Ch = '5') THEN Proc5;
           IF (CButTOn(230,350,'Cot Function') AND
           (getbutTOnpressed = 1)) OR (Ch = '6') THEN Proc6;
           IF (CbutTOn(230,400,'Quit') AND (getbutTOnpressed = 1))
           OR (upCASE(Ch) = '7') THEN
           BEGIN
              quit:=true;
              Banimate(230,400,'Quit');
              fadeout;
              hidemousecursor;
              closegraph;
              fadein;
           END;
     UNTIL Quit;
END;
BEGIN
   maINproc;
END;

BEGIN
   radians:=0; {Initializes variables}
   deg:=0;
   place:=0;
   DO_graph;
   readscr('trig.pcx'); {Loads introductory PCX file}
   delay(3000);
   menu;
   menu_screen;
   restorecrtmode;
   SetUpScreen;
   readln;
END.