home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / BIPL.ZIP / PROCS.ZIP / ITLIBDOS.ICN < prev    next >
Encoding:
Text File  |  1993-01-27  |  15.1 KB  |  470 lines
  1. ##########################################################################
  2. #    
  3. #    File:     itlibdos.icn
  4. #    
  5. #    Subject:  Procedures for termlib-type tools (MS-DOS version)
  6. #    
  7. #    Author:   Richard L. Goerwitz
  8. #
  9. #    Date:     February 29, 1992
  10. #
  11. ##########################################################################
  12. #
  13. #    Version:  1.15
  14. #
  15. ###########################################################################
  16. #
  17. #  The following library represents a series of rough functional
  18. #  equivalents to the standard UNIX low-level termcap routines.  They
  19. #  are not meant as exact termlib clones.  Nor are they enhanced to
  20. #  take care of magic cookie terminals, terminals that use \D in their
  21. #  termcap entries, or, in short, anything I felt would not affect my
  22. #  normal, day-to-day work with ANSI and vt100 terminals.  At this
  23. #  point I'd recommend trying iolib.icn instead of itlibdos.icn.  Iolib
  24. #  is largely DOS-UNIX interchangeable, and it does pretty much every-
  25. #  thing itlibdos.icn does.
  26. #
  27. #  Requires:  An MS-DOS platform & co-expressions.  The MS-DOS version
  28. #  is a port of the UNIX version.  Software you write for this library
  29. #  can be made to run under UNIX simply by substituting the UNIX ver-
  30. #  sion of this library.  See below for additional notes on how to use
  31. #  this MS-DOS port.
  32. #
  33. #  setname(term)
  34. #    Use only if you wish to initialize itermlib for a terminal
  35. #  other than what your current environment specifies.  "Term" is the
  36. #  name of the termcap entry to use.  Normally this initialization is
  37. #  done automatically, and need not concern the user.
  38. #
  39. #  getval(id)
  40. #    Works something like tgetnum, tgetflag, and tgetstr.  In the
  41. #  spirit of Icon, all three have been collapsed into one routine.
  42. #  Integer valued caps are returned as integers, strings as strings,
  43. #  and flags as records (if a flag is set, then type(flag) will return
  44. #  "true").  Absence of a given capability is signalled by procedure
  45. #  failure.
  46. #
  47. #  igoto(cm,destcol,destline) - NB:  default 1 offset (*not* zero)!
  48. #    Analogous to tgoto.  "Cm" is the cursor movement command for
  49. #  the current terminal, as obtained via getval("cm").  Igoto()
  50. #  returns a string which, when output via iputs, will cause the
  51. #  cursor to move to column "destcol" and line "destline."  Column and
  52. #  line are always calculated using a *one* offset.  This is far more
  53. #  Iconish than the normal zero offset used by tgoto.  If you want to
  54. #  go to the first square on your screen, then include in your program
  55. #  "iputs(igoto(getval("cm"),1,1))."
  56. #
  57. #  iputs(cp,affcnt)
  58. #    Equivalent to tputs.  "Cp" is a string obtained via getval(),
  59. #  or, in the case of "cm," via igoto(getval("cm"),x,y).  Affcnt is a
  60. #  count of affected lines.  It is only relevant for terminals which
  61. #  specify proportional (starred) delays in their termcap entries.
  62. #
  63. #  Notes on the MS-DOS version:
  64. #    There are two basic reasons for using the I/O routines
  65. #  contained in this package.  First, by using a set of generalized
  66. #  routines, your code will become much more readable.  Secondly, by
  67. #  using a high level interface, you can avoid the cardinal
  68. #  programming error of hard coding things like screen length and
  69. #  escape codes into your programs.
  70. #    To use this collection of programs, you must do two things.
  71. #  First, you must add the line "device=ansi.sys" (or the name of some
  72. #  other driver, like zansi.sys, nansi.sys, or nnansi.sys [=new
  73. #  nansi.sys]) to your config.sys file.  Secondly, you must add two
  74. #  lines to your autoexec.bat file:  1) "set TERM=ansi-mono" and 2)
  75. #  "set TERMCAP=\location\termcap."  The purpose of setting the TERM
  76. #  variable is to tell this program what driver you are using.  If you
  77. #  have a color system, use "ansi-color" instead of "ansi-mono," and
  78. #  if you are using nansi or zansi instead of vanilla ansi, use one of
  79. #  these names instead of the "ansi" (e.g. "zansi-mono").  The purpose
  80. #  of setting TERMCAP is to make it possible to determine where the
  81. #  termcap file is located.  The termcap file (which should have been
  82. #  packed with this library as termcap.dos) is a short database of all
  83. #  the escape sequences used by the various terminal drivers.  Set
  84. #  TERMCAP so that it reflects the location of this file (which should
  85. #  be renamed as termcap, for the sake of consistency with the UNIX
  86. #  version).  Naturally, you must change "\location\" above to reflect
  87. #  the correct path on your system.  With some distributions, a second
  88. #  termcap file may be included (termcap2.dos).  Certain games work a
  89. #  lot better using this alternate file.  To try it out, rename it to
  90. #  termcap, and set TERMCAP to its location.
  91. #    Although I make no pretense here of providing here a complete
  92. #  introduction to the format of the termcap database file, it will be
  93. #  useful, I think, to explain a few basic facts about how to use this
  94. #  program in conjunction with it.  If, say, you want to clear the
  95. #  screen, add the line,
  96. #
  97. #    iputs(getval("cl"))
  98. #
  99. #  to your program.  The function iputs() outputs screen control
  100. #  sequences.  Getval retrieves a specific sequence from the termcap
  101. #  file.  The string "cl" is the symbol used in the termcap file to
  102. #  mark the code used to clear the screen.  By executing the
  103. #  expression "iputs(getval("cl"))," you are 1) looking up the "cl"
  104. #  (clear) code in the termcap database entry for your terminal, and
  105. #  the 2) outputting that sequence to the screen.
  106. #    Some other useful termcap symbols are "ce" (clear to end of
  107. #  line), "ho" (go to the top left square on the screen), "so" (begin
  108. #  standout mode), and "se" (end standout mode).  To output a
  109. #  boldfaced string, str, to the screen, you would write -
  110. #
  111. #    iputs(getval("so"))
  112. #    writes(str)
  113. #    iputs(getval("se"))
  114. #
  115. #  You could write "writes(getval("so") || str || getval("se")), but
  116. #  this would only work for DOS.  Some UNIX terminals require padding,
  117. #  and iputs() handles them specially.  Normally you should not worry
  118. #  about UNIX quirks under DOS.  It is in general wise, though, to
  119. #  separate out screen control sequences, and output them via iputs().
  120. #    It is also heartily to be recommended that MS-DOS programmers
  121. #  try not to assume that everyone will be using a 25-line screen.
  122. #  Some terminals are 24-line.  Some 43.  Some have variable window
  123. #  sizes.  If you want to put a status line on, say, the 2nd-to-last
  124. #  line of the screen, then determine what that line is by executing
  125. #  "getval("li")."  The termcap database holds not only string-valued
  126. #  sequences, but numeric ones as well.  The value of "li" tells you
  127. #  how many lines the terminal has (compare "co," which will tell you
  128. #  how many columns).  To go to the beginning of the second-to-last
  129. #  line on the screen, type in:
  130. #
  131. #    iputs(igoto(getval("cm"), 1, getval("li")-1))
  132. #
  133. #  The "cm" capability is a special capability, and needs to be output
  134. #  via igoto(cm,x,y), where cm is the sequence telling your computer
  135. #  to move the cursor to a specified spot, x is the column, and y is
  136. #  the row.  The expression "getval("li")-1" will return the number of
  137. #  the second-to-last line on your screen.
  138. #
  139. ##########################################################################
  140. #
  141. #  Requires: MS-DOS, coexpressions
  142. #
  143. #  See also: iscreen.icn (a set of companion utilities), iolib.icn
  144. #
  145. ##########################################################################
  146.  
  147.  
  148. global tc_table
  149. record true()
  150.  
  151.  
  152. procedure check_features()
  153.  
  154.     local in_params, line
  155.  
  156.     initial {
  157.     find("ms-dos",map(&features)) |
  158.         er("check_features","MS-DOS system required",1)
  159.     find("o-expres",&features) |
  160.         er("check_features","co-expressions not implemented - &$#!",1)
  161.     }
  162.  
  163.     return
  164.  
  165. end
  166.  
  167.  
  168.  
  169. procedure setname(name)
  170.  
  171.     # Sets current terminal type to "name" and builds a new termcap
  172.     # capability database (residing in tc_table).  Fails if unable to
  173.     # find a termcap entry for terminal type "name."  If you want it
  174.     # to terminate with an error message under these circumstances,
  175.     # comment out "| fail" below, and uncomment the er() line.
  176.  
  177.     #tc_table is global
  178.     
  179.     check_features()
  180.  
  181.     tc_table := maketc_table(getentry(name)) | fail
  182.     # er("setname","no termcap entry found for "||name,3)
  183.     return
  184.  
  185. end
  186.  
  187.  
  188.  
  189. procedure getname()
  190.  
  191.     # Getname() first checks to be sure we're running under DOS, and,
  192.     # if so, tries to figure out what the current terminal type is,
  193.     # checking the value of the environment variable TERM, and if this
  194.     # is unsuccessful, defaulting to "mono."
  195.  
  196.     local term, tset_output
  197.  
  198.     check_features()
  199.     term := getenv("TERM") | "mono"
  200.     
  201.     return \term |
  202.     er("getname","can't seem to determine your terminal type",1)
  203.  
  204. end
  205.  
  206.  
  207.  
  208. procedure er(func,msg,errnum)
  209.  
  210.     # short error processing utility
  211.     write(&errout,func,":  ",msg)
  212.     exit(errnum)
  213.  
  214. end
  215.  
  216.  
  217.  
  218. procedure getentry(name, termcap_string)
  219.  
  220.     # "Name" designates the current terminal type.  Getentry() scans
  221.     # the current environment for the variable TERMCAP.  If the
  222.     # TERMCAP string represents a termcap entry for a terminal of type
  223.     # "name," then getentry() returns the TERMCAP string.  Otherwise,
  224.     # getentry() will check to see if TERMCAP is a file name.  If so,
  225.     # getentry() will scan that file for an entry corresponding to
  226.     # "name."  If the TERMCAP string does not designate a filename,
  227.     # getentry() will look through ./termcap for the correct entry.
  228.     # Whatever the input file, if an entry for terminal "name" is
  229.     # found, getentry() returns that entry.  Otherwise, getentry()
  230.     # fails.
  231.  
  232.     local f, getline, line, nm, ent1, ent2
  233.  
  234.     /termcap_string := getenv("TERMCAP")
  235.  
  236.     if \termcap_string ? (not match("\\"), pos(1) | tab(find("|")+1), =name)
  237.     then return termcap_string
  238.     else {
  239.  
  240.     # The logic here probably isn't clear.  The idea is to try to use
  241.     # the termcap environment variable successively as 1) a termcap en-
  242.     # try and then 2) as a termcap file.  If neither works, 3) go to
  243.     # the ./termcap file.  The else clause here does 2 and, if ne-
  244.     # cessary, 3.  The "\termcap_string ? (not match..." expression
  245.     # handles 1.
  246.  
  247.     if find("\\",\termcap_string)
  248.     then f := open(termcap_string)
  249.     /f := open("termcap") |
  250.         er("getentry","I can't access your termcap file",1)
  251.  
  252.     getline := create read_file(f)
  253.     
  254.     while line := @getline do {
  255.         if line ? (pos(1) | tab(find("|")+1), =name, any(':|')) then {
  256.         entry := ""
  257.         while (\line | @getline) ? {
  258.             if entry ||:= 1(tab(find(":")+1), pos(0))
  259.             then {
  260.             close(f)
  261.             # if entry ends in tc= then add in the named tc entry
  262.             entry ?:= tab(find("tc=")) ||
  263.                 # recursively fetch the new termcap entry
  264.                 (move(3), getentry(tab(find(":"))) ?
  265.                     # remove the name field from the new entry
  266.                      (tab(find(":")+1), tab(0)))
  267.             return entry
  268.             }
  269.             else {
  270.             \line := &null # must precede the next line
  271.             entry ||:= trim(trim(tab(0),'\\'),':')
  272.             }
  273.         }
  274.         }
  275.     }
  276.     }
  277.  
  278.     close(f)
  279.     er("getentry","can't find and/or process your termcap entry",3)
  280.  
  281. end
  282.  
  283.  
  284.  
  285. procedure read_file(f)
  286.  
  287.     # Suspends all non #-initial lines in the file f.
  288.     # Removes leading tabs and spaces from lines before suspending
  289.     # them.
  290.  
  291.     local line
  292.  
  293.     \f | er("read_tcap_file","no valid termcap file found",3)
  294.     while line := read(f) do {
  295.     match("#",line) & next
  296.     line ?:= (tab(many('\t ')) | &null, tab(0))
  297.     suspend line
  298.     }
  299.  
  300.     fail
  301.  
  302. end
  303.  
  304.  
  305.  
  306. procedure maketc_table(entry)
  307.  
  308.     # Maketc_table(s) (where s is a valid termcap entry for some
  309.     # terminal-type): Returns a table in which the keys are termcap
  310.     # capability designators, and the values are the entries in
  311.     # "entry" for those designators.
  312.  
  313.     local k, v
  314.  
  315.     /entry & er("maketc_table","no entry given",8)
  316.     if entry[-1] ~== ":" then entry ||:= ":"
  317.     
  318.     tc_table := table()
  319.  
  320.     entry ? {
  321.  
  322.     tab(find(":")+1)    # tab past initial (name) field
  323.  
  324.     while tab((find(":")+1) \ 1) ? {
  325.  
  326.         &subject == "" & next
  327.         if k := 1(move(2), ="=")
  328.         then tc_table[k] := Decode(tab(find(":")))
  329.         else if k := 1(move(2), ="#")
  330.         then tc_table[k] := integer(tab(find(":")))
  331.         else if k := 1(tab(find(":")), pos(-1))
  332.         then tc_table[k] := true()
  333.         else er("maketc_table", "your termcap file has a bad entry",3)
  334.     }
  335.     }
  336.  
  337.     return tc_table
  338.  
  339. end
  340.  
  341.  
  342.  
  343. procedure getval(id)
  344.  
  345.     /tc_table := maketc_table(getentry(getname())) |
  346.     er("getval","can't make a table for your terminal",4)
  347.  
  348.     return \tc_table[id] | fail
  349.     # er("getval","the current terminal doesn't support "||id,7)
  350.  
  351. end
  352.  
  353.  
  354.  
  355. procedure Decode(s)
  356.  
  357.     # Does things like turn ^ plus a letter into a genuine control
  358.     # character.
  359.  
  360.     new_s := ""
  361.  
  362.     s ? {
  363.     while new_s ||:= tab(upto('\\^')) do {
  364.         chr := move(1)
  365.         if chr == "\\" then {
  366.         new_s ||:= {
  367.             case chr2 := move(1) of {
  368.             "\\" : "\\"
  369.             "^"  : "^"
  370.             "E"  : "\e"
  371.             "b"  : "\b"
  372.             "f"  : "\f"
  373.             "n"  : "\n"
  374.             "r"  : "\r"
  375.             "t"  : "\t"
  376.             default : {
  377.                 if any(&digits,chr2) then {
  378.                 char(integer("8r"||chr2||move(2 to 0 by -1))) |
  379.                     er("Decode","bad termcap entry",3)
  380.                 }
  381.                else chr2
  382.             }
  383.             }
  384.         }
  385.         }
  386.         else new_s ||:= char(ord(map(move(1),&lcase,&ucase)) - 64)
  387.     }
  388.     new_s ||:= tab(0)
  389.     }
  390.  
  391.     return new_s
  392.  
  393. end
  394.  
  395.  
  396.  
  397. procedure igoto(cm,col,line)
  398.  
  399.     local colline, range, increment, padding, str, outstr, chr, x, y
  400.  
  401.     if col > (tc_table["co"]) | line > (tc_table["li"]) then {
  402.     colline := string(\col) || "," || string(\line) | string(\col|line)
  403.     range := "(" || tc_table["co"]-1 || "," || tc_table["li"]-1 || ")"
  404.     er("igoto",colline || " out of range " || (\range|""),9)
  405.     } 
  406.  
  407.     # Use the Iconish 1;1 upper left corner & not the C-ish 0 offsets
  408.     increment := -1
  409.     outstr := ""
  410.     
  411.     cm ? {
  412.     while outstr ||:= tab(find("%")) do {
  413.         tab(match("%"))
  414.         if padding := integer(tab(any('23')))
  415.         then chr := (="d" | "d")
  416.         else chr := move(1)
  417.         if case \chr of {
  418.         "." :  outstr ||:= char(line + increment)
  419.         "+" :  outstr ||:= char(line + ord(move(1)) + increment)
  420.         "d" :  {
  421.             str := string(line + increment)
  422.             outstr ||:= right(str, \padding, "0") | str
  423.         }
  424.         }
  425.         then line :=: col
  426.         else {
  427.         case chr of {
  428.             "n" :  line := ixor(line,96) & col := ixor(col,96)
  429.             "i" :  increment := 0
  430.             "r" :  line :=: col
  431.             "%" :  outstr ||:= "%"
  432.             "B" :  line := ior(ishift(line / 10, 4), line % 10)
  433.             ">" :  {
  434.             x := move(1); y := move(1)
  435.             line > ord(x) & line +:= ord(y)
  436.             &null
  437.             }
  438.         } | er("goto","bad termcap entry",5)
  439.         }
  440.     }
  441.     return outstr || tab(0)
  442.     }
  443.  
  444. end
  445.  
  446.  
  447.  
  448. procedure iputs(cp, affcnt)
  449.  
  450.     # Writes cp to the screen.  Use this instead of writes() for
  451.     # compatibility with the UNIX version (which will need to send
  452.     # null padding in some cases).  Iputs() also does a useful type
  453.     # check.
  454.  
  455.     static num_chars
  456.     initial num_chars := &digits ++ '.'
  457.  
  458.     type(cp) == "string" |
  459.     er("iputs","you can't iputs() a non-string value!",10)
  460.  
  461.     cp ? {
  462.     if tab(many(num_chars)) & ="*" then
  463.         stop("iputs:  MS-DOS termcap files shouldn't specify padding.")
  464.     writes(tab(0))
  465.     }
  466.  
  467.     return
  468.  
  469. end
  470.