Add Grin language

grin/grin.txt

@@ -0,0 +1,64 @@
+Grin has 48 commands. It has a tape size of 2^63 and programs can be up to 2^63 commands. 
+All values are 64-bit floating points.
+
+By default, grin.exe runs code.txt. Drag and drop any file onto it to parse it.
+
+It works very similarly to BrainFuck - simply replace the "+"s with "}"s and the "-"s 
+with "{"s and you'll get a working program. MathFuck adds a single value register and
+utilizes it to allow easier arithmatic than in BrainFuck. # marks the beginning and end
+of a comment.
+
+
+
+
+Commands:
+
+>	shift memory cell right
+<	shift memory cell left
+.	output the content of this memory cell as an ASCII character
+:	output the content of this cell as a number.
+,	set this memory cell's value to the ASCII value of input
+;	set this memory cell's value to a number inputted
+'	output the register as an ASCII character
+"	output the register as a number
++	add this memory cell to the value in the register and put the answer in this memory cell
+-	subtract the value in the register from the value in this memory cell
+*	multiply this memory cell by the value in the register
+/	divide this memory cell by the value in the register
+^	raise this memory cell to the exponent in the register
+$	store the current memory cell in the register
+\	store the value that's in the register in the current memory cell
+~	swap the value in the register and the current memory cell
+=	set the register to 0
+_	set the memory cell under the pointer to 0
+%	current memory cell is modulo'd by the value in the register
+r	round the memory cell to the nearest integer
+&	perform a logical NAND on the memory cell and the register
+|	perform a logical OR on the memory cell and the register
+!	perform a logical NOT on the memory cell
+@	Negate the memory cell under the pointer
+[	jump past the matching ] if the current memory cell is <= 0
+]	jump back to the matching [
+?	If the cell under the pointer is >0 it becomes 1 and if it's <0 it becomes -1
+}	increment the memory cell under the pointer by 1
+{	decrement the memory cell under the pointer by 1
+(	print all characters up to the next ) to the console
+)	print a newline
+s	put the sine of the number in the current memory cell in the current memory cell
+c	calculate the cosine of the current memory cell
+t	calculate the tangent of the current memory cell
+S	calculate the arcsine of the current memory cell
+C	calculate arccos
+T	calculate arctan
+1	divides 1 by the current memory cell and places it there
+2	performs modulo 2 on the current memory cell
+e	sets the current cell's value to e
+p	sets the current cell's value to pi
+l	takes the natural log of the current cell and stores it there
+m	stores the arithmatic mean of the current cell and the register in this cell
+q	takes the square root of the current memory cell and places it there
+L	takes the log of the current cell using the register as the base and puts it in the cell
+j	if the register is >0 the program skips the number of instructions specified by the register, if a decimal is specified the number is rounded down
+D	toggles following trigonometric functions to operate on degrees or radians; degrees is the default
+`	end the program
+#	starts and ends a comment

grin/impl/code.txt

@@ -0,0 +1,2 @@
+# Your code goes here. #
+

grin/impl/source.bmx

@@ -0,0 +1,217 @@
+SuperStrict
+Framework brl.standardio
+Import brl.blitz
+Import brl.filesystem
+Import brl.stream
+Import brl.retro
+Import brl.math
+
+
+
+
+Global path$="code.txt"
+If AppArgs.length>1 Then
+	Local ona%=0
+	For Local a$=EachIn AppArgs
+		ona:+1
+		If ona=2 Then path=a
+	Next
+EndIf
+
+
+
+Global code@[1]
+
+Local fil:TStream=ReadFile(path)
+If Not fil Print "Could not load "+path;Input;End
+
+Global size:long=1
+Global cmds$="><.:,;'~q+-*/^$\~~=%sctSCT12r&|!@[]?}{()`_eplmqLjD"
+Global ends%=0
+Global inparen%=0
+Global comment%=0
+Repeat
+	Local b$=Chr(ReadByte(fil))
+	If (Instr(cmds,b) Or inparen) And comment=0
+		If b="(" inparen=1
+		If b=")" inparen=0
+		code=code[..size+1]
+		code[size-1]=Asc(b)
+		If b="_" ends=1
+		size:+1
+	ElseIf b="#"
+		comment=Not comment
+	EndIf
+Until Eof(fil)
+
+
+Print "Executing program."
+Print ""
+
+
+
+Global memory:Double[64],msize%=64
+Global mmod%=0
+Function get:Double(x:Long)
+	If x+mmod<0 Then 
+		mmod=-x;memory=memory[..msize+mmod]
+		For Local rsize%=0 To msize+mmod-2
+			memory[msize+mmod-1-rsize]=memory[msize+mmod-2-rsize]
+		Next
+		memory[0]=0
+	EndIf
+	If x=>msize Then msize:+1;memory=memory[..msize+mmod]
+	If x+mmod<0
+		Print msize+mmod
+		Print x+mmod
+	EndIf
+	Return memory[x+mmod]
+End Function
+Function set(x:Long,s:Double)
+	get x
+	memory[x+mmod]=s
+End Function
+
+
+Global degrees%=1
+Global pos:Long=0
+Global mem:Long=0
+Global reg:Double=0
+Global skips%=0
+Repeat
+	If pos=>size Then Exit
+	'Print Chr(code[pos])
+	If skips=0
+		Select Chr(code[pos])
+			Case ">" mem:+1
+			Case "<" mem:-1
+			Case "+" set(mem,get(mem)+reg)
+			Case "-" set(mem,get(mem)-reg)
+			Case "*" set(mem,get(mem)*reg)
+			Case "/" set(mem,get(mem)/reg)
+			Case "^" set(mem,get(mem)^reg)
+			Case "%" set(mem,get(mem) Mod reg)
+			Case "r" set(mem,round(get(mem)))
+			Case "$" reg=get(mem)
+			Case "\" set(mem,reg)
+			Case "~~"Local tmp:Double=reg;reg=get(mem);set(mem,tmp)
+			Case "=" reg=0
+			Case "&" set(mem,lnand(get(mem),reg))
+			Case "|" set(mem,lor(get(mem),reg))
+			Case "!" set(mem,lnot(get(mem)))
+			Case "@" set(mem,-get(mem))
+			Case "." WriteStdout Chr(get(mem))
+			Case ":" WriteStdout get(mem)
+			Case "," set(mem,Asc(Input()))
+			Case ";" set(mem,Double(Input()))
+			Case "'" WriteStdout Chr(reg)
+			Case "~q"WriteStdout reg
+			Case "[" If get(mem)<=0 Then pos=match(pos,"[","]",1)
+			Case "]" pos=match(pos,"]","[",-1)-1
+			Case "?" set(mem,sign(get(mem)))
+			Case "}" set(mem,get(mem)+1)
+			Case "{" set(mem,get(mem)-1)
+			Case "(" Local f:Long=match(pos,"",")",1);writeparen pos,f;pos=f
+			Case ")" Print ""
+			Case "s" set(mem,Sin(deg(get(mem))))
+			Case "c" set(mem,Cos(deg(get(mem))))
+			Case "t" set(mem,Tan(deg(get(mem))))
+			Case "S" set(mem,ASin(deg(get(mem))))
+			Case "C" set(mem,ACos(deg(get(mem))))
+			Case "T" set(mem,ATan(deg(get(mem))))
+			Case "1" set(mem,Double(1)/get(mem))
+			Case "2" set(mem,get(mem) Mod 2)
+			Case "e" set(mem,e())
+			Case "p" set(mem,Pi)
+			Case "l" set(mem,Log10(get(mem)))
+			Case "L" set(mem,Logbx(get(mem),reg))
+			Case "m" set(mem,(get(mem)+reg)/Double(2))
+			Case "q" set(mem,get(mem)^(1/reg))
+			Case "D" degrees=Not degrees
+			Case "j" If reg>0 skips=Floor(reg)
+			Case "_" set(mem,0)
+			Case "`" Exit
+		End Select
+	Else
+		skips:-1
+		Select Chr(code[pos])
+			Case "[" If get(mem)<=0 Then pos=match(pos,"[","]",1)
+			Case "]" pos=match(pos,"]","[",-1)-1
+			Case "(" Local f:Long=match(pos,"",")",1);pos=f
+		End Select
+	EndIf
+'	Print get(mem)
+	pos:+1
+Forever
+
+
+Print " "
+Print " "
+Print "Execution complete."
+Input
+End
+
+
+
+
+Function match:Long(start:Long,inc$,dec$,dir%)
+	Local nest:Long=1,in:Long=start+dir
+	Repeat
+		If in=>size Or in<0 
+			Print "ERROR: could not find matching "+dec;Input;End
+		EndIf
+		If Chr(code[in])=inc nest:+1
+		If Chr(code[in])=dec nest:-1
+		If nest=0 Return in
+		in:+dir
+	Forever
+End Function
+
+
+Function writeparen(start:Long,fin:Long)
+	Local txt$=""
+	For Local write:Long=start+1 To fin-1
+		txt:+Chr(code[write])
+	Next
+	WriteStdout txt
+End Function
+
+
+Function lnand%(x:Double,y:Double)
+	If (x=0) | (y=0) Return 1
+	Return 0
+End Function
+Function lor%(x:Double,y:Double)
+	If (x<>0) | (y<>0) Return 1
+	Return 0
+End Function
+Function lnot%(x:Double)
+	If (x=0) Return 1
+	Return 0
+End Function
+
+Function deg%(x%)
+	If degrees=1 Return x
+	Return x*Pi/Double(180)
+End Function
+
+Function e:Double()
+	Return 2.71828182845904523536
+End Function
+
+Function Logbx:Double(x:Double,b:Double)
+	Return Log(x)/Log(b)
+End Function
+
+Function round:Double(num:Double)
+	Local dec:Double=num Mod 1
+	If dec=>.5 Return num+(1-dec)
+	Return num-dec
+End Function
+
+
+Function sign:Double(num:Double)
+	If num>0 Return 1
+	If num<0 Return -1
+	Return 0
+End Function

