unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  Spin, ExtCtrls, mystringlistunit;

type

  { TForm1 }

  TForm1 = class(TForm)
    Image1: TImage;
    Memo1: TMemo;
    Memo2: TMemo;
    SpinEdit1: TSpinEdit;
    SpinEdit2: TSpinEdit;
    procedure FormActivate(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure Memo1Change(Sender: TObject);
  private
    personen,tage: tMyStringList;
    zeiten:        array of longint;
    kannNicht:     array of array of array of longint;
    inhaltOk:      boolean;
    procedure clearArrays;
    procedure schreibeNach(x,y: longint; s: string);
  public
    procedure zeichnen;
    procedure interpretiereInhalt;
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

uses
  math, lowlevelunit;

{ TForm1 }

procedure TForm1.FormResize(Sender: TObject);
begin
  memo2.width:=form1.clientWidth-memo1.left;
  image1.free;
  image1:=tImage.create(form1);
  image1.parent:=form1;
  image1.left:=0;
  image1.top:=160;
  image1.width:=form1.clientWidth-image1.left;
  image1.height:=form1.clientHeight-image1.top;
  zeichnen;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  personen:=tMyStringList.create;
  tage:=tMyStringList.create;
  setLength(kannNicht,0);
  setLength(zeiten,0);
  inhaltOk:=false;
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
  interpretiereInhalt;
  zeichnen;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  clearArrays;
  personen.free;
  tage.free;
end;

procedure TForm1.Memo1Change(Sender: TObject);
begin
  interpretiereInhalt;
  zeichnen;
end;

procedure tForm1.clearArrays;
var
  i,j: longint;
begin
  personen.clear;
  tage.clear;
  for i:=0 to length(kannNicht)-1 do begin
    for j:=0 to length(kannNicht[i])-1 do
      setLength(kannNicht[i,j],0);
    setLength(kannNicht[i],0);
  end;
  setLength(kannNicht,0);
  setLength(zeiten,0);
end;

procedure tForm1.schreibeNach(x,y: longint; s: string);
begin
  image1.canvas.textOut(
    round(image1.width/(tage.count+1)*(x+0.5) - image1.canvas.textWidth(s)/2),
    round(image1.height/(length(zeiten)+1)*(y+0.5) - image1.canvas.textHeight(s)/2),
    s
  );
end;

procedure tForm1.zeichnen;
var
  i,j,k: longint;
  ma,mi: longint;
  guete: extended;
  s:     string;
begin
  if not inhaltOk then
    exit;
  image1.canvas.brush.color:=$ffffff;
  image1.canvas.pen.color:=$000000;
  image1.canvas.rectangle(-1,-1,image1.width+1,image1.height+1);
  ma:=-1;
  mi:=-1;
  for i:=0 to length(zeiten)-1 do
    for j:=0 to tage.count-1 do begin
      if (ma<0) or (ma < length(kannNicht[i,j])) then
        ma:=length(kannNicht[i][j]);
      if (mi<0) or (mi > length(kannNicht[i,j])) then
        mi:=length(kannNicht[i][j]);
    end;
  for i:=0 to length(zeiten)-1 do
    schreibeNach(0,i+1,intToStr(zeiten[i]));
  for j:=0 to tage.count-1 do
    schreibeNach(j+1,0,tage[j]);
  for i:=0 to length(zeiten)-1 do
    for j:=0 to tage.count-1 do begin
      guete:=min(1,max(0,1-(length(kannNicht[i,j])-mi)/(ma-mi+byte(ma=mi))));
      if guete<0.5 then
        image1.canvas.brush.color:=$ff or (round($ff*(2*guete)) shl 8)
      else
        image1.canvas.brush.color:=$ff00 or round($ff*(2-2*guete));
      image1.canvas.pen.color:=image1.canvas.brush.color;
      image1.canvas.rectangle(
        round(image1.width/(tage.count+1)*(j+1)),
        round(image1.height/(length(zeiten)+1)*(i+1)),
        round(image1.width/(tage.count+1)*(j+2))-1,
        round(image1.height/(length(zeiten)+1)*(i+2))-1
      );
      image1.canvas.pen.color:=$000000;
      s:='';
      for k:=0 to length(kannNicht[i,j])-1 do
        s:=s+personen[kannNicht[i,j,k]]+', ';
      delete(s,length(s)-1,2);
      schreibeNach(j+1,i+1,s);
    end;
end;

procedure tForm1.interpretiereInhalt;
var
  i,j,k,knTag: longint;
  s,knZeit,t:  string;
begin
  inhaltOk:=false;
  image1.canvas.pen.color:=$0000ff;
  image1.canvas.pen.width:=5;
  image1.canvas.moveTo(0,0);
  image1.canvas.lineTo(image1.width,image1.height);
  image1.canvas.moveTo(image1.width,0);
  image1.canvas.lineTo(0,image1.height);
  image1.canvas.pen.color:=$000000;
  image1.canvas.pen.width:=1;
  clearArrays;
  setLength(zeiten,spinEdit2.value - spinEdit1.value);
  for i:=spinEdit1.value to spinEdit2.value-1 do
    zeiten[i-spinEdit1.value]:=i;
  tage.text:=memo1.lines.text;
  tage.grep('^$',true);
  setLength(kannNicht,length(zeiten));
  for i:=0 to length(kannNicht)-1 do begin
    setLength(kannNicht[i],tage.count);
    for j:=0 to length(kannNicht[i])-1 do
      setLength(kannNicht[i,j],0);
  end;
  for i:=0 to memo2.lines.count-1 do begin
    s:=memo2.lines[i];
    if s='' then
      continue;
    personen.add(erstesArgument(s,':'));
    while s<>'' do begin
      knTag:=tage.findeZeile(erstesArgument(s));
      if knTag<0 then
        exit;
      knZeit:=erstesArgument(s);
      while pos(',',knZeit)>0 do
        knZeit[pos(',',knZeit)]:=' ';
      while pos('-',knZeit)>0 do begin
        t:=knZeit;
        knZeit:='';
        while pos(' ',t+' ') < pos('-',t) do
          knZeit:=knZeit+' '+erstesArgument(t);
        try
          j:=strToInt(erstesArgument(t,'-'));
          k:=strToInt(erstesArgument(t));
        except
          exit;
        end;
        while j<k do begin
          knZeit:=knZeit+' '+intToStr(j);
          inc(j);
        end;
        knZeit:=knZeit+' '+t;
      end;
      knZeit:=trim(knZeit);
      while knZeit<>'' do begin
        try
          j:=strToInt(erstesArgument(knZeit)) - spinEdit1.value;
        except
          exit;
        end;
        if (j<0) or (j>=length(kannNicht)) then
          exit;
        setLength(kannNicht[j][knTag],length(kannNicht[j][knTag])+1);
        kannNicht[j][knTag][length(kannNicht[j][knTag])-1]:=personen.count-1;
      end;
    end;
  end;
  inhaltOk:=
    (tage.count>0) and
    (length(zeiten)>0);
end;

end.