[QUIZ#3] Alexander Schuc (Excel/VBScript)

[Alexander Schuc]

So,.. ich dachte mir ich setze die Quiz-Aufgabe mal zuerst in einer anderne Sprache um, und die Speicherzellen haben mich irgendwie an Excel erinnert.

Im Zip findet ihr eine Version für Excel 2007, und eine für frühere Versionen. Beim Speichern gabs allerdings ne Meldung, dass eine verwendete Funktion dort u.U. nicht funktioniert. Betrifft allerdings nur eine Darstellung, der Interpreter klappt.

Code ist evt. nicht der Beste.. Ewig nichts mehr mit VbScript gebastelt.

Übrigens.. ich widme diesen Code: Navy *mhwahaha*

Erläuterung:

Aufbau:

- Tabelle 1 (BrainScript) ist das UserInterface
Hier kann das BrainScript "geladen", sowie bereits Eingaben vorgenommen werden. Auch die Ausgabe ist hier zu sehen.

- Tabelle 2 (Memory) bildet den Speicher des Interpreters
Damit alles bei mir noch auf den Bildschirm passt, verwende ich 20 Spalten pro Reihe für den Speicher. Der Interpreter kann 2000 Zeilen verwenden. Sind also 40000 Speicherzellen.

- Tabelle 3 (ASCII) ist eine ASCII Ansicht des Speichers.
Hier werden über Formeln die Werte aus Tabelle 2 in ASCII Zeichen umgewandelt.

Arbeitsweise:

Der Interpreter wird mit Startwerten für die Startposition innerhalb des Scripts, Endposition und der aktuellen Speicherposition gestartet.

startIndex ist die Startposition, gibt also den ersten Befehl an.
endIndex gibt die letzte Position an.
mA steht für memory address und gibt die Speicherzelle an.

mA wird als Referenz übergeben, da bei Schleifen der Interpreter rekursiv aufgerufen wird, und nach den rekursiven Aufrufen, soll die veränderte Speicherposition verwendet werden.

Bei der eigentlichen Abarbeitung wird ein Zeichen aus dem Script entnommen, und eine entsprechende Aktion ausgeführt. Die Befehle +-<>., sind recht einfach. Hier wird einfach der Speicher oder die Speicherposition verändert.

Beim Einlesen eines Wertes vom Benutzer wird zuerst in der InputBox der ersten Tabelle nachgesehen. Sollte dort kein Text mehr vorhanden sein, kommt eine Eingabeaufforderung. Hier kann eine ganze Zeile eingegeben werden. Die derzeit nicht gebrauchten Werte, werden in die InputBox gespeichert. Wird nichts angegeben, wird eine 0 in den Speicher geschrieben.

Der Befehl [ lässt nach dem entsprechenden ] suchen, und ruft dann den Interpreter rekursiv mit neuen Start- und Endpositionen auf.

] setzt den ProgramCounter auf die startPosition zurück. (Bei Schleifen ist dies die Position des [)

Code:

Sub ResetMemory()

    BrainScript.OutputBox.value = ""
    
    With Memory.Range(Memory.Cells(1, 1), Memory.Cells(2000, 20))
        .value = 0
        .Interior.Color = RGB(255, 255, 255)
        .Font.Color = RGB(0, 0, 0)
    End With
    
    With ASCII.Range(ASCII.Cells(1, 1), ASCII.Cells(2000, 20))
        .Interior.Color = RGB(255, 255, 255)
        .Font.Color = RGB(0, 0, 0)
    End With
    

End Sub

Sub StartBrainScript()

    BrainScript.OutputBox.value = ""
    Call BrainScriptInterpreter(1, Len(BrainScript.ScriptBox.value) + 1, 1)

End Sub

Sub BrainScriptInterpreter(ByVal startIndex As Integer, ByVal endIndex As Integer, ByRef mA)

    Dim Script As String
    Dim PC As Long
    Dim curStatement As String
    
    Script = BrainScript.ScriptBox.value
    PC = startIndex

    If endIndex > Len(Script) + 1 Then
        endIndex = Len(Script) + 1
    End If
    
    While PC < endIndex
    
        curStatement = Mid(Script, PC, 1)
        
        Select Case curStatement
        
            Case "+"
                Call updateMemory(mA, 1)
                
            Case "-"
                Call updateMemory(mA, -1)
                
            Case ">"
                mA = updateMa(mA, 1)
                
            Case "<"
                mA = updateMa(mA, -1)
                
            Case "."
                Call printCell(mA)
            
            Case ","
                Call readChar(mA)
                
            Case "["
            
                If PC = startIndex Then
                    If getMemoryCell(mA).value = 0 Then
                        Exit Sub
                    End If
                Else
                    nEI = FindLoopEnd(PC)
                    Call BrainScriptInterpreter(PC, nEI + 1, mA)
                    PC = nEI
                End If
                
            
            Case "]"
            
                PC = startIndex - 1
            
        End Select
    
        PC = PC + 1
        
    Wend

End Sub



Sub readChar(address)

    Set cell = getMemoryCell(address)
    
    Line = BrainScript.InputBox.value
    
    If Len(Line) = 0 Then
        Line = InputBox("Eingabe", "Es werden Eingaben benötigt")
        BrainScript.InputBox.value = Line
    End If
    
    If Len(Line) = 0 Then
        cell.value = 0
        Exit Sub
        
    End If
    
    
    char = Left(Line, 1)
    cell.value = Asc(char)
    BrainScript.InputBox.value = Mid(Line, 2)

End Sub

Sub printCell(address)
    
    Set cell = getMemoryCell(address)
    c = Chr(cell.value)
    BrainScript.OutputBox.value = BrainScript.OutputBox.value + c
    

End Sub




Sub updateMemory(address, step)

    Dim value As Integer
    Set cell = getMemoryCell(address)

    value = CInt(cell.value)
    value = value + step
    
    If value < 0 Then
        value = 255
    End If
    
    If value > 255 Then
        value = 0
    End If
    
    Call SetMemoryCell(address, value)
     
End Sub

Function FindLoopEnd(start)

    Script = BrainScript.ScriptBox.value
    lstart = 0
    
    For i = (start + 1) To Len(Script)
        If Mid(Script, i, 1) = "[" Then
            lstart = lstart + 1
        ElseIf Mid(Script, i, 1) = "]" Then
            If lstart = 0 Then
                FindLoopEnd = i
                Exit Function
            Else
                lstart = lstart - 1
            End If
        End If
    Next i
    
    FindLoopEnd = -1

End Function

Sub SetMemoryCell(address, value)

    getMemoryCell(address).value = value

End Sub

Function updateMa(mA, step)

    newMa = mA + step
    
    If newMa < 1 Then
        newMa = 40000
    End If
    
    If newMa > 40000 Then
        newMa = 1
    End If
    
    getMemoryCell(newMa).Interior.Color = RGB(23, 23, 23)
    getMemoryCell(mA).Interior.Color = RGB(255, 255, 255)
    
    getMemoryCell(newMa).Font.Color = RGB(255, 255, 255)
    getMemoryCell(mA).Font.Color = RGB(0, 0, 0)
   
    getASCIICell(newMa).Interior.Color = RGB(23, 23, 23)
    getASCIICell(mA).Interior.Color = RGB(255, 255, 255)
    
    getASCIICell(newMa).Font.Color = RGB(255, 255, 255)
    getASCIICell(mA).Font.Color = RGB(0, 0, 0)
    
    updateMa = newMa

End Function

Function getMemoryCell(index)

    Dim row As Long
    Dim col As Long
    
    
    col = ((index - 1) Mod 20) + 1
    row = Int((index - 1) / 20) + 1
    
    If col = 0 Then col = 1
    
    Set cell = Memory.Cells(row, col)
    Set getMemoryCell = cell
    
End Function

Function getASCIICell(index)

    Dim row As Long
    Dim col As Long
    
    col = ((index - 1) Mod 20) + 1
    row = Int((index - 1) / 20) + 1
    
    If col = 0 Then col = 1
    
    Set cell = ASCII.Cells(row, col)
    Set getASCIICell = cell
    
End Function

 

[Navy]

Ich hasse Dich! Ernsthaft und leidenschaftslos.
Mögen Dir die M$-Lizenzbedingungen ausgedruckt per Post zugesand werden...!

 

[Alexander Schuc]

Mwahaha..

Hab ich gern gemacht.