*************************
* Werd Nerd 1.0 *
* *
* By Porter Venn III *
* 10/26/94 - / / *
* *
* Copyright 1994 *
* BBsoft Co. *
*************************
ON ERROR DO errortrap
************************** Initial Game Setup Procedures ********************
DO setup_params && Setup Initial Parameters (SETS etc...)
DO set_vars && Setup Globals and Initial Variable Values
DO checkansi && Check that user ANSI/IBM settings are on
&& DO checksysop && Check to see if user has Sysop Access (PRIV 255)
&& DO getkey && Get Security key
DO intro && Intro Screen
DO checkmonth && Check to see if its a new month
DO getconfig && Get game configuation settings
DO getuser && Get the user out of players.dbf or create him.
DO show_initial && Paint screen & Show initial values
DO instructions && Ask user for instructions, show them if wanted.
*****************************************************************************
** Main Program Code Body **
*****************************************************************************
DO WHILE .T.
DO press_start && Press Any Key to Start
DO get_letters && Randomly Get Letters for this game
DO show_letters && Show the letters
DO start_timer && Start the 60 second timer
DO WHILE .T. && Game Round begins
DO get_word && Get word from user...
IF game_end = "YES" && If game is over, exit loop
game_end = "NO"
EXIT
ENDIF && If not over, continue ...
DO add_word && Add the word to big board
LOOP
ENDDO
DO check_spell && Check Big Board Spelling
first = "YES"
LOOP
ENDDO
****************************************************************************
?? "Should never be here... End of Main Code Core"
WAIT
QUIT
**************************** Randomly Select Letters ************************
PROCEDURE get_letters
PRIVATE got_it[98]
SET COLOR TO bg/bg
beavis = 3
DO WHILE beavis <= 12
@ beavis,5 SAY SPACE(70)
beavis = beavis + 1
LOOP
ENDDO
zz = 1
DO WHILE zz <= 98
got_it[zz] = " "
zz = zz + 1
LOOP
ENDDO
SET COLOR TO GR+*/r
@ 17,3 SAY "Picking Letters"
RESTORE from random additive
x = 1
DO WHILE x <= 12
maxnum = 98
mrec = 0
DO WHILE .T.
DO random WITH maxnum,mrec
IF got_it[mrec] <> "XXX"
got_it[mrec] = "XXX"
EXIT
ENDIF
LOOP
ENDDO
DO CASE
CASE mrec = 1
letter[x] = "A"
CASE mrec = 2
letter[x] = "A"
CASE mrec = 3
letter[x] = "A"
CASE mrec = 4
letter[x] = "A"
CASE mrec = 5
letter[x] = "A"
CASE mrec = 6
letter[x] = "A"
CASE mrec = 7
letter[x] = "A"
CASE mrec = 8
letter[x] = "A"
CASE mrec = 9
letter[x] = "A"
CASE mrec = 10
letter[x] = "B"
CASE mrec = 11
letter[x] = "B"
CASE mrec = 12
letter[x] = "C"
CASE mrec = 13
letter[x] = "C"
CASE mrec = 14
letter[x] = "D"
CASE mrec = 15
letter[x] = "D"
CASE mrec = 16
letter[x] = "D"
CASE mrec = 17
letter[x] = "D"
CASE mrec = 18
letter[x] = "E"
CASE mrec = 19
letter[x] = "E"
CASE mrec = 20
letter[x] = "E"
CASE mrec = 21
letter[x] = "E"
CASE mrec = 22
letter[x] = "E"
CASE mrec = 23
letter[x] = "E"
CASE mrec = 24
letter[x] = "E"
CASE mrec = 25
letter[x] = "E"
CASE mrec = 26
letter[x] = "E"
CASE mrec = 27
letter[x] = "E"
CASE mrec = 28
letter[x] = "E"
CASE mrec = 29
letter[x] = "E"
CASE mrec = 30
letter[x] = "F"
CASE mrec = 31
letter[x] = "F"
CASE mrec = 32
letter[x] = "G"
CASE mrec = 33
letter[x] = "G"
CASE mrec = 34
letter[x] = "G"
CASE mrec = 35
letter[x] = "H"
CASE mrec = 36
letter[x] = "H"
CASE mrec = 37
letter[x] = "I"
CASE mrec = 38
letter[x] = "I"
CASE mrec = 39
letter[x] = "I"
CASE mrec = 40
letter[x] = "I"
CASE mrec = 41
letter[x] = "I"
CASE mrec = 42
letter[x] = "I"
CASE mrec = 43
letter[x] = "I"
CASE mrec = 44
letter[x] = "I"
CASE mrec = 45
letter[x] = "I"
CASE mrec = 46
letter[x] = "J"
CASE mrec = 47
letter[x] = "K"
CASE mrec = 48
letter[x] = "L"
CASE mrec = 49
letter[x] = "L"
CASE mrec = 50
letter[x] = "L"
CASE mrec = 51
letter[x] = "L"
CASE mrec = 52
letter[x] = "M"
CASE mrec = 53
letter[x] = "M"
CASE mrec = 54
letter[x] = "N"
CASE mrec = 55
letter[x] = "N"
CASE mrec = 56
letter[x] = "N"
CASE mrec = 57
letter[x] = "N"
CASE mrec = 58
letter[x] = "N"
CASE mrec = 59
letter[x] = "N"
CASE mrec = 60
letter[x] = "O"
CASE mrec = 61
letter[x] = "O"
CASE mrec = 62
letter[x] = "O"
CASE mrec = 63
letter[x] = "O"
CASE mrec = 64
letter[x] = "O"
CASE mrec = 65
letter[x] = "O"
CASE mrec = 66
letter[x] = "O"
CASE mrec = 67
letter[x] = "O"
CASE mrec = 68
letter[x] = "P"
CASE mrec = 69
letter[x] = "P"
CASE mrec = 70
letter[x] = "Q"
CASE mrec = 71
letter[x] = "R"
CASE mrec = 72
letter[x] = "R"
CASE mrec = 73
letter[x] = "R"
CASE mrec = 74
letter[x] = "R"
CASE mrec = 75
letter[x] = "R"
CASE mrec = 76
letter[x] = "R"
CASE mrec = 77
letter[x] = "S"
CASE mrec = 78
letter[x] = "S"
CASE mrec = 79
letter[x] = "S"
CASE mrec = 80
letter[x] = "S"
CASE mrec = 81
letter[x] = "T"
CASE mrec = 82
letter[x] = "T"
CASE mrec = 83
letter[x] = "T"
CASE mrec = 84
letter[x] = "T"
CASE mrec = 85
letter[x] = "T"
CASE mrec = 86
letter[x] = "T"
CASE mrec = 87
letter[x] = "U"
CASE mrec = 88
letter[x] = "U"
CASE mrec = 89
letter[x] = "U"
CASE mrec = 90
letter[x] = "U"
CASE mrec = 91
letter[x] = "V"
CASE mrec = 92
letter[x] = "V"
CASE mrec = 93
letter[x] = "W"
CASE mrec = 94
letter[x] = "W"
CASE mrec = 95
letter[x] = "X"
CASE mrec = 96
letter[x] = "Y"
CASE mrec = 97
letter[x] = "Y"
CASE mrec = 98
letter[x] = "Z"
ENDCASE
x = x + 1
LOOP
ENDDO
SAVE TO random ALL LIKE A?SEED
SET COLOR TO r/r
RETURN
*****************************************************************************
*************************** Show letters on the screen **********************
PROCEDURE show_letters
SET COLOR TO g/g
@ 17,28 SAY SPACE(24)
@ 20,41 SAY SPACE(10)
SET COLOR TO W+/g
x = 1
col = 28
DO WHILE x <= 12
@ 17,COL SAY letter[x]
col = col + 2
x = x + 1
IF first = "YES"
delay = .25
DO pause WITH delay
ENDIF
LOOP
ENDDO
first = "NO"
SET COLOR TO r/r
@ 17,3 SAY " "
SET COLOR TO gr+/g
@ 20,29 SAY t_left PICTURE "##"
RETURN
*****************************************************************************
**************************** Get Word from user *****************************
PROCEDURE get_word
PRIVATE temp_letter[12]
gw_col = 41
SET COLOR TO g/g
@ 20,(gw_col-1) SAY " "
x_let = 0
clearit = 1
DO WHILE clearit <= 10
get_word[clearit] = " "
clearit = clearit + 1
LOOP
ENDDO
tankaray = ACOPY(letter,temp_letter)
DO WHILE .T.
CLEAR TYPEAHEAD
key = 0
key = INKEY(1)
DO timer
IF game_end = "YES"
RETURN
ENDIF
IF key <> 0
IF key = 13
RETURN
ENDIF
IF key = 8 .AND. x_let > 0
counter = 1
DO WHILE counter <= 12
zummy = ASCAN(letter,get_word[x_let],counter)
IF temp_letter[zummy] = CHR(206)
temp_letter[zummy] = get_word[x_let]
SET COLOR TO W+/g
@ 17,(26 + (zummy*2)) SAY get_word[x_let]
counter = 12
ENDIF
counter = counter + 1
LOOP
ENDDO
get_word[x_let] = SPACE(1)
gw_col = gw_col - 1
x_let = x_let - 1
SET COLOR TO g/g
@ 20,gw_col SAY " "
ENDIF
dummy = ASCAN(temp_letter,UPPER(CHR(key)))
IF dummy <> 0
IF key <> 8 .AND. x_let < 10
SET COLOR TO g/g
@ 17,(26 + (dummy*2)) SAY " "
x_let = x_let + 1
SET COLOR TO n/g
@ 20,gw_col SAY UPPER(CHR(key))
gw_col = gw_col + 1
get_word[x_let] = UPPER(CHR(key))
temp_letter[dummy] = CHR(206)
ENDIF
ENDIF
ENDIF
LOOP
ENDDO
*****************************************************************************
?? "Shouldnt ever be here! end of get_word"
WAIT
QUIT
**************************** Add Word to Big Board **************************
PROCEDURE add_word
new_word = " "
x = 1
DO WHILE x <= 10
new_word = new_word + get_word[x]
x = x + 1
LOOP
ENDDO
new_word = LTRIM(RTRIM(new_word))
IF LEN(new_word) < 3
SET COLOR TO GR+*/r
@ 17,3 SAY " Word must have"
@ 18,3 SAY " min 3 letters!"
delay = 3
DO pause WITH delay
SET COLOR TO r/r
@ 17,3 SAY " "
@ 18,3 SAY " "
DO show_letters
RETURN
ENDIF
IF aw_counter > 1
beavis = 1
beavis_row = 3
beavis_col = 5
DO WHILE beavis <= (aw_counter -1)
IF pick_words[beavis] = new_word
SET COLOR TO GR+/r
@ 17,3 SAY " You already "
@ 18,3 SAY " have that word!"
SET COLOR TO GR+*/bg
@ beavis_row,beavis_col SAY pick_words[beavis]
delay = 4
DO pause WITH delay
SET COLOR TO BG+/bg
@ beavis_row,beavis_col SAY pick_words[beavis]
SET COLOR TO r/r
@ 17,3 SAY " "
@ 18,3 SAY " "
DO show_letters
RETURN
ENDIF
beavis = beavis + 1
beavis_row = beavis_row + 1
IF beavis_row = 13
beavis_col = beavis_col + 18
beavis_row = 3
ENDIF
LOOP
ENDDO
ENDIF
pick_words[aw_counter] = new_word
aw_counter = aw_counter + 1
IF aw_counter > 40
t_left = 0
ENDIF
SET COLOR TO bg+/bg
@ top_row,top_col SAY new_word
top_row = top_row + 1
IF top_row = 13
top_col = top_col + 18
top_row = 3
ENDIF
DO show_letters
RETURN
*****************************************************************************
************************** Start 60 Second Timer Routine ********************
PROCEDURE start_timer
timer_sec = SECONDS()
RETURN
*****************************************************************************
****************************** 60 second Game timer *************************
PROCEDURE timer
IF t_left <= 0
game_end = "YES"
RETURN
ENDIF
now_sec = SECONDS()
t_left = (timer_sec + timer) - now_sec
SET COLOR TO gr+/g
@ 20,29 SAY ABS(t_left) PICTURE "##"
IF t_left <= 5
SET COLOR TO gr+*/g
@ 20,29 SAY ABS(t_left) PICTURE "##"
ENDIF
SET COLOR TO g/g
@ 20,gw_col SAY " "
RETURN
*****************************************************************************
************************** Check Users Spelling on Big Board ****************
PROCEDURE check_spell
temp_word = "Z"
temp_score = 0
SET COLOR TO gr+/g
@ 20,29 SAY " 0"
SET COLOR TO W+*/r
@ 17,3 SAY " Game Over "
delay = 2
DO pause WITH delay
SET COLOR TO GR+/r
@ 17,3 SAY "Adding Scores.."
CLEAR TYPEAHEAD
top_col = 16
top_row = 3
let_score = 0
word_score = 0
aw_counter = aw_counter - 1
x = 1
USE spell INDEX spell
DO while x <= aw_counter
SEEK pick_words[x]
IF FOUND()
word_length = LEN(pick_words[x])
beavis = 1
DO WHILE beavis <= word_length
z_letter = SUBSTR(pick_words[x],beavis,1)
DO CASE
case z_letter = "A"
let_score = let_score +1
case z_letter = "B"
let_score = let_score +3
case z_letter = "C"
let_score = let_score +3
case z_letter = "D"
let_score = let_score +2
case z_letter = "E"
let_score = let_score +1
case z_letter = "F"
let_score = let_score +4
case z_letter = "G"
let_score = let_score +2
case z_letter = "H"
let_score = let_score +4
case z_letter = "I"
let_score = let_score +1
case z_letter = "J"
let_score = let_score +8
case z_letter = "K"
let_score = let_score +5
case z_letter = "L"
let_score = let_score +1
case z_letter = "M"
let_score = let_score +3
case z_letter = "N"
let_score = let_score +1
case z_letter = "O"
let_score = let_score +1
case z_letter = "P"
let_score = let_score +3
case z_letter = "Q"
let_score = let_score +10
case z_letter = "R"
let_score = let_score +1
case z_letter = "S"
let_score = let_score +1
case z_letter = "T"
let_score = let_score +1
case z_letter = "U"
let_score = let_score +1
case z_letter = "V"
let_score = let_score +4
case z_letter = "W"
let_score = let_score +4
case z_letter = "X"
let_score = let_score +8
case z_letter = "Y"
let_score = let_score +4
case z_letter = "Z"
let_score = let_score +10
ENDCASE
beavis = beavis + 1
LOOP
ENDDO
color_word = "W+/bg"
color_score = "r/bg"
word_score = let_score
let_score = 0
IF word_length = 7
word_score = INT(word_score * 1.25)
color_word = "b/bg"
color_score = "b/bg"
ENDIF
IF word_length = 8
word_score = INT(word_score * 1.5)
color_word = "b/bg"
color_score = "b/bg"
ENDIF
IF word_length = 9
word_score = INT(word_score * 1.75)
color_word = "b/bg"
color_score = "b/bg"
ENDIF
IF word_length = 10
word_score = INT(word_score * 2)
color_word = "b/bg"
color_score = "b/bg"
ENDIF
IF word_score > temp_score
temp_word = pick_words[x]
temp_score = word_score
ENDIF
game_score = game_score + word_score
SET COLOR TO &color_word
@ top_row,(top_col-11) SAY pick_words[x]
SET COLOR TO &color_score
@ top_row,top_col SAY "+"
@ top_row,(top_col+2) SAY word_score PICTURE "###"
ELSE
game_score = game_score - 5
SET COLOR TO n/bg
@ top_row,(top_col-11) SAY pick_words[x]
SET COLOR TO n/bg
@ top_row,top_col SAY "- 5"
ENDIF
top_row = top_row + 1
IF top_row = 13
top_col = top_col + 18
top_row = 3
ENDIF
x = x + 1
delay = .75
DO pause WITH delay
LOOP
ENDDO
IF game_score < 0
game_score = 0
ENDIF
SET COLOR TO GR+/r
@ 17,3 SAY " Game Score: "
SET COLOR TO W+/r
@ 17,16 SAY game_score PICTURE "@B ###"
delay = 2
DO pause WITH delay
SET COLOR TO W+/rb
beavis = 1
DO WHILE beavis <= game_score
@ 20,70 SAY beavis PICTURE "@B ###,###"
@ 21,70 SAY (total_score + beavis) PICTURE "@B ###,###"
delay = .005
DO pause WITH delay
beavis = beavis + 1
LOOP
ENDDO
DO check_bw
DO check_bg
total_score = total_score + game_score
last_game = game_score
@ 20,70 SAY last_game PICTURE "@B ###,###"
@ 21,70 SAY total_score PICTURE "@B ###,###"
games_left = games_left -1
game_score = 0
SET COLOR TO W+/r
@ 17,3 SAY " "
@ 18,3 SAY " "
t_left = timer
SET COLOR TO gr+/g
@ 20,29 SAY t_left PICTURE "##"
SET COLOR TO W+/rb
@ 17,72 SAY games_left PICTURE "@B ###"
SET COLOR TO W+/BG
top_col = 5
top_row = 3
aw_counter = 1
beavis = 1
DO WHILE beavis <= 40
pick_words[beavis] = ""
beavis = beavis + 1
LOOP
ENDDO
SET COLOR TO GR+/r
@ 17,3 SAY " [S]cores/Stats "
@ 18,3 SAY " [N]ext Game "
@ 19,3 SAY " [I]nstructions "
@ 20,3 SAY " [Q]uit for now "
SET COLOR TO W+/r
@ 17,5 SAY "S"
@ 18,5 SAY "N"
@ 19,5 SAY "I"
@ 20,5 SAY "Q"
DO WHILE .T.
choice = "N"
SET COLOR TO GR+/r
@ 21,3 SAY " :";
GET choice PICTURE "!A"
READ
IF choice = "N"
IF games_left > 0
SET COLOR TO r/r
@ 17,3 SAY SPACE(15)
@ 18,3 SAY SPACE(15)
@ 19,3 SAY SPACE(15)
@ 20,3 SAY SPACE(15)
@ 21,3 SAY SPACE(15)
RETURN
ENDIF
IF games_left <= 0
SET COLOR TO r/r
@ 17,3 SAY "Sorry, you have"
@ 18,3 SAY "no more games "
@ 19,3 SAY "left for today."
@ 20,3 SAY SPACE(15)
@ 21,3 SAY SPACE(15)
delay = 4
DO pause WITH delay
SET COLOR TO GR+/r
@ 17,3 SAY " [S]cores/Stats "
@ 18,3 SAY " [N]ext Game "
@ 19,3 SAY " [I]nstructions "
@ 20,3 SAY " [Q]uit for now "
SET COLOR TO W+/r
@ 17,5 SAY "S"
@ 18,5 SAY "N"
@ 19,5 SAY "I"
@ 20,5 SAY "Q"
ENDIF
ENDIF
IF choice = "S"
SET COLOR TO GR+/r
@ 17,3 SAY " [A]ll Stats "
@ 18,3 SAY " [1] Best Words "
@ 19,3 SAY " [2] Best Games "
@ 20,3 SAY " [3] Leaderboard"
SET COLOR TO W+/r
@ 17,5 SAY "A"
@ 18,5 SAY "1"
@ 19,5 SAY "2"
@ 20,5 SAY "3"
choice = "X"
SET COLOR TO GR+/r
@ 21,3 SAY " :";
GET choice PICTURE "!A"
READ
IF choice = "X"
SET COLOR TO GR+/r
@ 17,3 SAY " [S]cores/Stats "
@ 18,3 SAY " [N]ext Game "
@ 19,3 SAY " [I]nstructions "
@ 20,3 SAY " [Q]uit for now "
@ 21,3 SAY " "
SET COLOR TO W+/r
@ 17,5 SAY "S"
@ 18,5 SAY "N"
@ 19,5 SAY "I"
@ 20,5 SAY "Q"
ENDIF
IF choice = "A"
SET COLOR TO r/r
@ 17,3 SAY SPACE(15)
@ 18,3 SAY SPACE(15)
@ 19,3 SAY SPACE(15)
@ 20,3 SAY SPACE(15)
@ 21,3 SAY SPACE(15)
DO stat1
DO stat2
DO stat3
DO stat4
SET COLOR TO GR+/r
@ 17,3 SAY " [S]cores/Stats "
@ 18,3 SAY " [N]ext Game "
@ 19,3 SAY " [I]nstructions "
@ 20,3 SAY " [Q]uit for now "
@ 21,3 SAY " "
SET COLOR TO W+/r
@ 17,5 SAY "S"
@ 18,5 SAY "N"
@ 19,5 SAY "I"
@ 20,5 SAY "Q"
ENDIF
IF choice = "1"
SET COLOR TO r/r
@ 17,3 SAY SPACE(15)
@ 18,3 SAY SPACE(15)
@ 19,3 SAY SPACE(15)
@ 20,3 SAY SPACE(15)
@ 21,3 SAY SPACE(15)
DO stat3
SET COLOR TO GR+/r
@ 17,3 SAY " [S]cores/Stats "
@ 18,3 SAY " [N]ext Game "
@ 19,3 SAY " [I]nstructions "
@ 20,3 SAY " [Q]uit for now "
@ 21,3 SAY " "
SET COLOR TO W+/r
@ 17,5 SAY "S"
@ 18,5 SAY "N"
@ 19,5 SAY "I"
@ 20,5 SAY "Q"
ENDIF
IF choice = "2"
SET COLOR TO r/r
@ 17,3 SAY SPACE(15)
@ 18,3 SAY SPACE(15)
@ 19,3 SAY SPACE(15)
@ 20,3 SAY SPACE(15)
@ 21,3 SAY SPACE(15)
DO stat4
SET COLOR TO GR+/r
@ 17,3 SAY " [S]cores/Stats "
@ 18,3 SAY " [N]ext Game "
@ 19,3 SAY " [I]nstructions "
@ 20,3 SAY " [Q]uit for now "
@ 21,3 SAY " "
SET COLOR TO W+/r
@ 17,5 SAY "S"
@ 18,5 SAY "N"
@ 19,5 SAY "I"
@ 20,5 SAY "Q"
ENDIF
IF choice = "3"
SET COLOR TO r/r
@ 17,3 SAY SPACE(15)
@ 18,3 SAY SPACE(15)
@ 19,3 SAY SPACE(15)
@ 20,3 SAY SPACE(15)
@ 21,3 SAY SPACE(15)
DO stat1
DO stat2
SET COLOR TO GR+/r
@ 17,3 SAY " [S]cores/Stats "
@ 18,3 SAY " [N]ext Game "
@ 19,3 SAY " [I]nstructions "
@ 20,3 SAY " [Q]uit for now "
@ 21,3 SAY " "
SET COLOR TO W+/r
@ 17,5 SAY "S"
@ 18,5 SAY "N"
@ 19,5 SAY "I"
@ 20,5 SAY "Q"
ENDIF
ENDIF
IF choice = "Q"
SET COLOR TO r/r
@ 17,3 SAY SPACE(15)
@ 18,3 SAY SPACE(15)
@ 19,3 SAY SPACE(15)
@ 20,3 SAY SPACE(15)
@ 21,3 SAY SPACE(15)
DO save_scores
QUIT
ENDIF
IF choice = "I"
SET COLOR TO W+/BG
@ 3,5 say " "
@ 4,5 say " "
@ 5,5 say " "
@ 6,5 say " "
@ 7,5 say " "
@ 8,5 say " "
@ 9,5 say " "
@ 10,5 say " "
@ 11,5 say " "
@ 12,5 say " "
SET COLOR TO r/r
@ 17,3 SAY SPACE(15)
@ 18,3 SAY SPACE(15)
@ 19,3 SAY SPACE(15)
@ 20,3 SAY SPACE(15)
@ 21,3 SAY SPACE(15)
DO instructions
SET COLOR TO GR+/r
@ 17,3 SAY " [S]cores/Stats "
@ 18,3 SAY " [N]ext Game "
@ 19,3 SAY " [I]nstructions "
@ 20,3 SAY " [Q]uit for now "
SET COLOR TO W+/r
@ 17,5 SAY "S"
@ 18,5 SAY "N"
@ 19,5 SAY "I"
@ 20,5 SAY "Q"
ENDIF
LOOP
ENDDO
?? "Should never be here... end of check spelling"
WAIT
QUIT
****************************************************************************
***************************** Random Number Generator************************
PROCEDURE RANDOM && Random Number Generator
&& MAXNUM = Number to find
PARAMETERS MaxNum, Mrec && MREC = Number Recieved
DO WHILE .T.
AXSEED = MOD(40014*AXSEED,2147483563)
AYSEED = MOD(40692*AYSEED,2147483399)
RAND_RESULT = MOD(AXSEED + AYSEED,2147483563)
mrec = INT((rand_result / 21474783563) * (maxnum*10)) + 1
z_sec = SECONDS()
z_sec_str = STR(z_sec)
z_num = VAL(RIGHT(z_sec_str,1))
IF z_num < 5
EXIT
ENDIF
LOOP
ENDDO
RETURN
*****************************************************************************
******************************* Program Pause *******************************
PROCEDURE Pause && Pauses for amount of seconds in DELAY
PARAMETERS delay
s1 = SECONDS()
today2 = today && today should = DATE() before this
&& routine is run.
DO WHILE .T.
s2 = SECONDS()
IF s2 > (s1+delay)
EXIT
ENDIF
IF DATE() <> today2
s1 = SECONDS()
today2 = DATE()
ENDIF
LOOP
ENDDO
RETURN
*****************************************************************************
********************************* Error Trap *********************************
PROCEDURE errortrap
SET COLOR TO W+
? "An Error has occurred in this program. Please tell your Sysop that the"
? "following Error has occured: "
? " "
? "Error: "+MESSAGE()
? " "
? " "
WAIT
QUIT
******************************************************************************
******************* Check Current Month / Rollover if new month **************
PROCEDURE checkmonth
thismonth = MONTH(DATE())
USE config EXCLUSIVE
GOTO TOP
configmonth = d_month
IF configmonth = 0
REPLACE d_month WITH thismonth
CLOSE ALL
RETURN
ENDIF
IF configmonth <> thismonth
REPLACE d_month WITH thismonth
CLOSE ALL
USE scores EXCLUSIVE
GOTO TOP
temp_player = d_player && whats this?
temp_h_score = d_h_score && whats this?
CLOSE ALL
COPY FILE scores.new to scores.dbf
USE players EXCLUSIVE
DELETE ALL
ZAP
ENDIF
CLOSE ALL
RETURN
****************************************************************************
******************** Get CONFIG.DBF Configuartion settings ******************
PROCEDURE getconfig
USE config
GOTO TOP
games_day = d_gamesday
allhigh = d_allhigh
allhighn = d_allhighn
allhighd = d_allhighd
CLOSE ALL
RETURN
*****************************************************************************
************************** Get user from PLAYERS.DBF ************************
PROCEDURE getuser
USE players
GOTO TOP
LOCATE FOR d_name = name
IF .NOT. FOUND()
APPEND BLANK
REPLACE d_name WITH name
REPLACE d_score WITH 0
REPLACE d_lastplay WITH DATE()
days = DAY(DATE()) * games_day
REPLACE d_gameleft WITH days
games_left = days
total_score = 0
today = DATE()
newbie = "YES"
ENDIF
IF FOUND()
IF DAY(d_lastplay) < DAY(DATE())
games_left = d_gameleft + ((DAY(DATE()) - DAY(d_lastplay)) * games_day)
total_score = d_score
name = d_name
today = DATE()
ENDIF
IF DAY(d_lastplay) = DAY(DATE())
games_left = d_gameleft
total_score = d_score
name = d_name
today = DATE()
ENDIF
IF games_left = 0
CLOSE ALL
CLEAR SCREEN
DO nogame
CLEAR SCREEN
QUIT
ENDIF
newbie = "NO"
ENDIF
CLOSE ALL
RETURN
*****************************************************************************
*************************** No More Games Left Today *************************
PROCEDURE nogame
&& do later
? "Sorry...no more games"
WAIT
RETURN
******************************************************************************
*************************** Setup Initial Parameters ************************
PROCEDURE setup_params
SET TALK OFF
SET CONFIRM ON
SET BELL OFF
SET EXCLUSIVE OFF
SET EXACT ON
SET ESCAPE OFF
RETURN
*****************************************************************************
*********************** Setup Initial Variables & Globals *******************
PROCEDURE set_vars
PUBLIC name,letter[12],get_word[12],today,pick_words[40],aw_counter
PUBLIC top_col,top_row,timer,timer_sec,t_left,game_end,gw_col,games_left
PUBLIC first,game_score,total_score,games_day,free_game,last_game
PUBLIC thismonth,newbie,allhigh,allhighn,allhighd
PUBLIC temp_word, temp_score
name = UNAME()
today = DATE()
games_left = 1
aw_counter = 1
top_col = 5
top_row = 3
timer = 60
t_left = timer
game_end = "NO"
game_score = 0
first = "YES"
RETURN
*****************************************************************************
********************* Show Initial Screen / Vars / Etc... *******************
PROCEDURE show_initial
TYPE main.ans
SET COLOR TO W+/rb
@ 17,72 SAY games_left PICTURE "@B ###"
@ 21,70 SAY total_score PICTURE "@B ###,###"
@ 20,70 SAY "0"
RETURN
****************************************************************************
**************************** Intro Screen **********************************
PROCEDURE intro
TYPE intro.ans
delay = .14
DO pause WITH delay
SET COLOR TO N+/b
@ 2,30 SAY "BBSoft Presents ..."
DO pause WITH delay
SET COLOR TO w/b
@ 2,30 SAY "BBSoft Presents ..."
DO pause WITH delay
SET COLOR TO W+/b
@ 2,30 SAY "BBSoft Presents ..."
delay = 1
DO pause WITH delay
delay = .14
DO pause WITH delay
SET COLOR TO N+/b
@ 2,23 SAY "Another Game from Porter Venn..."
DO pause WITH delay
SET COLOR TO w/b
@ 2,23 SAY "Another Game from Porter Venn..."
DO pause WITH delay
SET COLOR TO W+/b
@ 2,23 SAY "Another Game from Porter Venn..."
delay = 1.2
DO pause WITH delay
delay = .14
DO pause WITH delay
SET COLOR TO N+/b
@ 2,23 SAY " Welcome to ... "
DO pause WITH delay
SET COLOR TO w/b
@ 2,23 SAY " Welcome to ... "
DO pause WITH delay
SET COLOR TO W+/b
@ 2,23 SAY " Welcome to ... "
delay = .8
DO pause WITH delay
delay = .01
beavis = 1
zcol_counter = 34
word_length = 1
end_word = "WERD NERD"
source_word = "DEIRDREREALLYBLEWITTHISTIMEHAILTOTHEREDSKINS!BBSOFTMAKESTHEBESTGAMES.BUSTERISACOOLCAT!DEADHEADSSMELL.WHITEFISHMONTANARULES!"
word_counter = 1
DO WHILE word_length <= 9
SET COLOR TO GR+/BG
DO WHILE beavis <= 7
DO pause WITH delay
@ 5,zcol_counter SAY SUBSTR(source_word,word_counter,1)
beavis = beavis + 1
word_counter = word_counter + 1
LOOP
ENDDO
SET COLOR TO W+/BG
@ 5,zcol_counter SAY SUBSTR(end_word,word_length,1)
word_length = word_length + 1
zcol_counter = zcol_counter + 1
beavis = 1
LOOP
ENDDO
SET COLOR TO W+/b
@ 8,26 SAY "Press Any Key To Continue"
SET COLOR TO n/n
WAIT " "
&& Remember to add rest of intro with BBS name, Serial # etc... here later.
RETURN
****************************************************************************
******************************** Instructions ******************************
PROCEDURE instructions
yn = "Y"
SET COLOR TO W+/BG
@ 5,20 SAY "Would you like to read the instructions?";
GET yn PICTURE "Y"
READ
IF yn = "N"
RETURN
ENDIF
IF yn = "Y"
@ 3,5 say "Welcome to Werd Nerd! "
@ 4,5 say " "
@ 5,5 say "So how does one play this wacky game? Its quite easy actually. "
@ 6,5 say "The object of Werd Nerd is to create as many words as you can from a "
@ 7,5 say "random group of letters, within 60 seconds. "
@ 8,5 say " "
@ 9,5 say "When play starts, 12 letters will randomly appear in the box at in "
@ 10,5 say "the middle of the screen on the bottom (The Green Box) Using those 12 "
@ 11,5 say "letters, you must type as many words as you can before time runs out. "
@ 12,5 say " --- Press Any Key To Continue --- "
DO keypress
@ 3,5 say "When the clock runs out, all the words you typed will be scored and "
@ 4,5 say "added together, giving you a total score for that game. Each game you"
@ 5,5 say "play during the month adds up to a cumulative score for the entire "
@ 6,5 say "month. "
@ 7,5 say " "
@ 8,5 say "The amount of games you receive per day is determined by the way your "
@ 9,5 say "sysop set up the game. If you miss a few days, dont worry, you will "
@ 10,5 say "be able to play games even for days you missed, up until the end of "
@ 11,5 say "the month. "
@ 12,5 say " --- Press Any Key To Continue --- "
DO keypress
@ 3,5 say "Scoring: After the clock runs out all your words will be checked for "
@ 4,5 say "spelling, if your words are spelled correctly, you will be awarded "
@ 5,5 say "points according to how difficult the word is. Words that use rare "
@ 6,5 say "and hard to use letters, like the 'X', 'Q' & 'Z' for example, are "
@ 7,5 say "worth more than easier to use letters, such as the 'A', 'S' and 'E'. "
@ 8,5 say " "
@ 9,5 say "You may also recieve a bonus for longer words... Any words with a "
@ 10,5 say "length of 7 letters or more will recieve a bonus. If your able to use"
@ 11,5 say "all 10 letters your bonus will be DOUBLE the orignal score! "
@ 12,5 say " --- Press Any Key To Continue --- "
DO keypress
@ 3,5 say "Be sure to spell the word correctly if you can, each miss-spelled word"
@ 4,5 say "will deduct 5 points from your score for that game. "
@ 5,5 say " "
@ 6,5 say "When the game adds up your words for scoring, all red words are words "
@ 7,5 say "that were spelled correctly. Black words are incorrect, and the rare "
@ 8,5 say "blue words are bonus words (7 or more letters). "
@ 9,5 say " "
@ 10,5 say "WERD NERD keeps track of all stats, your scores, other players scores,"
@ 11,5 say "and even your best ever 5 game scores and your top 5 words. "
@ 12,5 say " --- Press Any Key To Continue --- "
DO keypress
@ 3,5 say "That pretty much sums it up... Werd Nerd is a very easy game to play. "
@ 4,5 say "Remember to spell those words correctly! Have Fun! "
@ 5,5 say " "
@ 6,5 say " "
@ 7,5 say " "
@ 8,5 say " "
@ 9,5 say " "
@ 10,5 say " "
@ 11,5 say " "
@ 12,5 say " --- Press Any Key To Continue --- "
DO keypress
@ 3,5 say " "
@ 4,5 say " "
@ 5,5 say " "
@ 6,5 say " "
@ 7,5 say " "
@ 8,5 say " "
@ 9,5 say " "
@ 10,5 say " "
@ 11,5 say " "
@ 12,5 say " "
ENDIF
RETURN
****************************************************************************
**************************** Check for Ansi Support ************************
PROCEDURE checkansi
IF UANSI()
RETURN
ENDIF
CLEAR SCREEN
? "In order to play Werd Nerd, you must have ANSI set to ON"
? " "
WAIT
QUIT
***************************************************************************
************************** User Keypress (Any Key) ************************
PROCEDURE keypress
CLEAR TYPEAHEAD
keypress = "N"
DO WHILE keypress = "N"
I=INKEY(1)
IF i <> 0
keypress = "Y"
ENDIF
LOOP
ENDDO
RETURN
***************************************************************************
******************************** Press Start ******************************
PROCEDURE press_start
SET COLOR TO bg/bg
@ 3,5 say " "
@ 4,5 say " "
@ 5,5 say " "
@ 6,5 say " "
@ 7,5 say " "
@ 8,5 say " "
@ 9,5 say " "
@ 10,5 say " "
@ 11,5 say " "
@ 12,5 say " "
SET COLOR TO n/bg
@ 7,21 SAY "Press Any Key when you're ready to Start"
DO keypress
RETURN
***************************************************************************
****************************** Check Best Word ****************************
PROCEDURE check_bw
IF temp_score = 0
RETURN
ENDIF
playername = LOWER(LTRIM(RTRIM(UNAME())))
length = LEN(playername)
firstlet = UPPER(LEFT(playername,1))
restname = RIGHT(playername,(length-1))
playername = STUFF(restname,1,0,firstlet)
laststart = AT(" ",playername)
lastlet = UPPER(RIGHT(playername,(length-laststart)))
lastlet = LEFT(lastlet,1)
playername = LTRIM(RTRIM(STUFF(playername,laststart+1,1,lastlet)))
USE bestword
GOTO TOP
DECLARE b_words[20]
DECLARE b_word[20]
DECLARE b_wordn[20]
DECLARE b_wordd[20]
counter = 1
DO WHILE counter <= 20
GOTO counter
b_words[counter] = z_b_words
b_word[counter] = z_b_word
b_wordn[counter] = z_b_wordn
b_wordd[counter] = z_b_wordd
counter = counter + 1
LOOP
ENDDO
counter = 1
DO WHILE counter <= 20
IF temp_score > b_words[counter]
zz = 20
DO WHILE zz > counter
b_words[zz] = b_words[zz-1]
b_word[zz] = b_word[zz-1]
b_wordn[zz] = b_wordn[zz-1]
b_wordd[zz] = b_wordd[zz-1]
zz = zz - 1
LOOP
ENDDO
b_words[counter] = temp_score
b_word[counter] = temp_word
b_wordn[counter] = playername
b_wordd[counter] = today
EXIT
ENDIF
counter = counter + 1
LOOP
ENDDO
counter = 1
DO WHILE counter <= 20
GOTO counter
REPLACE z_b_words WITH b_words[counter]
REPLACE z_b_word WITH b_word[counter]
REPLACE z_b_wordn WITH b_wordn[counter]
REPLACE z_b_wordd WITH b_wordd[counter]
counter = counter + 1
LOOP
ENDDO
CLOSE ALL
RETURN
***************************************************************************
****************************** Check Best Game ****************************
PROCEDURE check_bg
IF game_score = 0
RETURN
ENDIF
playername = LOWER(LTRIM(RTRIM(UNAME())))
length = LEN(playername)
firstlet = UPPER(LEFT(playername,1))
restname = RIGHT(playername,(length-1))
playername = STUFF(restname,1,0,firstlet)
laststart = AT(" ",playername)
lastlet = UPPER(RIGHT(playername,(length-laststart)))
lastlet = LEFT(lastlet,1)
playername = LTRIM(RTRIM(STUFF(playername,laststart+1,1,lastlet)))
USE bestgame
GOTO TOP
DECLARE b_game[20]
DECLARE b_gamen[20]
DECLARE b_gamed[20]
counter = 1
DO WHILE counter <= 20
GOTO counter
b_game[counter] = z_b_game
b_gamen[counter] = z_b_gamen
b_gamed[counter] = z_b_gamed
counter = counter + 1
LOOP
ENDDO
counter = 1
DO WHILE counter <= 20
IF game_score > b_game[counter]
zz = 20
DO WHILE zz > counter
b_game[zz] = b_game[zz-1]
b_gamen[zz] = b_gamen[zz-1]
b_gamed[zz] = b_gamed[zz-1]
zz = zz - 1
LOOP
ENDDO
b_game[counter] = game_score
b_gamen[counter] = playername
b_gamed[counter] = today
EXIT
ENDIF
counter = counter + 1
LOOP
ENDDO
counter = 1
DO WHILE counter <= 20
GOTO counter
REPLACE z_b_game WITH b_game[counter]
REPLACE z_b_gamen WITH b_gamen[counter]
REPLACE z_b_gamed WITH b_gamed[counter]
counter = counter + 1
LOOP
ENDDO
CLOSE ALL
RETURN
***************************************************************************
******************************** Save Scores ******************************
PROCEDURE save_scores
set color to W+
nowmonth = MONTH(DATE())
IF nowmonth <> thismonth
RETURN
ENDIF
USE players
GOTO TOP
LOCATE FOR d_name = name
REPLACE d_score WITH total_score
REPLACE d_lastplay WITH today
REPLACE d_gameleft WITH games_left
CLOSE ALL
playername = LOWER(LTRIM(RTRIM(UNAME())))
length = LEN(playername)
firstlet = UPPER(LEFT(playername,1))
restname = RIGHT(playername,(length-1))
playername = STUFF(restname,1,0,firstlet)
laststart = AT(" ",playername)
lastlet = UPPER(RIGHT(playername,(length-laststart)))
lastlet = LEFT(lastlet,1)
playername = LTRIM(RTRIM(STUFF(playername,laststart+1,1,lastlet)))
USE SCORES
GOTO TOP
DECLARE player[20]
DECLARE scores[20]
counter = 1
DO WHILE counter <= 20
GOTO counter
player[counter] = LTRIM(RTRIM(d_player))
scores[counter] = d_h_score
counter = counter + 1
LOOP
ENDDO
counter = 1
DO WHILE counter <= 20
IF total_score >= scores[counter]
killdupe = 1
DO WHILE killdupe <= 20
IF playername = player[killdupe]
switch = killdupe
DO WHILE switch <= 19
player[switch] = player[switch+1]
scores[switch] = scores[switch+1]
switch = switch + 1
LOOP
ENDDO
ENDIF
killdupe = killdupe + 1
LOOP
ENDDO
count_2 = 20
DO WHILE count_2 > counter
scores[count_2] = scores[count_2-1]
player[count_2] = player[count_2-1]
count_2 = count_2 - 1
LOOP
ENDDO
scores[counter] = total_score
player[counter] = playername
EXIT
ENDIF
counter = counter + 1
LOOP
ENDDO
counter = 1
DO WHILE counter <= 20
GOTO counter
REPLACE d_player WITH player[counter]
REPLACE d_h_score WITH scores[counter]
counter = counter + 1
LOOP
ENDDO
CLOSE ALL
&& This checks to see if there is a new All-Time High Score
USE config
GOTO TOP
IF total_score > d_allhigh
REPLACE d_allhigh with total_score
REPLACE d_allhighn with playername
REPLACE d_allhighd with today
CLOSE ALL
ENDIF
RETURN
**************************************************************************
************************ Procedure STAT1 (Leaderboard) *******************
PROCEDURE stat1
SET COLOR TO R*/bg
@ 1,32 SAY "CURRENT LEADERS"
SET COLOR TO bg/bg
@ 3,5 say " "
@ 4,5 say " "
@ 5,5 say " "
@ 6,5 say " "
@ 7,5 say " "
@ 8,5 say " "
@ 9,5 say " "
@ 10,5 say " "
@ 11,5 say " "
@ 12,5 say " "
USE SCORES
GOTO TOP
counter = 1
temprow = 3
DO WHILE counter <= 10
GOTO counter
SET COLOR TO b/bg
IF name = UPPER(d_player)
SET COLOR TO b*/bg
ENDIF
@ temprow,5 SAY LTRIM(RTRIM(LEFT(d_player,21)))
SET COLOR TO rb/bg
IF name = UPPER(d_player)
SET COLOR TO rb*/bg
ENDIF
IF d_h_score > 0
@ temprow,28 SAY d_h_score PICTURE "#,###,###"
ENDIF
counter = counter + 1
temprow = temprow + 1
LOOP
ENDDO
counter = 11
temprow = 3
DO WHILE counter <= 20
GOTO counter
SET COLOR TO b/bg
IF name = UPPER(d_player)
SET COLOR TO b*/bg
ENDIF
@ temprow,43 SAY LTRIM(RTRIM(LEFT(d_player,21)))
SET COLOR TO rb/bg
IF name = UPPER(d_player)
SET COLOR TO rb*/bg
ENDIF
IF d_h_score > 0
@ temprow,66 SAY d_h_score PICTURE "#,###,###"
ENDIF
counter = counter + 1
temprow = temprow + 1
LOOP
ENDDO
CLOSE ALL
SET COLOR TO w+/r
@ 17,3 SAY SPACE(16)
@ 18,3 SAY " Press Any Key "
@ 19,3 SAY " to Continue. "
@ 20,3 SAY SPACE(16)
@ 21,3 SAY SPACE(16)
DO keypress
SET COLOR TO GR+/bg
@ 1,32 SAY "WERD NERD 1.0 "
RETURN
**************************************************************************
************************ Procedure STAT2 (Last Months) *******************
PROCEDURE stat2
RETURN
**************************************************************************
************************ Procedure STAT3 (Best Words) *******************
PROCEDURE stat3
RETURN
**************************************************************************
************************ Procedure STAT4 (Best Games) *******************
PROCEDURE stat4
RETURN
**************************************************************************