Write A Game in 24 hours Contest!

Miscellaneous Forums/General Discussion/Write A Game in 24 hours Contest!

NOTE: This is not my primary entry. Please scroll down below to "Tank Battle" for my primary entry.

;Mind Reader
;By John Judnich

Type Record
	Field Num
End Type

Global winnings, losses

Cls
Graphics 640,480,0,2
AppTitle "Mind Reader"

Color 255,255,0
Print "Instructions:"
Color 255,255,255
Print "Welcome to the Mind Reader. To play this game,"
Print "simply think of the number 1 or 0, and press a"
Print "key when you're ready. The computer will try to"
Print "read your mind by adapting to your thought"
Print "pattern which is learned over time. Therefore,"
Print "the computer's guesses will not initially be"
Print "very correct."
Print
Print "You get 1 point when the computer can't guess"
Print "you're number, and the computer gets 1 point"
Print "when the computer guesses your number correctly."
Print
Print "The first to reach 10 points wins!"
Print
Print "Note: This program trusts you are honest, and"
Print "that you will honestly admit when the computer"
Print "guesses your number. If you lie, the computer"
Print "will get confused about your brain pattern."
Print "You can delete your brain pattern file at any"
Print "time if you want to start over."
Print
Print "Enter your name below: (this is used to load"
Print "the correct thought pattern file later)"
Color 255,0,0
name$ = Input$()
Color 255,255,255

;Load thought pattern
Cls
Locate 0,0
If FileType(name$+".mnd") = 1 Then
	Print "Welcome back, "+name$+"!"
	LoadPattern(name$+".mnd")
Else
	Print "Welcome, "+name$+"!"
End If
Color 0,255,0
Print "Games won:  "+winnings
Color 255,0,0
Print "Games lost: "+losses
Color 255,255,255
If winnings+losses > 0 Then
	prcnt = 100 * winnings / (winnings+losses)
	Print "Your records indicate that you have a "+prcnt+" percent chance to win."
End If
Print
Print

;Play game
computerscore = 0
playerscore = 0
Repeat
	Print "Think of a number (0 or 1 only), then press a key..."
	WaitKey()
	
	numguess = GuessNumber()
	;If playerscore > 0 Then If 100*computerscore/playerscore > 50 Then numguess = 1-numguess
	
	Color 255,255,0
	Print "Were you thinking of "+numguess+"? (Y = Yes   N = No)"
	Color 255,255,255
	Repeat
		answer = WaitKey()
	Until answer = 121 Or answer = 110
	If answer = 121 Then computerscore = computerscore + 1: numreal = numguess
	If answer = 110 Then playerscore = playerscore + 1: numreal = 1-numguess
	
	;Record the player's number
	guess.Record = New Record
	guess\num = numreal
	
	Color 0,0,255
	Print "Current scores:"
	Print "Computer: "+computerscore+"   Player:"+playerscore
	Color 255,255,255
	Print
	Print
Until computerscore = 10 Or playerscore = 10

Print
Print
If computerscore = 10 Then
	Color 255,0,0
	Print "Sorry!"
	Color 255,255,255
	Print "You lost the game,"
	losses = losses + 1
Else
	Color 0,255,0
	Print "Congratulations!"
	Color 255,255,255
	Print "You won the game!"
	winnings = winnings + 1
End If
Print

SavePattern(name$+".mnd")

WaitKey()
End

;This scans the current brain pattern data to guess the next number
Function GuessNumber()
	itm.Record = Last Record
	If itm = Null Then Return Rand(0, 1)
	itm = Before itm
	
	maxlength = 0
	maxitem.Record = Null
	
	While itm <> Null
		chkitm.Record = Last Record
		itm2.Record = itm
		
		length = 0
		Repeat
			If itm2\Num <> chkitm\Num Then Exit
			length = length + 1
			itm2 = Before itm2
			chkitm = Before chkitm
		Until itm2 = Null Or chkitm = Null
		
		If length > maxlength Then maxlength = length: maxitem = itm
		
		itm = Before itm
	Wend
	
	DebugLog maxlength
	
	If maxlength > 2 Then
		maxitem = After maxitem
		guess = maxitem\Num
	Else
		guess = Rand(0, 1)
	End If
	
	Return guess
End Function


Function LoadPattern(filename$)
	Repeat
		x.Record = First Record
		If x <> Null Then Delete x
	Until x = Null

	file = ReadFile(filename$)
	
	winnings = ReadInt(file)
	losses = ReadInt(file)
	
	While Not Eof(file)
		x.Record = New Record
		x\Num = ReadByte(file)
		DebugLog x\Num
	Wend
End Function


Function SavePattern(filename$)
	file = WriteFile(filename$)
	
	WriteInt file, winnings
	WriteInt file, losses
	
	For x.Record = Each Record
		WriteByte file, x\Num
	Next
End Function


You may have to play it a few times before it begins to guess the numbers you're thinking of with better accuracy. It just uses a simple pattern recognition system to attempt to anticipate what numbers you think of. Even then, it doesn't have very much advantage over a pure random guessing system if you try to trick it.