Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/LONGINT.ZIP/DERSH1.PAS

Pascal/Delphi Source File | 1988-10-24 | 11.2 KB | 405 lines

program project1(input,output);
{This program fulfills the requirements of Project 1 in CSCI 220 - Fall 1988.
 It permits the entry, printing, addition, and subtraction of long integers.
 Author: Herbert L. Dershem
 Date  : October 21, 1988
 Program Title: Long Integers}

const maxlen = 80;  {Maximum length of a number}
type numstring = varying [maxlen + 1] of char;  {representing long integers}
     string = varying [80] of char;             {representing character strings}
     intarray = array [1..maxlen] of integer;   {integer representation of long
                                                 integers}
     longnum = record            {longnum is the internal form of long integers}
                 sign:char;
                 whole:intarray;
                 fraction:intarray;
               end;
     vararray = array ['A'..'Z'] of longnum; {array of longnum variables}

var v:vararray;          {variable array}
    selection:integer;   {menu selection}

procedure initialize(var v:vararray);
{Initialize the variable array to sign of *}
var c:char;
begin
  for c:='A' to 'Z' do
    v[c].sign:='*';
end; {initialize}

procedure presentmenu;
{Present the menu to the user}
begin
  writeln('1. Enter a number');
  writeln('2. Print a number');
  writeln('3. Add numbers');
  writeln('4. Subtract numbers');
  writeln('5. Terminate program');
  writeln;
end; {presentmenu}

procedure menuselect(var selection:integer);
{Make a legal selection from the menu.  Prompts for entry will continue until
 a legal entry (1-5) is made.}
var c:char;
begin
  presentmenu;
  write('Enter your selection: ');
  readln(c);
  while not (c in ['1'..'5']) do
  begin
    writeln('Illegal entry - enter an integer from 1 to 5');
    write('Enter you selection: ');
    readln(c);
  end;
  selection := ord(c) - ord('0');
end; {menuselect}

function upper(c:char):char;
{If c is a lower case letter, change to upper case.  Otherwise return c
 unchanged.}
begin
  if c in ['a'..'z'] then
    upper := chr(ord(c) + ord('A') - ord('a'))
  else
    upper := c;
end; {upper}

procedure getvar(comment:string; var vname:char);
{Use comment to prompt for a variable name and return a legal name ('A'..'Z').
 Procedure will continue to prompt until a legal entry is made.  Lower case
 letters will be converted to legal upper case letters.}
begin
  write('What variable do you wish to '+comment+'?');
  readln(vname);
  vname := upper(vname);
  while not (vname in ['A'..'Z']) do
  begin
    writeln('Illegal entry - enter a letter from A to Z');
    readln(vname);
    vname := upper(vname);
  end;
end; {getvar}

procedure split(strvalue:numstring; var strwhole,strfraction:numstring);
{Take the string version in strvalue and split it into the whole and
 fractional strings, i.e., those digits before and after the decimal point.}
var point:integer;
begin
  point:=index(strvalue,'.');
  if point > 0 then
  begin
    strwhole := substr(strvalue,1,point-1);
    strfraction := substr(strvalue,point+1,length(strvalue)-point);
  end
  else
  begin
    strwhole := strvalue;
    strfraction := '0';
  end;
end; {split}

procedure convertwhole(strwhole:numstring; var value:longnum; var valid:boolean);
{Convert the whole part string in strwhole into it integer array equivalent in
 value.  Valid indicates whether strwhole was valid or not.}
var loc,i:integer;
begin
  valid := true;
  loc := 0;
  for i:=length(strwhole) downto 1 do
    if valid and (strwhole[i] in ['0'..'9']) then
    begin
      loc := loc + 1;
      value.whole[loc] := ord(strwhole[i])-ord('0');
    end
    else
      valid := false;
  if valid then
    for i := loc+1 to maxlen do
      value.whole[i] := 0;
end; {convertwhole}

procedure convertfraction(strfraction:numstring; var value:longnum; var valid:
                                                  boolean);
{Convert the fraction string in strfraction to its integer array equivalent
 in value.  Valid indicates whether strfraction represents a valid fraction or
 not.}
