Category : Files from Magazines
Archive   : DBMS9106.ZIP
Filename : AQUARIUM

®LM0¯STEVE, REMEMBER TO UPLOAD THE ACCOMPANYING LISTING TO
TELEPATH FOR JUNE: F:\MANUS\91JUN\GRUMPFIS\TELEPATH.TXT

Listing 1: The Good Housekeeper (Summer '87 code)

function ewe_dee_ef

private oldcolor, oldscrn, oldrow, oldcol
oldcolor = setcolor() && save color setting
oldscrn = savescreen(0, 0, 24, 79) && save screen contents
oldrow = row() && save current row
oldcol = col() && save current column
*
* body of function
*
setcolor(oldcolor) && restore color
restscreen(0, 0, 24, 79, oldscrn) && restore screen
@ oldrow, oldcol say '' && restore cursor position
return whatever

****************************

Listing 2: The Good Housekeeper (Clipper 5.0 version)

function ewe_dee_ef
SaveEnv()
*
* body of function
*
RestEnv()
return whatever


**********************************

Caption for Listing 3 (STEVE: we need to include these lines as
comments in listing if you decide not to use a caption):
SaveEnv() lets you save the current cursor row/column/size, color, and screen; RestEnv() restores the cursor row/column/size, color, and screen.

Listing 3: SaveEnv() and RestEnv()

static envstack_ := {} // stack used by SaveEnv() and RestEnv()

/* manifest constants used by SaveEnv() and RestEnv() */
#define ROW 1
#define COLUMN 2
#define CURSOR 3
#define COLOR 4
#define SCREEN 5

function SaveEnv()
aadd(envstack_, { row(), col(), setcursor(), setcolor(), ;
savescreen(0, 0, maxrow(), maxcol()) } )
return nil

* end of function SaveEnv()


function RestEnv()
local ele := len(envstack_)
/* preclude empty array, which would cause an array access error!*/

if ele > 0
/* reset row/column position */
setpos(envstack_[ele, ROW], envstack_[ele, COLUMN])
/* reset cursor state */
setcursor(envstack_[ele, CURSOR])
/* reset color */
setcolor(envstack_[ele, COLOR])
/* restore screen */
restscreen(0, 0, maxrow(), maxcol(), envstack_[ele, SCREEN])
/* truncate array by lopping off last element */
asize(envstack_, ele - 1)
endif
return NIL

* end of function RestEnv()

*********************************

Listing 4: A nested READ

memvar getlist // to squelch compiler warnings
function main
local x := 0, mdate := date() + 14
cls
@10,10 say "Balance: " ;
get x picture '#####. ##' valid credit(@x)
@11,10 say "Due date:" get mdate
read
return nil

function credit(balance)
local x := 0, getlist := {}, ;
oldscrn := savescreen(10, 40, 10, 64)
@10,40 say "Credit (if any):" ;
get x picture '#####. ##'
read
balance -= x
/* subtract credit from original balance */
restscreen(10, 40, 10, 64, oldscrn)
return . t.

******************************************

Caption for Listing 5:
SaveGets() saves current GETs and clears 'em out. RestGets()
restores GETs.

Listing 5: SaveGets() and RestGets()

function SaveGets()
aadd(getstack_, memvar->getlist)
memvar->getlist := {}
return len(getstack_)

* end function SaveGets()


function RestGets(ele)
/* use LIFO (last item in array) if no parameter was passed */
ele = if(ele == NIL, len(getstack_), ele)
/* preclude empty array */
if len(getstack_) > 0 .and. ele <= len(getstack_)
memvar->getlist := getstack_[ele]
/* truncate length of array only if using LIFO,
if no param passed */
if ele == len(getstack_) .and. pcount() = 0
asize(getstack_, len(getstack_) - 1)
endif
endif
return NIL

* end function RestGets()


*******************************************

Optional Caption for Listing 6:
This sample code makes use of SaveGets() and RestGets() to save and restore three sets of GETs.

Listing 6: Using SaveGets() and RestGets()

memvar getlist // to squelch compiler warnings

function 3setsogets
local x := { 1, 2, 3, 4, 5, 6, 7, 8, 9}, y, z
for z = 1 to 3
for y = 1 to 3
@ y * 2, 0 get x[(z - 1) * 3 + y]
next
gfsavegets()
next
cls
gfrestgets(2)

reget()
read
gfrestgets(1)
reget()
read
gfrestgets(3)
reget()
read
// display all values
aeval(x, { | a | qout(a) } )
return nil

//ReGet(): redisplay all active GETs
static function reget
aeval(getlist, { | get | get:display() } )
return nil

**********************************

Caption for Listing 7: SaveEnv2() accepts parameters to check and change cursor and color settings.

Listing 7: SaveEnv2(): A modified SaveEnv()

#define TOP coords[1]
#define LEFT coords[2]
#define BOTTOM coords[3]
#define RIGHT coords[4]

function SaveEnv2(scrn_save, curs_size, newcolor)
local coords := if(scrn_save = NIL .or. valtype(scrn_save) == "A",; scrn_save, { 0, 0, maxrow(), maxcol() } )
aadd(envstack_, { row(), col(), setcursor(curs_size), ;
setcolor(newcolor), if(valtype(coords) = "A",;
{ TOP, LEFT, BOTTOM, RIGHT,;
savescreen(TOP, LEFT, BOTTOM, RIGHT) }, NIL) } )

return nil