module rodst2;

var $n : tuple of atom := atom[];

var $ch : tuple of atom := atom[Иван, Екатерина];

var $nikto : integer := 0;
var $win1;
var $wy : integer := 20;

rule ввод
   forall $x: Человек( имя: $имя )
=>
   $n := $n + atom[$имя] ;
end;

rule ввод1
=>
   var $m1,$m2 : integer;
   $m1 := Menu(400,50," Выберите человека", $n, 1 );
   $ch[1]:= $n[$m1];
   OutText( $win1, 50, $wy, $ch[1]);
   $wy:=$wy+15;
   $m2 := Menu(400,50," Выберите человека", $n, 1 );
   $ch[2]:= $n[$m2];
   OutText( $win1, 50, $wy, $ch[2]);
   $wy:=$wy+30;
end;

rule ввод2
exist $x: Человек( имя:$имяx ),
      $y: Человек( имя:$имяy )
  when ( $имяx = $ch[1] ) & ( $имяy = $ch[2] )
=>
  new родств($x, $y);
end;

// Правило для остановки
rule Stop
=>
  activate group();
end;

rule ДетиРодителей
  forall $x: Человек( родители: $род )
  when #$род != 0
=>
  for $i in $род loop
       edit   $i: Человек( дети:  $i.дети + Человек{$x} );
  end;
end;