var i,loc:integer;
begin
  valid:=true;
  for loc :=1 to length(strfraction) do
    if valid and (strfraction[loc] in ['0'..'9']) then
      value.fraction[loc] := ord(strfraction[loc]) - ord('0')
    else
      valid := false;
  if valid then
    for i := length(strfraction)+1 to maxlen do
      value.fraction[i]:=0;
end; {convertfraction}

procedure getnum(vname:char; var value:longnum);
{Requests a long number for variable vname from the user and tests it
for validity.  The valid number is stored in value.}
var strvalue,strwhole,strfraction:numstring;
    valid:boolean;
begin
  writeln('What value do you wish to enter for '+vname+'?');
  readln(strvalue);
  if length(strvalue)>maxlen then
  begin
    writeln('Number too long - please try again - max is ',maxlen:1);
    getnum(vname,value);
  end
  else
  begin
    if length(strvalue)>0 then
    begin
    if (strvalue[1]='-') or (strvalue[1]='+') then
    begin
      value.sign := strvalue[1];
      strvalue := substr(strvalue,2,length(strvalue)-1);
    end
    else
      value.sign := '+';
    end;
    split(strvalue,strwhole,strfraction);
    convertwhole(strwhole,value,valid);
    if valid then
      convertfraction(strfraction,value,valid);
    if not valid then
    begin
      writeln('Invalid number - try again');
      getnum(vname,value);
    end;
  end;
end; {getnum}

procedure enter(var v:vararray);
{Prompts for an entry of a number by requesting the variable name and number
 and stores the entered number in the variable.}
var vname:char;
begin
  getvar('enter',vname);
  getnum(vname,v[vname]);
end; {enter}

procedure printvar(value:longnum);
{Prints the value}
var charcount,loc,last:integer;
    leftsignificant:boolean;
    rightsignificant:boolean;
begin
  charcount:=0;
  leftsignificant := false;
  if value.sign='-' then
  begin
    write('-');
    charcount:=1;
  end;
  for loc := maxlen downto 1 do
    if (value.whole[loc]<>0) or (leftsignificant) then
    begin
      leftsignificant := true;
      write(chr(value.whole[loc] + ord('0')));
      charcount:=charcount + 1;
    end;
  rightsignificant := false;
  last:=0;
  for loc := maxlen downto 1 do
    if (not rightsignificant) and (value.fraction[loc]>0) then
    begin
      last := loc;
      rightsignificant := true;
    end;
  if (last>0) and (charcount<maxlen) then
  begin
    write('.');
    if last-charcount>maxlen-1 then
      last:=maxlen-1-charcount;
    for loc:=1 to last do
      write(chr(value.fraction[loc] + ord('0')));
  end;
  if not(rightsignificant or leftsignificant) then
    write('0');
  writeln;
end; {printvar}

procedure print(v:vararray);
{Prompts user for variable name and prints that variable.}
var vname:char;
begin
  getvar('print',vname);
  printvar(v[vname]);
end; {print}

function gtr(value1,value2:longnum):boolean;
{Returns true if value1 is greater than value2.}
var loc:integer;
begin
  loc:=maxlen;
  while (loc>1) and (value1.whole[loc]=value2.whole[loc]) do
    loc:=loc-1;
  if value1.whole[loc]=value2.whole[loc] then
  begin
    loc:=1;
    while (loc<maxlen) and (value1.fraction[loc]=value2.fraction[loc]) do
      loc:=loc+1;
    gtr:=value1.fraction[loc]>value2.fraction[loc];
  end
  else
    gtr:=value1.whole[loc]>value2.whole[loc];
end; {gtr}

procedure sumdigit(digit1,digit2:integer; var answer,carry:integer);
{Adds digit1 and digit2 and places resulting digit in answer and carry in carry.}
begin
  answer:=digit1+digit2+carry;
  if answer>9 then
  begin
    answer:=answer-10;
    carry:=1;
  end
  else
    carry:=0;
