Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Einfache Turingmaschine
| Uploader: |  Westbeam |
| Datum/Zeit: | 23.06.2012 19:47:45 |
'habe die Idee von dem heutigen Googledoodle(23. Juni 2012)
'Eine simple Turingmaschine, die das Programm "test.t" ausführt
'Kurze Erklärung:
'Es gibt 16 Felder, von denen jedes entweder den Wert 1 oder 0 hat
'Unten läuft ein Schreibkopf ^ vorbei, der die Felder beschreiben kann
'Der Schreibkopf wird über ein selbstgeschriebenes Programm gesteuert, welches die Datei "test.t" ist
'Hier eine kurze Befehlsreferenz:
'1 = Wert 1 in Feld schreiben
'0 = Wert 0 in Feld schreiben
'R = Schreibkopf ein Feld nach rechts bewegen
'L = Schreibkopf ein Feld nach links bewegen
'E = Ende des Programms
'Meine Turingmaschine funktioniert nicht ganz so wie die von Google, dennoch sollte sie genügen, um euch die Funktionsweise zu erklären
Screenres 640,480
Width 640/8, 480/16
Declare Sub ReadProgramm(file As String)
Dim Shared As String programm(255),tprogram(255)
Dim Shared As Integer ff,i2
Type Tspeicher
As Integer position
As Integer wert
End Type
Dim Shared As Integer sposition
sposition=0
Dim Shared As Tspeicher speicher(16)
For i As Integer=1 To 16
speicher(i).wert=0
Next
Dim Shared As Any Ptr sptr
sptr=ImageCreate(40,40)
Line sptr,(0,0)-(40,40),15,BF
Line sptr,(3,3)-(36,36),0,B
ReadProgramm("test.t")
ff=Freefile
Open "test.t" For Input As #ff
i2=1
Do
Line Input #ff,programm(i2)
If programm(i2)="1" Then
speicher(sposition).wert=1
ElseIf programm(i2)="0" Then
speicher(sposition).wert=0
ElseIf programm(i2)="R" Then
sposition+=1
ElseIf programm(i2)="L" Then
sposition-=1
ElseIf programm(i2)="E" Then
Color 4
Draw String (130,40),"Ende des Programms, beliebige Taste druecken"
Getkey
End
End If
Sleep 400,1
i2+=1
Screenlock
Cls
Line (0,0)-(640,480),15,BF
For i As Integer=0 To 16
Put (2+i*40,230),sptr,Pset
Color 0
Draw String (19+i*40,242),Str(speicher(i).wert)
Next
Color 0,15
Draw String (19+sposition*40,270),"^"
Color 0,15
For i As Integer=1 To 255
Print tprogram(i)+" ";
Next
Draw String ((i2-1)*16,16),"^"
Screenunlock
Loop Until Inkey=Chr(27)
Close #ff
End
Sub ReadProgramm(file As String)
Var fff=FreeFile
Open file For Input As #fff
For i3 As Integer=1 To 255
Line Input #fff,tprogram(i3)
Next
Close #fff
End Sub