unit Aufgabe1_u;
(*) Geschrieben von Benito van der Zander

  Namennotation:
    YYYY_xx
Name  /\  Typ
  Trennzeichen

  Typ:
    x                                          x
  Allgemeine Information:             Genauere Information:
  b: Booleanwert                       x: Boolean (kann weggelassen werden)
                                       b: ByteBool
                                       l: LongBool
                                       w: WordBool;

  c: Cardinalwert (ohne Vorzeichen)    x: Cardinal (kann weggelassen werden)
                                       b: Byte
                                       w: Word
                                       l: LongWord
  i: Integerwert (mit Vorzeichen)
                                       x: Integer  (kann weggelassen werden)
                                       s: ShortInt
                                       sm: SmallInt
                                       l: LongInt
                                       i: Int64

  t: Text                              c: Char
                                       s: String
-----------------------------------------------------------------
  x:Benutzerdefiniert                  aab:packed array of array of boolean;
                                       ts: TypeStr 
(*)
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Spin, ExtCtrls, Menus,math,integer_Asm;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    Programm1: TMenuItem;
    Zwischenzustndeberechnen1: TMenuItem;
    Beenden1: TMenuItem;
    Schiebereglereinstellen1: TMenuItem;
    Anfangszustandseinstellen1: TMenuItem;
    Panel1: TPanel;
    Panel2: TPanel;
    ScrollBar1: TScrollBar;
    ScrollBar2: TScrollBar;
    PaintBox1: TPaintBox;
    procedure Riegeleinstellen1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Zwischenzustndeberechnen1Click(Sender: TObject);
    procedure Anfangszustandseinstellen1Click(Sender: TObject);
    procedure ScrollBar1Change(Sender: TObject);
    procedure Beenden1Click(Sender: TObject);
  private
    { Private-Deklarationen}
    Riegel_i:integer; //Nimmt die Anzahl der Riegel auf
    Riegel_Zustaende_xaab:packed array of array of boolean;
    benutzezustaende_i:integer;
    function BlockierenderRiegel(schaltriegel_i,zustandsreihe_i:integer):integer;
    procedure WM_ERASEBKGND(var mes:Tmessage);message WM_ERASEBKGND;
    procedure SchalteRiegelum(schaltriegel_i,zustandsreihe_i:integer);
    procedure BerechneNeueReihe(stoerenderRiegel_i:integer);
    function BerechneZustandsZahl:TypeStr;
    function GetFreeMemory:cardinal;
  public
    { Public-Deklarationen}
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//-----------------------Berechnet die Anzahl der notwendigen Schritte, die benötigt werden, um die Pforte ordentlich zu schließen------------
function TForm1.BerechneZustandsZahl;
var i:integer;
    temp_xts,anzahl_xts:TypeStr;
    addsub_b:Boolean;
    erster_b:boolean;
begin
temp_xts:='1';  //Berechnet den spezifischen Wert 1^length(s_ts)-1  (der Wert von Riegel N-1)
for i:=1 to high(Riegel_Zustaende_xaab[0]) do
  temp_xts:=mul(temp_xts,'2');


anzahl_xts:='0'; //0 Schritte
addsub_b:=true; //Erst den spezifischen Wert addieren, dann subtrahieren
erster_b:=true; //Der zweitletzte offene Riegel (im Programm erster Riegel)
for i:=length(Riegel_Zustaende_xaab[0])-1 downto 1 do begin //Läuft von Riegel N-1 zu Riegel 1 runter
  if Riegel_Zustaende_xaab[0][i-1] then begin //Wenn der Riegel offen ist, verändert er die Anzahl
    if erster_b then //Wenn der Riegel der zweitletzte offene Riegel ist
      anzahl_xts:=Add(anzahl_xts,temp_xts) //Wird der spezifische Wert addiert
     else //sonst
      if addsub_b then //Ist gerade addieren eingeschaltet:
        anzahl_xts:=Add(anzahl_xts,sub(temp_xts,'1')) //Wird der spezifische Wert minus 1 addiert
       else //Ist gerade subtrahieren eingeschaltet:
        anzahl_xts:=Sub(anzahl_xts,sub(temp_xts,'1'));//Wird der spezifische Wert minus 1 subtrahiert
    erster_b:=false; //Nicht mehr der hintester Riegel
    addsub_b:=not addsub_b ; //Von addieren zu subtrahieren, bzw von subtrahieren zu addieren umschalten
  end;
  temp_xts:=Diviz(temp_xts,'2'); //Der spezifische Wert wird halbiert
  temp_xts:=copy(temp_xts,1,pos('.',temp_xts)-1); //Die Division liefert eine Kommazahl zurück (z.b.: 2.0), diese kann nicht weiter verarbeitet werden, und wird deshalb hier zu einer Ganzzahl umgeschrieben
