Постройте на экране "Замок" - Free Pascal

{*****************************************************}
{                                                     }
{                  ТУРБОГРАФ XXI                      }
{                   Версия 2.1                        }
{                                                     }
{                  Модуль Fraction                    }
{           Операции с обыкновенными дробями          }
{                                                     }
{         Copyright (C) 1993,98  С.Свердлов           }
{                                                     }
{*****************************************************}
unit Fraction;
 
interface
 
type
 
   FracType =
      record
         Num, Den : longint;
      end;
 
function MCD( x, y : longint ) : longint;
procedure FCancel( var x : FracType );
procedure FMult( x, y : FracType; var Z : FracType );
procedure FInv( x : FracType; var y : FracType );
procedure FracRound( s, t : longint; var p, q : integer; Max : integer );
 
{=========================================================================}
 
implementation
 
function MCD( x, y : longint ) : longint;
   { НОД по алгоритму Евклида }
var
   Buf : longint;
begin
   while y <> 0 do begin
      Buf := y;
      y := x mod y;
      x := Buf;
   end;
   MCD := x;
end;
 
procedure FCancel( var x : FracType );
var
   d : longint;
begin
   with x do begin
      d := MCD( Num, Den );
      if d <> 0 then begin
         Num := Num div d;
         Den := Den div d;
      end;
   end;
end;
 
procedure FMult( x, y : FracType; var z : FracType );
var
   d1, d2, d : longint;
begin
   z.Num := x.Num*y.Num;
   z.Den := x.Den*y.Den;
   FCancel( z );
end;
 
procedure FInv( x : FracType; var y : FracType );
begin
   y.Num := x.Den;
   y.Den := x.Num;
end;
 
procedure FracRound( s, t : longint; var p, q : integer; Max : integer );
var
   b              : longint;
   k              : integer;
   ss, tt, Save   : longint;
   pp, qq         : longint;
begin
   if s=0 then begin
      p := 0;
      q := 1;
      end
   else begin
      k := 0;
      p := 0; q := 1;
      pp := 0; qq := 0;
      while ( s<>0 ) and ( pp < Max ) and ( qq < Max )do begin
         Inc(k);
         b := t div s;
         Save := t mod s;
         t := s;
         s := Save;
         if k=1 then begin
            pp := 1;
            qq := b;
            end
         else begin
            Save := b*pp+p;
            p := pp;
            pp := Save;
            Save := b*qq+q;
            q := qq;
            qq := Save;
         end;
      end;
      if ( pp < Max ) and ( qq < Max ) then begin
         p := pp;
         q := qq;
      end;
   end;
end;
 
 
end.