Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/GET10.ZIP/GETNUM.PAS

Pascal/Delphi Source File | 1988-11-09 | 12.8 KB | 461 lines

procedure getnumber

   (num_prompt:   screen_text;
    atr,atc:      byte;        {screen co-ords}
    low,high:     longint;     {not checked if equal}
    pattr,nattr:  byte;        {attributes}
var number:       longint;
    maxvalue:     longint;     {implied type}
    default:      numstring);

{
  Get an integer. Value of maxvalue determines implied type of argument
  returned in 'number' parameter. Set maxvalue to 65535 for a word, 255
  for a byte etc. Use predefined constants maxword, maxshortint etc.

  If low = high range checking is off, legal range then determined by type.
  If either low or high is not appropriate for the implied type then they
  are BOTH reset to their respective minimum and maximum legal values.

  Field size is determined in the first instance by the required number of
  digits for the implied type (3 for a byte, 5 for a word etc.). Validation
  criteria may constrain this further (byte in range 0..99 will require a
  field size of only 2 digits), unless the user has ValidationOverride
  privilege in which case the nominal (full) field size is used.

  If number passed is too big to be displayed in the field allowed then the
  field is asterisk filled. ^Y clears, <ret> sets a blank field to a default
  value if one has been specified and <esc> leaves the field unchanged.
}

var
    strminvalue,
    strmaxvalue,
    lostr,histr,
    instr:         numstring;

    default_number,
    minvalue,
    last_number,               {last number in input loop}
    save_number:   longint;    {original number}
    I,code,
    nominal_field_size,        {max field size for type}
    field_size:    integer;    {field size currently in effect}

    dchar:         char;
    finished,
    negative,
    numberok:      boolean;



function validation_on: boolean;
{
  Dynamic validation not attempted unless: low <= 0 <= high (and low <> high)
}
begin
  validation_on := (low <> high) and
                   (finished or ((low <= 0) and (high >= 0)));
end;


function illegal_value: boolean;
begin
  illegal_value := (number < minvalue) or (number > maxvalue);
end;


function IntOutOfRange: boolean;
begin
  IntOutOfRange :=
    (validation_on and ((number < low) or (number > high))) or
    illegal_value;
end;


function field_complete: boolean;
begin
  field_complete := ((length(instr) = field_size) and (instr[1] <> '*'));
end;


procedure reset_number (reset_value: longint);
{
  This procedure is used to translate a number into a string (instr) and
  to reset 'negative' and 'finished' boolean variables.
}
begin
  number := reset_value;
  last_number := number;
  str(number,instr);
  if instr = '0' then
    instr := '';
  negative := number < 0;
  finished := false;
end;


procedure display_number (signed_number: longint; SetFinished: boolean);
{
  This procedure accepts a number, transforms it to a string or series
  of asterisks and displays it. The string version of the number: 'instr'
  is global to the getnumber procedure.

  oldsize is used to control use of default value: instr will remain
  blank, not '0', if last instr was = ''.

  instr = '0' followed by <ret> means instr := '0'
  instr = ''  followed by <ret> means instr := default (if default <> '')

  default = '' means no default specified
  default = 'nnn' (a number) means use this default

  low = high means no user specified range checking in effect

  Numbers outside the range for the type in effect are displayed as a string
  of *'s, e.g., 999 for an implied type of byte (max value 255). This
  shouldn't ever happen if this procedure is called properly using the
  procedures: getlongint, getint, getshortint, getbyte and getword.

  Numbers falling outside the validation range are ALSO displayed this way.
  E.g, -1 in a field of type integer (range -32768..32767) with a validation
  range of 0..999.

  This is primarily because any validation range specified is used in
  determining the field size (to facilitate the use of automatic field
  completion -- the AutoTab option).

  However, if ValidationOverride is in effect (meaning the user has privilege
  to override the validation) the maximum field size for the integer type is
  used. The number failing the validation check may then be displayed by
  issuing the appropriate command (^R) to temporarily (NB) relax the
  validation.
}
var oldsize: integer;
    fattr:   byte;

begin

  finished := SetFinished;

  if EditingField and not finished and (fieldcursor <> 0) then
    fattr := fieldcursor
  else fattr := nattr;

  oldsize := length(instr); {must precede next line}
  str(signed_number,instr); {assume number in range}

  if IntOutOfRange then
   {number is illegal for type or outside validation constraints}
    begin
      if not escaped then
        if EditingField and not illegal_value then  {no msg if field painting}
          error2(NumberWord + brighten(instr) + outside_validation_range
                + brighten(lostr) + ToWord + brighten(histr));

      fillchar (instr[1],field_size,'*'); {* fill field + length byte}
      instr[0] := chr(field_size);        {set length byte}
      oldsize := field_size;
    end;


  if not finished then

    begin
      if negative and not (instr[1] in ['-','*']) then
        instr := '-' + instr;
      instr := copy(instr,1,oldsize);
    end

  else if instr[1] <> '*' then

    begin
      if (instr = '0') and ZeroAsBlank then
        instr := '';

      if ZeroFillNumbers then {takes precedence over ZeroAsBlank}
        begin
          if signed_number < 0 then
            delete(instr,1,1);
          while length(instr) < field_size do
            instr := '0' + instr;
          if signed_number < 0 then
            instr[1] := '-';
        end

      else if RightJustifyNumbers then
             while length(instr) < field_size do
               instr := ' ' + instr
    end;

  Qfill(atr,atc,1,field_size,fattr,' ');

  if RightJustifyNumberEntry then
    Qwrite(atr,atc + field_size - length(instr),fattr,instr)
  else Qwrite(atr,atc,fattr,instr);
end;


