Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Not ANOTHER word-game!
#1
Well, yes, but this one has one or two features that I've never seen in other word-games, so at the risk of overloading this genre of Programs (and the mentalities of the non-lexophile group), here it is.
It's attached as a .zip file, with the dictionary folder Wordlists, which should be in the same folder as the .bas file.
Code: (Select All)
Screen 9
_FullScreen
Randomize Timer
Common Shared k, k$, name$(), score(), flipped, minsize, winscore, plr
Common Shared wrd$, csrh, wrdpos, picked, choice, ln$, reverse$, dumwrd$, mve, found, dictword$, srch$, wordval, tryval, try$
Dim name$(2), score(2)

Color 14: Locate 8, 38: Print "Worm": Print: Print Tab(22);: Color 15: Print " An original word-game by Phil Taylor"
Print
Color 14

Print Tab(17); "Would you like to read the instructions (Y/N) ?"
Instrs:
_KeyClear: k = 0
While k < 1: _Limit 30: k = _KeyHit: Wend
If k <> 78 And k <> 110 Then instructions
Cls
name$(1) = "PLAYER 1": name$(2) = "PLAYER 2": winscore = 200
Locate 10, 9
Print " Accept defaults PLAYER 1, PLAYER 2, Win-level 200 points (Y/N) ?"
_KeyClear: k = 0
While k < 1: _Limit 30: k = _KeyHit: Wend
If k = 89 Or k = 121 Then name$(1) = "PLAYER 1": name$(2) = "PLAYER 2": winscore = 200: GoTo SetUpGame
_KeyClear
wipe "10"
Locate 10, 10: Print "Name for first player (enter for default PLAYER 1): ";
Input n$
If Len(n$) > 1 Then name$(1) = UCase$(n$)
wipe "10"
Locate 10, 10: Print "Name for second player (enter for default PLAYER 2) ";
Input n$
If Len(n$) > 1 Then name$(2) = UCase$(n$)
wipe "10"
Locate 10, 13: Print "Winning score (1=100 to 9=900, enter for default 100):";
_KeyClear: k = 0
While k < 1: _Limit 30: k = _KeyHit: Wend
If k < 49 Or k > 57 Then winscore = 100 Else winscore = (k - 48) * 100
wipe "10"


Cls

SetUpGame:
Locate 10, 2: Print "First player: "; name$(1); Tab(25); "Second player: "; name$(2); Tab(50); "Winning score level:"; winscore
flip = 1: flipped = 0
minsize = 3: plr = 1
score(1) = 0: score(2) = 0

NewWord:
If score(1) >= winscore Or score(2) >= winscore Then
    Cls: Locate 10, 32: Print "We have a winner!"
    Print: Print Tab(31); name$(1), score(1); Tab(31); name$(2), score(2)
    Sleep
    System
End If
wrd$ = Chr$(Int(Rnd * 26) + 65): csrh = 320 '                                                                    wrd$ is random letter at start

PlayerUp:
Color 14
Locate 1, 3: Print name$(1); Space$(4); score(1); Tab(30); name$(plr); " playing"; Tab(64); name$(2); Space$(4); score(2)
cut = Int((Len(wrd$) + 1) / 2): wrdpos = 40: picked = 0: flipped = 0 '                                           cut is number of letters at left of cursor, changes each time a letter is added
wipe "10"
Locate 10, wrdpos: Print wrd$

ShowChoices:
Color 14
Locate 1, 3: Print name$(1); Space$(4); score(1); Tab(34); name$(plr); " playing"; Tab(64); name$(2); Space$(4); score(2)
Locate 2, 33: Print "Winning Score:"; winscore
Color 15: Locate 14, 26: Print "A-Z to select a letter to add"
If picked = 0 Then Color 8
Locate 15, 6: Print "Use Left/Right arrows to change its position, then up-arrow to place it": Color 15
If Len(wrd$) < minsize Or flipped = 1 Then Color 8
Locate 16, 7: Print "1 to Claim a word    2 to Challenge a group": Color 15
If Len(wrd$) < minsize Or flipped = 1 Then Color 8
Locate 16, 53: Print "3 to Concede this round": Color 15
If Len(wrd$) < 2 Then Color 8
Locate 17, 27: Print "Down-arrow to flip the word": Color 15
Locate 18, 32: Print "Esc to close game"
Locate 19, 57: Print ""
Color 15: Locate 12, 40: Print "?"