end;
if Riegel_Zustaende_xaab[0][high(Riegel_Zustaende_xaab[0])] then
  if anzahl_xts='0' then
    anzahl_xts:='2'
   else
    anzahl_xts:=Add( anzahl_xts,'1'); //Ist Riegel N offen, wird die Schrittzahl um eins erhöt
if anzahl_xts='0' then
  anzahl_xts:='1';

Result:=anzahl_xts;
end;

//berechnet den Riegel, der verhindert, dass ein gewisser Riegel geschlossen wird
function TForm1.BlockierenderRiegel(schaltriegel_i,zustandsreihe_i:integer):integer;
var i_i:integer;
    SchalterAn:boolean;
begin
result:=0; //Prinzipiell wird davon ausgegangen, dass der erste Riegel stört
if schaltriegel_i<=0 then
  result:=-1 //erster Riegel kann immer umgeschaltet werden
else if schaltriegel_i=riegel_i-1 then begin //Wenn dere Riegel N-1 ist, greift regel 4
  SchalterAn:=false; //Kein Schalter an
  for i_i:=schaltriegel_i-1 downto 0 do
    if Riegel_Zustaende_xaab[zustandsreihe_i,i_i] then
      SchalterAn:=true; //Ein Riegel an
  if SchalterAn then //Wenn ein Riegel an ist
    Result:=0 //wird der Rückgabewert auf 0 gesetzte
   else
    Result:=-1;//sonst auf -1
end;
if Result>=0 then begin //Ist der Rückgabewert nicht -1
  if not Riegel_Zustaende_xaab[zustandsreihe_i,schaltriegel_i-1] then begin //wird getestet ob der Riegel mit der kleineren Nummer offen ist
    Result:=schaltriegel_i-1; //Wenn nicht, wird er zurückgegeben
    exit; //und die Prozedur abgebrochen
  end;
  for i_i:=schaltriegel_i-2 downto 0 do //Dann wird vom übernächst kleineren Riegel bis zum ersten getestet
    if Riegel_Zustaende_xaab[zustandsreihe_i,i_i] then begin //Ob er zu ist
      Result:=i_i; //Wenn nicht, wird er zurückgegeben
      exit;//und die Prozedur abgebrochen
    end;
  Result:=-1;//wurde sie nicht abgebrochen, wird -1 zurückgegeben
end;

end;

//-------------Neue Zustandsreihe zum ordentlichen Schließen der Pforte berechnen-----------------------
procedure TForm1.BerechneNeueReihe(stoerenderRiegel_i:integer);
var RiegelSchaltbar_i:integer; //Blockierender Riegel
begin
RiegelSchaltbar_i:=BlockierenderRiegel(stoerenderRiegel_i,benutzezustaende_i); //Testen ob der Riegel umschaltbar ist
while RiegelSchaltbar_i<>-1 do begin //Wenn nicht
  BerechneNeueReihe(RiegelSchaltbar_i); //Wird die Funktion mit diesem den störenden Riegel störenden Riegel gestartet (Rekursive Schleife wiederholen)
  RiegelSchaltbar_i:=BlockierenderRiegel(stoerenderRiegel_i,benutzezustaende_i); //Erneut testen ob der Riegel umschaltbar ist
end; //Iterative Schleife wiederholen

benutzezustaende_i:=benutzezustaende_i+1; //Hintesten aktiven Zustand um eins verschieben 
CopyMemory(riegel_zustaende_xaab[benutzezustaende_i],riegel_zustaende_xaab[benutzezustaende_i-1],length(riegel_zustaende_xaab[benutzezustaende_i-1])); //alten Riegelzustand auf den neuen kopieren
riegel_zustaende_xaab[benutzezustaende_i][stoerenderRiegel_i]:=not riegel_zustaende_xaab[benutzezustaende_i][stoerenderRiegel_i]; //und verändern
end;

//---------------Berechnet die zum Schließen notwendigen Schritte---------------
procedure TForm1.Zwischenzustndeberechnen1Click(Sender: TObject);
var i_i:integer;
    groese_i:Int64;
    groese_bts:TypeStr;
