Microsoft Small Basic

Program Listing: TZQ849

List Program

'Author: Marco Garcia.
'Comments: Marco Garcia.
'Strategie: Analysis the program step by step and comment any step. After this synthesis of analysis program and wrote abstrac.
'Abstract:This is a simple Celullar Automaton with minimal rules of behavior in one dimension.
'Program inspired in work exposed in : http://www.enelnombredetux.com/project.php?project=autcel
'And article exposed in: http://es.wikipedia.org/wiki/Aut%C3%B3mata_celular
'Inspire from code of: http://rosettacode.org/wiki/One-dimensional_cellular_automata#BASIC
'--------------------------------------------------------------------------------------------------
'Draw world 1D.
'Draw cells, initial state
TextWindow.Title = "Linear Cellular Automaton or LCA II."
TextWindow.ForegroundColor = "Red"
TextWindow.WriteLine("I hope you enjoy it with this simulation of A.Life")
InitialState = "000101001"
Cicles = 9
result = 0
Temp1 = 0
Temp2 = 0
Temp3 = 0
'Rule1
A = "000"
B = "101"
C = "010"
D = "111"
'Rule2
E ="001"
F ="100"
G ="110"
H ="011"

'Start 10 cicle of read initial cellular state, apply a simple rules of 1D world-cells
For i = 0 To Cicles - 1
TextWindow.WriteLine("Generation " + i + ":" + InitialState)'Initial state
RulesOfLife()'Apply rules
InitialState = result'Change inner InitialState by result
EndFor
'Rules of the live in a subroutine.
Sub RulesOfLife
'First chain of characters with first rule.
If Temp1 = Text.GetSubText(InitialState, 1, 3) and Temp1 = A then
Temp3 = "010"
Temp2 = Text.GetSubText(InitialState, 4, 6)
result = Text.Append(Temp3,Temp2)
EndIf
If Temp1 = Text.GetSubText(InitialState, 1, 3) and Temp1 = B then
Temp3 = "111"
Temp2 = Text.GetSubText(InitialState, 4, 6)
result = Text.Append(Temp3,Temp2)
EndIf
If Temp1 = Text.GetSubText(InitialState, 1, 3) and Temp1 = C then
Temp3 = "000"
Temp2 = Text.GetSubText(InitialState, 4, 6)
result = Text.Append(Temp3,Temp2)
EndIf
If Temp1 = Text.GetSubText(InitialState, 1, 3) and Temp1 = D then
Temp3 = "111"
Temp2 = Text.GetSubText(InitialState, 4, 6)
result = Text.Append(Temp3,Temp2)
EndIf
'2º rules for first chain of charactrs.
If Temp1 = Text.GetSubText(InitialState, 1, 3) and Temp1 = E then
Temp3 = "001"
Temp2 = Text.GetSubText(InitialState, 4, 6)
result = Text.Append(Temp3,Temp2)
EndIf
If Temp1 = Text.GetSubText(InitialState, 1, 3) and Temp1 = F then
Temp3 = "100"
Temp2 = Text.GetSubText(InitialState, 4, 6)
result = Text.Append(Temp3,Temp2)
EndIf
If Temp1 = Text.GetSubText(InitialState, 1, 3) and Temp1 = G then
Temp3 = "110"
Temp2 = Text.GetSubText(InitialState, 4, 6)
result = Text.Append(Temp3,Temp2)
EndIf
If Temp1 = Text.GetSubText(InitialState, 1, 3) and Temp1 = H then
Temp3 = "011"
Temp2 = Text.GetSubText(InitialState, 4, 6)
result = Text.Append(Temp3,Temp2)
EndIf
'-----------------------------------------------------------------------------------------------------
'Second chain of characters with first rule.
If Temp1 = Text.GetSubText(InitialState, 4, 3) and Temp1 = A then
Temp3 = "010"
Temp2 = Text.GetSubText(InitialState, 1, 3)
resultChain1 = Text.Append(Temp2,Temp3)
FInalCHain = Text.GetSubText(InitialState, 6, 3)
resultChain2 = Text.Append(resultChain1,FInalCHain)
result =resultChain2
EndIf
If Temp1 = Text.GetSubText(InitialState, 4, 3) and Temp1 = B then
Temp3 = "111"
Temp2 = Text.GetSubText(InitialState, 4, 3)
resultChain1 = Text.Append(Temp2,Temp3)
FInalCHain = Text.GetSubText(InitialState, 6, 3)
resultChain2 = Text.Append(resultChain1,FInalCHain)
result =resultChain2
EndIf
If Temp1 = Text.GetSubText(InitialState, 4, 3) and Temp1 = C then
Temp3 = 010
Temp2 = Text.GetSubText(InitialState, 1, 3)
resultChain1 = Text.Append(Temp2,Temp3)
FInalCHain = Text.GetSubText(InitialState, 6, 3)
resultChain2 = Text.Append(resultChain1,FInalCHain)
result =resultChain2
EndIf
If Temp1 = Text.GetSubText(InitialState, 4, 3) and Temp1 = D then
Temp3 = "111"
Temp2 = Text.GetSubText(InitialState, 1, 3)
resultChain1 = Text.Append(Temp2,Temp3)
FInalCHain = Text.GetSubText(InitialState, 6, 3)
resultChain2 = Text.Append(resultChain1,FInalCHain)
result =resultChain2
EndIf
'2º rules for second chain of charactrs.
If Temp1 = Text.GetSubText(InitialState, 4, 3) and Temp1 = E then
Temp3 = "001"
Temp2 = Text.GetSubText(InitialState, 1, 3)
resultChain1 = Text.Append(Temp2,Temp3)
FInalCHain = Text.GetSubText(InitialState, 6, 3)
resultChain2 = Text.Append(resultChain1,FInalCHain)
result =resultChain2
EndIf
If Temp1 = Text.GetSubText(InitialState, 4, 3) and Temp1 = F then
Temp3 = "100"
Temp2 = Text.GetSubText(InitialState, 1, 3)
resultChain1 = Text.Append(Temp2,Temp3)
FInalCHain = Text.GetSubText(InitialState, 6, 3)
resultChain2 = Text.Append(resultChain1,FInalCHain)
result =resultChain2
EndIf
If Temp1 = Text.GetSubText(InitialState, 4, 3) and Temp1 = G then
Temp3 = "110"
Temp2 = Text.GetSubText(InitialState, 1, 3)
resultChain1 = Text.Append(Temp2,Temp3)
FInalCHain = Text.GetSubText(InitialState, 6, 3)
resultChain2 = Text.Append(resultChain1,FInalCHain)
result =resultChain2
EndIf
If Temp1 = Text.GetSubText(InitialState, 4, 3) and Temp1 = H then
Temp3 = "011"
Temp2 = Text.GetSubText(InitialState, 1, 3)
resultChain1 = Text.Append(Temp2,Temp3)
FInalCHain = Text.GetSubText(InitialState, 6, 3)
resultChain2 = Text.Append(resultChain1,FInalCHain)
result =resultChain2
EndIf
'-----------------------------------------------------------------------------------------------------
'-----------------------------------------------------------------------------------------------------
'Thirts chain of characters with first rule.
If Temp1 = Text.GetSubText(InitialState, 6, 3) and Temp1 = A then
Temp3 = "010"
Temp2 = Text.GetSubText(InitialState, 6, 3)
resultChain1 = Text.Append(Temp2,Temp3)
FInalCHain = Text.GetSubText(InitialState, 6, 3)
resultChain2 = Text.Append(resultChain1,FInalCHain)
result =resultChain2
EndIf
If Temp1 = Text.GetSubText(InitialState, 6, 3) and Temp1 = B then
Temp3 = "111"
Temp2 = Text.GetSubText(InitialState, 6, 3)
resultChain1 = Text.Append(Temp2,Temp3)
FInalCHain = Text.GetSubText(InitialState, 6, 3)
resultChain2 = Text.Append(resultChain1,FInalCHain)
result =resultChain2
EndIf
If Temp1 = Text.GetSubText(InitialState, 6, 3) and Temp1 = C then
Temp3 = 010
Temp2 = Text.GetSubText(InitialState, 6, 3)
resultChain1 = Text.Append(Temp2,Temp3)
FInalCHain = Text.GetSubText(InitialState, 6, 3)
resultChain2 = Text.Append(resultChain1,FInalCHain)
result =resultChain2
EndIf
If Temp1 = Text.GetSubText(InitialState, 6, 3) and Temp1 = D then
Temp3 = "111"
Temp2 = Text.GetSubText(InitialState, 6, 3)
resultChain1 = Text.Append(Temp2,Temp3)
FInalCHain = Text.GetSubText(InitialState, 6, 3)
resultChain2 = Text.Append(resultChain1,FInalCHain)
result =resultChain2
EndIf
'2º rules for second chain of charactrs.
If Temp1 = Text.GetSubText(InitialState, 6, 3) and Temp1 = E then
Temp3 = "001"
Temp2 = Text.GetSubText(InitialState, 6, 3)
resultChain1 = Text.Append(Temp2,Temp3)
FInalCHain = Text.GetSubText(InitialState, 6, 3)
resultChain2 = Text.Append(resultChain1,FInalCHain)
result =resultChain2
EndIf
If Temp1 = Text.GetSubText(InitialState, 6, 3) and Temp1 = F then
Temp3 = "100"
Temp2 = Text.GetSubText(InitialState, 1, 3)
resultChain1 = Text.Append(Temp2,Temp3)
FInalCHain = Text.GetSubText(InitialState, 6, 3)
resultChain2 = Text.Append(resultChain1,FInalCHain)
result =resultChain2
EndIf
If Temp1 = Text.GetSubText(InitialState, 6, 3) and Temp1 = G then
Temp2 = Text.GetSubText(InitialState, 6, 3)
resultChain1 = Text.Append(Temp2,Temp3)
FInalCHain = Text.GetSubText(InitialState, 6, 3)
resultChain2 = Text.Append(resultChain1,FInalCHain)
result =resultChain2
EndIf
If Temp1 = Text.GetSubText(InitialState, 4, 3) and Temp1 = H then
Temp3 = "011"
Temp2 = Text.GetSubText(InitialState, 6, 3)
resultChain1 = Text.Append(Temp2,Temp3)
FInalCHain = Text.GetSubText(InitialState, 6, 3)
resultChain2 = Text.Append(resultChain1,FInalCHain)
result =resultChain2
EndIf
EndSub
'-----------------------------------------------------------------------------------------------
'Draw a canvas with translation binary values to row of colour boxes.
GraphicsWindow.Show()
GraphicsWindow.Title = "Linear Cellular Automaton or LCA II."
long = Text.GetLength(result)
Row = Cicles
Columns = long
tamano= 40
S = S + 1
GraphicsWindow.BackgroundColor= "Yellow"
For f = 1 To Row
For c = 1 to columns
For p = 1 To long
bin = Text.GetSubText(result,S, long - S)
ColorDecide()
cuadrados[f][c] = Shapes.AddRectangle (tamano, tamano)
Shapes.Move(cuadrados[f][c], c * tamano, f * tamano)
EndFor
EndFor
endfor

Sub ColorDecide
If bin = "0" Then
GraphicsWindow.BrushColor = "Black"
EndIf
If bin = "1" Then
GraphicsWindow.BrushColor = "Red"
EndIf
EndSub