PureBasic Forums - English

Code: Select all

; Define (Windows)

	EnableExplicit

	Macro ConsoleHandle()
		GetStdHandle_( #STD_OUTPUT_HANDLE ) 
	EndMacro

	Structure tConsole_COORD
		StructureUnion
			coord.COORD
			long.l
		EndStructureUnion
	EndStructure

	Procedure ConsoleBufferLocate(x,y)

		Protected ConsoleBufferInfo.CONSOLE_SCREEN_BUFFER_INFO
		Protected hConsole
		Protected location.tConsole_COORD

		hConsole = ConsoleHandle()
		GetConsoleScreenBufferInfo_( hConsole,@ConsoleBufferInfo )
		If y >= ConsoleBufferInfo\dwSize\y Or x >= ConsoleBufferInfo\dwSize\x
			ProcedureReturn #False
		EndIf

		location\coord\x = x
		location\coord\y = y
		SetConsoleCursorPosition_( hConsole,location\long )

		ProcedureReturn #True
	EndProcedure

	DataSection
		ShaderChar:
		Data.a " ·*¤############"
		ShaderColF:
		Data.a "@HHHHGO@HGOHGOGO"
		ShaderColB:
		Data.a "@@@@@@@HHHHGGGOO"
		ShaderNorm:
		Data.a " .,-~:;=!*¤#$Ø@©"
	EndDataSection

; EndDefine

OpenConsole("Donut based on a1k0n.net",#PB_Ascii)
ConsoleCursor(0)
   

Macro R(mul,shift,x,y)

	r=x;
	x-(mul*y)>>shift
	y+(mul*r)>>shift
	r=(3145728-x*x-y*y)>>11
	x=(x*r)>>10
	y=(y*r)>>10

EndMacro

Global Dim b.a(2000)
Global Dim z.a(2000)


Procedure Main()

	Protected sA=1024
	Protected cA=0
	Protected sB=1024
	Protected cB=0
	Protected r
	Protected r1,r2
	Protected k2

	Protected i,si,ci
	Protected j,sj,cj

	Protected x0,x1,x2,x3,x4,x5,x6,x7
	Protected x,y,n,o,z

	Repeat

		FillMemory(@b(1),2000,0,#PB_Ascii);		Text Buffer
		FillMemory(@z(1),2000,127,#PB_Ascii);	Z-Buffer

		sj=0
		cj=1024
		For j=0 To 90
			si=0
			ci=1024
			For i=0 To 324
				R1=1
				R2=2048
				K2=5100*1024

				x0=R1*cj+R2
				x1=(ci*x0)>>10
				x2=(cA*sj)>>10
				x3=(si*x0)>>10
				x4=R1*x2 - ((sA*x3)>>10)
				x5=(sA*sj)>>10
				x6=K2 + R1*1024*x5 + cA*x3
				x7=(cj*si)>>10
				x=40 + 30*(cB*x1 - sB*x4)/x6
				y=12 + 15*(cB*x4 + sB*x1)/x6
				N=((((-cA*x7 - cB*(((-sA*x7)>>10) + x2) - ci*((cj*sB)>>10))>>10) - x5) * 22)>>11; 0-15
				o=x + 80 * y
				z=(x6-K2)>>15

				If (25 > y And y > 0 And x > 0 And 80 > x And z<z(o))
					z(o)=z
					If n>=0
						b(o)=n
					EndIf
				EndIf
				R(5,8,ci,si)
			Next
			R(9,7,cj,sj)
		Next j

		ConsoleBufferLocate(0,0)
		ConsoleColor(15,0)
		For i=1 To 2000
			j=b(i)
			If GetKeyState_(#VK_SHIFT)&128
				ConsoleColor(PeekA(?ShaderColF+j)-'@',PeekA(?ShaderColB+j)-'@')
				Print(Chr(PeekA(?ShaderChar+j)))
			Else
				Print(Chr(PeekA(?ShaderNorm+j)))
			EndIf
			If i%80=0
				PrintN("")
			EndIf
			R(7,10,cA,sA);
			R(5,9,cB,sB);
		Next i
		Delay(25)
	Until Inkey()
	
EndProcedure

Main()