Just posting some random code here...

TheAutomator · Post by **TheAutomator** » Mon Jan 04, 2021 2:49 am

Let's make the computer write it's own code for once! :D

#width = 800
#height = 600
#fontSize = 8
#maxline = 53
#windowTimer = 200

OpenWindow(0, 0, 0, #width, #height, "Random Code", #PB_Window_ScreenCentered | #PB_Window_SystemMenu)
EditorGadget(0, 0, 0, #width, #height, #PB_Editor_ReadOnly | #PB_Editor_WordWrap)
LoadFont(0, "Lucida Console", #fontSize)
SetGadgetFont(0, FontID(0))
SetGadgetColor(0, #PB_Gadget_FrontColor, $00FF00)
SetGadgetColor(0, #PB_Gadget_BackColor, 0)
AddWindowTimer(0, 0, #windowTimer)

;################################================================--------------------------------

Structure state
	type.s
	iteration.i
EndStructure

Global NewList stack.state()

#string = "ABCDEFGHIJKLMNOPQRSTUVWXYZ_abcdefghijklmnopqrstuvwxyz0123456789 !#$%&'()*+,-./:;<=>?@[\]^{|}~"

Global Dim operator.s(15)
operator(0) = "+"
operator(1) = "-"
operator(2) = "*"
operator(3) = "/"
operator(4) = "<"
operator(5) = "=<"
operator(6) = "<="
operator(7) = "="
operator(8) = "=>"
operator(9) = ">="
operator(10) = ">"
operator(11) = "!"
operator(12) = "&"
operator(13) = "And"
operator(14) = "Or"
operator(15) = "Xor"

Procedure.s name()
	ProcedureReturn Mid(#string, Random(53, 1), 1)
EndProcedure

Procedure.s string()
	rndstr.s
	If Random(1)
		rndstr = Mid(#string, Random(93,1), 1)
	EndIf
	ProcedureReturn #DQUOTE$ + rndstr + #DQUOTE$
EndProcedure

Procedure.s literal()
	Select Random(6)
		Case 0
			ProcedureReturn "False"
		Case 1
			ProcedureReturn "True"
		Case 2
			ProcedureReturn Str(Random(9))
		Case 3
			ProcedureReturn string()
		Case 4
			ProcedureReturn name()
		Case 5
			ProcedureReturn "Input()"
		Case 6
			ProcedureReturn name() + "[" + Random(9) + "]" ; no recursion!
	EndSelect
EndProcedure

Procedure.s math()
	math.s = literal()
	optmax = Random(3)
	For i = 1 To optmax
		Select Random(9)
			Case 0
				math = "Not " + math
			Case 1
				math = "-" + math
			Case 3
				math = "Int(" + math + ")"
			Case 4
				math = "Str(" + math + ")"
			Case 5
				math = "Len(" + math + ")"
			Case 6
				math = "Left(" + math + ", " + literal() + ")"
			Case 7
				math = "Right(" + math + ", " + literal() + ")"
			Case 8
				math = "Mid(" + math + ", " + literal() + ", " + literal() + ")"
			Case 9
				math + " " + operator(Random(15)) + " " + literal()
		EndSelect
		If i < optmax And Random(1)
			math = "(" + math + ")"
		EndIf
	Next
	ProcedureReturn math
EndProcedure

Procedure.s optionalNegate()
	Select Random(9)
		Case 0
			ProcedureReturn "Not " + literal()
		Case 1
			ProcedureReturn "-" + literal()
		Default
			ProcedureReturn literal()
	EndSelect
EndProcedure

Procedure.s sequence(minimum, values)
	Define result.s
	For i = 1 To Random(3,minimum)
		If i > 1
			result + ", "
		EndIf
		If values
			result + OptionalNegate()
		Else
			result + Mid(#string, i, 1)
		EndIf
	Next
	ProcedureReturn result
EndProcedure

Procedure.s comment() ; can also append after statements etc...
	Select Random(15)
		Case 0
			ProcedureReturn "; Need to rewrite this..."
		Case 1
			ProcedureReturn "; Some more code here!"
		Case 2
			ProcedureReturn "; Let's hope this works!"
		Case 3
			ProcedureReturn "; A little bit of magic..."
		Case 4
			ProcedureReturn "; Workaround for that annoying bug..."
		Case 5
			ProcedureReturn "; Need to update this later..."
		Case 6
			ProcedureReturn "; Let's try something here..."
		Case 7
			ProcedureReturn "; This should work, hopefully."
		Case 8
			ProcedureReturn "; Just some random comment for no particular reason."
		Case 9
			ProcedureReturn "; RTFM if confused about this part..."
		Case 10
			ProcedureReturn "; Brilliant!"
		Case 11
			ProcedureReturn "; That should do the trick!"
		Case 12
			ProcedureReturn "; Copy paste from the internet..."
		Case 13
			ProcedureReturn "; Wrote this part while half asleep..."
		Case 14
			ProcedureReturn "; No other way to code this???"
		Case 15
			ProcedureReturn "; Ugh, my fingers hurt from typing!"
	EndSelect
EndProcedure

Procedure.s statement()
	Select Random(4)
		Case 0
			ProcedureReturn name() + " = " + math()
		Case 1
			ProcedureReturn name() + " = List[" + Random(9) + "]"
		Case 2
			ProcedureReturn name() + "[" + Random(9) + "] = " + math()
		Case 3
			ProcedureReturn "Print " + math()
		Case 4
			ProcedureReturn "Call " + name() + "(" + sequence(0, 1) + ")"
	EndSelect
EndProcedure

;################################================================--------------------------------

Global tabs

Procedure writeLine(line.s, allowComment = 1) ; EDIT: code changed by @Mr.L
   Global event
   
   If allowComment And Random(50) = 0
      line + " " + comment()
   EndIf
   Static lineCount = 0
   For i = 1 To tabs
      line = "|   " + line
   Next
   
   If lineCount = #maxline
      RemoveGadgetItem(0, 0)
   Else
      lineCount + 1
   EndIf
   
   pos = Len(line) - tabs * 4
   AddGadgetItem(0, lineCount - 1, "")
   
   While event <> #PB_Event_CloseWindow And pos >= 0
      SetGadgetItemText(0, lineCount - 1, Left(line, Len(line) - pos))
      pos - 1
      event = WaitWindowEvent()
      Delay(Random(50,5))
   Wend
EndProcedure

writeLine("; Code by: TheAutomator.") ; write first comment

;################################================================--------------------------------

Global newline

Global position
Global goal

Procedure.s selectBlock(nest)
	If nest
		position + 1
		AddElement(stack())
		stack()\type = "select"
		If newline
			stack()\iteration = 1
			newline = 0
		EndIf
	EndIf
	Select stack()\iteration
		Case 0
			writeLine("", 0)
			newline = 1
			stack()\iteration + 1
			ProcedureReturn "select"
		Case 1
			writeLine("Select " + math())
			tabs + 2
			stack()\iteration + 1
			ProcedureReturn "select"
		Case 2
			tabs - 1
			writeLine("Case " + sequence(1, 1))
			tabs + 1
			stack()\iteration + Random(2)
		Case 3
			tabs - 1
			writeLine("CaseElse")
			tabs + 1
			stack()\iteration + 1
		Case 4
			position - 1
			tabs - 2
			writeLine("EndSelect")
			stack()\iteration + 1
			ProcedureReturn "select"
		Case 5
			DeleteElement(stack())
			writeLine("", 0)
			newline = 1
	EndSelect
EndProcedure

Procedure.s repeatBlock(nest)
	If nest
		position + 1
		AddElement(stack())
		stack()\type = "repeat"
		If newline
			stack()\iteration = 1
			newline = 0
		EndIf
	EndIf
	Select stack()\iteration
		Case 0
			writeLine("", 0)
			newline = 1
			stack()\iteration + 1
			ProcedureReturn "repeat"
		Case 1
			writeLine("Repeat")
			tabs + 1
			stack()\iteration + 1
		Case 2
			position - 1
			tabs - 1
			writeLine("Until " + math())
			stack()\iteration + 1
			ProcedureReturn "repeat"
		Case 3
			DeleteElement(stack())
			writeLine("", 0)
			newline = 1
	EndSelect
EndProcedure

Procedure.s whileBlock(nest)
	If nest
		position + 1
		AddElement(stack())
		stack()\type = "while"
		If newline
			stack()\iteration = 1
			newline = 0
		EndIf
	EndIf
	Select stack()\iteration
		Case 0
			writeLine("", 0)
			newline = 1
			stack()\iteration + 1
			ProcedureReturn "while"
		Case 1
			writeLine("While " + math())
			tabs + 1
			stack()\iteration + 1
		Case 2
			position - 1
			tabs - 1
			writeLine("WEnd")
			stack()\iteration + 1
			ProcedureReturn "while"
		Case 3
			DeleteElement(stack())
			writeLine("", 0)
			newline = 1
	EndSelect
EndProcedure

Procedure.s forBlock(nest)
	If nest
		position + 1
		AddElement(stack())
		stack()\type = "for"
		If newline
			stack()\iteration = 1
			newline = 0
		EndIf
	EndIf
	Select stack()\iteration
		Case 0
			writeLine("", 0)
			newline = 1
			stack()\iteration + 1
			ProcedureReturn "for"
		Case 1
			Define temp.s
			If Random(4) = 0
				temp + " Step " + optionalNegate()
			EndIf
			writeLine("For " + name() + " = " + optionalNegate() + " To " + optionalNegate() + temp)
			tabs + 1
			stack()\iteration + 1
		Case 2
			position - 1
			tabs - 1
			writeLine("Next")
			stack()\iteration + 1
			ProcedureReturn "for"
		Case 3
			DeleteElement(stack())
			writeLine("", 0)
			newline = 1
	EndSelect
EndProcedure

Procedure.s ifBlock(nest)
	If nest
		position + 1
		AddElement(stack())
		stack()\type = "if"
		If newline
			stack()\iteration = 1
			newline = 0
		EndIf
	EndIf
	Select stack()\iteration
		Case 0
			writeLine("", 0)
			newline = 1
			stack()\iteration + 1
			ProcedureReturn "if"
		Case 1
			writeLine("If " + math() + " Then")
			tabs + 1
			stack()\iteration + Random(3,1)
		Case 2
			tabs - 1
			writeLine("ElseIf " + math() + " Then")
			tabs + 1
			stack()\iteration + Random(2)
		Case 3
			tabs - 1
			writeLine("Else")
			tabs + 1
			stack()\iteration + 1
		Case 4
			position - 1
			tabs - 1
			writeLine("EndIf")
			stack()\iteration + 1
			ProcedureReturn "if"
		Case 5
			DeleteElement(stack())
			writeLine("", 0)
			newline = 1
	EndSelect
EndProcedure

Procedure.s functionBlock(nest)
	If nest
		position + 1
		AddElement(stack())
		stack()\type = "function"
		If newline
			stack()\iteration = 1
			newline = 0
		EndIf
	EndIf
	Select stack()\iteration
		Case 0
			writeLine("", 0)
			newline = 1
			stack()\iteration + 1
			ProcedureReturn "function"
		Case 1
			writeLine("Function " + name() + "(" + sequence(0, 0) + ")")
			tabs + 1
			stack()\iteration + 1
		Case 2
			position - 1
			tabs - 1
			writeLine("EndFunction")
			stack()\iteration + 1
			ProcedureReturn "function"
		Case 3
			DeleteElement(stack())
			writeLine("", 0)
			newline = 1
	EndSelect
EndProcedure

Procedure blockStatement(); returns true if succes
	If ListSize(stack()) > 0 And Random(9) = 0
		SelectElement(stack(), Random(ListSize(stack())-1))
		Define stmt.s
		Select stack()\type
			Case "function"
				If Random(1)
					stmt = "Return " + math()
				Else
					stmt = "Return"
				EndIf
			Case "repeat"
				stmt = "ExitRepeat"
			Case "while"
				stmt = "ExitWhile"
			Case "for"
				stmt = "ExitFor"
		EndSelect
		LastElement(stack())
		If stmt <> ""
			newline = 0
			writeLine(stmt)
			ProcedureReturn 1
		EndIf
	EndIf
EndProcedure

;################################================================--------------------------------

Procedure.s CODE()
	Static save.s
	
	Select save
		Case "function"
			save = functionBlock(0)
			ProcedureReturn
		Case "select"
			save = selectBlock(0)
			ProcedureReturn
		Case "repeat"
			save = repeatBlock(0)
			ProcedureReturn
		Case "while"
			save = whileBlock(0)
			ProcedureReturn
		Case "if"
			save = ifBlock(0)
			ProcedureReturn
		Case "for"
			save = forBlock(0)
			ProcedureReturn
	EndSelect
	
	If Random(50) = 0
		writeLine(comment(), 0)
		ProcedureReturn
	EndIf
	
	If blockStatement()
		ProcedureReturn
	ElseIf Random(2)
		writeLine(statement())
		newline = 0
		ProcedureReturn
	EndIf
	
	If position = goal
		goal = Random(3,1)
	EndIf
	nest = Bool(goal > position)
	
	If nest
		Select Random(5, Bool(ListSize(stack()) > 0))
			Case 0
				save = "function"
			Case 1
				save = "select"
			Case 2
				save = "repeat"
			Case 3
				save = "while"
			Case 4
				save = "if"
			Case 5
				save = "for"
		EndSelect
	Else
		save = stack()\type
	EndIf
	Select save
		Case "function"
			save = functionBlock(nest)
		Case "select"
			save = selectBlock(nest)
		Case "repeat"
			save = repeatBlock(nest)
		Case "while"
			save = whileBlock(nest)
		Case "if"
			save = ifBlock(nest)
		Case "for"
			save = forBlock(nest)
	EndSelect
EndProcedure

;################################================================--------------------------------

Repeat
	event = WaitWindowEvent()
	If event = #PB_Event_Timer
		CODE() ; lines to long problem, makes GUI flicker! (need to solve this) also how to get rid of scrollbar??
	EndIf
Until event = #PB_Event_CloseWindow

firace · Post by **firace** » Mon Jan 04, 2021 11:36 am

Haha very nicely done!

Minor suggestions:
- In PB there are no [] - use () instead
- "CaseElse" is "Default"

The funny thing is I had the exact same idea a just a couple days ago, but didn't have time to try implementing it...

TheAutomator · Post by **TheAutomator** » Mon Jan 04, 2021 1:54 pm

Thanks :)
I used a self invented syntax for this one, but you are free to make / post a PB version or your own version if you like :)

Why did i use my own language? Because it makes the code "plausible".
PB doesn't have variants and the option to re-declare functions with the same names etc... so the code would be full of errors in reality that way.
It would also be very complex to implement the full syntax of PB (need to declare every var with type etc..).

Also: updated the code to have 'for' loops and 'exit loops' and 'returns' inside code blocks only if they are possible in that block.

Mr.L · Post by **Mr.L** » Mon Jan 04, 2021 3:38 pm

Thank you, that's really funny

I edited the writeLine Procedure to make it look a bit more "natural":

Code: Select all

Procedure writeLine(line.s, allowComment = 1)
	Global event
	
	If allowComment And Random(50) = 0
		line + " " + comment()
	EndIf
	Static lineCount = 0
	For i = 1 To tabs
		line = "|   " + line
	Next
	
	If lineCount = #maxline
		RemoveGadgetItem(0, 0)
	Else
		lineCount + 1
	EndIf
	
	pos = Len(line) - tabs * 4
	AddGadgetItem(0, lineCount - 1, "")
	
	While event <> #PB_Event_CloseWindow And pos >= 0
		SetGadgetItemText(0, lineCount - 1, Left(line, Len(line) - pos))
		pos - 1
		event = WaitWindowEvent()
		Delay(Random(50,5))
	Wend
EndProcedure

Kwai chang caine · Post by **Kwai chang caine** » Mon Jan 04, 2021 3:39 pm

Works here

Thanks for sharing

skywalk · Post by **skywalk** » Mon Jan 04, 2021 4:02 pm

If only I could code that fast

skywalk · Post by **skywalk** » Mon Jan 04, 2021 4:04 pm

Mr.L wrote:Thank you, that's really funny

I edited the writeLine Procedure to make it look a bit more "natural":

For a more natural look, please add some backspacing and deletions and scrolling up and down.

TheAutomator · Post by **TheAutomator** » Tue Jan 05, 2021 1:37 pm

@Mr.L
Hahah, that gif is spot on! XD
Added your edit to the code ;)
I made a text based game a while ago in the autoit language like that, where the typing by the computer looks very realistic.
I'm gonna try to get rid of the windowtimer and do everything with delays maybe..
A "AppendText()" function for edit controls would be nice for PB!

@skywalk
I know it's more of a joke but yeah, maybe I'm gonna make it look more natural later on. :p
the backspaces are a plausible idea actually. Typing random letters once and awhile and then backspacing it a few seconds later.

@Kwai chang caine
No problem, i wanted to code this for a while now and i just had to share it, never saw it before excerpt for a few tester software's and this site:
https://www.cs.bgu.ac.il/~arielbar/sl/#/main

Any other edits or suggestions for optimizing / cleaning the code are always welcome, I learn a lot every time I see a different approach from you guys :)
maybe I'll make a screensaver out of this :p

I'm having some issues with the scrollbar popping up every time the text would hit the last line.
Also want to get rid of the ugly border of the edit control without having to stretch the edit out of the borders of the window.

Thanks for the feedback everyone!

Lunasole · Post by **Lunasole** » Thu Jan 07, 2021 12:49 am

Haha, great to run it and show all around what a super-mega-nuclear coder you are

I'd like to make a screensaver like this

PureBasic Forums - English

Just posting some random code here...

Just posting some random code here...

Re: Just posting some random code here...

Re: Just posting some random code here...

Re: Just posting some random code here...

Re: Just posting some random code here...

Re: Just posting some random code here...

Re: Just posting some random code here...

Re: Just posting some random code here...

Re: Just posting some random code here...