'Classes/System/Console.ab

Namespace System

Enum ConsoleColor
	Black		= 0 
	DarkGray	= FOREGROUND_INTENSITY
	Gray		= FOREGROUND_RED Or FOREGROUND_GREEN Or FOREGROUND_BLUE
	White		= FOREGROUND_RED Or FOREGROUND_GREEN Or FOREGROUND_BLUE Or FOREGROUND_INTENSITY

	DarkRed		= FOREGROUND_RED
	Red			= FOREGROUND_RED Or FOREGROUND_INTENSITY

	DarkYellow	= FOREGROUND_RED Or FOREGROUND_GREEN
	Yellow		= FOREGROUND_RED Or FOREGROUND_GREEN Or FOREGROUND_INTENSITY

	DarkGreen	= FOREGROUND_GREEN
	Green		= FOREGROUND_GREEN Or FOREGROUND_INTENSITY

	DarkCyan	= FOREGROUND_GREEN Or FOREGROUND_BLUE
	Cyan		= FOREGROUND_GREEN Or FOREGROUND_BLUE Or FOREGROUND_INTENSITY

	DarkBlue	= FOREGROUND_BLUE
	Blue		= FOREGROUND_BLUE Or FOREGROUND_INTENSITY

	DarkMagenta	= FOREGROUND_RED Or FOREGROUND_BLUE
	Magenta		= FOREGROUND_RED Or FOREGROUND_BLUE Or FOREGROUND_INTENSITY
End Enum