_KeyClear
GetChoice:
PSet (csrh, 152): Draw "c14u10"
wipe "10"
Locate 10, wrdpos: Print wrd$
choice = 0
_Limit 30
choice = _KeyHit
Select Case choice
    Case Is < 1 '                                                                                                invalid choice
        GoTo GetChoice

    Case Is = 27 '                                                                                               exit game
        System

    Case 65 To 90, 97 To 122 '                                                                                   letter
        If picked = 0 Then '                                                                                     as long as letter not already picked...
            picked = 1
            letr$ = UCase$(Chr$(choice))
            Locate 12, 40: Print letr$
            Locate 15, 6: Print "Use Left/Right arrows to change its position, then up-arrow to place it"
            GoTo GetChoice
        End If

    Case Is = 19200 '                                                                                            left
        If picked = 0 Then GoTo GetChoice '                                                                      if no letter picked yet, ignore
        If cut > 0 Then '                                                                                        if csr not beyond left limit...
            wipe "11" '                                                                                          remove csr...
            csrh = csrh - 8: cut = cut - 1 '                                                                     reposition cut position and csr
        End If
        GoTo GetChoice

    Case Is = 19712 '                                                                                            right
        If picked = 0 Then GoTo GetChoice '                                                                      if no letter picked yet, ignore
        If cut < Len(wrd$) Then '                                                                                if csr not beyond right limit...
            wipe "11" '                                                                                          remove csr...
            csrh = csrh + 8: cut = cut + 1 '                                                                     reposition cut position and csr
        End If
        GoTo GetChoice

    Case Is = 18432 '                                                                                             up (place letter)
        flipped = 0
        If picked = 1 Then
            wrd$ = Left$(wrd$, cut) + letr$ + Right$(wrd$, Len(wrd$) - cut)
            cut = Int((Len(wrd$) + 1) / 2)
            wrdpos = 41 - cut
            Locate 10, wrdpos: Print wrd$
            picked = 0: flipped = 0
            wipe "111617 "
            csrh = 320
            Locate 12, 40: Print "?"
            letr$ = ""
            If plr = 1 Then plr = 2 Else plr = 1
            wipe "14151719"
            Color 15: Locate 12, 40: Print "?"
        End If
        GoTo ShowChoices

    Case Is = 49 '                                                                                                     claim word
        If Len(wrd$) >= minsize And flipped = 0 Then
            wordval = 0
            For a = 1 To Len(wrd$): wordval = wordval + a: Next
            Locate 5, 35: Print "Points Value is"; wordval
            DictionaryCheck:
            If _DirExists("WordLists") Then
                found = 0
                srch$ = "WordLists/" + Left$(wrd$, 1) '                                                               set up file to be searched for try$
                Open srch$ For Input As #1
                While Not EOF(1)
                    Input #1, dictword$
                    If UCase$(dictword$) = wrd$ Then
                        found = 1
                        Exit While
                    End If
                Wend
                Close #1
            Else
                Locate 6, 10: Print "Is this word accepted (y/n)"
                _KeyClear: k = 0
                While k < 1
                    k = _KeyHit
                Wend
                If k = 110 Then found = 0
            End If
            If found = 0 Then
                wipe "0607"
                Locate 7, 35: Color 12: Print wrd$; " not found!"
                If plr = 1 Then plr = 2 Else plr = 1
                score(plr) = score(plr) + wordval
            Else score(plr) = score(plr) + wordval
            End If
            Locate 9, 30: Print name$(plr); " scores"; wordval; " points"
            Sleep 2
            wipe "050709"
            Color 14
            GoTo NewWord
        Else
            GoTo GetChoice
        End If


    Case Is = 50 '                                                                                                        challenge word
        If Len(wrd$) >= minsize And flipped = 0 Then
            found = 0
            wordval = 0: tryval = 0
            For a = 1 To Len(wrd$): wordval = wordval + a: Next
            Locate 6, 30: Print name$(plr); " challenges this group!"
            If plr = 1 Then plr = 2 Else plr = 1
            Print Tab(15); name$(plr); " Please type a word that contains the group";
            _KeyClear
            Print Tab(35);: Color 15: Input try$
            try$ = UCase$(try$)
            If try$ < "A" Or try$ > "Z" Then GoTo BadTry
            For a = 1 To Len(try$): tryval = tryval + a: Next
            If tryval > wordval Then wordval = tryval
            DictSearch:
            If _DirExists("WordLists") Then
                found = 0
                srch$ = "WordLists/" + Left$(try$, 1) '                                                                     set up file to be searched for try$
                Open srch$ For Input As #1
                While Not EOF(1)
                    Input #1, dictword$
                    If UCase$(dictword$) = try$ Then
                        found = 1
                        Exit While
                    End If
                Wend
                Close #1
            Else
                Locate 6, 10: Print "Is this word accepted (y/n)"
                _KeyClear: k = 0
                While k < 1
                    k = _KeyHit
                Wend
                If k = 110 Then found = 0
            End If
            BadTry:
            If found = 0 Then
                wipe "07"
                Locate 7, 35: Color 12: Print try$; " Not found!"
                If plr = 1 Then plr = 2 Else plr = 1
                score(plr) = score(plr) + wordval
            Else score(plr) = score(plr) + wordval
            End If
            Locate 9, 30: Print name$(plr); " scores"; wordval; " points"
            Sleep 2
            wipe "060709"
            Color 14
            GoTo NewWord
        Else
            GoTo GetChoice
        End If



    Case Is = 51 '                                                                                                                  concede word
        If Len(wrd$) >= minsize And flipped = 0 Then
            wipe "0607080914151719"
            wordval = 0
            For a = 1 To Len(wrd$): wordval = wordval + a: Next
            Locate 6, 30: Print name$(plr); " concedes this round!"
            If plr = 1 Then plr = 2 Else plr = 1
            score(plr) = score(plr) + wordval
            Locate 9, 30: Print name$(plr); " scores"; wordval; " points"
            Sleep 2
            wipe "0506070809"
            Color 14
            GoTo NewWord
        Else
            GoTo GetChoice
        End If

        GoTo NewWord
    Case Is = 20480 '                                                                                                                 flip word
        If picked = 0 Then
            If flipped = 1 Then GoTo GetChoice
            Locate 17, 27: Color 8: Print "Down-arrow to flip the word": Color 15
            reverse$ = ""
            For a = Len(wrd$) To 1 Step -1
                reverse$ = reverse$ + Mid$(wrd$, a, 1)
            Next
            wrd$ = reverse$
            flipped = 1
            cut = Int((Len(wrd$) + 1) / 2): wrdpos = 41 - cut
            GoTo GetChoice
        End If
    Case Else
        GoTo GetChoice
