uses crt,dos,graph,mouse;
type
    mmm = record
        nx,ny,ox,oy : integer;
        lbut,rbut : boolean;
    end;
    ggg = record
        x1,y1,x2,y2 : integer;
    end;
    scrobj = object
           x1,y1,x2,y2 : integer;
           command : integer;
    end;
    stuff = ^scrobj;
    segment = array[0..127,0..479] of byte;
    pseg = ^segment;
const
cmopen = 1;
cmsave = 2;
cmbmp = 3;
cmcreate = 4;
cmundo = 5;
cmhelp = 6;
cmpencil = 7;
cmline = 8;
cmbox = 9;
cmboxf = 10;
cmcircle = 11;
cmcirclef = 12;
cmeraser = 13;
cmlevelup = 14;
cmleveldown = 15;

var
rv,rd,rv1,rv2,rv3,rv4,rd1,rd2,rd3,rd4 : integer;
rel : real;
bradd : longint;
dats : array[0..127,0..479] of byte;
tool : integer;
a,b,c,d : integer;
p,bs : pointer;
w : word;
mouseinfo : mmm;
graphinfo : ggg;
mf : file;
see : string;
level : integer;
objarray : array [1..15] of stuff;
trad,fundo : file;
qgrab : word;
grab : pointer;
cha : char;
pix : byte;

procedure initobject (xx1,yy1,xx2,yy2,rcommand : integer);
var ts : stuff;
begin
new(ts);
ts^.x1 := xx1;
ts^.x2 := xx2;
ts^.y1 := yy1;
ts^.y2 := yy2;
ts^.command := rcommand;
objarray[rcommand] := ts;
end;

procedure changecursor(tm : integer);

begin
     case tm of
     1 : assign(mf,'pencil.pcr');
     2 : assign(mf,'line.pcr');
     3 : assign(mf,'box.pcr');
     4 : assign(mf,'sbox.pcr');
     5 : assign(mf,'circle.pcr');
     6 : assign(mf,'scircle.pcr');
     7 : assign(mf,'eraser.pcr');
     end;
     reset(mf,1);
     blockread(mf,p^,w);
     close(mf);
end;

procedure levelup;
var
   ss : string;
begin
settextstyle(triplexfont,horizdir,1);
setusercharsize(1,2,1,2);
settextjustify(centertext,centertext);

inc(level);
if level > 14 then level := 14;
setcolor(white);
str(level-1,ss);
ss := 'Level ' + ss;
outtextxy(575,360,ss);
setcolor(level);
str(level,ss);
ss := 'Level ' + ss;
outtextxy(575,360,ss);
end;
procedure leveldown;
var
   ss : string;
begin
settextstyle(triplexfont,horizdir,1);
setusercharsize(1,2,1,2);
settextjustify(centertext,centertext);

dec(level);
if level < 1 then level := 1;
setcolor(white);
str(level+1,ss);
ss := 'Level ' + ss;
outtextxy(575,360,ss);
setcolor(level);
str(level,ss);
ss := 'Level ' + ss;
outtextxy(575,360,ss);
end;

procedure refresh;
var
   loo : integer;
begin
level := 0;
cleardevice;
setcolor(15);
line(512,0,512,480);
setfillstyle(solidfill,15);
floodfill(600,100,15);
setcolor(darkgray);
setfillstyle(solidfill,darkgray);
settextstyle(triplexfont,horizdir,1);
setusercharsize(1,2,1,2);
settextjustify(centertext,centertext);

for loo := 0 to 5 do
begin
     setcolor(black);
     bar3d(546,30*loo+10,606,30*loo+30,0,true);
     case loo of
     0 : outtextxy(576,30*loo+17,'Open');
     1 : outtextxy(576,30*loo+17,'Save');
     2 : outtextxy(576,30*loo+17,'BMP');
     3 : outtextxy(576,30*loo+17,'Create');
     4 : outtextxy(576,30*loo+17,'Undo');
     5 : outtextxy(576,30*loo+17,'Help');
     end;



     setcolor(black);

end;
setfillstyle(solidfill,lightgray);
bar(530,200,620,330);
setfillstyle(solidfill,darkgray);
for loo := 0 to 2 do
begin
bar3d(540,200+30*loo+10,570,230+loo*30,0,true);
changecursor((loo*2)+1);
putimage(548,200+30*loo+15,p^,xorput);
bar3d(580,200+30*loo+10,610,230+loo*30,0,true);