end; {sumdigit}

procedure subdigit(digit1,digit2:integer; var answer,carry:integer);
{Subtracts digit2 from digit1 and places resulting digit in answer and carry in
 carry.  If there is a carry, it is -1.}
begin
  answer:=digit1-digit2+carry;
  if answer<0 then
  begin
    answer:=answer+10;
    carry:=-1;
  end
  else
    carry:=0;
end; {subdigit}

function numsigs(value:longnum):integer;
{Returns the number of significant digits in value including sign and decimal.}
var left,right,count:integer;
begin
  left:=maxlen;
  while (left>1) and (value.whole[left]=0) do
    left:=left-1;
  if value.whole[left]=0 then
    left:=0;
  right:=maxlen;
  while (right>1) and (value.fraction[right]=0) do
    right:=right-1;
  if value.fraction[right]=0 then
    right:=0;
  count:=0;
  if right>0 then count:=count+1;
  if value.sign='-' then count:=count+1;
  numsigs:=left+right+count;
end; {numsigs}

procedure negate(var value:longnum);
{Changes the sign of value.}
begin
  if value.sign='-' then value.sign:='+'
                    else value.sign:='-';
end; {negate}

procedure diff(value1,value2:longnum; var value3:longnum);
{Stores the difference value1-value2 in value3}
var valtemp:longnum;
    i,carry:integer;
begin
  if gtr(value2,value1) then
  begin
    negate(value1);
    negate(value2);
    diff(value2,value1,value3);
  end
  else
  begin
    carry:=0;
    valtemp.sign:=value1.sign;
    for i:=maxlen downto 1 do
      subdigit(value1.fraction[i],value2.fraction[i],valtemp.fraction[i],
               carry);
    for i:=1 to maxlen do
      subdigit(value1.whole[i],value2.whole[i],valtemp.whole[i],carry);
    if numsigs(valtemp)>maxlen then
      writeln('Answer not representible in ',maxlen,' characters.')
    else
      value3:=valtemp;
  end;
end; {diff}

procedure sum(value1,value2:longnum; var value3:longnum);
{Stores the sum value1+value2 in value3}
var valtemp:longnum;
    i,carry:integer;
begin
  if value1.sign='*' then
    writeln('First operand is undefined')
  else if value2.sign='*' then
    writeln('Second operand is undefined')
  else
  begin
    if value1.sign<>value2.sign then
    begin
      negate(value2);
      diff(value1,value2,value3);
    end
    else
    begin
      carry:=0;
      valtemp.sign:=value1.sign;
      for i:= maxlen downto 1 do
        sumdigit(value1.fraction[i],value2.fraction[i],valtemp.fraction[i],
                 carry);
      for i := 1 to maxlen do
        sumdigit(value1.whole[i],value2.whole[i],valtemp.whole[i],carry);
      if numsigs(valtemp)>maxlen then
        writeln('Answer not representable in ',maxlen,' characters')
      else
        value3:=valtemp;
    end;
  end;
end; {sum}

procedure add(var v:vararray);
{Prompts for add and carries out the addition.}
var vname1,vname2,vname3:char;
begin
  getvar('add first',vname1);
  getvar('add second',vname2);
  getvar('hold the result',vname3);
  sum(v[vname1],v[vname2],v[vname3]);
end; {add}

procedure subtract(var v:vararray);
{Prompts for subtraction and carries it out.}
var vname1,vname2,vname3:char;
begin
  getvar('subtract from',vname1);
  getvar('subtract',vname2);
  getvar('hold the result',vname3);
  negate(v[vname2]);
  sum(v[vname1],v[vname2],v[vname3]);
  negate(v[vname2]);
end; {subtract}

begin {main}
 initialize(v);
 repeat
  repeat
    menuselect(selection);
  until (selection>=1) and (selection<=5);
  if selection <5 then
    case selection of
     1: enter(v);
     2: print(v);
     3: add(v);
     4: subtract(v);
    end; {case}
 until selection=5;
end.