Сложение вычитание в обратном коде

program rgr;
uses crt,graph;
type
arr=array [1..15] of integer;
var
s:string;
l:word;
d:text;
 
 procedure title(s:string);
var
x:string;
begin
clrscr;
assign(d,s);
reset(d);
 while not eof(d) do
begin
readln(d,x);
writeln(x);
end;
close(d);
writeln;
writeln;
readln;
end;
 
 procedure risunok;
Var gd,gm:integer;
begin
clrscr;
detectgraph (gd,gm);
initgraph (gd,gm,'tp\7');
Line (60,150,60,450);
Line (60,150,240,150);
Line (60,450,240,450);
Line (240,150,240,450);
Line (60,150,240,60);
Line (240,150,390,60);
Line (240,60,390,60);
Line (390,60,390,350);
Line (390,350,240,450);
Line (82,140,255,140);
Line (255,140,255,440);
Line (90,180,150,180);
Line (150,180,150,240);
Line (150,240,90,240);
Line (90,240,90,180);
Line (120,180,120,210);
Line (90,240,120,210);
Line (120,210,150,210);
Line (90,270,150,270);
Line (150,270,150,330);
Line (150,330,90,330);
Line (90,330,90,270);
Line (90,330,120,300);
Line (120,270,120,300);
Line (120,300,150,300);
Line (90,360,150,360);
Line (150,360,150,420);
Line (150,420,90,420);
Line (90,420,90,360);
Line (120,360,120,390);
Line (120,390,90,420);
Line (120,390,150,390);
Line (180,330,180,450);
Line (180,330,240,330);
Line (180,390,185,390);
Line (255,175,390,93);
Line (270,185,380,117);
Line (330,150,330,175);
Line (255,240,390,150);
Line (255,300,390,210);
Line (255,360,390,270);
Line (255,420,390,330);
Readln
end;
 
 
 
 
 
{if ne 1 ili 0}
 function proverka1(x:string):boolean;
var
i,k:integer;
r:boolean;
begin
r:=true;
 if x[1]='-' then
begin
 for k:=2 to i do
 if not ((x[k]='0') or (x[k]='1')) then
r:=false
end
 else
begin
 for k:=1 to i do
 if not ((x[k]='0') or (x[k]='1')) then
r:=false;
end;
proverka1:=r;
end;
 
{razrad}
 function proverka2(a,b:integer; x,k:string):integer;
var
r:integer;
begin
 if a>b then
begin
 if x[1]='-' then r:=a
 else r:=a+1;
end
 else
begin
 if b>a then
begin
 if k[1]='-' then r:=b
 else r:=b+1;
end
 else
begin
 if (x[1]='-') and (k[1]='-') then r:=a
 else r:=a+1;
end;
end;
proverka2:=r;
end;
 
{massiv,obr}
 procedure proverka3 (var mas:arr; a:string; k:integer);
var len,i: integer;
begin
len:=length(a);
 if a[1]='-' then
begin
 for i:=1 to len-1 do
begin
 if a[len-i+1]='0' then mas[i]:=0
 else mas[i]:=1;
end;
 for i:=len to k-1 do mas[i]:=0;
mas[k]:=1;
 for i:=k downto 1 do
writeln(mas[i]);
end
 else
begin
 for i:=1 to len do
begin
 if a[len-i+1]='0' then mas[i]:=0
 else mas[i]:=1;
end;
 for i:=len+1 to k do mas[i]:=0;
 for i:=k downto 1 do
write(mas[i]);
end;
end;
 
{obr.k.,iz pramogo}
 procedure proverka4(var mas:arr;k:integer);
var i: integer;
begin
 if mas[k]=1 then
begin
 for i:=1 to k-1 do
begin
 if mas[i]=1 then mas[i]:=0
 else mas[i]:=1;
end;
end;
writeln;
 for i:=k downto 1 do
write(mas[i]);
end;
 
{slojenie 2 massiva, k-razrad, mas3}
 procedure summa (var m1,m2,m3:arr;k:integer);
var i, a, b: integer;
begin
a:=0; b:=0;
 for i:=1 to k do
begin
a:=m1[i]+m2[i]+b;
m3[i]:=a mod 2;
b:=a div 2;
end;
 if b=1 then m3[k+1]:=1;
 for i:=k downto 1 do write(m1[i]); writeln;