grin/src/99 Bottles of Beer.grin

@@ -0,0 +1,6 @@
+}}$^^*$++}}}[}}:( bottles of beer on the wall,)):( bottles of beer.))
+(Take one down, pass it around.)){:( bottles of beer on the wall.)){{]}
+:( bottle of beer on the wall,)):( bottle of beer.))
+(Take it down, pass it around.))(No more bottles of beer on the wall.))
+(No more bottles of beer on the wall,))(No more bottles of beer.))
+}$^^*$++}}}(Go to the store and buy some more.)):( bottles of beer on the wall.))

grin/src/Area of Circle.grin

@@ -0,0 +1,2 @@
+}[(Input the radius of the circle you wish to find the area of. );)
+>_}}$p<^$>*(Answer: ):( sq. units)))<(Again? [0/1] );)]

grin/src/CollatzSequence.grin

@@ -0,0 +1,2 @@
+<}[>(Calculate a Collatz sequence of what number?));)<}
+[<}>>$:)>\2$>\![_}}$<</>>_]<[_}}}$<*}>_]<$<\{])<(Steps: ):))>(Again? [1/0] ))<;)]

grin/src/Distance.grin

@@ -0,0 +1,9 @@
+(This program will find the distance between two coordinates in 3D space.)))
+(Please input [X1].y1..z1..x2..y2..z2.));>)
+(Please input .x1.[y1].z1..x2..y2..z2.));>)
+(Please input .x1..y1.[z1].x2..y2..z2.));>)
+(Please input .x1..y1..z1.[x2].y2..z2.));>)
+(Please input .x1..y1..z1..x2.[y2].z2.));>)
+(Please input .x1..y1..z1..x2..y2.[z2]));)
+<<<$<<<-$*>$>>>-$*>$<<<-$*$<<+$>>>>+>_}}1$<^
+(Distance: ):)

