unit data;

{$mode objfpc}{$H+}

interface

uses
  windows,Classes, SysUtils,FPimage, Graphics,math;

type

{ TMap }
T2DArray=array of array of longint;
TMap=class
  map,water: T2DArray;
  procedure loadFromImageFile256(fileName: string);
  procedure loadFromImage256(bmp: tbitmap);
  procedure displayWater256(bmp: TBitmap);

  //Algorithmen sind von Lilli Kaufhold, Martin Maas,
  //Ulrich Mierendorff und Benito van der Zander
  procedure completeFill;
  procedure rainFill(R: longint;prec:longint=1);
end;

type THeapElement=record
  x,y:longint;
end;

PHeapElement=^THeapElement;
{ TMapHeap }

TMapHeap=class
private
  heap:array of THeapElement;
  len:cardinal;
  inheap: array of array of boolean;
  procedure movedown(p:cardinal);
public
  invertedPriority,removeNever:boolean;
  map:T2DArray;
  procedure push(x,y,h:longint);
  procedure pop;
  function get: PHeapElement;
  function getH: longint;
  constructor create(w,h:longint;amap:T2DArray=nil);
end;

implementation

{ TMap }

procedure TMap.loadFromImageFile256(fileName: string);
var bmp:TBitmap;
begin
  bmp:=TBitmap.Create;
  bmp.LoadFromFile(fileName);
  loadFromImage256(bmp);
  bmp.free;
end;

procedure TMap.loadFromImage256(bmp: tbitmap);
var x,y:longint;
begin
  SetLength(map,bmp.Width,bmp.Height);
  SetLength(water,bmp.Width,bmp.Height);
  bmp.Canvas.LockCanvas;
  try
    for x:=0 to high(map) do
      for y:=0 to high(map[x]) do begin
        map[x,y]:=bmp.Canvas.Colors[x,y].green;
        water[x,y]:=0;
      end;
  finally
    bmp.Canvas.UnlockCanvas;
  end;
end;

procedure TMap.displayWater256(bmp: TBitmap);
var x,y:longint;
    fpcol: TFPColor;
begin
  bmp.Width:=length(water);
  bmp.height:=Length(water);
  bmp.Canvas.LockCanvas;
  try
    for x:=0 to high(map) do
      for y:=0 to high(map[x]) do begin
        fpcol:=bmp.Canvas.Colors[x,y];
        fpcol.blue:=word(water[x,y]);
        bmp.Canvas.Colors[x,y]:=fpcol;
      end;
  finally
    bmp.Canvas.UnlockCanvas;
  end;
end;

procedure TMap.completeFill;
var i,x,y:longint;
    heap:TMapHeap;
begin
  heap:=TMapHeap.Create(length(map),length(map[0]));
  heap.map:=nil;//interne werten
  heap.invertedPriority:=true;
  heap.removeNever:=true;
  
  for i:=0 to high(map) do begin
    heap.push(i,0,map[i,0]);
    heap.push(i,high(map[0]),map[i,high(map[0])]);
  end;
  for i:=0 to high(map[0]) do begin
    heap.push(0,i,map[0,i]);
    heap.push(high(map[0]),i,map[high(map[0]),i]);
  end;
  
  while heap.len>0 do begin
    x:=heap.get^.x;
    y:=heap.get^.y;
    water[x,y]:=heap.getH;
    heap.pop();
    if x>0 then
      heap.push(x-1,y,max(map[x-1,y],water[x,y]));
    if y>0 then
      heap.push(x,y-1,max(map[x,y-1],water[x,y]));
    if x<high(map) then
      heap.push(x+1,y,max(map[x+1,y],water[x,y]));
    if y<high(map[0]) then
      heap.push(x,y+1,max(map[x,y+1],water[x,y]));
  end;
  
  heap.free;
end;

procedure TMap.rainFill(R: longint;prec:longint=1);
var i,x,y,h:longint;
    heap:TMapHeap;
begin
  heap:=TMapHeap.Create(length(map),length(map[0]));
  heap.map:=map;//externe werte
  for x:=0 to high(map) do
    for y:=0 to high(map[x]) do begin
      heap.push(x,y,map[x,y]+r);
      water[x,y]:=map[x,y]+r;
    end;
  while heap.len>0 do begin
    x:=heap.get^.x;
    y:=heap.get^.y;
    h:=heap.getH;
    heap.pop;
    if (x>0) and (water[x-1,y]<h) then begin
    
    end;
  end;

  heap.free;
end;

procedure TMapHeap.movedown(p: cardinal);
var tempHeap: THeapElement;
    modifier:longint;
    c:cardinal;
begin
  if invertedPriority then modifier:=-1
  else modifier:=1;

  while 2*p<=len do begin
    c:=2*p;
    if (c+1<=len) and (map[heap[c+1].x,heap[c+1].y]*modifier>map[heap[c].x,heap[c].y]*modifier) then c:=c+1;
    if map[heap[p].x,heap[p].y]*modifier>map[heap[c].x,heap[c].y]*modifier then break;

    tempHeap:=heap[p];
    heap[p]:=heap[c];
    heap[c]:=tempHeap;
    p:=c;
  end;
end;

procedure TMapHeap.push(x,y,h:longint);
var p:cardinal;
    tempHeap: THeapElement;
    modifier:longint;
begin
  if (x<0) or (y<0) then exit;
  if (x>high(inheap)) or (y>high(inheap)) then exit;
  if inheap[x,y] then exit;
  len+=1;
  inheap[x,y]:=true;
  heap[len].x:=x;
  heap[len].y:=y;
  map[x,y]:=h;

  if invertedPriority then modifier:=-1
  else modifier:=1;

  p:=len;
  while (p>1) and (map^[heap[p shr 1].x,heap[p shr 1].y]*modifier<map^[heap[p].x,heap[p].y]*modifier) do begin
    tempHeap:=heap[p];
    heap[p]:=heap[p shr 1];
    heap[p shr 1]:=tempHeap;
    p:=p shr 1;
  end;
  movedown(p);
end;

procedure TMapHeap.pop;
begin
  if len=0 then exit;
  if not removeNever then inheap[heap[1].x,heap[1].y]:=false;
  heap[1]:=heap[len];
  len-=1;
  
  movedown(1);

end;

function TMapHeap.get: PHeapElement;
begin
  result:=@heap[1];
end;

function TMapHeap.getH: longint;
begin
  exit(map[heap[1].x,heap[1].y]);
end;


constructor TMapHeap.create(w, h: longint;amap: T2DArray);
var x:longint;
begin
  len:=0;
  SetLength(heap,w*h+1);
  setlength(inheap,w,h);
  for x:=0 to high(inheap) do
    FillChar(inheap[x,0],length(inheap[x])*sizeof(inheap[x,0]),0);
  if amap=nil then setlength(map,w,h)
  else map:=amap;
    
end;


procedure heapTest();
var heap: TMapHeap;
  procedure check(val: array of longint);
  var i,j,k,l:longint;
      val2:array of longint;
      heapstr:string;
  begin
    RandSeed:=2;
    for i:=1 to 200 do begin
      l:=0;
      setlength(val2,length(val));
      move(val[0],val2[0],sizeof(val[0])*length(val));

      while length(val2) >0 do begin
        l+=1;
        j:=random(length(val2));
        heap.push(l,l,val2[j]);
        val2[j]:=val2[high(val2)];
        setlength(val2,length(val2)-1);
     {   heapstr:='';
        for l:=1 to heap.len do
          heapstr:=heapstr+inttostr(heap.heap[l].h)+' ';
        OutputDebugString(pchar(heapstr));               }
      end;
      if heap.len<>cardinal(length(val)) then
        raise exception.create('ungültige Länge: '+IntToStr(heap.len));
      for k:=0 to high(val) do begin
{        heapstr:='';
        for l:=1 to heap.len do
          heapstr:=heapstr+inttostr(heap.heap[l].h)+' ';
        OutputDebugString(pchar(heapstr));}
        if heap.get^.h<>val[k] then
          raise exception.Create('heap test failed: '+inttostr(heap.get^.h)+'<>'+inttostr(val[k])+' (pos: '+inttostr(i)+'/'+inttostr(k)+'): ');
        heap.pop;
      end;
      if heap.len<>0 then
        raise exception.create('ungültige Länge2: '+IntToStr(heap.len));
    end;
  end;
begin
  heap:=TMapHeap.Create(100,100);
  heap.invertedPriority:=false;
  heap.removeNever:=false;
  check([100,90,80,70,60,50,40,30,20,10]);
  check([866,436,324,244,243,123,122,87,24,12,8,4]); // }
  heap.invertedPriority:=true;
  check([10,20,30,40,50]);
  check([1,14,24,63,245,266,345,445,564,667,789,808,920,1000,2003,3123,3242,3456,4607,4700,4909,5000]);
  heap.free;
end;

initialization
  heapTest()
  
end.



    