rule РодителиДетей
  forall $x: Человек(  супруг: $супруг, дети: $дети )
  when (#$дети != 0) & ($супруг != ?)
=>
  if #$супруг.дети = 0
  then edit   $супруг: Человек( дети: $дети );
  end;
  for $ii in $дети loop
      if #$ii.родители != 2
      then edit   $ii: Человек( родители: Человек{$x, $супруг });
      end;
  end;
end;

/*----------------------------------------------------------------*/

rule Мать_Отец
exist $rod : родств(кто: $x, кому: $y),
      $x: Человек( родители: $род )
      when ( #$род != 0 ) & ( $y in $род  )
=>
      if $y.пол = муж
      then
           OutText( $win1, 50, $wy, ToString($y.имя)+ "  отец "+ ToString($x.имя) );
      else
           OutText( $win1, 50, $wy,ToString($y.имя)+ "  мать "+ToString($x.имя) );
       end;

      $wy := $wy + 15;

      if $x.пол = муж
      then
           OutText( $win1, 50, $wy, ToString($x.имя) + "  сын " + ToString($y.имя) );
      else
           OutText( $win1, 50, $wy, ToString($x.имя)+"  дочь " + ToString($y.имя) );
      end;
      $wy := $wy + 30;
finish
//      call group(Stop);
    activate group();
end;

rule Бабушка_Дедушка
exist $rod : родств(кто: $x, кому: $y),
      $x: Человек( родители: $род ),
      $y: Человек(дети: $дети )
      when ( #($род * $дети) != 0 )
=>

      if $y.пол = муж
      then
          OutText( $win1, 50, $wy, ToString($y.имя) + "  дедушка " + ToString($x.имя) );
      else
          OutText( $win1, 50, $wy, ToString($y.имя) + "  бабушка " + ToString($x.имя) );
      end;

      $wy := $wy + 15;

      if $x.пол = муж
      then
          OutText( $win1, 50, $wy, ToString($x.имя) + "  внук " + ToString($y.имя) );
      else
          OutText( $win1, 50, $wy, ToString($x.имя) + "  внучка " + ToString($y.имя) );
      end;

      $wy := $wy + 30;
finish
//      call group(Stop);
//  activate group();
 end;

rule Брат_Сестра
  exist $rod : родств(кто: $x, кому: $y),
         $x: Человек( родители: $род ),
         $y: Человек( родители: $род )
         when (#$род != 0 )
=>

         if $x.пол = муж
         then
             OutText( $win1, 50, $wy, ToString($x.имя) + "  брат " + ToString($y.имя) );
         else
             OutText( $win1, 50, $wy, ToString($x.имя) + "  сестра " + ToString($y.имя) );
         end;

         $wy := $wy + 15;

         if $y.пол = муж
         then
             OutText( $win1, 50, $wy, ToString($y.имя) + "  брат " + ToString($x.имя) );
         else
             OutText( $win1, 50, $wy, ToString($y.имя) + "  сестра " + ToString($x.имя) );
         end;
      $wy := $wy + 30;
finish
//      call group(Stop);
//  activate group();
end;

rule Супруг
  exist $rod : родств(кто: $x, кому: $y ),
        $x: Человек( имя:$имя, супруг: $y )
=>
         if $x.пол = муж
         then
             OutText( $win1, 50, $wy, ToString($x.имя) + "  муж " + ToString($y.имя) );
         else
             OutText( $win1, 50, $wy, ToString($x.имя) + "  жена " + ToString($y.имя) );
         end;

         $wy := $wy + 15;

         if $y.пол = муж
         then
             OutText( $win1, 50, $wy, ToString($y.имя) + "  муж " + ToString($x.имя) );
         else
             OutText( $win1, 50, $wy, ToString($y.имя) + "  жена " + ToString($x.имя) );
         end;

      $wy := $wy + 30;
finish
//      call group(Stop);
//  activate group();
end;

rule Кузен_Кузина
  exist $rod : родств(кто: $x, кому: $y),
         $x: Человек( родители: $род1 ),
         $y: Человек( родители: $род2 )
         when ( #($род1)!=0 & #($род2) != 0 & $род1!=$род2)
=>
        for $ii in $род1 loop
          for $ij in $род2 loop
            if #$ii.родители!=0 & #$ij.родители!=0 & $ii.родители=$ij.родители
            then
              if $x.пол = муж
              then
                 OutText( $win1, 50, $wy, ToString($x.имя) + "  кузен " + ToString($y.имя) );
              else
                 OutText( $win1, 50, $wy, ToString($x.имя) + "  кузина " + ToString($y.имя) );
              end;

              $wy := $wy + 15;

              if $y.пол = муж
              then
                  OutText( $win1, 50, $wy, ToString($y.имя) + "  кузен " + ToString($x.имя) );
              else
                  OutText( $win1, 50, $wy, ToString($y.имя) + "  кузина " + ToString($x.имя) );
              end;
              $wy := $wy + 30;
            end; //if
          end; //for ij
        end; //for ii
finish
//      call group(Stop);
//  activate group();
end;

rule Дядя_Тетя
exist $rod: родств(кто: $x, кому: $y),
      $y: Человек(родители: $r1),
      $x: Человек(родители: $r2)
      when(#($r1)!=0 & #($r2)!=0 & $r1!=$r2)
=>
    $wy := $wy + 15;
    for $i in $r1 loop
            if #$i.родители !=0 & $i.родители = $r2 then
            $wy := $wy + 15;
                if $y.пол = муж then
                        OutText( $win1, 50, $wy, ToString($x.имя) + " дядя " + ToString($x.имя));
                else
                        OutText( $win1, 50, $wy, ToString($x.имя) + " тётя " + ToString($x.имя));
                end;
                $wy := $wy + 15;

                if $x.пол = муж then
                        OutText( $win1, 50, $wy, ToString($y.имя) + " племянник " + ToString($x.имя));
                else
                        OutText( $win1, 50, $wy, ToString($y.имя) + " племянница " + ToString($x.имя));
                end;
            $wy := $wy + 15;
            $nikto := 1;
        end;
    end;
finish
//      call group(Stop);
//  activate group();
end;

rule Теща_Тесть
exist $rod : родств(кто: $x, кому: $y),
      $x: Человек(супруг: $s1),
      $y: Человек(дети: $s2)
      when ($s1 in $s2)
=>
    if ($x.пол = муж) then
            if $y.пол = муж then
                OutText( $win1, 50, $wy, ToString($y.имя) + " тесть " + ToString($x.имя) );
            else
                OutText( $win1, 50, $wy, ToString($y.имя) + " тёща " + ToString($x.имя) );
            end;
        $wy := $wy + 15;
        OutText( $win1, 50, $wy, ToString($x.имя) + " зять " + ToString($y.имя) );
        $wy := $wy + 15;
        $nikto := 1;
    end;
finish
//      call group(Stop);
//  activate group();
end;

rule Свекр_Свекровь
exist $rod : родств(кто: $x, кому: $y),
      $y: Человек(супруг: $s1),
      $x: Человек(дети: $s2)
      when ($s1 in $s2)
=>
    if ($y.пол = жен) then
            if $x.пол = муж then
                OutText( $win1, 50, $wy, ToString($x.имя) + " свёкр " + ToString($y.имя) );
            else
                OutText( $win1, 50, $wy, ToString($x.имя) + " свекровь " + ToString($y.имя) );
            end;
        $wy := $wy + 15;
        OutText( $win1, 50, $wy, ToString($y.имя) + " невестка " + ToString($x.имя) );
        $wy := $wy + 15;
        $nikto := 1;
    end;
end;

rule Сват_Сватья
  exist $rod : родств(кто: $x, кому: $y),
      $x: Человек( дети: $d1),
      $y: Человек( дети: $d2)
      when #($d1 * $d2) = 0
=>
    for $i in $d1 loop
        for $j in $d2 loop
                if $i.супруг = $j then

                    if $y.пол = муж then
                        OutText( $win1, 50, $wy, ToString($y.имя) + " сват " + ToString($x.имя) );
                    else
                        OutText( $win1, 50, $wy, ToString($y.имя) + " сватья " + ToString($x.имя) );
                    end;
                $wy := $wy + 15;
                    if $x.пол = муж then
                        OutText( $win1, 50, $wy, ToString($x.имя) + " сват " + ToString($y.имя) );
                    else
                        OutText( $win1, 50, $wy, ToString($x.имя) + " сватья " + ToString($y.имя) );
                    end;
                $wy := $wy + 15;
                $nikto := 1;
            end;
        end;
    end;
end;
/*
rule Шурин
exist $rod : родств(кто: $x, кому: $y),
      $x: Человек( супруг: $s),
      $s: Человек( родители: $r),
      $y: Человек( родители: $r)
      when #$r != 0
=>
    if $x.пол = муж & $y.пол = муж then
        OutText( $win1, 50, $wy, ToString($y.имя) + " шурин " + ToString($x.имя) );
        $wy := $wy + 15;
    end;
end;

rule Деверь_Золовка
  exist $rod : родств(кто: $x, кому: $y),
      $x: Человек( супруг: $s),
      $s: Человек( родители: $r),
      $y: Человек( родители: $r)
      when #$r != 0
=>
    if $x.пол = жен then
        if $y.пол = муж then
            OutText( $win1, 50, $wy, ToString($y.имя) + " деверь " + ToString($x.имя) );
        end;

        if $y.пол = жен then
            OutText( $win1, 50, $wy, ToString($y.имя) + " золовка " + ToString($x.имя) );
        end;
        $wy := $wy + 30;
        OutText( $win1, 50, $wy, ToString($x.имя) + " невестка " + ToString($y.имя) );
        $wy := $wy + 15;
    end;
end;
*/
rule НетРодства
  exist $rod : родств(кто: $x, кому: $y)
  when  $nikto = 0
=>
  OutText( $win1, 50, $wy, ToString($x.имя) + " не состоит в родственных отношениях с " + ToString($y.имя) );
end;

var $правила: group := group(
    ДетиРодителей,
    РодителиДетей,
    ввод,
    ввод1,
    ввод2,
        Мать_Отец,
    Бабушка_Дедушка,
    Брат_Сестра,
    Супруг,
    Кузен_Кузина,
    Дядя_Тетя,
    Сват_Сватья,
    Теща_Тесть,
    Свекр_Свекровь,
    НетРодства,
    Stop
);

begin
  new

    @Валерий: Человек (имя: Валерий, пол: муж),
    @Ирина: Человек (имя: Ирина, пол: жен, супруг: @Валерий),
    @Никита: Человек (имя: Никита, пол: муж ),
    @Анна: Человек (имя: Анна, пол: жен, супруг: @Никита ),
    @Тимофей: Человек (  имя: Тимофей, пол: муж ),
    @Екатерина: Человек (  имя: Екатерина, пол: жен, супруг: @Тимофей ),
    @Давид: Человек (  имя: Давид, пол: муж, родители: (Человек { @Валерий , @Ирина }) ),
    @Юлия: Человек (  имя: Юлия, пол: жен, супруг: @Давид, родители: (Человек { @Никита , @Анна }) ),
    @Владимир: Человек (  имя: Владимир, пол: муж, родители: (Человек { @Никита , @Анна }) ),
    @Анастасия: Человек (  имя: Анастасия, пол: жен, супруг: @Владимир, родители: (Человек { @Тимофей , @Екатерина }) ),
    @Владислав: Человек (  имя: Владислав, пол: муж, родители: (Человек { @Тимофей , @Екатерина }) ),
    @Александр: Человек (  имя: Александр, пол: муж, родители: (Человек { @Давид , @Юлия }) ),
    @Тимур: Человек (  имя: Тимур, пол: муж, родители: (Человек { @Владимир , @Анастасия }) ),
    @Дмитрий: Человек (  имя: Дмитрий, пол: муж, родители: (Человек { @Владимир , @Анастасия }) ),
    @Елена: Человек (  имя: Елена, пол: жен, супруг: @Дмитрий );


   $win1 := MakeWindow("Вопросно-ответная система 'Родственники'", 0,0,1010,640);
   TextColor($win1,4);
   call $правила;
   if (Ask("Конец сеанса", "Закрыть окна?"))
   then  CloseWindow($win1);
   end;
WriteNet();

end.