UWSCでCUI（コンソールウインドウ）を扱う（その２）

UWSCでCUIを扱う、CUIモジュールを少し改変してみた。
STOPFORMで止められるようにした（メモリーリークするけど）。

ReadConsoleをUWSCのスレッドから直接呼び出すと、STOPFORMが利かなくなるので、ネイティブスレッドから呼び出すように変更。
ついでに、画面がちらつくけど、画面バッファコピーを利用しての補完もしてみた。
ネイティブスレッドを使うので、Asmモジュールに依存しています。

スクリプト

CUI.uws

OPTION EXPLICIT

CALL Asm

IFB GET_UWSC_NAME = "CUI.uws" THEN
	CUI.Create()

	DIM loop = TRUE, cmd
	WHILE loop
		CUI.Output("> ", FALSE)
		cmd = CUI.Input("CuiCompSample(hThread)")
		//cmd = CUI.Input()
		loop = (cmd <> "exit") AND (cmd <> "quit")
	WEND

	CUI.Destroy()
ENDIF
PROCEDURE CuiCompSample(th)
	DIM ret = 258, timeout = $7fffffff, buf
	WHILE ret = 258 AND timeout > 0
		IFB GETKEYSTATE(VK_TAB) THEN
			SCKEY(CUI.ID(), VK_BACK)
			buf = COPY(CUI.CopyBuffer(), 3)	// 「> 」分飛ばす
			IFB buf = COPY("exit", 1, LENGTH(buf)) THEN
				CUI.Paste(COPY("exit", LENGTH(buf) + 1))
			ENDIF
		ENDIF
		ret = Asm.WaitForSingleObject(th, 100)
		timeout = timeout - 100
	WEND
FEND


