NBPrg40. CALCWS.PAS. MiniOS. OpenSource.

NBPrg40. CALCWS.PAS. MiniOS. OpenSource.
***************************************

{ Nikita Beloshenko (GNU) CalcWS = Calc(WORK_SYS) }

Unit CalcWS;

(******************************************************
 *                                                    *
 *   CALCWS.PAS                                       *
 *                                                    *
 *   CalcWS.                                          *
 *   Graphical unit for NBPrg23 graphical             *
 *   subsystem. NBPrg23 is the part of NBPrg40        *
 *   (and also NBPrg27-33,34,35,36,37,38)             *
 *   CalcWS is graphical unit for calculation         *
 *   (calculator).                                    *
 *                                                    *
 ******************************************************)

Interface
Uses graph,crt,interf_w,work_sys,NBPRG_I;
Type
   wcalc=Object(work_sys_object)
         End;

   c_coord=Record
          x,y:integer;
         End;

   c_barcoord=Record
             A,B:c_coord
            End;


   calc_palete=Object(wcalc)
                 bufcolor:integer;
                 helpframecolor:integer;
                 helpcolor:integer;
                 comcolor:integer;
                 regcolor:integer;
                 framecolor:integer;
                 bodycolor:integer;
                 Constructor standart;
                 Procedure restruct;
                 Destructor done;
               End;

   calc_register=Object(wcalc)
                   A,B,C,D,E,F,G:real;
                   ai,bi,ci:integer;
                   formula:string;
                   Procedure clear;
                   Procedure cformula(s:String);
                   Procedure cset(s:String);
                   Procedure cadd(s:String);
                   Procedure csub(s:String);
                   Procedure cmov(s:String);
                   Procedure cmul(s:String);
                   Procedure cdiv(s:String);
                   Procedure cln(s:String);
                   Procedure csin(s:String);
                   Procedure ccos(s:String);
                   Procedure carctan(s:String);
                   Procedure cexp(s:String);
                   Procedure csqrt(s:String);
                 End;

   calc_interf=Object(wcalc)
                 reg:calc_register;
                 p:calc_palete;
                 com_bar:c_barcoord;
                 reg_bar:c_barcoord;
                 c_bar:c_barcoord;
                 hicom,buf:byte;
                 command:Array[1..100] Of String;
                 Constructor init;
                 Procedure build_body;
                 Procedure build_body_without_reg_clear;
                 Procedure outregister;
                 Procedure inputcommand;
                 Procedure printhelp;
                 Procedure printbuffer;
                 Procedure savebuffer;
                 Procedure loadbuffer;
                 Destructor done;
               End;

Var
 pc_interf:^calc_interf;

Procedure calc_run;

Implementation

Var maxx,maxy:integer;
    c_key:char;

Procedure calc_run;
Var
  i : Byte;
  x,y,x1,y1:integer;
  ch:char; s:String;
Begin
  maxx:=getmaxx; maxy:=getmaxy;
  new(pc_interf,init); c_key:=' ';
  While ord(c_key)<>27 Do Begin

        { RELOAD CALC GRAFICAL INTERFACE }
        pc_interf^.build_body_without_reg_clear;

        { WRITE COMMANDS }
        With pc_interf^ Do
        Begin
          setcolor(p.comcolor);
          settextstyle(smallfont,horizdir,4);
          With com_bar Do Begin x:=a.x; y:=a.y; x1:=b.x; y1:=b.y; End;
          If (hicom Mod 10=0) Then
          Begin
             bar(x+1,y+1,x1-1,y1-1);
          End;
          i:=1; inc(x,5); inc(y,5);
          If (hicom>1) And (hicom<10) Then
          For i:=1 To hicom Do
          Begin
            {outtextxy(x,y,'');}
            outtextxy(x,y,command[i]);
            inc(y,10);
          End;
          buf:=hicom Mod 10;
          If hicom>10 Then
          For i:=hicom-buf+1 To hicom Do
          Begin
            {outtextxy(x,y,'');}
            outtextxy(x,y,command[i]);
            inc(y,10);
          End;
        End;

        c_key:=readkey;
        If c_key='c' Then pc_interf^.inputcommand;
        If c_key='h' Then pc_interf^.printhelp;
        If c_key='b' Then pc_interf^.printbuffer;
        If c_key='l' Then pc_interf^.loadbuffer;
        pc_interf^.outregister;
  End;
  If ord(c_key)=27 then pc_interf^.savebuffer;
  dispose(pc_interf,done);
