{ 1stInCa.PAS Copyleft (c) Zdeno Sekerák, } { 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.