module CUI
	dim hInput, hOutput, hError
	dim orgTextAttr = 0
	dim FOREGROUND_ORIGINAL, BACKGROUND_ORIGINAL
	dim id = -1, _addr = 0, _para = 0

	function Create(title = GET_UWSC_NAME, BufferSize = 1024)
		result = AllocConsole()
		if result then SetConsoleTitleA(title)

		hInput  = GetStdHandle(STD_INPUT_HANDLE)
		hOutput = GetStdHandle(STD_OUTPUT_HANDLE)
		hError  = GetStdHandle(STD_ERROR_HANDLE)
		orgTextAttr = getOriginalTextAttribute()
		BACKGROUND_ORIGINAL = orgTextAttr and $F0
		FOREGROUND_ORIGINAL = orgTextAttr and $F
		id = getid(title, "ConsoleWindowClass")

		_addr = Asm.Set("VYvsUYtFCIlF/GoAi038g8EMUYtV/ItCCFCLTfyLUQRSi0X8iwhRi1X8i0IQ/9CL5V3CBADM")
		DIM paraSize = 20, i = 0
		_para = Asm.Alloc(paraSize)
		IFB _addr > 0 AND _para > 0 THEN
			i = i + Asm.SetDword(_para + i, hInput)
			i = i + Asm.SetDword(_para + i, Asm.Alloc(BufferSize))
			i = i + Asm.SetDword(_para + i, BufferSize)
			i = i + Asm.SetDword(_para + i, 0)
			i = i + Asm.SetDword(_para + i, Asm.GetProcAddress(Asm.hK32, "ReadConsoleA"))
		ENDIF
	fend

	function ID()
		result = id
	fend

	function GetColor(fgcolor = "", bgcolor = "")
		DIM f = _color(fgcolor)
		if f < 0 then f = FOREGROUND_ORIGINAL
		DIM b = _color(bgcolor)
		if b < 0 then b = BACKGROUND_ORIGINAL else b = b * $10
		result = f or b
	fend

	function _color(color = "", def = -1)
		select color
			case "blue", "b"
				result = FOREGROUND_BLUE or FOREGROUND_INTENSITY
			case "green", "g"
				result = FOREGROUND_GREEN or FOREGROUND_INTENSITY
			case "red", "r"
				result = FOREGROUND_RED or FOREGROUND_INTENSITY
			case "yellow", "y"
				result = FOREGROUND_GREEN or FOREGROUND_RED or FOREGROUND_INTENSITY
			case "yellow-", "y-"
				result = FOREGROUND_GREEN or FOREGROUND_RED
			case "pink", "p"
				result = FOREGROUND_BLUE or FOREGROUND_RED or FOREGROUND_INTENSITY
			case "lightblue", "lb"
				result = FOREGROUND_BLUE or FOREGROUND_GREEN or FOREGROUND_INTENSITY
			case "white", "w"
				result = FOREGROUND_BLUE or FOREGROUND_GREEN or FOREGROUND_RED or FOREGROUND_INTENSITY
			case "black", "bl", "bk"
				result = 0
			case "gray", "gy"
				result = FOREGROUND_INTENSITY
			default
				result = def
		selend
	fend

	function Destroy()
		IFB _para THEN
			Asm.Free(Asm.GetDword(_para + 4))
			Asm.Free(_para)
		ENDIF
		IF _addr THEN Asm.Free(_addr)
		result = FreeConsole()
	fend

	procedure Clear(row = -1, col = -1, len = -1)
		DIM cbi = getConsoleScreenBufferInfoArray()
		if row = -1 then row = cbi[3]
		if col = -1 then col = cbi[2]
		if len = -1 then len = cbi[0] - col
		SetConsoleCursorPosition(hOutput, col + row * $10000)
		Output(FORMAT(" ", len), FALSE)
		SetConsoleCursorPosition(hOutput, cbi[2] + cbi[3] * $10000)
	fend

	function Output(Text = "", Cr = TRUE, color = -1, hOut = -1)
		if hOut = -1 THEN hOut = hOutput
		if Cr then Text = Text + "<#CR>"
		color = _color(color, color)
		if length(Text) then
			dim size
			if color > -1 then SetConsoleTextAttribute(hOutput, color)
			result = WriteConsoleA(hOutput, Text, lengthb(Text), size, 0)
			if color > -1 then SetConsoleTextAttribute(hOutput, orgTextAttr)
		endif
	fend

	function Input(func = EMPTY)
		DIM i = 1, th = 0, timeout = $7fffffff
		IF _addr AND _para THEN th = Asm.Run(_addr, _para, i, 0)
		THREAD _inputThread(func, th)
		WHILE i = 258 AND timeout > 0
			i = Asm.WaitForSingleObject(th, 100)
			timeout = timeout - 100
		WEND
		ifb i = 0 then
			i = Asm.GetDword(_para + 12)
			result = FORMAT(CHR(0), i)
			RtlMoveMemory(result, Asm.GetDword(_para + 4), i)
			result = replace(result, "<#cr>", "")
		endif
	fend
	procedure _inputThread(func, hThread)
		if func <> EMPTY then EVAL(func)
	fend

	function Peek(BufferSize = 128)
		DIM buf = "", ir[INPUT_RECORD_LEN * BufferSize], read, i, vk, add
		IFB PeekConsoleInputW(hInput, ir, BufferSize, read) AND read THEN
			FOR i = 0 TO read - 1
				IFB ir[INPUT_RECORD_LEN * i] = 1 AND ir[INPUT_RECORD_LEN * i + 2] THEN
					vk = ir[INPUT_RECORD_LEN * i + 5]
					// ir[INPUT_RECORD_LEN * i + 4] : RepeatCountはとりあえず無視か？
					IF vk = VK_BACK THEN
						buf = COPY(buf, 1, LENGTH(buf) - 1)
					ELSE
						// vkは小文字なので、CAPSLOCKとSHIFTで大文字にする
						add = CHR(ir[INPUT_RECORD_LEN * i + 7])
						IF vk <> VK_SPACE AND add <> "　" THEN add = TRIM(add)
						IFB !LENGTH(add) THEN
							PRINT "vk:" + vk
						ELSEIF (ir[INPUT_RECORD_LEN * i + 8] AND $90 = $80) OR (ir[INPUT_RECORD_LEN * i + 8] AND $90 = $10) THEN
							buf = buf + STRCONV(add, SC_UPPERCASE)
						ELSE
							buf = buf + add
						ENDIF
					ENDIF
				ENDIF
			NEXT
		ENDIF
		RESULT = buf
	fend

	function CopyBuffer(row = -1)
		DIM hwnd = IdToHnd(id)
		SendMessageA(hwnd, $111, 65525, 0)
		SendMessageA(hwnd, $111, 65520, 0)
		result = GetStr(0)
		if row = -1 then
			DIM cbi = getConsoleScreenBufferInfoArray()
			row = cbi[3]
		endif
		if row >= 0 then
			result = split(result, "<#CR>")
			result = result[row]
		endif
	fend
	function Paste(cmd)
		SendStr(0, cmd)
		result = SendMessageA(IdToHnd(id), $111, 65521, 0)
	fend

	function Error(Text, Cr = TRUE, color = -2)
		if color = -2 then color = GetColor("r")
		result = Output(Text, Cr, color, hError)
	fend

	function getConsoleScreenBufferInfoArray()
		result = safearray(0, 10)
		GetConsoleScreenBufferInfo(hOutput, result)
	fend

	function getOriginalTextAttribute()
		DIM CONSOLE_SCREEN_BUFFER_INFO = getConsoleScreenBufferInfoArray()
		result = CONSOLE_SCREEN_BUFFER_INFO[4]
	fend

	function GetConsoleWidth()
		DIM CONSOLE_SCREEN_BUFFER_INFO = getConsoleScreenBufferInfoArray()
		result = CONSOLE_SCREEN_BUFFER_INFO[0]
	fend

	def_dll AllocConsole():bool:kernel32
	def_dll FreeConsole():bool:kernel32
	def_dll GetStdHandle(dword):dword:kernel32
	def_dll ReadConsoleA(dword, var string, dword, var dword, dword):bool:kernel32
	def_dll WriteConsoleA(dword, string, dword, var dword, dword):bool:kernel32
	def_dll SetConsoleTitleA(string):bool:kernel32
	def_dll SetConsoleTextAttribute(dword, int):bool:kernel32
	def_dll GetConsoleScreenBufferInfo(hwnd, word[]):bool:kernel32
	def_dll PeekConsoleInputW(dword, var word[], dword, var dword): bool: kernel32
	def_dll SetConsoleCursorPosition(dword, dword): bool: kernel32
	def_dll RtlMoveMemory(var string, dword, dword): kernel32
	def_dll SendMessageA(Hwnd,Long,Long,Dword):Long:user32

	const STD_INPUT_HANDLE  = -10   //標準入力ハンドルを取得
	const STD_OUTPUT_HANDLE = -11   //標準出力ハンドルを取得
	const STD_ERROR_HANDLE  = -12   //標準エラーハンドルを取得

	const FOREGROUND_BLUE		= $1  //文字色に青を加える
	const FOREGROUND_GREEN		= $2  //文字色に緑を加える
	const FOREGROUND_RED		= $4  //文字色に赤を加える
	const FOREGROUND_INTENSITY	= $8  //文字色を高輝度にする
	const BACKGROUND_BLUE		= $10 //背景色に青を加える
	const BACKGROUND_GREEN		= $20 //背景色に緑を加える
	const BACKGROUND_RED		= $40 //背景色に赤を加える
	const BACKGROUND_INTENSITY	= $80 //背景色を高輝度にする

	const INPUT_RECORD_LEN = 10

endmodule

これだけ実行すると、テストコードにより、「exit」の補完がTABキーで行えます。
、、、クリップボード依存と、画面ちらつきがあるから、イマイチ使いたくない。
とはいえ、STOPFORMが有効になるので、その点はマル。
補完とかしなければ、クリップボード依存はないので、STOPFORM有効だけ利用できる。
でもでも、メモリーリークがバツ、、、そんなに気にしなくても良いけど。