begin
setlength(riegel_zustaende_xaab,1); //Setzt die Anzahl der Zustände zurück
benutzezustaende_i:=0; //Letzten aktiven Zustand auf 0 setzten
groese_bts:=BerechneZustandsZahl; //berechnet die benötigte Anzahl der Zustände
ShowMessage('Benötigte Schritte: '+groese_bts); //Gibt sie aus
if length(groese_bts)<20 then //Wenn die Zahl weniger als 20 Stellen hhat
  groese_i:=StrToInt64(groese_bts) //Wird sie einer Int64 Variable zur Weiterverarbeitung zugewiesen
 else begin
   groese_i:=high(int64); //Sonst wird sie auf den Maximalen Wert gesetzt
   if Application.MessageBox('Die Daten lassen sich vorraussichtlich nicht berechnen. Trotzdem die Zustandsfolge berechnen?','Bundeswettbewerb Aufgabe 1',MB_YESNO)=IDNO then exit; //und eine Warnung ausgegeben
 end;
if groese_i*length(riegel_zustaende_xaab[0])>GetFreeMemory then //Wenn die Anzahl nicht in den RAM passt
 if Application.MessageBox('Die Daten passen vorraussichtlich nicht in den freien, physikalischen Speicher. Trotzdem die Zustandsfolge berechnen?','Bundeswettbewerb Aufgabe 1',MB_YESNO)=idno then exit; //wird eine Warnung ausgegeben
setlength(riegel_zustaende_xaab,groese_i,riegel_i); //Reserviert den benötigten Speicherplatz
for i_i:=riegel_i-2 downto 0 do begin //Alle Riegel von N-1 bis zum ersten
  if Riegel_Zustaende_xaab[benutzezustaende_i,i_i] then //werden wenn sie nicht geschlossen sind
    BerechneNeueReihe(i_i); //der rekursiven Funktion übergeben
end;
if Riegel_Zustaende_xaab[benutzezustaende_i,Riegel_i-1] then //wenn Riegel N offen ist,
  BerechneNeueReihe(Riegel_i-1); //wird er mit Hilfe von Regel 4 geschlopssen

Resize; //Updatet die Scrollbars
PaintBox1.Refresh; //Darstellung updaten
end;

//Stellt die Riegel dar
procedure TForm1.PaintBox1Paint(Sender: TObject);
var x_i,y_i,xpos_i,ypos_i,textwidth_auf_i,textwidth_Zu_i,halbeTextHoehe_i:integer; //For Schleifen Variable für X | für Y; X und Y Zeichenposoition; Textbreite von 'auf'; Textbreite von 'Zu'; Halbe Texthöhe von einen Buchstaben
    i_i,t_i:integer;
    temp_ts:string;//Temporärer String
    temp_xBitmap:TBitmap;