changecursor((loo*2)+2);
putimage(588,200+30*loo+15,p^,xorput);

end;
inc(loo);
changecursor((loo*2)+1);
bar3d(560,200+30*loo+10,590,230+loo*30,0,true);
putimage(568,200+30*loo+15,p^,xorput);
levelup;
loo := 6;
settextstyle(triplexfont,vertdir,1);
setusercharsize(1,2,1,2);
settextjustify(centertext,centertext);

setcolor(black);
bar3d(540,200+30*loo+10,570,230+loo*30,0,true);
outtextxy(550,200+30*loo+18,'>');
bar3d(580,200+30*loo+10,610,230+loo*30,0,true);
outtextxy(590,200+30*loo+19,'<');
settextstyle(triplexfont,horizdir,1);
setusercharsize(1,3,1,3);
settextjustify(centertext,centertext);
setcolor(BLUE);
outtextxy(575,440,'StereoMaker');
setcolor(red);
setcolor(green);
outtextxy(575,460,'By Alan Marble');
end;

function gmoox(tt,ttt : integer) : byte;
var
   tvar : real;
   rz : byte;
begin
     tvar := tt + (ttt * 512);
     writeln(tt+ttt*512,' ',tt,' ',ttt);
     seek(fundo,tt+ttt*512);
     blockread(fundo,rz,1);
     gmoox := rz;
end;

procedure initscreen;
var
   comcount : integer;
   loo : integer;
begin
comcount := 1;
level := 0;
cleardevice;
setcolor(15);
line(512,0,512,480);
setfillstyle(solidfill,15);
floodfill(600,100,15);
setcolor(darkgray);
setfillstyle(solidfill,darkgray);
settextstyle(triplexfont,horizdir,1);
setusercharsize(1,2,1,2);
settextjustify(centertext,centertext);

for loo := 0 to 5 do
begin
     setcolor(black);
     bar3d(546,30*loo+10,606,30*loo+30,0,true);
     case loo of
     0 : begin
              outtextxy(576,30*loo+17,'Open');
              initobject(546,30*loo+10,606,30*loo+30,comcount);
              inc(comcount);
         end;
     1 : begin
              outtextxy(576,30*loo+17,'Save');
              initobject(546,30*loo+10,606,30*loo+30,comcount);
              inc(comcount);
         end;
     2 : begin
              outtextxy(576,30*loo+17,'BMP');
              initobject(546,30*loo+10,606,30*loo+30,comcount);
              inc(comcount);
         end;
     3 : begin
              outtextxy(576,30*loo+17,'Create');
              initobject(546,30*loo+10,606,30*loo+30,comcount);
              inc(comcount);
         end;
     4 : begin
              outtextxy(576,30*loo+17,'Undo');
              initobject(546,30*loo+10,606,30*loo+30,comcount);
              inc(comcount);
         end;
     5 : begin
              outtextxy(576,30*loo+17,'Help');
              initobject(546,30*loo+10,606,30*loo+30,comcount);
              inc(comcount);
         end;
     end;



     setcolor(black);

end;
setfillstyle(solidfill,lightgray);
bar(530,200,620,330);
setfillstyle(solidfill,darkgray);
for loo := 0 to 2 do
begin
bar3d(540,200+30*loo+10,570,230+loo*30,0,true);
changecursor((loo*2)+1);
initobject(540,200+30*loo+10,570,230+loo*30,comcount);
inc(comcount);

putimage(548,200+30*loo+15,p^,xorput);
bar3d(580,200+30*loo+10,610,230+loo*30,0,true);
initobject(580,200+30*loo+10,610,230+loo*30,comcount);
inc(comcount);
changecursor((loo*2)+2);
putimage(588,200+30*loo+15,p^,xorput);

end;
inc(loo);
changecursor((loo*2)+1);
bar3d(560,200+30*loo+10,590,230+loo*30,0,true);
initobject(560,200+30*loo+10,590,230+loo*30,comcount);
inc(comcount);
putimage(568,200+30*loo+15,p^,xorput);
levelup;
loo := 6;
settextstyle(triplexfont,vertdir,1);
setusercharsize(1,2,1,2);
settextjustify(centertext,centertext);

