uses crt, dos;
CONST VGA = $a000;

VAR loop1,barvaR, barvaRa, barvaGa, barvaBa,barvaRb, barvaGb, barvaBb : integer;
    Pall : Array [0..255, 1..3] of byte;
    Polje : array [1..318, 1..198] of shortint;
    f,g: text;
    izhod:integer;
    ch: char;
{----------------------------------------------------------------------------}
Procedure SetMCGA; assembler;
asm
  mov   ax,0013h
  int   10h
end;
{----------------------------------------------------------------------------}
Procedure SetText; assembler;
asm
  mov   ax,0003h
  int   10h
end;
{----------------------------------------------------------------------------}
Procedure Putpixel (X,Y : Integer; Col : Byte);
BEGIN
  Mem[VGA:X+(Y*320)]:=Col;
END;
{----------------------------------------------------------------------------}
Function Getpixel (X,Y : Integer) : byte;
BEGIN
  Getpixel := Mem[VGA:X+(Y*320)];
END;
{----------------------------------------------------------------------------}
Procedure Pal(ColorNo : Byte; R,G,B : Byte);
Begin
   Port[$3c8] := ColorNo;
   Port[$3c9] := R;
   Port[$3c9] := G;
   Port[$3c9] := B;
End;
{----------------------------------------------------------------------------}
procedure dolocitev_barv;
var st: integer;

begin
  writeln('Izberi çtevilko barvne kombinacije ');
  writeln(' ');
  writeln(' ');
  writeln('stev.               barva ozadja              barva crt');
  writeln(' ');
  writeln('1.)                     crna                     bela');
  writeln('2.)                     rdeca                    sv. modra');
  writeln('3.)                     zelena                   violicna');
  writeln('4.)                     modra                    sv. zelena');
  writeln('5.)                     sv. modra                rdeca');
  writeln('6.)                     violicna                 zelena');
  writeln('7.)                     sv. zelena               modra');
  writeln('8.)                     rdeca                    zelena');
  writeln('9.)                     zelena                   modra');
  writeln('10.)                    modra                    rdeca');
  writeln('11.)                    rdeca                    modra');
  writeln('12.)                    zelena                   rdeca');
  writeln('13.)                    modra                    zelena');
  writeln('14.)                    bela                     crna');
  writeln(' ');
  write('Izberi stevilko in pritisni enter:  ');
  read(st);


  if st=1 then begin
barvaRa:=1;barvaGa:=1;barvaBa:=1;barvaRb:=0;barvaGb:=0;barvaBb:=0; end
  else if st=2 then begin
barvaRa:=0;barvaGa:=1;barvaBa:=1;barvaRb:=1;barvaGb:=0;barvaBb:=0;end
  else if st=3 then begin
barvaRa:=1;barvaGa:=0;barvaBa:=1;barvaRb:=0;barvaGb:=1;barvaBb:=0;end
  else if st=4 then begin
barvaRa:=1;barvaGa:=1;barvaBa:=0;barvaRb:=0;barvaGb:=0;barvaBb:=1;end
  else if st=5 then begin
barvaRa:=1;barvaGa:=0;barvaBa:=0;barvaRb:=0;barvaGb:=1;barvaBb:=1;end
  else if st=6 then begin
barvaRa:=0;barvaGa:=1;barvaBa:=0;barvaRb:=1;barvaGb:=0;barvaBb:=1;end
  else if st=7 then begin
barvaRa:=0;barvaGa:=0;barvaBa:=1;barvaRb:=1;barvaGb:=1;barvaBb:=0;end
  else if st=8 then begin
barvaRa:=0;barvaGa:=1;barvaBa:=0;barvaRb:=1;barvaGb:=0;barvaBb:=0;end
  else if st=9 then begin
barvaRa:=0;barvaGa:=0;barvaBa:=1;barvaRb:=0;barvaGb:=1;barvaBb:=0;end
  else if st=10 then begin
barvaRa:=1;barvaGa:=0;barvaBa:=0;barvaRb:=0;barvaGb:=0;barvaBb:=1;end
  else if st=11 then begin
barvaRa:=0;barvaGa:=0;barvaBa:=1;barvaRb:=1;barvaGb:=0;barvaBb:=0;end
  else if st=12 then begin
barvaRa:=1;barvaGa:=0;barvaBa:=0;barvaRb:=0;barvaGb:=1;barvaBb:=0;end
  else if st=13 then begin
barvaRa:=0;barvaGa:=1;barvaBa:=0;barvaRb:=0;barvaGb:=0;barvaBb:=1;end
  else if st=14 then begin
barvaRa:=0;barvaGa:=0;barvaBa:=0;barvaRb:=1;barvaGb:=1;barvaBb:=1;end
  else if st>14 then izhod:=1;
end;
{----------------------------------------------------------------------------}
PROCEDURE Circle(centerX, centerY, R, Col : INTEGER) ;

VAR x,y,a,xpos,ypos, mypos : INTEGER ;
label 1;

BEGIN
x:= 0 ; y := R ; a := 3-2*R ;

1:
  xpos := x+centerX ; ypos := y+centerY ; mypos := -y+centerY ;
  putpixel(xpos, ypos,Col) ; (*  x  y *)
  putpixel(xpos,mypos,Col) ; (*  x -y *)
  xpos := -x+centerX ;
  putpixel(xpos, ypos,Col) ; (* -x  y *)
  putpixel(xpos,mypos,Col) ; (* -x -y *)

  xpos := y+centerX ; ypos := x+centerY ; mypos := -x+centerY ;
  putpixel(xpos, ypos,Col) ; (*  y  x *)
  putpixel(xpos,mypos,Col) ; (*  y -x *)
  xpos := -y+centerX ;
  putpixel(xpos, ypos,Col) ; (* -y  x *)
  putpixel(xpos,mypos,Col) ; (* -y -x *)

  if a<0 then
    a:=a+4*x+6
  else
    begin
      a:=a+4*(x-y)+10;
      y:=y-1;
    end;
  x:=x+1;
  if x<=y then goto 1
