home *** CD-ROM | disk | FTP | other *** search
/ Win Platinum / Win Platinum.iso / apps / pascal-w / magic.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-08-20  |  1.8 KB  |  68 lines
  1. PROGRAM Magic(Input, Output);
  2.  
  3. const
  4.    maxsize = 11;    {Maximum size of square}
  5. type
  6.    sqrtype = ARRAY[1..maxsize, 1..maxsize] OF Integer;
  7. var
  8.    square : sqrtype;
  9.    size, row, sum : Integer;
  10.  
  11.   Procedure MakeSquare( VAR sq : sqrtype; Limit : Integer );
  12.   var
  13.      num, r, c  : Integer;
  14.  
  15.   begin
  16.     FOR r := 1 TO Limit DO
  17.       FOR c := 1 TO Limit DO sq[r, c] := 0;
  18.  
  19.     IF Odd(Limit) THEN
  20.       BEGIN (* start in middle row of last column *)
  21.         r := (Limit+1) DIV 2;
  22.         c := Limit;
  23.         FOR num := 1 TO Sqr(Limit) DO
  24.           BEGIN
  25.             IF sq[r, c] <> 0 THEN
  26.               BEGIN (* select a different diagonal *)
  27.                 r := r-1; IF r < 1 THEN r := r+Limit;
  28.                 c := c-2; IF c < 1 THEN c := c+Limit;
  29.               END;
  30.             sq[r, c] := num; (* move down diagonally to right *)
  31.             r := r+1; IF r > Limit THEN r := r-Limit;
  32.             c := c+1; IF c > Limit THEN c := c-Limit;
  33.           END; (* FOR *)
  34.       END; (* IF *)
  35.   END; (* MakeSquare *)
  36.  
  37.   Procedure WriteSquare( VAR sq: sqrtype; Limit: Integer );
  38.   var 
  39.      row, col : Integer;
  40.  
  41.   Begin
  42.      FOR row := 1 TO Limit DO
  43.         begin
  44.     for col := 1 to (Limit div 2) do
  45.        Write( sq[row, 2*col -1]:4, sq[row, 2*col]:4 );
  46.         Writeln( sq[row, Limit]:4 );
  47.         end;
  48.   End; (* PrintSquare *)
  49.  
  50. begin
  51.   size := 3;
  52.   while ( size <= maxsize ) do
  53.      begin
  54.      WriteLn( 'Magic Square of size = ', size:3 );
  55.      WriteLn;
  56.      MakeSquare( square, size );
  57.      WriteSquare( square, size );
  58.      WriteLn;
  59.      sum := 0;
  60.      FOR row := 1 TO size DO 
  61.         sum := sum + square[row, 1];
  62.      WriteLn('Sum of row, column or diagonal = ', sum:5);
  63.      WriteLn;
  64.      WriteLn;
  65.      size := size+2;
  66.      end;
  67. end.
  68.