uses crt, memory;


var
p,m,n:word;
opacity, more_red, m_comp, comp1,comp2:integer;
col,red,green,blue:byte;


procedure colors0(seg_dpal1:word);{mode 0 color scheme}
begin
for opacity:=0 to 25 do
for p:=0 to 4 do
  for m:=0 to 5 do
  begin

    for n:=1 to 6 do begin
      col:=n+m*6+p*36;
      m_comp:=n*4+20   {+ opacity};

      if p=0 then m_comp:=0;

      red:=m_comp;  green:=m_comp;   blue:=m_comp+10;

      if red>63 then red:=63;
      if green>63 then green:=63;
      if blue>63 then blue:=63;

      mem[seg_dpal1: (col*3)   + opacity*180*3] := red*4;
      mem[seg_dpal1: (col*3+1) + opacity*180*3] := green*4;
      mem[seg_dpal1: (col*3+2) + opacity*180*3] := blue*4;
    end;
end;
end;

procedure colors1(seg_dpal1:word); {mode 1 color scheme}
begin
for opacity:=0 to 25 do
for p:=0 to 4 do
  for m:=0 to 5 do
  begin
    more_red:=opacity shr 1;

    for n:=1 to 6 do begin
      col:=n+m*6+p*36;


      if p=0 then begin
         m_comp:=n*3   + opacity div 4;
         red:=m_comp+more_red shr 1; green:=m_comp; blue:=m_comp+more_red +5;
         end
      else begin
         m_comp:=n*2 +16  + opacity div 3;
         red:=m_comp+more_red shr 1; green:=m_comp; blue:=m_comp+more_red +10;
         end;

      if red>63 then red:=63;
      if green>63 then green:=63;
      if blue>63 then blue:=63;

      mem[seg_dpal1: (col*3)   + opacity*180*3] := red*4;
      mem[seg_dpal1: (col*3+1) + opacity*180*3] := green*4;
      mem[seg_dpal1: (col*3+2) + opacity*180*3] := blue*4;
    end;
end;
end;


procedure colors2(seg_dpal1:word); {mode 2 color scheme}
begin
for opacity:=0 to 25 do
for p:=0 to 4 do
  for m:=0 to 5 do
  begin
    more_red:=opacity shr 1;

    for n:=1 to 6 do begin
      col:=n+m*6+p*36;
      m_comp:=n*3   + opacity;
      comp1:=n*5+10 + opacity;
      comp2:= opacity*2;

      if p=0 then begin red:=m_comp+more_red;  green:=m_comp-more_red;   blue:=m_comp+more_red*3;  end;
      if p=1 then begin red:=comp1+more_red;   green:=comp2-more_red;    blue:=comp2+8-more_red;     end;
      if p=2 then begin red:=comp2+more_red;   green:=comp1-more_red;    blue:=comp2+10-more_red;     end;
      if p=3 then begin red:=comp2+2+more_red; green:=comp2+10-more_red; blue:=comp1+8-more_red;     end;
      if p=4 then begin red:=comp1+more_red;   green:=comp1-more_red;    blue:=comp2+10-more_red;     end;

      if red>63 then red:=63;
      if green>63 then green:=63;
      if blue>63 then blue:=63;

      mem[seg_dpal1: (col*3)   + opacity*180*3] := red*4;
      mem[seg_dpal1: (col*3+1) + opacity*180*3] := green*4;
      mem[seg_dpal1: (col*3+2) + opacity*180*3] := blue*4;
    end;
end;
end;


procedure colors3(seg_dpal1:word); {mode 3 color scheme}
var ro,go,bo:integer;
begin
for opacity:=0 to 25 do
  for p:=0 to 4 do
   for m:=0 to 5 do

  begin
    more_red:=opacity shr 1;

    for n:=1 to 6 do begin
      col:=n+m*6+p*36;
      m_comp:=n*3   + opacity;
      comp1:=n*5+10 + opacity;
      comp2:= opacity*2;

      if m=0 then begin
              if p=0 then begin green:=m_comp  +more_red; red:=m_comp   -more_red; blue:=m_comp   +more_red*3; end;
              if p=1 then begin green:=comp1   +more_red; red:=comp2    -more_red; blue:=comp2+8  -more_red;   end;
              if p=2 then begin green:=comp2   +more_red; red:=comp1    -more_red; blue:=comp2+10 -more_red;   end;
              if p=3 then begin green:=comp2+2 +more_red; red:=comp2+10 -more_red; blue:=comp1+8  -more_red;   end;
              if p=4 then begin green:=comp1   +more_red; red:=comp1    -more_red; blue:=comp2+10 -more_red;   end;
              if n=1 then begin go:=m_comp  +more_red; ro:=m_comp   -more_red; bo:=m_comp   +more_red*3; end;
              end;
      if m=1 then begin
              if p=0 then begin red:=m_comp  +more_red; blue:=m_comp   -more_red; green:=m_comp   +more_red*2; end;
              if p=1 then begin red:=comp1   +more_red; blue:=comp2    -more_red; green:=comp2+8  -more_red;   end;
              if p=2 then begin red:=comp2   +more_red; blue:=comp1    -more_red; green:=comp2+10 -more_red;   end;
              if p=3 then begin red:=comp2+2 +more_red; blue:=comp2+10 -more_red; green:=comp1+8  -more_red;   end;
              if p=4 then begin red:=comp1   +more_red; blue:=comp1    -more_red; green:=comp2+10 -more_red;   end;
              if n=1 then begin ro:=m_comp  +more_red; bo:=m_comp   -more_red; go:=m_comp   +more_red*2; end;
              end;
      if m=2 then begin
              if p=0 then begin blue:=m_comp  +more_red; green:=m_comp   -more_red; red:=m_comp   +more_red*3; end;
              if p=1 then begin blue:=comp1   +more_red; green:=comp2    -more_red; red:=comp2+8  -more_red;   end;
              if p=2 then begin blue:=comp2   +more_red; green:=comp1    -more_red; red:=comp2+10 -more_red;   end;
              if p=3 then begin blue:=comp2+2 +more_red; green:=comp2+10 -more_red; red:=comp1+8  -more_red;   end;
              if p=4 then begin blue:=comp1   +more_red; green:=comp1    -more_red; red:=comp2+10 -more_red;   end;
              if n=1 then begin bo:=m_comp  +more_red; go:=m_comp   -more_red; ro:=m_comp   +more_red*3; end;
           end;
      if m=4 then begin
              if p=0 then begin green:=m_comp  +more_red; blue:=m_comp   -more_red; red:=m_comp   +more_red*3; end;
              if p=1 then begin green:=comp1   +more_red; blue:=comp2    -more_red; red:=comp2+8  -more_red;   end;
              if p=2 then begin green:=comp2   +more_red; blue:=comp1    -more_red; red:=comp2+10 -more_red;   end;
              if p=3 then begin green:=comp2+2 +more_red; blue:=comp2+10 -more_red; red:=comp1+8  -more_red;   end;
              if p=4 then begin green:=comp1   +more_red; blue:=comp1    -more_red; red:=comp2+10 -more_red;   end;
              if n=1 then begin go:=m_comp  +more_red; bo:=m_comp   -more_red; ro:=m_comp   +more_red*3; end;
           end;
      if m=5 then begin
              if p=0 then begin blue:=m_comp  +more_red; red:=m_comp   -more_red; green:=m_comp   +more_red*3; end;
              if p=1 then begin blue:=comp1   +more_red; red:=comp2    -more_red; green:=comp2+8  -more_red;   end;
              if p=2 then begin blue:=comp2   +more_red; red:=comp1    -more_red; green:=comp2+10 -more_red;   end;
              if p=3 then begin blue:=comp2+2 +more_red; red:=comp2+10 -more_red; green:=comp1+8  -more_red;   end;
              if p=4 then begin blue:=comp1   +more_red; red:=comp1    -more_red; green:=comp2+10 -more_red;   end;
              if n=1 then begin bo:=m_comp  +more_red; ro:=m_comp   -more_red; go:=m_comp   +more_red*3; end;
           end;
      if m=3 then begin
              if p=0 then begin red:=m_comp  +more_red; green:=m_comp   -more_red; blue:=m_comp   +more_red*3; end;
              if p=1 then begin red:=comp1   +more_red; green:=comp2    -more_red; blue:=comp2+8  -more_red;   end;
              if p=2 then begin red:=comp2   +more_red; green:=comp1    -more_red; blue:=comp2+10 -more_red;   end;
              if p=3 then begin red:=comp2+2 +more_red; green:=comp2+10 -more_red; blue:=comp1+8  -more_red;   end;
              if p=4 then begin red:=comp1   +more_red; green:=comp1    -more_red; blue:=comp2+10 -more_red;   end;
              if n=1 then begin ro:=m_comp  +more_red; go:=m_comp   -more_red; bo:=m_comp   +more_red*3; end;
           end;


      red:=   round(red    + ro/2);
      green:= round(green  + go/2);
      blue:=  round(blue   + bo/2);

      if red>63 then red:=63;
      if green>63 then green:=63;
      if blue>63 then blue:=63;

      mem[seg_dpal1: (col*3)   + opacity*180*3] := red*4;
      mem[seg_dpal1: (col*3+1) + opacity*180*3] := green*4;
      mem[seg_dpal1: (col*3+2) + opacity*180*3] := blue*4;
    end;
