200byteDemoChallenge!

I wrote some crappy piece of code to automatically execute all the entries in this thread, save their code to disk and take a screenshot after 10 seconds of execution.

Strict

Import pub.freeprocess
Import desktopext

' Some crude code to automatically execute all the entries of the 255 bytes demo challenge,
' and store the entries code along with screenshots

Const OUTPUT_DIR$ = "_bbchallenge_"

Function FixSpaces$(s$)
	s$ = s.Replace("~r~n", " ").Replace("~t", " ")
	Repeat
		Local s2$ = s.Replace("  ", " ")
		If s2.Length = s.Length Then
			Return s2
		EndIf
		s = s2
	Forever
End Function

Function FixHtmlEntities$(s$)
	Return s.Replace("&amp;", "&").Replace("&lt;", "<").Replace("&gt;", ">")
End Function

Type TCodeEntry
	Field author$
	Field code$	
End Type


Function ExtractCodeEntries:TList(htmlPage:TStream)
	Local entries:TList = New TList
		
	Local text$ = LoadString(htmlPage)
	Local startPos% = 0
	
	#TopLoop
	Repeat
		startPos = text.Find("class=code", startPos)
		If startPos < 0 Then
			Exit TopLoop
		EndIf
		startPos = text.Find(">", startPos )
		startPos :+ 1
		Local endPos% = text.Find("</", startPos)
		If endPos < 0 Then
			Throw "Uh oh, end of code not found!"
		EndIf
		Local srcCode$ = text[startPos..endPos]
		srcCode = FixHtmlEntities(srcCode)
		Local userName$= "Unknown"
		Local t$ = text[0..startPos]
'		Local userNameStartPos% = t.FindLast("/Account/showuser.php?id=")
		Local userNameStartPos% = t.FindLast("<font class=tiny>(Posted")
		If userNameStartPos >= 0 Then
			Const USERNAME_START_PATTERN$ = "<tr ><td >"
			userNameStartPos = t[0..userNameStartPos].FindLast(USERNAME_START_PATTERN)
			If userNameStartPos  > 0 Then
				userNameStartPos :+ USERNAME_START_PATTERN.Length
				'userNameStartPos = t.Find(">", userNameStartPos+1) 
				'userNameStartPos :+ 1
				'If userNameStartPos >= 0 Then
					Local userNameEndPos% = t.Find("<", userNameStartPos) 
					If userNameStartPos < 0 Then
						Throw "Uh oh, end of author name not found!"
					EndIf
					userName = t[userNameStartPos..userNameEndPos]
				'EndIf
			EndIf
		EndIf
		username = FixSpaces(username)
		DebugLog "###" + userName + "###"
		DebugLog srcCode
		
		Local entry:TCodeEntry = New TCodeEntry
		entry.author = username
		entry.code = srcCode
		entries.AddLast(entry)
		
		startPos = endPos
	Forever
	
	Return entries
End Function

' Pass maxExecTime=0 to prevent execution and just dump the source files
Function Run(htmlPage:TStream, maxExecTime%=10000)
	Local BMK_PATH$ = getenv_("BMK_PATH")
	If BMK_PATH = "" Then
		Notify( "Environment variable 'BMK_PATH' not found.~n" + ..
				"Please set it up to point to the bmk executable path.~n" +..
				"Example: ~qc:\program files\BlitzMax\bin\bmk.exe~q.")
		Return
	EndIf
	
	DeleteDir(OUTPUT_DIR, True)
	CreateDir(OUTPUT_DIR)
	
	Local entries:TList = ExtractCodeEntries(htmlPage)
	Local count% = 0

	For Local entry:TCodeEntry = EachIn entries
		DebugLog "###" + entry.author + "###"
		DebugLog entry.code
				 
		Local srcFileName$ = OUTPUT_DIR +"/" + entry.author + " (" + count + ").bmx"
		SaveString(entry.code, srcFileName)
		If maxExecTime > 0 Then
			Local cmd$ = "~q" + BMK_PATH+"~q makeapp ~q" + CurrentDir() + "/" + srcFileName + "~q"
			DebugLog ">" + cmd
			Local process:TProcess = CreateProcess(cmd)
			While  ProcessStatus(process)
				Delay(10)
			Wend
			cmd$ = StripExt(srcFileName)
	?Win32
			cmd :+ ".exe"
	?
			DebugLog ">" + cmd
			process:TProcess = CreateProcess(cmd)
			If process = Null Then
				Notify("Couldn't compile the following code !~r~n"+entry.code[0..100]+"~r~n...")			
			Else
				Local startTime% = MilliSecs()
				Repeat
					If MilliSecs() - startTime > maxExecTime Or Not ProcessStatus(process) Then
						process.Terminate()
						process.Close()
						Exit
					EndIf
					Local pixmap:TPixmap = DesktopPixmap()
					SavePixmapPNG(pixmap, StripExt(srcFileName)+".png")
					Delay(10)
				Forever
			EndIf
		EndIf
		
		count :+ 1
	Next
	
End Function

Local stream:TStream = OpenStream("tcp::blitzbasic.com")
stream.WriteString("GET /Community/posts.php?topic=67848~r~n~r~n")
Local maxExecTime%
If Confirm("Execute code entries (or just dump them to disk) ?") Then
	maxExecTime = 10000
Else
	maxExecTime = 0
EndIf

Run(stream, maxExecTime)

The code & screenshots are saved to the "_bbchallenge_" sub-directory.
For the screenshot functionality, it uses the DesktopExt module (windows only) available here : http://www.chaos-interactive.de/index.php?show=12&lang=eng.