[comp.lang.pascal] Real Number Probelm with Technojocks toolbox v5.0

cncst3@unix.cis.pitt.edu (Chunqing N. Cheng) (10/27/90)

In article <1743@software.software.org> cox@software.org (Guy Cox) writes:
>In article <24818@adm.BRL.MIL> guillory@storm.dnet.nasa.gov (ANTHONY R. GUILLORY (904)) writes:
> I have a version for TP 5.0.  I think I got it from mtsg.ubc.ca 
> (128.189.103.1), but I'm not positive.  The filenames are TTT500-1.ZIP
> and TTT500-2.ZIP.  Anyway, they are ASCII files, not TPUs.  So you should
> be able to compile them for TP 5.5.  I also have their LiteComm package
> for TP 5.5.  I got that from the Borland Forum on CompuServe.  It might
> have a version of the toolkit for TP 5.5.  
> 
> If you find a toolkit for TP 5.5, let me know.
> 
> Anthony Guillory
> INTERNET:  GUILLORY@STORM.DNET.NASA.GOV
> SPAN:  STORM::GUILLORY or 723::GUILLORY
> UUCP:  UUNET!STORM.DNET.NASA.GOV!GUILLORY

I downloaded the files, unzipped and compiled under TP5.5 with
conditions "ver50 dirfull iofull"  etc..

The demonstration went smooth.

I am an engineer, and have a lot files written in TP, so I started
to try to include those units.

I particularly used READ_REAL procedure, and then I am completely 
stuck.  The TechnoJock Toolkit is so lousy on real numbers, it
cannot show it correctly.  It just show very small number as all
bunch of zero's.  I digged into the READ_REAL source
code, find no way around.  By looking through other files,
I found REAL_TO_SCISTR in STRNTTT5.PAS file.  Then I changed 
REAL_TO_STR in READTTT5.PAS to READL_TO_SCISTR, hopefully to
solve the problem.  But I get foating errors instead....
When There are some real numbers I do not get foating error,
I cannot change the number into scientific format, it just
beeps at 'E's I tried to put in.

For me, an engineer, a program cannot accept a real number just like
a computer without keyboard.  So, I start to modify the code.
The following is the modified part, with the capability to

1.  display a real number smarterly.  I mean that if it cannot fit
    in normal way, it goes to scientific format automatically.
    So, you do not need separately procedure for this.

2.  Accept scientific format.

3.  retain others in original way, (hopefully).

I called 713 493-6354, an answer machine told me that they are closed
until November sometime.  Hope somebody can benefit from this 
modification.  I do not know how to send this piece of code to them,
if somebody knows, please do it for me.

(Meanwhile, I have not register my copy yet, I'll to let my boss pay
of it)

{in STRnTTT5.pas unit file}
{.... deleted ......}

function Real_to_str(Number:real;Decimals:byte):string;
var Temp : string; i: byte; sign : string[1];power:word;
begin
    Str(Number:20:Decimals,Temp);
    repeat
         If copy(Temp,1,1) = ' ' then delete(Temp,1,1);
    until copy(temp,1,1) <> ' ';
    If Decimals = Floating then
    begin
       Temp := Strip('R','0',Temp);
       If Temp[Length(temp)] = '.' then
          Delete(temp,Length(temp),1);
       if ((Temp='0') and (Number<>0)) or (abs(number)>1.0E12) then
          begin
           sign:=''; if number<0 then sign:='-';
           number:=abs(number);
           power:=0;
           if number<1 then
           begin
             repeat
               power:=power+1;
               number:=number*10;
             until number>=1;
             if sizeof(number)=6 then Str(Number:20:12,Temp)
                                 else Str(Number:20:8,Temp);
             repeat
               If copy(Temp,1,1) = ' ' then delete(Temp,1,1);
             until copy(temp,1,1) <> ' ';
             Temp := Sign+Strip('R','0',Temp)+'E-'+int_to_Str(power);
           end else
           begin
             repeat
               power:=power+1;
               number:=number/10;
             until number<10;
             if sizeof(number)=6 then Str(Number:20:12,Temp)
                                 else Str(Number:20:8,Temp);
             repeat
               If copy(Temp,1,1) = ' ' then delete(Temp,1,1);
             until copy(temp,1,1) <> ' ';
             Temp := Sign+Strip('R','0',Temp)+'E'+int_to_Str(power);
           end;
         end;
      Real_to_Str := Temp;
    end;