begin
//Doppelbufferbild erzeugen
temp_xBitmap:=TBitmap.Create;
temp_xBitmap.Width:=PaintBox1.Width;
temp_xBitmap.Height:=PaintBox1.Height;
try
  //Konstanten inizialiesieren  
  textwidth_auf_i:=temp_xBitmap.Canvas.TextWidth('auf');
  textwidth_Zu_i:=temp_xBitmap.Canvas.TextWidth('zu');
  halbeTextHoehe_i:=(30-temp_xBitmap.Canvas.TextHeight('ZO')) div 2;
  for x_i:=0 to high(Riegel_Zustaende_xaab) do begin
    xpos_i:=x_i*30+30-ScrollBar1.Position; //X-Zeichenposition ermitteln
    if xpos_i<-30 then //Wenn die Zeichenposition nicht zu sehen ist, weil sie zu weit links ist
      continue; //Schleife an der nächsten Zeichenposition wiederholen
    if xpos_i>temp_xBitmap.Width then //Wenn die Zeichenposition nicht zu sehen ist, weil sie zu weit rechts ist
      break; //Schleife abbrechen
    temp_ts:=IntToStr(x_i+1); //Aktuelle Zustandsnummer
    temp_xBitmap.Canvas.brush.Color:=clWhite; //Hintergrundfarbe weiß
    temp_xBitmap.Canvas.TextOut(xpos_i+(30- temp_xBitmap.Canvas.TextWidth(temp_ts)) div 2,5-ScrollBar2.Position,temp_ts); //Zustandsnummer ausgeben
    for y_i:=0 to high(Riegel_Zustaende_xaab[x_i]) do begin
      ypos_i:=20+y_i*30-ScrollBar2.Position; //Y-zeichenposition ermitteln
      if ypos_i<-30 then //Wenn die Y-Zeichenposition über dem Fensterrand ist
        continue; //wird die innere Schleife mit einer neuen Position wiederholt
      if ypos_i>temp_xBitmap.Height then //Wenn die Y-Zeichenposition unter dem Fensterrand ist
        break; //wird die innere Schleife abgebrochen
      with temp_xBitmap.Canvas do begin
        if x_i=0 then begin //Wenn der erste Zustand dargestellt werden soll
          brush.Color:=clWhite;
          TextOut(2-ScrollBar1.Position,ypos_i+10,'R.'+IntToStr(y_i+1));//Wird die Riegelnummer ausgegeben
        end;
        if Riegel_Zustaende_xaab[x_i,y_i] then //wenn der Riegel auf ist
          brush.Color:=clLime //wird ein grünes Kästchen gezeichnet
         else
          brush.Color:=clRed; //sonst ein rotes
        Rectangle(xpos_i,ypos_i,xpos_i+30,ypos_i+30); //Kästchen zeichnen
        if Riegel_Zustaende_xaab[x_i,y_i] then //wenn der Riegel auf ist
          TextOut(xpos_i+(30-textwidth_auf_i)div 2,ypos_i+halbeTextHoehe_i,'Auf') //wird 'auf' ausgegeben
         else //sonst
          TextOut(xpos_i+(30-textwidth_Zu_i) div 2,ypos_i+halbeTextHoehe_i,'Zu') //wird 'Zu' ausgegeben
      end;
    end;
    if x_i=0 then continue;
    ypos_i:=ypos_i+30;
    t_i:=0;
    for i_i:=0 to high(Riegel_Zustaende_xaab[0]) do begin
      if Riegel_Zustaende_xaab[x_i,i_i]<>Riegel_Zustaende_xaab[x_i-1,i_i] then begin
        t_i:=i_i;
      end;
    end;
    temp_xBitmap.Canvas.brush.Color:=clYellow;
    temp_xBitmap.Canvas.Rectangle(xpos_i-12,ypos_i+12,xpos_i+12,ypos_i+32);
    temp_xBitmap.Canvas.TextOut(xpos_i-10,ypos_i+17,'R'+IntToStr(t_i+1)); //wird 'Zu' ausgegeben
    temp_xBitmap.Canvas.MoveTo(xpos_i,ypos_i);
    temp_xBitmap.Canvas.LineTo(xpos_i,ypos_i+12);
  end;
  PaintBox1.Canvas.Draw(0,0,temp_xBitmap); //Doppelbuffer darstellen
finally
  temp_xBitmap.free;
end;
end;

//--------------------------Voreinstellungen setzten----------------------------
procedure TForm1.FormCreate(Sender: TObject);
begin
  Riegel_i:=4; //4 Riegel
  setlength(Riegel_Zustaende_xaab,1,riegel_i); //setzten
end;



//----------------Scrollbalken, bei Größenänderung einstellen------------------
procedure TForm1.FormResize(Sender: TObject);
begin
  ScrollBar1.Max:=max((30+30*length(riegel_zustaende_xaab)-PaintBox1.Width),0); //Unteren Scrollbalken einstellen
  if ScrollBar1.Max=0 then
    ScrollBar1.Enabled:=false
   else
    ScrollBar1.Enabled:=true;
  ScrollBar2.Max:=max((20+30*length(riegel_zustaende_xaab[0])-PaintBox1.height),0); //Rechten Scrollbalken einstellen
  if ScrollBar2.Max=0 then
    ScrollBar2.Enabled:=false
   else
    ScrollBar2.Enabled:=true;
end;

//------------------------------Klicken verarbeiten-----------------------------
procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var Feldy_i,Feldx_i:int64; //Welcher Riegel? | Welcher Zustand (erster, zweiter..)?
begin
Feldy_i:=(y-20) div 30; //Riegelposition ermitteln
Feldx_i:=(x-30) div 30; //Zustandsposition ermitteln
if Feldx_i>high(riegel_zustaende_xaab) then exit; //Wenn ein Zustand angesprochen wird, der außerhalb des Arrays ist, wird abgebrochen
if Feldy_i>high(riegel_zustaende_xaab[0]) then exit; //siehe oben /\
SchalteRiegelum(Feldy_i,Feldx_i); //Riegel umschalten
PaintBox1.Refresh; //Darstellung updaten
end;


//Setzt die Anzahl der Riegel
procedure TForm1.Riegeleinstellen1Click(Sender: TObject);
var NeuerRiegelWert_ts:string;
    NeuerRiegelWert_i:integer;
