*************************
* Super Solitaire 2.0 *
* *
* By Porter Venn III *
* 10/28/94 - 10/26/95 *
* *
* Copyright 1994,1995 *
* BBsoft Co. *
*************************
ON ERROR DO errortrap
ON DISCONNECT DO hangup
DO checkansi
DO checksysop
SET TALK OFF
SET CONFIRM ON
SET BELL OFF
SET EXCLUSIVE OFF
SET ESCAPE OFF
SET DISCONNECT MAXINST 500
SET EXACT ON
CLEAR TYPEAHEAD
PUBLIC col,row,pointer,seed,deck,c1[5],c2[5],c3[5],c4[5],c5[5],c6[5],stock[22]
PUBLIC flip_flop,cval_1,crow_1,ccol_1,czz_1,cpoint_1
PUBLIC stock_left,games_left,free_game,score,bonus_level,game_over
PUBLIC all_high_s,all_high_n,lst_mon_s,lst_mon_n,name,games_day,today,newbie
PUBLIC cur_high,cur_high_n,thismonth
PUBLIC m_bbsname,m_sn,view_yn,s_thisgame
DO getkey
name = UNAME()
row = 19
col = 3
pointer = 1
flip_flop = 1
stock_left = 15
bonus_level = 4
game_over = "NO"
newbie = "NO"
view_yn = "N"
s_thisgame = 0
DO checkmonth
DO getconfig
DO getuser
DO intro
DO viewfame
IF view_yn = "Y"
DO verifyplay
ENDIF
TYPE main.ans
SET COLOR TO bg+
IF all_high_s > 0
@ 4,67 SAY all_high_s PICTURE "@B #,###,###"
@ 5,46 SAY all_high_n
ENDIF
IF lst_mon_s > 0
@ 6,67 SAY lst_mon_s PICTURE "@B #,###,###"
@ 7,46 SAY lst_mon_n
ENDIF
IF cur_high > 0
@ 8,67 SAY cur_high PICTURE "@B #,###,###"
@ 9,46 SAY cur_high_n
ENDIF
SET COLOR TO W+
@ 19,34 SAY " "
SET COLOR to gr+
IF games_left > 9
@ 19,34 SAY LTRIM(RTRIM(STR(games_left)))
ENDIF
IF games_left < 10
@ 19,34 SAY " "+LTRIM(RTRIM(STR(games_left)))
ENDIF
@ 1,50 SAY score PICTURE "@B #,###,###"
@ 1,72 SAY s_thisgame PICTURE "@B ####"
SET COLOR TO w+/w
@ 21,2 SAY "Clear more card(s) for a free game"
SET COLOR TO b/w
@ 21,8 SAY LTRIM(RTRIM(STR(free_game)))
DO ask_instruct
DO WHILE .T. && Main Program Loop
SET COLOR TO R+
@ 17,34 SAY LTRIM(RTRIM(STR(stock_left)))
@ 12,44 CLEAR TO 20,76
SET COLOR TO W+
@ 19,34 SAY " "
SET COLOR to gr+
IF games_left > 9
@ 19,34 SAY LTRIM(RTRIM(STR(games_left)))
ENDIF
IF games_left < 10
@ 19,34 SAY " "+LTRIM(RTRIM(STR(games_left)))
ENDIF
IF free_game > 0
SET COLOR TO w+/w
@ 21,2 SAY "Clear more card(s) for a free game"
SET COLOR TO b/w
@ 21,8 SAY LTRIM(RTRIM(STR(free_game)))
ENDIF
SET COLOR TO GR+
@ 5,27 SAY "500 Points"
@ 8,27 SAY "250 Points"
@ 11,27 SAY "100 Points"
@ 14,27 SAY " 50 Points"
SET COLOR TO W+
DO chk_end_month && checks end of month, display warning.
Do shdeck && Shuffle Deck
DO stock_cards && Put Cards in Arrays
DO show_cards && Display the cards on the screen
CLEAR TYPEAHEAD
DO play_game && game begins
DO play_again && ask player to play again
LOOP
ENDDO
PROCEDURE shdeck
SET COLOR TO W+*
@ 15,44 SAY " Shuffling Cards "
RESTORE from random additive
maxnum = 2500
mrec = 0
DO random WITH maxnum,mrec
seed = mrec
SAVE TO random ALL LIKE A?SEED
PRIVATE NewDeck, Cntr, rnd
STORE ";
2C 3C 4C 5C 6C 7C 8C 9C 0C JC QC KC AC;
2H 3H 4H 5H 6H 7H 8H 9H 0H JH QH KH AH;
2D 3D 4D 5D 6D 7D 8D 9D 0D JD QD KD AD;
2S 3S 4S 5S 6S 7S 8S 9S 0S JS QS KS AS" TO Newdeck
Deck = ""
Cntr = 0
DO WHILE Cntr < 52
Seed = MOD((3141592621*Seed+2718281829),10000000000)
Rnd = (Seed*.0000001)-INT(Seed*.0000001)
Rnd = (INT((Rnd*(52-Cntr))+1)*3)-2
Deck = Deck+SUBSTR (NewDeck,Rnd,3)
NewDeck = STUFF (NewDeck,Rnd,3,"")
Cntr = Cntr + 1
ENDDO
RETURN
PROCEDURE stock_cards
counter = 1
deck_counter = 1
DO WHILE counter <= 52
IF counter <= 5
x_con = 1
DO WHILE x_con <= 5
c1[x_con] = SUBSTR(deck,deck_counter,3)
counter = counter + 1
deck_counter = deck_counter + 3
x_con = x_con + 1
LOOP
ENDDO
ENDIF
IF counter > 5 .AND. counter <= 10
x_con = 1
DO WHILE x_con <= 5
c2[x_con] = SUBSTR(deck,deck_counter,3)
counter = counter + 1
deck_counter = deck_counter + 3
x_con = x_con + 1
LOOP
ENDDO
ENDIF
IF counter >10 .AND. counter <= 15
x_con = 1
DO WHILE x_con <= 5
c3[x_con] = SUBSTR(deck,deck_counter,3)
counter = counter + 1
deck_counter = deck_counter + 3
x_con = x_con + 1
LOOP
ENDDO
ENDIF
IF counter >15 .AND. counter <= 20
x_con = 1
DO WHILE x_con <= 5
c4[x_con] = SUBSTR(deck,deck_counter,3)
counter = counter + 1
deck_counter = deck_counter + 3
x_con = x_con + 1
LOOP
ENDDO
ENDIF
IF counter >20 .AND. counter <= 25
x_con = 1
DO WHILE x_con <= 5
c5[x_con] = SUBSTR(deck,deck_counter,3)
counter = counter + 1
deck_counter = deck_counter + 3
x_con = x_con + 1
LOOP
ENDDO
ENDIF
IF counter >25 .AND. counter <= 30
x_con = 1
DO WHILE x_con <= 5
c6[x_con] = SUBSTR(deck,deck_counter,3)
counter = counter + 1
deck_counter = deck_counter + 3
x_con = x_con + 1
LOOP
ENDDO
ENDIF
IF counter >30 .AND. counter <= 52
x_con = 1
DO WHILE x_con <= 22
stock[x_con] = SUBSTR(deck,deck_counter,3)
counter = counter + 1
deck_counter = deck_counter + 3
x_con = x_con + 1
LOOP
ENDDO
ENDIF
LOOP
ENDDO
RETURN
PROCEDURE show_cards
@ 5,3 CLEAR TO 18,25
@ 16,27 CLEAR TO 17,29
z = 1
DO WHILE z <= 6
IF z = 1
sc_col = 3
sc_row = 5
zz = 1
DO WHILE zz <= 5
card_top = LTRIM(LEFT(c1[zz],2))+" "
card_bot = " " + LTRIM(LEFT(c1[zz],2))
IF LTRIM(LEFT(c1[zz],2)) = "0"
card_top = "10 "
card_bot = " 10"
ENDIF
IF RIGHT(c1[zz],1) = "H" .OR. RIGHT(c1[zz],1) = "D"
card_color = "r/w" && RED Card
ENDIF
IF RIGHT(c1[zz],1) = "C" .OR. RIGHT(c1[zz],1) = "S"
card_color = "n/w" && BLACK card
ENDIF
SET COLOR TO &card_color
@ sc_row,sc_col SAY card_top
@ (sc_row+1),sc_col SAY card_bot
zz = zz + 1
sc_row = sc_row + 3
delay = .10
DO pause WITH delay
LOOP
ENDDO
ENDIF
IF z = 2
sc_col = 7
sc_row = 5
zz = 1
DO WHILE zz <= 5
card_top = LTRIM(LEFT(c2[zz],2))+" "
card_bot = " " + LTRIM(LEFT(c2[zz],2))
IF LTRIM(LEFT(c2[zz],2)) = "0"
card_top = "10 "
card_bot = " 10"
ENDIF
IF RIGHT(c2[zz],1) = "H" .OR. RIGHT(c2[zz],1) = "D"
card_color = "r/w" && RED Card
ENDIF
IF RIGHT(c2[zz],1) = "C" .OR. RIGHT(c2[zz],1) = "S"
card_color = "n/w" && BLACK card
ENDIF
SET COLOR TO &card_color
@ sc_row,sc_col SAY card_top
@ (sc_row+1),sc_col SAY card_bot
zz = zz + 1
sc_row = sc_row + 3
delay = .10
DO pause WITH delay
LOOP
ENDDO
ENDIF
IF z = 3
sc_col = 11
sc_row = 5
zz = 1
DO WHILE zz <= 5
card_top = LTRIM(LEFT(c3[zz],2))+" "
card_bot = " " + LTRIM(LEFT(c3[zz],2))
IF LTRIM(LEFT(c3[zz],2)) = "0"
card_top = "10 "
card_bot = " 10"
ENDIF
IF RIGHT(c3[zz],1) = "H" .OR. RIGHT(c3[zz],1) = "D"
card_color = "r/w" && RED Card
ENDIF
IF RIGHT(c3[zz],1) = "C" .OR. RIGHT(c3[zz],1) = "S"
card_color = "n/w" && BLACK card
ENDIF
SET COLOR TO &card_color
@ sc_row,sc_col SAY card_top
@ (sc_row+1),sc_col SAY card_bot
zz = zz + 1
sc_row = sc_row + 3
delay = .10
DO pause WITH delay
LOOP
ENDDO
ENDIF
IF z = 4
sc_col = 15
sc_row = 5
zz = 1
DO WHILE zz <= 5
card_top = LTRIM(LEFT(c4[zz],2))+" "
card_bot = " " + LTRIM(LEFT(c4[zz],2))
IF LTRIM(LEFT(c4[zz],2)) = "0"
card_top = "10 "
card_bot = " 10"
ENDIF
IF RIGHT(c4[zz],1) = "H" .OR. RIGHT(c4[zz],1) = "D"
card_color = "r/w" && RED Card
ENDIF
IF RIGHT(c4[zz],1) = "C" .OR. RIGHT(c4[zz],1) = "S"
card_color = "n/w" && BLACK card
ENDIF
SET COLOR TO &card_color
@ sc_row,sc_col SAY card_top
@ (sc_row+1),sc_col SAY card_bot
zz = zz + 1
sc_row = sc_row + 3
delay = .10
DO pause WITH delay
LOOP
ENDDO
ENDIF
IF z = 5
sc_col = 19
sc_row = 5
zz = 1
DO WHILE zz <= 5
card_top = LTRIM(LEFT(c5[zz],2))+" "
card_bot = " " + LTRIM(LEFT(c5[zz],2))
IF LTRIM(LEFT(c5[zz],2)) = "0"
card_top = "10 "
card_bot = " 10"
ENDIF
IF RIGHT(c5[zz],1) = "H" .OR. RIGHT(c5[zz],1) = "D"
card_color = "r/w" && RED Card
ENDIF
IF RIGHT(c5[zz],1) = "C" .OR. RIGHT(c5[zz],1) = "S"
card_color = "n/w" && BLACK card
ENDIF
SET COLOR TO &card_color
@ sc_row,sc_col SAY card_top
@ (sc_row+1),sc_col SAY card_bot
zz = zz + 1
sc_row = sc_row + 3
delay = .10
DO pause WITH delay
LOOP
ENDDO
ENDIF
IF z = 6
sc_col = 23
sc_row = 5
zz = 1
DO WHILE zz <= 5
card_top = LTRIM(LEFT(c6[zz],2))+" "
card_bot = " " + LTRIM(LEFT(c6[zz],2))
IF LTRIM(LEFT(c6[zz],2)) = "0"
card_top = "10 "
card_bot = " 10"
ENDIF
IF RIGHT(c6[zz],1) = "H" .OR. RIGHT(c6[zz],1) = "D"
card_color = "r/w" && RED Card
ENDIF
IF RIGHT(c6[zz],1) = "C" .OR. RIGHT(c6[zz],1) = "S"
card_color = "n/w" && BLACK card
ENDIF
SET COLOR TO &card_color
@ sc_row,sc_col SAY card_top
@ (sc_row+1),sc_col SAY card_bot
zz = zz + 1
sc_row = sc_row + 3
delay = .10
DO pause WITH delay
LOOP
ENDDO
ENDIF
z = z + 1
LOOP
ENDDO
card_top = LTRIM(LEFT(stock[15],2))+" "
card_bot = " " + LTRIM(LEFT(stock[15],2))
IF LTRIM(LEFT(stock[15],2)) = "0"
card_top = "10 "
card_bot = " 10"
ENDIF
IF RIGHT(stock[15],1) = "H" .OR. RIGHT(stock[15],1) = "D"
card_color = "r/w" && RED Card
ENDIF
IF RIGHT(stock[15],1) = "C" .OR. RIGHT(stock[15],1) = "S"
card_color = "n/w" && BLACK card
ENDIF
SET COLOR TO &card_color
@ 16,27 SAY card_top
@ 17,27 SAY card_bot
SET COLOR TO W+
@ 15,44 SAY " "
DO help_screen
RETURN
PROCEDURE play_game
SET COLOR TO GR+
@ row,col SAY "▄▄▄"
DO WHILE .T.
CLEAR TYPEAHEAD
key = INKEY(1)
IF key = 19 .OR. key = 52
been_here = "NO"
IF pointer = 1
old_row = row
old_col = col
@ old_row,old_col SAY " "
col = col + 24
pointer = 7
DO checkrow
SET COLOR TO GR+
@ row,col SAY "▄▄▄"
been_here = "YES"
ENDIF
IF been_here = "NO"
IF pointer > 1
old_row = row
old_col = col
@ old_row,old_col SAY " "
col = col - 4
pointer = pointer - 1
DO checkrow
SET COLOR TO GR+
@ row,col SAY "▄▄▄"
ENDIF
ENDIF
ENDIF
IF key = 4 .OR. key = 54
been_here = "NO"
IF pointer = 7
old_row = row
old_col = col
@ old_row,old_col SAY " "
col = col - 24
pointer = 1
DO checkrow
SET COLOR TO GR+
@ row,col SAY "▄▄▄"
been_here = "YES"
ENDIF
IF been_here = "NO"
IF pointer < 7
old_row = row
old_col = col
@ old_row,old_col SAY " "
col = col + 4
pointer = pointer + 1
DO checkrow
SET COLOR TO GR+
@ row,col SAY "▄▄▄"
ENDIF
ENDIF
ENDIF
IF key = 32
IF pointer = 1
zz = 5
zz_col = 3
zz_row = 17
DO WHILE zz > 0
IF c1[ZZ] <> "XXX"
card_top = LTRIM(LEFT(c1[zz],2))+" "
card_bot = " " + LTRIM(LEFT(c1[zz],2))
IF LTRIM(LEFT(c1[zz],2)) = "0"
card_top = "10 "
card_bot = " 10"
ENDIF
IF RIGHT(c1[zz],1) = "H" .OR. RIGHT(c1[zz],1) = "D"
card_color = "r/bg" && RED Card
ENDIF
IF RIGHT(c1[zz],1) = "C" .OR. RIGHT(c1[zz],1) = "S"
card_color = "n/bg" && BLACK card
ENDIF
SET COLOR TO &card_color
@ zz_row,zz_col SAY card_top
@ (zz_row+1),zz_col SAY card_bot
SET COLOR TO GR+
@ row,col SAY "▄▄▄"
DO logic_engine WITH zz,zz_col,zz_row
zz = 0
ENDIF
zz = zz - 1
zz_row = zz_row - 3
LOOP
ENDDO
ENDIF
IF pointer = 2
zz = 5
zz_col = 7
zz_row = 17
DO WHILE zz > 0
IF c2[ZZ] <> "XXX"
card_top = LTRIM(LEFT(c2[zz],2))+" "
card_bot = " " + LTRIM(LEFT(c2[zz],2))
IF LTRIM(LEFT(c2[zz],2)) = "0"
card_top = "10 "
card_bot = " 10"
ENDIF
IF RIGHT(c2[zz],1) = "H" .OR. RIGHT(c2[zz],1) = "D"
card_color = "r/bg" && RED Card
ENDIF
IF RIGHT(c2[zz],1) = "C" .OR. RIGHT(c2[zz],1) = "S"
card_color = "n/bg" && BLACK card
ENDIF
SET COLOR TO &card_color
@ zz_row,zz_col SAY card_top
@ (zz_row+1),zz_col SAY card_bot
SET COLOR TO GR+
@ row,col SAY "▄▄▄"
DO logic_engine WITH zz,zz_col,zz_row
zz = 0
ENDIF
zz = zz - 1
zz_row = zz_row - 3
LOOP
ENDDO
ENDIF
IF pointer = 3
zz = 5
zz_col = 11
zz_row = 17
DO WHILE zz > 0
IF c3[ZZ] <> "XXX"
card_top = LTRIM(LEFT(c3[zz],2))+" "
card_bot = " " + LTRIM(LEFT(c3[zz],2))
IF LTRIM(LEFT(c3[zz],2)) = "0"
card_top = "10 "
card_bot = " 10"
ENDIF
IF RIGHT(c3[zz],1) = "H" .OR. RIGHT(c3[zz],1) = "D"
card_color = "r/bg" && RED Card
ENDIF
IF RIGHT(c3[zz],1) = "C" .OR. RIGHT(c3[zz],1) = "S"
card_color = "n/bg" && BLACK card
ENDIF
SET COLOR TO &card_color
@ zz_row,zz_col SAY card_top
@ (zz_row+1),zz_col SAY card_bot
SET COLOR TO GR+
@ row,col SAY "▄▄▄"
DO logic_engine WITH zz,zz_col,zz_row
zz = 0
ENDIF
zz = zz - 1
zz_row = zz_row - 3
LOOP
ENDDO
ENDIF
IF pointer = 4
zz = 5
zz_col = 15
zz_row = 17
DO WHILE zz > 0
IF c4[ZZ] <> "XXX"
card_top = LTRIM(LEFT(c4[zz],2))+" "
card_bot = " " + LTRIM(LEFT(c4[zz],2))
IF LTRIM(LEFT(c4[zz],2)) = "0"
card_top = "10 "
card_bot = " 10"
ENDIF
IF RIGHT(c4[zz],1) = "H" .OR. RIGHT(c4[zz],1) = "D"
card_color = "r/bg" && RED Card
ENDIF
IF RIGHT(c4[zz],1) = "C" .OR. RIGHT(c4[zz],1) = "S"
card_color = "n/bg" && BLACK card
ENDIF
SET COLOR TO &card_color
@ zz_row,zz_col SAY card_top
@ (zz_row+1),zz_col SAY card_bot
SET COLOR TO GR+
@ row,col SAY "▄▄▄"
DO logic_engine WITH zz,zz_col,zz_row
zz = 0
ENDIF
zz = zz - 1
zz_row = zz_row - 3
LOOP
ENDDO
ENDIF
IF pointer = 5
zz = 5
zz_col = 19
zz_row = 17
DO WHILE zz > 0
IF c5[ZZ] <> "XXX"
card_top = LTRIM(LEFT(c5[zz],2))+" "
card_bot = " " + LTRIM(LEFT(c5[zz],2))
IF LTRIM(LEFT(c5[zz],2)) = "0"
card_top = "10 "
card_bot = " 10"
ENDIF
IF RIGHT(c5[zz],1) = "H" .OR. RIGHT(c5[zz],1) = "D"
card_color = "r/bg" && RED Card
ENDIF
IF RIGHT(c5[zz],1) = "C" .OR. RIGHT(c5[zz],1) = "S"
card_color = "n/bg" && BLACK card
ENDIF
SET COLOR TO &card_color
@ zz_row,zz_col SAY card_top
@ (zz_row+1),zz_col SAY card_bot
SET COLOR TO GR+
@ row,col SAY "▄▄▄"
DO logic_engine WITH zz,zz_col,zz_row
zz = 0
ENDIF
zz = zz - 1
zz_row = zz_row - 3
LOOP
ENDDO
ENDIF
IF pointer = 6
zz = 5
zz_col = 23
zz_row = 17
DO WHILE zz > 0
IF c6[ZZ] <> "XXX"
card_top = LTRIM(LEFT(c6[zz],2))+" "
card_bot = " " + LTRIM(LEFT(c6[zz],2))
IF LTRIM(LEFT(c6[zz],2)) = "0"
card_top = "10 "
card_bot = " 10"
ENDIF
IF RIGHT(c6[zz],1) = "H" .OR. RIGHT(c6[zz],1) = "D"
card_color = "r/bg" && RED Card
ENDIF
IF RIGHT(c6[zz],1) = "C" .OR. RIGHT(c6[zz],1) = "S"
card_color = "n/bg" && BLACK card
ENDIF
SET COLOR TO &card_color
@ zz_row,zz_col SAY card_top
@ (zz_row+1),zz_col SAY card_bot
SET COLOR TO GR+
@ row,col SAY "▄▄▄"
DO logic_engine WITH zz,zz_col,zz_row
zz = 0
ENDIF
zz = zz - 1
zz_row = zz_row - 3
LOOP
ENDDO
ENDIF
IF pointer = 7
IF stock_left <= 0
game_over = "YES"
ENDIF
IF stock_left > 0
card_top = LTRIM(LEFT(stock[stock_left],2))+" "
card_bot = " " + LTRIM(LEFT(stock[stock_left],2))
IF LTRIM(LEFT(stock[stock_left],2)) = "0"
card_top = "10 "
card_bot = " 10"
ENDIF
IF RIGHT(stock[stock_left],1) = "H" .OR. RIGHT(stock[stock_left],1) = "D"
card_color = "r/bg" && RED Card
ENDIF
IF RIGHT(stock[stock_left],1) = "C" .OR. RIGHT(stock[stock_left],1) = "S"
card_color = "n/bg" && BLACK card
ENDIF
SET COLOR TO &card_color
@ 16,27 SAY card_top
@ 17,27 SAY card_bot
SET COLOR TO GR+
@ row,col SAY "▄▄▄"
zz = stock_left
zz_col = 27
zz_row = 16
DO logic_engine WITH zz,zz_col,zz_row
ENDIF
ENDIF
ENDIF
IF key = 13
IF stock_left > 0
@ 16,27 SAY " "
@ 17,27 SAY " "
delay = .30
DO pause WITH delay
stock_left = stock_left - 1
SET COLOR TO R+
IF stock_left > 9
@ 17,34 SAY LTRIM(RTRIM(STR(stock_left)))
ENDIF
IF stock_left < 10
@ 17,34 SAY " "+LTRIM(RTRIM(STR(stock_left)))
ENDIF
IF stock_left > 0
card_top = LTRIM(LEFT(stock[stock_left],2))+" "
card_bot = " " + LTRIM(LEFT(stock[stock_left],2))
IF LTRIM(LEFT(stock[stock_left],2)) = "0"
card_top = "10 "
card_bot = " 10"
ENDIF
IF RIGHT(stock[stock_left],1) = "H" .OR. RIGHT(stock[stock_left],1) = "D"
card_color = "r/w" && RED Card
ENDIF
IF RIGHT(stock[stock_left],1) = "C" .OR. RIGHT(stock[stock_left],1) = "S"
card_color = "n/w" && BLACK card
ENDIF
SET COLOR TO &card_color
@ 16,27 SAY card_top
@ 17,27 SAY card_bot
ENDIF
SET COLOR TO GR+
@ row,col SAY "▄▄▄"
IF stock_left <= 0
game_over = "YES"
ENDIF
ENDIF
ENDIF
IF key = 81 .OR. key = 113
CLEAR TYPEAHEAD
@ 12,44 CLEAR TO 20,76
yn = "N"
SET COLOR TO W+
@ 15,44 SAY "Do you want to Quit? [Y/N] ";
GET yn PICTURE "Y"
READ
IF yn = "Y"
games_left = games_left - 1
DO finish
ENDIF
IF yn = "N"
DO help_screen
ENDIF
ENDIF
IF key = 72 .OR. key = 104
DO instructions
DO help_screen
ENDIF
IF game_over = "YES"
RETURN
ENDIF
LOOP
ENDDO
PROCEDURE logic_engine
PARAMETERS zz,zz_col,zz_row
IF pointer = 1
card_type = LEFT(c1[zz],2)
IF card_type = " K" && If a King
delay = .30
DO pause WITH delay
c1[zz] = "XXX"
@ zz_row,zz_col SAY " "
@ zz_row+1,zz_col SAY " "
DO fg_1down
ENDIF
card_value = 0
DO leng1 WITH card_type,card_value
IF card_type <> " K"
IF flip_flop = 1
cval_1 = card_value
crow_1 = zz_row
ccol_1 = zz_col
czz_1 = zz
cpoint_1 = pointer
flip_flop = 2
RETURN
ENDIF
IF flip_flop = 2
delay = .30
DO pause WITH delay
IF (card_value + cval_1) = 13
c1[zz] = "XXX"
@ zz_row,zz_col SAY " "
@ zz_row+1,zz_col SAY " "
DO leng2
DO fg_1down
ENDIF
IF (card_value + cval_1) <> 13
DO mustb13
card_top = LTRIM(LEFT(c1[zz],2))+" "
card_bot = " " + LTRIM(LEFT(c1[zz],2))
IF LTRIM(LEFT(c1[zz],2)) = "0"
card_top = "10 "
card_bot = " 10"
ENDIF
IF RIGHT(c1[zz],1) = "H" .OR. RIGHT(c1[zz],1) = "D"
card_color = "r/w" && RED Card
ENDIF
IF RIGHT(c1[zz],1) = "C" .OR. RIGHT(c1[zz],1) = "S"
card_color = "n/w" && BLACK card
ENDIF
SET COLOR TO &card_color
@ zz_row,zz_col SAY card_top
@ (zz_row+1),zz_col SAY card_bot
DO leng3
ENDIF
ENDIF
flip_flop = 1
ENDIF
ENDIF
IF pointer = 2
card_type = LEFT(c2[zz],2)
IF card_type = " K" && If a King
delay = .30
DO pause WITH delay
c2[zz] = "XXX"
@ zz_row,zz_col SAY " "
@ zz_row+1,zz_col SAY " "
DO fg_1down
ENDIF
card_value = 0
DO leng1 WITH card_type,card_value
IF card_type <> " K"
IF flip_flop = 1
cval_1 = card_value
crow_1 = zz_row
ccol_1 = zz_col
czz_1 = zz
cpoint_1 = pointer
flip_flop = 2
RETURN
ENDIF
IF flip_flop = 2
delay = .30
DO pause WITH delay
IF (card_value + cval_1) = 13
c2[zz] = "XXX"
@ zz_row,zz_col SAY " "
@ zz_row+1,zz_col SAY " "
DO leng2
DO fg_1down
ENDIF
IF (card_value + cval_1) <> 13
DO mustb13
card_top = LTRIM(LEFT(c2[zz],2))+" "
card_bot = " " + LTRIM(LEFT(c2[zz],2))
IF LTRIM(LEFT(c2[zz],2)) = "0"
card_top = "10 "
card_bot = " 10"
ENDIF
IF RIGHT(c2[zz],1) = "H" .OR. RIGHT(c2[zz],1) = "D"
card_color = "r/w" && RED Card
ENDIF
IF RIGHT(c2[zz],1) = "C" .OR. RIGHT(c2[zz],1) = "S"
card_color = "n/w" && BLACK card
ENDIF
SET COLOR TO &card_color
@ zz_row,zz_col SAY card_top
@ (zz_row+1),zz_col SAY card_bot
DO leng3
ENDIF
ENDIF
flip_flop = 1
ENDIF
ENDIF
IF pointer = 3
card_type = LEFT(c3[zz],2)
IF card_type = " K" && If a King
delay = .30
DO pause WITH delay
c3[zz] = "XXX"
@ zz_row,zz_col SAY " "
@ zz_row+1,zz_col SAY " "
DO fg_1down
ENDIF
card_value = 0
DO leng1 WITH card_type,card_value
IF card_type <> " K"
IF flip_flop = 1
cval_1 = card_value
crow_1 = zz_row
ccol_1 = zz_col
czz_1 = zz
cpoint_1 = pointer
flip_flop = 2
RETURN
ENDIF
IF flip_flop = 2
delay = .30
DO pause WITH delay
IF (card_value + cval_1) = 13
c3[zz] = "XXX"
@ zz_row,zz_col SAY " "
@ zz_row+1,zz_col SAY " "
DO leng2
DO fg_1down
ENDIF
IF (card_value + cval_1) <> 13
DO mustb13
card_top = LTRIM(LEFT(c3[zz],2))+" "
card_bot = " " + LTRIM(LEFT(c3[zz],2))
IF LTRIM(LEFT(c3[zz],2)) = "0"
card_top = "10 "
card_bot = " 10"
ENDIF
IF RIGHT(c3[zz],1) = "H" .OR. RIGHT(c3[zz],1) = "D"
card_color = "r/w" && RED Card
ENDIF
IF RIGHT(c3[zz],1) = "C" .OR. RIGHT(c3[zz],1) = "S"
card_color = "n/w" && BLACK card
ENDIF
SET COLOR TO &card_color
@ zz_row,zz_col SAY card_top
@ (zz_row+1),zz_col SAY card_bot
DO leng3
ENDIF
ENDIF
flip_flop = 1
ENDIF
ENDIF
IF pointer = 4
card_type = LEFT(c4[zz],2)
IF card_type = " K" && If a King
delay = .30
DO pause WITH delay
c4[zz] = "XXX"
@ zz_row,zz_col SAY " "
@ zz_row+1,zz_col SAY " "
DO fg_1down
ENDIF
card_value = 0
DO leng1 WITH card_type,card_value
IF card_type <> " K"
IF flip_flop = 1
cval_1 = card_value
crow_1 = zz_row
ccol_1 = zz_col
czz_1 = zz
cpoint_1 = pointer
flip_flop = 2
RETURN
ENDIF
IF flip_flop = 2
delay = .30
DO pause WITH delay
IF (card_value + cval_1) = 13
c4[zz] = "XXX"
@ zz_row,zz_col SAY " "
@ zz_row+1,zz_col SAY " "
DO leng2
DO fg_1down
ENDIF
IF (card_value + cval_1) <> 13
DO mustb13
card_top = LTRIM(LEFT(c4[zz],2))+" "
card_bot = " " + LTRIM(LEFT(c4[zz],2))
IF LTRIM(LEFT(c4[zz],2)) = "0"
card_top = "10 "
card_bot = " 10"
ENDIF
IF RIGHT(c4[zz],1) = "H" .OR. RIGHT(c4[zz],1) = "D"
card_color = "r/w" && RED Card
ENDIF
IF RIGHT(c4[zz],1) = "C" .OR. RIGHT(c4[zz],1) = "S"
card_color = "n/w" && BLACK card
ENDIF
SET COLOR TO &card_color
@ zz_row,zz_col SAY card_top
@ (zz_row+1),zz_col SAY card_bot
DO leng3
ENDIF
ENDIF
flip_flop = 1
ENDIF
ENDIF
IF pointer = 5
card_type = LEFT(c5[zz],2)
IF card_type = " K" && If a King
delay = .30
DO pause WITH delay
c5[zz] = "XXX"
@ zz_row,zz_col SAY " "
@ zz_row+1,zz_col SAY " "
DO fg_1down
ENDIF
card_value = 0
DO leng1 WITH card_type,card_value
IF card_type <> " K"
IF flip_flop = 1
cval_1 = card_value
crow_1 = zz_row
ccol_1 = zz_col
czz_1 = zz
cpoint_1 = pointer
flip_flop = 2
RETURN
ENDIF
IF flip_flop = 2
delay = .30
DO pause WITH delay
IF (card_value + cval_1) = 13
c5[zz] = "XXX"
@ zz_row,zz_col SAY " "
@ zz_row+1,zz_col SAY " "
DO leng2
DO fg_1down
ENDIF
IF (card_value + cval_1) <> 13
DO mustb13
card_top = LTRIM(LEFT(c5[zz],2))+" "
card_bot = " " + LTRIM(LEFT(c5[zz],2))
IF LTRIM(LEFT(c5[zz],2)) = "0"
card_top = "10 "
card_bot = " 10"
ENDIF
IF RIGHT(c5[zz],1) = "H" .OR. RIGHT(c5[zz],1) = "D"
card_color = "r/w" && RED Card
ENDIF
IF RIGHT(c5[zz],1) = "C" .OR. RIGHT(c5[zz],1) = "S"
card_color = "n/w" && BLACK card
ENDIF
SET COLOR TO &card_color
@ zz_row,zz_col SAY card_top
@ (zz_row+1),zz_col SAY card_bot
DO leng3
ENDIF
ENDIF
flip_flop = 1
ENDIF
ENDIF
IF pointer = 6
card_type = LEFT(c6[zz],2)
IF card_type = " K" && If a King
delay = .30
DO pause WITH delay
c6[zz] = "XXX"
@ zz_row,zz_col SAY " "
@ zz_row+1,zz_col SAY " "
DO fg_1down
ENDIF
card_value = 0
DO leng1 WITH card_type,card_value
IF card_type <> " K"
IF flip_flop = 1
cval_1 = card_value
crow_1 = zz_row
ccol_1 = zz_col
czz_1 = zz
cpoint_1 = pointer
flip_flop = 2
RETURN
ENDIF
IF flip_flop = 2
delay = .30
DO pause WITH delay
IF (card_value + cval_1) = 13
c6[zz] = "XXX"
@ zz_row,zz_col SAY " "
@ zz_row+1,zz_col SAY " "
DO leng2
DO fg_1down
ENDIF
IF (card_value + cval_1) <> 13
DO mustb13
card_top = LTRIM(LEFT(c6[zz],2))+" "
card_bot = " " + LTRIM(LEFT(c6[zz],2))
IF LTRIM(LEFT(c6[zz],2)) = "0"
card_top = "10 "
card_bot = " 10"
ENDIF
IF RIGHT(c6[zz],1) = "H" .OR. RIGHT(c6[zz],1) = "D"
card_color = "r/w" && RED Card
ENDIF
IF RIGHT(c6[zz],1) = "C" .OR. RIGHT(c6[zz],1) = "S"
card_color = "n/w" && BLACK card
ENDIF
SET COLOR TO &card_color
@ zz_row,zz_col SAY card_top
@ (zz_row+1),zz_col SAY card_bot
DO leng3
ENDIF
ENDIF
flip_flop = 1
ENDIF
ENDIF
IF pointer = 7
card_type = LEFT(stock[stock_left],2)
IF card_type = " K" && If a King
delay = .30
DO pause WITH delay
stock_left = stock_left - 1
SET COLOR TO R+
IF stock_left > 9
@ 17,34 SAY LTRIM(RTRIM(STR(stock_left)))
ENDIF
IF stock_left < 10
@ 17,34 SAY " "+LTRIM(RTRIM(STR(stock_left)))
ENDIF
@ 16,27 SAY " "
@ 17,27 SAY " "
DO pause WITH delay
IF stock_left > 0
card_top = LTRIM(LEFT(stock[stock_left],2))+" "
card_bot = " " + LTRIM(LEFT(stock[stock_left],2))
IF LTRIM(LEFT(stock[stock_left],2)) = "0"
card_top = "10 "
card_bot = " 10"
ENDIF
IF RIGHT(stock[stock_left],1) = "H" .OR. RIGHT(stock[stock_left],1) = "D"
card_color = "r/w" && RED Card
ENDIF
IF RIGHT(stock[stock_left],1) = "C" .OR. RIGHT(stock[stock_left],1) = "S"
card_color = "n/w" && BLACK card
ENDIF
SET COLOR TO &card_color
@ 16,27 SAY card_top
@ 17,27 SAY card_bot
SET COLOR TO GR+
@ row,col SAY "▄▄▄"
ENDIF
IF stock_left = 0
game_over = "YES"
@ 16,27 SAY " "
@ 17,27 SAY " "
SET COLOR TO GR+
@ row,col SAY "▄▄▄"
ENDIF
ENDIF
card_value = 0
DO leng1 WITH card_type,card_value
IF card_type <> " K"
IF flip_flop = 1
cval_1 = card_value
crow_1 = zz_row
ccol_1 = zz_col
czz_1 = zz
cpoint_1 = pointer
flip_flop = 2
RETURN
ENDIF
IF flip_flop = 2
delay = .30
DO pause WITH delay
IF (card_value + cval_1) = 13
DO leng2
@ 16,27 SAY " "
@ 17,27 SAY " "
delay = .30
DO pause WITH delay
stock_left = stock_left - 1
SET COLOR TO R+
IF stock_left > 9
@ 17,34 SAY LTRIM(RTRIM(STR(stock_left)))
ENDIF
IF stock_left < 10
@ 17,34 SAY " "+LTRIM(RTRIM(STR(stock_left)))
ENDIF
IF stock_left > 0
card_top = LTRIM(LEFT(stock[stock_left],2))+" "
card_bot = " " + LTRIM(LEFT(stock[stock_left],2))
IF LTRIM(LEFT(stock[stock_left],2)) = "0"
card_top = "10 "
card_bot = " 10"
ENDIF
IF RIGHT(stock[stock_left],1) = "H" .OR. RIGHT(stock[stock_left],1) = "D"
card_color = "r/w" && RED Card
ENDIF
IF RIGHT(stock[stock_left],1) = "C" .OR. RIGHT(stock[stock_left],1) = "S"
card_color = "n/w" && BLACK card
ENDIF
SET COLOR TO &card_color
@ 16,27 SAY card_top
@ 17,27 SAY card_bot
ENDIF
IF stock_left = 0
game_over = "YES"
ENDIF
ENDIF
IF (card_value + cval_1) <> 13
DO mustb13
card_top = LTRIM(LEFT(stock[stock_left],2))+" "
card_bot = " " + LTRIM(LEFT(stock[stock_left],2))
IF LTRIM(LEFT(stock[stock_left],2)) = "0"
card_top = "10 "
card_bot = " 10"
ENDIF
IF RIGHT(stock[stock_left],1) = "H" .OR. RIGHT(stock[stock_left],1) = "D"
card_color = "r/w" && RED Card
ENDIF
IF RIGHT(stock[stock_left],1) = "C" .OR. RIGHT(stock[stock_left],1) = "S"
card_color = "n/w" && BLACK card
ENDIF
SET COLOR TO &card_color
@ 16,27 SAY card_top
@ 17,27 SAY card_bot
DO leng3
ENDIF
ENDIF
flip_flop = 1
ENDIF
ENDIF
SET COLOR TO GR+
@ row,col SAY " "
DO checkrow
SET COLOR TO GR+
@ row,col SAY "▄▄▄"
RETURN
PROCEDURE ask_instruct
IF newbie = "YES"
yn = "Y"
ENDIF
IF newbie = "NO"
yn = "N"
ENDIF
SET COLOR TO W+
@ 15,44 SAY "Read Instructions Now ? [Y/N]";
GET yn PICTURE "Y"
READ
IF yn = "N"
RETURN
ENDIF
IF yn = "Y"
DO instructions
ENDIF
RETURN
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
PROCEDURE errortrap
SET COLOR TO W+
? "An Error has occurred in this program. Please tell your Sysop that the"
? "following Error has occured: "
? " "
? "Error: "
?? ERROR()
? MESSAGE(ERROR())
? " "
WAIT
QUIT
PROCEDURE leng1
PARAMETERS card_type,card_value
IF card_type = " Q"
card_type = "12"
ENDIF
IF card_type = " J"
card_type = "11"
ENDIF
IF card_type = " 0"
card_type = "10"
ENDIF
IF card_type = " A"
card_type = "01"
ENDIF
card_value = VAL(card_type)
RETURN
PROCEDURE leng2
IF cpoint_1 = 1
c1[czz_1] = "XXX"
@ crow_1,ccol_1 SAY " "
@ crow_1+1,ccol_1 SAY " "
DO fg_1down
ENDIF
IF cpoint_1 = 2
c2[czz_1] = "XXX"
@ crow_1,ccol_1 SAY " "
@ crow_1+1,ccol_1 SAY " "
DO fg_1down
ENDIF
IF cpoint_1 = 3
c3[czz_1] = "XXX"
@ crow_1,ccol_1 SAY " "
@ crow_1+1,ccol_1 SAY " "
DO fg_1down
ENDIF
IF cpoint_1 = 4
c4[czz_1] = "XXX"
@ crow_1,ccol_1 SAY " "
@ crow_1+1,ccol_1 SAY " "
DO fg_1down
ENDIF
IF cpoint_1 = 5
c5[czz_1] = "XXX"
@ crow_1,ccol_1 SAY " "
@ crow_1+1,ccol_1 SAY " "
DO fg_1down
ENDIF
IF cpoint_1 = 6
c6[czz_1] = "XXX"
@ crow_1,ccol_1 SAY " "
@ crow_1+1,ccol_1 SAY " "
DO fg_1down
ENDIF
IF cpoint_1 = 7
stock_left = stock_left - 1
@ 16,27 SAY " "
@ 17,27 SAY " "
delay = .30
DO pause WITH delay
SET COLOR TO R+
IF stock_left > 9
@ 17,34 SAY LTRIM(RTRIM(STR(stock_left)))
ENDIF
IF stock_left < 10
@ 17,34 SAY " "+LTRIM(RTRIM(STR(stock_left)))
ENDIF
IF stock_left > 0
card_top = LTRIM(LEFT(stock[stock_left],2))+" "
card_bot = " " + LTRIM(LEFT(stock[stock_left],2))
IF LTRIM(LEFT(stock[stock_left],2)) = "0"
card_top = "10 "
card_bot = " 10"
ENDIF
IF RIGHT(stock[stock_left],1) = "H" .OR. RIGHT(stock[stock_left],1) = "D"
card_color = "r/w" && RED Card
ENDIF
IF RIGHT(stock[stock_left],1) = "C" .OR. RIGHT(stock[stock_left],1) = "S"
card_color = "n/w" && BLACK card
ENDIF
SET COLOR TO &card_color
@ 16,27 SAY card_top
@ 17,27 SAY card_bot
SET COLOR TO GR+
@ row,col SAY "▄▄▄"
ENDIF
IF stock_left = 0
game_over = "YES"
ENDIF
ENDIF
RETURN
PROCEDURE leng3
IF cpoint_1 = 1
card_top = LTRIM(LEFT(c1[czz_1],2))+" "
card_bot = " " + LTRIM(LEFT(c1[czz_1],2))
IF LTRIM(LEFT(c1[czz_1],2)) = "0"
card_top = "10 "
card_bot = " 10"
ENDIF
IF RIGHT(c1[czz_1],1) = "H" .OR. RIGHT(c1[czz_1],1) = "D"
card_color = "r/w" && RED Card
ENDIF
IF RIGHT(c1[czz_1],1) = "C" .OR. RIGHT(c1[czz_1],1) = "S"
card_color = "n/w" && BLACK card
ENDIF
SET COLOR TO &card_color
@ crow_1,ccol_1 SAY card_top
@ (crow_1+1),ccol_1 SAY card_bot
ENDIF
IF cpoint_1 = 2
card_top = LTRIM(LEFT(c2[czz_1],2))+" "
card_bot = " " + LTRIM(LEFT(c2[czz_1],2))
IF LTRIM(LEFT(c2[czz_1],2)) = "0"
card_top = "10 "
card_bot = " 10"
ENDIF
IF RIGHT(c2[czz_1],1) = "H" .OR. RIGHT(c2[czz_1],1) = "D"
card_color = "r/w" && RED Card
ENDIF
IF RIGHT(c2[czz_1],1) = "C" .OR. RIGHT(c2[czz_1],1) = "S"
card_color = "n/w" && BLACK card
ENDIF
SET COLOR TO &card_color
@ crow_1,ccol_1 SAY card_top
@ (crow_1+1),ccol_1 SAY card_bot
ENDIF
IF cpoint_1 = 3
card_top = LTRIM(LEFT(c3[czz_1],2))+" "
card_bot = " " + LTRIM(LEFT(c3[czz_1],2))
IF LTRIM(LEFT(c3[czz_1],2)) = "0"
card_top = "10 "
card_bot = " 10"
ENDIF
IF RIGHT(c3[czz_1],1) = "H" .OR. RIGHT(c3[czz_1],1) = "D"
card_color = "r/w" && RED Card
ENDIF
IF RIGHT(c3[czz_1],1) = "C" .OR. RIGHT(c3[czz_1],1) = "S"
card_color = "n/w" && BLACK card
ENDIF
SET COLOR TO &card_color
@ crow_1,ccol_1 SAY card_top
@ (crow_1+1),ccol_1 SAY card_bot
ENDIF
IF cpoint_1 = 4
card_top = LTRIM(LEFT(c4[czz_1],2))+" "
card_bot = " " + LTRIM(LEFT(c4[czz_1],2))
IF LTRIM(LEFT(c4[czz_1],2)) = "0"
card_top = "10 "
card_bot = " 10"
ENDIF
IF RIGHT(c4[czz_1],1) = "H" .OR. RIGHT(c4[czz_1],1) = "D"
card_color = "r/w" && RED Card
ENDIF
IF RIGHT(c4[czz_1],1) = "C" .OR. RIGHT(c4[czz_1],1) = "S"
card_color = "n/w" && BLACK card
ENDIF
SET COLOR TO &card_color
@ crow_1,ccol_1 SAY card_top
@ (crow_1+1),ccol_1 SAY card_bot
ENDIF
IF cpoint_1 = 5
card_top = LTRIM(LEFT(c5[czz_1],2))+" "
card_bot = " " + LTRIM(LEFT(c5[czz_1],2))
IF LTRIM(LEFT(c5[czz_1],2)) = "0"
card_top = "10 "
card_bot = " 10"
ENDIF
IF RIGHT(c5[czz_1],1) = "H" .OR. RIGHT(c5[czz_1],1) = "D"
card_color = "r/w" && RED Card
ENDIF
IF RIGHT(c5[czz_1],1) = "C" .OR. RIGHT(c5[czz_1],1) = "S"
card_color = "n/w" && BLACK card
ENDIF
SET COLOR TO &card_color
@ crow_1,ccol_1 SAY card_top
@ (crow_1+1),ccol_1 SAY card_bot
ENDIF
IF cpoint_1 = 6
card_top = LTRIM(LEFT(c6[czz_1],2))+" "
card_bot = " " + LTRIM(LEFT(c6[czz_1],2))
IF LTRIM(LEFT(c6[czz_1],2)) = "0"
card_top = "10 "
card_bot = " 10"
ENDIF
IF RIGHT(c6[czz_1],1) = "H" .OR. RIGHT(c6[czz_1],1) = "D"
card_color = "r/w" && RED Card
ENDIF
IF RIGHT(c6[czz_1],1) = "C" .OR. RIGHT(c6[czz_1],1) = "S"
card_color = "n/w" && BLACK card
ENDIF
SET COLOR TO &card_color
@ crow_1,ccol_1 SAY card_top
@ (crow_1+1),ccol_1 SAY card_bot
ENDIF
IF cpoint_1 = 7
card_top = LTRIM(LEFT(stock[stock_left],2))+" "
card_bot = " " + LTRIM(LEFT(stock[stock_left],2))
IF LTRIM(LEFT(stock[stock_left],2)) = "0"
card_top = "10 "
card_bot = " 10"
ENDIF
IF RIGHT(stock[stock_left],1) = "H" .OR. RIGHT(stock[stock_left],1) = "D"
card_color = "r/w" && RED Card
ENDIF
IF RIGHT(stock[stock_left],1) = "C" .OR. RIGHT(stock[stock_left],1) = "S"
card_color = "n/w" && BLACK card
ENDIF
SET COLOR TO &card_color
@ 16,27 SAY card_top
@ 17,27 SAY card_bot
ENDIF
RETURN
PROCEDURE fg_1down
DO addscore
free_game = free_game - 1
IF free_game = 0
SET COLOR TO GR+*/w
@ 21,2 SAY " You've Won a FREE Game! "
delay = 2
DO pause WITH delay
SET COLOR TO b/w
@ 21,2 SAY " "
SET COLOR to gr+*
games_left = games_left + 1
SET COLOR TO W+
@ 19,34 SAY " "
IF games_left > 9
@ 19,34 SAY LTRIM(RTRIM(STR(games_left)))
ENDIF
IF games_left < 10
@ 19,34 SAY " "+LTRIM(RTRIM(STR(games_left)))
ENDIF
delay = .5
DO pause WITH delay
SET COLOR TO W+
@ 19,34 SAY " "
SET COLOR TO GR+
IF games_left > 9
@ 19,34 SAY LTRIM(RTRIM(STR(games_left)))
ENDIF
IF games_left < 10
@ 19,34 SAY " "+LTRIM(RTRIM(STR(games_left)))
ENDIF
ENDIF
IF free_game > 9
SET COLOR TO b/w
@ 21,8 SAY LTRIM(RTRIM(STR(free_game)))
SET COLOR TO w+
ENDIF
IF free_game > 0 .AND. free_game < 10
SET COLOR TO b/w
IF free_game <= 3
SET COLOR TO b*/w
ENDIF
@ 21,8 SAY " "+LTRIM(RTRIM(STR(free_game)))
SET COLOR TO w+
ENDIF
RETURN
PROCEDURE addscore
SET COLOR TO gr+
s_thisgame = s_thisgame + 5
score = score + 5
@ 1,50 SAY score PICTURE "@B #,###,###"
@ 1,72 SAY s_thisgame PICTURE "@B ####"
x = bonus_level
IF x > 0
IF c1[x]="XXX" .AND. c2[x]="XXX" .AND. c3[x]="XXX" .AND. c4[x]="XXX" .AND. c5[x]="XXX" .AND. c6[x]="XXX"
IF bonus_level = 4
bonus_level = bonus_level - 1
SET COLOR TO GR+*
@ 14,27 SAY " 50 Points"
delay = 1
DO pause WITH delay
SET COLOR TO BG+
@ 14,27 SAY " 50 Points"
score = score + 50
s_thisgame = s_thisgame + 50
SET COLOR TO GR+
@ 1,50 SAY score PICTURE "@B #,###,###"
@ 1,72 SAY s_thisgame PICTURE "@B ####"
RETURN
ENDIF
IF bonus_level = 3
bonus_level = bonus_level - 1
SET COLOR TO GR+*
@ 11,27 SAY "100 Points"
delay = 1
DO pause WITH delay
SET COLOR TO BG+
@ 11,27 SAY "100 Points"
score = score + 100
s_thisgame = s_thisgame + 100
SET COLOR TO GR+
@ 1,50 SAY score PICTURE "@B #,###,###"
@ 1,72 SAY s_thisgame PICTURE "@B ####"
RETURN
ENDIF
IF bonus_level = 2
bonus_level = bonus_level - 1
SET COLOR TO GR+*
@ 8,27 SAY "250 Points"
delay = 1
DO pause WITH delay
SET COLOR TO BG+
@ 8,27 SAY "250 Points"
score = score + 250
s_thisgame = s_thisgame + 250
SET COLOR TO GR+
@ 1,50 SAY score PICTURE "@B #,###,###"
@ 1,72 SAY s_thisgame PICTURE "@B ####"
RETURN
ENDIF
IF bonus_level = 1
bonus_level = bonus_level - 1
SET COLOR TO GR+*
@ 5,27 SAY "500 Points"
delay = 1
DO pause WITH delay
SET COLOR TO BG+
@ 5,27 SAY "500 Points"
score = score + 500
s_thisgame = s_thisgame + 500
SET COLOR TO GR+
@ 1,50 SAY score PICTURE "@B #,###,###"
@ 1,72 SAY s_thisgame PICTURE "@B ####"
SET COLOR TO W+
@ 10,4 SAY " Congratulations! "
@ 11,4 SAY "You Cleared the Board!"
game_over = "YES"
ENDIF
ENDIF
ENDIF
RETURN
PROCEDURE play_again
games_left = games_left - 1
SET COLOR TO W+
@ 19,34 SAY " "
SET COLOR to gr+
IF games_left > 9
@ 19,34 SAY LTRIM(RTRIM(STR(games_left)))
ENDIF
IF games_left < 10
@ 19,34 SAY " "+LTRIM(RTRIM(STR(games_left)))
ENDIF
CLEAR TYPEAHEAD
@ row,col SAY " "
@ 12,44 CLEAR TO 20,76
SET COLOR TO GR+*
@ 15,54 SAY "GAME OVER"
delay = 3
DO pause WITH delay
nowmonth = MONTH(DATE())
IF nowmonth <> thismonth
DO Finish
ENDIF
IF games_left <= 0
@ 12,44 CLEAR TO 20,76
SET COLOR TO BG+
@ 13,44 SAY "You have no more games left"
@ 14,44 SAY "for today. "
@ 16,44 SAY "Try again tommorrow."
SET COLOR TO W+
@ 18,44 SAY "Total Score this Month: "
SET COLOR TO GR+
@ 18,68 SAY score PICTURE "@B #,###,###"
SET COLOR TO W+
@ 20,44 SAY " (Press any key to continue) "
DO keypress
DO Finish
ENDIF
IF games_left > 0
CLEAR TYPEAHEAD
@ 12,44 CLEAR TO 20,76
SET COLOR TO W+
@ 14,44 SAY "Total Score this Month: "
SET COLOR TO GR+
@ 14,68 SAY score PICTURE "@B #,###,###"
SET COLOR TO W+
@ 16,44 SAY "Games Left: "
SET COLOR TO R+
@ 16,57 SAY LTRIM(RTRIM(STR(games_left)))
yn = "Y"
SET COLOR TO W+
@ 18,44 SAY "Play again? [Y/N] ";
GET yn PICTURE "Y"
READ
IF yn = "Y"
row = 19
col = 3
pointer = 1
flip_flop = 1
stock_left = 15
bonus_level = 4
game_over = "NO"
SET COLOR TO GR+
s_thisgame = 0
@ 1,72 SAY s_thisgame PICTURE "@B ####"
DO getconfig
ENDIF
IF yn = "N"
DO finish
ENDIF
ENDIF
RETURN
PROCEDURE finish
nowmonth = MONTH(DATE())
SET COLOR TO W+
@ 19,34 SAY " "
SET COLOR to gr+
IF games_left > 9
@ 19,34 SAY LTRIM(RTRIM(STR(games_left)))
ENDIF
IF games_left < 10
@ 19,34 SAY " "+LTRIM(RTRIM(STR(games_left)))
ENDIF
IF nowmonth = thismonth
DO checkfame
USE players
GOTO TOP
LOCATE FOR d_name = name
REPLACE d_score WITH score
REPLACE d_lastplay WITH today
REPLACE d_gameslft WITH games_left
CLOSE ALL
CLEAR TYPEAHEAD
@ 12,44 CLEAR TO 20,76
yn = "Y"
SET COLOR TO W+
@ 15,44 SAY "View High Scores? [Y/N] ";
GET yn PICTURE "Y"
READ
IF yn = "Y"
DO showfame
ENDIF
QUIT
ENDIF
IF nowmonth <> thismonth
@ 12,44 CLEAR TO 20,76
SET COLOR TO BG+
@ 13,44 SAY "A New month is now upon us!"
@ 14,44 SAY " "
@ 15,44 SAY "All scores have been reset "
@ 16,44 SAY "and updated for a new month."
SET COLOR TO W+
@ 20,44 SAY " (Press any key to continue) "
DO keypress
QUIT
ENDIF
PROCEDURE help_screen
@ 12,44 CLEAR TO 20,76
SET COLOR TO W+
@ 12,44 SAY "Your Goal: Try to match cards"
@ 13,44 SAY "That will total 13. "
SET COLOR TO w
@ 15,44 SAY "[SPACE] = "
@ 16,44 SAY "[ENTER] = "
@ 17,44 SAY "[H] = "
@ 18,44 SAY "[Q] = "
SET COLOR TO W+
@ 15,55 SAY "To select a card "
@ 16,55 SAY "Get a card from stock"
@ 17,55 SAY "Help & Instructions "
@ 18,55 SAY "Quit / Exit Game "
@ 20,44 SAY "<- -> Keys & Num Pad move Crsr"
RETURN
PROCEDURE instructions
@ 12,44 CLEAR TO 20,76
SET COLOR TO W+
@ 12,44 SAY "Your Goal: Try to match cards "
@ 13,44 SAY "That will total 13. "
@ 14,44 SAY " "
@ 15,44 SAY "All cards equal their face "
@ 16,44 SAY "value. An ACE Equals 1 etc... "
@ 17,44 SAY "Note: A Jack = 11, Queen = 12 "
@ 18,44 SAY "and a KING = 13 and is free. "
@ 19,44 SAY " "
@ 20,44 SAY " (Press any key to continue) "
DO keypress
@ 12,44 CLEAR TO 20,76
SET COLOR TO W+
@ 12,44 SAY "You select pairs of cards by "
@ 13,44 SAY "moving the yellow cursor with "
@ 14,44 SAY "the arrow keys on your "
@ 15,44 SAY "keyboard. "
@ 16,44 SAY " "
@ 17,44 SAY "Press [SPACE] to select a "
@ 18,44 SAY "card. You must select 2 cards"
@ 19,44 SAY "that equal 13 to score. "
@ 20,44 SAY " (Press any key to continue) "
DO keypress
@ 12,44 CLEAR TO 20,76
SET COLOR TO W+
@ 12,44 SAY "If you cannot find a pair "
@ 13,44 SAY "that total 13, you can use the"
@ 14,44 SAY "card in your stock. You can "
@ 15,44 SAY "get a new card in stock by "
@ 16,44 SAY "pressing [ENTER]. "
@ 17,44 SAY " "
@ 18,44 SAY "There are 15 cards in the "
@ 19,44 SAY "stock. When the stock reaches"
@ 20,44 SAY " (Press any key to continue) "
DO keypress
@ 12,44 CLEAR TO 20,76
SET COLOR TO W+
@ 12,44 SAY "0, the game is over. "
@ 13,44 SAY " "
@ 14,44 SAY "Scoring: "
@ 15,44 SAY " "
@ 16,44 SAY "For every card removed from "
@ 17,44 SAY "the board you score 5 points. "
@ 18,44 SAY "You can gain bonus points by "
@ 19,44 SAY " "
@ 20,44 SAY " (Press any key to continue) "
DO keypress
@ 12,44 CLEAR TO 20,76
SET COLOR TO W+
@ 12,44 SAY "clearing the upper rows. The "
@ 13,44 SAY "2nd row rewards 50 points, the"
@ 14,44 SAY "3rd row 100 points, the 4th "
@ 15,44 SAY "row is worth 250 points, and "
@ 16,44 SAY "the 5th is worth 500. "
@ 17,44 SAY " "
@ 18,44 SAY "You are allowed a set amount "
@ 19,44 SAY "of games per day. Once you "
@ 20,44 SAY " (Press any key to continue) "
DO keypress
@ 12,44 CLEAR TO 20,76
SET COLOR TO W+
@ 12,44 SAY "have used your games for the "
@ 13,44 SAY "day, you must wait until the "
@ 14,44 SAY "next day to play again. If "
@ 15,44 SAY "you miss a few days, you will "
@ 16,44 SAY "be able to play those missed "
@ 17,44 SAY "games as well. "
@ 18,44 SAY " "
@ 19,44 SAY " "
@ 20,44 SAY " (Press any key to continue) "
DO keypress
@ 12,44 CLEAR TO 20,76
SET COLOR TO W+
@ 12,44 SAY "You can also win a free game "
@ 13,44 SAY "by clearing enough cards. The"
@ 14,44 SAY "amount needed is shown at the "
@ 15,44 SAY "bottom of the screen. "
@ 16,44 SAY " "
@ 17,44 SAY "The High Scores on the score "
@ 18,44 SAY "list are for the entire month."
@ 19,44 SAY " "
@ 20,44 SAY " (Press any key to continue) "
DO keypress
@ 12,44 CLEAR TO 20,76
SET COLOR TO W+
@ 12,44 SAY "After the month ends, the "
@ 13,44 SAY "scores are reset, and players "
@ 14,44 SAY "may compete for a new high "
@ 15,44 SAY "score for that particular "
@ 16,44 SAY "month. "
@ 17,44 SAY " "
@ 18,44 SAY "Good Luck ! "
@ 19,44 SAY " "
@ 20,44 SAY " (Press any key to continue) "
DO keypress
@ 12,44 CLEAR TO 20,76
SET COLOR TO W+
@ 12,44 SAY " "
@ 13,44 SAY "Note: If your Communications "
@ 14,44 SAY "software does not allow you to"
@ 15,44 SAY "use your <- Cursor Keys - >, "
@ 16,44 SAY "You may use your numeric key -"
@ 17,44 SAY "pad. (4) Moves the cursor left"
@ 18,44 SAY "and (6) moves it to the right."
@ 19,44 SAY " "
@ 20,44 SAY " (Press any key to continue) "
DO keypress
RETURN
PROCEDURE keypress
CLEAR TYPEAHEAD
keypress = "N"
DO WHILE keypress = "N"
I=INKEY(1)
IF i <> 0
keypress = "Y"
ENDIF
LOOP
ENDDO
RETURN
PROCEDURE checkansi
IF UANSI()
RETURN
ENDIF
? "In order to play Super Solitaire, you must have ANSI set to ON"
? " "
WAIT
QUIT
PROCEDURE mustb13
SET COLOR TO R*/w
@ 21,2 SAY " The cards you select must total 13 "
delay = 2
DO pause WITH delay
@ 21,2 SAY " "
IF free_game > 0
SET COLOR TO w+/w
@ 21,2 SAY "Clear more card(s) for a free game"
SET COLOR TO b/w
@ 21,8 SAY LTRIM(RTRIM(STR(free_game)))
ENDIF
RETURN
PROCEDURE intro
TYPE intro.ans
delay = .17
DO pause WITH delay
SET COLOR TO N+/r
@ 3,21 SAY "BBSoft Presents..."
DO pause WITH delay
SET COLOR TO n/bg
@ 8,42 SAY "6 "
@ 9,42 SAY " 6"
SET COLOR TO w/r
@ 3,21 SAY "BBSoft Presents..."
DO pause WITH delay
SET COLOR TO n/bg
@ 8,46 SAY "7 "
@ 9,46 SAY " 7"
SET COLOR TO W+/r
@ 3,21 SAY "BBSoft Presents..."
DO pause WITH delay
SET COLOR TO n/r
@ 8,42 SAY " "
@ 9,42 SAY " "
@ 8,46 SAY " "
@ 9,46 SAY " "
DO pause WITH delay
SET COLOR TO r/bg
@ 8,50 SAY "Q "
@ 9,50 SAY " Q"
DO pause WITH delay
SET COLOR TO n/bg
@ 5,46 SAY "A "
@ 6,46 SAY " A"
DO pause WITH delay
SET COLOR TO N+/r
@ 6,21 SAY "Super Solitaire !"
SET COLOR TO n/r
@ 8,50 SAY " "
@ 9,50 SAY " "
@ 5,46 SAY " "
@ 6,46 SAY " "
DO pause WITH delay
SET COLOR TO w/r
@ 6,21 SAY "Super Solitaire !"
SET COLOR TO r/bg
@ 5,50 SAY "K "
@ 6,50 SAY " K"
DO pause WITH delay
SET COLOR TO W+/r
@ 6,21 SAY "Super Solitaire !"
delay = .40
SET COLOR TO n/r
@ 5,50 SAY " "
@ 6,50 SAY " "
DO pause WITH delay
SET COLOR TO r/bg
@ 5,42 SAY "10 "
@ 6,42 SAY " 10"
DO pause WITH delay
SET COLOR TO n/bg
@ 2,50 SAY "3 "
@ 3,50 SAY " 3"
DO pause WITH delay
SET COLOR TO n/r
@ 5,42 SAY " "
@ 6,42 SAY " "
@ 2,50 SAY " "
@ 3,50 SAY " "
DO pause WITH delay
SET COLOR TO r/bg
@ 2,42 SAY "5 "
@ 3,42 SAY " 5"
DO pause WITH delay
@ 2,46 SAY "8 "
@ 3,46 SAY " 8"
DO pause WITH delay
SET COLOR TO n/r
@ 2,42 SAY " "
@ 3,42 SAY " "
@ 2,46 SAY " "
@ 3,46 SAY " "
delay = 1
DO pause WITH delay
SET COLOR TO W+/r
@ 2,20 SAY " Super Solitaire (1.3) "
@ 3,20 SAY " Written By Porter Venn III "
@ 4,20 SAY " Copyright 1994,1995 BBSoft Co."
@ 5,20 SAY " "
@ 6,20 SAY " "
SET COLOR TO gr+/r
length = LEN(LTRIM(RTRIM(m_bbsname)))
bbs = LTRIM(RTRIM(m_bbsname))
pos = (21+(INT((36-length)/2)))
@ 6,POS SAY bbs
SET COLOR TO BG+/r
@ 7,19 SAY " Serial #:"
SET COLOR TO bg/r
@ 7,39 SAY m_sn
SET COLOR TO w+/r
@ 9,20 SAY " Press any Key to Continue"
DO keypress
RETURN
PROCEDURE getconfig
USE config
GOTO TOP
games_day = d_gamesday
free_game = d_freegame
all_high_s = d_allhigh
all_high_n = d_allhighn
lst_mon_s = d_lsthigh
lst_mon_n = d_lsthighn
CLOSE ALL
USE scores
GOTO TOP
cur_high = d_h_score
cur_high_n = d_player
CLOSE ALL
RETURN
PROCEDURE checkfame
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 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] = 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
IF score > all_high_s
USE config
GOTO TOP
REPLACE d_allhigh with score
REPLACE d_allhighn with playername
REPLACE d_all_date with today
CLOSE ALL
ENDIF
RETURN
PROCEDURE showfame
TYPE fame.ans
USE SCORES
GOTO TOP
counter = 1
temprow = 10
DO WHILE counter <= 10
GOTO counter
SET COLOR TO b/w
IF name = UPPER(d_player)
SET COLOR TO b*/w
ENDIF
@ temprow,6 SAY LTRIM(RTRIM(LEFT(d_player,21)))
SET COLOR TO rb/w
IF name = UPPER(d_player)
SET COLOR TO rb*/w
ENDIF
IF d_h_score > 0
@ temprow,29 SAY d_h_score PICTURE "#,###,###"
ENDIF
counter = counter + 1
temprow = temprow + 1
LOOP
ENDDO
counter = 11
temprow = 10
DO WHILE counter <= 20
GOTO counter
SET COLOR TO b/w
IF name = UPPER(d_player)
SET COLOR TO b*/w
ENDIF
@ temprow,44 SAY LTRIM(RTRIM(LEFT(d_player,21)))
SET COLOR TO rb/w
IF name = UPPER(d_player)
SET COLOR TO rb*/w
ENDIF
IF d_h_score > 0
@ temprow,67 SAY d_h_score PICTURE "#,###,###"
ENDIF
counter = counter + 1
temprow = temprow + 1
LOOP
ENDDO
CLOSE ALL
USE config
GOTO TOP
IF d_allhigh > 0
SET COLOR TO g+/w
@ 3,32 SAY d_allhigh PICTURE "@B #,###,###"
SET COLOR TO W+/w
@ 4,32 SAY d_all_date
SET COLOR TO b+/w
@ 3,42 SAY d_allhighn
ENDIF
IF d_lsthigh > 0
SET COLOR TO rb/w
@ 6,32 SAY d_lsthigh PICTURE "@B #,###,###"
SET COLOR TO b/w
@ 6,42 SAY d_lsthighn
ENDIF
CLOSE ALL
SET COLOR TO W+/W
@ 21,29 SAY "Press any key to continue"
DO keypress
TYPE fame2.ans
USE last8
GOTO TOP
SET COLOR TO W+/w
l8_row = 3
counter = 1
DO WHILE counter <= 4
IF LEN(LTRIM(RTRIM(d_name))) > 0
SET COLOR TO W+/w
@ l8_row,5 SAY LEFT(d_name,17)
SET COLOR TO n+/w
@ l8_row,23 SAY d_month
SET COLOR TO b/w
@ l8_row,33 SAY d_score PICTURE "###,###"
ENDIF
l8_row = l8_row + 1
counter = counter + 1
SKIP
LOOP
ENDDO
l8_row = 3
DO WHILE .NOT. EOF()
IF LEN(LTRIM(RTRIM(d_name))) > 0
SET COLOR TO W+/w
@ l8_row,42 SAY LEFT(d_name,17)
SET COLOR TO n+/w
@ l8_row,60 SAY d_month
SET COLOR TO b/w
@ l8_row,70 SAY d_score PICTURE "###,###"
ENDIF
l8_row = l8_row + 1
SKIP
LOOP
ENDDO
USE LASTMON
GOTO TOP
counter = 1
temprow = 10
DO WHILE counter <= 10
GOTO counter
SET COLOR TO b/w
IF name = UPPER(d_player)
SET COLOR TO b*/w
ENDIF
@ temprow,6 SAY LTRIM(RTRIM(LEFT(d_player,21)))
SET COLOR TO rb/w
IF name = UPPER(d_player)
SET COLOR TO rb*/w
ENDIF
IF d_h_score > 0
@ temprow,29 SAY d_h_score PICTURE "#,###,###"
ENDIF
counter = counter + 1
temprow = temprow + 1
LOOP
ENDDO
counter = 11
temprow = 10
DO WHILE counter <= 20
GOTO counter
SET COLOR TO b/w
IF name = UPPER(d_player)
SET COLOR TO b*/w
ENDIF
@ temprow,44 SAY LTRIM(RTRIM(LEFT(d_player,21)))
SET COLOR TO rb/w
IF name = UPPER(d_player)
SET COLOR TO rb*/w
ENDIF
IF d_h_score > 0
@ temprow,67 SAY d_h_score PICTURE "#,###,###"
ENDIF
counter = counter + 1
temprow = temprow + 1
LOOP
ENDDO
CLOSE ALL
SET COLOR TO W+/W
@ 21,29 SAY "Press any key to continue"
DO keypress
RETURN
PROCEDURE getkey
USE SOLKEY
STORE bbsname TO bbs
STORE 26 TO localval
B = 0
A = 1
M = LEN(LTRIM(RTRIM(bbsname)))
DO WHILE A < LEN(bbs) + 1
B = B + ASC(SUBSTR(bbs,A,1))
A = A + 1
ENDDO
IF B * M * localVal = sncount
m_bbsname = bbsname
m_sn = sn
RETURN
ELSE
CLEAR
SET COLOR TO BG+
? "There appears to be a problem with the SOLKEY.DBF file. Please report this"
? "error to your System Operator."
? " "
WAIT
QUIT
ENDIF
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_gameslft WITH days
games_left = days
score = 0
today = DATE()
newbie = "YES"
ENDIF
IF FOUND()
IF DAY(d_lastplay) < DAY(DATE())
games_left = d_gameslft + ((DAY(DATE()) - DAY(d_lastplay)) * games_day)
score = d_score
name = d_name
today = DATE()
ENDIF
IF DAY(d_lastplay) = DAY(DATE())
games_left = d_gameslft
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
PROCEDURE checkmonth
thismonth = MONTH(DATE())
USE config
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
GOTO TOP
temp_player = d_player
temp_h_score = d_h_score
CLOSE ALL
COPY FILE scores.dbf to lastmon.dbf
USE last8
lastdate = CMONTH(DATE()-26)
counter = 7
DO WHILE counter > 0
GOTO counter
tz_name = d_name
tz_month = d_month
tz_score = d_score
GOTO counter+1
REPLACE d_name WITH tz_name
REPLACE d_month WITH tz_month
REPLACE d_score WITH tz_score
counter = counter - 1
LOOP
ENDDO
GOTO 1
REPLACE d_name WITH temp_player
REPLACE d_month WITH lastdate
REPLACE d_score WITH temp_h_score
CLOSE ALL
COPY FILE scores.new TO scores.dbf
USE config
GOTO TOP
REPLACE d_lsthigh WITH temp_h_score
REPLACE d_lsthighn WITH temp_player
CLOSE ALL
&& might want to put a COPY FILE players.new TO players.dbf
&& here in places of the following routine. zxzx
USE players EXCLUSIVE
DELETE ALL
ZAP
ENDIF
CLOSE ALL
RETURN
PROCEDURE nogame
TYPE intro.ans
delay = .17
DO pause WITH delay
SET COLOR TO N+/r
@ 3,21 SAY "BBSoft Presents..."
DO pause WITH delay
SET COLOR TO n/bg
@ 8,42 SAY "6 "
@ 9,42 SAY " 6"
SET COLOR TO w/r
@ 3,21 SAY "BBSoft Presents..."
DO pause WITH delay
SET COLOR TO n/bg
@ 8,46 SAY "7 "
@ 9,46 SAY " 7"
SET COLOR TO W+/r
@ 3,21 SAY "BBSoft Presents..."
DO pause WITH delay
SET COLOR TO n/r
@ 8,42 SAY " "
@ 9,42 SAY " "
@ 8,46 SAY " "
@ 9,46 SAY " "
DO pause WITH delay
SET COLOR TO r/bg
@ 8,50 SAY "Q "
@ 9,50 SAY " Q"
DO pause WITH delay
SET COLOR TO n/bg
@ 5,46 SAY "A "
@ 6,46 SAY " A"
DO pause WITH delay
SET COLOR TO N+/r
@ 6,21 SAY "Super Solitaire !"
SET COLOR TO n/r
@ 8,50 SAY " "
@ 9,50 SAY " "
@ 5,46 SAY " "
@ 6,46 SAY " "
DO pause WITH delay
SET COLOR TO w/r
@ 6,21 SAY "Super Solitaire !"
SET COLOR TO r/bg
@ 5,50 SAY "K "
@ 6,50 SAY " K"
DO pause WITH delay
SET COLOR TO W+/r
@ 6,21 SAY "Super Solitaire !"
delay = .40
SET COLOR TO n/r
@ 5,50 SAY " "
@ 6,50 SAY " "
DO pause WITH delay
SET COLOR TO W+/r
@ 3,21 SAY "Uh.............."
SET COLOR TO r/bg
@ 5,42 SAY "10 "
@ 6,42 SAY " 10"
DO pause WITH delay
SET COLOR TO n/bg
@ 2,50 SAY "3 "
@ 3,50 SAY " 3"
DO pause WITH delay
SET COLOR TO W+/r
@ 6,21 SAY "Wait a second...."
delay = 2.5
DO pause WITH delay
SET COLOR TO W+/r
@ 3,21 SAY "hmmmmmm.........."
delay = 2.5
DO pause WITH delay
@ 5,21 SAY "It looks like you "
@ 6,21 SAY "have no more games"
@ 7,21 SAY "left for today! "
delay = 5
DO pause WITH delay
@ 3,21 SAY " "
@ 5,21 SAY " "
@ 6,21 SAY " "
@ 7,21 SAY " "
@ 8,21 SAY "Nice Try Wisenheimer!"
delay = 3
DO pause WITH delay
@ 8,21 SAY "Try again Tommorrow "
delay = 4
DO pause WITH delay
SET COLOR TO W+
DO viewfame
RETURN
PROCEDURE checksysop
IF UPRIV() < 255
RETURN
ENDIF
today = DATE()
CLEAR SCREEN
SET COLOR TO W+
yn = "N"
@ 10,16 SAY "Enter the Sysop Configuration Panel? [Y/N] ";
GET yn PICTURE "Y"
READ
IF yn = "N"
RETURN
ENDIF
TYPE panel.ans
USE config EXCLUSIVE
GOTO TOP
t_games_day = d_gamesday
t_freegame = d_freegame
CLOSE ALL
t_reset = "N"
SET COLOR TO BG+/gr
@ 3,32 SAY t_games_day PICTURE "#"
@ 7,32 SAY t_freegame PICTURE "##"
@ 14,32 SAY t_reset PICTURE "Y"
@ 3,32 GET t_games_day PICTURE "#" RANGE 1,9
READ
@ 7,32 GET t_freegame PICTURE "##" RANGE 20,30
READ
@ 14,32 GET t_reset PICTURE "Y"
READ
IF t_reset = "Y"
yn = "N"
SET COLOR TO W+/gr
@ 15,15 SAY "Are you Sure?"
@ 15,32 GET yn PICTURE "Y"
READ
IF yn = "Y"
@ 17,15 SAY "Reseting Scores..."
delay = 1
DO pause WITH Delay
COPY FILE scores.new to scores.dbf
COPY FILE scores.new to lastmon.dbf
COPY FILE last8.new to last8.dbf
&& might want to put a COPY FILE players.new TO players.dbf
&& here in places of the following routine. zxzx
USE players
GOTO TOP
DELETE ALL
ZAP
CLOSE ALL
USE config
GOTO TOP
REPLACE d_month WITH 0
REPLACE d_allhigh WITH 0
REPLACE d_allhighn WITH ""
REPLACE d_lsthigh WITH 0
REPLACE d_lsthighn WITH ""
REPLACE d_all_date WITH DATE()
CLOSE ALL
@ 17,15 SAY "Done "
ENDIF
ENDIF
delay = 2
DO pause WITH delay
USE config
GOTO TOP
REPLACE d_gamesday WITH t_games_day
REPLACE d_freegame WITH t_freegame
CLOSE ALL
SET COLOR TO W+
CLEAR SCREEN
SET COLOR TO W+
? "Information has been saved and updated"
? " "
WAIT
RETURN
PROCEDURE viewfame
SET COLOR TO W+
CLEAR SCREEN
SET COLOR TO W+
yn = "Y"
@ 10,16 SAY "Would you like view the High Scores? [Y/N] ";
GET yn PICTURE "Y"
READ
IF yn = "Y"
view_yn = "Y"
DO showfame
ENDIF
RETURN
PROCEDURE checkrow
IF pointer = 1
IF c1[5] <> "XXX"
row = 19
ENDIF
IF c1[5] = "XXX"
row = 16
ENDIF
IF c1[4] = "XXX"
row = 13
ENDIF
IF c1[3] = "XXX"
row = 10
ENDIF
IF c1[2] = "XXX"
row = 7
ENDIF
ENDIF
IF pointer = 2
IF c2[5] <> "XXX"
row = 19
ENDIF
IF c2[5] = "XXX"
row = 16
ENDIF
IF c2[4] = "XXX"
row = 13
ENDIF
IF c2[3] = "XXX"
row = 10
ENDIF
IF c2[2] = "XXX"
row = 7
ENDIF
ENDIF
IF pointer = 3
IF c3[5] <> "XXX"
row = 19
ENDIF
IF c3[5] = "XXX"
row = 16
ENDIF
IF c3[4] = "XXX"
row = 13
ENDIF
IF c3[3] = "XXX"
row = 10
ENDIF
IF c3[2] = "XXX"
row = 7
ENDIF
ENDIF
IF pointer = 4
IF c4[5] <> "XXX"
row = 19
ENDIF
IF c4[5] = "XXX"
row = 16
ENDIF
IF c4[4] = "XXX"
row = 13
ENDIF
IF c4[3] = "XXX"
row = 10
ENDIF
IF c4[2] = "XXX"
row = 7
ENDIF
ENDIF
IF pointer = 5
IF c5[5] <> "XXX"
row = 19
ENDIF
IF c5[5] = "XXX"
row = 16
ENDIF
IF c5[4] = "XXX"
row = 13
ENDIF
IF c5[3] = "XXX"
row = 10
ENDIF
IF c5[2] = "XXX"
row = 7
ENDIF
ENDIF
IF pointer = 6
IF c6[5] <> "XXX"
row = 19
ENDIF
IF c6[5] = "XXX"
row = 16
ENDIF
IF c6[4] = "XXX"
row = 13
ENDIF
IF c6[3] = "XXX"
row = 10
ENDIF
IF c6[2] = "XXX"
row = 7
ENDIF
ENDIF
IF pointer = 7
row = 19
ENDIF
RETURN
PROCEDURE RANDOM && Random Number Generator
&& MAXNUM = Number to find
&& MREC = Number Recieved
PARAMETERS MaxNum, Mrec
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
PROCEDURE chk_end_month
IF ISLASTDAY(DATE())
IF VAL(LEFT(TIME(),2)) >= 23
SET COLOR TO W+*
@ 13,43 SAY " WARNING !!! "
SET COLOR TO W+
@ 14,43 SAY " "
@ 15,43 SAY "In less than one hour, a new "
@ 16,43 SAY "month will begin. Be sure to "
@ 17,43 SAY "finish your games before midnight"
@ 18,43 SAY "or your score will not be saved. "
delay = 8
DO pause WITH delay
@ 13,43 SAY " "
@ 14,43 SAY " "
@ 15,43 SAY " "
@ 16,43 SAY " "
@ 17,43 SAY " "
@ 18,43 SAY " "
ENDIF
ENDIF
RETURN
PROCEDURE hangup
nowmonth = MONTH(DATE())
IF nowmonth = thismonth
games_left = games_left - 1
IF games_left <= 0
games_left = 0
ENDIF
USE players
GOTO TOP
LOCATE FOR d_name = name
REPLACE d_score WITH score
REPLACE d_lastplay WITH today
REPLACE d_gameslft WITH games_left
CLOSE ALL
QUIT
ENDIF
IF nowmonth <> thismonth
QUIT
ENDIF
RETURN
PROCEDURE verifyplay
CLEAR TYPEAHEAD
SET COLOR TO W+
CLEAR SCREEN
SET COLOR TO W+
yn = "Y"
@ 10,8 SAY "Are you ready to play? (Press [N] to return to the BBS) [Y/N] ";
GET yn PICTURE "Y"
READ
IF yn = "N"
QUIT
ENDIF
RETURN