/*
@brief コンソール入出力・ウィンドウなどのクラス
@date 2008/02/26
@auther Egtra
*/
Class Console
Public
	/*
	@brief コンソールの背景色を取得または設定する
	@date 2008/09/02
	@auther NoWest
	*/
	Static Sub BackgroundColor ( value As ConsoleColor )
		If ActiveBasic.IsNothing(Console.out) Then
			Exit Sub
		Else
			If Console.hconsoleout = NULL Then
				Exit Sub
			Else
				Dim csbi As CONSOLE_SCREEN_BUFFER_INFO
				Dim ret = GetConsoleScreenBufferInfo(Console.hconsoleout,csbi)
				If ret = 0 Then Throw New IO.IOException()
				csbi.wAttributes And = &HFF0F'背景色だけ変更できるようにマスク処理
				ret = SetConsoleTextAttribute(Console.hconsoleout,csbi.wAttributes Or (This.ConsoleColorToTextAttribute(value)<<4) As Word/* foreをbackへ変換 */)			
				If ret = 0 Then Throw New IO.IOException()
			End If
		End If
	End Sub
	Static Function BackgroundColor() As ConsoleColor
		If ActiveBasic.IsNothing(Console.out) Then
			Return ConsoleColor.Gray
		Else
			If Console.hconsoleout = NULL Then
				Return ConsoleColor.Gray
			Else
				Dim csbi As CONSOLE_SCREEN_BUFFER_INFO
				Dim ret = GetConsoleScreenBufferInfo(Console.hconsoleout,csbi)
				If ret = 0 Then Throw New IO.IOException()
				Dim attributes = csbi.wAttributes And &H00F0'背景色だけ取り出せるようにマスク処理
				Return This.TextAttributeToConsoleColor(attributes>>4/* backをforeへ変換 */)
			End If
		End If
	End Function


	/*
	@brief バッファ領域の高さを取得または設定する
	@date 2008/09/02
	@auther NoWest
	*/
	Static Sub BufferHeight ( value As Long )
		Dim width As Long, height As Long
		This.GetBufferSize(width,height)
		Console.SetBufferSize(width,value)
	End Sub
	Static Function BufferHeight () As Long
		Dim width As Long, height As Long
		This.GetBufferSize(width,height)
		Return height
	End Function

	/*
	@brief バッファ領域の幅を取得または設定する
	@date 2008/09/02
	@auther NoWest
	*/
	Static Sub BufferWidth ( value As Long )
		Dim width As Long, height As Long
		This.GetBufferSize(width,height)
		Console.SetBufferSize(value,height)
	End Sub
	Static Function BufferWidth () As Long
		Dim width As Long, height As Long
		This.GetBufferSize(width,height)
		Return width
	End Function

	/*
	@brief カーソルの列位置を取得または設定する
	@date 2008/09/02
	@auther NoWest
	*/
	Static Sub CursorLeft ( value As Long )
		Dim left As Long, top As Long
		This.GetCursorPosition(left,top)
		Console.SetCursorPosition(value,top)
	End Sub
	Static Function CursorLeft () As Long
		Dim left As Long, top As Long
		This.GetCursorPosition(left,top)
		Return left
	End Function

	/*
	@brief 文字セル内のカーソルの高さを取得または設定する
	@date 2008/09/02
	@auther NoWest
	*/
	Static Sub CursorSize ( value As Long )
		If Console.hconsoleout = NULL Then
			Exit Sub
		Else
			Dim cci As CONSOLE_CURSOR_INFO
			Dim ret = GetConsoleCursorInfo(Console.hconsoleout,cci)
			If ret = 0 Then Throw New IO.IOException()
			cci.dwSize = value As DWord
			ret = SetConsoleCursorInfo(Console.hconsoleout,cci)
			If ret = 0 Then Throw New IO.IOException()
		End If
	End Sub
	Static Function CursorSize () As Long
		If Console.hconsoleout = NULL Then
			Return -1 As Long
		Else
			Dim cci As CONSOLE_CURSOR_INFO
			Dim ret = GetConsoleCursorInfo(Console.hconsoleout,cci)
			If ret = 0 Then Throw New IO.IOException()
			Return cci.dwSize As Long
		End If
	End Function

	/*
	@brief カーソルの行位置を取得または設定する
	@date 2008/09/02
	@auther NoWest
	*/
	Static Sub CursorTop ( value As Long )
		Dim left As Long, top As Long
		This.GetCursorPosition(left,top)
		Console.SetCursorPosition(left,value)
	End Sub
	Static Function CursorTop () As Long
		Dim left As Long, top As Long
		This.GetCursorPosition(left,top)
		Return top
	End Function

	/*
	@brief カーソルを表示するかどうかを示す値を取得または設定する
	@date 2008/09/02
	@auther NoWest
	*/
	Static Sub CursorVisible ( visible As Boolean )
		If Console.hconsoleout = NULL Then
			Exit Sub
		Else
			Dim cci As CONSOLE_CURSOR_INFO
			Dim ret = GetConsoleCursorInfo(Console.hconsoleout,cci)
			If ret = 0 Then Throw New IO.IOException()
			cci.bVisible = visible As BOOL
			ret = SetConsoleCursorInfo(Console.hconsoleout,cci)
			If ret = 0 Then Throw New IO.IOException()
		End If
	End Sub
	Static Function CursorVisible () As Boolean
		If Console.hconsoleout = NULL Then
			Return False
		Else
			Dim cci As CONSOLE_CURSOR_INFO
			Dim ret = GetConsoleCursorInfo(Console.hconsoleout,cci)
			If ret = 0 Then Throw New IO.IOException()
			Return cci.bVisible As Boolean
		End If
	End Function

	/*
	@brief コンソールの前景色を取得または設定する
	@date 2008/09/02
	@auther NoWest
	*/
	Static Sub ForegroundColor ( value As ConsoleColor )
		If ActiveBasic.IsNothing(Console.out) Then
			Exit Sub
		Else
			If Console.hconsoleout = NULL Then
				Exit Sub
			Else
				Dim csbi As CONSOLE_SCREEN_BUFFER_INFO
				Dim ret = GetConsoleScreenBufferInfo(Console.hconsoleout,csbi)
				If ret = 0 Then Throw New IO.IOException()
				csbi.wAttributes And = &HFFF0'前景色だけ変更できるようにマスク処理
				ret = SetConsoleTextAttribute(Console.hconsoleout,csbi.wAttributes Or This.ConsoleColorToTextAttribute(value))			
				If ret = 0 Then Throw New IO.IOException()
			End If
		End If
	End Sub
	Static Function ForegroundColor() As ConsoleColor
		If ActiveBasic.IsNothing(Console.out) Then
			Return ConsoleColor.Gray
		Else
			If Console.hconsoleout = NULL Then
				Return ConsoleColor.Gray
			Else
				Dim csbi As CONSOLE_SCREEN_BUFFER_INFO
				Dim ret = GetConsoleScreenBufferInfo(Console.hconsoleout,csbi)
				If ret = 0 Then Throw New IO.IOException()
				Dim attributes = csbi.wAttributes And &H000F'前景色だけ取り出せるようにマスク処理
				Return This.TextAttributeToConsoleColor(attributes)
			End If
		End If
	End Function

	/*
	@brief コンソールのタイトルを取得または設定する
	@date 2008/09/02
	@auther NoWest
	*/
	Static Sub Title( title As String )
		If Console.hconsoleout =NULL Then
			Exit Sub
		Else
			SetConsoleTitle(ToTCStr(title))
		End If
	End Sub
	Static Function Title() As String
		If Console.hconsoleout =NULL Then
			Return ""
		Else
			Dim sb = New Text.StringBuilder
			sb.Length = 24500
			Dim ret = GetConsoleTitle(StrPtr(sb),sb.Length())
			If ret = 0 Then
				Dim error = GetLastError()
				If error <> ERROR_SUCCESS Then
					ActiveBasic.Windows.ThrowWithErrorCode(error, "Console.Title")
				End If
			End If
			sb.Length = ret
			Return sb.ToString()
		End If
	End Function


	/*
	@brief 標準エラー出力を設定する
	@date 2008/08/21
	@auther Egtra
	*/
	Static Sub SetError(newErr As IO.TextWriter)
		If ActiveBasic.IsNothing(newErr) Then
			Throw New ArgumentNullException("newErr")
		End If
		Console.err = newErr