setcolor(black);
bar3d(540,200+30*loo+10,570,230+loo*30,0,true);
initobject(540,200+30*loo+10,570,230+loo*30,comcount);
inc(comcount);
outtextxy(550,200+30*loo+18,'>');
bar3d(580,200+30*loo+10,610,230+loo*30,0,true);
initobject(580,200+30*loo+10,610,230+loo*30,comcount);

outtextxy(590,200+30*loo+19,'<');
settextstyle(triplexfont,horizdir,1);
setusercharsize(1,3,1,3);
settextjustify(centertext,centertext);
setcolor(BLUE);
outtextxy(575,440,'StereoMaker');
setcolor(red);
setcolor(green);
outtextxy(575,460,'By Alan Marble');
end;


procedure initmouse;
begin
w := imagesize(0,0,10,10);
getmem(p,w);
getmem(bs,w);
getimage(0,0,10,10,bs^);
assign(mf,'pencil.pcr');
reset(mf,1);
blockread(mf,p^,w);
close(mf);
resetmouse;
mousewindow(0,0,255,255);

mouseinfo.nx :=0;
mouseinfo.ny :=0;
mouseinfo.ox :=0;
mouseinfo.oy :=0;
end;
procedure drawmed(xx,yy : integer);
begin
mouseinfo.nx := trunc(getmousex / 255 * 640);
mouseinfo.ny := trunc(getmousey / 255 * 480);
with mouseinfo do
begin
line(xx,yy,ox,oy);
line(xx,yy,nx,ny);
ox := nx;
oy := ny;
end;
end;

procedure checkmouse;
begin
mouseinfo.nx := trunc(getmousex / 255 * 640);
mouseinfo.ny := trunc(getmousey / 255 * 480);
if (mouseinfo.nx <> mouseinfo.ox) or (mouseinfo.ny <> mouseinfo.oy) then
with mouseinfo do
begin
     putimage(ox,oy,bs^,normalput);
     getimage(nx,ny,nx+10,ny+10,bs^);
     putimage(nx,ny,p^,xorput);
     ox := nx;
     oy := ny;
end;
end;
procedure pencil;
begin
     changecursor(1);
     tool := cmpencil;
end;
procedure pline;
begin
     changecursor(2);
     tool := cmline;
end;
procedure box;
begin
     changecursor(3);
     tool := cmbox;
end;
procedure boxf;
begin
     changecursor(4);
     tool := cmboxf;
end;
procedure pcircle;
begin
     changecursor(5);
     tool := cmcircle;
end;
procedure circlef;
begin
     changecursor(6);
     tool := cmcirclef;
end;
procedure eraser;
begin
     changecursor(7);
     tool := cmeraser;
end;

procedure route(x,y : integer);
var
rcommand : integer;
v : integer;
lx,ly,tlx,tly : integer;
ard : integer;
begin
rcommand := 0;
for v := 1 to 15 do
if ((x > objarray[v]^.x1) and (x < objarray[v]^.x2) and
    (y > objarray[v]^.y1) and (y < objarray[v]^.y2)) then
     rcommand := objarray[v]^.command;
case rcommand of
cmpencil : pencil;
cmline : pline;
cmbox : box;
cmboxf : boxf;
cmcircle : pcircle;
cmcirclef : circlef;
cmeraser : eraser;
cmlevelup : begin
            levelup;
            repeat until not(leftpressed);
            end;
cmleveldown : begin
              leveldown;
              repeat until not(leftpressed);
              end;
cmundo : begin
              seek(fundo,0);
              for ard := 0 to 3 do
              begin

                   blockread(fundo,grab^,qgrab);
                   putimage(ard*128,0,grab^,normalput);
              end;
         end;

cmcreate : begin
                settextstyle(triplexfont,horizdir,1);
