'prompt.sbp


#ifndef _INC_PROMPT
#define _INC_PROMPT


#include <api_imm.sbp>

Dim _PromptSys_hWnd As HWND
Dim _PromptSys_dwThreadID As DWord
Dim _PromptSys_bInitFinish As BOOL

'text

Dim _PromptSys_LogFont As LOGFONTA 'LOGFONT
Dim _PromptSys_hFont As HFONT
Dim _PromptSys_FontSize As SIZE
Dim _PromptSys_InputStr[255] As Char
Dim _PromptSys_InputLen As Long
Dim _PromptSys_KeyChar As Byte
Dim _PromptSys_CurPos As POINTAPI
Dim _PromptSys_Buffer[100] As *Char
Dim _PromptSys_TextColor[100] As *COLORREF
Dim _PromptSys_BackColor[100] As *COLORREF
Dim _PromptSys_TextWidth[100] As Long
Dim _PromptSys_NowTextColor As COLORREF
Dim _PromptSys_NowBackColor As COLORREF
Dim _PromptSys_SectionOfBufferAccess As CRITICAL_SECTION


_PromptSys_InputLen=-1

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


_PromptSys_bInitFinish=0
CreateThread(0, 0, AddressOf(PromptMain) As LPTHREAD_START_ROUTINE, 0, 0, _PromptSys_dwThreadID)
Do
	Sleep(20)
Loop Until _PromptSys_bInitFinish

Sub DrawPromptBuffer(hDC As HDC, StartLine As Long, EndLine As Long)
	Dim i As Long, i2 As Long, i3 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_Buffer[0])
		_System_free(_PromptSys_TextColor[0])
		_System_free(_PromptSys_BackColor[0])
		For i = 0 To 100 - 1
			_PromptSys_Buffer[i] = _PromptSys_Buffer[i+1]
			_PromptSys_TextColor[i] = _PromptSys_TextColor[i+1]
			_PromptSys_BackColor[i] = _PromptSys_BackColor[i+1]
			_PromptSys_TextWidth[i] = _PromptSys_TextWidth[i+1]
		Next
		_PromptSys_Buffer[100] = _System_calloc(SizeOf (Char) * 255)
		_PromptSys_TextColor[100] = _System_calloc(SizeOf(COLORREF) * 255)
		_PromptSys_BackColor[100] = _System_calloc(SizeOf(COLORREF) * 255)
		_PromptSys_TextWidth[100] = 0

		_PromptSys_CurPos.y--

		'Redraw
		StartLine = -1
	Wend

	i = 0
	While i * _PromptSys_FontSize.cy < rc.bottom and i <= 100
		If StartLine=-1 or (StartLine<=i and i<=EndLine) Then
			Dim sz As SIZE
			i3 = lstrlen(_PromptSys_Buffer[i])
			GetTextExtentPoint32(hDC, _PromptSys_Buffer[i], i3, sz)

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

			Dim width = 0 As Long
			For i2 = 0 To i3-1
				SetTextColor(hDC, _PromptSys_TextColor[i][i2])
				If _PromptSys_BackColor[i][i2] = -1 Then
					SetBkMode(hDC, TRANSPARENT)
				Else
					SetBkMode(hDC, OPAQUE)
					SetBkColor(hDC, _PromptSys_BackColor[i][i2])
				End If

				Dim temporary[2] As Char
				Dim tempLen As Long
				temporary[0] = _PromptSys_Buffer[i][i2]
#ifdef UNICODE
				If _System_IsSurrogatePair(_PromptSys_Buffer[i][i2], _PromptSys_Buffer[i][i2+1]) Then
#else
				If IsDBCSLeadByte(temporary[0]) Then
