home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a012 / 1.ddi / CHAP13.EXE / CHP1352.PRG < prev    next >
Encoding:
Text File  |  1991-06-12  |  4.3 KB  |  152 lines
  1. /*
  2.    Listing 13.52 Demonstration of Windowing Functions
  3.    Author: Joe Booth
  4.    Excerpted from "Clipper 5: A Developer's Guide"
  5.    Copyright (c) 1991 M&T Books
  6.                       501 Galveston Drive
  7.                       Redwood City, CA 94063-4728
  8.                       (415) 366-3600
  9. */
  10.  
  11. //───── NOTE: must compile with the /N option!
  12.  
  13. #include "box.ch"
  14.  
  15. static wstack := {}
  16. memvar getlist      // to squelch compiler warnings
  17.  
  18. #define TOP       wstack[len(wstack), 1]
  19. #define LEFT      wstack[len(wstack), 2]
  20. #define BOTTOM    wstack[len(wstack), 3]
  21. #define RIGHT     wstack[len(wstack), 4]
  22. #define CONTENTS  wstack[len(wstack), 5]
  23.  
  24. #define TESTING     // to compile test program -- remove at will
  25.  
  26. // begin test program
  27.  
  28. #ifdef TESTING
  29.  
  30. /* user-defined command to allow familiar @..SAY / @..GET style syntax */
  31. #xcommand @ <r>, <c> WSAY <t>  =>  WSay( <r>, <c>, <t> )
  32. #xcommand @ <r>, <c> WGET <v> [<list,...>]  => ;
  33.                    @ WRow( <r> ), WCol( <c> ) get <v> [<list>]
  34.  
  35. #include "inkey.ch"
  36. #include "fileio.ch"
  37. #define LOGFILE  "change.log"      // default name for log file
  38. #define CRLF     chr(13)+chr(10)   // self-explanatory
  39.  
  40. function sugg_box
  41. local mwho := space(3), mdate := date(), mtime := time(), x
  42. local handle, mnotes := [], lines, oldcolor := setcolor()
  43. local oldf10
  44. local oldscore := set(_SET_SCOREBOARD, .F.)  // shut off scoreboard
  45. WCreate(5, 20, 16, 60, "B+/W")         // Display a window
  46. /* note that all of the following @ coordinates will be
  47.    positioned relative to the active window! */
  48. @ 0, 2 wsay "Change Suggestions"
  49. @ 1, 1 wsay "Who :"
  50. @ 2, 1 wsay "Date:"
  51. @ 3, 1 wsay "Time:"
  52. @ 4, 1 wsay "Idea:"
  53.  
  54. @ 1, 7 wget mwho picture "!!!"
  55. @ 2, 7 wget mdate
  56. @ 3, 7 wget mtime
  57. read
  58. if lastkey() <> K_ESC
  59.    /* enable F10 to emulate Ctrl-W keypress -- see below */
  60.    oldf10 := setkey(K_F10, { || quicksave() } )
  61.    @ 11, 8 wsay "Press F10 to save notes"
  62.    mnotes := memoedit(mnotes, WRow(4), WCol(7), WRow(10), WCol(38), .t.)
  63.    if ! empty(mnotes)
  64.       if file( LOGFILE )
  65.          handle := fopen( LOGFILE, FO_READWRITE)
  66.          /* move to end of file in order to append to it */
  67.          fseek(handle, 0, FS_END)
  68.       else
  69.          handle := fcreate( LOGFILE, FC_NORMAL)
  70.       endif
  71.       Fwrite(handle, "WHO: " + mwho + " on " + dtoc(mdate) + ;
  72.                     " at " + mtime + CRLF, 34)
  73.       lines := mlcount(mnotes, 50)
  74.       for x = 1 to lines
  75.           fwrite(handle, memoline(mnotes, 50, x), 50)
  76.       next
  77.       fwrite(handle, CRLF)
  78.       fclose(handle)
  79.    endif
  80.    setkey(K_F10, oldf10)
  81. endif
  82. WKill()
  83. setcolor(oldcolor)                 // reset color
  84. set(_SET_SCOREBOARD, oldscore)     // reset SCOREBOARD status
  85. return NIL
  86.  
  87. static function quicksave
  88. keyboard chr(23)
  89. return nil
  90.  
  91. #endif
  92.  
  93. // end test program -- begin main windowing functions
  94.  
  95.  
  96. /* WCreate() - create and open active window */
  97. function WCreate(t, l, b, r, w_color)
  98. /* use current color setting if color was not passed */
  99. w_color := if(w_color = NIL, setcolor(), w_color)
  100. /* add this information to the window stack */
  101. aadd(wstack, { t, l, b, r, savescreen(t, l, b, r) } )
  102. setcolor(w_color)
  103. @ t, l, b, r box B_DOUBLE_SINGLE + ' '
  104. return NIL
  105.  
  106.  
  107. /* WKill() - close active window and remove from stack */
  108. function WKill
  109. /* make sure window stack is not empty */
  110. if ! empty(wstack)
  111.    /* restore previous screen under this window */
  112.    Restscreen( TOP, LEFT, BOTTOM, RIGHT, CONTENTS)
  113.    /* truncate window stack */
  114.    asize(wstack, len(wstack) - 1)
  115. endif
  116. return NIL
  117.  
  118.  
  119. /* WRow() - returns row relative to window */
  120. function WRow(_offrow)
  121. return if(empty(wstack), 0, TOP + _offrow)
  122.  
  123.  
  124. /* WCol() - returns column relative to window */
  125. function WCol(_offcol)
  126. return if(empty(wstack), 0, LEFT + _offcol)
  127.  
  128. /* WClear() - clear contents of active window */
  129. function WClear
  130. if ! empty(wstack)
  131.    scroll(TOP + 1, LEFT + 1, BOTTOM - 1, RIGHT - 1, 0)
  132. endif
  133. return NIL
  134.  
  135.  
  136. /* WSay() - @..SAY redirected to current window */
  137. function WSay(wrow, wcol, wtext)
  138. if ! empty(wstack)
  139.    @ WRow(wrow), WCol(wcol) say wtext
  140. endif
  141. return NIL
  142.  
  143.  
  144. /* WPrompt() - @..PROMPT redirected to current window */
  145. function WPrompt(wrow, wcol, wtext)
  146. if ! empty(wstack)
  147.    @ WRow(wrow), WCol(wcol) prompt wtext
  148. endif
  149. return NIL
  150.  
  151. // end of file CHP1352.PRG
  152.