'prompt.sbp


#ifndef _INC_PROMPT
#define _INC_PROMPT

Namespace ActiveBasic
Namespace Prompt
Namespace Detail

Function _PromptSys_GetTextExtentPoint32(hdc As HDC, psz As PCSTR, cb As Long, ByRef Size As SIZE) As Long
	_PromptSys_GetTextExtentPoint32 = GetTextExtentPoint32A(hdc, psz, cb, Size)
End Function

Function _PromptSys_GetTextExtentPoint32(hdc As HDC, psz As PCWSTR, cb As Long, ByRef Size As SIZE) As Long
	_PromptSys_GetTextExtentPoint32 = GetTextExtentPoint32W(hdc, psz, cb, Size)
End Function

Function _PromptSys_TextOut(hdc As HDC, x As Long, y As Long, psz As PCSTR, cb As Long) As Long
	_PromptSys_TextOut = TextOutA(hdc, x, y, psz, cb)
	If _PromptSys_TextOut = 0 Then Debug
End Function

Function _PromptSys_TextOut(hdc As HDC, x As Long, y As Long, psz As PCWSTR, cb As Long) As Long
	_PromptSys_TextOut = TextOutW(hdc, x, y, psz, cb)
End Function

Function _PromptSys_ImmGetCompositionString(himc As HIMC, index As DWord, pBuf As PSTR, bufLen As DWord) As Long
	_PromptSys_ImmGetCompositionString = ImmGetCompositionStringA(himc, index, pBuf, bufLen)
End Function

Function _PromptSys_ImmGetCompositionString(himc As HIMC, index As DWord, pBuf As PWSTR, bufLen As DWord) As Long
	_PromptSys_ImmGetCompositionString = ImmGetCompositionStringW(himc, index, pBuf, bufLen)
End Function

Dim _PromptSys_hWnd As HWND
Dim _PromptSys_dwThreadID As DWord
Dim _PromptSys_hInitFinish As HANDLE

'text
Type _PromptSys_CharacterInformation
	ForeColor As COLORREF
	BackColor As COLORREF
	StartPos As Long
End Type

Type _PromptSys_LineInformation
	Length As Long
	Text As *Char
	CharInfo As *_PromptSys_CharacterInformation
End Type

Dim _PromptSys_hFont As HFONT
Dim _PromptSys_FontSize As SIZE
Dim _PromptSys_InputStr[255] As Char
Dim _PromptSys_InputLen = -1 As Long
Dim _PromptSys_KeyChar As Byte
Dim _PromptSys_CurPos As POINTAPI
Dim _PromptSys_TextLine[100] As _PromptSys_LineInformation
Dim _PromptSys_NowTextColor As COLORREF
Dim _PromptSys_NowBackColor As COLORREF
Dim _PromptSys_SectionOfBufferAccess As CRITICAL_SECTION


'graphic
Dim _PromptSys_hBitmap As HBITMAP
Dim _PromptSys_hMemDC As HDC
Dim _PromptSys_ScreenSize As SIZE
Dim _PromptSys_GlobalPos As POINTAPI

Sub _PromptSys_Initialize()
	_PromptSys_hInitFinish = CreateEvent(0, FALSE, FALSE, 0)
	Dim _PromptSys_hThread = CreateThread(0, 0, AddressOf(PromptMain), 0, 0, _PromptSys_dwThreadID)
	If _PromptSys_hThread = 0 Then
		Debug
		ExitProcess(1)
	End If
	WaitForSingleObject(_PromptSys_hInitFinish, INFINITE)
End Sub

Sub DrawPromptBuffer(hDC As HDC, StartLine As Long, EndLine As Long)
	Dim i As Long, i2 As Long, i3 As Long
	Dim ret As Long

	Dim hOldFont = SelectObject(hDC, _PromptSys_hFont) As HFONT

	'Scroll
	Dim rc As RECT
	GetClientRect(_PromptSys_hWnd, rc)
	While (_PromptSys_CurPos.y+1) * _PromptSys_FontSize.cy > rc.bottom and _PromptSys_CurPos.y > 0
		_System_free(_PromptSys_TextLine[0].Text)
		_System_free(_PromptSys_TextLine[0].CharInfo)
		For i = 0 To 100 - 1
			_PromptSys_TextLine[i].Length = _PromptSys_TextLine[i+1].Length
			_PromptSys_TextLine[i].Text = _PromptSys_TextLine[i+1].Text
			_PromptSys_TextLine[i].CharInfo = _PromptSys_TextLine[i+1].CharInfo
		Next
		_PromptSys_TextLine[100].Length = 0
		_PromptSys_TextLine[100].Text = _System_calloc(SizeOf (Char) * 255)
		_PromptSys_TextLine[100].CharInfo = _System_calloc(SizeOf (_PromptSys_CharacterInformation) * 255)
		_PromptSys_CurPos.y--

		'Redraw
		StartLine = -1
	Wend

	i = 0' : Debug
	While i * _PromptSys_FontSize.cy < rc.bottom and i <= 100
		If StartLine=-1 or (StartLine<=i and i<=EndLine) Then
			Dim currentLineCharInfo = _PromptSys_TextLine[i].CharInfo

			Dim sz As SIZE
			i3 = _PromptSys_TextLine[i].Length
			_PromptSys_GetTextExtentPoint32(hDC, _PromptSys_TextLine[i].Text, i3, sz)

