home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / database / mailit.zip / IO20.INC < prev    next >
Text File  |  1986-03-12  |  22KB  |  660 lines

  1. { IO20.INC -- Global I/O procedures to include in programs generally
  2.   Version 2.0 includes prev_page and next_page, changes where pause text
  3.   is displayed -- WPM -- 2/26/86 }
  4.  
  5. { ------------------------------------------------------------ }
  6.  
  7. const
  8.     prev_fld  = $0b ;  { ^K -- up_arrow on Kaypro II '83 }
  9.     next_fld  = $0a ;  { ^J -- linefeed, down_arrow }
  10.     backspace = $08 ;  { ^H -- Backspace key }
  11.     del_fld   = $19 ;  { ^Y }
  12.     prev_page = $12 ;  { ^R }
  13.     next_page = $03 ;  { ^C }
  14.     escape    = $1b ;
  15.     carr_rtn  = $0d ;
  16.     del       = $7f ;
  17.     filler    = $2e ;  { . }
  18.  
  19. type
  20.     str_type = string[80] ;
  21.  
  22.     intset = set of $00 .. $ff ;
  23.  
  24. const  { Turbo typed constants -- initialized variables }
  25.     terminating : intset = [carr_rtn, next_fld, prev_fld, next_page,
  26.                             prev_page, escape] ;
  27.     adjusting   : intset = [backspace, del_fld, del] ;
  28.  
  29. var
  30.     fld, scrn   : integer ; {For field & screen cursor control}
  31.  
  32. { ------------------------------------------------------------ }
  33.  
  34. { procedure gotoxy (col,row) ; -- Built-in proc in Turbo to place
  35.   cursor on screen.  Upper left is (1,1) not (0,0)! }
  36.  
  37. { procedure clrscr ; -- Built-in proc in Turbo to clear screen. }
  38.  
  39. { procedure clreol ; -- built-in proc in Turbo to clear to end of line }
  40.  
  41. { ------------------------------------------------------------ }
  42.  
  43. procedure clrline (col,row : integer) ;
  44.     begin
  45.         gotoxy (col,row) ;
  46.         clreol
  47.     end ;
  48.  
  49. { ------------------------------------------------------------ }
  50.  
  51. procedure clreos ;
  52.     begin
  53.         write (chr($17))   {Clear to end of screen on Kaypro & ADM-3A}
  54.     end ;
  55.  
  56. { ------------------------------------------------------------ }
  57.  
  58. procedure beep ;
  59.     begin
  60.         write (chr(7))
  61.     end ;
  62.  
  63. { ------------------------------------------------------------ }
  64.  
  65. procedure do_fld_ctl (key : integer) ;
  66.   { Adjusts global FLD based on value of key, the ordinal value of last key pressed }
  67.   { global
  68.         fld : integer -- for field cursor control }
  69.     begin
  70.         case key of
  71.           carr_rtn, next_fld : fld := fld + 1 ;
  72.           prev_fld           : fld := fld - 1 ;
  73.           next_page          : fld := 999 ;
  74.           prev_page          : fld := -999 ;
  75.           escape             : fld := maxint ;  { NOTE -- different from MT+ }
  76.         end  { case }
  77.     end ;  { proc do_fld_ctl }
  78.  
  79. { ------------------------------------------------------------ }
  80.  
  81. procedure do_scrn_ctl ;
  82.   { Checks value of FLD and adjusts value of SCRN accordingly }
  83.   { Global
  84.         fld, scrn : integer -- For field and screen cursor control }
  85.     begin
  86.         if fld < 1 then
  87.                 scrn := scrn - 1
  88.         else if fld = maxint then
  89.                 scrn := maxint
  90.         else
  91.                 scrn := scrn + 1
  92.     end ;
  93.  
  94. { ------------------------------------------------------------ }
  95.  
  96. procedure write_str (st:str_type ; col,row:integer) ;
  97.     begin
  98.         gotoxy (col,row) ;
  99.         write (st)
  100.     end ;
  101.  
  102. { ------------------------------------------------------------ }
  103.  
  104. procedure write_int (int:integer ; width,col,row:integer) ;
  105.     begin
  106.         gotoxy (col,row) ;
  107.         write (int:width)
  108.     end ;
  109.  
  110. { ------------------------------------------------------------ }
  111.  
  112. procedure write_bool (bool:boolean ; col, row:integer) ;
  113.     begin
  114.         gotoxy (col,row) ;
  115.         if bool then write ('YES') else write ('NO ')
  116.     end ;
  117.  
  118. { ------------------------------------------------------------ }
  119.  
  120. procedure write_real (r:real ; width,frac,col,row:integer) ;
  121.     begin
  122.         gotoxy (col,row) ;
  123.         write (r:width:frac)
  124.     end ;
  125.  
  126. { ------------------------------------------------------------ }
  127.  
  128. { This is for Kaypro CP/M -- comment it out to use IBM }
  129. (*
  130. procedure keyin (var ch:char) ;
  131. { Reads a single character from keyboard without echoing it back.
  132.   Modified to trap WordStar commands, 4/29/85 }
  133.     begin
  134.         read (kbd, ch) ;
  135.         if ch = ^S then
  136.             ch := chr(backspace)
  137.         else if ch = ^E then
  138.             ch := chr(prev_fld)
  139.         else if ch = ^X then
  140.             ch := chr(next_fld)
  141.     END ;
  142. *)
  143. { ------------------------------------------------------------ }
  144.  
  145. { This is for IBM PC-DOS -- comment it out for CP/M }
  146.  
  147. procedure keyin (var ch:char) ;
  148. { Reads a single character from keyboard without echoing it back.
  149.   Maps function key scan codes to single keyboard keys.
  150.   Modified for IBM -- from Turbo 3.0 manual, page 360 -- 5/29/85
  151.   Modified for IO20 -- 2/26/86 }
  152.  
  153.     var
  154.         func : boolean ;     { Whether function key or not }
  155.            c : char ;        { Character read }
  156.          key : integer ;     { ORD of character returned }
  157.  
  158.     begin
  159.         func := false ;
  160.         read (kbd,c) ;                       { Get first char }
  161.         if  (ord(c) = escape)                { If there is }
  162.         and keypressed then                  { a second ... }
  163.           begin
  164.             read (kbd,c) ;                   { Get 2nd char }
  165.             func := true
  166.           end ;
  167.         key := ord(c) ;
  168.  
  169.         if func then                         { Translate func. keys }
  170.             case key of
  171.               61,72 : key := prev_fld ;   { F3, up-arrow }
  172.               62,80 : key := next_fld ;   { F4, down-arrow }
  173.               65,73 : key := prev_page ;  { F7, PgUp }
  174.               66,81 : key := next_page ;  { F8, PgDn }
  175.               59,83,75 : key := backspace ;  { F1, DEL, left-arrow }
  176.               60    : key := del_fld ;    { F2 }
  177.             else      key := 00 ;
  178.             end  { case }
  179.         else  { not a function key }
  180.             case key of
  181.               $13   : key := backspace ;  { ^S -- Like WordStar }
  182.               $05   : key := prev_fld ;   { ^E }
  183.               $18   : key := next_fld ;   { ^X }
  184.             end ;  { case }
  185.  
  186.         ch := chr(key)                       { finally, return the character }
  187.     end ;
  188.  
  189. { ------------------------------------------------------------ }
  190.  
  191. function purgech (instr : str_type ; inchar : char) : str_type ;
  192.     {Purges all instances of the character from the string}
  193.     var
  194.         n      : integer ;  {Loop counter}
  195.         outstr : str_type ; {Result string}
  196.  
  197.     begin
  198.         outstr := '' ;
  199.         for n := 1 to length (instr) do
  200.                 if not (instr[n] = inchar) then
  201.                         outstr := concat (outstr, instr[n]) ;
  202.         purgech := outstr
  203.     end ;
  204.  
  205. { ------------------------------------------------------------ }
  206.  
  207. function stripch (instr:str_type ; inchar:char) : str_type ;
  208.     {Strips leading instances of the character from the string}
  209.     begin
  210.         while not (length(instr) = 0)
  211.         and (instr[1] = inchar) do
  212.                 delete (instr, 1, 1) ;
  213.         stripch := instr
  214.     end ;
  215.  
  216. { ------------------------------------------------------------ }
  217.  
  218. function chopch (instr:str_type ; inchar:char) : str_type ;
  219.     {Chops trailing instances of the character from the string}
  220.     begin
  221.         while not (length(instr) = 0)
  222.         and (instr[length(instr)] = inchar) do
  223.                 delete (instr, length(instr), 1) ;
  224.         chopch := instr
  225.     end ;
  226.  
  227. { ------------------------------------------------------------ }
  228.  
  229. procedure adjust_str (var st : str_type ; key, maxlen, col, row : integer ) ;
  230.   { deletes a character or the whole entry }
  231.     var
  232.         i : integer ;
  233.     begin
  234.       case key of
  235.         del_fld   : begin
  236.                       st := '' ;
  237.                       gotoxy (col, row) ;
  238.                       for i := 1 to maxlen do
  239.                           write (chr(filler)) ;
  240.                       gotoxy (col, row)
  241.                     end ;
  242.         backspace,
  243.         del       : if length(st) = 0 then
  244.                         beep
  245.                     else
  246.                       begin
  247.                         write (chr(backspace), chr(filler), chr(backspace)) ;
  248.                         delete (st, length(st), 1)
  249.                       end
  250.       end  { case }
  251.     end ; { proc adjust_str }
  252.  
  253. { ------------------------------------------------------------ }
  254.  
  255. procedure read_str (var st:str_type ; maxlen, col, row:integer) ;
  256.  
  257.   { Read String.  This procedure gets input from the keyboard one
  258.     character at a time and edits on the fly, rejecting invalid
  259.     characters.  COL and ROW tell where to begin the data input
  260.     field, and MAXLEN is the maximum length of the string to be
  261.     returned. }
  262.  
  263.     var
  264.         ch          : char ;
  265.         i,key       : integer ;
  266.  
  267.     procedure add_to_str ;
  268.         begin
  269.             if length(st) = maxlen then
  270.                     beep
  271.             else
  272.                 begin
  273.                     st  := concat(st, ch) ;     {concatenate char. onto str.}
  274.                     write (ch)
  275.                 end
  276.         end ; {--- of ADD_TO_STR---}
  277.  
  278.     begin {--- READ_STR ---}
  279.         write_str (st, col, row) ;
  280.         for i := (length(st)+1) to maxlen do
  281.                 write (chr(filler)) ;
  282.         gotoxy ((col + length(st)), row) ;
  283.         repeat
  284.             keyin (ch) ;
  285.             key := ord(ch) ;
  286.             if key in [$20 .. $7e] then
  287.                 add_to_str
  288.             else if key in adjusting then
  289.                 adjust_str (st,key,maxlen,col,row)
  290.             else if key in terminating then
  291.                 do_fld_ctl (key)
  292.             else
  293.               beep ;
  294.         until key in terminating ;
  295.         write ('':maxlen - length(st))
  296. end ; {--- of READ_STR ---}
  297.  
  298. { ------------------------------------------------------------ }
  299.  
  300. procedure read_int (var int:integer ; maxlen, col, row:integer) ;
  301.  
  302.   { Read Integer.  This procedure gets input from the keyboard
  303.     one character at a time and edits on the fly, rejecting
  304.     invalid characters.  COL and ROW tell where to begin the data
  305.     input field, and MAXLEN is the maximum length of the integer
  306.     to be returned. }
  307.  
  308.     var
  309.         ch          : char ;
  310.         i,key       : integer ;
  311.         st          : string[5] ;
  312.         maxst       : string[5] ;
  313.         code        : integer ;
  314.  
  315.     procedure add_to_str ;
  316.         begin
  317.             if length(st) = maxlen then
  318.                     beep
  319.             else
  320.                 begin
  321.                     st  := concat(st, ch) ;     {concatenate char. onto str.}
  322.                     write (ch)
  323.                 end
  324.         end ; {--- of ADD_TO_STR---}
  325.  
  326.     begin {--- READ_INT ---}
  327.         str (maxint:5, maxst) ;                    {Make integer into string}
  328.         str (int:maxlen, st) ;
  329.         st := purgech (st, ' ') ;
  330.         st := stripch (st, '0') ;
  331.         write_str (st, col, row) ;
  332.         for i := (length(st)+1) to maxlen do
  333.                 write (chr(filler)) ;
  334.         gotoxy ((col + length(st)), row) ;
  335.         repeat
  336.             keyin (ch) ;
  337.             key := ord(ch) ;
  338.             if key = $2d then                 { minus sign }
  339.               begin
  340.                 if  length(st) = 0 then
  341.                     add_to_str
  342.                 end
  343.             else if key in [$30 .. $39] then  {digits 0 - 9}
  344.               begin
  345.                 add_to_str ;
  346.                 if (length(st) = 5)
  347.                 and (st > maxst) then
  348.                     adjust_str (st,del,maxlen,col,row)
  349.               end
  350.             else if key in adjusting then
  351.                 adjust_str (st,key,maxlen,col,row)
  352.             else if key in terminating then
  353.                 do_fld_ctl (key)
  354.             else
  355.               beep ;
  356.         until key in terminating ;
  357.  
  358.         if st = '' then
  359.             begin
  360.                 int := 0 ;
  361.                 code := 0
  362.             end
  363.         else
  364.                 val (st, int, code) ;              {Make string into integer}
  365.         gotoxy (col, row) ;
  366.         if code = 0 then  {Conversion worked OK}
  367.                 write (int:maxlen)
  368.         else
  369.             begin
  370.                 write ('** CONVERSION ERROR ', code) ;
  371.                 halt
  372.             end
  373. end ; {--- of READ_INT ---}
  374.  
  375. { ------------------------------------------------------------ }
  376.  
  377. function equal (r1,r2 : real) : boolean ;
  378.   { tests functional equality of two real numbers -- 4/30/85 }
  379.     begin
  380.         equal := abs(r1 - r2) < 1.0e-5
  381.     end ;  { function equal }
  382.  
  383. { ------------------------------------------------------------ }
  384.  
  385. function greater (r1,r2 : real) : boolean ;
  386.   { tests functional inequality of two real numbers -- 5/1/85 }
  387.     begin
  388.         greater := (r1 - r2) > 1.0e-5
  389.     end ;  { function greater }
  390.  
  391. { ------------------------------------------------------------ }
  392.  
  393. procedure read_real (var r:real ; maxlen,frac,col,row:integer) ;
  394.  
  395.   { Read Real.  This procedure gets input from the keyboard
  396.     one character at a time and edits on the fly, rejecting
  397.     invalid characters.  COL and ROW tell where to begin the data
  398.     input field; MAXLEN is the maximum length of the string
  399.     representation of the real number, including sign and decimal
  400.     point; FRAC is the fractional part, the number of digits to
  401.     right of the decimal point.
  402.  
  403.     Note -- In TURBO the maximum number of significant digits in
  404.     decimal (not scientific) representation is 11.  It is the
  405.     programmer's responsibility to limit input and computed output
  406.     to 11 significant digits.  }
  407.  
  408.     var
  409.         ch          : char ;    {Input character}
  410.         i,key       : integer ; {Loop control ; ORD of CH}
  411.         st          : string[13] ; {String representation of real number}
  412.         code        : integer ; {Result of VAL conversion}
  413.         rlen        : integer ; {Current length of ST to right of dec. pt.}
  414.         llen        : integer ; {Current length to left, including dec. pt.}
  415.         maxl        : integer ; {Max allowable to left, including dec. pt.}
  416.  
  417.     procedure compute_length ;
  418.         begin
  419.             if pos ('.', st) = 0 then     { If no dec. pt. ... }
  420.               begin
  421.                 llen := length(st) ;      {the whole string is Left}
  422.                 rlen := 0                 {and none is Right}
  423.               end
  424.             else    {There is a decimal point ...}
  425.               begin
  426.                 llen := pos ('.', st) ;   {Left is all up to dec. pt.}
  427.                 rlen := length(st) - llen {Right is the rest}
  428.               end
  429.         end ; { proc compute_length }
  430.  
  431.     procedure add_to_str ;
  432.         procedure add_it ;
  433.             begin
  434.                 st  := concat(st, ch) ;
  435.                 write (ch)
  436.             end ;
  437.         begin {ADD_TO_STR}
  438.             if ch = '.' then      { Decimal point: if not one already, add it }
  439.               begin
  440.                 if pos('.', st) = 0 then
  441.                     add_it
  442.                 else
  443.                     beep
  444.               end
  445.                                   { else it's not a decimal point }
  446.             else if pos('.',st) = 0 then
  447.             { There's no dec pt in string, so digit goes on left. }
  448.               begin
  449.                 if llen = (maxl - 1) then
  450.                     beep  { Only a dec pt is allowed in pos MAXL }
  451.                 else
  452.                     add_it
  453.               end
  454.             else  { There is a dec pt in string, so digit goes on right }
  455.               begin
  456.                 if rlen = frac then
  457.                     beep
  458.                 else
  459.                     add_it
  460.               end
  461.         end ; {--- of ADD_TO_STR---}
  462.  
  463.     begin {--- READ_REAL ---}
  464.                               {Initialize}
  465.         maxl  := maxlen - frac ;
  466.                               {Set up string representation of real and }
  467.                               {determine length of left & right portions}
  468.         str(r:maxlen:frac,st) ;           {Make real into string}
  469.         st := purgech (st, ' ') ;         {Purge all blanks}
  470.         st := stripch (st, '0') ;         {Strip leading zeroes}
  471.         if not (pos('.', st) = 0) then    {If there is a dec. pt ... }
  472.             begin
  473.                 st := chopch (st, '0') ;  {Chop trailing zeroes}
  474.                 st := chopch (st, '.')    {and trailing dec. pt.}
  475.             end ;
  476.  
  477.                               {Write string on console}
  478.         write_str (st, col, row) ;
  479.         for i := (length(st)+1) to maxlen do
  480.                 write (chr(filler)) ;
  481.         gotoxy ((col + length(st)), row) ;
  482.  
  483.                               {Get input a character at a time & edit it}
  484.         repeat
  485.                 compute_length ;
  486.                 keyin (ch) ;
  487.                 key := ord(ch) ;
  488.                 if ch = '-' then
  489.                   begin
  490.                     if length(st) = 0 then
  491.                         add_to_str
  492.                     else
  493.                         beep
  494.                   end
  495.                 else if (ch = '.')
  496.                      or (ch in ['0' .. '9']) then
  497.                     add_to_str
  498.                 else if key in adjusting then
  499.                     adjust_str (st,key,maxlen,col,row)
  500.                 else if key in terminating then
  501.                     do_fld_ctl (key)
  502.                 else
  503.                     beep
  504.         until key in terminating ;
  505.  
  506.                               {Done getting input, now convert back to real}
  507.         if (st = '')                             {If null string ... }
  508.         or (st = '.')
  509.         or (st = '-')
  510.         or (st = '-.') then
  511.             begin
  512.                 r := 0.0 ;                       {Make real zero}
  513.                 code := 0
  514.             end
  515.         else    {Not a null string}
  516.                 val (st, r, code) ;              {Make string into real}
  517.         gotoxy (col, row) ;
  518.         if code = 0 then  {Conversion worked OK}
  519.                 write (r:maxlen:frac)            {Write the real on screen}
  520.         else
  521.             begin
  522.                 write ('** CONVERSION ERROR ', code) ;
  523.                 halt
  524.             end
  525. end ; {--- of READ_REAL ---}
  526.  
  527. { ------------------------------------------------------------ }
  528.  
  529. procedure read_yn (var bool:boolean; col,row:integer) ;
  530.   { Inputs "Y" OR "N" to boolean at column and row specified,
  531.     prints "YES" or "NO."
  532.  
  533.     Note -- use this when the screen control will not return
  534.     to the question and the boolean IS NOT defined before the
  535.     user answers the question. }
  536.  
  537.     var ch:char ;
  538.     begin
  539.         gotoxy (col,row) ;
  540.         write ('   ') ;
  541.         gotoxy (col,row) ;
  542.         repeat
  543.                 keyin (ch)
  544.         until (ch in ['Y', 'y', 'N', 'n']) ;
  545.         if (ch = 'Y') or (ch = 'y') then
  546.             begin
  547.                 write ('YES') ;
  548.                 bool := true
  549.             end
  550.         else
  551.             begin
  552.                 write ('NO ') ;
  553.                 bool := false
  554.             end
  555.     end ; {--- of READ_YN ---}
  556.  
  557. { ------------------------------------------------------------ }
  558.  
  559. procedure read_bool (var bool:boolean; col,row:integer) ;
  560.   { Displays boolean at column and row specified, inputs "Y"
  561.     or "N" to set new value of boolean, prints "YES" or "NO."
  562.  
  563.     Note -- use this when the screen control may return to the
  564.     question and the boolean IS defined before the user answers
  565.     the question. }
  566.  
  567.     var
  568.         ch         : char ;
  569.         key        : integer ;
  570.  
  571.     begin
  572.         write_bool (bool, col, row) ;
  573.         gotoxy (col, row) ;
  574.         repeat
  575.             keyin (ch) ;
  576.             key := ord(ch) ;
  577.             if key in [$59, $79] then           { 'Y', 'y' }
  578.                 begin
  579.                     bool := true ;
  580.                     key := next_fld ;
  581.                     do_fld_ctl(key)
  582.                 end
  583.             else if key in [$4e, $6e] then      { 'N', 'n' }
  584.                 begin
  585.                     bool := false ;
  586.                     key := next_fld ;
  587.                     do_fld_ctl(key)
  588.                 end
  589.             else if key in terminating then
  590.                 do_fld_ctl(key)
  591.             else
  592.                 beep ;
  593.         until key in terminating ;
  594.         write_bool (bool, col, row)
  595.     end ; {--- of READ_BOOL ---}
  596.  
  597. { ------------------------------------------------------------ }
  598.  
  599. procedure pause ;
  600.     {Prints message on bottom line, waits for user response}
  601.     var
  602.         ch   : char ;
  603.         key : integer ;
  604.     begin
  605.         clrline (1,24) ;
  606.         write_str ('PRESS SPACE BAR TO CONTINUE OR UP-ARROW TO GO BACK',14,24) ;
  607.         repeat
  608.                 keyin (ch) ;
  609.                 key := ord(ch) ;
  610.                 case key of
  611.                   $20      : fld := fld + 1 ;
  612.                   prev_fld : fld := fld - 1 ;
  613.                   prev_page : fld := -999 ;
  614.                   escape   : fld := maxint ;
  615.                 end ;
  616.         until key in [$20, prev_fld, prev_page, escape] ;
  617.         clrline (1,24)
  618.     end ; {--- of PAUSE ---}
  619.  
  620. { ------------------------------------------------------------ }
  621.  
  622. procedure hard_pause ;
  623.   { Like Pause, but only accepts space bar or Escape and only goes forward }
  624.     var
  625.         ch   : char ;
  626.         key : integer ;
  627.     begin
  628.         clrline (1,24) ;
  629.         write_str ('PRESS SPACE BAR TO CONTINUE',26,24) ;
  630.         repeat
  631.                 keyin (ch) ;
  632.                 key := ord(ch) ;
  633.                 case key of
  634.                   $20      : fld := fld + 1 ;
  635.                   escape   : fld := maxint ;
  636.                 end ;
  637.         until key in [$20, escape] ;
  638.         clrline (1,24)
  639.     end ; {--- of hard_pause ---}
  640.  
  641. { ------------------------------------------------------------ }
  642.  
  643. procedure show_msg (msg : str_type) ;
  644.   { Beeps, displays message centered on line 23, pauses }
  645.  
  646.     var
  647.         savefld : integer ;
  648.  
  649.     begin
  650.         savefld := fld ;
  651.         beep ;
  652.         clrline (1,23) ;
  653.         write_str (msg,((80-length(msg)) div 2),23) ;
  654.         hard_pause ;
  655.         clrline (1,23) ;
  656.         fld := savefld ;
  657.     end ; { --- of SHOW_MSG --- }
  658.  
  659. { ----- EOF IO20.INC ----------------------------------------- }
  660.