End;

(*-----------------------------------------*)
(*           ЏЂ‹€’ђЂ  ЉЂ‹њЉ“‹џ’ЋђЂ         *)
(*-----------------------------------------*)
Constructor calc_palete.standart;
Begin
  bufcolor:=lightgray;
  helpframecolor:=red;
  helpcolor:=cyan;
  comcolor:=brown;
  framecolor:=red;
  bodycolor:=cyan;
  regcolor:=black;
End;

Procedure calc_palete.restruct;
Begin
  bufcolor:=black;
  helpframecolor:=black;
  helpcolor:=black;
  comcolor:=black;
  framecolor:=black;
  bodycolor:=black;
  regcolor:=black;
End;

Destructor calc_palete.done;
Begin
  bufcolor:=0;
  helpframecolor:=0;
  helpcolor:=0;
  comcolor:=0;
  framecolor:=0;
  bodycolor:=0;
  regcolor:=0;
End;

(*-----------------------------------------*)
(*          €Ќ’…ђ”…‰‘  ЉЂ‹њЉ“‹џ’ЋђЂ        *)
(*-----------------------------------------*)
Constructor calc_interf.init;
Var i:byte;
Begin
  For i:=1 To 100 Do command[i]:='';
  p.standart; hicom:=1;
  c_bar.a.x:=maxx Div 4;
  c_bar.a.y:=maxy Div 4;
  c_bar.b.x:=maxx-maxx Div 4;
  c_bar.b.y:=maxy-maxy Div 4;
  build_body;
End;

Procedure calc_interf.build_body_without_reg_clear;
Var x,y,x1,y1:integer;
Begin
  setfillstyle(solidfill,p.bodycolor);
  setcolor(p.framecolor);
  With c_bar Do Begin
       bar(a.x,a.y,b.x,b.y);
       rectangle(a.x,a.y,b.x,b.y);
       x:=a.x+10; y:=a.y+10;
       x1:=(a.x+b.x) Div 2; y1:=b.y-10;
  End;
  rectangle(x,y,x1,y1);
  inc(x,2); inc(y,2); dec(x1,2); dec(y1,2);
  rectangle(x,y,x1,y1);
  With com_bar Do Begin
       a.x:=x; a.y:=y; b.x:=x1; b.y:=y1;
  End;
  dec(x,2); dec(y,2); inc(x1,2); inc(y1,2);
  With c_bar Do Begin
       x:=x1+20; x1:=b.x-10; y:=y+30;
  End;
  rectangle(x,y,x1,y1);
  inc(x,2); inc(y,2); dec(x1,2); dec(y1,2);
  With reg_bar Do Begin
       a.x:=x; a.y:=y; b.x:=x1; b.y:=y1;
  End;
  rectangle(x,y,x1,y1);
  inc(x,2); dec(y,20);
  settextstyle(smallfont,horizdir,5);
  outtextxy(x,y,'register:');
  outregister;
End;