'			BitBlt(hDC,_
'				sz.cx, i * _PromptSys_FontSize.cy, _
'				rc.right, _PromptSys_FontSize.cy, _
'				_PromptSys_hMemDC, sz.cx, i * _PromptSys_FontSize.cy, SRCCOPY)

			While i2 < i3
				SetTextColor(hDC, currentLineCharInfo[i2].ForeColor)
				If currentLineCharInfo[i2].BackColor = -1 Then
					SetBkMode(hDC, TRANSPARENT)
				Else
'					Debug
					ret = SetBkMode(hDC, OPAQUE)
					ret = SetBkColor(hDC, currentLineCharInfo[i2].BackColor)
				End If

				Dim tempLen As Long
				If _System_IsDoubleUnitChar(_PromptSys_TextLine[i].Text[i2], _PromptSys_TextLine[i].Text[i2+1]) Then
					tempLen = 2
				Else
					tempLen = 1
				End If
				With _PromptSys_FontSize
					_PromptSys_TextOut(hDC, currentLineCharInfo[i2].StartPos, i * .cy, VarPtr(_PromptSys_TextLine[i].Text[i2]) As *Char, tempLen)
				End With
				i2 += tempLen
			Wend
		End If

		i++
	Wend

	SelectObject(hDC, hOldFont)
End Sub

Sub PRINT_ToPrompt(buf As String)
	OutputDebugString(ToTCStr(Ex"PRINT_ToPrompt " + buf + Ex"\r\n"))
	EnterCriticalSection(_PromptSys_SectionOfBufferAccess)
	If buf = "あ" Then Debug
	With _PromptSys_CurPos
		Dim hdc = GetDC(_PromptSys_hWnd)
		Dim hOldFont = SelectObject(hdc, _PromptSys_hFont)
		Dim StartLine = .y As Long
		Dim bufLen = buf.Length
		Dim doubleUnitChar = False As Boolean
		'Addition
		Dim i2 = 0 As Long, i3 As Long
		For i2 = 0 To ELM(bufLen)
			If buf[i2] = &h0d Then 'CR \r
				_PromptSys_TextLine[.y].Length = .x
				.x = 0
			ElseIf buf[i2] = &h0a Then 'LF \n
				_PromptSys_TextLine[.y].Length = System.Math.Max(_PromptSys_TextLine[.y].Length, .x)
				.y++
			Else
				Dim currentLineCharInfo = _PromptSys_TextLine[.y].CharInfo
				_PromptSys_TextLine[.y].Text[.x] = buf[i2]
				currentLineCharInfo[.x].ForeColor = _PromptSys_NowTextColor
				currentLineCharInfo[.x].BackColor = _PromptSys_NowBackColor

				If buf[i2] = &h09 Then 'tab
					Dim tabStop = _PromptSys_FontSize.cx * 8
					currentLineCharInfo[.x + 1].StartPos = currentLineCharInfo[.x].StartPos + _
						tabStop - currentLineCharInfo[.x].StartPos Mod tabStop
				Else
					If doubleUnitChar <> False Then
						doubleUnitChar = False
						currentLineCharInfo[.x + 1].StartPos = currentLineCharInfo[.x].StartPos
					Else
						Dim sz As SIZE
						Dim charLen As Long
						If _System_IsDoubleUnitChar(buf[i2], buf[i2 + 1]) Then
							charLen = 2
							doubleUnitChar = True
						Else
							charLen = 1
						EndIf
						Dim p = buf.StrPtr
						_PromptSys_GetTextExtentPoint32(hdc, VarPtr(p[i2]) As *Char, charLen, sz)
						currentLineCharInfo[.x + 1].StartPos = currentLineCharInfo[.x].StartPos + sz.cx
					End If
				End If
				.x++
			End If
		Next
		_PromptSys_TextLine[.y].Length = System.Math.Max(_PromptSys_TextLine[.y].Length, .x)

		'Draw the text buffer added
		'DrawPromptBuffer(hdc, StartLine, .y)
		InvalidateRect(_PromptSys_hWnd, ByVal 0, TRUE)
		UpdateWindow(_PromptSys_hWnd)
		SelectObject(hdc, hOldFont)
		ReleaseDC(_PromptSys_hWnd, hdc)
	End With
	LeaveCriticalSection(_PromptSys_SectionOfBufferAccess)
End Sub