setusercharsize(1,3,1,3);

                putimage(mouseinfo.ox,mouseinfo.oy,bs^,normalput);
                seek(fundo,0);
                for ard := 0 to 3 do
                begin
                getimage(ard*128,0,ard*128+127,479,grab^);
                blockwrite(fundo,grab^,qgrab);
                end;
                setcolor(black);
                setfillstyle(solidfill,15);
                bar(100,100,200,200);
                settextjustify(lefttext,toptext);
                outtextxy(110,110,'Sure? [y,n]');
                repeat
                      cha := readkey;
                      cha := upcase(cha);
                until (cha = 'Y') or (cha = 'N');
                outtextxy(180,110,cha);
                if cha = 'Y' then
                begin
                outtextxy(110,130,'Planar or topo?');
                outtextxy(110,140,'[p,t]');

                repeat
                      cha := readkey;
                      cha := upcase(cha);
                until (cha = 'P') or (cha = 'T');
                outtextxy(140,140,cha);
                end;
                seek(fundo,0);
              for ard := 0 to 3 do
              begin

                   blockread(fundo,grab^,qgrab);
                   putimage(ard*128,0,grab^,normalput);
              end;

end;
end;
if x < 512 then
begin
putimage(mouseinfo.ox,mouseinfo.oy,bs^,normalput);
seek(fundo,0);
for ard := 0 to 3 do
begin
getimage(ard*128,0,ard*128+127,479,grab^);
blockwrite(fundo,grab^,qgrab);
end;
if (tool <> cmeraser) and (tool <> cmpencil) then
begin
lx := mouseinfo.ox;
ly := mouseinfo.oy;
setcolor(15);
setwritemode(xorput);
while leftpressed do
drawmed(lx,ly);
line(lx,ly,mouseinfo.ox,mouseinfo.oy);
setwritemode(normalput);
end;
if tool = cmpencil then
begin
setcolor(level);
moveto(mouseinfo.ox,mouseinfo.oy);
while leftpressed do
begin
mouseinfo.nx := trunc(getmousex / 255 * 640);
mouseinfo.ny := trunc(getmousey / 255 * 480);
lineto(mouseinfo.nx,mouseinfo.ny);
with mouseinfo do
begin
ox := nx;
oy := ny;
end;
end;
end;
if tool = cmeraser then
begin
setcolor(black);
setfillstyle(solidfill,black);
moveto(mouseinfo.ox,mouseinfo.oy);
while leftpressed do
begin
mouseinfo.nx := trunc(getmousex / 255 * 640);
mouseinfo.ny := trunc(getmousey / 255 * 480);
fillellipse(mouseinfo.ox,mouseinfo.oy,2,2);
with mouseinfo do
begin
ox := nx;
oy := ny;
end;
end;
end;
setcolor(level);
setfillstyle(solidfill,level);
case tool of
cmcircle : ellipse(lx,ly,0,360,abs(lx-mouseinfo.ox),abs(ly-mouseinfo.oy));
cmcirclef : fillellipse(lx,ly,abs(lx-mouseinfo.ox),abs(ly-mouseinfo.oy));
cmbox : begin
        if lx > mouseinfo.ox then
             begin
             tlx := lx;
             lx := mouseinfo.ox;
             end;
        if lx < mouseinfo.ox then tlx := mouseinfo.ox;
        if ly > mouseinfo.oy then
             begin
             tly := ly;
             ly := mouseinfo.oy;
             end;
        if ly < mouseinfo.oy then tly := mouseinfo.oy;
        rectangle(lx,ly,tlx,tly);
        end;
cmboxf : begin
        if lx > mouseinfo.ox then
             begin
             tlx := lx;
             lx := mouseinfo.ox;
             end;
        if lx < mouseinfo.ox then tlx := mouseinfo.ox;
        if ly > mouseinfo.oy then
             begin
             tly := ly;
             ly := mouseinfo.oy;
             end;
        if ly < mouseinfo.oy then tly := mouseinfo.oy;
        bar(lx,ly,tlx,tly);
        end;
cmline : begin
        moveto(lx,ly);
        lineto(mouseinfo.ox,mouseinfo.oy);
        end;


end;
with mouseinfo do
begin
getimage(nx,ny,nx+10,ny+10,bs^);
putimage(nx,ny,p^,xorput);
end;

end;

end;

begin

tool := cmeraser;
a := vga;
b := vgahi;
initgraph(a,b,'c:\tp\bgi');
assign(fundo,'$ndo$.$$$');
rewrite(fundo,1);
close(fundo);
reset(fundo,1);
qgrab := imagesize(0,0,127,479);
getmem(grab,qgrab);

