{
    This file is part of matrix
    Copyright (c) 2008 by Riccardo Iaconelli

    A calculator able to operate on matrixes

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

}

program matrix_calc;

  uses crt;
  type matrix = array[1..10, 1..10] of integer;

  var n, s, argc : integer;
  var operation : char;
  var m : array [1..2] of matrix;

// Functions!

function det (a : matrix) : integer;
begin
  det := (a[1,1] * a[2,2]) - (a[1,2] * a[2,1]);
end;

function sum (a : matrix; b : matrix) : matrix;
  var i, j : integer;
begin
  for i:=1 to n do
  begin
    for j:=1 to n do
    begin
      sum[i,j] := a[i,j] + b[i,j];
    end;
  end;
end;

function invsum (a : matrix) : matrix;
  var i, j : integer;
begin
  for i:=1 to n do
  begin
    for j:=1 to n do
    begin
      invsum[i,j] := -a[i,j]
    end;
  end;
end;

function multiply (a : matrix; b : matrix) : matrix; { a, b: numbers to multiply. if b = -1,
                                                                find the inverse of a }
  var i, j, k : integer;
  var r : matrix;
begin
  for i:=1 to n do
  begin
    for j:=1 to n do
    begin
      r[i,j] := 0;
      for k:=1 to n do
      begin
        r[i,j] := r[i,j] + (a[i,k] * b[k,j])
      end;
    end;
  end;
  multiply := r;
end;

function multiply (a : matrix; b : integer) : matrix;
  var i, j : integer;
begin
  for i:=1 to n do
  begin
    for j:=1 to n do
    begin
      multiply[i,j] := a[i,j] * b;
    end;
  end;
end;


function inv_multiply (a : matrix) : matrix;
  var i, j : integer;
  var r : matrix;
begin
  if not ((det(a) = 0) or (n <> 2)) then // Let's just make sure...
  begin
    r[1,1] := a[2,2];
    r[2,2] := a[1,1];
    r[1,2] := -a[1,2];
    r[2,1] := -a[2,1];

    for i:=1 to n do
      for j:=1 to n do
        inv_multiply[i,j] := (r[i,j]) div (det(a));
  end;
end;

function get_matrix : matrix;
  var i, j : integer;
begin
  for i:=1 to n do
  begin
    for j:=1 to n do
    begin
      Write('Inserisci a(', i, j, '): ');
      Read(get_matrix[i,j]);
    end;
  end;
end;

procedure print_matrix (r : matrix);
  var i, j : integer;
begin
  // Draw the upper decoration
  Write(char($DA), '  ');
  for i:=1 to n do
    Write('     ');
  WriteLn('  ', char($BF));

  // Draw matrix
  for i:=1 to n do
  begin
    Write(char($7C), ' ');
    for j:=1 to n do
    begin
      Write(r[i, j]:4);
      if (j <> n) then
        Write('    ');
    end;
    WriteLn(' ', char($7C));
  end;

  // Draw bottom decoration
  Write(char($C0), '  ');
  for i:=1 to n do
    Write('     ');
  WriteLn('  ', char($D9));
end;

procedure get_data;
  var i : integer;
begin
  for i := 1 to argc do
  begin
    if argc = 1 then
      WriteLn('Inserisci la matrice:')
    else
      WriteLn('Inserisci la ', i, ' matrice:');
    
    m[i] := get_matrix;
  end;

  if (operation = 's') then
  begin
    Write('Moltiplica la matrice per: ');
    Read(s);
  end;
end;

procedure eval;
  var r : matrix;
  var d : integer;
begin

  if (operation = '+') then
    r := sum(m[1], m[2])
  else if (operation = '/') then
    r := inv_multiply(m[1])
  else if (operation = '-') then
    r:= invsum(m[1])
  else if (operation = 'd') then
  begin
    r := m[1];
    d := det(m[1])
  end
  else if (operation = 's') then
    r := multiply(m[1], s)
  else if (operation = 'x') then
    r := multiply(m[1], m[2]);

  WriteLn();
  WriteLn('===============================================');

  if (operation = 'd') then
    WriteLn('La matrice data e'' stata:')
  else
    WriteLn('La matrice risultante e'':');

  print_matrix(r);

  if (operation = 'd') then
    WriteLn(' ...e il suo determinante e'': ', d);

  WriteLn('===============================================');
  WriteLn();