end;
end;


procedure colors4(seg_dpal1:word); {mode 4 color scheme}
var cp1,cp2:single;
begin
for opacity:=0 to 25 do
for p:=0 to 4 do
  for m:=0 to 5 do
  begin
    more_red:=round(opacity/2);

    for n:=1 to 6 do begin
      col:=n+m*6+p*36;
      m_comp:=n*4   + opacity;

      if p=0 then begin
         m_comp:=n*3   + opacity div 2;
         red:=round((m_comp+more_red)*0.7); green:=round((m_comp)*0.9); blue:=round((m_comp+more_red)*1.3);
         end;
      if p=1 then begin {white}
         m_comp:=n*2 +16  + opacity div 3;
         red:=m_comp+more_red; green:=m_comp; blue:=m_comp+(more_red*2)+5;
         end;
      if p=2 then begin  {red}
         m_comp:=n*3 +16  + opacity div 3;
         red:=m_comp+more_red; green:=round((m_comp)/1.6); blue:=round((m_comp+(more_red*2) +10)/1.6);
         end;
      if p=3 then begin  {blue}
         m_comp:=n*3 +16  + opacity div 3;
         red:=round((m_comp+more_red)/1.6); green:=round((m_comp)/1.6); blue:=round((m_comp+(more_red*2) +10));
         end;
      if p=4 then begin  {violet}
         m_comp:=n*3 +16  + opacity div 3;
         red:=m_comp+more_red; green:=round((m_comp)/1.6); blue:=round((m_comp+(more_red*2) +10));
         end;

            cp1:=opacity / 4.5;
            cp2:=opacity*1;

         red:=round(    ((red/cp1)   +(cp2)     )/1.2    );
         green:=round(  ((green/cp1) +(cp2/1.2) )/1.2    );
         blue:=round(   ((blue/cp1)  +(cp2)     )/1.2    );



      if red>63 then red:=63;
      if green>63 then green:=63;
      if blue>63 then blue:=63;

      mem[seg_dpal1: (col*3)   + opacity*180*3] := red*4;
      mem[seg_dpal1: (col*3+1) + opacity*180*3] := green*4;
      mem[seg_dpal1: (col*3+2) + opacity*180*3] := blue*4;
    end;
end;
end;


procedure colors5(seg_dpal1:word);{mode 5 color scheme}
begin
for opacity:=0 to 25 do
for p:=0 to 4 do
  for m:=0 to 5 do
  begin
    for n:=1 to 6 do begin
      col:=n+m*6+p*36;

      mem[seg_dpal1:(col*3)   + opacity*180*3]:= round((60-opacity*2)/2) *4;
      mem[seg_dpal1:(col*3+1) + opacity*180*3]:= round((60-opacity*2)/1.5) *4;
      mem[seg_dpal1:(col*3+2) + opacity*180*3]:= round((60-opacity*2) ) *4;

    end;
end;
end;


procedure MakeColorScheme(name:string; num:byte; where:word);
var
fw1:file;
begin
       if num=0 then Colors0(where)
  else if num=1 then Colors1(where)
  else if num=2 then Colors2(where)
  else if num=3 then Colors3(where)
  else if num=4 then Colors4(where)
  else if num=5 then Colors5(where);

Assign(fw1, name);
Rewrite(fw1,1);
for m:=0 to 14041 do BlockWrite(fw1, mem[where:m], 1);
Close(fw1);

end;


begin
SetUpVirtual(scr,vaddr);

MakeColorScheme('colors0.bin',0, vaddr);
MakeColorScheme('colors1.bin',1, vaddr);
MakeColorScheme('colors2.bin',2, vaddr);
MakeColorScheme('colors3.bin',3, vaddr);
MakeColorScheme('colors4.bin',4, vaddr);
MakeColorScheme('colors5.bin',5, vaddr);


end.