*------------------------------------------------------------------------------- *-- Program...: LITE5.PRG *-- Programmer: Ken Mayer *-- Date......: 7/17/91 *-- Notes.....: The dBASE Menus are fine to a point, but there are times when *-- you may need a LOT of menu pads. This program is designed to *-- allow up to 60 menu items, although you can, if you desire, *-- set up some options as headers (these will not be chooseable *-- by the user), and you can set up conditions where an option *-- may be skipped. This routine is the original program, created *-- for my fantasy gaming procedures. It allows a user to choose *-- an item once (for you gamers, this is part of a character *-- generation routine -- when creating a character, the character *-- may improve certain skills once only ... (that's for the *-- creation ... in the update routines that option will be removed) *-- -- the user knows he's chosen that item before because the *-- color changes ... *-- Original concept by FELIXR, but I ran with it and programmed *-- it up ... As a programmer, the following procedures will need *-- to be modified: *-- REFRESH -- description of each litebar *-- LOADARRAY -- load the arrays ... there are some items *-- that will need changing *-- DOCHOICE -- this is where the user choice is made ... *-- VALID -- validation of litebars ... *-- Other items needing changing are noted in comments. *------------------------------------------------------------------------------- cTalk = set("TALK") set talk off cStatus = set("STATUS") set stat off && just making sure cEscape = set("ESCAPE") set escape off && for use with INKEY() cCursor = set("CURSOR") set cursor off set procedure to proc && contains a few routines like YESNO ... clear && clear screen completely for this ... ?scrnhead("rg+/gb","Character Skills") public literow,litecol,choice,lastcol,lastrow,gl_error && global memvars *-- literow = row position *-- litecol = column -- used together to hold real positions *-- choice = user entry (up, down, right, left, , *-- lastcol = last column -- entered in REFRESH routine *-- lastrow = last row -- ditto ln_max = 60 && max entries choice = 0 && init choice so it's numeric ... public skill,lite_bar,pos1,pos2,skil_flag,skip,heading && arrays declare skill[ln_max],pos1[15],pos2[4],lite_bar[15,4],skil_flag[15,4] declare skip[15,4],heading[15,4] *-- skill[x] = value we're obtaining from user ... *-- pos1[x] = position of choices on screen ... rows *-- pos2[y] = same ... columns *-- lite_bar[x,y] = choices displayed on screen ... *-- skil_flag[x,y]= flag for each choice ... once chosen can't choose again *-- skip[x,y] = flag to determine if we should skip an option ... *-- heading[x,y] = if it's a heading, we need to display in specific colors *-------------------------------------------------------------------------- * START processing here *-------------------------------------------------------------------------- do load_array && procedure below to load values into arrays *-- PROGRAMMER -- Make sure these are correct --* literow = 2 && starting coordinates litecol = 1 && ditto do scrnpnt && paint the screen the first time .. the rest is handled && when the cursor is moved ... *-------------------------------------------------------------------------- * find out how many changes the user can make in beginning skills ... *-------------------------------------------------------------------------- if yesno(.t.,"Number of Changes Allowed","Do you want to roll the dice?","",; "rg+/gb,n/w,rg+/gb") ln_roll = validice(1,6,"Number of Changes","rg+/gb,n/g,rg+/gb") else ln_roll = dice(6) endif && yesno ... ln_numskills = ln_roll + 2 *-------------------------------------------------------------------------- * loop until the user has done them all ... *-------------------------------------------------------------------------- do while ln_numskills > 0 && loop until user has modified all skills @1,60 say "Skills left: "+ltrim(str(ln_numskills)) color rg+/gb choice = 0 && default it to 0, just to be safe .... choice = inkey(0) *-- inkey() returns: 4 = right arrow *-- 19 = left arrow *-- 5 = up arrow *-- 24 = down arrow *-- 13 = /Carriage Return *-- 27 = *-- 2 = *-- 27 = * do case case choice = 4 .or. choice = 19 do movecol case choice = 5 .or. choice = 24 do moverow case choice = 2 .or. choice = 26 do HomeEnd case choice = 13 do DoChoice if .not. gl_error && check to see if user chose wrong item ln_numskills = ln_numskills - 1 && decrement counter endif endcase enddo && loop and main procedure ... *-------------------------------------------------------------------------- *-- CLEANUP *-------------------------------------------------------------------------- release literow,litecol,choice,lastcol,lastrow release pos1,pos2,lite_bar,skip,heading release skill,skil_flag && these last two may need to be kept for my own && production version ... and NOT released ... set status &cStatus && reset these if needed ... set talk &cTalk set escape &cEscape set cursor &cCursor do Save_Array && save the data in the SKILL[] array ... RETURN && to calling program *-------------------------------------------------------------------------- * procedures here *-------------------------------------------------------------------------- PROCEDURE Load_Array *-- This will be replaced in my gaming programs to replace the *-- contents of the SKILL[] array with fields from the database *-- also load skil_name[] array from database ... (same way) ln_count = 0 && initialize "skill" array ln_num = int(rand(-1) * 20) + 1 do while ln_count < ln_max ln_count = ln_count + 1 skill[ln_count] = int(rand() * 20) + 1 && random number from 1 to 20 enddo *-- don't touch --* ln_cnt1 = 0 && initialize the lightbar array ... do while ln_cnt1 < 15 ln_cnt1 = ln_cnt1 + 1 ln_cnt2 = 0 do while ln_cnt2 < 4 ln_cnt2 = ln_cnt2 + 1 lite_bar[ln_cnt1,ln_cnt2] = space(1) && init to a single space && character in it... store .f. to skip[ln_cnt1,ln_cnt2] && init to NO skip, but change && below as needed ... enddo enddo do Refresh && this is used to setup the litebars ... and can be called && as a separate procedure from anywhere ... *-- this shouldn't need to be changed ... *-- start at row six, allowing room at top of window/screen for headings row1 = 6 row2 = 7 row3 = 8 row4 = 9 row5 = 10 row6 = 11 row7 = 12 row8 = 13 row9 = 14 row10 = 15 row11 = 16 row12 = 17 row13 = 18 row14 = 19 row15 = 20 *-- set for four columns, up to 20 characters each -- column four should *-- be kept down to 15 ... actually all of them should. col1 = 5 col2 = 25 col3 = 45 col4 = 65 *-- positions -- POS1 array is the row pos1[1] = row1 pos1[2] = row2 pos1[3] = row3 pos1[4] = row4 pos1[5] = row5 pos1[6] = row6 pos1[7] = row7 pos1[8] = row8 pos1[9] = row9 pos1[10] = row10 pos1[11] = row11 pos1[12] = row12 pos1[13] = row13 pos1[14] = row14 pos1[15] = row15 *-- positions -- POS2 array is the column pos2[1] = col1 pos2[2] = col2 pos2[3] = col3 pos2[4] = col4 RETURN *-- EoP: Load_Array *-------------------------------------------------------------------------- PROCEDURE Save_Array *-- procedure to save the contents of the SKILL[] array back to the *-- database, otherwise all of this is pointless ... RETURN *-- EoP: Save_Array *-------------------------------------------------------------------------- PROCEDURE Refresh *-- PROGRAMMER CHANGES --* *-- this routine simply refreshes/defines the bars for the litebar *-- headings should define both SKIP and HEADING arrays as true for *-- those entries, otherwise the program will allow them as "valid" *-- choices. If you want to set up conditionals, this is the place *-- to do it. You can do such things as: *-- IF *-- STORE .t. TO SKIP[x,y] *-- ELSE *-- STORE .f. TO SKIP[x,y] *-- ENDIF *-- this would replace the WHEN clause of the dbase popup BARs. lite_bar[1,1] = "HEADING 1" store .t. to skip[1,1] && don't allow as valid choice store .t. to heading[1,1] && for color display lite_bar[2,1] = "Choice 1: "+ltrim(str(skill[1])) lite_bar[3,1] = "Choice 2: "+ltrim(str(skill[2])) *-- 4,1 = nothing -- blank lite_bar[5,1] = "HEADING 2" store .t. to skip[5,1] store .t. to heading[5,1] lite_bar[6,1] = "Choice 3: "+ltrim(str(skill[3])) lite_bar[7,1] = "Choice 4: "+ltrim(str(skill[4])) *-- column 2 lite_bar[1,2] = "HEADING 3" store .t. to skip[1,2] store .t. to heading[1,2] lite_bar[2,2] = "Choice 5: "+ltrim(str(skill[5])) lite_bar[3,2] = "Choice 6: "+ltrim(str(skill[6])) lite_bar[4,2] = "Choice 7: "+ltrim(str(skill[7])) store .t. to skip[4,2] *-- 5,2 = nothing lite_bar[6,2] = "HEADING 4" store .t. to skip[6,2] store .t. to heading[6,2] lite_bar[7,2] = "Choice 8: "+ltrim(str(skill[8])) *-- column 3 lite_bar[1,3] = "HEADING 5" store .t. to skip[1,3] store .t. to heading[1,3] lite_bar[2,3] = "Choice 9: "+ltrim(str(skill[9])) lite_bar[3,3] = "Choice 10: "+ltrim(str(skill[10])) lite_bar[4,3] = "Choice 11: "+ltrim(str(skill[11])) lite_bar[5,3] = "Choice 12: "+ltrim(str(skill[12])) *-- It is vital that these two items are set properly. If you have *-- four columns, change lastcol to 4, and so on ... lastcol = 3 lastrow = 7 RETURN *-- EoP: Refresh *-------------------------------------------------------------------------- PROCEDURE ScrnPnt && procedure to paint the screen *-- this procedure will probably only be called once - at the beginning *-- of the program. There should be no need for programmer modifications. ln_cnt = 0 do while ln_cnt < 15 ln_cnt = ln_cnt + 1 ln_cnt2 = 0 do while ln_cnt2 < 4 ln_cnt2 = ln_cnt2 + 1 if len(trim(lite_bar[ln_cnt,ln_cnt2])) > 0 if heading[ln_cnt,ln_cnt2] @pos1[ln_cnt],pos2[ln_cnt2] say lite_bar[ln_cnt,ln_cnt2]; color rg+/gb && it's a heading else if skip[ln_cnt,ln_cnt2] && it's not a heading, must not be && allowed! @pos1[ln_cnt],pos2[ln_cnt2] say lite_bar[ln_cnt,ln_cnt2]; color r/n && color says it's not allowed! else && normal item ... @pos1[ln_cnt],pos2[ln_cnt2] say lite_bar[ln_cnt,ln_cnt2] endif && skip ... endif && heading ... endif && len(trim... enddo && while ln_cnt2 ... enddo && while ln_cnt ... @pos1[2],pos2[1] say lite_bar[2,1] color n/g && display first bar higlighted do center with 23,80,"rg+/r","Press: "+chr(24)+chr(25)+chr(26)+chr(27)+; ", , to move, to choose" RETURN *-- EoP: ScrnPnt *-------------------------------------------------------------------------- PROCEDURE MoveRow && up/down arrows pressed *-- NO CHANGES NEEDED (in the next three procedures ... --* *-- this procedure handles up and down movement. It is designed to first, *-- redisplay the current litebar area in "normal" color (default is *-- whatever your screen/window NORMAL color is set to). Next, it looks *-- at the keystroke, and moves the pointer to the next item. We check *-- to see if that's valid (using VALID() below), and if it is, we are *-- done. If it's not valid, we move in the direction (up/down) again, *-- and check for valid, looping until we either find a valid option, or, *-- if none of the options in that column are valid, we move to the *-- next column. (Tricky, eh?) Once we have a valid position, we *-- display it highlighted, and return ... if valid() @pos1[literow],pos2[litecol] clear to pos1[literow],pos2[litecol]+19 if skil_flag[literow,litecol] && if it's .t., display as RED on Black @pos1[literow],pos2[litecol] say lite_bar[literow,litecol] color r/n else && otherwise, display as normal ... @pos1[literow],pos2[litecol] say lite_bar[literow,litecol] endif endif && valid() do case *-- uparrow first case choice = 5 if literow = 1 && if first row literow = lastrow && wrap it around ... else literow = literow - 1 && decrement (move to next row) endif ln_count = 1 && set counter to 1 do while .not. valid() && function below to determine if lite_bar && is valid ln_count = ln_count + 1 && if we're here, we're moving again if ln_count = lastrow && we've wrapped around choice = 4 && stick a right arrow in here ... do movecol && procedure to move cursor by col! exit && we're done here ... endif && ln_count = lastrow if literow = 1 && check for first row literow = lastrow && wrap around else literow = literow - 1 && decrement (move to next) endif enddo *-- down arrow next case choice = 24 if literow = lastrow && if last row literow = 1 && wrap it around ... else literow = literow + 1 && increment (move to next row) endif ln_count = 1 && set counter to 1 do while .not. valid() && function below to determine if lite_bar && is valid ln_count = ln_count + 1 && if we're here, we're moving again if ln_count = lastrow && we've wrapped around choice = 19 && stick a left arrow in here ... do movecol && procedure to move cursor by col! exit && we're done here ... endif && ln_count = lastrow if literow = lastrow && check for last row literow = 1 && wrap around else literow = literow + 1 && increment (move to next) endif enddo endcase @pos1[literow],pos2[litecol] clear to pos1[literow],pos2[litecol]+19 @pos1[literow],pos2[litecol] say lite_bar[literow,litecol] color n/g && display in hilight colors ... RETURN *-- EoP: MoveRow *-------------------------------------------------------------------------- PROCEDURE MoveCol && left/right arrows pressed *-- See comments in MoveRow for an explanation of this. if valid() @pos1[literow],pos2[litecol] clear to pos1[literow],pos2[litecol]+19 if skil_flag[literow,litecol] && if it's .t., display as RED on Black @pos1[literow],pos2[litecol] say lite_bar[literow,litecol] color r/n else && otherwise, display as normal ... @pos1[literow],pos2[litecol] say lite_bar[literow,litecol] endif endif do case case choice = 4 ** right arrow if litecol = lastcol && if last column litecol = 1 && wrap it around ... else litecol = litecol + 1 && increment (move to next column) endif ln_count = 1 && set counter to 1 do while .not. valid() && function below to determine if lite_bar && is valid ln_count = ln_count + 1 && if we're here, we're moving again if ln_count = lastcol && we've wrapped around choice = 24 && stick a down arrow in here ... do moverow && procedure to move cursor by rows! exit && we're done here ... endif && ln_count = lastcol if litecol = lastcol && check for last column litecol = 1 && wrap around else litecol = litecol + 1 && increment (move to next) endif enddo *-- left arrow next case choice = 19 if litecol = 1 && if FIRST column litecol = lastcol && wrap it around ... else litecol = litecol - 1 && decrement (move to next column) endif ln_count = 1 && set counter to 1 do while .not. valid() && function below to determine if lite_bar && is valid ln_count = ln_count + 1 && if we're here, we're moving again if ln_count = lastcol && we've wrapped around choice = 5 && stick an up arrow in here ... do moverow && procedure to move cursor by rows! exit && we're done here ... endif && ln_count = lastcol if litecol = 1 && check for last column litecol = lastcol && wrap around else litecol = litecol - 1 && decrement (move to next) endif enddo endcase @pos1[literow],pos2[litecol] clear to pos1[literow],pos2[litecol]+19 @pos1[literow],pos2[litecol] say lite_bar[literow,litecol] color n/g RETURN *-- EoP: MoveCol *-------------------------------------------------------------------------- PROCEDURE HomeEnd && user pressed or *-- Very much the same logic as MoveRow and MoveCol, but the *-- cursor is moved to the first position () or last () and *-- validations is checked in those columns (moving to another column *-- if really necessary). if valid() @pos1[literow],pos2[litecol] clear to pos1[literow],pos2[litecol]+19 if skil_flag[literow,litecol] && if it's .t., display as RED on Black @pos1[literow],pos2[litecol] say lite_bar[literow,litecol] color r/n else && otherwise, display as normal ... @pos1[literow],pos2[litecol] say lite_bar[literow,litecol] endif endif && valid() do case *-- For HOME, we need to go to first position, and move down the column, *-- as if we were doing the routine in MOVEROW ... for END we do the *-- same, but go to last position, and work UP the column, looking for *-- valid ... case choice = 26 *-- key litecol = 1 && move pointer to "Home" position literow = 1 ln_count = 1 && set counter to 1 do while .not. valid() && function below to determine if lite_bar && is valid ln_count = ln_count + 1 && if we're here, we're moving again if ln_count = lastrow && we've wrapped around choice = 4 && stick a right arrow in here ... do movecol && procedure to move cursor by rows! exit && we're done here ... endif && ln_count = lastrow if literow = lastrow && check for last column literow = 1 && wrap around else literow = literow + 1 && increment (move to next) endif enddo case choice = 2 *-- key literow = lastrow && move cursor to last item litecol = lastcol ln_count = 1 && set counter to 1 do while .not. valid() && function below to determine if lite_bar && is valid ln_count = ln_count + 1 && if we're here, we're moving again if ln_count = lastrow && we've wrapped around choice = 19 && stick a left arrow in here ... do movecol && procedure to move cursor by col! exit && we're done here ... endif && ln_count = lastrow if literow = 1 && check for first row literow = lastrow && wrap around else literow = literow - 1 && increment (move to next) endif enddo endcase @pos1[literow],pos2[litecol] clear to pos1[literow],pos2[litecol]+19 @pos1[literow],pos2[litecol] say lite_bar[literow,litecol] color n/g && display in hilight colors ... RETURN *-- EoP: HomeEnd *-------------------------------------------------------------------------- PROCEDURE DoChoice && Determine what user has chosen to do, and do it. *-- PROGRAMMER CHANGES --* *-- This is where we go when the user has pressed . It means *-- they want to choose the highlighted option. The current structure *-- below looks at the column, and then the row we are pointing to *-- to decide what to do. Such options as DO program can be placed *-- in the approprate cases ... *-- For this version, we set a value (skill number), and then use that *-- in the SKILL[] Array. *-- can this be done more efficiently? I can't think of a better *-- way ... >sigh<. do case case litecol = 1 do case case literow = 1 case literow = 2 sk_num = 1 case literow = 3 sk_num = 2 case literow = 4 case literow = 5 case literow = 6 sk_num = 3 case literow = 7 sk_num = 4 case literow = 8 case literow = 9 case literow = 10 case literow = 11 case literow = 12 case literow = 13 case literow = 14 case literow = 15 endcase case litecol = 2 do case case literow = 1 case literow = 2 sk_num = 5 case literow = 3 sk_num = 6 case literow = 4 sk_num = 7 case literow = 5 case literow = 6 case literow = 7 sk_num = 8 case literow = 8 case literow = 9 case literow = 10 case literow = 11 case literow = 12 case literow = 13 case literow = 14 case literow = 15 endcase case litecol = 3 do case case literow = 1 case literow = 2 sk_num = 9 case literow = 3 sk_num = 10 case literow = 4 sk_num = 11 case literow = 5 sk_num = 12 case literow = 6 case literow = 7 case literow = 8 case literow = 9 case literow = 10 case literow = 11 case literow = 12 case literow = 13 case literow = 14 case literow = 15 endcase case litecol = 4 do case case literow = 1 case literow = 2 case literow = 3 case literow = 4 case literow = 5 case literow = 6 case literow = 7 case literow = 8 case literow = 9 case literow = 10 case literow = 11 case literow = 12 case literow = 13 case literow = 14 case literow = 15 endcase endcase lc_skilname = substr(lite_bar[literow,litecol],1,; at(":",lite_bar[literow,litecol])-1) && get the skill name from the && litebar ... gl_error = .f. if yesno(.t.,"&lc_skilname","Do you really want to modify",; "&lc_skilname?","rg+/gb,n/g,rg+/gb") if yesno(.t.,"&lc_skilname","Do you want to roll the dice?","",; "rg+/gb,n/g,rg+/gb") set cursor on ln_roll = int(ValiDice(1,100,"","rg+/b,n/g,rg+/n") / 2) && get valid value from user and then cut it in half ... set cursor off else ln_roll = int(Dice(100) / 2) && roll it and cut value in half ... endif skill[sk_num] = skill[sk_num] + ln_roll && add this to it ... store .t. to skil_flag[literow,litecol] && don't allow this choice again ... store .t. to skip[literow,litecol] && SKIP this one next time around ... do refresh && update the lite_bar array ... @pos1[literow],pos2[litecol] clear to pos1[literow],pos2[litecol]+19 @pos1[literow],pos2[litecol] say lite_bar[literow,litecol] color r/n && display option red on black ... so user KNOWS he's done it before. else && user didn't want this 'un after all gl_error = .t. endif && check to see if user wanted this one ... RETURN *-------------------------------------------------------------------------- FUNCTION Valid && used to determine if the current litebar choice is valid if len(trim(lite_bar[literow,litecol])) > 0 .and. .not. skip[literow,litecol] store .t. to lValid else store .f. to lValid endif RETURN lValid *-------------------------------------------------------------------------- * end of program: LITE4.prg *--------------------------------------------------------------------------