begin
NeuerRiegelWert_ts:=IntToStr(Riegel_i); //Aktuelle Anzahl der Riegel
if InputQuery('Bundeswettbewerbinformatik Aufgabe 1','Wieviele Riegel soll es geben?',NeuerRiegelWert_ts) then begin
  NeuerRiegelWert_i:=StrToInt(NeuerRiegelWert_ts);
  if (NeuerRiegelWert_i<4) then
    if Application.MessageBox('Zu wenig Riegel. Soll die Anzahl der Riegel auf 4 gesetzt werden?','Bundeswettbewerbinformatik Aufgabe 1',MB_YESNO)=IDYES	then NeuerRiegelWert_i:=4;
  Riegel_i:=NeuerRiegelWert_i;
  Self.Caption:='BwInf A.1 ('+IntToStr(NeuerRiegelWert_i)+' Riegel)';
  setlength(Riegel_Zustaende_xaab,1,riegel_i); //Setzt die Anzahl der Riegel
  Resize; //Updatet die Scrollbars
  PaintBox1.Refresh; //Darstellung updaten

end;
end;





//-------------------------------Riegel umschalten------------------------------
procedure TForm1.SchalteRiegelum(schaltriegel_i,zustandsreihe_i:integer);
begin
if BlockierenderRiegel(schaltriegel_i,zustandsreihe_i)<0 then //Wenn der Riegel nicht blockiert wird
  riegel_zustaende_xaab[zustandsreihe_i,schaltriegel_i]:=not riegel_zustaende_xaab[zustandsreihe_i,schaltriegel_i]; //Wird er umgeschaltet
end;



//-------------------------Stellt den Startwert ein-----------------------------
procedure TForm1.Anfangszustandseinstellen1Click(Sender: TObject);
var zustaende_ts:string;
    i_i,count_i:integer;
begin
if InputQuery('Bundeswettbewerbinformatik Aufgabe 1','Bitte geben Sie die Riegelzustände ein (z.B.: zaaz).',zustaende_ts) then begin
  zustaende_ts:=LowerCase(zustaende_ts); //Konvertiert die Zustandszahl in Kleinbuchstaben
  count_i:=0;
  for i_i:=1 to length(zustaende_ts) do //Läuft den String durch um die Anzahl der Riegel zu bestimimen
    if zustaende_ts[i_i] in ['a','z','o'] then //Wenn der gewählte Buchstabe ein 'a' (für auf), ein 'z' (für zu) oder ein 'o' (für offen) ist
      inc(count_i); //wird die Riegelanzahl erhöht

  Riegel_i:=max(count_i,1); //Riegelanzahlsvariable setzten
  setlength(riegel_zustaende_xaab,1,Riegel_i); //Setzt die Anzahl
  count_i:=0;
  for i_i:=1 to length(zustaende_ts) do begin //Läuft den Text durch, um die Riegelarten zu bestimmen
    if not (zustaende_ts[i_i] in ['a','z','o']) then continue;//Bei einem ungültigen Buchstaben neu machen
    if zustaende_ts[i_i] = 'z' then //Setzt bei einem z
      Riegel_Zustaende_xaab[0,count_i]:=false //den Riegel auf zu
     else
      Riegel_Zustaende_xaab[0,count_i]:=true;//Und bei einem anderen Buchstaben auf auf
    inc(count_i); //aktuelle Position verschieben
  end;
  Resize; //Updatet die Scrollbars
  PaintBox1.Refresh; //Updatet die Darstellung
  Self.Caption:='BwInf A.1 ('+IntToStr(Riegel_i)+' Riegel)'; //Und die Titelleiste
end;
end;

//---------------verhindert das störende Flackern des Hintergundes--------------
procedure TForm1.WM_ERASEBKGND(var mes:Tmessage);
begin
  mes.Result:=1;
end;

//----------------------Ermittelt den freien Arbeitsspeicher--------------------
function TForm1.GetFreeMemory:cardinal;
var memstate:TMemoryStatus;
begin
  GlobalMemoryStatus(memstate); //Ermittelt alle Speicherinformationen
  Result:=memstate.dwAvailPhys; //Gibt den freien Arbeitsspeicher zurück
end;

procedure TForm1.ScrollBar1Change(Sender: TObject);
begin
  PaintBox1.Refresh;
end;

procedure TForm1.Beenden1Click(Sender: TObject);
begin
Close;
end;

end.

