home *** CD-ROM | disk | FTP | other *** search
/ Piper's Pit BBS/FTP: ibm 0010 - 0019 / ibm0010-0019 / ibm0010.tar / ibm0010 / CLIPB52.ZIP / GELLER.ZIP / STDIO.PRG < prev   
Encoding:
Text File  |  1990-06-02  |  3.6 KB  |  151 lines
  1. *  Program Name..: STDIO.PRG
  2. *  Author........: Barbara Geller
  3. *  Date..........: 05/21/90
  4. *  Description...: Supporting functions 
  5. *  Notice........: 1990 Clipper Developers Conference 
  6.  
  7. FUNCTION center(row,msg1) 
  8.    @ row,INT((80-LEN(msg1))/2 +.5) say msg1
  9.    return .t.
  10. * endfunc : center
  11.  
  12. FUNCTION center_sh(rrow, banner, t, l, b, r, frame)
  13.    * 1 = clear  2 = double     3 = single    4 = doub top single side  
  14.    * 5 = single top doub side  6 = heavy box 
  15.  
  16.    frame := IF(frame = 0 .or. frame > 7,1,frame) 
  17.  
  18.    PAINT(co_detail)
  19.    @ t,l,b,r box SUBSTR(;
  20.         "         ╔═╗║╝═╚║ ┌─┐│┘─└│ ╒═╕│╛═╘│ ╓─╖║╜─╙║ █▀███▄██ ",;
  21.         ((frame-1) * 9)+1,9)
  22.  
  23.    IF ! EMPTY(banner) 
  24.       @ rrow,int((80-LEN(banner))/2 +.5) say banner
  25.    ENDIF
  26.    PAINT(pop) 
  27.  
  28.    PAINT(co_blank)
  29.    @ t+1,r+1,b+1,r+2 box SUBSTR("  ▄█    █",1,9)  
  30.    @ b+1,l+1,b+1,r+1 box SUBSTR(" █       ",1,9)
  31.    PAINT(pop) 
  32.  
  33.    return .t.
  34. * endfunc
  35.  
  36. FUNCTION err_msg(msg1)
  37.    PAINT(co_err)
  38.    PCLR("ebuff",23,0,24,79,0)
  39.                
  40.    @ 23,INT((80-LEN(msg1))/2 +.5) say msg1
  41.    @ 24,27 say "Press any key to continue."     
  42.    INKEY(0)
  43.  
  44.    PAINT(pop)
  45.    RESTSCREEN(23,0,24,79,ebuff)
  46.    return .t.
  47. * endfunc : err_msg
  48.  
  49. FUNCTION inits
  50.    LOCAL count
  51.  
  52.    PUBLIC co_norm, co_banner, co_detail, co_err, co_get, co_blank 
  53.    PUBLIC co_wind, co_invwind 
  54.    PUBLIC pbuff,ebuff,pop_arry[10],popptr,pop
  55.  
  56.    SET scoreboard OFF
  57.    SET wrap       ON
  58.    SET exact      OFF
  59.    SET softseek   ON
  60.    SET escape     ON
  61.  
  62.    AFILL(pop_arry,"W/N")
  63.    popptr := 0 
  64.    pop    := "pop" 
  65.  
  66.    pbuff  := "" 
  67.    ebuff  := "" 
  68.  
  69.    SETCURSOR(.f.)
  70.  
  71.    IF ISCOLOR() .and. shade # 'mono' 
  72.       co_norm    := "B/BG,BR/W,,,N/W  "
  73.       co_banner  := "W+/GR,BR/W,,,N/W "     
  74.       co_detail  := "BG+/B,BR/W,,,N/W "
  75.       co_err     := "W+/R,BR/W,,,N/W  "
  76.       co_get     := "BR/W             "
  77.       co_blank   := "N/N,N/N,,,N/W    "
  78.       co_wind    := "N/G,BR/W,,,N/W   "
  79.       co_invwind := "GR/W,N/W,,,N/W   "        
  80.       shade      := "color"
  81.  
  82.    ELSE
  83.       co_norm    := "W/N,N/W,,,N/W    "
  84.       co_banner  := "W+/N,N/W,,,N/W   "
  85.       co_detail  := "N/W,W+/N,,,N/W   "
  86.       co_err     := "N/W,W+/N,,,N/W   "
  87.       co_get     := "N/W              "
  88.       co_blank   := "N/N,N/N,,,N/W    "
  89.       co_wind    := co_norm           
  90.       co_invwind := "N/W,W+/N,,,N/W   "
  91.       shade      := "mono"
  92.    ENDIF
  93.  
  94.    * set up code for the achoice example 
  95.  
  96.    USE jobs NEW
  97.    IF ! FILE("JOBS.NTX")
  98.       INDEX on posit_type TO jobs 
  99.    ENDIF
  100.  
  101.    * put the job positions in an array 
  102.    PUBLIC ach_posit[max := LASTREC()], arr_bott 
  103.  
  104.    FOR k := 1 TO max
  105.       ach_posit[k] := posit_type
  106.       skip
  107.    NEXT
  108.  
  109.    * array demeninsions
  110.    arr_top  := 6  
  111.    arr_bott := 20  
  112.      
  113.    IF (count := (arr_bott - (arr_top + 1)) + 1) > max 
  114.       arr_bott := arr_bott - (count - max)  
  115.    ENDIF 
  116.  
  117.    return .t.
  118. * endfunc : init
  119.  
  120. FUNCTION paint(pop) 
  121.    IF pop == "pop"
  122.       SETCOLOR(pop_arry[--popptr])
  123.    ELSE
  124.       pop_arry[++popptr] := pop
  125.       SETCOLOR(pop)
  126.    ENDIF
  127.    return .t.
  128. * endfunc : paint
  129.  
  130. FUNCTION pclr(buff,t,l,b,r,frame)
  131.    * 1 = clear  2 = double     3 = single    4 = doub top single side  
  132.    * 5 = single top doub side  6 = heavy box 
  133.  
  134.    frame := IF(frame = 0 .or. frame > 7,1,frame) 
  135.  
  136.    &buff := SAVESCREEN(t,l,b,r)
  137.    @ t,l,b,r BOX; 
  138.         SUBSTR("         ╔═╗║╝═╚║ ┌─┐│┘─└│ ╒═╕│╛═╘│ ╓─╖║╜─╙║ █▀███▄██ ",;
  139.               ((frame-1) * 9)+1,9)
  140.    return .t.
  141. * endfunc : pclr
  142.  
  143. FUNCTION readc
  144.    SETCURSOR(.t.)
  145.    READ
  146.    SETCURSOR(.f.)
  147.  
  148.    return (LASTKEY() == 27) 
  149. * endfunc : readc
  150.  
  151.