writeln('+');
 for i:=k downto 1 do write(m2[i]); writeln;
writeln('-----------');
 for i:=k+1 downto 1 do write(m3[i]); writeln;
writeln;
end;
 
{if mas3>k then ppc}
 procedure perenos(var m1,m2:arr;k:integer);
var i, a, b: integer;
begin
 if m1[k+1]=1 then
begin
writeln;
writeln;
writeln('Perenos');
a:=0; b:=0;
 for i:=k downto 1 do write(m1[i]);
writeln;
writeln('+');
writeln('1':k);
writeln('-------------');
 for i:=1 to k do
begin
a:=m1[i]+m2[i]+b;
m1[i]:=a mod 2;
b:=a div 2;
end;
 for i:=k downto 1 do write(m1[i]);
writeln;
end;
end;
 
{iz obr>=v pra and otvet in obr.por}
 procedure otvet(var mas:arr;k:integer);
var i: integer;
begin
 if mas[k]=0 then
begin
writeln;
 while mas[k]=0 do k:=k-1;
write('otvet= ');
 for i:=k downto 1 do write(mas[i]);
end
 else
begin
writeln;
k:=k-1;
 while mas[k]=0 do k:=k-1;
writeln;
write('Reshenie=-');
 for i:=k downto 1 do write(mas[i]);
end;
end;
 
{samo soboi ponyatno}
 procedure osnovnoe;
var
a,b: string[15];
dlina1, dlina2, k, n, i: integer;
r:boolean;
m1, m2, m3, mas:arr;
begin
 for i:=1 to 15 do
begin
m1[i]:=0;
m2[i]:=0;
m3[i]:=0;
mas[i]:=0;
end;
 for i:=2 to 15 do mas[i]:=0; mas[1]:=1;
clrscr;
write('Vvedite chislo #1 ');
readln(a);
writeln;
write('Vvedite chislo #2 ');
readln(b);
 if ((proverka1(a)) and (proverka1(b))) then
begin
dlina1:=length(a);
dlina2:=length(b);
k:=proverka2(dlina1,dlina2,a,b);
writeln;
writeln('Pryamoi kod');
proverka3(m1,a,k);
writeln;
proverka3(m2,b,k);
writeln;writeln;
writeln('Obratnii kod');
proverka4(m1,k);
proverka4(m2,k);
writeln;
writeln('Deistvie:');
writeln('1= +');
writeln('2= -');
readln(n);
 case n of
 
 1: begin
writeln;
writeln('delaem slojenie');
summa(m1,m2,m3,k);
 if ((m1[k]=1) and (m2[k]=1) and (m3[k]=0)) or ((m1[k]=0) and (m2[k]=0) and (m3[k]=1)) then
begin
m1[k+1]:=m1[k];
m2[k+1]:=m2[k];
k:=k+1;
writeln;
writeln('Perepolnenie');
summa(m1,m2,m3,k);
end;
perenos(m3,mas,k);
write('Pryamoi');
proverka4(m3,k);
otvet(m3,k);
end;
2:
begin
 for i:=1 to k do
begin
 if m2[i]=1 then m2[i]:=0
 else m2[i]:=1;
end;
end;
 else writeln('Ne pravilnoe deistvie');
end;
writeln;
summa(m1,m2,m3,k);
 if ((m1[k]=1)and(m2[k]=1)and(m3[k]=0))or((m1[k]=0)and(m2[k]=0)and(m3[k]=1)) then
begin
m1[k+1]:=m1[k];
m2[k+1]:=m2[k];
k:=k+1;
writeln;
writeln('Perenos');
summa(m1,m2,m3,k);
perenos(m3,mas,k);
write('Pramoi:');
proverka4(m3,k);
otvet(m3,k)
end
 else writeln('Ne verno vvedeno');
readln;
end;
end;
 
begin
clrscr;
s:='';
s:='E:\title.txt';
title(s);
 while l<>5 do
begin
clrscr;
writeln('Menu:');
writeln;
writeln('1.-Vipolnenie deistvii');
writeln('2.-Help');
writeln('3.-Primer');
writeln('4.-Risunok');
writeln('5.-Exit');
readln(l);
 case l of
1:osnovnoe;
2:begin
  s:='e:\help.txt';
  title(s);
  end;
3:begin
  s:='e:\primer.txt';
  title(s);
  end;
4:risunok;
end;
end;
end.