End Select

Sub instructions
    Cls: Color 14
    Print Tab(32); "Worm Instructions"
    Color 15
    Print " A random letter is presented, and the players take turns to add one letter to"
    Print " it, building towards a word, but avoiding completing it. The letter may be"
    Print " placed at either end, or anywhere inside the group, thus exending the "; Chr$(34); "Worm"; Chr$(34); "."
    Print
    Print " If a player recognizes a completed word they may claim it, and gain points."
    Print " If successful, they gain points based on its length but if not, their opponent"
    Print " gains the points."
    Print " The group may also be Flipped (reversed) before adding the letter (the result"
    Print " of the Flip can not be claimed as a word)."
    Print
    Print " If they suspect that the group is not part of a real word, they may challenge,"
    Print " and their opponent must then type a complete word containing the group. If"
    Print " they can"; Chr$(39); "t provide a real word, the challenger gains points based on either"
    Print " the size of the group or the length of their attempt, whichever is greater."
    Print
    Print " If a player thinks that any word formed by continuing to expand the group will"
    Print " cost points, they may concede, and their opponent gains points based on the"
    Print " size of the group thus far. This can help to avoid losing even more points."
    Print
    Print " The game ends when one player reaches the pre-set winning score."

    Color 14: Print Tab(28); "Press a key to continue."
    Sleep
    Cls
    Print
End Sub

Sub wipe (ln$)
    For a = 1 To Len(ln$) - 1 Step 2
        Locate Val(Mid$(ln$, a, 2)): Print Space$(80)
    Next
End Sub

Sub Keypress
End Sub

Sub DictSearch
    wrd$ = try$
    srch$ = "WordLists/" + Left$(wrd$, 1)
    wipe "14151719"
    Open srch$ For Input As #1
    While Not EOF(1)
        Input #1, dictword$
        If UCase$(dictword$) = wrd$ Then
            wipe "07"
            Locate 7, 35: Color 14: Print wrd$; " found!"
            found = 1
            Exit While
        End If
    Wend
    Close #1
End Sub


Attached Files
.zip   worm.zip (Size: 576.82 KB / Downloads: 44)
Of all the places on Earth, and all the planets in the Universe, I'd rather live here (Perth, W.A.) Big Grin
Please visit my Website at: http://oldendayskids.blogspot.com/
Reply
#2
Does this program draw a yellow cursor between the letters of the unfinished word? Because on my computer it leaves trails of the very top of it. There is no way to tell where is the cursor because it is invisible except for the trails. After four words are inserted this game becomes impossible to play because of it.