cleardevice;
initmouse;

initscreen;
repeat
checkmouse;
if rightpressed then floodfill(mouseinfo.nx,mouseinfo.ny,level);
if leftpressed then route(mouseinfo.nx,mouseinfo.ny);
until (cha = 'P') or (cha = 'T');
close(fundo);
freemem(p,w);
freemem(bs,w);
freemem(grab,qgrab);

assign(fundo,'rnmi.rni');
rewrite(fundo,1);
if cha = 'P' then
begin
     for c := 0 to 3 do
     begin
     for a := 0 to 127 do
     for b := 0 to 479 do
     dats[a,b] := getpixel(a+(c*128),b);
     blockwrite(fundo,dats,sizeof(dats));
     end;
end;

if cha = 'T' then
begin
     bradd := 0;
     settextstyle(triplexfont,horizdir,1);
setusercharsize(1,2,1,2);
settextjustify(centertext,centertext);

     for c := 0 to 3 do
     begin
     for a := 0 to 127 do
     for b := 0 to 479 do
     dats[a,b] := getpixel(a+(c*128),b);
     blockwrite(fundo,dats,sizeof(dats));
     end;
     close(fundo);
     reset(fundo,1);
     assign(trad,'renn.nn');
     rewrite(trad,1);
     closegraph;
     restorecrtmode;
     for c := 0 to 3 do
     begin
     for a := 0 to 127 do
     for b := 0 to 479 do
     begin
     rd1 := a+(c*128);
     rd2 := a+(c*128);
     rd3 := b;
     rd4 := b;
     while (gmoox(rd1,b) = 0) and (rd1 < 512) do inc(rd1);
     while (gmoox(rd2,b) = 0) and (rd2 >= 1) do dec(rd2);
     while (gmoox(a+(c*128),rd3) = 0) and (rd3 < 480) do inc(rd3);
     while (gmoox(a+(c*128),rd4) = 0) and (rd4 >= 1) do dec(rd4);
     rv1 := gmoox(rd1,b)*10;
     rv2 := gmoox(rd2,b)*10;
     rv3 := gmoox(a+(c*128),rd3)*10;
     rv4 := gmoox(a+(c*128),rd4)*10;
     rd1 := abs(a+(c*128)-rd1);
     rd2 := abs(a+(c*128)-rd2);
     rd3 := abs(b-rd3);
     rd4 := abs(b-rd4);
     rv1 := rv1 * rd2;
     rv2 := rv2 * rd1;
     rv := (rv1+rv2) div (rd1+rd2);
     rv3 := rv3 * rd4;
     rv4 := rv4 * rd3;
     rd := (rv3+rv4) div (rd3+rd4);
     rv := (rv+rd) div 2;
     dats[a,b] := rv;
     rv := (a+(c*128)) + (b * 512);
     rel := rv / (480*512);
     rel := rel * 100;
     rv := trunc(rel);
     inc(bradd);
     setcolor(white);
     outtextxy(575,360,'ллллл');
     setcolor(black);
     rel := bradd / (480*512);
     rel := rel * 100;
     rv := trunc(rel);
     str(rv,see);
     outtextxy(575,360,see);

     end;
     blockwrite(trad,dats,sizeof(dats));
     end;
close(fundo);
close(trad);
assign(fundo,'renn.nn');
reset(fundo,1);
end;
close(fundo);

reset(fundo,1);
cleardevice;
for a := 0 to 127 do
for b := 0 to 479 do
putpixel(a,b,trunc(random * 2));
getmem(grab,qgrab);
getimage(0,0,127,479,grab^);
for a := 1 to 4 do
putimage(a*128,0,grab^,normalput);

for a := 1 to 4 do
begin
blockread(fundo,dats,sizeof(dats));
for b := 0 to 127 do
for c := 0 to 479 do
begin
pix := getpixel(b+((a-1)*128),c);
if cha = 'P' then putpixel(b+(a*128)-(dats[b,c]*10),c,pix)
   else putpixel(b+(a*128)+dats[b,c],c,pix);
end;
getimage(a*128,0,a*128+127,479,grab^);
for pix := a+1 to 4 do
putimage(a*128,0,grab^,normalput);
end;
readln;
end.