home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a066 / 1.img / WIN.PRG < prev    next >
Encoding:
Text File  |  1992-03-20  |  6.6 KB  |  324 lines
  1. /*
  2.     win.prg
  3.  
  4.     Copyright (c) 1991 Anton van Straaten
  5. */
  6.  
  7.  
  8. #include "class(y).ch"
  9. #include "win.ch"
  10. #include "gen.ch"
  11.  
  12.  
  13. static currWin
  14.  
  15.  
  16. create class Window
  17.  
  18.     instvar buf
  19.     instvar cursor
  20.  
  21.     classvar winList
  22.  
  23.     method  close
  24.     method  open
  25.  
  26. export :
  27.     instvar top, left, bottom, right noassign
  28.     instvar margin      noassign
  29.  
  30.     instvar boxChars    noassign
  31.     instvar frameColor  noassign
  32.     instvar paneColor   noassign
  33.     instvar isOpen      noassign
  34.  
  35.     method  width       // make these instvars?
  36.     method  height
  37.  
  38.     method  show
  39.     method  draw
  40.     method  clear
  41.     method  hide
  42.     method  hideOn
  43.     method  kill
  44.     method  killOn
  45.  
  46.     method  activate
  47.  
  48.     method  title
  49.  
  50.     class method hideAll
  51.  
  52. endclass
  53.  
  54.  
  55.  
  56. constructor new (nTop, nLeft, nBottom, nRight, cFrame, cFrameColor, cPaneColor, lOpen)
  57.     ::top    := nTop
  58.     ::left   := nLeft
  59.     ::bottom := nBottom
  60.     ::right  := nRight
  61.  
  62.     ::boxChars   := ifnil(cFrame, DUBLBORD)
  63.     ::frameColor := cFrameColor
  64.     ::paneColor  := cPaneColor
  65.  
  66.     if lOpen == NIL .or. lOpen
  67.         ::show()
  68.     end
  69. return
  70.  
  71.  
  72.  
  73. method procedure show
  74.     if ::isOpen == NIL .or. !::isOpen
  75.         if ::winList == NIL
  76.             ::winList := list():new
  77.         end
  78.         if ::winList:tail() <> NIL
  79.             ::winList:tail():cursor := cursor():new
  80.         end
  81.         ::open()
  82.         ::winList:add(self)
  83.     else
  84.         ::activate()
  85.     end
  86. return
  87.  
  88.  
  89.  
  90. method procedure open
  91.     local buf := savescreen(::top, ::left, ::bottom, ::right)
  92.     winCurrent(self)
  93.     if ::isOpen == NIL
  94.         ::draw()
  95.     else
  96.         restscreen(::top, ::left, ::bottom, ::right, ::buf)
  97.         ::cursor:show()
  98.     end
  99.     ::buf := buf
  100.     ::isOpen := .t.
  101. return
  102.  
  103.  
  104.  
  105. method procedure draw
  106.     if ::isOpen == NIL .or. !::isOpen
  107.         ::margin := 0
  108.         if ::boxChars <> NOBORDER
  109.             setcolor(::frameColor)
  110.             // margin must be 0 for following to work
  111.             @ 0, 0, maxrow(), maxcol() box ::boxChars
  112.             ::margin := 1
  113.         end
  114.         ::clear()
  115.     end
  116. return
  117.  
  118.  
  119.  
  120. method procedure clear
  121.     setcolor(::paneColor)
  122.     @ 0, 0 clear to maxrow(), maxcol()
  123.     ::cursor := cursor():new
  124. return
  125.  
  126.  
  127.  
  128. method function hideOn(event)
  129.     local key
  130.     local eventType := valtype(event)
  131.     local curstate := setcursor(1)
  132.     if eventType = 'C'
  133.         // event should contain a string of key values
  134.         while !(chr(key := inkey(0)) $ event)
  135.         end
  136.     elseif eventType $ 'NU'
  137.         // event should contain a number of seconds;
  138.         // 0 waits indefinitely for keystroke
  139.         key := inkey(event)
  140.     end
  141.     setcursor(curstate)
  142.     ::hide()
  143. return key
  144.  
  145.  
  146.  
  147. method procedure hide
  148.     if ::isOpen <> NIL .and. ::isOpen
  149.         if !(self == ::winList:tail())
  150.             ::activate()    // tbd: flag to prevent open of window being deleted? or use procname() in activate
  151.         end
  152.         ::close()
  153.         ::winList:delete()
  154.         if ::winList:tail() <> NIL
  155.             ::winList:tail():activate()
  156.         end
  157.     end
  158. return
  159.  
  160.  
  161.  
  162. method procedure close
  163.     local buf := savescreen(::top, ::left, ::bottom, ::right)
  164.     restscreen(::top, ::left, ::bottom, ::right, ::buf)
  165.     ::cursor:update()
  166.     ::buf := buf
  167.     ::isOpen := .f.
  168. return
  169.  
  170.  
  171.  
  172. method procedure kill
  173.     ::hide()
  174.     ::buf := NIL
  175.     ::cursor := NIL
  176. return
  177.  
  178.  
  179.  
  180. method function killOn(event)
  181.     local key := ::hideOn(event)
  182.     ::kill()
  183. return key
  184.  
  185.  
  186.  
  187. method procedure activate
  188.     local win := ::winList:tail()
  189.  
  190.     if !(win == self) .and. win <> NIL
  191.         // close all windows down to self
  192.         while win <> NIL
  193.             win:close()
  194.             if win == self
  195.                 exit
  196.             end
  197.             win := ::winList:prev()
  198.         end
  199.  
  200.         ::winList:delete()              // delete self from list
  201.         win := ::winList:current()
  202.  
  203.         while win <> NIL
  204.             win:open()
  205.             win := ::winList:next()
  206.         end
  207.         ::winList:add(self)
  208.         ::open()
  209.     elseif win <> NIL
  210.         ::cursor:show()
  211.         winCurrent(self)
  212.     end
  213. return
  214.  
  215.  
  216.  
  217. method function width
  218. return (::right - ::left - ::margin * 2 + 1)
  219.  
  220.  
  221. method function height
  222. return (::bottom - ::top - ::margin * 2 + 1)
  223.  
  224.  
  225. method procedure hideAll
  226.     local win
  227.  
  228.     while (win := ::winList:tail()) != NIL
  229.         win:hide()
  230.     end
  231. return
  232.  
  233.  
  234. /*
  235.  
  236.     :title(cMsg, nPosn, cColor)
  237.  
  238.     Display msg on the window border in position specified by posn, which
  239.     must be one of the constants specified in winInit(): wTL, wTC, wTR, wBL,
  240.     wBC, or wBR.  If msg is numeric, the relevant portion of the border is
  241.     redrawn.  The color parameter is optional.
  242.  
  243. */
  244.  
  245. method procedure title(msg, posn, color)
  246.     local row, col, horizline
  247.  
  248.     if ::isOpen == NIL .or. !::isOpen        // tbd: method for this?
  249.         return
  250.     end
  251.  
  252.     ::activate()
  253.     ifnil posn := wTC
  254.     if posn = wTL .or. posn = wTC .or. posn = wTR
  255.         row = ::top
  256.         horizline = substr(::boxChars, 2, 1)
  257.     elseif posn = wBL .or. posn = wBC .or. posn = wBR
  258.         row = ::bottom
  259.         horizline = substr(::boxChars, 6, 1)
  260. *    else
  261.         * tbd: error (or other behaviour?)
  262.     end
  263.  
  264.     if valtype(msg) = 'N'
  265.         msg = replicate(horizline, msg)
  266.     end
  267.  
  268.     do case
  269.         case posn = wTL .or. posn = wBL
  270.             col = ::left + 2
  271.         case posn = wTC .or. posn = wBC
  272.             col = (::right + ::left - len(msg))/2
  273.         case posn = wTR .or. posn = wBR
  274.             col = ::right - len(msg) - 2
  275.     end
  276.  
  277.     if col + len(msg) > ::right
  278.         msg = left(msg, ::right - col)           // truncate message
  279.     end
  280.  
  281.     ::cursor:update()
  282.     setcolor(if(color == NIL, ::frameColor, color))
  283.     // to avoid translation:
  284.     DevPos(row, col)
  285.     DevOut(msg)
  286.     ::cursor:show()
  287.  
  288. return
  289.  
  290.  
  291. function winCurrent(w)
  292.     if w != NIL
  293.         if valtype(w) == 'N' .and. w == 0
  294.             // this is the only way to select the main screen at present. tbd.
  295.             CurrWin := NIL
  296.         else
  297.             CurrWin := w
  298.         end
  299.     end
  300. return CurrWin
  301.  
  302.  
  303. function winTop
  304. return if(CurrWin == NIL, 0, CurrWin:top + CurrWin:margin)
  305.  
  306. function winLeft
  307. return if(CurrWin == NIL, 0, CurrWin:left + CurrWin:margin)
  308.  
  309. function winMaxRow
  310. // 24 below is very naughty
  311. return if(CurrWin == NIL, 24, CurrWin:height() - 1)
  312.  
  313. function winMaxCol
  314. // 79 below is very naughty
  315. return if(CurrWin == NIL, 79, CurrWin:width() - 1)
  316.  
  317.  
  318. // used in win.ch
  319. function _wintrunc(str, nCol)
  320. return left(str, if(CurrWin == NIL, 79, CurrWin:width() - nCol))
  321.  
  322.  
  323. // eof win.prg
  324.