Also there's no way to tell if the program detected it successfully loaded the "WordLists" directory. At first I picked up only the source code as shown above, then discovered there was an attachment.
Reply
#3
(01-23-2023, 05:34 PM)mnrvovrfc Wrote: Does this program draw a yellow cursor between the letters of the unfinished word? Because on my computer it leaves trails of the very top of it. There is no way to tell where is the cursor because it is invisible except for the trails. After four words are inserted this game becomes impossible to play because of it.

Also there's no way to tell if the program detected it successfully loaded the "WordLists" directory. At first I picked up only the source code as shown above, then discovered there was an attachment.

Thanks for the feedback. Sorry about not having the No Dictionary alert. I'll add that, and improve the prompt to download it.
As for the cursor-thing, no, there is no such problem on my computer. With my very limited knowledge about such things, I would guess it's something to do with the screen mode, or your screen resolution. Maybe someone can shed some light on this.
Of all the places on Earth, and all the planets in the Universe, I'd rather live here (Perth, W.A.) Big Grin
Please visit my Website at: http://oldendayskids.blogspot.com/
Reply
#4
@mnrvovrfc:
I bellieve I've found the discrepancy between your screen display and mine. When I change the Screen 9 (at the top of the programme) to Screen 12, I get the situation you described.
I chose Screen 9 because it gives better character-shapes (with the default font) than 12.
Would you mind checking ito see if this is the case?
Of all the places on Earth, and all the planets in the Universe, I'd rather live here (Perth, W.A.) Big Grin
Please visit my Website at: http://oldendayskids.blogspot.com/
Reply
#5
LOL I do have to settle for the EGA screen mode so it works properly.

After pressing a letter key, pressing down-arrow key quits the program. Pressing the left or right arrow key has no problem with drawing the screen, but then punching down-arrow might unsettle somebody right now.
Reply
#6
Screen 9 works fine for me with unusual insert routine Phil has.

What got me stuck was that I extracted zip and THEN found out I had to extract the letter files AGAIN! to get it to check words.

I would think one pass through zip would take care of it all?

Phil is it possible to play against computer as 2 player game not fun for me.
b = b + ...
Reply
#7
@mnrvovrfc: I'm glad you found a screen mode that works for you.
I have trapped the down-arrow key in the later version that I'm preparing - it will be ignored, and the Esc key will be the only exit. Thanks for finding my "deliberate error"  Blush

@bplus: My bad! Sorry.
I should have zipped the WordLists file with the worm.bas file, but I zipped the WordLists.7z file instead, so it was "double-zipped". I'll fix that.
As for a Player vs Computer mode, I'll look at that; It may be hard to get a timely response from the computer, as it would need to examine all options - checking for a completed word; checking a group's validity (against the whole dictionary) ; or adding a "valid" letter before, after, or in between; or conceding.
An interesting project! Thanks.
Of all the places on Earth, and all the planets in the Universe, I'd rather live here (Perth, W.A.) Big Grin
Please visit my Website at: http://oldendayskids.blogspot.com/
Reply
#8
I believe I've addressed all the isssues that have been pointed out (except the Player vs Computer), plus a few more, and have re-constructed the game with suitable changes for each. I've added some basic sounds to acknowledge inputs etc. The new file is attached below. This and the Wordlists directory will now open in one "unzip".
Thanks again for the feedback and suggestions.
.7z   worm.7z (Size: 576.71 KB / Downloads: 61)
Of all the places on Earth, and all the planets in the Universe, I'd rather live here (Perth, W.A.) Big Grin
Please visit my Website at: http://oldendayskids.blogspot.com/
Reply
#9
Here is a snap of what the zip file looks like after extraction from zip file:
   

@PhilofPerth do you check your downloads that you post to make sure everything works as expected?

I am not seeing any changes in game nor hearing any sounds. Phil did you download the correct zip?

Dang I think I extracted the wrong file, the new one is 7z, sorry.

Yep, redownloaded and extracted perfectly!, sound and some text blanked out now instead before.
I think I am missing some point or strategy to game but all seems to be working better.
b = b + ...
Reply
#10
RE: Strategy

Playing the game, the first player has to pick a 4 letter word that can't be made into a 3 letter words when he adds 2nd letter (BTW no 2 letter words allowed I found out, because no way to claim a 2 letter word by 1st player), otherwise the first player adds a letter and 2 player adds a letter that makes it a 3 letter word and forever claim the points. ie who ever goes first is loser.

I think Phil, you want players to build long and twisting words like a worm but a player out to win is going to claim a word ASAP no matter how short so that the other player can't get any points. My concern from that stand point the game won't be much fun. Maybe I am missing something?
b = b + ...
Reply




Users browsing this thread: 11 Guest(s)