'		Dim sw = Console.err As IO.StreamWriter
'		Dim fs = sw.BaseStream() As IO.FileStream
'		Console.hconsoleerr = fs.Handle()
	End Sub

	/*
	@brief 標準エラー出力を取得する
	@date 2008/08/21
	@auther Egtra
	*/
	Static Function Error() As IO.TextWriter
		Error = err
	End Function

	/*
	@brief 標準出力を設定する
	@date 2008/06/21
	@auther overtaker
	*/
	Static Sub SetOut(newOut As IO.TextWriter)
		If ActiveBasic.IsNothing(newOut) Then
			Throw New ArgumentNullException("newOut")
		End If
		Console.out = newOut
	End Sub

	/*
	@brief 標準出力を取得する
	@date 2008/06/21
	@auther overtaker
	*/
	Static Function Out() As IO.TextWriter
		Out = out
	End Function

	/*
	@brief 標準出力に1行書き込む
	@date 2008/06/21
	@auther overtaker
	*/
	Static Sub WriteLine(value As String)
		out.WriteLine(value)
		out.Flush()
	End Sub

	Static Sub WriteLine()
		out.WriteLine()
		out.Flush()
	End Sub

	Static Sub WriteLine(x As Boolean)
		WriteLine(Str$(x))
	End Sub
	
	Static Sub WriteLine(x As Char)
		WriteLine(Chr$(x))
	End Sub

	Static Sub WriteLine(x As Byte)
		WriteLine(Str$(x))
	End Sub
#ifdef UNICODE
	Static Sub WriteLine(x As SByte)
		WriteLine(Str$(x))
	End Sub
#else
	Static Sub WriteLine(x As Word)
		WriteLine(Str$(x))
	End Sub