Function PromptProc(hWnd As HWND, message As DWord, wParam As WPARAM, lParam As LPARAM) As LRESULT
	Select Case message
		Case WM_CREATE
			Return _PromptWnd_OnCreate(hWnd, ByVal lParam As *CREATESTRUCT)
		Case WM_PAINT
			_PromptWnd_OnPaint(hWnd)
		Case WM_SETFOCUS
			_PromptWnd_OnSetFocus(hWnd, wParam As HWND)
		Case WM_KILLFOCUS
			_PromptWnd_OnKillForcus(hWnd, wParam As HWND)
		Case WM_KEYDOWN
			_PromptWnd_OnKeyDown(wParam As DWord, LOWORD(lParam) As DWord, HIWORD(lParam) As DWord)
		Case WM_CHAR
			_PromptWnd_OnChar(hWnd, wParam, lParam)
		Case WM_IME_COMPOSITION
			Return _PromptWnd_OnImeCompostion(hWnd, wParam, lParam)
		Case WM_DESTROY
			_PromptWnd_OnDestroy(hWnd)
		Case Else
			PromptProc = DefWindowProc(hWnd, message, wParam, lParam)
			Exit Function
	End Select
	PromptProc = 0
End Function

Function _PromptWnd_OnCreate(hwnd As HWND, ByRef cs As CREATESTRUCT) As LRESULT
	Dim hdc = GetDC(hwnd)
	With _PromptSys_ScreenSize
		_PromptSys_hBitmap = CreateCompatibleBitmap(hdc, .cx, .cy)
	End With
	_PromptSys_hMemDC = CreateCompatibleDC(hdc)
	SelectObject(_PromptSys_hMemDC, _PromptSys_hBitmap)

	'Initialize for Win9x
	Dim hOldBrush = SelectObject(_PromptSys_hMemDC, GetStockObject(BLACK_BRUSH)) As HBRUSH
	With _PromptSys_ScreenSize
		PatBlt(_PromptSys_hMemDC, 0, 0, .cx, .cy, PATCOPY)
	End With
	SelectObject(_PromptSys_hMemDC, hOldBrush)

	Dim tm As TEXTMETRIC
	Dim hOldFont = SelectObject(_PromptSys_hMemDC, _PromptSys_hFont) As HFONT
	GetTextMetrics(_PromptSys_hMemDC, tm)
	SelectObject(_PromptSys_hMemDC, hOldFont)
	With _PromptSys_FontSize
		.cx = tm.tmAveCharWidth
		.cy = tm.tmHeight
	End With

	'_PromptSys_hFont initialize
	Dim lf As LOGFONT
	With lf
		.lfHeight = -MulDiv(12, GetDeviceCaps(hdc, LOGPIXELSY), 72)
		.lfWidth = 0
		.lfEscapement = 0
		.lfOrientation = 0
		.lfWeight = 0
		.lfItalic = 0
		.lfUnderline = 0
		.lfStrikeOut = 0
		.lfCharSet = SHIFTJIS_CHARSET
		.lfOutPrecision = OUT_DEFAULT_PRECIS
		.lfClipPrecision = CLIP_DEFAULT_PRECIS
		.lfQuality = DEFAULT_QUALITY
		.lfPitchAndFamily = FIXED_PITCH
		lstrcpy(.lfFaceName, ToTCStr("ＭＳ 明朝"))
	End With

	_PromptSys_hFont = CreateFontIndirect(lf)

	ReleaseDC(hwnd, hdc)

	_PromptWnd_OnCreate = 0
End Function

Sub _PromptWnd_OnPaint(hwnd As HWND)
	Dim ps As PAINTSTRUCT
	Dim hdc = BeginPaint(hwnd, ps)
	With _PromptSys_ScreenSize
		BitBlt(hdc, 0, 0, .cx, .cy, _PromptSys_hMemDC, 0, 0, SRCCOPY)
'	With ps.rcPaint
'		BitBlt(hdc, .left, .top, .right - .left, .bottom - .top, _PromptSys_hMemDC, .left, .top, SRCCOPY)
	End With
	DrawPromptBuffer(hdc, -1, 0)
	EndPaint(hwnd, ps)
End Sub

Sub _PromptWnd_OnSetFocus(hwnd As HWND, hwndOldFocus As HWND)
	If _PromptSys_InputLen <> -1 Then
		Dim himc = ImmGetContext(hwnd)
		If himc Then
			Dim CompForm As COMPOSITIONFORM
			With CompForm
				.dwStyle = CFS_POINT
				.ptCurrentPos.x = _PromptSys_CurPos.x * _PromptSys_FontSize.cx
				.ptCurrentPos.y = _PromptSys_CurPos.y * _PromptSys_FontSize.cy
			End With
			ImmSetCompositionWindow(himc, CompForm)

			Dim lf As LOGFONT
			GetObject(_PromptSys_hFont, Len(lf), lf)
			ImmSetCompositionFont(himc, lf)
		End If
		ImmReleaseContext(hwnd, himc)

		CreateCaret(hwnd, 0, 9, 6)
		With _PromptSys_CurPos
			SetCaretPos(_PromptSys_TextLine[.y].CharInfo[.x].StartPos, (.y + 1) * _PromptSys_FontSize.cy - 7)
		End With
		ShowCaret(hwnd)
	End If
