It is currently Tue Mar 09, 2021 9:57 am

All times are UTC + 1 hour




Post new topic Reply to topic  [ 9 posts ] 
Author Message
 Post subject: Just posting some random code here...
PostPosted: Mon Jan 04, 2021 2:49 am 
Offline
User
User
User avatar

Joined: Tue Dec 01, 2020 8:33 pm
Posts: 92
Let's make the computer write it's own code for once! :D
Code:
#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


Last edited by TheAutomator on Tue Jan 05, 2021 1:14 pm, edited 2 times in total.

Top
 Profile  
Reply with quote  
 Post subject: Re: Just posting some random code here...
PostPosted: Mon Jan 04, 2021 11:36 am 
Offline
Enthusiast
Enthusiast

Joined: Wed Nov 09, 2011 8:58 am
Posts: 638
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...

_________________
My new project: A simple HTML/CSS UI engine for PB desktop apps
viewtopic.php?f=7&t=74582


Top
 Profile  
Reply with quote  
 Post subject: Re: Just posting some random code here...
PostPosted: Mon Jan 04, 2021 1:54 pm 
Offline
User
User
User avatar

Joined: Tue Dec 01, 2020 8:33 pm
Posts: 92
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.


Top
 Profile  
Reply with quote  
 Post subject: Re: Just posting some random code here...
PostPosted: Mon Jan 04, 2021 3:38 pm 
Offline
User
User

Joined: Sun Oct 09, 2011 7:39 am
Posts: 47
Thank you, that's really funny :lol:

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

Code:
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


Image


Top
 Profile  
Reply with quote  
 Post subject: Re: Just posting some random code here...
PostPosted: Mon Jan 04, 2021 3:39 pm 
Offline
Addict
Addict
User avatar

Joined: Sun Nov 05, 2006 11:42 pm
Posts: 4876
Location: Lyon - France
Works here :D
Thanks for sharing 8)

_________________
ImageThe happiness is a road...
Not a destination


Top
 Profile  
Reply with quote  
 Post subject: Re: Just posting some random code here...
PostPosted: Mon Jan 04, 2021 4:02 pm 
Offline
Addict
Addict
User avatar

Joined: Wed Dec 23, 2009 10:14 pm
Posts: 3414
Location: Boston, MA
If only I could code that fast :mrgreen:

_________________
The nice thing about standards is there are so many to choose from. ~ Andrew Tanenbaum


Top
 Profile  
Reply with quote  
 Post subject: Re: Just posting some random code here...
PostPosted: Mon Jan 04, 2021 4:04 pm 
Offline
Addict
Addict
User avatar

Joined: Wed Dec 23, 2009 10:14 pm
Posts: 3414
Location: Boston, MA
Mr.L wrote:
Thank you, that's really funny :lol:

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. :idea:

_________________
The nice thing about standards is there are so many to choose from. ~ Andrew Tanenbaum


Top
 Profile  
Reply with quote  
 Post subject: Re: Just posting some random code here...
PostPosted: Tue Jan 05, 2021 1:37 pm 
Offline
User
User
User avatar

Joined: Tue Dec 01, 2020 8:33 pm
Posts: 92
@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!


Top
 Profile  
Reply with quote  
 Post subject: Re: Just posting some random code here...
PostPosted: Thu Jan 07, 2021 12:49 am 
Offline
Addict
Addict
User avatar

Joined: Mon Oct 26, 2015 2:55 am
Posts: 963
Location: UA
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

_________________
..


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 9 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 7 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye