pariuri.pas

This ar the basic programs that i did in highschool. From very simple to medium programs. From array

program pariuri_sportive;

 var f,ft:text;
    n,i,j,k,l,c,d,e,g,p:byte;
    o,q,r,s,t:byte;
    a:array[1..10,1..7,1..7,1..7] of shortint;
    v:array[1..20] of integer;

BEGIN
l:=0;
k:=1;
i:=1;
assign(f,'fpariu.txt');
reset(f);
assign(ft,'ftest.txt');
reset(ft);
write(ft);
while not eof(f) do
                 begin
                 if (j=7) and (k=7) and (l=7) then begin
                                                   inc(i);
                                                   l:=0;
                                                   k:=1;
                                                   end;

                 if(j=7) and (l=7) then begin
                                        inc(k);
                                        l:=0;
                                        end;
                 inc(l);
                 j:=0;
                 while not eoln(f) do
                                   begin
                                   inc(j);
                                   read( f,a[i,j,k,l]);
                                   {write(a[i,j,k,l]);}
                                   end;
                 readln(f);
                 end;
close (f);
close (ft);
readln;
n:=i;
writeln('Nr de etape pana acum ',n);


writeln('Meciuri cate 3 consecutive cu acelasi rezultat(de egalitate) ');
begin
for j:=1 to 7 do
 for k:=1 to 7 do
  for l:=1 to 7 do
            begin
            i:=0;
            repeat
            inc(i);
            if (a[i,j,k,l]=a[i+1,j,k,l]) and (a[i,j,k,l]=a[i+2,j,k,l]) and (a[i,j,k,l]=0) then write(j,k,l,' ');

            until i=n-2;
            end;
end;


writeln;
writeln('Meciuri cate 3 consecutive cu acelasi rezultat(de victorie) ');
begin
for j:=1 to 7 do
 for k:=1 to 7 do
  for l:=1 to 7 do
            begin
            i:=0;
            repeat
            inc(i);
            if (a[i,j,k,l]=a[i+1,j,k,l]) and (a[i,j,k,l]=a[i+2,j,k,l]) and (a[i,j,k,l]=1) then write(j,k,l,' ');

            until i=n-2;
            end;
end;


writeln;
writeln('Meciuri cate 5 consecutive cu acelasi rezultat(de egalitate) ');
begin
for j:=1 to 7 do
 for k:=1 to 7 do
  for l:=1 to 7 do
            begin
            i:=0;
            repeat
            inc(i);
            if (a[i,j,k,l]=a[i+1,j,k,l]) and (a[i,j,k,l]=a[i+2,j,k,l])
               and (a[i,j,k,l]=a[i+3,j,k,l]) and (a[i,j,k,l]=a[i+4,j,k,l])
               and (a[i,j,k,l]=0) then write(j,k,l,' ');

            until i=n-4;
            end;
end;



writeln;
writeln('Meciuri cate 5 consecutive cu acelasi rezultat(de victorie) ');
begin
for j:=1 to 7 do
 for k:=1 to 7 do
  for l:=1 to 7 do
            begin
            i:=0;
            repeat
            inc(i);
            if (a[i,j,k,l]=a[i+1,j,k,l]) and (a[i,j,k,l]=a[i+2,j,k,l])
               and (a[i,j,k,l]=a[i+3,j,k,l]) and (a[i,j,k,l]=a[i+4,j,k,l])
               and (a[i,j,k,l]=1) then write(j,k,l,' ');

            until i=n-4;
            end;
end;


writeln;
writeln('Meciuri cate 5 aleatori cu acelasi rezultat de egalitate');
begin
for j:=1 to 7 do
 for k:=1 to 7 do
  for l:=1 to 7 do
           begin
           p:=0;
           for i:=1 to n-4 do
               begin
               if (a[i,j,k,l]=0) then inc(p);

               for c:=(i+1) to n-3 do
                   begin
                   if a[c,j,k,l]=0 then inc(p);

                   for d:=(c+1) to n-2 do
                       begin
                       if a[d,j,k,l]=0 then inc(p);

                       for e:=(d+1) to n-1 do
                           begin
                           if a[e,j,k,l]=0 then inc(p);

                           for g:=(e+1) to n do
                               begin
                               if a[g,j,k,l]=0 then inc(p);

                               end;
                           end;
                       end;
                   end;
                                begin  if p=5 then write(j,k,l,' ');
                                p:=0;
                                end;
               end;
           end;