grin/src/Factorial.grin

@@ -0,0 +1,2 @@
+}[>(What number would you like to determine the factorial of?));
+>_}<[$>*<{]>>(Answer: ):))(Again? [1/0]))<;)]`

grin/src/Fibonacci.grin

@@ -0,0 +1,2 @@
+(Calculate how many numbers of the Fibonacci sequence?));)
+>:)>}:)<<[{>$>>\<$>+:)<$<\>>$<\<<]

grin/src/Hello World.grin

@@ -0,0 +1 @@
+(Hello, world!)

grin/src/Juggler Sequence.grin

@@ -0,0 +1,4 @@
+<}[>(Calculate the Juggler sequence of what number?));)<}
+[<}>>$:)>\2$>\![_}}1$<<^>>_]<[_}}$}/$<^>_]<:( -> )$<<<<<<
+\<\<\r$>-$[>-$<_]@[>-{$<_][@]@![>$<_]>>>>>}>>\>\<{]_}:)<<
+(Steps: ):))>>(Again? [1/0] ))<;)]

grin/src/Round.grin

@@ -0,0 +1,3 @@
+}[>(Round up [0] or down [1]? );$>\!>(Input the number you want to round. );)
+$>\>\r$<-$[<-<[>}<_]>$>_]@[<-<<[>>{<<_]>>$>_][@]@![<$>_](Answer: )"))
+<<(Again? [0/1] );))]