End Sub

Sub _PromptWnd_OnKillForcus(hwnd As HWND, hwndNewFocus As HWND)
	HideCaret(hwnd)
	DestroyCaret()
End Sub

Sub _PromptWnd_OnKeyDown(vk As DWord, repeat As DWord, flags As DWord)
	If _PromptSys_InputLen = -1 Then
		_PromptSys_KeyChar = vk As Byte
	End If
End Sub

Sub _PromptWnd_OnDestroy(hwnd As HWND)
	DeleteDC(_PromptSys_hMemDC)
	DeleteObject(_PromptSys_hBitmap)

	PostQuitMessage(0)
End Sub

Sub _PromptWnd_OnChar(hwnd As HWND, wParam As WPARAM, lParam As LPARAM)
	Dim TempStr As String
	If _PromptSys_InputLen <> -1 Then
		If wParam = VK_BACK Then
			If _PromptSys_InputLen Then
				_PromptSys_InputLen--
				_PromptSys_InputStr[_PromptSys_InputLen] = 0

				_PromptSys_CurPos.x--
				With _PromptSys_CurPos
					_PromptSys_TextLine[.y].Text[.x] = 0
				End With
			End If
		ElseIf wParam = VK_RETURN Then
			_PromptSys_InputStr[_PromptSys_InputLen] = 0
			_PromptSys_InputLen = -1
			TempStr = Ex"\r\n"
		ElseIf wParam = &H16 Then
/*
			'Paste Command(Use Clippboard)
			OpenClipboard(hwnd)
			Dim hGlobal = GetClipboardData(CF_TEXT) As HGLOBAL
			If hGlobal = 0 Then Exit Sub
			Dim pTemp = GlobalLock(hGlobal) As PCSTR
#ifdef UNICODE 'A版ウィンドウプロシージャ用
			Dim tempSizeA = lstrlenA(pTemp)
			Dim tempSizeW = MultiByteToWideChar(CP_ACP, 0, pTemp, tempSizeA, 0, 0) + 1
			TempStr = ZeroString(tempSizeW)
			MultiByteToWideChar(CP_ACP, 0, pTemp, tempSizeA, StrPtr(TempStr), tempSizeW)
#else
			TempStr = ZeroString(lstrlen(pTemp) + 1)
			lstrcpy(StrPtr(TempStr), pTemp)
#endif
			memcpy(VarPtr(_PromptSys_InputStr[_PromptSys_InputLen]), TempStr.Chars, SizeOf (Char) * TempStr.Length)
			_PromptSys_InputLen += TempStr.Length

			GlobalUnlock(hGlobal)
			CloseClipboard()
*/
		Else
			Dim t = wParam As TCHAR
			TempStr = New String(VarPtr(t), 1)
			_PromptSys_InputStr[_PromptSys_InputLen] = TempStr[0]
			_PromptSys_InputLen++
		End If

		SendMessage(hwnd, WM_KILLFOCUS, 0, 0)
		ActiveBasic.Prompt.Detail.PRINT_ToPrompt(TempStr)
		SendMessage(hwnd, WM_SETFOCUS, 0, 0)
	End If
End Sub

Function _PromptWnd_GetCompositionStringW(himc As HIMC, ByRef rpsz As PWSTR) As Long
	Dim size = ImmGetCompositionStringW(himc, GCS_RESULTSTR, 0, 0) 'sizeはバイト単位
	rpsz = GC_malloc(size) As PWSTR
	If rpsz = 0 Then
		'Debug
		Return 0
	End If
	Return ImmGetCompositionStringW(himc, GCS_RESULTSTR, rpsz, size)
End Function

Function _PromptWnd_GetCompositionStringA(himc As HIMC, ByRef rpsz As PSTR) As Long
	Dim size = ImmGetCompositionStringA(himc, GCS_RESULTSTR, 0, 0) 'sizeはバイト単位
	rpsz = GC_malloc(size) As PSTR
	If rpsz = 0 Then
		'Debug
		Return 0
	End If
	Return ImmGetCompositionStringA(himc, GCS_RESULTSTR, rpsz, size)
End Function

Function _PromptWnd_OnImeCompostion(hwnd As HWND, wp As WPARAM, lp As LPARAM) As LRESULT
	If (lp And GCS_RESULTSTR) <> 0 Then
		Dim himc = ImmGetContext(hwnd)
		If himc = 0 Then
			'Debug
			Return 0
		End If
		Dim tempStr = Nothing As String
		Dim str As *Char
#ifdef UNICODE
		Dim osver = System.Environment.OSVersion
		With osver
			' GetCompositionStringW is not implimented in Windows 95
			If .Version.Major = 4 And .Version.Minor = 0 And .Platform = System.PlatformID.Win32Windows Then
				Dim strA As PCSTR
				Dim sizeA = _PromptWnd_GetCompositionStringA(himc, strA)
				tempStr = New String(strA, sizeA As Long)
			Else
				Dim size = _PromptWnd_GetCompositionStringW(himc, str)
				tempStr = New String(str, (size \ SizeOf (WCHAR)) As Long)
			End If
		End With