Procedure calc_interf.build_body;
Var x,y,x1,y1:integer;
Begin
  setfillstyle(solidfill,p.bodycolor);
  setcolor(p.framecolor);
  With c_bar Do Begin
       bar(a.x,a.y,b.x,b.y);
       rectangle(a.x,a.y,b.x,b.y);
       x:=a.x+10; y:=a.y+10;
       x1:=(a.x+b.x) Div 2; y1:=b.y-10;
  End; reg.clear;
  rectangle(x,y,x1,y1);
  inc(x,2); inc(y,2); dec(x1,2); dec(y1,2);
  rectangle(x,y,x1,y1);
  With com_bar Do Begin
       a.x:=x; a.y:=y; b.x:=x1; b.y:=y1;
  End;
  dec(x,2); dec(y,2); inc(x1,2); inc(y1,2);
  With c_bar Do Begin
       x:=x1+20; x1:=b.x-10; y:=y+30;
  End;
  rectangle(x,y,x1,y1);
  inc(x,2); inc(y,2); dec(x1,2); dec(y1,2);
  With reg_bar Do Begin
       a.x:=x; a.y:=y; b.x:=x1; b.y:=y1;
  End;
  rectangle(x,y,x1,y1);
  inc(x,2); dec(y,20);
  settextstyle(smallfont,horizdir,5);
  outtextxy(x,y,'register:');
  outregister;
End;

Procedure calc_interf.outregister;
Var x,y,x1,y1:integer; s:String;
Begin
  setcolor(p.regcolor);
  setfillstyle(solidfill,p.bodycolor);
  settextstyle(smallfont,horizdir,4);
  With reg_bar Do Begin x:=a.x; y:=a.y; x1:=b.x; y1:=b.y; End;
  bar(x+1,y+1,x1-1,y1-1);
  inc(x,5); inc(y,5);
  str(reg.a,s); s:='A= '+s; outtextxy(x,y,s); inc(y,10);
  str(reg.b,s); s:='B= '+s; outtextxy(x,y,s); inc(y,10);
  str(reg.c,s); s:='C= '+s; outtextxy(x,y,s); inc(y,10);
  str(reg.d,s); s:='D= '+s; outtextxy(x,y,s); inc(y,10);
  str(reg.e,s); s:='E= '+s; outtextxy(x,y,s); inc(y,10);
  str(reg.f,s); s:='F= '+s; outtextxy(x,y,s); inc(y,10);
  str(reg.g,s); s:='G= '+s; outtextxy(x,y,s); inc(y,10); inc(y,10);
  str(reg.ai,s); s:='Ai= '+s; outtextxy(x,y,s); inc(y,10);
  str(reg.bi,s); s:='Bi= '+s; outtextxy(x,y,s); inc(y,10);
  str(reg.ci,s); s:='Ci= '+s; outtextxy(x,y,s); inc(y,10);
End;

Procedure calc_interf.inputcommand;
Var x,y,x1,y1:integer; i:byte;
    ch:char; s:String;
Begin
  setcolor(p.comcolor);
  settextstyle(smallfont,horizdir,4);
  With com_bar Do Begin x:=a.x; y:=a.y; x1:=b.x; y1:=b.y; End;
  If hicom=100 Then Begin savebuffer; hicom:=1; End;
  If (hicom Mod 10=0) Then Begin
     bar(x+1,y+1,x1-1,y1-1);
  End;
  i:=1; inc(x,5); inc(y,5);
  If (hicom>1) And (hicom<10) Then
     For i:=1 To hicom Do Begin
         {outtextxy(x,y,'');}
         outtextxy(x,y,command[i]);
         inc(y,10);
     End;
  buf:=hicom Mod 10;
  If hicom>10 Then
     For i:=hicom-buf+1 To hicom Do Begin
         {outtextxy(x,y,'');}
         outtextxy(x,y,command[i]);
         inc(y,10);
     End;
  s:=''; ch:=' ';
  While (ord(ch)<>13) And (length(s)<20) Do Begin
        ch:=readkey; s:=s+ch;
        outtextxy(x,y,ch); inc(x,5);
  End; inc(hicom); reg.cformula(s);
  command[hicom]:=s;
  reg.Ai:=hicom;
  reg.Bi:=100;
  reg.Ci:=100-hicom;