writeln;
end;


writeln('Meciuri cate 5 aleatori cu acelasi rezultat (de victorie)');
begin
for j:=1 to 7 do
 for k:=1 to 7 do
  for l:=1 to 7 do
           begin
           p:=0;
           for i:=1 to n-4 do
               begin
               if (a[i,j,k,l]=1) then inc(p);
               for c:=(i+1) to n-3 do
                   begin
                   if a[c,j,k,l]=1 then inc(p);
                   for d:=(c+1) to n-2 do
                       begin
                       if a[d,j,k,l]=1 then inc(p);
                       for e:=(d+1) to n-1 do
                           begin
                           if a[e,j,k,l]=1 then inc(p);
                           for g:=(e+1) to n do
                               begin
                               if a[g,j,k,l]=1 then inc(p);
                               end;
                           end;
                       end;
                   end;
                                begin  if p=5 then write(j,k,l,' ');
                                p:=0;
                                end;
               end;
           end;
writeln;
end;


writeln('Meciuri cate 10 aleatori cu acelasi rezultat (de victorie)');
begin
for j:=1 to 7 do
 for k:=1 to 7 do
  for l:=1 to 7 do
           begin
           p:=0;
           for i:=1 to n-9 do
               begin
               if (a[i,j,k,l]=1) then inc(p);
               for c:=(i+1) to n-8 do
                   begin
                   if a[c,j,k,l]=1 then inc(p);
                   for d:=(c+1) to n-7 do
                       begin
                       if a[d,j,k,l]=1 then inc(p);
                       for e:=(d+1) to n-6 do
                           begin
                           if a[e,j,k,l]=1 then inc(p);
                           for g:=(e+1) to n-5 do
                               begin
                               if a[g,j,k,l]=1 then inc(p);
                               for o:=1 to n-4 do
                                   begin
                                   if (a[o,j,k,l]=1) then inc(p);
                                   for q:=(o+1) to n-3 do
                                       begin
                                       if a[q,j,k,l]=1 then inc(p);
                                       for r:=(q+1) to n-2 do
                                           begin
                                           if a[r,j,k,l]=1 then inc(p);
                                           for s:=(r+1) to n-1 do
                                               begin
                                               if a[s,j,k,l]=1 then inc(p);
                                               for t:=(s+1) to n do
                                                   begin
                                                   if a[t,j,k,l]=1 then inc(p);
                                                   end;
                                               end;
                                           end;
                                       end;
                                   end;
                               end;
                           end;
                       end;
                   end;
               end;

                      begin  if p=10 then write(j,k,l,' ');
                      p:=0;
                      end;

           end;
writeln;
end;


writeln('Meciuri cate 10 aleatori cu acelasi rezultat (de egalitate)');
begin
for j:=1 to 7 do
 for k:=1 to 7 do
  for l:=1 to 7 do
           begin
           p:=0;
           for i:=1 to n-9 do
               begin
               if (a[i,j,k,l]=0) then inc(p);
               for c:=(i+1) to n-8 do
                   begin
                   if a[c,j,k,l]=0 then inc(p);
                   for d:=(c+1) to n-7 do
                       begin
                       if a[d,j,k,l]=0 then inc(p);
                       for e:=(d+1) to n-6 do
                           begin
                           if a[e,j,k,l]=0 then inc(p);
                           for g:=(e+1) to n-5 do
                               begin
                               if a[g,j,k,l]=0 then inc(p);
                               for o:=1 to n-4 do
                                   begin
                                   if (a[o,j,k,l]=0) then inc(p);
                                   for q:=(o+1) to n-3 do
                                       begin
                                       if a[q,j,k,l]=0 then inc(p);
                                       for r:=(q+1) to n-2 do
                                           begin
                                           if a[r,j,k,l]=0 then inc(p);
                                           for s:=(r+1) to n-1 do
                                               begin
                                               if a[s,j,k,l]=0 then inc(p);
                                               for t:=(s+1) to n do
                                                   begin
                                                   if a[t,j,k,l]=0 then inc(p);
                                                   end;
                                               end;
                                           end;
                                       end;
                                   end;
                               end;
                           end;
                       end;
                   end;
               end;

                      begin  if p=10 then write(j,k,l,' ');
                      p:=0;
                      end;

           end;
writeln;
end;



END.