procedure enter_default_value;
{
  Enter default if default is a valid number (illegal default values are
  ignored) and either ValidationOveride is true or the number falls within
  the validation range.

  This procedure may be amended to prompt for confirmation of default values.
}
begin
  value(default,default_number,maxvalue,code);

  if code = 0 then {default is valid number}
    begin
      {Use ConfirmDefault here}

      if ValidationOverride then
        begin
          low := 0;
          high := 0;
        end;

      if (low <> high) and
        ((default_number < low) or
        (default_number > high)) then
        error2(No_privilege)
      else reset_number(default_number);

    end
  else error2(default_is_invalid);
end; {enter default}


procedure get_input;
begin
  reset_number(number); {sets up instr}

  display_number(number,false);

  if RightJustifyNumberEntry then
    getdigit(atr,atc + field_size,0)
  else getdigit(atr,atc + length(instr),0);

  clearerror2;

  if scancode = 0 then
    begin

      dchar := chr(asciicode);

      if (length(instr) = field_size) and (dchar in ['0'..'9']) then
       if instr[1] = '*' then
         instr := ''
       else dchar := ^I; {don't allow it to get longer}

      case dchar of
        ^H       : if instr[1] = '*' then
                     reset_number(0)
                   else if length(instr) > 0 then
                     begin
                       dec(ord(instr[0]));
                       negative := negative and (length(instr) > 0);
                     end;
{
                                          NOTE

                    + & -: Check if sign change allowed by validation
                    constraints, then by type constraints. Asymmetry of
                    or clause for + results from the fact that all
                    integer types allow positive numbers
}
         '-'     : if instr[1] <> '*' then
                     if (low < 0) or
                       ((not validation_on) and (minvalue < 0)) then
                       negative := not negative;

         '+'     : if instr[1] <> '*' then
                     if (high > 0) or (not validation_on) then
                       negative := false;

         '.',^I  : finished := instr[1] <> '*';

         ^J,^M   : if instr[1] = '*' then
                     reset_number(save_number)
                   else

                     begin
                       if (default <> '') and
                         ((dchar = ^J) or (instr = '')) then
                         enter_default_value;
                       finished := true;
                     end;

         ^[      : begin
                     reset_number(save_number);
                     escaped := true;
                   end;

         ^Y      : reset_number(0);

         ^U      : reset_number(save_number);

         '0'..'9': begin
                     if (dchar = '0') and
                       ((instr = '0') or (instr = '-0')) then
                       {do nothing}
                     else instr := instr + dchar;
                   end;

      end; {case}


      if not escaped and (instr[1] <> '*') then {turn string into number}
        begin

          if negative then
            begin
              if (instr[1] <> '-') then
                instr := '-' + instr;
            end
          else if instr[1] = '-' then
                 delete(instr,1,1);

          last_number := number;

          value(instr,number,maxvalue,code);

          if (code <> 0) then {value returns 0 for '' and '-'}
            begin
              error2(Number_must_be_in_range + brighten(strminvalue) +
                     ToWord + brighten(strmaxvalue));
              reset_number(last_number);
            end;

          finished := finished or (field_complete and AutoTab);

        end; {not escaped}
    end

  else {extended key}

    begin
      action := get_edit(command);

      {amend here to control what extended keys are acceptable}

      case action of

        tabback: finished := instr[1] <> '*';

        reset: if ValidationOverride then {user has privilege}
                 begin
                   if low <> high then
                     info2(Range_checking_suspended);

                   low := 0;
                   high := 0;

                   reset_number(save_number);
                 end
               else error2(No_privilege);

        help,
        upchar,
        downchar,
        leftchar,
        rightchar,
        pageup,
        pagedown,
        scrollup,
        scrolldown,
        goto_top,
        goto_bottom,
        abort,
        exit_screen,
        quit:

                 begin
                   reset_number(save_number);
                   finished := true;
                 end;


      else error2(Invalid_key);
      end; {case}
    end;
end;


procedure warn_user_number_is_invalid;
begin
  if abs(high - low) > 1 then
    error2(Enter_a_number_between + brighten(lostr) + AndWord +
           brighten(histr))
  else
    error2(Enter_either + brighten(lostr) + OrWord + brighten(histr));

  reset_number(save_number);
end;


begin {getnumber}
  escaped := false;
  finished := false;  {used in setting validation_on}

  save_number := number;
  last_number := number;

  if low > high then
    begin
      low := 0;
      high := 0;
    end;
{
  Nominal field size depends on implied type of integer to return
}
  if (maxvalue = maxword) or (maxvalue = maxbyte) then
    minvalue := 0
  else minvalue := pred(-maxvalue);

  str(minvalue,strminvalue);
  str(maxvalue,strmaxvalue);
  nominal_field_size := maxW(ord(strminvalue[0]),ord(strmaxvalue[0]));

  if (low < minvalue) or (high > maxvalue) then
    begin
      low := minvalue;
      high := maxvalue;
    end;
{
  Find out how many digits to allow for input. Lower number may be longer,
  e.g., a range of -999 to 99. Decrease field size if necessary.
}
  str(low,lostr);
  str(high,histr);

  if ValidationOverride or not validation_on then
    field_size := nominal_field_size
  else field_size := minW(maxW(ord(lostr[0]),ord(histr[0])),nominal_field_size);

  SetCursor(CursorOn or CursorUnderline);
  clearerror2;
  numberok := false;

  display_prompt(num_prompt,atr,atc,pattr,field_size);

  if not PaintingFields then
    repeat
      repeat
        get_input
      until finished or escaped or IntOutOfRange;

      numberok := (not IntOutOfRange) or Escaped;
      if not numberok then
        warn_user_number_is_invalid;

    until numberok
  else
    reset_number(number); {sets up instr}

  display_number(number,true);
  SetCursor(CursorOff);
end; {getnum}