end;

{================================================}

{In READTTT5.PAS   unit file}

Procedure Read_Line(X,Y,L,F,B,Format:byte;
                     var Text   :string);
{....... functions and procedures here deleted ....... }
begin                  {main Procedure Read_Line}
    Check_Parameters;
    R_Null := false;
    FindCursor(Cursor_X,Cursor_Y,ScanTop,ScanBot);
    If RTTT.Insert then
       HalfCursor
    else
       OnCursor;
    Write_String;
    FirstCharPress := true;
    Repeat
         Ch := Getkey;
         If Format in [2,3] then
            Ch := upcase(Ch);
         If Ch in RTTT.End_Chars then
         begin
            AllDone := True;
            If Ch <> #027 then Text := TempText;
         end
         else
         Case Ch of
         #131,              {mouseright}
         CursorRight   :  begin
                              If (CursorPos < L)
                              and (CursorPos <= length(TempText)) then
                              begin
                                  CursorPos := Succ(CursorPos);
                                  MoveTheCursor;
                              end;
                          end;
         #130,               {mouseleft}
         CursorLeft    :  begin
                              If CursorPos > 1 then
                              begin
                                  CursorPos := Pred(CursorPos);
                                  MoveTheCursor;
                              end;
                          end;
         HomeKey       :  begin
                              CursorPos := 1;
                              MoveTheCursor;
                          end;
         EndKey        :  begin
                              If CursorPos < L then
                              If length(TempText) < L then
                                  CursorPos := length(TempText) + 1
                              else
                                  CursorPos := L;
                              MoveTheCursor;
                          end;
        InsKey        :  If Format <> 3 then   {don't allow insert on Y/N!}
                         begin
                             InsertMode := not InsertMode;
                             If InsertMode then
                                HalfCursor
                             else
                                OnCursor;
                         end;
        DelKey        :  Char_Del;
        BackSpace     :  Char_Backspace;
        Zap           :  Erase_Field;
        EscKey        :  If RTTT.AllowEsc then
                             Alldone := true
                         else
                            Clang;
        EnterKey      :  begin
                             Alldone := true;
                             Text := TempText;
                         end;
       #33 .. #42,                                 {! to *}
       #44,#47,                                    {, /}
       #58 .. #64,                                 {: to @}
       #91 .. #96,                                 {[ to '}
       #123 .. #126   :  If (Format in [1,2]) then {{ to ~}
                         begin
                             If FirstCharPress and RTTT.EraseDefault then
                                Erase_Field;
                             Add_Char(Ch);
                         end
                         else
                             Clang;
       #43          :begin
                        If (Format in [1,2])       { + }
                        or ( (CursorPos=1) and (Format in [5,6,7])) then
                        begin
                            If FirstCharPress and RTTT.EraseDefault then
                                Erase_Field;
                            Add_Char(Ch);
                        end
                        else
                           Clang;
                       end;
       #45          :begin
                        If (Format in [1,2])       { - }
                        or ( (CursorPos=1) and (Format in [5,6,7]))
                        or ((format=7) and (temptext[cursorpos-1] in ['e','E']))
                        then
                        begin
                            If FirstCharPress and RTTT.EraseDefault then
                                Erase_Field;
                            Add_Char(Ch);
                        end
                        else
                           Clang;
                       end;
       #46            : If (Format in [1,2])       {.}
                        or ( (Pos('.',TempText)=0) and (Format = 7)) then
                        begin
                            If FirstCharPress and RTTT.EraseDefault then
                                Erase_Field;
                            Add_Char(Ch);
                        end
                        else
                           Clang;
       #48..#57       : If (Format in [1..2,5..8]) then {0 to 9}
                        begin
                            If FirstCharPress and RTTT.EraseDefault then
                                Erase_Field;
                            Add_Char(Ch);
                        end
                        else
                           Clang;
       #32,                                              {space}
{       #65..#77, }                                        {A to M}
       'A'..'D','F'..'M',
       #79..#88,                                         {O to X}
       #90,                                              {Z}
       {#97..#122}
       'a'..'d','f'..'z': If (Format in [1,2,4]) then      {a to z}
                        begin
                            If FirstCharPress and RTTT.EraseDefault then
                                Erase_Field;
                            Add_Char(Ch);
                        end
                        else
                           Clang;
       'e','E': If (Format in [1,2,4]) or
                   ((Format=7) and (pos(ch,temptext)=0) and (Cursorpos>1))
                     then
                        begin
                          if ((cursorpos=2) and (temptext[1] in ['.','+','-']) and
                             (format=7))
                               or ((cursorpos=3) and (temptext[2]='.') and
                                  (temptext[1] in ['+','-']) and (format=7))
                            then Clang else
                            begin
                            If FirstCharPress and RTTT.EraseDefault then
                                Erase_Field;
                             Add_Char(Ch);
                            end;
                        end else
                           Clang;
       #78,#89        : If (Format in [1..4]) then        {N Y}
                        begin
                            Add_Char(Ch);
                            If Format = 3 then
                            begin
                                Alldone := true;
                                Text := TempText;
                            end;
                        end
                        else
                           Clang;
      #128,#129       :;    {absorb stray mouse movement to avoid Clang'n}
      else Clang;
      end; {case}
      FirstCharPress := false;
      Until Alldone;
      R_Char := Ch;
      If  RTTT.RightJustify
      and (Format > 4) then
      begin
          Fastwrite(X,Y,attr(F,B),replicate(L,RTTT.Whitespace));
          Fastwrite(X+L-Length(TempText),Y,attr(F,B),Text);
      end
      else
        Fastwrite(X,Y,attr(F,B),FillWhiteSpace(Text));
      GotoXY(Cursor_X,Cursor_Y);
      SizeCursor(ScanTop,ScanBot);
end;  {Proc Read_Line}

{..... Funcitons and Procedures here deleted .........}
Procedure Read_Real(X,Y,L:byte;
                    Prompt:StrScreen;
                    BoxType: byte;
                    Var W : real;
                    Min, Max : real);
var
   Temp : Real;
   Txt : StrScreen;
   Valid : boolean;
   Code : integer;
   YT : byte;
   ChR : char;
begin
    If Min >= Max     then Min := -1.7E38;
    If Max <= -1.7E38 then Max :=  1.7E38;
    If (W < Min) then W := Min;
    If (W > Max) then W := Max;
    If Min < 0 then    {add room for - sign}
       Inc(L);
    If ((W = 0.0) and RTTT.SuppressZero) then
       Txt := ''
    else
       Txt := Real_To_Str(W,RTTT.RealDP);
    Temp := W;
    Valid := false;
    Display_Box_and_Prompt(X,Y,Boxtype,Prompt,L);
    YT := MessageLine(Y);
    Repeat
         Read_Line(X,Y,L,RTTT.FCol,RTTT.BCol,7,Txt);
         If ((R_Char = #027) and RTTT.AllowEsc)
         or ((Txt = '') and (RTTT.AllowNull)) then
         begin
             If Txt = '' then R_Null := true;
             exit;
         end
         else
         begin
             val(Txt,Temp,code);
             If code <> 0 then
             begin
                Invalid_Message(YT,ChR);
                If ChR = #027 then
                   Txt := Real_to_Str(W,RTTT.RealDP);
             end
             else
             begin
                 If (Temp < Min) or (Temp > Max) then
                 begin
                    OutOfRange_Message(Yt,Real_To_Str(Min,RTTT.RealDP),Real_To_Str(Max,RTTT.RealDP),ChR);
                    If ChR = #027 then
                       Txt := Real_to_Str(W,RTTT.RealDP);
                 end
                 else
                 begin
                     W := temp;
                     Valid := true;
                 end;
            end;
        end;
    Until Valid  or ((R_Char = #027) and RTTT.AllowEsc);
end;

{....funcitons and procedures here deleted  .....}

Chunqing Cheng