#endif
	Static Sub WriteLine(x As Integer)
		WriteLine(Str$(x))
	End Sub

	Static Sub WriteLine(x As DWord)
		WriteLine(Str$(x))
	End Sub

	Static Sub WriteLine(x As Long)
		WriteLine(Str$(x))
	End Sub

	Static Sub WriteLine(x As QWord)
		WriteLine(Str$(x))
	End Sub

	Static Sub WriteLine(x As Int64)
		WriteLine(Str$(x))
	End Sub

	Static Sub WriteLine(x As Single)
		WriteLine(Str$(x))
	End Sub

	Static Sub WriteLine(x As Double)
		WriteLine(Str$(x))
	End Sub

	Static Sub WriteLine(x As Object)
		WriteLine(x.ToString)
	End Sub

	/*
	@brief 標準出力に書き込む
	@date 2008/06/21
	@auther overtaker
	*/
	Static Sub Write(s As String)
		out.Write(s)
		out.Flush()
	End Sub

	Static Sub Write(x As Boolean)
		Write(Str$(x))
	End Sub

	Static Sub Write(x As Char)
		Write(Chr$(x))
	End Sub

	Static Sub Write(x As Byte)
		Write(Str$(x))
	End Sub
#ifdef UNICODE
	Static Sub Write(x As SByte)
		Write(Str$(x))
	End Sub
#else
	Static Sub Write(x As Word)
		Write(Str$(x))
	End Sub
#endif
	Static Sub Write(x As Integer)
		Write(Str$(x))
	End Sub

	Static Sub Write(x As DWord)
		Write(Str$(x))
	End Sub

	Static Sub Write(x As Long)
		Write(Str$(x))
	End Sub

	Static Sub Write(x As QWord)
		Write(Str$(x))
	End Sub

	Static Sub Write(x As Int64)
		Write(Str$(x))
	End Sub

	Static Sub Write(x As Object)
		Write(x.ToString)
	End Sub

	/*
	@brief 標準入力を設定する
	@date 2008/02/26
	@auther Egtra
	*/
	Static Sub SetIn(newIn As IO.TextReader)
		If ActiveBasic.IsNothing(newIn) Then
			Throw New ArgumentNullException("newIn")
		End If
		Console.in = newIn
	End Sub

	/*
	@brief 標準入力を取得する
	@date 2008/02/26
	@auther Egtra
	*/
	Static Function In() As IO.TextReader
		In = in
	End Function

	/*
	@brief 標準入力から1行読み込む
	@date 2008/02/26
	@auther Egtra
	*/
	Static Function ReadLine() As String
		ReadLine = in.ReadLine()
	End Function

	/*
	@brief 標準入力から1行読み込む
	@date 2008/02/26
	@auther Egtra
	*/
	Static Function Read() As Long
		Read = in.Read()
	End Function

	/*
	@brief  コンソール バッファおよび対応するコンソール ウィンドウをクリア
	@date   2008/09/02
	@auther NoWest
	*/
	Static Sub Clear()
		If Console.hconsoleout = NULL Then
			Exit Sub
		Else
			Dim csbi As CONSOLE_SCREEN_BUFFER_INFO
			Dim ret = GetConsoleScreenBufferInfo(Console.hconsoleout,csbi)
			If ret = 0 Then Throw New IO.IOException()
			Dim length = csbi.dwSize.X * csbi.dwSize.Y
			Dim written As DWord
			Dim s = New String(" ")
			ret = FillConsoleOutputCharacter(Console.hconsoleout,s[0],length,0,written)
			If ret = 0 Then Throw New IO.IOException()
			ret = FillConsoleOutputAttribute(Console.hconsoleout,csbi.wAttributes,length,0,written)
			If ret = 0 Then Throw New IO.IOException()
			ret = SetConsoleCursorPosition(Console.hconsoleout,0)
			If ret = 0 Then Throw New IO.IOException()
		End If
	End Sub

	/*
	@brief  標準エラー ストリームを取得
	@date   2008/09/07
	@auther NoWest
	*/
	Static Sub OpenStandardError()
		Dim w = New Detail.ConsoleWriter(hconsoleerr)
		Console.SetOut(System.IO.TextWriter.Synchronized(w))
	End Sub

	/*
	@brief  標準入力ストリーム ストリームを取得
	@date   2008/09/07
	@auther NoWest
	*/
	Static Sub OpenStandardInput()
		Dim w = New Detail.ConsoleReader(hconsolein)
		Console.SetIn(System.IO.TextReader.Synchronized(w))
	End Sub

	/*
	@brief  標準出力ストリーム ストリームを取得
	@date   2008/09/07
	@auther NoWest
	*/
	Static Sub OpenStandardOutput()
		Dim w = New Detail.ConsoleWriter(hconsoleout)
		Console.SetOut(System.IO.TextWriter.Synchronized(w))
		Console.defBC = This.ConsoleColorToTextAttribute(Console.BackgroundColor)
		Console.defFC = This.ConsoleColorToTextAttribute(Console.ForegroundColor)
	End Sub

	/*
	@brief  コンソールの前景色および背景色を既定値に設定
	@date   2008/09/07
	@auther NoWest
	*/
	Static Sub ResetColor()
		Console.BackgroundColor = TextAttributeToConsoleColor(Console.defBC)
		Console.ForegroundColor = TextAttributeToConsoleColor(Console.defFC)
	End Sub

	/*
	@brief バッファ領域の高さと幅を指定された値に設定
	@date 2008/09/02
	@auther NoWest
	*/
	Static Sub SetBufferSize ( width As Long, height As Long )
		If Console.hconsoleout = NULL Then
			Exit Sub
		Else
			Dim size As COORD
			size.X = width As Integer
			size.Y = height As Integer
			Dim ret = SetConsoleScreenBufferSize(Console.hconsoleout,COORDtoDWORD(size))
			If ret = 0 Then Throw New IO.IOException()
		End If
	End Sub

	/*
	@brief カーソルの位置を設定
	@date 2008/09/02
	@auther NoWest
	*/
	Static Sub SetCursorPosition ( left As Long, top As Long )
		If Console.hconsoleout = NULL Then
			Exit Sub
		Else
			Dim pos As COORD
			pos.X = left As Integer
			pos.Y = top As Integer
			Dim ret = SetConsoleCursorPosition(Console.hconsoleout,COORDtoDWORD(pos))
			If ret = 0 Then Throw New IO.IOException()
		End If
	End Sub

