home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / CLIPPER / SCRTIL / SCRTILE.PRG
Text File  |  1993-02-08  |  8KB  |  233 lines
  1. /*
  2.  * File......: SCRTILE.PRG
  3.  * Author....: Todd C. MacDonald
  4.  * CIS ID....: 73767,2242
  5.  * Date......: $Date$
  6.  * Revision..: $Revision$
  7.  * Log file..: $Logfile$
  8.  *
  9.  * This is an original work by Todd C. MacDonald and is hereby
  10.  * placed in the public domain.
  11.  *
  12.  * Modification history:
  13.  * ---------------------
  14.  *
  15.  * $Log$
  16.  *
  17.  */
  18.  
  19.  
  20. /*  $DOC$
  21.  *  $FUNCNAME$
  22.  *      ft_scrtile()
  23.  *  $CATEGORY$
  24.  *      To be assigned
  25.  *  $ONELINER$
  26.  *      Paint a "tiled" text pattern over a specified screen region.
  27.  *  $SYNTAX$
  28.  *      ft_scrtile( <acTile>, <nColor>, ;
  29.  *        [<nT>], [<nL>], [<nB>], [<nR>] ) -> NIL
  30.  *  $ARGUMENTS$
  31.  *      <acTile> is a single or multi-dimensional array of
  32.  *      character strings to be used as a "tile" which will be
  33.  *      replicated to cover the specified screen region.
  34.  *
  35.  *      <nColor> is an integer representing the color attribute.
  36.  *      The formula is: nFore + ( nBack * 16 )
  37.  *
  38.  *      <nT>, <nL>, <nB>, and <nR> are the optional coordinates of
  39.  *      the screen region you wish to "tile" over.  The defaults
  40.  *      for each if not passed are 0, 0, maxrow(), and maxcol()
  41.  *      respectively.
  42.  *  $RETURNS$
  43.  *      NIL
  44.  *  $DESCRIPTION$
  45.  *      This function may be used to paint an attractive backdrop or
  46.  *      "desktop" surface on which to display your windows or other
  47.  *      screen objects.
  48.  *  $EXAMPLES$
  49.  *      ft_scrtile( { '░' }, 20 )     // Fills the screen with R/B '░'s.
  50.  *                                    // "@...box" might be a better choice
  51.  *                                    // in this case.
  52.  *
  53.  *      ft_scrtile( { ;               // Fills the region specified with
  54.  *        '░░░░▓▓▓▓', ;               // the pattern shown in Yellow on
  55.  *        '░░░░▓▓▓▓', ;               // Magenta.
  56.  *        '▓▓▓▓░░░░', ;
  57.  *        '▓▓▓▓░░░░' }, ;
  58.  *        94, 2, 4, maxrow() - 3, maxcol() - 4 )
  59.  *
  60.  *      ft_scrtile( { ;               // Fills the screen with the pattern
  61.  *        '        ', ;             // shown in White on Cyan.
  62.  *        '         ', ;
  63.  *        '        ', ;
  64.  *        '         ', ;
  65.  *        '         ' }, 63 )
  66.  *
  67.  *      ft_scrtile( { ;               // You get the idea.
  68.  *        '                    ', ;
  69.  *        '  NanForum         ', ;
  70.  *        '                    ', ;
  71.  *        '                    ', ;
  72.  *        '     ■     ToolKit  ', ;
  73.  *        '                    ' }, 31 )
  74.  *  $SEEALSO$
  75.  *
  76.  *  $INCLUDE$
  77.  *
  78.  *  $END$
  79.  */
  80.  
  81.  
  82. #ifdef FT_TEST
  83.  
  84.  
  85. //--------------------------------------------------------------------------//
  86.   FUNCTION TestDriver
  87. //--------------------------------------------------------------------------//
  88.  
  89. #command WAIT => ;
  90.   @ maxrow(), 0 ;;
  91.   @ maxrow(), int( ( maxcol() - 16 ) / 2 ) say 'press any key...' ;;
  92.   inkey( 0 )
  93.  
  94. // I know, a total waste of time and disk space, but it's fun to watch... 
  95.  
  96. LOCAL aFTlogo := { ;
  97.   { '                    ','  NanForum         ','                    ', ;
  98.     '                    ','     ■     Toolkit  ','                    ' }, ;
  99.   { '                    ','    NanForum       ','                    ', ;
  100.     '                    ','   ■     Toolkit    ','                    ' }, ;
  101.   { '                    ','      NanForum      ','                   ', ;
  102.     '  ■                 ','       Toolkit      ','                    ' }, ;
  103.   { '                    ','  ■     NanForum    ','                    ', ;
  104.     '                    ','     Toolkit       ','                    ' }, ;
  105.   { '                    ','    ■     NanForum  ','                    ', ;
  106.     '                    ','   Toolkit         ','                    ' }, ;
  107.   { '                    ','      ■     NanFor  ','                 u  ', ;
  108.     '  T              m  ','  oolkit           ','                    ' }, ;
  109.   { '                    ','  T     ■     NanF  ','  o              o  ', ;
  110.     '  o              r  ','  lkit         mu  ','                    ' }, ;
  111.   { '                    ','  ooT     ■     Na  ','  l              n  ', ;
  112.     '  k              F  ','  it         muro  ','                    ' }, ;
  113.   { '                    ','  klooT     ■       ','  i              N  ', ;
  114.     '  t              a  ','           muroFn  ','                    ' }, ;
  115.   { '                    ','  tiklooT     ■     ','                    ', ;
  116.     '                    ','         muroFnaN  ','                    ' }, ;
  117.   { '                    ','    tiklooT     ■   ','                    ', ;
  118.     '                    ','       muroFnaN    ','                    ' }, ;
  119.   { '                    ','      tiklooT       ','                 ■  ', ;
  120.     '                   ','      muroFnaN      ','                    ' }, ;
  121.   { '                    ','       tiklooT     ','                    ', ;
  122.     '                    ','    muroFnaN     ■  ','                    ' }, ;
  123.   { '                    ','         tiklooT   ','                    ', ;
  124.     '                    ','  muroFnaN     ■    ','                    ' }, ;
  125.   { '                    ','           tikloo  ','  m              T  ', ;
  126.     '  u                 ','  roFnaN     ■      ','                    ' }, ;
  127.   { '                    ','  um         tikl  ','  r              o  ', ;
  128.     '  o              o  ','  FnaN     ■     T  ','                    ' }, ;
  129.   { '                    ','  orum         ti  ','  F              k  ', ;
  130.     '  n              l  ','  aN     ■     Too  ','                    ' }, ;
  131.   { '                    ','  nForum           ','  a              t  ', ;
  132.     '  N              i  ','       ■     Toolk  ','                    ' } }
  133.  
  134. LOCAL lExited := .f., n
  135.  
  136. ft_scrtile( { '░' }, 20 )
  137.  
  138. wait
  139.  
  140. ft_scrtile( { ;
  141.   '░░░░▓▓▓▓', ;
  142.   '░░░░▓▓▓▓', ;
  143.   '▓▓▓▓░░░░', ;
  144.   '▓▓▓▓░░░░' }, 94, 2, 4, maxrow() - 3, maxcol() - 4 )
  145.  
  146. wait
  147.  
  148. ft_scrtile( { ;
  149.   '        ', ;
  150.   '         ', ;
  151.   '        ', ;
  152.   '         ', ;
  153.   '         ' }, 63 )
  154.  
  155. wait
  156.  
  157. WHILE !lExited
  158.  
  159.   FOR n := 1 TO 18
  160.  
  161.     ft_scrtile( aFTlogo[ n ], 31,,, maxrow() - 1 )
  162.  
  163.     IF inkey() != 0
  164.  
  165.       lExited := .t.
  166.  
  167.       EXIT
  168.  
  169.     ENDIF
  170.  
  171.   NEXT
  172.  
  173. END
  174.  
  175. ft_scrtile( aFTlogo[ 1 ], 31,,, maxrow() - 1 )
  176.  
  177. @ maxrow(), 0
  178.  
  179. setpos( maxrow() - 1, 0 )
  180.  
  181. RETURN nil
  182. //--------------------------------------------------------------------------//
  183.  
  184.  
  185. #endif
  186.  
  187.  
  188. //--------------------------------------------------------------------------//
  189.   FUNCTION ft_scrtile( acTile, nColor, nT, nL, nB, nR )
  190. //--------------------------------------------------------------------------//
  191.  
  192. LOCAL acPattern := aclone( acTile )
  193. LOCAL cColor    := chr( nColor )
  194. LOCAL nPattRows := len( acPattern )
  195. LOCAL nPattCols := len( acPattern[ 1 ] ) * 2
  196. LOCAL nPattRow  := 0
  197. LOCAL cScrReg   := ''
  198.  
  199. LOCAL nMaxCol, nNbrReps, nY, nX, nRow
  200.  
  201. IF nT = nil; nT := 0;        ENDIF
  202. IF nL = nil; nL := 0;        ENDIF
  203. IF nB = nil; nB := maxrow(); ENDIF
  204. IF nR = nil; nR := maxcol(); ENDIF
  205.  
  206. nMaxCol  := nR - nL + 1
  207. nNbrReps := int( nMaxCol / ( nPattCols / 2 ) ) + 1
  208.  
  209. // insert color attribute into background pattern
  210. FOR nY := 1 to nPattRows
  211.  
  212.   FOR nX := 2 to nPattCols step 2
  213.  
  214.     acPattern[ nY ] = stuff( acPattern[ nY ], nX, 0, cColor )
  215.  
  216.   NEXT
  217.  
  218. NEXT
  219.  
  220. // replicate background pattern and attributes for screen region
  221. FOR nRow := nT to nB
  222.  
  223.   nPattRow := iif( nPattRow + 1 <= nPattRows, nPattRow + 1, 1 )
  224.  
  225.   cScrReg += left( replicate( acPattern[ nPattRow ], nNbrReps ), nMaxCol * 2 )
  226.  
  227. NEXT
  228.  
  229. // paint the tile pattern over the specified screen region
  230. restscreen( nT, nL, nB, nR, cScrReg )
  231.  
  232. RETURN nil
  233. //--------------------------------------------------------------------------//