#else
		Dim size = _PromptWnd_GetCompositionStringA(himc, str)
		tempStr = New String(str, size As Long)
#endif
		ImmReleaseContext(hwnd, himc)

		ActiveBasic.Strings.ChrCopy(VarPtr(_PromptSys_InputStr[_PromptSys_InputLen]), tempStr.StrPtr, tempStr.Length As SIZE_T)
		_PromptSys_InputLen += tempStr.Length

		SendMessage(hwnd, WM_KILLFOCUS, 0, 0)
		ActiveBasic.Prompt.Detail.PRINT_ToPrompt(tempStr)
		SendMessage(hwnd, WM_SETFOCUS, 0, 0)

		_PromptWnd_OnImeCompostion = 0
	Else
		_PromptWnd_OnImeCompostion = DefWindowProc(hwnd, WM_IME_COMPOSITION, wp, lp)
	End If
End Function

Function PromptMain(data As VoidPtr) As DWord
	Dim i As Long
	'Allocate
	For i = 0 To 100
		With _PromptSys_TextLine[i]
			.Length = 0
			.Text = _System_calloc(SizeOf (Char) * 255)
			.CharInfo = _System_calloc(SizeOf (_PromptSys_CharacterInformation) * 255)
		End With
	Next

	'Current Colors initialize
	_PromptSys_NowTextColor = RGB(255, 255, 255)
	_PromptSys_NowBackColor = RGB(0, 0, 0)

	'Setup
	With _PromptSys_ScreenSize
		.cx = GetSystemMetrics(SM_CXSCREEN)
		.cy = GetSystemMetrics(SM_CYSCREEN)
	End With

	'Critical Section
	InitializeCriticalSection(_PromptSys_SectionOfBufferAccess)

	'Regist Prompt Class
	Dim wcl As WNDCLASSEX
	ZeroMemory(VarPtr(wcl), Len(wcl))
	With wcl
		.cbSize = Len(wcl)
		.hInstance = GetModuleHandle(0)
		.style = CS_HREDRAW Or CS_VREDRAW' or CS_DBLCLKS
		.hIcon = LoadImage(0, MAKEINTRESOURCE(IDI_APPLICATION), IMAGE_ICON, 0, 0, LR_DEFAULTSIZE Or LR_SHARED) As HICON
		.hIconSm = LoadImage(0, MAKEINTRESOURCE(IDI_WINLOGO), IMAGE_ICON, 0, 0, LR_DEFAULTSIZE Or LR_SHARED) As HICON
		.hCursor = LoadImage(0, MAKEINTRESOURCE(IDC_ARROW), IMAGE_CURSOR, 0, 0, LR_DEFAULTSIZE Or LR_SHARED) As HCURSOR
		.lpszClassName = ToTCStr("PROMPT")
		.lpfnWndProc = AddressOf(PromptProc)
		.hbrBackground = GetStockObject(BLACK_BRUSH)
	End With
	Dim atom = RegisterClassEx(wcl)

	'Create Prompt Window
	_PromptSys_hWnd = CreateWindowEx(WS_EX_CLIENTEDGE, atom As ULONG_PTR As LPCTSTR, ToTCStr("BASIC PROMPT"), _
		WS_OVERLAPPEDWINDOW, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, _
		0, 0, wcl.hInstance, 0)
	ShowWindow(_PromptSys_hWnd, SW_SHOW)
	UpdateWindow(_PromptSys_hWnd)
	SetEvent(_PromptSys_hInitFinish)
	Dim msg As MSG
	Do
		Dim iResult = GetMessage(msg, 0, 0, 0)
		If iResult = 0 Then
			System.Environment.ExitCode = msg.wParam As Long
			Exit Do
		ElseIf iResult = -1 Then
			Exit Do
		End If
		TranslateMessage(msg)
		DispatchMessage(msg)
	Loop

	'強制的に終了する
	End

	EnterCriticalSection(_PromptSys_SectionOfBufferAccess)

	For i = 0 to 100
		_System_free(_PromptSys_TextLine[i].Text)
		_System_free(_PromptSys_TextLine[i].CharInfo)
	Next

	LeaveCriticalSection(_PromptSys_SectionOfBufferAccess)

	DeleteCriticalSection(_PromptSys_SectionOfBufferAccess)

	End
End Function

'Prompt text command functoins

