78 lines
2.1 KiB
Plaintext
78 lines
2.1 KiB
Plaintext
' Rosetta Code problem: https://rosettacode.org/wiki/Execute_SNUSP
|
|
' by Jjuanhdez, 05/2024
|
|
' The interpreter below implements Core SNUSP:
|
|
|
|
Const HW = "/++++!/===========?\>++.>+.+++++++..+++" & Chr(10) & _
|
|
"\+++\ | /+>+++++++>/ /++++++++++<<.++>./" & Chr(10) & _
|
|
"$+++/ | \+++++++++>\ \+++++.>.+++.-----\" & Chr(10) & _
|
|
" \==-<<<<+>+++/ /=.>.+>.--------.-/"
|
|
|
|
Dim Shared As Integer ipf, ipc ' instruction pointers in row and column
|
|
Dim Shared As Integer direcc ' direction (0 = right, 1 = down, 2 = left, 3 = up)
|
|
|
|
Sub Paso()
|
|
If direcc And 1 Then
|
|
ipf += 1 - (direcc And 2)
|
|
Else
|
|
ipc += 1 - (direcc And 2)
|
|
End If
|
|
End Sub
|
|
|
|
Sub SNUSP (dsLen As Integer, SNUSPcode As String)
|
|
Dim As Ubyte ad(dsLen - 1) ' data store
|
|
Dim As Integer dp ' data pointer
|
|
Dim As String cb(dsLen) ' two-way code storage
|
|
Dim As String fila, op, linea
|
|
Dim As Integer r, i, j
|
|
|
|
dp = 0
|
|
i = 1
|
|
j = 1
|
|
ipf = 0
|
|
ipc = 0
|
|
direcc = 0
|
|
|
|
While i <= Len(SNUSPcode)
|
|
If Mid(SNUSPcode, i, 1) = Chr(10) Then
|
|
cb(j) = linea
|
|
linea = ""
|
|
j += 1
|
|
Else
|
|
linea &= Mid(SNUSPcode, i, 1)
|
|
End If
|
|
i += 1
|
|
Wend
|
|
cb(j) = linea
|
|
|
|
For r = 0 To Ubound(cb)
|
|
fila = cb(r)
|
|
ipc = Instr(fila, "$") - 1
|
|
If ipc >= 0 Then
|
|
ipf = r
|
|
Exit For
|
|
End If
|
|
Next r
|
|
|
|
While ipf >= 0 And ipf <= Ubound(cb) And ipc >= 0 And ipc < Len(cb(ipf))
|
|
op = Mid(cb(ipf), ipc + 1, 1)
|
|
Select Case op
|
|
Case ">": dp += 1 ' RIGTH
|
|
Case "<": dp -= 1 ' LEFT
|
|
Case "+": ad(dp) += 1 ' INCR
|
|
Case "-": ad(dp) -= 1 ' DECR
|
|
Case ",": Input ad(dp) ' READ
|
|
Case ".": Print Chr(ad(dp)); ' WRITE
|
|
Case "/": direcc = Not direcc ' RULD
|
|
Case "\": direcc Xor= 1 ' LURD
|
|
Case "!": Paso ' SKIP
|
|
Case "?": If ad(dp) = 0 Then Paso ' SKIPZ
|
|
End Select
|
|
Paso
|
|
Wend
|
|
Print Chr(ad(dp));
|
|
End Sub
|
|
|
|
SNUSP(5, HW)
|
|
|
|
Sleep
|