#endif
					temporary[1] = _PromptSys_Buffer[i][i2+1]
					temporary[2] = 0
					i2++
					tempLen = 2
				Else
					temporary[1] = 0
					tempLen = 1
				End If
				With _PromptSys_FontSize
					TextOut(hDC, width, i * .cy, temporary, tempLen)
				End With
				GetTextExtentPoint32(hDC, temporary, i3, sz)
				width += sz.cx
			Next
		End If

		i++
	Wend

	SelectObject(hDC, hOldFont)
End Sub

Sub PRINT_ToPrompt(buf As String)
	EnterCriticalSection(_PromptSys_SectionOfBufferAccess)
	With _PromptSys_CurPos
		Dim StartLine As Long
		StartLine = .y
		'Addition
		Dim i2 = 0 As Long, i3 As Long
		Do
			If buf[i2] = 9 Then	'tab
				i3 = 8 - (.x And 7) '(.x mod 8)
				_System_FillChar(VarPtr(_PromptSys_Buffer[.y][.x]), i3, &h20) 'Asc(" ")
				i2++
				.x += i3
				Continue
			End If

			If buf[i2] = 13 and buf[i2+1] = 10 Then	'\r\n
				i2 += 2
				.y++
				.x = 0
				Continue
			End If

			If buf[i2] = 0 Then Exit Do
			_PromptSys_Buffer[.y][.x] = buf[i2]
			_PromptSys_TextColor[.y][.x] = _PromptSys_NowTextColor
			_PromptSys_BackColor[.y][.x] = _PromptSys_NowBackColor

			i2++
			.x++
		Loop

		'Draw the text buffer added
		Dim hDC = GetDC(_PromptSys_hWnd)
		DrawPromptBuffer(hDC, StartLine, .y)
		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
	Dim hIMC As HIMC
	Dim hDC As HDC
	Dim ps As PAINTSTRUCT
	Dim TempStr As String
	Dim CompForm As COMPOSITIONFORM

	Select Case message
		Case WM_CREATE
			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
			GetTextExtentPoint32(_PromptSys_hMemDC, " " As PCTSTR, 1, _PromptSys_FontSize)
			GetTextMetrics(_PromptSys_hMemDC, tm)
			SelectObject(_PromptSys_hMemDC, hOldFont)
			_PromptSys_FontSize.cy = tm.tmHeight

			ReleaseDC(hWnd,hDC)
		Case WM_PAINT
			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)

			_PromptSys_bInitFinish = TRUE
		Case WM_SETFOCUS
			If _PromptSys_InputLen<>-1 Then
				hIMC = ImmGetContext(hWnd)
				If hIMC Then
					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)
					ImmSetCompositionFontA(hIMC, _PromptSys_LogFont)
				End If
				ImmReleaseContext(hWnd, hIMC)

				CreateCaret(hWnd, NULL, 9, 6)
				SetCaretPos(_PromptSys_CurPos.x*_PromptSys_FontSize.cx, _
					(_PromptSys_CurPos.y+1)*_PromptSys_FontSize.cy-7)
				ShowCaret(hWnd)
			End If
		Case WM_KILLFOCUS
			HideCaret(hWnd)
			DestroyCaret()
		Case WM_KEYDOWN
			If _PromptSys_InputLen=-1 Then
				_PromptSys_KeyChar=wParam As Byte
			End If
		Case WM_CHAR
			If _PromptSys_InputLen <> -1 Then
				If wParam = VK_BACK Then
					If _PromptSys_InputLen Then
						_PromptSys_InputLen--
						_PromptSys_InputStr[_PromptSys_InputLen] = 0

						_PromptSys_CurPos.x--
						_PromptSys_Buffer[_PromptSys_CurPos.y][_PromptSys_CurPos.x] = 0
					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 Return 0
					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
					_PromptSys_InputStr[_PromptSys_InputLen] = wParam As Byte
					_PromptSys_InputLen++

					TempStr.ReSize(1)
					TempStr[0] = wParam As Char
				End If

				SendMessage(hWnd, WM_KILLFOCUS, 0, 0)
				PRINT_ToPrompt(TempStr)
				SendMessage(hWnd, WM_SETFOCUS, 0, 0)
			End If
		Case WM_IME_COMPOSITION
			Return _PromptSys_OnImeCompostion(hWnd, wParam, lParam)
		Case WM_DESTROY
			DeleteDC(_PromptSys_hMemDC)
			DeleteObject(_PromptSys_hBitmap)

			PostQuitMessage(0)
		Case Else
			PromptProc=DefWindowProc(hWnd,message,wParam,lParam)
			Exit Function
	End Select
	PromptProc=0