Sub Cls(n As Long)
	Dim i As Long

	'When parameter was omitted, num is set to 1
	If n = 0 Then n = 1

	If n = 1 Or n = 3 Then
		'Clear the text screen
		For i = 0 To 100
			With _PromptSys_TextLine[i]
				.Text[0] = 0 '_System_FillChar(_PromptSys_TextLine[i].Text, -1 As Char, 0)
				.Length = 0
			End With
		Next
		With _PromptSys_CurPos
			.x = 0
			.y = 0
		End With
	End If

	If n = 2 Or n = 3 Then
		'Clear the graphics screen
		Dim hOldBrush = SelectObject(_PromptSys_hMemDC, GetStockObject(BLACK_BRUSH))
		With _PromptSys_ScreenSize
			PatBlt(_PromptSys_hMemDC, 0, 0, .cx, .cy, PATCOPY)
		End With
		SelectObject(_PromptSys_hMemDC, hOldBrush)
	End If

	'Redraw
	InvalidateRect(_PromptSys_hWnd, ByVal 0, 0)
End Sub

Sub Color(textColorCode As Long, backColorCode As Long)
	_PromptSys_NowTextColor = GetBasicColor(textColorCode)
	If backColorCode = -1 Then
		_PromptSys_NowBackColor = -1
	Else
		_PromptSys_NowBackColor = GetBasicColor(backColorCode)
	End If
End Sub

Sub INPUT_FromPrompt(showStr As String)
*InputReStart

	ActiveBasic.Prompt.Detail.PRINT_ToPrompt(showStr)

	'Input by keyboard
	_PromptSys_InputLen = 0
	SendMessage(_PromptSys_hWnd, WM_SETFOCUS, 0, 0)
	While _PromptSys_InputLen <> -1
		Sleep(10)
	Wend
	SendMessage(_PromptSys_hWnd, WM_KILLFOCUS, 0, 0)

	'Set value to variable
	Const comma = &h2c As Char 'Asc(",")
	Dim broken = ActiveBasic.Strings.Detail.Split(New String(_PromptSys_InputStr), comma)
	Dim i As Long
	For i = 0 To ELM(broken.Count)
		If _System_InputDataPtr[i] = 0 Then
			ActiveBasic.Prompt.Detail.PRINT_ToPrompt(Ex"入力データの個数が多すぎます\r\n")
			Goto *InputReStart
		End If
		_System_Input_SetArgument(_System_InputDataPtr[i], _System_InputDataType[i], broken[i])
	Next

	If _System_InputDataPtr[i]<>0 Then
		ActiveBasic.Prompt.Detail.PRINT_ToPrompt(Ex"入力データの個数が足りません\r\n")
		Goto *InputReStart
	End If
End Sub

Sub Locate(x As Long, y As Long)
	If x < 0 Then x = 0
	If y < 0 Then y = 0
	If y > 100 Then y = 100
	With _PromptSys_CurPos
		.x = x
		.y = y
	End With

	Dim i = _PromptSys_TextLine[y].Length
	If i < x Then
		ActiveBasic.Strings.ChrFill(VarPtr(_PromptSys_TextLine[y].Text[i]), x - i, &h20 As Char) 'Asc(" ")
		Dim i2 As Long
		For i2 = i To ELM(x)
			_PromptSys_TextLine[y].CharInfo[i2].BackColor = -1
		Next
		_PromptSys_TextLine[y].Length = x
	End If
End Sub

'Prompt graphic command functions

Sub Circle(x As Long , y As Long, radius As Long, ColorCode As Long, StartPos As Double, EndPos As Double, Aspect As Double, bFill As Long, BrushColor As Long)
	Dim i1 As Long, i2 As Long, i3 As Long, i4 As Long

	Dim hPen = CreatePen(PS_SOLID,1,GetBasicColor(ColorCode))
	Dim hBrush As HBRUSH
	If bFill Then
		hBrush = CreateSolidBrush(GetBasicColor(BrushColor))
	Else
		hBrush = GetStockObject(NULL_BRUSH)
	End If

	Dim hDC = GetDC(_PromptSys_hWnd)
	Dim hOldPenDC = SelectObject(hDC, hPen)
	Dim hOldBrushDC = SelectObject(hDC, hBrush)
	Dim hOldPen = SelectObject(_PromptSys_hMemDC, hPen)
	Dim hOldBrush = SelectObject(_PromptSys_hMemDC, hBrush)

	Dim radi2 As Long
	If Aspect<1 Then
		radi2=(CDbl(radius)*Aspect) As Long
	Else
		radi2=radius
		radius=(CDbl(radius)/Aspect) As Long
	End If

	If StartPos=0 And EndPos=0 Then
		Ellipse(hDC,x-radius,y-radi2,x+radius,y+radi2)
		Ellipse(_PromptSys_hMemDC,x-radius,y-radi2,x+radius,y+radi2)
	Else
		Dim sw As Boolean
		StartPos *=StartPos
		EndPos *=EndPos

		If StartPos<0 Or EndPos<0 Then
			sw = True
		Else
			sw = False
		End If

		StartPos = Abs(StartPos)
		EndPos = Abs(EndPos)

		If StartPos<=78.5 Then
			i1=78
			i2=Int(StartPos)
		ElseIf StartPos<=235.5 Then
			StartPos -= 78.5
			i1=78-Int(StartPos)
			i2=78
		ElseIf StartPos<=392.5 Then
			StartPos -= 235.5
			i1=-78
			i2=78-Int(StartPos)
		ElseIf StartPos<=549.5 Then
			StartPos -= 392.5
			i1=-78+Int(StartPos)
			i2=-78
		ElseIf StartPos<=628 Then
			StartPos -= 549.5
			i1=78
			i2=-78+Int(StartPos)
		End If

		If EndPos<=78.5 Then
			i3=78
			i4=Int(EndPos)
		ElseIf EndPos<=235.5 Then
			EndPos -= 78.5
			i3=78-Int(EndPos)
			i4=78
		ElseIf EndPos<=392.5 Then
			EndPos -= 235.5
			i3=-78
			i4=78-Int(EndPos)
		ElseIf EndPos<=549.5 Then
			EndPos -= 392.5
			i3=-78+Int(EndPos)
			i4=-78
		ElseIf EndPos<=628 Then
			EndPos -= 549.5
			i3=78
			i4=-78+Int(EndPos)
		End If

		If sw Then
			Pie(hDC,x-radius,y-radi2,x+radius,y+radi2,  x+i1,y-i2,x+i3,y-i4)
			Pie(_PromptSys_hMemDC,x-radius,y-radi2,x+radius,y+radi2,  x+i1,y-i2,x+i3,y-i4)
		Else
			Arc(hDC,x-radius,y-radi2,x+radius,y+radi2,  x+i1,y-i2,x+i3,y-i4)
			Arc(_PromptSys_hMemDC,x-radius,y-radi2,x+radius,y+radi2,  x+i1,y-i2,x+i3,y-i4)
		End If
	End If

	SelectObject(hDC, hOldPenDC)
	SelectObject(hDC, hOldBrushDC)
	ReleaseDC(_PromptSys_hWnd, hDC)
	SelectObject(_PromptSys_hMemDC, hOldPen)
	SelectObject(_PromptSys_hMemDC, hOldBrush)
	DeleteObject(hPen)
	If bFill Then DeleteObject(hBrush)