End;

Procedure calc_interf.printhelp;
Var h_ch:char;
    x,y,x1,y1:integer;
    x_,y_,x1_,y1_:integer;
Begin
  x:=maxx Div 20; x1:=maxx Div 3-maxx Div 7+10;
  y:=maxy Div 8; y1:=maxy Div 3 + maxy Div 3;
  p.helpcolor:=cyan; p.helpframecolor:=red;
  setfillstyle(solidfill,p.helpcolor);
  setcolor(p.helpframecolor);
  bar(x,y,x1,y1); rectangle(x,y,x1,y1); h_ch:=' ';
  x_:=x+5; y_:=y+10;
  settextstyle(smallfont,horizdir,5);
  outtextxy(x_,y_,'"c"-command.');  inc(y_,10);
  outtextxy(x_,y_,'"h"-help.');     inc(y_,10);
  outtextxy(x_,y_,'"b"-buffer.');   inc(y_,10);
  outtextxy(x_,y_,'Warning!!!');    inc(y_,10);
  outtextxy(x_,y_,'Esc-clear');     inc(y_,10);
  outtextxy(x_,y_,'  buffer.');     inc(y_,10);
  outtextxy(x_,y_,'');              inc(y_,10);
  outtextxy(x_,y_,'commands:');     inc(y_,10);
  outtextxy(x_,y_,'set');           inc(y_,10);
  outtextxy(x_,y_,'add');           inc(y_,10);
  outtextxy(x_,y_,'sub');           inc(y_,10);
  outtextxy(x_,y_,'mul');           inc(y_,10);
  outtextxy(x_,y_,'mov');           inc(y_,10);
  outtextxy(x_,y_,'div');           inc(y_,10);
  outtextxy(x_,y_,'ln');            inc(y_,10);
  outtextxy(x_,y_,'sin');           inc(y_,10);
  outtextxy(x_,y_,'cos');           inc(y_,10);
  outtextxy(x_,y_,'arctan');        inc(y_,10);
  outtextxy(x_,y_,'exp');           inc(y_,10);
  outtextxy(x_,y_,'sqrt');          inc(y_,10);

  While ord(h_ch)<>27 Do h_ch:=readkey;
  p.helpcolor:=black;
  p.helpframecolor:=black;
  setfillstyle(solidfill,p.helpcolor);
  setcolor(p.helpframecolor);
  bar(x,y,x1,y1); rectangle(x,y,x1,y1);

  NBPRG_I_reload_interf; { NBPRG GRAPHICAL INTERFACE RELOAD }
End;

Procedure calc_interf.printbuffer;
Var h_ch:char;
    x,y,x1,y1:integer;
    x_,y_,x1_,y1_:integer;
    i,pos:byte;
Begin
  x:=maxx Div 20; x1:=maxx Div 3-maxx Div 7+25;
  y:=maxy Div 3+10; y1:=maxy-maxy Div 4;
  p.bufcolor:=lightgray;
  p.helpframecolor:=red; pos:=1;
  setfillstyle(solidfill,p.bufcolor);
  setcolor(p.helpframecolor);
  bar(x,y,x1,y1); rectangle(x,y,x1,y1); h_ch:=' ';
  x_:=x+5; y_:=y+10;
  While ord(h_ch)<>27 Do Begin
        If pos+9>100 Then pos:=1;
        y_:=y+10;
        For i:=pos To pos+9 Do Begin
            setcolor(red);
            settextstyle(smallfont,horizdir,5);
            outtextxy(x_,y_,command[i]);
            inc(y_,10);
        End;
        h_ch:=readkey;
        If (ord(h_ch)=80) And (pos+9<=100) Then inc(pos);
        If (ord(h_ch)=72) And (pos>1)      Then dec(pos);
        bar(x,y,x1,y1); rectangle(x,y,x1,y1);
  End;
  p.bufcolor:=black; p.helpframecolor:=black;
  setfillstyle(solidfill,p.bufcolor);
  setcolor(p.helpframecolor);
  bar(x,y,x1,y1); rectangle(x,y,x1,y1); h_ch:=' ';

  NBPRG_I_reload_interf; { NBPRG GRAPHICAL INTERFACE RELOAD }