Private
	Function enter() As ActiveBasic.Windows.CriticalSectionLock
		Imports ActiveBasic.Windows
		If ActiveBasic.IsNothing(cs) Then
			Dim lock = New CriticalSectionLock(_System_CriticalSection)
			Try
				If ActiveBasic.IsNothing(cs) Then
					cs = New CriticalSection
				End If
			Finally
				lock.Dispose()
			End Try
		End If
		enter = cs.Enter
	End Function

	Function ConsoleColorToTextAttribute( value As ConsoleColor ) As Word
		Dim ret = value As DWord
		Return ret As Word
	End Function

	Function TextAttributeToConsoleColor( value As Word ) As ConsoleColor
		Select Case value
			Case 0
				Return ConsoleColor.Black
			Case FOREGROUND_INTENSITY
				Return ConsoleColor.DarkGray
			Case FOREGROUND_RED Or FOREGROUND_GREEN Or FOREGROUND_BLUE
				Return ConsoleColor.Gray
			Case FOREGROUND_RED Or FOREGROUND_GREEN Or FOREGROUND_BLUE Or FOREGROUND_INTENSITY
				Return ConsoleColor.White
			Case FOREGROUND_RED
				Return ConsoleColor.DarkRed
			Case FOREGROUND_RED Or FOREGROUND_INTENSITY
				Return ConsoleColor.Red
			Case FOREGROUND_RED Or FOREGROUND_GREEN
				Return ConsoleColor.DarkYellow
			Case FOREGROUND_RED Or FOREGROUND_GREEN Or FOREGROUND_INTENSITY
				Return ConsoleColor.Yellow
			Case FOREGROUND_GREEN
				Return ConsoleColor.DarkGreen
			Case FOREGROUND_GREEN Or FOREGROUND_INTENSITY
				Return ConsoleColor.Green
			Case FOREGROUND_GREEN Or FOREGROUND_BLUE
				Return ConsoleColor.DarkCyan
			Case FOREGROUND_GREEN Or FOREGROUND_BLUE Or FOREGROUND_INTENSITY
				Return ConsoleColor.Cyan
			Case FOREGROUND_BLUE
				Return ConsoleColor.DarkBlue
			Case FOREGROUND_BLUE Or FOREGROUND_INTENSITY
				Return ConsoleColor.Blue
			Case FOREGROUND_RED Or FOREGROUND_BLUE
				Return ConsoleColor.DarkMagenta
			Case FOREGROUND_RED Or FOREGROUND_BLUE Or FOREGROUND_INTENSITY
				Return ConsoleColor.Magenta
			Case Else
				Return ConsoleColor.Gray
		End Select
	End Function

	Sub GetCursorPosition ( ByRef left As Long, ByRef top As Long )
		If Console.hconsoleout = NULL Then
			Exit Sub
		Else
			Dim csbi As CONSOLE_SCREEN_BUFFER_INFO
			Dim ret = GetConsoleScreenBufferInfo(Console.hconsoleout,csbi)
			If ret = 0 Then Throw New IO.IOException()
			left = csbi.dwCursorPosition.X
			top = csbi.dwCursorPosition.Y
		End If
	End Sub

	Sub GetBufferSize ( ByRef width As Long, ByRef height As Long )
		If Console.hconsoleout = NULL Then
			Exit Sub
		Else
			Dim csbi As CONSOLE_SCREEN_BUFFER_INFO
			Dim ret = GetConsoleScreenBufferInfo(Console.hconsoleout,csbi)
			If ret = 0 Then Throw New IO.IOException()
			width = csbi.dwSize.X
			height = csbi.dwSize.Y
		End If
	End Sub

	Static hconsoleerr = GetStdHandle(STD_ERROR_HANDLE) As HANDLE
	Static hconsolein = GetStdHandle(STD_INPUT_HANDLE) As HANDLE
	Static hconsoleout = GetStdHandle(STD_OUTPUT_HANDLE) As HANDLE
	Static in = Nothing As IO.TextReader
	Static out = Nothing As IO.TextWriter
	Static err = Nothing As IO.TextWriter
	Static cs = Nothing As ActiveBasic.Windows.CriticalSection
	Static defBC As Word
	Static defFC As Word