End Function

Function _PromptSys_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 size = ImmGetCompositionString(himc, GCS_RESULTSTR, 0, 0) 'sizeはバイト単位
		Dim str = _System_malloc(size) As PTSTR
		If str = 0 Then
			'Debug
			Return 0
		End If
		ImmGetCompositionString(himc, GCS_RESULTSTR, str, size)
		ImmReleaseContext(hwnd, himc)

		memcpy(VarPtr(_PromptSys_InputStr[_PromptSys_InputLen]), str, size)
		_PromptSys_InputLen += size

		Dim tempStr As String(str, size \ SizeOf (Char))
		_System_free(str)

		SendMessage(hwnd, WM_KILLFOCUS, 0, 0)
		PRINT_ToPrompt(tempStr)
		SendMessage(hwnd, WM_SETFOCUS, 0, 0)

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

Function PromptMain(dwData As Long) As Long
	Dim i As Long

	'Allocate
	For i=0 To 100
		_PromptSys_Buffer[i] = _System_calloc(SizeOf (Char) * 255)
		_PromptSys_TextColor[i] = _System_calloc(SizeOf(COLORREF) * 255)
		_PromptSys_BackColor[i] = _System_calloc(SizeOf(COLORREF) * 255)
	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

	'LogFont initialize
	With _PromptSys_LogFont
		.lfHeight = -16
		.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
#ifdef UNICODE
		WideCharToMultiByte(CP_ACP, 0, "ＭＳ 明朝", 5, .lfFaceName, LF_FACESIZE, 0, 0)
#else
		lstrcpy(.lfFaceName, "ＭＳ 明朝")
#endif
	End With

	_PromptSys_hFont = CreateFontIndirectA(ByVal VarPtr(_PromptSys_LogFont))

	'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 = LoadIcon(NULL, MAKEINTRESOURCE(IDI_APPLICATION))
		.hIconSm = LoadIcon(NULL, MAKEINTRESOURCE(IDI_WINLOGO))
		.hCursor = LoadCursor(NULL, MAKEINTRESOURCE(IDC_ARROW))
		.lpszClassName = "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 PCSTR, "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)

	Dim msg As MSG
	Do
		Dim iResult = GetMessage(msg, 0, 0, 0)
		If iResult = 0 or iResult = -1 Then Exit Do
		TranslateMessage(msg)
		DispatchMessage(msg)
	Loop

	'強制的に終了する
	ExitProcess(0)

	EnterCriticalSection(_PromptSys_SectionOfBufferAccess)
	
	For i=0 to 100
		_System_free(_PromptSys_Buffer[i])
		_System_free(_PromptSys_TextColor[i])
		_System_free(_PromptSys_BackColor[i])
	Next

	LeaveCriticalSection(_PromptSys_SectionOfBufferAccess)

	DeleteCriticalSection(_PromptSys_SectionOfBufferAccess)

	ExitProcess(0)
End Function


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

Macro CLS()(num As Long)
	Dim i As Long
	Dim hOldBrush As HBRUSH

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

	If num=1 or num=3 Then
		'Clear the text screen
		For i = 0 To 100
			_System_FillChar(_PromptSys_Buffer[i],255,0)
		Next
		With _PromptSys_CurPos
			.x = 0
			.y = 0
		End With
	End If

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

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