END;
{----------------------------------------------------------------------------}
Procedure Line(x1, y1, x2, y2, Col : integer);
var i, deltax, deltay, numpixels,
    d, dinc1, dinc2,
    x, xinc1, xinc2,
    y, yinc1, yinc2 : integer;
begin

  deltax := abs(x2 - x1);
  deltay := abs(y2 - y1);

  if deltax >= deltay then
    begin

      numpixels := deltax + 1;
      d := (2 * deltay) - deltax;
      dinc1 := deltay * 2;
      dinc2 := (deltay - deltax) * 2;
      xinc1 := 1;
      xinc2 := 1;
      yinc1 := 0;
      yinc2 := 1;
    end
  else
    begin

      numpixels := deltay + 1;
      d := (2 * deltax) - deltay;
      dinc1 := deltax * 2;
      dinc2 := (deltax - deltay) * 2;
      xinc1 := 0;
      xinc2 := 1;
      yinc1 := 1;
      yinc2 := 1;
    end;

  if x1 > x2 then
    begin
      xinc1 := - xinc1;
      xinc2 := - xinc2;
    end;
  if y1 > y2 then
    begin
      yinc1 := - yinc1;
      yinc2 := - yinc2;
    end;

  x := x1;
  y := y1;

  for i := 1 to numpixels do
    begin
      PutPixel(x, y, Col);
      if d < 0 then
        begin
          d := d + dinc1;
          x := x + xinc1;
          y := y + yinc1;
        end
      else
        begin
          d := d + dinc2;
          x := x + xinc2;
          y := y + yinc2;
        end;
    end;
end;
{----------------------------------------------------------------------------}
Procedure dat_1(x,col:integer);
begin
  IF x=318 THEN
    begin
      write(f,pall[col,1]);
      write(f,' ');
      write(f,pall[col,2]);
      write(f,' ');
      write(f,pall[col,3]);
      writeln(f,' ');
    end
  else
    begin
      write(f,pall[col,1]);
      write(f,' ');
      write(f,pall[col,2]);
      write(f,' ');
      write(f,pall[col,3]);
      write(f,' ');
    end;
end;
{----------------------------------------------------------------------------}
Procedure dat_2(x,col: integer);
begin
  IF x=318 THEN
    begin
      write(g,pall[col,1]);
      write(g,' ');
      write(g,pall[col,2]);
      write(g,' ');
      write(g,pall[col,3]);
      writeln(g,' ');
    end
  else
    begin
      write(g,pall[col,1]);
      write(g,' ');
      write(g,pall[col,2]);
      write(g,' ');
      write(g,pall[col,3]);
      write(g,' ');
    end;
end;
{----------------------------------------------------------------------------}
Procedure izrisi_filtrirane_podatke;
var x,y:integer;                      
begin                                       
  FOR y := 1 TO 198 DO
    begin
      FOR x := 1 TO 318 DO
        begin
          putpixel(x, y, polje[x,y]);
        end;
    end;
end;
{----------------------------------------------------------------------------}
Procedure filter;
VAR x, y : word;
var Col:integer;
BEGIN
  FOR y := 1 TO 198 DO
    begin
      FOR x := 1 TO 318 DO
        begin
          dat_1(x,getpixel(x, y));
          Col:=(Getpixel(x-1, y-1)+Getpixel(x, y-1)+Getpixel(x+1, y-1)+
            Getpixel(x-1, y)+Getpixel(x, y)+Getpixel(x+1, y)+
            Getpixel(x-1, y+1)+Getpixel(x, y+1)+Getpixel(x+1, y+1)) div 9;
          Polje[x, y]:= Col;
          dat_2(x, col);
        end;
    end;
END;
{----------------------------------------------------------------------------}
BEGIN
  clrscr;
  izhod:=0;
  assign(f,'pod_1.ppm');
  assign(g,'pod_filt.ppm');
  rewrite(f);
  rewrite(g);
  writeln(f, 'P3');
  writeln(f,'318  198');
  writeln(f,'64');
  writeln(f,' ');
  writeln(g, 'P3');
  writeln(g,'318  198');
  writeln(g,'64');
  writeln(g,' ');

  dolocitev_barv;
  if (izhod=1) then exit;
  setmcga;

  For Loop1 := 0 to 63 do BEGIN
    Pall[Loop1, 1] := loop1*barvaRa + (63-loop1)*barvaRb;    {rdeca}
    Pall[Loop1, 2] := loop1*barvaGa + (63-loop1)*barvaGb;    {zelena}
    Pall[Loop1, 3] := loop1*barvaBa + (63-loop1)*barvaBb;    {modra}
  END;

  For loop1 := 0 to 63 do
    pal(loop1, pall[loop1, 1], pall[loop1, 2], pall[loop1, 3]);


  circle(160, 100, 90, 63);
  line(160, 5, 160, 195, 63);
  line(10, 100, 308, 100, 63);
  line(10, 20, 308, 160, 63);

  filter;
  izrisi_filtrirane_podatke;
  ch:=Readkey;

  SetText;
  close(f);
  close(g);
END.