Wordiff: Difference between revisions

3,409 bytes added ,  2 months ago
Added FreeBASIC
m (→‎{{header|Wren}}: Minor tidy)
(Added FreeBASIC)
 
Line 338:
You could have entered: [heap, help, hump, kemp]
</pre>
 
=={{header|FreeBASIC}}==
<syntaxhighlight lang="vbnet">REM Wordiff ' 10 march 2024 '
 
'--- Declaración de variables globales ---
Dim Shared As String words()
Dim Shared As String used()
Dim Shared As String player1
Dim Shared As String player2
Dim Shared As String player
Dim Shared As String prevWord
Dim Shared As Integer prevLen
 
'--- SUBrutinas y FUNCiones ---
Sub loadWords
Dim As Integer i, j, numLines
Dim As String linea
Open "unixdict.txt" For Input As #1
While Not Eof(1)
Line Input #1, linea
If Len(linea) = 3 Or Len(linea) = 4 Then
Redim Preserve words(numLines)
words(numLines) = linea
numLines += 1
End If
Wend
Close #1
End Sub
 
Sub Intro
Cls
Color 10, 0 '10, black
Locate 10, 30 : Print "---WORDIFF---"
Locate 12, 5 : Print "Por turnos, teclear nuevas palabras del "
Locate 13, 5 : Print "diccionario de tres o mas caracteres que "
Locate 14, 5 : Print "se diferencien de la anterior en una letra."
Color 14
Locate 16, 5 : Input "Player 1, please enter your name: ", player1
Locate 17, 5 : Input "Player 2, please enter your name: ", player2
If player2 = player1 Then player2 &= "2"
Color 7
End Sub
 
 
Function wordExists(word As String) As Boolean
For i As Integer = 0 To Ubound(words)
If words(i) = word Then Return True
Next i
Return False
End Function
 
Function wordUsed(word As String) As Boolean
For i As Integer = 0 To Ubound(used)
If used(i) = word Then Return True
Next i
Return False
End Function
 
Sub addUsedWord(word As String)
Redim Preserve used(Ubound(used) + 1)
used(Ubound(used)) = word
End Sub
 
Sub MenuPrincipal
Dim As String word
Dim As Integer i, changes, longi
Dim As Boolean ok
Cls
prevWord = words(Int(Rnd * Ubound(words)))
prevLen = Len(prevWord)
player = player1
Print "The first word is ";
Color 15 : Print prevWord : Color 7
Do
Color 7 : Print player; ", plays:";
Color 15 : Input " ", word
word = Lcase(word)
longi = Len(word)
ok = False
Color 12
If longi < 3 Then
Print "Words must be at least 3 letters long."
Elseif wordExists(word) = 0 Then
Print "Not in dictionary."
Elseif wordUsed(word) <> 0 Then
Print "Word has been used before."
Elseif word = prevWord Then
Print "You must change the previous word."
Elseif longi = prevLen Then
changes = 0
For i = 1 To longi
If Mid(word, i, 1) <> Mid(prevWord, i, 1) Then changes += 1
Next i
If changes > 1 Then
Print "Only one letter can be changed."
Else
ok = True
End If
Else
Print "Invalid change."
End If
If ok Then
prevLen = longi
prevWord = word
addUsedWord(word)
player = Iif(player = player1, player2, player1)
Else
Print "So, sorry "; player; ", you've lost!"
Dim As String KBD
Do: KBD = Inkey: Loop While KBD = ""
Exit Do
End If
Loop
End Sub
 
'--- Programa Principal ---
Randomize Timer
Intro
loadWords
MenuPrincipal
End
'--------------------------</syntaxhighlight>
 
=={{header|FutureBasic}}==
2,122

edits