MODULE Queens2;
(*upgrade za xds *)
  FROM IO IMPORT
    WrStr, WrLn, WrCard, RdCard, OK;

  FROM SYSTEM IMPORT
    TSIZE;

  FROM Storage IMPORT
    ALLOCATE, DEALLOCATE;

  IMPORT FIO;

  CONST
    MaxDim = 50;

  TYPE
    (*Indeks = INTEGER;*)
	Interval = [1 .. MaxDim];
    DomenCene = INTEGER; (*[0 .. MaxDim * MaxDim];*)
    DomenBrojaKraljica = INTEGER; (*[1 .. MaxDim * MaxDim];*)

    PPolozaj = POINTER TO SPolozaj;
    SPolozaj = RECORD
                 Ko, Vr: INTEGER;
                 Cena: DomenCene;
                 Veza: PPolozaj;
               END;

    PKraljica = POINTER TO SKraljica;
    SKraljica = RECORD
                  Pre, Sled: PKraljica;
                  Kandidati: PPolozaj;
                  TekKo, TekVr: INTEGER;
                END;

    StanjeTip = RECORD
                  Cena: DomenCene;
                  PrvaKra, TekKra: PKraljica;
                END;
    StatusTip = (stZauzeto, stNapadnuto, stSlobodno);
    ResenjeTip = RECORD
                   Cena: DomenCene;
                   Poz: ARRAY Interval, Interval OF StatusTip;
                 END;
  VAR
    BrojKol, BrojVrs: INTEGER;
    BrojKraljica: INTEGER;

  PROCEDURE Unos();
  BEGIN
    REPEAT
      WrLn;
      WrStr('Unesite broj Kolona sahovske table (od 1 do ');
      WrCard(MaxDim, 1);
      WrStr(') ------- ');
      BrojKol:= RdCard();
    UNTIL OK AND (1 <= BrojKol) AND (BrojKol <= MaxDim);
    REPEAT
      WrLn;
      WrStr('Unesite broj Vrsta sahovske table (od 1 do ');
      WrCard(MaxDim, 1);
      WrStr(') ------- ');
      BrojVrs:= RdCard();
    UNTIL OK AND (1 <= BrojVrs) AND (BrojVrs <= MaxDim);
    REPEAT
      WrLn;
      WrStr('Unesite broj kraljica (od 1 do ');
      WrCard(BrojKol * BrojVrs, 1);
      WrStr(') ------- ');
      BrojKraljica:= RdCard();
    UNTIL OK AND (1 <= BrojKraljica) AND (BrojKraljica <= BrojKol * BrojVrs);
  END Unos;

  PROCEDURE Postavi(VAR Stanje: StanjeTip);
    VAR
      Temp: PPolozaj;
  BEGIN
    WITH Stanje DO
      Temp:= TekKra^.Kandidati;
      TekKra^.Kandidati:= Temp^.Veza;
      TekKra^.TekKo:= Temp^.Ko;
      TekKra^.TekVr:= Temp^.Vr;
      Cena:= Temp^.Cena;
      DISPOSE(Temp);
    END;
  END Postavi;

  PROCEDURE Inicijalizacija(VAR Stanje: StanjeTip; VAR Br: CARDINAL);
    VAR
      Tek, Pom: PKraljica;
      i: DomenBrojaKraljica;
  BEGIN
    Br:= 0;
    WITH Stanje DO
      Cena:= 0;
      NEW(PrvaKra);
      TekKra:= PrvaKra;
      Tek:= PrvaKra;
      Tek^.Pre:= NIL;
      FOR i:= 2 TO BrojKraljica DO
        Pom:= Tek;
        NEW(Tek^.Sled);
        Tek:= Tek^.Sled;
        Tek^.Pre:= Pom;
      END;
      Tek^.Sled:= NIL;
    END;
  END Inicijalizacija;

  PROCEDURE Ispitaj(Ko, Vr: INTEGER; Granica: PKraljica; VAR Stanje: StanjeTip; VAR Status: StatusTip);
    VAR
      Tek: PKraljica;
      Jos: BOOLEAN;
  BEGIN
    WITH Stanje DO
      Tek:= PrvaKra;
      Jos:= Tek # Granica;
      Status:= stSlobodno;
      WHILE Jos DO
        IF (Tek^.TekKo = Ko) AND (Tek^.TekVr = Vr) THEN
          Status:= stZauzeto;
          Jos:= FALSE;
        ELSE
          IF (Tek^.TekKo = Ko) OR (Tek^.TekVr = Vr) OR (ABS(Tek^.TekKo - Ko) = ABS(Tek^.TekVr - Vr)) THEN
            Status:= stNapadnuto;
          END;
          IF Tek^.Sled= Granica THEN
            Jos:= FALSE;
          ELSE
            Tek:= Tek^.Sled;
          END;
        END;
      END;
    END;
  END Ispitaj;

  PROCEDURE Stampa(VAR Resenje: ResenjeTip);
    CONST
      ImeFajla = "Resenje.txt";
    VAR
      Ko, Vr: INTEGER;
      Izlaz: FIO.File;
  BEGIN
    IF FIO.Exists(ImeFajla) THEN
      Izlaz:= FIO.Append(ImeFajla);
    ELSE
      Izlaz:= FIO.Create(ImeFajla);
    END;
    WrLn;
    WrStr('-----------------------------------------------------------------');
    WrStr('---------------');
    WrLn;
    FIO.WrLn(Izlaz);
    WrStr('Kraljice treba staviti na sledeca polja:');
    FIO.WrStr(Izlaz, 'Kraljice treba staviti na sledeca polja:');
    WrLn;
    FIO.WrLn(Izlaz);
    FOR Vr:= BrojVrs TO 1 BY -1 DO
      WrLn;
      FIO.WrLn(Izlaz);
      FOR Ko:= 1 TO BrojKol DO
        CASE Resenje.Poz[Ko, Vr] OF
          stZauzeto: WrStr(' Q');
                     FIO.WrStr(Izlaz, ' Q'); |
          stNapadnuto: WrStr(' x');
                       FIO.WrStr(Izlaz, ' x');
        ELSE
          WrStr(' .');
          FIO.WrStr(Izlaz, ' .');
        END;
      END;
    END;
    WrLn;
    FIO.WrLn(Izlaz);
    WrLn;
    FIO.WrLn(Izlaz);
    WrStr('Broj slobodnih polja je: ');
    FIO.WrStr(Izlaz, 'Broj slobodnih polja je: ');
    WrCard(BrojKol * BrojVrs - Resenje.Cena, 1);
    FIO.WrCard(Izlaz, BrojKol * BrojVrs - Resenje.Cena, 1);
    FIO.Close(Izlaz);
  END Stampa;

  PROCEDURE Dame(BrojKol, BrojVrs: INTEGER);
    VAR
      Stanje: StanjeTip;
      Resenje: ResenjeTip;
      MinCena: DomenCene;
      Br: CARDINAL;

    PROCEDURE NadjiKandidate(VAR Stanje: StanjeTip);

      PROCEDURE NadjiCenu(k, v: INTEGER; VAR Cena: DomenCene; VAR Stanje: StanjeTip);
        VAR
          Ko, Vr: INTEGER;
          Status: StatusTip;
      BEGIN
        Cena:= 0;
        FOR Ko:= 1 TO BrojKol DO
          FOR Vr:= 1 TO BrojVrs DO
            IF (Ko # k) AND (Vr # v) AND (ABS(Ko - k) # ABS(Vr - v)) THEN
              Ispitaj(Ko, Vr, Stanje.TekKra, Stanje, Status);
              IF Status # stSlobodno THEN
                INC(Cena);
              END;
            ELSE
              INC(Cena);
            END;
          END;
        END;
      END NadjiCenu;

      PROCEDURE Ubaci(VAR Prvi, Novi: PPolozaj);
        VAR
          Tek: PPolozaj;
      BEGIN
        IF (Prvi = NIL) OR (Novi^.Cena < Prvi^.Cena) THEN
          Novi^.Veza:= Prvi;
          Prvi:= Novi;
        ELSE
          Tek:= Prvi;
          WHILE (Tek^.Veza # NIL) AND (Tek^.Veza^.Cena < Novi^.Cena) DO
            Tek:= Tek^.Veza;
          END;
          Novi^.Veza:= Tek^.Veza;
          Tek^.Veza:= Novi;
        END;
      END Ubaci;

      VAR
        k, v: INTEGER;
        Temp, Prvi: PPolozaj;
        NovaCena: DomenCene;
        PocKol, PocVrs: INTEGER;

    BEGIN
      Prvi:= NIL;
      IF Stanje.TekKra = Stanje.PrvaKra THEN
        PocKol:= 1;
      ELSE
        PocKol:= Stanje.TekKra^.Pre^.TekKo;
      END;
      FOR k:= PocKol TO BrojKol DO
        IF (k = PocKol) AND (Stanje.TekKra # Stanje.PrvaKra) THEN
          PocVrs:= Stanje.TekKra^.Pre^.TekVr + 1;
        ELSE
          PocVrs:= 1;
        END;
        FOR v:= PocVrs TO BrojVrs DO
          NadjiCenu(k, v, NovaCena, Stanje);
          IF NovaCena < MinCena THEN
            NEW(Temp);
            WITH Temp^ DO
              Veza:= NIL;
              Ko:= k;
              Vr:= v;
              Cena:= NovaCena;
            END;
            Ubaci(Prvi, Temp);
          END;
        END;
      END;
      Stanje.TekKra^.Kandidati:= Prvi;
    END NadjiKandidate;

    PROCEDURE ZapamtiResenje(VAR Stanje: StanjeTip; VAR Resenje: ResenjeTip);
      VAR
        Ko, Vr: INTEGER;
        Status: StatusTip;
    BEGIN
      Resenje.Cena:= Stanje.Cena;
      FOR Ko:= 1 TO BrojKol DO
        FOR Vr:= 1 TO BrojVrs DO
          Ispitaj(Ko, Vr, NIL, Stanje, Status);
          Resenje.Poz[Ko, Vr]:= Status;
        END;
      END;
    END ZapamtiResenje;

  BEGIN
    Inicijalizacija(Stanje, Br);
    MinCena:= BrojKol * BrojVrs  + 1;
    NadjiKandidate(Stanje);
    WITH Stanje DO
      WHILE TekKra # NIL DO
        WHILE TekKra^.Kandidati # NIL DO
          IF TekKra = PrvaKra THEN
            INC(Br);
            WrCard(Br, 4);
          END;
          Postavi(Stanje);
          IF TekKra^.Sled = NIL THEN
            IF Cena < MinCena THEN
              MinCena:= Cena;
              ZapamtiResenje(Stanje, Resenje);
            END;
          ELSE
            TekKra:= TekKra^.Sled;
            NadjiKandidate(Stanje);
          END;
        END;
        TekKra:= TekKra^.Pre;
      END;
      Stampa(Resenje);
    END;
  END Dame;

  VAR
	as,df : Interval;
  
BEGIN
  Unos();
  WrLn;
  WrStr('Sacekajte !!!');
  WrLn;
  Dame(BrojKol, BrojVrs);
  as := 5;
  df := 6;
END Queens2.