End;

Procedure calc_interf.savebuffer;
Var h_ch:char;
    x,y,x1,y1:integer;
    x_,y_,x1_,y1_:integer;
    i,pos:byte;
    s1:String; t:text;
    l1:set of 'a'..'z';
    l2:set of 'A'..'Z';
Begin
  x:=maxx Div 20; x1:=maxx Div 3-maxx Div 7+25;
  y:=maxy Div 3+10; y1:=maxy-maxy Div 4;
  p.bufcolor:=lightgray;
  p.helpframecolor:=red; pos:=1;
  setfillstyle(solidfill,p.bufcolor);
  setcolor(p.helpframecolor);
  bar(x,y,x1,y1); rectangle(x,y,x1,y1); h_ch:=' ';
  x_:=x+5; y_:=y+10;
  settextstyle(smallfont,horizdir,5);
  outtextxy(x_,y_,'Esly nugno ');      inc(y_,10);
  outtextxy(x_,y_,'soxranit ');        inc(y_,10);
  outtextxy(x_,y_,'buffer ');          inc(y_,10);
  outtextxy(x_,y_,'input name,');      inc(y_,10);
  outtextxy(x_,y_,'else input ');      inc(y_,10);
  outtextxy(x_,y_,'"aaaaa". ');        inc(y_,10);
  s1:=''; i:=0;
  While (ord(h_ch)<>13) And (i<=5) Do Begin
        inc(i);
        h_ch:=readkey; inc(x_,7);
        If ord(h_ch)<>13 Then s1:=s1+h_ch;
        outtextxy(x_,y_,h_ch);
  End; inc(y_,10);
  outtextxy(x_,y_,s1); delay(5000); delay(5000); delay(5000);
  If s1<>'aaaaa' Then Begin
     s1:=s1+'.clc';
     assign(t,s1); rewrite(t);
     For i:=1 To hicom Do write(t,command[i]);
     close(t);
  End;
  p.bufcolor:=black; p.helpframecolor:=black;
  setfillstyle(solidfill,p.bufcolor);
  setcolor(p.helpframecolor);
  bar(x,y,x1,y1); rectangle(x,y,x1,y1); h_ch:=' ';

  NBPRG_I_reload_interf; { NBPRG GRAPHICAL INTERFACE RELOAD }
End;

Procedure calc_interf.loadbuffer;
Var h_ch:char;
    x,y,x1,y1:integer;
    x_,y_,x1_,y1_:integer;
    i,pos:byte;
    s1:String; t:text;
    l1:set of 'a'..'z';
    l2:set of 'A'..'Z';