End Class

Namespace Detail

Class ConsoleWriter
	Inherits IO.TextWriter
Public
	Sub ConsoleWriter(hOut As HANDLE)
		h = hOut
	End Sub

	Override Sub Flush()
		Dim b = Buffer
		Dim written As DWord
		WriteConsole(h, StrPtr(b), b.Length As DWord, written, 0)
		b.Remove(0, written As Long)
	End Sub

Private
	h As HANDLE
End Class

Class ConsoleReader
	Inherits IO.TextReader
Public
	Sub ConsoleReader(hIn As HANDLE)
		h = hIn
	End Sub

Protected
	Override Function Underflow() As Boolean
		If eofReached Then
			Underflow = 0
		Else
			Dim b = Buffer
			Dim currentBufLength = b.Length
			b.Length = currentBufLength + 256
			Dim p = StrPtr(b)
			Dim read As DWord
			If ReadConsole(h, VarPtr(p[currentBufLength]), 256 * SizeOf (TCHAR), read, 0) = 0 Then
				IO.Detail.ThrowWinLastErrorIOException()
			End If
			Dim eofPos = ActiveBasic.Strings.ChrFind(VarPtr(p[currentBufLength]) As PCTSTR, read As SIZE_T, &h1A As TCHAR)
			If eofPos <> -1 Then
				eofReached = True
				read = eofPos
			End If
			b.Length = currentBufLength + read
			Underflow = read <> 0
		End If
	End Function

Private
	h As HANDLE
	eofReached As Boolean
End Class

End Namespace 'Detail

End Namespace 'System