Macro 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 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)
	Dim i As Long ,i2 As Long, i3 As Long
	Dim buf As String

*InputReStart

	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
	i = 0
	i2 = 0
	buf = ZeroString(lstrlen(_PromptSys_InputStr))
	While 1
		i3 = 0
		While 1
			If _PromptSys_InputStr[i2] = &h2c Then
				buf.Chars[i3] = 0
				Exit While
			End If

			buf.Chars[i3] = _PromptSys_InputStr[i2]

			If _PromptSys_InputStr[i2] = 0 Then Exit While

			i2++
			i3++
		Wend

		_System_Input_SetArgument(_System_InputDataPtr[i], _System_InputDataType[i], buf, i3)

		i++
		If _System_InputDataPtr[i]=0 and _PromptSys_InputStr[i2]=&h2c Then 'Asc(",")
			PRINT_ToPrompt(Ex"入力データの個数が多すぎます\r\n")
			Goto *InputReStart
		ElseIf _PromptSys_InputStr[i2]=0 Then
			If _System_InputDataPtr[i]<>0 Then
				PRINT_ToPrompt(Ex"入力データの個数が足りません\r\n")
				Goto *InputReStart
			Else
				Exit While
			End If
		End If

		i2++
	Wend
End Sub

Sub PRINTUSING_ToPrompt(UsingStr As String)
	PRINT_ToPrompt(_System_GetUsingFormat(UsingStr))
End Sub

Macro LOCATE(x As Long, y As Long)
	Dim i As Long, i2 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
	i=0
	While _PromptSys_Buffer[y][i]
		i++
	Wend

	If i < x Then
		_System_FillChar(VarPtr(_PromptSys_Buffer[y][i]), x - i, &h20) 'Asc(" ")
		For i2 = i To x - 1
			_PromptSys_BackColor[y][i2] = -1
		Next
	End If
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]

	Dim hBrush As HBRUSH
	Dim radi2 As Long
	Dim sw As Long
	Dim i1 As Long, i2 As Long, i3 As Long, i4 As Long

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

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

	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
		StartPos *=StartPos
		EndPos *=EndPos

		If StartPos<0 Or EndPos<0 Then
			sw=1
		Else
			sw=0
		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

	ReleaseDC(_PromptSys_hWnd,hDC)
	SelectObject(_PromptSys_hMemDC,hOldPen)
	SelectObject(_PromptSys_hMemDC,hOldBrush)
	DeleteObject(hPen)
	If bFill Then DeleteObject(hBrush)
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]
	Dim temp As Long

	If sx=&H80000000 And sy=&H80000000 Then
		sx=_PromptSys_GlobalPos.x
		sy=_PromptSys_GlobalPos.y
	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)

	_PromptSys_GlobalPos.x=ex
	_PromptSys_GlobalPos.y=ey
End Macro

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

	Dim hDC=GetDC(_PromptSys_hWnd)
	SetPixel(hDC,x,y,GetBasicColor(ColorCode))
	SetPixel(_PromptSys_hMemDC,x,y,GetBasicColor(ColorCode))
	ReleaseDC(_PromptSys_hWnd,hDC)

	_PromptSys_GlobalPos.x=x
	_PromptSys_GlobalPos.y=y
End Macro

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

	Dim hDC As HDC
	Dim hBrush As HBRUSH, hOldBrush As VoidPtr
	
	hBrush=CreateSolidBrush(GetBasicColor(BrushColor))

	hDC=GetDC(_PromptSys_hWnd)
	SelectObject(hDC,hBrush)
	hOldBrush=SelectObject(_PromptSys_hMemDC,hBrush)

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

	ReleaseDC(_PromptSys_hWnd,hDC)
	SelectObject(_PromptSys_hMemDC,hOldBrush)
	DeleteObject(hBrush)
End Macro


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

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 As Long

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

	i=0
	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


#endif '_INC_PROMPT