End Sub

Sub Line(sx As Long, sy As Long, bStep As Long, ex As Long, ey As Long, ColorCode As Long, fType As Long, BrushColor As Long)
	Dim temp As Long

	If sx = &H80000000 And sy = &H80000000 Then
		With _PromptSys_GlobalPos
			sx = .x
			sy = .y
		End With
	End If

	If bStep Then
		ex += sx
		ey += sy
	Else
		If fType Then
			'ラインの場合（四角形でない場合）
			If sx>ex Then
				temp=ex
				ex=sx
				sx=temp
			End If
			If sy>ey Then
				temp=ey
				ey=sy
				sy=temp
			End If
		End If
	End If

	Dim hdc = GetDC(_PromptSys_hWnd)
	Dim hPen = CreatePen(PS_SOLID, 1, GetBasicColor(ColorCode))
	Dim hBrush As HBRUSH
	If fType=2 Then
		hBrush = CreateSolidBrush(GetBasicColor(BrushColor))
	Else
		hBrush = GetStockObject(NULL_BRUSH)
	End If

	SelectObject(hdc, hPen)
	SelectObject(hdc, hBrush)
	Dim hOldPen = SelectObject(_PromptSys_hMemDC, hPen)
	Dim hOldBrush = SelectObject(_PromptSys_hMemDC, hBrush)

	Select Case fType
		Case 0
			'line
			MoveToEx(_PromptSys_hMemDC,sx,sy,ByVal NULL)
			LineTo(_PromptSys_hMemDC,ex,ey)
			SetPixel(_PromptSys_hMemDC,ex,ey,GetBasicColor(ColorCode))
			MoveToEx(hdc,sx,sy,ByVal NULL)
			LineTo(hdc,ex,ey)
			SetPixel(hdc,ex,ey,GetBasicColor(ColorCode))
		Case Else
			'Rectangle
			Rectangle(hdc,sx,sy,ex+1,ey+1)
			Rectangle(_PromptSys_hMemDC,sx,sy,ex+1,ey+1)
	End Select

	ReleaseDC(_PromptSys_hWnd,hdc)
	SelectObject(_PromptSys_hMemDC,hOldPen)
	SelectObject(_PromptSys_hMemDC,hOldBrush)
	DeleteObject(hPen)
	If fType = 2 Then DeleteObject(hBrush)
	With _PromptSys_GlobalPos
		.x = ex
		.y = ey
	End With
End Sub

Sub PSet(x As Long, y As Long, ColorCode As Long)
	Dim hdc = GetDC(_PromptSys_hWnd)
	SetPixel(hdc, x, y, GetBasicColor(ColorCode))
	SetPixel(_PromptSys_hMemDC, x, y, GetBasicColor(ColorCode))
	ReleaseDC(_PromptSys_hWnd, hdc)
	With _PromptSys_GlobalPos
		.x = x
		.y = y
	End With
End Sub

