home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / BIPL.ZIP / PROCS.ZIP / ISCREEN.ICN < prev    next >
Encoding:
Text File  |  1992-09-28  |  7.3 KB  |  304 lines
  1. ############################################################################
  2. #
  3. #    File:     iscreen.icn
  4. #
  5. #    Subject:  Procedures for screen functions
  6. #
  7. #    Author:   Richard L. Goerwitz
  8. #
  9. #    Date:     May 23, 1992
  10. #
  11. ###########################################################################
  12. #
  13. #    Version:  1.28
  14. #
  15. ###########################################################################
  16. #  
  17. #      This file contains some rudimentary screen functions for use with
  18. #  itlib.icn (termlib-like routines for Icon).
  19. #
  20. #      clear()              - clears the screen (tries several methods)
  21. #      emphasize()          - initiates emphasized (usu. = reverse) mode
  22. #      boldface()           - initiates bold mode
  23. #      blink()              - initiates blinking mode
  24. #      normal()             - resets to normal mode
  25. #      message(s)           - displays message s on 2nd-to-last line
  26. #      underline()          - initiates underline mode
  27. #      status_line(s,s2,p)  - draws status line s on the 3rd-to-last
  28. #        screen line; if s is too short for the terminal, s2 is used;
  29. #        if p is nonnull then it either centers, left-, or right-justi-
  30. #        fies, depending on the value, "c," "l," or "r."
  31. #      clear_emphasize()    - horrible way of clearing the screen to all-
  32. #        emphasize mode; necessary for many terminals
  33. #
  34. ############################################################################
  35. #
  36. #  Requires: UNIX
  37. #
  38. #  Links: itlib.icn (or your OS-specific port of itlib)
  39. #
  40. #  See also: boldface.icn
  41. #
  42. ############################################################################
  43.  
  44.  
  45. procedure clear()
  46.  
  47.     # Clears the screen.  Tries several methods.
  48.     local i
  49.  
  50.     normal()
  51.     if not iputs(getval("cl"))
  52.     then iputs(igoto(getval("cm"),1,1) | getval("ho"))
  53.     if not iputs(getval("cd"))
  54.     then {
  55.     every i := 1 to getval("li") do {
  56.         iputs(igoto(getval("cm"),1,i))
  57.         iputs(getval("ce"))
  58.     }
  59.     iputs(igoto(getval("cm"),1,1))
  60.     }
  61.     return
  62.  
  63. end
  64.  
  65.  
  66.  
  67. procedure boldface()
  68.     
  69.     static bold_str, cookie_str
  70.     initial {
  71.     if bold_str := getval("md")
  72.     then cookie_str := repl(getval("le"|"bc") | "\b", getval("mg"))
  73.     else {
  74.         # One global procedure value substituted for another.
  75.         boldface := emphasize
  76.         return emphasize()
  77.     }
  78.     }        
  79.  
  80.     normal()
  81.     iputs(\bold_str)
  82.     iputs(\cookie_str)
  83.     return
  84.  
  85. end
  86.  
  87.  
  88.  
  89. procedure blink()
  90.     
  91.     static blink_str, cookie_str
  92.     initial {
  93.     if blink_str := getval("mb")
  94.     then cookie_str :=
  95.          repl(getval("le"|"bc") | "\b", getval("mg"))
  96.     else {
  97.         # One global procedure value substituted for another.
  98.         blink := emphasize
  99.         return emphasize()
  100.     }
  101.     }        
  102.  
  103.     normal()
  104.     iputs(\blink_str)
  105.     iputs(\cookie_str)
  106.     return
  107.  
  108. end
  109.  
  110.  
  111.  
  112. procedure emphasize()
  113.     
  114.     static emph_str, cookie_str
  115.     initial {
  116.     if emph_str := getval("so")
  117.     then cookie_str := repl(getval("le"|"bc") | "\b", getval("sg"))
  118.     else {
  119.         if emph_str := getval("mr")
  120.         then cookie_str := repl(getval("le"|"bc") | "\b", getval("mg"))
  121.         else if emph_str := getval("us")
  122.         then cookie_str := repl(getval("le"|"bc") | "\b", getval("ug"))
  123.     }
  124.     }        
  125.  
  126.     normal()
  127.     iputs(\emph_str)
  128.     iputs(\cookie_str)
  129.     return
  130.  
  131. end
  132.  
  133.  
  134.  
  135. procedure underline()
  136.     
  137.     static underline_str, cookie_str
  138.     initial {
  139.     if underline_str := getval("us")
  140.     then cookie_str := repl(getval("le"|"bc") | "\b", getval("ug"))
  141.     }
  142.  
  143.     normal()
  144.     iputs(\underline_str)
  145.     iputs(\cookie_str)
  146.     return
  147.  
  148. end
  149.  
  150.  
  151.  
  152. procedure normal(mode)
  153.  
  154.     static UN_emph_str, emph_cookie_str,
  155.     UN_underline_str, underline_cookie_str,
  156.     UN_bold_str, bold_cookie_str
  157.  
  158.     initial {
  159.  
  160.     # Find out code to turn off emphasize (reverse video) mode.
  161.     if UN_emph_str := getval("se") then
  162.         # Figure out how many backspaces we need to erase cookies.
  163.         emph_cookie_str := repl(getval("le"|"bc") | "\b", getval("sg"))
  164.     else UN_emph_str := ""
  165.  
  166.     # Finally, figure out how to turn off underline mode.
  167.     if UN_underline_str := (UN_emph_str ~== getval("ue")) then
  168.         underline_cookie_str := repl(getval("le"|"bc")|"\b", getval("ug"))
  169.     else UN_underline_str := ""
  170.  
  171.     # Figure out how to turn off boldface mode.
  172.     if UN_bold_str := 
  173.         (UN_underline_str ~== (UN_emph_str ~== getval("me"))) then
  174.         # Figure out how many backspaces we need to erase cookies.
  175.         bold_cookie_str := repl(getval("le"|"bc") | "\b", getval("mg"))
  176.     else UN_bold_str := ""
  177.  
  178.     }        
  179.     
  180.     iputs("" ~== UN_emph_str) &
  181.     iputs(\emph_cookie_str)
  182.  
  183.     iputs("" ~== UN_underline_str) &
  184.     iputs(\underline_cookie_str)
  185.  
  186.     iputs("" ~== UN_bold_str) &
  187.     iputs(\bold_cookie_str)
  188.  
  189.     return
  190.  
  191. end
  192.  
  193.  
  194.  
  195. procedure status_line(s,s2,p)
  196.  
  197.     # Writes a status line on the terminal's third-to-last line
  198.     # The only necessary argument is s.  S2 (optional) is used
  199.     # for extra narrow screens.  In other words, by specifying
  200.     # s2 you give status_line an alternate, shorter status string
  201.     # to display, in case the terminal isn't wide enough to sup-
  202.     # port s.  If p is nonnull, then the status line is either
  203.     # centered (if equal to "c"), left justified ("l"), or right
  204.     # justified ("r").
  205.  
  206.     local width
  207.  
  208.     /s := ""; /s2 := ""; /p := "c"
  209.     width := getval("co")
  210.     if *s > width then {
  211.     (*s2 < width, s := s2) |
  212.         er("status_line","Your terminal is too narrow.",4)
  213.     }
  214.  
  215.     case p of {
  216.     "c"    : s := center(s,width)
  217.     "l"    : s := left(s,width)
  218.     "r"    : s := right(s,width)
  219.     default: stop("status_line:  Unknown option "||string(p),4)
  220.     }
  221.  
  222.     iputs(igoto(getval("cm"), 1, getval("li")-2))
  223.     emphasize(); writes(s)
  224.     normal()
  225.     return
  226.  
  227. end
  228.  
  229.  
  230.  
  231. procedure message(s)
  232.  
  233.     # Display prompt s on the second-to-last line of the screen.
  234.     # I hate to use the last line, due to all the problems with
  235.     # automatic scrolling.
  236.  
  237.     /s := ""
  238.     normal()
  239.     iputs(igoto(getval("cm"), 1, getval("li")))
  240.     iputs(getval("ce"))
  241.     normal()
  242.     iputs(igoto(getval("cm"), 1, getval("li")-1))
  243.     iputs(getval("ce"))
  244.     writes(s[1:getval("co")] | s)
  245.     return
  246.  
  247. end
  248.  
  249.  
  250.  
  251. procedure clear_underline()
  252.  
  253.     # Horrible way of clearing the screen to all underline mode, but
  254.     # the only apparent way we can do it "portably" using the termcap
  255.     # capability database.
  256.  
  257.     local i
  258.  
  259.     underline()
  260.     iputs(igoto(getval("cm"),1,1))
  261.     if getval("am") then {
  262.     underline()
  263.         every 1 to (getval("li")-1) * getval("co") do
  264.         writes(" ")
  265.     }
  266.     else {
  267.     every i := 1 to getval("li")-1 do {
  268.         iputs(igoto(getval("cm"), 1, i))
  269.         underline()
  270.         writes(repl(" ",getval("co")))
  271.     }
  272.     }
  273.     iputs(igoto(getval("cm"),1,1))
  274.  
  275. end
  276.  
  277.  
  278.  
  279. procedure clear_emphasize()
  280.  
  281.     # Horrible way of clearing the screen to all reverse-video, but
  282.     # the only apparent way we can do it "portably" using the termcap
  283.     # capability database.
  284.  
  285.     local i
  286.  
  287.     emphasize()
  288.     iputs(igoto(getval("cm"),1,1))
  289.     if getval("am") then {
  290.     emphasize()
  291.         every 1 to (getval("li")-1) * getval("co") do
  292.         writes(" ")
  293.     }
  294.     else {
  295.     every i := 1 to getval("li")-1 do {
  296.         iputs(igoto(getval("cm"), 1, i))
  297.         emphasize()
  298.         writes(repl(" ",getval("co")))
  299.     }
  300.     }
  301.     iputs(igoto(getval("cm"),1,1))
  302.  
  303. end
  304.