home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / BIPL.ZIP / PROCS.ZIP / IOLIB.ICN < prev    next >
Encoding:
Text File  |  1993-01-27  |  18.2 KB  |  562 lines
  1. ########################################################################
  2. #    
  3. #    File:     iolib.icn
  4. #    
  5. #    Subject:  Procedures for termlib-type tools for MS-DOS and UNIX
  6. #    
  7. #    Author:   Richard L. Goerwitz (with help from Norman Azadian)
  8. #
  9. #    Date:     January 17, 1992
  10. #
  11. ########################################################################
  12. #
  13. #    Version:  1.13
  14. #
  15. ###########################################################################
  16. #
  17. #  The following library represents a series of rough functional
  18. #  equivalents to the standard UNIX low-level termcap routines.  It is
  19. #  not meant as an exact termlib clone.  Nor is it enhanced to take
  20. #  care of magic cookie terminals, terminals that use \D in their
  21. #  termcap entries, or archaic terminals that require padding.  This
  22. #  library is geared mainly for use with ANSI and VT-100 devices.
  23. #  Note that this file may, in most instances, be used in place of the
  24. #  older UNIX-only itlib.icn file.  It essentially replaces the DOS-
  25. #  only itlibdos routines.  For DOS users not familiar with the whole
  26. #  notion of generalized screen I/O, I've included extra documentation
  27. #  below.  Please read it.
  28. #
  29. #  The sole disadvantage of this over the old itlib routines is that
  30. #  iolib.icn cannot deal with archaic or arcane UNIX terminals and/or
  31. #  odd system file arrangements.  Note that because these routines
  32. #  ignore padding, they can (unlike itlib.icn) be run on the NeXT and
  33. #  other systems which fail to implement the -g option of the stty
  34. #  command.  Iolib.icn is also simpler and faster than itlib.icn.
  35. #
  36. #  I want to thank Norman Azadian for suggesting the whole idea of
  37. #  combining itlib.icn and itlibdos.icn into one distribution, for
  38. #  suggesting things like letting drive specifications appear in DOS
  39. #  TERMCAP environment variables, and for finding several bugs (e.g.
  40. #  the lack of support for %2 and %3 in cm).  Although he is loathe
  41. #  to accept this credit, I think he deserves it.
  42. #
  43. #########################################################################
  44. #
  45. #  Contents:
  46. #
  47. #  setname(term)
  48. #    Use only if you wish to initialize itermlib for a terminal
  49. #  other than what your current environment specifies.  "Term" is the
  50. #  name of the termcap entry to use.  Normally this initialization is
  51. #  done automatically, and need not concern the user.
  52. #
  53. #  getval(id)
  54. #    Works something like tgetnum, tgetflag, and tgetstr.  In the
  55. #  spirit of Icon, all three have been collapsed into one routine.
  56. #  Integer valued caps are returned as integers, strings as strings,
  57. #  and flags as records (if a flag is set, then type(flag) will return
  58. #  "true").  Absence of a given capability is signalled by procedure
  59. #  failure.
  60. #
  61. #  igoto(cm,destcol,destline) - NB:  default 1 offset (*not* zero)!
  62. #    Analogous to tgoto.  "Cm" is the cursor movement command for
  63. #  the current terminal, as obtained via getval("cm").  Igoto()
  64. #  returns a string which, when output via iputs, will cause the
  65. #  cursor to move to column "destcol" and line "destline."  Column and
  66. #  line are always calculated using a *one* offset.  This is far more
  67. #  Iconish than the normal zero offset used by tgoto.  If you want to
  68. #  go to the first square on your screen, then include in your program
  69. #  "iputs(igoto(getval("cm"),1,1))."
  70. #
  71. #  iputs(cp,affcnt)
  72. #    Equivalent to tputs.  "Cp" is a string obtained via getval(),
  73. #  or, in the case of "cm," via igoto(getval("cm"),x,y).  Affcnt is a
  74. #  count of affected lines.  It is completely irrelevant for most
  75. #  modern terminals, and is supplied here merely for the sake of
  76. #  backward compatibility with itlib, a UNIX-only version of these
  77. #  routines (one which handles padding on archaic terminals).
  78. #
  79. ##########################################################################
  80. #
  81. #  Notes for MS-DOS users:
  82. #
  83. #    There are two basic reasons for using the I/O routines
  84. #  contained in this package.  First, by using a set of generalized
  85. #  routines, your code will become much more readable.  Secondly, by
  86. #  using a high level interface, you can avoid the cardinal
  87. #  programming error of hard coding things like screen length and
  88. #  escape codes into your programs.
  89. #
  90. #    To use this collection of programs, you must do two things.
  91. #  First, you must add the line "device=ansi.sys" (or the name of some
  92. #  other driver, like zansi.sys, nansi.sys, or nnansi.sys [=new
  93. #  nansi.sys]) to your config.sys file.  Secondly, you must add two
  94. #  lines to your autoexec.bat file: 1) "set TERM=ansi-mono" and 2)
  95. #  "set TERMCAP=\location\termcap."  The purpose of setting the TERM
  96. #  variable is to tell this program what driver you are using.  If you
  97. #  have a color system, you could use "ansi-color" instead of
  98. #  "ansi-mono," although for compatibility with a broader range of
  99. #  users, it would perhaps be better to stick with mono.  The purpose
  100. #  of setting TERMCAP is to make it possible to determine where the
  101. #  termcap database file is located.  The termcap file (which should
  102. #  have been packed with this library as termcap.dos) is a short
  103. #  database of all the escape sequences used by the various terminal
  104. #  drivers.  Set TERMCAP so that it reflects the location of this file
  105. #  (which should be renamed as termcap, for the sake of consistency
  106. #  across UNIX and MS-DOS spectra).  If desired, you can also try
  107. #  using termcap2.dos.  Certain games work a lot better using this
  108. #  alternate file.  To try it out, rename it to termcap, and set
  109. #  the environment variable TERMCAP to its location.
  110. #
  111. #    Although the authors make no pretense of providing here a
  112. #  complete introduction to the format of the termcap database file,
  113. #  it will be useful, we believe, to explain a few basic facts about
  114. #  how to use this program in conjunction with it.  If, say, you want
  115. #  to clear the screen, add the line,
  116. #
  117. #    iputs(getval("cl"))
  118. #
  119. #  to your program.  The function iputs() outputs screen control
  120. #  sequences.  Getval retrieves a specific sequence from the termcap
  121. #  file.  The string "cl" is the symbol used in the termcap file to
  122. #  mark the code used to clear the screen.  By executing the
  123. #  expression "iputs(getval("cl"))," you are 1) looking up the "cl"
  124. #  (clear) code in the termcap database entry for your terminal, and
  125. #  the 2) outputting that sequence to the screen.
  126. #
  127. #    Some other useful termcap symbols are "ce" (clear to end of
  128. #  line), "ho" (go to the top left square on the screen), "so" (begin
  129. #  standout mode), and "se" (end standout mode).  To output a
  130. #  boldfaced string, str, to the screen, you would write -
  131. #
  132. #    iputs(getval("so"))
  133. #    writes(str)
  134. #    iputs(getval("se"))
  135. #
  136. #  You can also write "writes(getval("so") || str || getval("se")),
  137. #  but this would make reimplementation for UNIX terminals that
  138. #  require padding rather difficult.
  139. #
  140. #    It is also heartily to be recommended that MS-DOS programmers
  141. #  try not to assume that everyone will be using a 25-line screen.
  142. #  Most terminals are 24-line.  Some 43.  Some have variable window
  143. #  sizes.  If you want to put a status line on, say, the 2nd-to-last
  144. #  line of the screen, then determine what that line is by executing
  145. #  "getval("li")."  The termcap database holds not only string-valued
  146. #  sequences, but numeric ones as well.  The value of "li" tells you
  147. #  how many lines the terminal has (compare "co," which will tell you
  148. #  how many columns).  To go to the beginning of the second-to-last
  149. #  line on the screen, type in:
  150. #
  151. #    iputs(igoto(getval("cm"), 1, getval("li")-1))
  152. #
  153. #  The "cm" capability is a special capability, and needs to be output
  154. #  via igoto(cm,x,y), where cm is the sequence telling your computer
  155. #  to move the cursor to a specified spot, x is the column, and y is
  156. #  the row.  The expression "getval("li")-1" will return the number of
  157. #  the second-to-last line on your screen.
  158. #
  159. ##########################################################################
  160. #
  161. #  Requires: UNIX or MS-DOS, co-expressions
  162. #
  163. #  See also: itlib.icn, iscreen.icn
  164. #
  165. ##########################################################################
  166.  
  167.  
  168. global tc_table, isDOS
  169. record true()
  170.  
  171.  
  172. procedure check_features()
  173.  
  174.     initial {
  175.  
  176.     if find("UNIX",&features) then
  177.         isDOS := &null
  178.     else if find("MS-DOS", &features) then
  179.         isDOS := 1
  180.     else stop("check_features:  OS not (yet?) supported.")
  181.  
  182.     find("expressi",&features) |
  183.         er("check_features","co-expressions not implemented - &$#!",1)
  184.     }
  185.  
  186.     return
  187.  
  188. end
  189.  
  190.  
  191.  
  192. procedure setname(name)
  193.  
  194.     # Sets current terminal type to "name" and builds a new termcap
  195.     # capability database (residing in tc_table).  Fails if unable to
  196.     # find a termcap entry for terminal type "name."  If you want it
  197.     # to terminate with an error message under these circumstances,
  198.     # comment out "| fail" below, and uncomment the er() line.
  199.  
  200.     #tc_table is global
  201.     
  202.     check_features()
  203.  
  204.     tc_table := table()
  205.     tc_table := maketc_table(getentry(name)) | fail
  206.     # er("setname","no termcap entry found for "||name,3)
  207.     return "successfully reset for terminal " || name
  208.  
  209. end
  210.  
  211.  
  212.  
  213. procedure getname()
  214.  
  215.     # Getname() first checks to be sure we're running under DOS or
  216.     # UNIX, and, if so, tries to figure out what the current terminal
  217.     # type is, checking successively the value of the environment
  218.     # variable TERM, and then (under UNIX) the output of "tset -".
  219.     # Terminates with an error message if the terminal type cannot be
  220.     # ascertained.  DOS defaults to "mono."
  221.  
  222.     local term, tset_output
  223.  
  224.     check_features()
  225.  
  226.     if \isDOS then {
  227.         term := getenv("TERM") | "mono"
  228.     }
  229.     else {
  230.     if not (term := getenv("TERM")) then {
  231.         tset_output := open("/bin/tset -","pr") |
  232.         er("getname","can't find tset command",1)
  233.         term := !tset_output
  234.         close(tset_output)
  235.     }
  236.     }
  237.  
  238.     return \term |
  239.     er("getname","can't seem to determine your terminal type",1)
  240.  
  241. end
  242.  
  243.  
  244.  
  245. procedure er(func,msg,errnum)
  246.  
  247.     # short error processing utility
  248.     write(&errout,func,":  ",msg)
  249.     exit(errnum)
  250.  
  251. end
  252.  
  253.  
  254.  
  255. procedure getentry(name, termcap_string)
  256.  
  257.     # "Name" designates the current terminal type.  Getentry() scans
  258.     # the current environment for the variable TERMCAP.  If the
  259.     # TERMCAP string represents a termcap entry for a terminal of type
  260.     # "name," then getentry() returns the TERMCAP string.  Otherwise,
  261.     # getentry() will check to see if TERMCAP is a file name.  If so,
  262.     # getentry() will scan that file for an entry corresponding to
  263.     # "name."  If the TERMCAP string does not designate a filename,
  264.     # getentry() will scan the termcap file for the correct entry.
  265.     # Whatever the input file, if an entry for terminal "name" is
  266.     # found, getentry() returns that entry.  Otherwise, getentry()
  267.     # fails.
  268.  
  269.     local isFILE, f, getline, line, nm, ent1, ent2, entry
  270.     static slash, termcap_names
  271.     initial {
  272.     if \isDOS then {
  273.         slash := "\\"
  274.         termcap_names := ["termcap","termcap.dos","termcap2.dos"]
  275.     }
  276.     else {
  277.         slash := "/"
  278.         termcap_names := ["/etc/termcap"]
  279.     }
  280.     }
  281.  
  282.  
  283.     # You can force getentry() to use a specific termcap file by cal-
  284.     # ling it with a second argument - the name of the termcap file
  285.     # to use instead of the regular one, or the one specified in the
  286.     # termcap environment variable.
  287.     /termcap_string := getenv("TERMCAP")
  288.  
  289.     if \isDOS then {
  290.     if \termcap_string then {
  291.         if termcap_string ? (
  292.          not ((tab(any(&letters)), match(":")) | match(slash)),
  293.          pos(1) | tab(find("|")+1), =name)
  294.         then {
  295.         # if entry ends in tc= then add in the named tc entry
  296.         termcap_string ?:= tab(find("tc=")) ||
  297.             # Recursively fetch the new termcap entry w/ name trimmed.
  298.             # Note that on the next time through name won't match the
  299.             # termcap environment variable, so getentry() will look for
  300.             # a termcap file.
  301.             (move(3), getentry(tab(find(":"))) ?
  302.              (tab(find(":")+1), tab(0)))
  303.         return termcap_string
  304.         }
  305.         else isFILE := 1
  306.     }
  307.     }
  308.     else {
  309.     if \termcap_string then {
  310.         if termcap_string ? (
  311.             not match(slash), pos(1) | tab(find("|")+1), =name)
  312.         then {
  313.         # if entry ends in tc= then add in the named tc entry
  314.         termcap_string ?:= tab(find("tc=")) ||
  315.             # Recursively fetch the new termcap entry w/ name trimmed.
  316.             (move(3), getentry(tab(find(":")), "/etc/termcap") ?
  317.              (tab(find(":")+1), tab(0)))
  318.         return termcap_string
  319.         }
  320.         else isFILE := 1
  321.     }
  322.     }
  323.  
  324.     # The logic here probably isn't clear.  The idea is to try to use
  325.     # the termcap environment variable successively as 1) a termcap en-
  326.     # try and then 2) as a termcap file.  If neither works, 3) go to
  327.     # the /etc/termcap file.  The else clause here does 2 and, if ne-
  328.     # cessary, 3.  The "\termcap_string ? (not match..." expression
  329.     # handles 1.
  330.  
  331.     if \isFILE            # if find(slash, \termcap_string)
  332.     then f := open(\termcap_string)
  333.     /f := open(!termcap_names) |
  334.     er("getentry","I can't access your termcap file.  Read iolib.icn.",1)
  335.     
  336.     getline := create read_file(f)
  337.     
  338.     while line := @getline do {
  339.     if line ? (pos(1) | tab(find("|")+1), =name, any(':|')) then {
  340.         entry := ""
  341.         while (\line | @getline) ? {
  342.         if entry ||:= 1(tab(find(":")+1), pos(0))
  343.         then {
  344.             close(f)
  345.             # if entry ends in tc= then add in the named tc entry
  346.             entry ?:= tab(find("tc=")) ||
  347.             # recursively fetch the new termcap entry
  348.             (move(3), getentry(tab(find(":"))) ?
  349.              # remove the name field from the new entry
  350.              (tab(find(":")+1), tab(0)))
  351.             return entry
  352.         }
  353.         else {
  354.             \line := &null # must precede the next line
  355.             entry ||:= trim(trim(tab(0),'\\'),':')
  356.         }
  357.         }
  358.     }
  359.     }
  360.  
  361.     close(f)
  362.     er("getentry","can't find and/or process your termcap entry",3)
  363.  
  364. end
  365.  
  366.  
  367.  
  368. procedure read_file(f)
  369.  
  370.     # Suspends all non #-initial lines in the file f.
  371.     # Removes leading tabs and spaces from lines before suspending
  372.     # them.
  373.  
  374.     local line
  375.  
  376.     \f | er("read_tcap_file","no valid termcap file found",3)
  377.     while line := read(f) do {
  378.     match("#",line) & next
  379.     line ?:= (tab(many('\t ')) | &null, tab(0))
  380.     suspend line
  381.     }
  382.  
  383.     fail
  384.  
  385. end
  386.  
  387.  
  388.  
  389. procedure maketc_table(entry)
  390.  
  391.     # Maketc_table(s) (where s is a valid termcap entry for some
  392.     # terminal-type): Returns a table in which the keys are termcap
  393.     # capability designators, and the values are the entries in
  394.     # "entry" for those designators.
  395.  
  396.     local k, v, str, decoded_value
  397.  
  398.     /entry & er("maketc_table","no entry given",8)
  399.     if entry[-1] ~== ":" then entry ||:= ":"
  400.     
  401.     /tc_table := table()
  402.  
  403.     entry ? {
  404.  
  405.     tab(find(":")+1)    # tab past initial (name) field
  406.  
  407.     while tab((find(":")+1) \ 1) ? {
  408.         &subject == "" & next
  409.         if k := 1(move(2), ="=") then {
  410.         # Get rid of null padding information.  Iolib can't
  411.         # handle it (unlike itlib.icn).  Leave star in.  It
  412.         # indicates a real dinosaur terminal, and will later
  413.         # prompt an abort.
  414.         str := ="*" | ""; tab(many(&digits))
  415.         decoded_value := Decode(str || tab(find(":")))
  416.         }
  417.         else if k := 1(move(2), ="#")
  418.         then decoded_value := integer(tab(find(":")))
  419.         else if k := 1(tab(find(":")), pos(-1))
  420.         then decoded_value := true()
  421.         else er("maketc_table", "your termcap file has a bad entry",3)
  422.         /tc_table[k] := decoded_value
  423.         &null
  424.     }
  425.     }
  426.  
  427.     return tc_table
  428.  
  429. end
  430.  
  431.  
  432.  
  433. procedure getval(id)
  434.  
  435.     /tc_table := maketc_table(getentry(getname())) |
  436.     er("getval","can't make a table for your terminal",4)
  437.  
  438.     return \tc_table[id] | fail
  439.     # er("getval","the current terminal doesn't support "||id,7)
  440.  
  441. end
  442.  
  443.  
  444.  
  445. procedure Decode(s)
  446.  
  447.     # Does things like turn ^ plus a letter into a genuine control
  448.     # character.
  449.  
  450.     local new_s, chr, chr2
  451.  
  452.     new_s := ""
  453.  
  454.     s ? {
  455.  
  456.     while new_s ||:= tab(upto('\\^')) do {
  457.         chr := move(1)
  458.         if chr == "\\" then {
  459.         new_s ||:= {
  460.             case chr2 := move(1) of {
  461.             "\\" : "\\"
  462.             "^"  : "^"
  463.             "E"  : "\e"
  464.             "b"  : "\b"
  465.             "f"  : "\f"
  466.             "n"  : "\n"
  467.             "r"  : "\r"
  468.             "t"  : "\t"
  469.             default : {
  470.                 if any(&digits,chr2) then {
  471.                 char(integer("8r"||chr2||move(2 to 0 by -1))) |
  472.                     er("Decode","bad termcap entry",3)
  473.                 }
  474.                else chr2
  475.             }
  476.             }
  477.         }
  478.         }
  479.         else new_s ||:= char(ord(map(move(1),&lcase,&ucase)) - 64)
  480.     }
  481.     new_s ||:= tab(0)
  482.     }
  483.  
  484.     return new_s
  485.  
  486. end
  487.  
  488.  
  489.  
  490. procedure igoto(cm,col,line)
  491.  
  492.     local colline, range, increment, padding, str, outstr, chr, x, y
  493.  
  494.     if \col > (tc_table["co"]) | \line > (tc_table["li"]) then {
  495.     colline := string(\col) || "," || string(\line) | string(\col|line)
  496.     range := "(" || tc_table["co"]-1 || "," || tc_table["li"]-1 || ")"
  497.     er("igoto",colline || " out of range " || (\range|""),9)
  498.     } 
  499.  
  500.     # Use the Iconish 1;1 upper left corner & not the C-ish 0 offsets
  501.     increment := -1
  502.     outstr := ""
  503.     
  504.     cm ? {
  505.     while outstr ||:= tab(find("%")) do {
  506.         tab(match("%"))
  507.         if padding := integer(tab(any('23')))
  508.         then chr := (="d" | "d")
  509.         else chr := move(1)
  510.         if case \chr of {
  511.         "." :  outstr ||:= char(line + increment)
  512.         "+" :  outstr ||:= char(line + ord(move(1)) + increment)
  513.         "d" :  {
  514.             str := string(line + increment)
  515.             outstr ||:= right(str, \padding, "0") | str
  516.         }
  517.         }
  518.         then line :=: col
  519.         else {
  520.         case chr of {
  521.             "n" :  line := ixor(line,96) & col := ixor(col,96)
  522.             "i" :  increment := 0
  523.             "r" :  line :=: col
  524.             "%" :  outstr ||:= "%"
  525.             "B" :  line := ior(ishift(line / 10, 4), line % 10)
  526.             ">" :  {
  527.             x := move(1); y := move(1)
  528.             line > ord(x) & line +:= ord(y)
  529.             &null
  530.             }
  531.         } | er("goto","bad termcap entry",5)
  532.         }
  533.     }
  534.     return outstr || tab(0)
  535.     }
  536.  
  537. end
  538.  
  539.  
  540.  
  541. procedure iputs(cp, affcnt)
  542.  
  543.     # Writes cp to the screen.  Use this instead of writes() for
  544.     # compatibility with itlib (a UNIX-only version which can handle
  545.     # albeit inelegantly) terminals that need padding.
  546.  
  547.     static num_chars
  548.     initial num_chars := &digits ++ '.'
  549.  
  550.     type(cp) == "string" |
  551.     er("iputs","you can't iputs() a non-string value!",10)
  552.  
  553.     cp ? {
  554.     if tab(many(num_chars)) & ="*" then
  555.         stop("iputs:  iolib can't use terminals that require padding.")
  556.     writes(tab(0))
  557.     }
  558.  
  559.     return
  560.  
  561. end
  562.