end;

function operation_implemented(op : char) : boolean;
begin
  if (((op = 'd') or (op = '/')) and (n > 2)) then
  begin
    operation_implemented := false;
    WriteLn('L''operazione non e'' implementata per matrici maggiori di ordine 2. Spiacente. :(');
  end
  else
    operation_implemented := true;
end;

function operation_valid(a : matrix; op : char) : boolean;
begin
  if ((op = '/') and (det(a) = 0)) then
  begin
    operation_valid := false;
    WriteLn;
    WriteLn('** L''operazione non e'' possibile per la matrice data! **');
    WriteLn('Infatti, il determinante della matrice assegnata:');
    print_matrix(a);
    WriteLn('e'' uguale a zero! E sai bene che e'' impossibile dividere per zero!');
    WriteLn
  end
  else
    operation_valid := true;
end;

procedure change_n;
begin
  clrscr;
  WriteLn('Per ora si sta operando con matrici quadrate di ordine: ', n, '.');
  Write('Cambiare in? (valore max. 10) ');
  Read(n);
  if (n > 10) then
  begin
    WriteLn('Valore troppo grosso. Imposto n a 2...');
    n := 2;
  end
  else if (n < 1) then
  begin
    WriteLn('PER FAVORE! CHE ASSURDITA''! Imposto n a 2, cosi'' impari!');
    n := 2;
  end
  else
    WriteLn('Il valore e'' stato cambiato con successo! Stai ora operando con matrici ', n, 'x', n, '.');
end;

function engage : boolean; { handles the main loop, if quitting returns 0}
  var scelta, operation_count, quit_number, change_n_number : integer;
begin

// Pascal is not optimal, fill in some data about the menu so that we don't get crazy
// with debugging if we decide to add an operation of something

  operation_count := 6;
  change_n_number := operation_count+1;
  quit_number := operation_count+2;

// Paint

  clrscr;

  WriteLn('Calcolatrice con matrici quadrate di ordine ', n);
  WriteLn('----------------------------------------------');
  WriteLn(' ');
  WriteLn('Operazioni con due matrici:');
  WriteLn(' ');
  WriteLn(' (1) - Somma');
  WriteLn(' (2) - Moltiplicazione');
  WriteLn(' ');
  WriteLn('Operazioni con una matrice:');
  WriteLn(' ');
  WriteLn(' (3) - Inverso della somma');
  WriteLn(' (4) - Inverso della moltiplicazione (Attenzione! Risultato approssimato!)');
  WriteLn(' (5) - Determinante di una matrice');
  WriteLn(' (6) - Prodotto di uno scalare per una matrice');
  WriteLn(' ');
  WriteLn('Altro:');
  WriteLn(' ');
  WriteLn(' (7) - Cambia ordini delle matrici');
  WriteLn(' (8) - Esci');
  WriteLn();
  Write('vx', n, '@matrix> ');
  Read(scelta);

// Set proprieties for the evaluation

  if (scelta = quit_number) then
    engage := false
  else
    engage := true;

  if scelta = change_n_number then
    change_n;

  if scelta < (operation_count+1) then
  begin
    if (scelta < 3) then
      argc := 2
    else
      argc := 1;

    if (scelta = 1) then
      operation := '+'
    else if (scelta = 2) then
      operation := 'x'
    else if (scelta = 3) then
      operation := '-'
    else if (scelta = 4) then
      operation := '/'
    else if (scelta = 5) then
      operation := 'd'
    else if (scelta = 6) then
      operation := 's';

    // Check if the operation is possible. Those two function will automatically
    // warn the user in case something is wrong, and explain to the user the failure.
    if (operation_implemented(operation)) then
    begin
      get_data;
      if operation_valid(m[1], operation) then // we just pass the first matrix because we can have
                                               // invalid data only for operations with one matrix
      begin
        eval;
      end;
    end;
  end;

end;

procedure let_him_see;
begin
    WriteLn();
    WriteLn('Premi invio per tornare al menu principale.');
    ReadLn();
    ReadLn(); { Don't ask why I need two of these... }
end;

begin
  n := 2;

  while (engage) do
  begin
    let_him_see;
  end;

  WriteLn('To boldly go where no matrix calculator has gone before!');
  WriteLn();
  WriteLn('<Press Enter to quit>');
  ReadLn();
  ReadLn();
end.