Begin
  x:=maxx Div 20; x1:=maxx Div 3-maxx Div 7+25;
  y:=maxy Div 3+10; y1:=maxy-maxy Div 4;
  p.bufcolor:=lightgray;
  p.helpframecolor:=red; pos:=1;
  setfillstyle(solidfill,p.bufcolor);
  setcolor(p.helpframecolor);
  bar(x,y,x1,y1); rectangle(x,y,x1,y1); h_ch:=' ';
  x_:=x+5; y_:=y+10;
  settextstyle(smallfont,horizdir,5);
  outtextxy(x_,y_,'Esly nugno ');      inc(y_,10);
  outtextxy(x_,y_,'zagruzit ');        inc(y_,10);
  outtextxy(x_,y_,'buffer ');          inc(y_,10);
  outtextxy(x_,y_,'input name,');      inc(y_,10);
  outtextxy(x_,y_,'else input ');      inc(y_,10);
  outtextxy(x_,y_,'"not". ');          inc(y_,10);
  s1:=''; i:=0;
  While (ord(h_ch)<>13) And (i<8) Do Begin
        inc(i);
        h_ch:=readkey; inc(x_,7);
        If ord(h_ch)<>13 Then s1:=s1+h_ch;
        outtextxy(x_,y_,h_ch);
  End; inc(y_,10);
  outtextxy(x_,y_,s1); delay(5000); delay(5000); delay(5000);
  If s1<>'not' Then Begin
     s1:=s1+'.clc';
     assign(t,s1); reset(t);
     For i:=1 To 100 Do command[i]:='';
     i:=0;
     While Not eof(t) Do Begin
           inc(i);
           readln(t,s1);
           command[i]:=s1;
           reg.cformula(s1);
     End;
     close(t);
  End;
  p.bufcolor:=blue; p.helpframecolor:=blue;
  setfillstyle(solidfill,p.bufcolor);
  setcolor(p.helpframecolor);
  bar(x,y,x1,y1); rectangle(x,y,x1,y1); h_ch:=' ';

  NBPRG_I_reload_interf; { NBPRG GRAPHICAL INTERFACE RELOAD }
End;


Destructor calc_interf.done;
Begin
  p.restruct;
  build_body;
  p.done; reg.clear;

  { NBPRG GRAPHICAL INTERFACE REBUILDING. }
  { NBPRG_I_reload_interf; }

End;

(*-----------------------------------------*)
(*          ђ…ѓ€‘’ђ›  ЉЂ‹њЉ“‹џ’ЋђЂ         *)
(*-----------------------------------------*)
Procedure calc_register.clear;
Begin
  a:=0; b:=0; c:=0; d:=0;
  e:=0; f:=0; g:=0;
  ai:=0; bi:=0; ci:=0;
  formula:='';
End;

Procedure calc_register.cformula(s:String);
Begin
  If pos('set',s)<>0 Then cset(s);
  If pos('add',s)<>0 Then cadd(s);
  If pos('sub',s)<>0 Then csub(s);
  If pos('mul',s)<>0 Then cmul(s);
  If pos('mov',s)<>0 Then cmov(s);
  If pos('div',s)<>0 Then cdiv(s);

  If pos('ln',s)<>0 Then cln(s);
  If pos('sin',s)<>0 Then csin(s);
  If pos('cos',s)<>0 Then ccos(s);
  If pos('arctan',s)<>0 Then carctan(s);
  If pos('exp',s)<>0 Then cexp(s);

  If pos('sqrt',s)<>0 Then csqrt(s);
End;


{procedure calc_register.cset(s:string);}
{$I Inc\CalcWS\CSet.Inc }

{procedure calc_register.cadd(s:string);}
{$I Inc\CalcWS\CAdd.Inc }

{procedure calc_register.csub(s:string);}
{$I Inc\CalcWS\CSub.Inc }

{procedure calc_register.cmov(s:string);}
{$I Inc\CalcWS\CMov.Inc }

{procedure calc_register.cmul(s:string);}
{$I Inc\CalcWS\CMul.Inc }

{procedure calc_register.cdiv(s:string);}
{$I Inc\CalcWS\CDiv.Inc }

{procedure calc_register.cln(s:string);}
{$I Inc\CalcWS\CLn.Inc }

{procedure calc_register.csin(s:string);}
{$I Inc\CalcWS\CSin.Inc }

{procedure calc_register.ccos(s:string);}
{$I Inc\CalcWS\CCos.Inc }

{procedure calc_register.cexp(s:string);}
{$I Inc\CalcWS\CExp.Inc }

{procedure calc_register.carctan(s:string);}
{$I Inc\CalcWS\CATan.Inc }

{procedure calc_register.csqrt(s:string);}
{$I Inc\CalcWS\CSqrt.Inc }


End.