Sub Paint(x As Long, y As Long, BrushColor As Long, LineColor As Long)
	Dim hbr = CreateSolidBrush(GetBasicColor(BrushColor))

	Dim hdc = GetDC(_PromptSys_hWnd)
	Dim hbrOld = SelectObject(_PromptSys_hMemDC, hbr)
	Dim hbrOldWndDC = SelectObject(hdc, hbr)

	ExtFloodFill(hdc, x, y, GetBasicColor(LineColor), FLOODFILLBORDER)
	ExtFloodFill(_PromptSys_hMemDC, x, y, GetBasicColor(LineColor), FLOODFILLBORDER)

	ReleaseDC(_PromptSys_hWnd, hdc)
	SelectObject(_PromptSys_hMemDC, hbrOld)
	SelectObject(hdc, hbrOldWndDC)
	DeleteObject(hbr)
End Sub

Function Inkey$() As String
	If _PromptSys_KeyChar=0 Then
		Inkey$=""
	Else
		Inkey$=Chr$(_PromptSys_KeyChar)
	End If
	_PromptSys_KeyChar=0
End Function

Function Input$(length As Long) As String
	Dim i = 0 As Long

	If length<=0 Then
		Input$=""
		Exit Function
	End If

	While 1
		If _PromptSys_KeyChar Then
			Input$=Input$+Chr$(_PromptSys_KeyChar)
			_PromptSys_KeyChar=0
			i++
			If i >= length Then
				Exit While
			End If
		End If
		Sleep(1)
	Wend
End Function

End Namespace 'Detail

Function OwnerWnd() As HWND
	Return Detail._PromptSys_hWnd
End Function

End Namespace 'Prompt
End Namespace 'ActiveBasic

'----------------------
' Prompt text Commands
'----------------------

Sub PRINT_ToPrompt(s As String)
	ActiveBasic.Prompt.Detail.PRINT_ToPrompt(s)
End Sub

Macro CLS()(num As Long)
	ActiveBasic.Prompt.Detail.Cls(num)
End Macro

Macro COLOR(TextColorCode As Long)(BackColorCode As Long)
	ActiveBasic.Prompt.Detail.Color(TextColorCode, BackColorCode)
End Macro

'---------- Defined in "command.sbp" ----------
'Dim _System_InputDataPtr[_System_MAX_PARMSNUM] As VoidPtr
'Dim _System_InputDataType[_System_MAX_PARMSNUM] As DWord
'----------------------------------------------
Sub INPUT_FromPrompt(ShowStr As String)
	ActiveBasic.Prompt.Detail.INPUT_FromPrompt(ShowStr)
End Sub

/* TODO: _System_GetUsingFormatを用意して実装する
Sub PRINTUSING_ToPrompt(UsingStr As String)
	ActiveBasic.Prompt.Detail.PRINT_ToPrompt(_System_GetUsingFormat(UsingStr))
End Sub
*/

Macro LOCATE(x As Long, y As Long)
	ActiveBasic.Prompt.Detail.Locate(x, y)
End Macro


'-------------------
' Graphics Commands
'-------------------

Macro CIRCLE(x As Long , y As Long, radius As Long)(ColorCode As Long, StartPos As Double, EndPos As Double, Aspect As Double, bFill As Long, BrushColor As Long)
	'呼び出し方法は以下のようになります（コンパイラがパラメータの並びを最適化します）
	'Circle (x, y), radius [, color] [, start] [, end] [, aspect] [, f] [, color2]
	ActiveBasic.Prompt.Detail.Circle(x, y, radius, ColorCode, StartPos, EndPos, Aspect, bFill, BrushColor)
End Macro

Macro LINE(sx As Long, sy As Long, bStep As Long, ex As Long, ey As Long)(ColorCode As Long, fType As Long, BrushColor As Long)
	'呼び出し方法は以下のようになります（コンパイラがパラメータの並びを最適化します）
	'Line (sx,sy)-[STEP](ex,ey),[ColorCode],[B/Bf],[BrushColor]
	ActiveBasic.Prompt.Detail.Line(sx, sy, bStep, ex, ey, ColorCode, fType, BrushColor)
End Macro

Macro PSET(x As Long, y As Long)(ColorCode As Long)
	'呼び出し方法は以下のようになります（コンパイラがパラメータの並びを最適化します）
	'PSet (x,y),ColorCode
	ActiveBasic.Prompt.Detail.PSet(x, y, ColorCode)
End Macro

Macro PAINT(x As Long, y As Long, BrushColor As Long)(ByVal LineColor As Long)
	'呼び出し方法は以下のようになります（コンパイラがパラメータの並びを最適化します）
	'Paint (x,y),BrushColor,LineColor
	ActiveBasic.Prompt.Detail.Paint(x, y, BrushColor, LineColor)
End Macro


'-----------
' Functions
'-----------

Function Inkey$() As String
	Return ActiveBasic.Prompt.Detail.Inkey$()
End Function

Function Input$(length As Long) As String
	Return ActiveBasic.Prompt.Detail.Input$(length)
End Function

ActiveBasic.Prompt.Detail._PromptSys_Initialize()

#endif '_INC_PROMPT