Liren Large Software Subsidy 5/05.iso/a/a012/1.ddi/CHAP13.EXE/CHP1313.PRG

Text File | 1991-06-12 | 5.3 KB | 180 lines

/*
   Listing 13.13  Clipper 5 Color Management System
   NOTE: This program makes external calls to:
          RESTARRAY()   contained in CHP0917.PRG
          SAVEARRAY()   contained in CHP0919.PRG
          SAVEENV()     contained in CHP1201.PRG
          RESTENV()     contained in CHP1202.PRG
   Author: Greg Lief
   Excerpted from "Clipper 5: A Developer's Guide"
   Copyright (c) 1991 M&T Books
                      501 Galveston Drive
                      Redwood City, CA 94063-4728
                      [phone]
*/

//───── NOTE: must compile with the /N option!

#include "box.ch"
#include "inkey.ch"
#include "colors.ch"

/* default name for color configuration file - change if you want */
#define  CFG_FILE     "colors.cfg"

/* convert logical to numeric: 1 if by land (.T.), 2 if by sea (.F.) */
#translate Logic2Num( <a> ) => ( if( <a>, 1, 2) )

static iscolor          /* global flag for color (1) or mono (2)  */

/* the following array contains color and monochrome settings for each
   type of color.  The third array describes the color it applies to,
   which makes it completely self-documenting.  This third element is
   also used during the ColorMod() routine to identify each color.
*/
static colors := {  { "W/B",   "W/N" , "Normal"   }, ;
                    { "+W/B",  "+W/N", "Bold"     }, ;
                    { "+GR/B", "+W/N", "Enhanced" }, ;
                    { "*W/B",  "*W/N", "Blinking" }, ;
                    { "+W/RB", "N/W" , "Messages" }, ;
                    { "+W/R",  "N/W" , "Warnings" }  }



#define TESTING

#ifdef TESTING            // stub program begins here

function main
local oldcolor
do case
   case file(CFG_FILE)
      ColorInit(CFG_FILE)
   /* verify that this is REALLY a color system */
   case iscolor()
      qout("Press C for color monitor, any other key for monochrome")
      /* this looks nuts, but works perfectly -- can you see why? */
      ColorInit( chr(inkey(0)) $ "cC" )
   otherwise
      ColorInit()
endcase
oldcolor := ColorSet(C_NORMAL)
cls
ColorSet(C_BOLD)
@ 11, 24, 13, 55 box "┌─┐│┘─└│ "
ColorSet(C_ENHANCED)
@ 12, 26 say "Welcome to the Brownout Zone"
inkey(3)
ColorMod()
ColorSet(C_BLINK)
@ 12, 26 say "Hope you enjoyed your visit!"
inkey(3)
setcolor(oldcolor)
cls
return nil

#endif // stub program ends here... main functions begin


/*
    ColorInit(): initializes color management system
                 to either color or monochrome, or
                 load previously saved color settings
*/
function colorinit(override)
local temparray
do case
   case override == NIL
      iscolor := logic2num(iscolor())
   case valtype(override) == 'L'
      iscolor := logic2num(override)
   otherwise
      if file(override)
         if len( temparray := restarray(override) ) = 0
            qout("Could not load colors from " + override)
            inkey(0)
         else
            colors := temparray
         endif
         iscolor := logic2num( iscolor() )
      endif
endcase
return NIL

* end function ColorInit()
*---------------------------------------------------------------*

/*
    ColorSet(): changes color in accordance with
                internal settings stored in array
*/
function ColorSet(colornum, newcolor)
/* modify color setting if second parameter was passed */
if newcolor != NIL
   colors[colornum, iscolor] := newcolor
endif
return setcolor(colors[colornum, iscolor])

* end function ColorSet()
*---------------------------------------------------------------*

/*
   ColorMod() - View/Modify all global color settings
*/
function ColorMod()
local key := 0, newcolor, ntop, xx, getlist := {}, colorfile, ;
      oldscore := set(_SET_SCOREBOARD, .f.)  // shut off scoreboard
SaveEnv(.t.)         // save entire screen for later restoration
ColorSet(C_NORMAL)
ntop = ( maxrow() - COLOR_CNT ) / 2
@ ntop, 22, ntop + COLOR_CNT + 1, 57 box B_SINGLE + ' '
setpos(ntop, 0)
/* pad each color setting to 8 characters for data entry */
aeval(colors,{ |a,b| colors[b, iscolor] := padr(colors[b, iscolor], 8) } )
for xx = 1 to COLOR_CNT
   @ row() + 1, 24 say colors[xx, 3] + " Color"
   ColorSet(xx)
   @ row(), 42 say "SAMPLE" get colors[xx, iscolor] valid redraw(ntop)
   ColorSet(C_NORMAL)
next
read

/* trim each color setting */
aeval(colors,{ |a,b| colors[b, iscolor] := trim(colors[b, iscolor]) } )
setpos(ntop + COLOR_CNT + 1, 24)
dispout("Press F10 to save these settings")
if inkey(0) == K_F10
   colorfile := padr(CFG_FILE, 12)
   ColorSet(C_MESSAGE)
   @ 11, 18, 13, 61 box B_DOUBLE + ' '
   @ 12, 20 say "Enter file name to save to:"
   @ 12, 48 get colorfile picture '@!'
   setcursor(1)
   read
   setcursor(0)
   if lastkey() != K_ESC .and. ! empty(colorfile)
      savearray(colors, ltrim(trim(colorfile)))
   endif
endif
RestEnv()
set(_SET_SCOREBOARD, oldscore)
return NIL

* end function ColorMod()
*---------------------------------------------------------------*


/*
   Redraw() - redraw color samples after each GET
*/
static function redraw(ntop)
local oldcolor := ColorSet(row() - ntop)
@ row(), 42 say "SAMPLE"
setcolor(oldcolor)
return .t.

* end static function Redraw()
*--------------------------------------------------------------------*

// end of file CHP1313.PRG