OpenConsole

BlitzMax Forums/BlitzMax Programming/OpenConsole

Perturbatio

(Posted 2005) [#1]

I've been playing about over the last few hours and have created the beginnings of (what I believe to be) a useful tool.

OpenConsole(tm)(c)(R)(ASAP)
What it is:

A command console for adding to your apps.
Useable
pretty easy to plug in to an app
probably riddled with bugs and memory leaks

What it isn't:

anywhere near finished
attractive
a banana
related to Bob Monkhouse
riddled with spiders and leeks
perfect
properly commented

My hope is that people will add and post useful fixes/additions to it so everyone can benefit from it.

It took me two lines of code to add this to rockout.bmx so it's definitely easy to implement.

Rem
Openconsole Version 0.1.0
created by Kris Kelly (Perturbatio) (C) 2005

TODO:
	Add text wrapping
	Add output scrolling
	Use TAB to autocomplete a command
	Perhaps turn it into a module?
EndRem
Strict

Function SplitString:TList(inString:String, Delim:String)
	Local tempList : TList = New TList
	Local currentChar : String = ""
	Local count : Int = 0
	Local TokenStart : Int = 0
	
	If Len(Delim)<>1 Then Return Null
	
	inString = Trim(inString)
	
	For count = 0 Until Len(inString)
		If inString[count..count+1] = delim Then
			tempList.AddLast(inString[TokenStart..Count])
			TokenStart = count + 1
		End If
		FlushMem
	Next
	tempList.AddLast(inString[TokenStart..Count])	
	Return tempList
End Function


Function GetKey:Int()
	Const RepeatRate : Int = 100 'ms
	Global LastTime:Long = MilliSecs()
	Global LastKey:Int = 0
	Local key:Int = 0
		
	While  Key <= 226
		If KeyDown(key) Then Exit
		Key:+ 1
	Wend
	
	FlushMem
	
	If Key = 227 Then Return 0
	
	If Key = LastKey Then
		If MilliSecs()-LastTime < RepeatRate Then Return 0
	EndIf
	
	LastTime = MilliSecs()
	LastKey = Key
	If Key < 227 Then Return Key Else Return 0
	
End Function


Type TRGB
	Field Red		: Int 'could use byte but int is faster
	Field Green		: Int
	Field Blue		: Int
	Field Alpha		: Int
	
	Method AsInt:Int()
		Return ( Red| (Green Shl 8) | (Blue Shl 16))
	End Method
	
	Method FromInt(col:Int)
		Red = col Shr 16 & $FF
		Green = col Shr 8  & $FF
		Blue = col & $FF
	End Method
	
	Method SetCol()
		SetColor Red, Green, Blue
	End Method
End Type


Type TOpenConsole
	Field _Visible			: Int
	Field _X				: Float
	Field _Y				: Float
	Field _Width			: Float
	Field _Height			: Float
	Field _FontCol			: TRGB
	Field _BGCol			: TRGB
	Field CmdProcessor		: TCommandProcessor
	Field _BorderWidth		: Int = 4
	Field HotKey			: Int = KEY_TAB
	Field HotCtrlKey		: Int = KEY_CONTROL
	Field Alpha				: Float = 0.75
	Field TextAlpha			: Float = 1.0
	Field History			: TList
	Field HistoryPos		: Int = -1 'represents the position in the History List (-1 means no position)
	Field InputBuffer		: String
	Field CursorPos			: Int = 0
	Field OutList			: TList
	Field OutListPos		: Int = 0
	
	
	'Get Field Methods
	Method Visible:Int()
		Return _Visible
	End Method
	
	Method X:Float()
		Return _X
	End Method
	
	Method Y:Float()
		Return _Y
	End Method
	
	Method Width:Float()
		Return _Width
	End Method
	
	Method Height:Float()
		Return _Height
	End Method
	
	
	'Set Field Methods
	Method SetVisible(val:Int)
		_Visible = val
	End Method
	
	Method SetX(val:Float)
		_X = val
	End Method
	
	Method SetY(val:Float)
		_Y = val
	End Method
	
	Method SetWidth(val:Float)
		_Width = val
	End Method
	
	Method SetHeight(val:Float)
		_Height = val
	End Method
	

	Method Draw()
		Local LineHeight:Int = (TextHeight(InputBuffer)+2)
		'Draw BG
		SetBlend(AlphaBlend)
		SetAlpha(Alpha)
		_BGCol.SetCol()
		DrawRect(X(), Y(), Width(), Height())
		
		'Draw Text
		SetAlpha(TextAlpha)
		_FontCol.SetCol()
		SetViewport(X() + _BorderWidth, Y() + _BorderWidth, Width() - (_BorderWidth Shl 1), Height() - (_BorderWidth Shl 1))
		SetOrigin(X() + _BorderWidth, Y() + _BorderWidth)
		
		DrawText(InputBuffer, 0, 0)
		
		'Draw Cursor
		DrawText("_", TextWidth(InputBuffer[..CursorPos]), 0)
		DrawText("_", TextWidth(InputBuffer[..CursorPos]), 1)
		DrawText("_", TextWidth(InputBuffer[..CursorPos]), 2)
		
		'Draw Command Output
		If OutList.Count() > 0 Then
			For Local count:Int = OutListPos To OutList.Count()-1
				DrawText(String(OutList.ValueAtIndex(count)), 0, LineHeight+(LineHeight * count))
				FlushMem
			Next
		EndIf
		'restore viewport and origin
		SetViewport(0,0,GraphicsWidth(), GraphicsHeight())
		SetOrigin(0,0)
		SetAlpha(1.0)
		
	End Method
	
	
	Method Update()
		If Visible() Then Draw()
		CheckInput()
	End Method
	
	
	Method CheckInput()
		Local ch:Int
		
		'visibility of console
		If Not Visible() Then 
		
			If KeyHit(HotKey) And KeyDown(HotCtrlKey) Then 
				SetVisible(True)
				FlushKeys()
			EndIf
			
			Return
		EndIf
		
		If KeyHit(HotKey) And KeyDown(HotCtrlKey) Then
			SetVisible(False)
		EndIf
		
		'Main input section
		
		ch = GetChar()
		
		If (ch > 31) And (ch < 126) Then 
			InputBuffer = InputBuffer[..CursorPos]+Chr(ch)+InputBuffer[CursorPos..]':+Chr(ch)
			CursorPos:+1
		EndIf
		
		Select ch
			Case 8 'Backspace
				If CursorPos > 0 Then
					InputBuffer = InputBuffer[..CursorPos-1]+InputBuffer[CursorPos..] 'backspace
					CursorPos:-1
				EndIf
			
			Case 13 'Return
				If Len(InputBuffer)>0 Then
					History.AddFirst(InputBuffer)
					CmdProcessor.Execute(InputBuffer)
				EndIf
				InputBuffer = "" 'return
				CursorPos = 0
				HistoryPos = -1
							
			Case 27 'Escape
				InputBuffer = "" 'escape
				CursorPos = 0
				HistoryPos = -1
				
		End Select
		
		Local SpecialKey = GetKey()
			
		Select SpecialKey
			Case KEY_LEFT 
				If CursorPos>0 Then CursorPos:- 1
				
			Case KEY_RIGHT
				If CursorPos < Len(InputBuffer) Then CursorPos:+ 1
				
			Case KEY_UP
				If History.Count() > 0 Then
					If HistoryPos < History.Count()-1 Then HistoryPos:+ 1
					InputBuffer = String(History.ValueAtIndex(HistoryPos))
					CursorPos = Len(InputBuffer)
				EndIf
				
			Case KEY_DOWN
				If History.Count() > 0 Then
					If HistoryPos > -1 Then HistoryPos:- 1
					If HistoryPos < 0 Then 
						InputBuffer = ""
					Else
						InputBuffer = String(History.ValueAtIndex(HistoryPos))
					EndIf
					CursorPos = Len(InputBuffer)
				EndIf
				
			Case KEY_DELETE
				If CursorPos < Len(InputBuffer) Then
					InputBuffer = InputBuffer[..CursorPos]+InputBuffer[CursorPos+1..]
				EndIf
				
			Case KEY_END
				CursorPos = Len(InputBuffer)
				
			Case KEY_HOME
				CursorPos = 0
				
			Case KEY_TAB
				'find next command that begins with the current InputBuffer text (i.e. if the user has typed "Cle" then show Clear)
				'NEED TO IMPLEMENT LATER
		End Select
			
	End Method
	
	
	Method Out(outString:String)
		OutList.AddFirst(outString)
	End Method
	
	
	Function Create:TOpenConsole(Visible:Int, X:Float, Y:Float, Width:Float, Height:Float, FontCol:Int = $FFFFFF, BGCol:Int = $000000)
		Local tempConsole:TOpenConsole = New TOpenConsole
			tempConsole.CmdProcessor = TCommandProcessor.Create()
				tempConsole.CmdProcessor.Parent = tempConsole
			tempConsole.SetVisible(Visible)
			tempConsole.SetX(X)
			tempConsole.SetY(Y)
			tempConsole.SetWidth(Width)
			tempConsole.SetHeight(Height)
			
			tempConsole._FontCol:TRGB = New TRGB
				tempConsole._FontCol.FromInt(FontCol)
						
			tempConsole._BGCol:TRGB = New TRGB
				tempConsole._BGCol.FromInt(BGCol)
				
			tempConsole.History:TList = New TList
			
			tempConsole.OutList:TList = New TList
		
		Return tempConsole
	End Function
End Type


'Parameter Types
Const ptByte		: Int = 0
Const ptInteger		: Int = 1
Const ptFloat		: Int = 2
Const ptString		: Int = 3



Type TCommand
	Field Command	: String
	Field Action(Owner:TOpenConsole Var, params:TList Var)
	Field HelpText : String
	
	
	Function Create:TCommand(cmd:String, Action(Owner:TOpenConsole Var, params:TList Var), HelpTxt:String)
		If Len(cmd)=0 Then Return Null
		
		
		
		Local tempCommand:TCommand = New TCommand
			tempCommand.Command = cmd
			tempCommand.Action = Action
			tempCommand.HelpText = HelpTxt
		Return tempCommand
		
	End Function
	
End Type


Type TCommandProcessor
	Field CommandList	: TList
	Field Parent:TOpenConsole
	
	Method Execute(cmd:String)
		?Debug
			Print "Command String: " + cmd
			Print "Command List Count: " + CommandList.Count()
		?
		Local cmdList:TList = SplitString(cmd, " ")
		
		?Debug
			Print "cmdList val 0: " + String(cmdList.ValueAtIndex(0))
			Print "Command List Val 0 String:" + String(TCommand(CommandList.ValueAtIndex(0)).Command).ToUpper()
		?
		Local command:TCommand = GetCommand(String(cmdList.ValueAtIndex(0)))
		
		If command <> Null Then
			?Debug
				Print "Command: "+command.command
				Print "Help: " + command.HelpText
			?
			command.Action(Parent, cmdList)
		Else
			Parent.Out("Command not found: " + String(cmdList.ValueAtIndex(0)))
		EndIf
	End Method
	
	Method RegisterCommand(cmd:TCommand)
		If Not GetCommand(cmd.command) Then
			
			ListAddLast(CommandList, cmd)
			
		EndIf
	End Method
	
	
	Method GetCommand:TCommand(cmd:String)	
		?Debug
			Print "Entered GetCommand with " + cmd
		?
		'iterate through command list and check each TCommand entry for cmd$
		If CommandList.Count() < 1 Then Return Null
		
		?Debug
			Print "commandList cound greater than 0"
		?
		
		For Local tempCommand:TCommand = EachIn CommandList
			?Debug
				Print "Iterating through CommandList"
				Print tempCommand.Command.ToUpper() + " ------ " + cmd.ToUpper()
			?
			If tempCommand.Command.ToUpper() = cmd.ToUpper() Then 
				Return tempCommand
			EndIf
			FlushMem
		Next
		Return Null
	End Method
	
	
	Function Create:TCommandProcessor()
		Local tempCommandProcessor:TCommandProcessor = New TCommandProcessor
			tempCommandProcessor.CommandList:TList = New TList
		Return tempCommandProcessor
	End Function
End Type


''''''''''''''''''''
''''''''''''''''''''
''''''' TEST '''''''
''''''''''''''''''''
''''''''''''''''''''


Graphics 640,480,0,0

Global con:TOpenConsole = TOpenConsole.Create(False, 0,0,640,200, $99FF99, $006600)
	con.OutList.AddLast("Press CTRL+TAB to show/hide console")

'COMMAND SetConsoleAlpha
Global cmdSetConsoleAlpha:TCommand = TCommand.Create("SetConsoleAlpha", cmdSetConsoleAlpha_Action, "Set the alpha value of the console")
	
	Function cmdSetConsoleAlpha_Action(Owner:TOpenConsole Var, params:TList Var)
		Local val:Float
		
		If params.Count() >1 Then
			val = String(params.ValueAtIndex(1)).ToFloat()
			
			If val => 0.1 And val <= 1.0 Then
				owner.Alpha = val
			Else
				Owner.Out("Error: alpha value range from 0.1 to 1.0")
			EndIf
		Else
			Owner.Out("Error: alpha value is not optional")
		EndIf
	End Function

	con.cmdProcessor.RegisterCommand(cmdSetConsoleAlpha)



'COMMAND Quit
Global cmdQuit:TCommand = TCommand.Create("Quit", cmdQuit_Action, "Quit the program")

	Function cmdQuit_Action(Owner:TOpenConsole Var, params:TList Var)
		End
	End Function

	con.cmdProcessor.RegisterCommand(cmdQuit)



'COMMAND ListCommands
Global cmdListCommands:TCommand = TCommand.Create("ListCommands", cmdListCommands_Action, "List all the commands")

	Function cmdListCommands_Action(Owner:TOpenConsole Var, params:TList Var)
		For Local tempCommand:TCommand = EachIn Owner.cmdProcessor.CommandList
			Owner.Out(tempCommand.Command + " - " + tempCommand.HelpText)
			FlushMem
		Next
	End Function

	con.cmdProcessor.RegisterCommand(cmdListCommands)



'COMMAND Help
Global cmdHelp:TCommand = TCommand.Create("Help", cmdHelp_Action, "Provides help on the specified command (USAGE: Help <command>)")
	
	Function cmdHelp_Action(Owner:TOpenConsole Var, params:TList Var)
		'if too many parameters passed
		If params.Count() > 2 Then 
			Owner.Out(cmdHelp.HelpText)
			Owner.Out("Maximum of one parameter allowed")
		EndIf
		
		'if one parameter passed then look it up
		If Params.Count()>1 Then
			Local paramString:String = String(Params.ValueAtIndex(1))
			Local tempCommand:TCommand = Owner.cmdProcessor.GetCommand(ParamString)
		
			If tempCommand <> Null Then		
				If Len(tempCommand.HelpText)>0 Then
					owner.out(tempCommand.HelpText)
				Else
					owner.out("No help found for " + ParamString)
				EndIf
			Else
				owner.out("Command not found: " + ParamString)
			EndIf
		Else 'if no parameters passed, return the Help for cmdHelp
			Owner.Out("Type ListCommands for a full list of all commands")
			Owner.Out(cmdHelp.HelpText)
		EndIf
	End Function
	
	con.cmdProcessor.RegisterCommand(cmdHelp)



'COMMAND ClearHistory
Global cmdClearHistoryList:TCommand = TCommand.Create("ClearHistory", cmdClearHistoryList_Action, "Clears the command history.")

	Function cmdClearHistoryList_Action(Owner:TOpenConsole Var, params:TList Var)
		If Params.Count()>1 Then 
			If String(Params.ValueAtIndex(1)) = "/?" Then
				 Owner.Out(cmdClearHistoryList.HelpText)
				Return
			EndIf
		EndIf
		Owner.History.Clear()
		Owner.HistoryPos = -1
		Owner.Out("History cleared.")
	End Function

	con.cmdProcessor.RegisterCommand(cmdClearHistoryList)



'COMMAND Cls
Global cmdClearOutList:TCommand = TCommand.Create("Cls", cmdClearOutList_Action, "Clears the output buffer.")

	Function cmdClearOutList_Action(Owner:TOpenConsole Var, params:TList Var)
		Owner.OutList.Clear()
		Owner.OutListPos = 0
	End Function

	con.cmdProcessor.RegisterCommand(cmdClearOutList)





Global CurrentMem:Int
Global LastMem : Int


While Not (KeyDown(KEY_ESCAPE) And KeyDown(KEY_SHIFT))
	CurrentMem = MemAlloced()
	If CurrentMem <> LastMem Then
		'SetAppTitle is in AppFuncs.mod ( <a href="http://www.blitzbasic.com/Community/posts.php?topic=43341" target="_blank">http://www.blitzbasic.com/Community/posts.php?topic=43341</a> )
		'just comment this part out If you don't have it
		SetAppTitle("Open Console test - Press Shift+Escape to Quit " + CurrentMem)
		LastMem = CurrentMem
	EndIf
	Cls
		'DRAW A BLOCK TO SHOW THE ALPHA
		SetColor(255,0,0)
		DrawRect(10,10,600,250)	
		con.Update()
		FlushMem()
	Flip

Wend
End

Comments and feedback welcome.

Rimmsy

(Posted 2005) [#2]

What a great piece of code. Cheers for this. I was searching for a text entry function for my console but I think I'll use your console instead.

Thanks again, Perty

Matt

Perturbatio

(Posted 2005) [#3]

wow! someone actually looked at the thread. I was beginning to think I'd done it all for nothing :)

Rimmsy

(Posted 2005) [#4]

Which reminds me, am I allowed you use this in my game with the following: OpenConsole(tm)(c)(R)(ASAP)?

And if not, *slaps monitor* why not?

Perturbatio

(Posted 2005) [#5]

Of course you are *slaps Rimmsy* it's a joke dammit! a joke!

Rimmsy

(Posted 2005) [#6]

I know, I know! I was joking too. *double table slap*

my hand is hurting. I'm really slapping these things you know. I'm not just typing it.

Perturbatio

(Posted 2005) [#7]

I know you were joking *triple slaps table*.
I was joking about you joking about me joking... em... or something like that.

Rimmsy

(Posted 2005) [#8]

ohhhh, really? Well, cop this: I wasn't joking about your joking. I was joking *at* my joke, which was a joke in itself at my own joke.

*slaps moderator currently looking at this thread with disdain*

ninjarat

(Posted 2007) [#9]

uh, gee, this looks like a pretty good tool. Too bad it got abandoned like a year ago. Anyone but me think it's a good idea to revive this thread?

Perturbatio

(Posted 2007) [#10]

I do, but I'm biased :)

ninjarat

(Posted 2007) [#11]

Well, duh. :P

Hey, tell you what. I'm working on a completely different project right now, but it uses a console command line in graphics mode. When I'm done with it, I'll post the command line parser I'm using, it just splits stuff up in to words based on a delineator.

That's what you have here, except that was a long time ago. I tried your old stuff, and it doesn't work in newer blitzmax at all anymore. Even after I fixed everything that generated a compile error, it still didn't work.

I'll also post an implementation of the parser in a command line like program. It uses wave~'s Max2D input module.

Perturbatio

(Posted 2007) [#12]

After changing some constants and the flushmem statements to GCCollect() and commenting out the setAppTitle command (it's a custom command in a module of mine), this compiles fine on the latest version:

Rem
Openconsole Version 0.1.0
created by Kris Kelly (Perturbatio) (C) 2005

TODO:
	Add text wrapping
	Add output scrolling
	Use TAB to autocomplete a command
	Perhaps turn it into a module?
EndRem
Strict

Function SplitString:TList(inString:String, Delim:String)
	Local tempList : TList = New TList
	Local currentChar : String = ""
	Local count : Int = 0
	Local TokenStart : Int = 0
	
	If Len(Delim)<>1 Then Return Null
	
	inString = Trim(inString)
	
	For count = 0 Until Len(inString)
		If inString[count..count+1] = delim Then
			tempList.AddLast(inString[TokenStart..Count])
			TokenStart = count + 1
		End If
		GCCollect()
	Next
	tempList.AddLast(inString[TokenStart..Count])	
	Return tempList
End Function


Function GetKey:Int()
	Const RepeatRate : Int = 100 'ms
	Global LastTime:Long = MilliSecs()
	Global LastKey:Int = 0
	Local key:Int = 0
		
	While  Key <= 226
		If KeyDown(key) Then Exit
		Key:+ 1
	Wend
	
	GCCollect()
	
	If Key = 227 Then Return 0
	
	If Key = LastKey Then
		If MilliSecs()-LastTime < RepeatRate Then Return 0
	EndIf
	
	LastTime = MilliSecs()
	LastKey = Key
	If Key < 227 Then Return Key Else Return 0
	
End Function


Type TRGB
	Field Red		: Int 'could use byte but int is faster
	Field Green		: Int
	Field Blue		: Int
	Field Alpha		: Int
	
	Method AsInt:Int()
		Return ( Red| (Green Shl 8) | (Blue Shl 16))
	End Method
	
	Method FromInt(col:Int)
		Red = col Shr 16 & $FF
		Green = col Shr 8  & $FF
		Blue = col & $FF
	End Method
	
	Method SetCol()
		SetColor Red, Green, Blue
	End Method
End Type


Type TOpenConsole
	Field _Visible			: Int
	Field _X				: Float
	Field _Y				: Float
	Field _Width			: Float
	Field _Height			: Float
	Field _FontCol			: TRGB
	Field _BGCol			: TRGB
	Field CmdProcessor		: TCommandProcessor
	Field _BorderWidth		: Int = 4
	Field HotKey			: Int = KEY_TAB
	Field HotCtrlKey		: Int = KEY_LCONTROL
	Field Alpha				: Float = 0.75
	Field TextAlpha			: Float = 1.0
	Field History			: TList
	Field HistoryPos		: Int = -1 'represents the position in the History List (-1 means no position)
	Field InputBuffer		: String
	Field CursorPos			: Int = 0
	Field OutList			: TList
	Field OutListPos		: Int = 0
	
	
	'Get Field Methods
	Method Visible:Int()
		Return _Visible
	End Method
	
	Method X:Float()
		Return _X
	End Method
	
	Method Y:Float()
		Return _Y
	End Method
	
	Method Width:Float()
		Return _Width
	End Method
	
	Method Height:Float()
		Return _Height
	End Method
	
	
	'Set Field Methods
	Method SetVisible(val:Int)
		_Visible = val
	End Method
	
	Method SetX(val:Float)
		_X = val
	End Method
	
	Method SetY(val:Float)
		_Y = val
	End Method
	
	Method SetWidth(val:Float)
		_Width = val
	End Method
	
	Method SetHeight(val:Float)
		_Height = val
	End Method
	

	Method Draw()
		Local LineHeight:Int = (TextHeight(InputBuffer)+2)
		'Draw BG
		SetBlend(AlphaBlend)
		SetAlpha(Alpha)
		_BGCol.SetCol()
		DrawRect(X(), Y(), Width(), Height())
		
		'Draw Text
		SetAlpha(TextAlpha)
		_FontCol.SetCol()
		SetViewport(X() + _BorderWidth, Y() + _BorderWidth, Width() - (_BorderWidth Shl 1), Height() - (_BorderWidth Shl 1))
		SetOrigin(X() + _BorderWidth, Y() + _BorderWidth)
		
		DrawText(InputBuffer, 0, 0)
		
		'Draw Cursor
		DrawText("_", TextWidth(InputBuffer[..CursorPos]), 0)
		DrawText("_", TextWidth(InputBuffer[..CursorPos]), 1)
		DrawText("_", TextWidth(InputBuffer[..CursorPos]), 2)
		
		'Draw Command Output
		If OutList.Count() > 0 Then
			For Local count:Int = OutListPos To OutList.Count()-1
				DrawText(String(OutList.ValueAtIndex(count)), 0, LineHeight+(LineHeight * count))
				GCCollect()
			Next
		EndIf
		'restore viewport and origin
		SetViewport(0,0,GraphicsWidth(), GraphicsHeight())
		SetOrigin(0,0)
		SetAlpha(1.0)
		
	End Method
	
	
	Method Update()
		If Visible() Then Draw()
		CheckInput()
	End Method
	
	
	Method CheckInput()
		Local ch:Int
		
		'visibility of console
		If Not Visible() Then 
		
			If KeyHit(HotKey) And KeyDown(HotCtrlKey) Then 
				SetVisible(True)
				FlushKeys()
			EndIf
			
			Return
		EndIf
		
		If KeyHit(HotKey) And KeyDown(HotCtrlKey) Then
			SetVisible(False)
		EndIf
		
		'Main input section
		
		ch = GetChar()
		
		If (ch > 31) And (ch < 126) Then 
			InputBuffer = InputBuffer[..CursorPos]+Chr(ch)+InputBuffer[CursorPos..]':+Chr(ch)
			CursorPos:+1
		EndIf
		
		Select ch
			Case 8 'Backspace
				If CursorPos > 0 Then
					InputBuffer = InputBuffer[..CursorPos-1]+InputBuffer[CursorPos..] 'backspace
					CursorPos:-1
				EndIf
			
			Case 13 'Return
				If Len(InputBuffer)>0 Then
					History.AddFirst(InputBuffer)
					CmdProcessor.Execute(InputBuffer)
				EndIf
				InputBuffer = "" 'return
				CursorPos = 0
				HistoryPos = -1
							
			Case 27 'Escape
				InputBuffer = "" 'escape
				CursorPos = 0
				HistoryPos = -1
				
		End Select
		
		Local SpecialKey = GetKey()
			
		Select SpecialKey
			Case KEY_LEFT 
				If CursorPos>0 Then CursorPos:- 1
				
			Case KEY_RIGHT
				If CursorPos < Len(InputBuffer) Then CursorPos:+ 1
				
			Case KEY_UP
				If History.Count() > 0 Then
					If HistoryPos < History.Count()-1 Then HistoryPos:+ 1
					InputBuffer = String(History.ValueAtIndex(HistoryPos))
					CursorPos = Len(InputBuffer)
				EndIf
				
			Case KEY_DOWN
				If History.Count() > 0 Then
					If HistoryPos > -1 Then HistoryPos:- 1
					If HistoryPos < 0 Then 
						InputBuffer = ""
					Else
						InputBuffer = String(History.ValueAtIndex(HistoryPos))
					EndIf
					CursorPos = Len(InputBuffer)
				EndIf
				
			Case KEY_DELETE
				If CursorPos < Len(InputBuffer) Then
					InputBuffer = InputBuffer[..CursorPos]+InputBuffer[CursorPos+1..]
				EndIf
				
			Case KEY_END
				CursorPos = Len(InputBuffer)
				
			Case KEY_HOME
				CursorPos = 0
				
			Case KEY_TAB
				'find next command that begins with the current InputBuffer text (i.e. if the user has typed "Cle" then show Clear)
				'NEED TO IMPLEMENT LATER
		End Select
			
	End Method
	
	
	Method Out(outString:String)
		OutList.AddFirst(outString)
	End Method
	
	
	Function Create:TOpenConsole(Visible:Int, X:Float, Y:Float, Width:Float, Height:Float, FontCol:Int = $FFFFFF, BGCol:Int = $000000)
		Local tempConsole:TOpenConsole = New TOpenConsole
			tempConsole.CmdProcessor = TCommandProcessor.Create()
				tempConsole.CmdProcessor.Parent = tempConsole
			tempConsole.SetVisible(Visible)
			tempConsole.SetX(X)
			tempConsole.SetY(Y)
			tempConsole.SetWidth(Width)
			tempConsole.SetHeight(Height)
			
			tempConsole._FontCol:TRGB = New TRGB
				tempConsole._FontCol.FromInt(FontCol)
						
			tempConsole._BGCol:TRGB = New TRGB
				tempConsole._BGCol.FromInt(BGCol)
				
			tempConsole.History:TList = New TList
			
			tempConsole.OutList:TList = New TList
		
		Return tempConsole
	End Function
End Type


'Parameter Types
Const ptByte		: Int = 0
Const ptInteger		: Int = 1
Const ptFloat		: Int = 2
Const ptString		: Int = 3



Type TCommand
	Field Command	: String
	Field Action(Owner:TOpenConsole Var, params:TList Var)
	Field HelpText : String
	
	
	Function Create:TCommand(cmd:String, Action(Owner:TOpenConsole Var, params:TList Var), HelpTxt:String)
		If Len(cmd)=0 Then Return Null
		
		
		
		Local tempCommand:TCommand = New TCommand
			tempCommand.Command = cmd
			tempCommand.Action = Action
			tempCommand.HelpText = HelpTxt
		Return tempCommand
		
	End Function
	
End Type


Type TCommandProcessor
	Field CommandList	: TList
	Field Parent:TOpenConsole
	
	Method Execute(cmd:String)
		?Debug
			Print "Command String: " + cmd
			Print "Command List Count: " + CommandList.Count()
		?
		Local cmdList:TList = SplitString(cmd, " ")
		
		?Debug
			Print "cmdList val 0: " + String(cmdList.ValueAtIndex(0))
			Print "Command List Val 0 String:" + String(TCommand(CommandList.ValueAtIndex(0)).Command).ToUpper()
		?
		Local command:TCommand = GetCommand(String(cmdList.ValueAtIndex(0)))
		
		If command <> Null Then
			?Debug
				Print "Command: "+command.command
				Print "Help: " + command.HelpText
			?
			command.Action(Parent, cmdList)
		Else
			Parent.Out("Command not found: " + String(cmdList.ValueAtIndex(0)))
		EndIf
	End Method
	
	Method RegisterCommand(cmd:TCommand)
		If Not GetCommand(cmd.command) Then
			
			ListAddLast(CommandList, cmd)
			
		EndIf
	End Method
	
	
	Method GetCommand:TCommand(cmd:String)	
		?Debug
			Print "Entered GetCommand with " + cmd
		?
		'iterate through command list and check each TCommand entry for cmd$
		If CommandList.Count() < 1 Then Return Null
		
		?Debug
			Print "commandList cound greater than 0"
		?
		
		For Local tempCommand:TCommand = EachIn CommandList
			?Debug
				Print "Iterating through CommandList"
				Print tempCommand.Command.ToUpper() + " ------ " + cmd.ToUpper()
			?
			If tempCommand.Command.ToUpper() = cmd.ToUpper() Then 
				Return tempCommand
			EndIf
			GCCollect()
		Next
		Return Null
	End Method
	
	
	Function Create:TCommandProcessor()
		Local tempCommandProcessor:TCommandProcessor = New TCommandProcessor
			tempCommandProcessor.CommandList:TList = New TList
		Return tempCommandProcessor
	End Function
End Type


''''''''''''''''''''
''''''''''''''''''''
''''''' TEST '''''''
''''''''''''''''''''
''''''''''''''''''''


Graphics 640,480,0,0

Global con:TOpenConsole = TOpenConsole.Create(False, 0,0,640,200, $99FF99, $006600)
	con.OutList.AddLast("Press CTRL+TAB to show/hide console")

'COMMAND SetConsoleAlpha
Global cmdSetConsoleAlpha:TCommand = TCommand.Create("SetConsoleAlpha", cmdSetConsoleAlpha_Action, "Set the alpha value of the console")
	
	Function cmdSetConsoleAlpha_Action(Owner:TOpenConsole Var, params:TList Var)
		Local val:Float
		
		If params.Count() >1 Then
			val = String(params.ValueAtIndex(1)).ToFloat()
			
			If val => 0.1 And val <= 1.0 Then
				owner.Alpha = val
			Else
				Owner.Out("Error: alpha value range from 0.1 to 1.0")
			EndIf
		Else
			Owner.Out("Error: alpha value is not optional")
		EndIf
	End Function

	con.cmdProcessor.RegisterCommand(cmdSetConsoleAlpha)



'COMMAND Quit
Global cmdQuit:TCommand = TCommand.Create("Quit", cmdQuit_Action, "Quit the program")

	Function cmdQuit_Action(Owner:TOpenConsole Var, params:TList Var)
		End
	End Function

	con.cmdProcessor.RegisterCommand(cmdQuit)



'COMMAND ListCommands
Global cmdListCommands:TCommand = TCommand.Create("ListCommands", cmdListCommands_Action, "List all the commands")

	Function cmdListCommands_Action(Owner:TOpenConsole Var, params:TList Var)
		For Local tempCommand:TCommand = EachIn Owner.cmdProcessor.CommandList
			Owner.Out(tempCommand.Command + " - " + tempCommand.HelpText)
			GCCollect()
		Next
	End Function

	con.cmdProcessor.RegisterCommand(cmdListCommands)



'COMMAND Help
Global cmdHelp:TCommand = TCommand.Create("Help", cmdHelp_Action, "Provides help on the specified command (USAGE: Help <command>)")
	
	Function cmdHelp_Action(Owner:TOpenConsole Var, params:TList Var)
		'if too many parameters passed
		If params.Count() > 2 Then 
			Owner.Out(cmdHelp.HelpText)
			Owner.Out("Maximum of one parameter allowed")
		EndIf
		
		'if one parameter passed then look it up
		If Params.Count()>1 Then
			Local paramString:String = String(Params.ValueAtIndex(1))
			Local tempCommand:TCommand = Owner.cmdProcessor.GetCommand(ParamString)
		
			If tempCommand <> Null Then		
				If Len(tempCommand.HelpText)>0 Then
					owner.out(tempCommand.HelpText)
				Else
					owner.out("No help found for " + ParamString)
				EndIf
			Else
				owner.out("Command not found: " + ParamString)
			EndIf
		Else 'if no parameters passed, return the Help for cmdHelp
			Owner.Out("Type ListCommands for a full list of all commands")
			Owner.Out(cmdHelp.HelpText)
		EndIf
	End Function
	
	con.cmdProcessor.RegisterCommand(cmdHelp)



'COMMAND ClearHistory
Global cmdClearHistoryList:TCommand = TCommand.Create("ClearHistory", cmdClearHistoryList_Action, "Clears the command history.")

	Function cmdClearHistoryList_Action(Owner:TOpenConsole Var, params:TList Var)
		If Params.Count()>1 Then 
			If String(Params.ValueAtIndex(1)) = "/?" Then
				 Owner.Out(cmdClearHistoryList.HelpText)
				Return
			EndIf
		EndIf
		Owner.History.Clear()
		Owner.HistoryPos = -1
		Owner.Out("History cleared.")
	End Function

	con.cmdProcessor.RegisterCommand(cmdClearHistoryList)



'COMMAND Cls
Global cmdClearOutList:TCommand = TCommand.Create("Cls", cmdClearOutList_Action, "Clears the output buffer.")

	Function cmdClearOutList_Action(Owner:TOpenConsole Var, params:TList Var)
		Owner.OutList.Clear()
		Owner.OutListPos = 0
	End Function

	con.cmdProcessor.RegisterCommand(cmdClearOutList)





Global CurrentMem:Int
Global LastMem : Int


While Not (KeyDown(KEY_ESCAPE) And KeyDown(KEY_LSHIFT))
	CurrentMem = GCMemAlloced()
	If CurrentMem <> LastMem Then
		'SetAppTitle is in AppFuncs.mod ( <a href="http://www.blitzbasic.com/Community/posts.php?topic=43341" target="_blank">www.blitzbasic.com/Community/posts.php?topic=43341</a> )
		'just comment this part out If you don't have it
		'SetAppTitle("Open Console test - Press Shift+Escape to Quit " + CurrentMem)
		LastMem = CurrentMem
	EndIf
	Cls
		'DRAW A BLOCK TO SHOW THE ALPHA
		SetColor(255,0,0)
		DrawRect(10,10,600,250)	
		con.Update()
		GCCollect()
	Flip

Wend
End

Koriolis

(Posted 2007) [#13]

Here's a modified version that handles multiline input (but commands still are single line so as is it is not of much use; rather a starting point).
Pertubatio, would you mind if I included a modified version of this console code with BVM 2?

Rem
Openconsole Version 0.1.0
created by Kris Kelly (Perturbatio) (C) 2005

TODO:
	Add text wrapping
	Add output scrolling
	Use TAB To autocomplete a command
	Perhaps turn it into a Module?
EndRem
Strict

Function SplitString:TList(inString:String, Delim:String, bTrimText%=True)
	Local tempList : TList = New TList
	Local currentChar : String = ""
	Local count : Int = 0
	Local TokenStart : Int = 0
	
	If Len(Delim)<>1 Then Return Null
	
	If bTrimText Then
		inString = Trim(inString)
	EndIf
	
	For count = 0 Until Len(inString)
		If inString[count..count+1] = delim Then
			tempList.AddLast(inString[TokenStart..Count])
			TokenStart = count + 1
		End If
		'GCCollect()
	Next
	tempList.AddLast(inString[TokenStart..Count])	
	Return tempList
End Function


Function GetKey:Int()
	Const RepeatRate : Int = 100 'ms
	Global LastTime:Long = MilliSecs()
	Global LastKey:Int = 0
	Local key:Int = 0
		
	While  Key <= 226
		If KeyDown(key) Then Exit
		Key:+ 1
	Wend
	
	'GCCollect()
	
	If Key = 227 Then Return 0
	
	If Key = LastKey Then
		If MilliSecs()-LastTime < RepeatRate Then Return 0
	EndIf
	
	LastTime = MilliSecs()
	LastKey = Key
	If Key < 227 Then Return Key Else Return 0
	
End Function


Type TRGB
	Field Red		: Int 'could use byte but int is faster
	Field Green		: Int
	Field Blue		: Int
	Field Alpha		: Int
	
	Method AsInt:Int()
		Return ( Red| (Green Shl 8) | (Blue Shl 16))
	End Method
	
	Method FromInt(col:Int)
		Red = col Shr 16 & $FF
		Green = col Shr 8  & $FF
		Blue = col & $FF
	End Method
	
	Method SetCol()
		SetColor Red, Green, Blue
	End Method
End Type


Type TOpenConsole
	Field _Visible			: Int
	Field _X				: Float
	Field _Y				: Float
	Field _Width			: Float
	Field _Height			: Float
	Field _FontCol			: TRGB
	Field _BGCol			: TRGB
	Field CmdProcessor		: TCommandProcessor
	Field _BorderWidth		: Int = 4
	Field HotKey			: Int = KEY_TAB
	Field HotCtrlKey		: Int = KEY_LCONTROL
	Field Alpha				: Float = 0.75
	Field TextAlpha			: Float = 1.0
	Field History			: TList
	Field HistoryPos		: Int = -1 'represents the position in the History List (-1 means no position)
	Field InputBuffer		: String
	Field CursorPos			: Int = 0
	Field OutList			: TList
	Field OutListPos		: Int = 0
	
	
	'Get Field Methods
	Method Visible:Int()
		Return _Visible
	End Method
	
	Method X:Float()
		Return _X
	End Method
	
	Method Y:Float()
		Return _Y
	End Method
	
	Method Width:Float()
		Return _Width
	End Method
	
	Method Height:Float()
		Return _Height
	End Method
	
	
	'Set Field Methods
	Method SetVisible(val:Int)
		_Visible = val
	End Method
	
	Method SetX(val:Float)
		_X = val
	End Method
	
	Method SetY(val:Float)
		_Y = val
	End Method
	
	Method SetWidth(val:Float)
		_Width = val
	End Method
	
	Method SetHeight(val:Float)
		_Height = val
	End Method
	

	Method Draw()
		Local LineHeight:Int = (TextHeight(InputBuffer)+2)
		'Draw BG
		SetBlend(AlphaBlend)
		SetAlpha(Alpha)
		_BGCol.SetCol()
		DrawRect(X(), Y(), Width(), Height())
		
		'Draw Text
		SetAlpha(TextAlpha)
		_FontCol.SetCol()
		SetViewport(X() + _BorderWidth, Y() + _BorderWidth, Width() - (_BorderWidth Shl 1), Height() - (_BorderWidth Shl 1))
		SetOrigin(X() + _BorderWidth, Y() + _BorderWidth)
		
		Local textLines:TList = SplitString(InputBuffer, "~n", False)
		Local cursLineNum% = 0
		Local currentCharCount% = 0
		Local currentLineCount% = 0
		Local cursPosInCurLine% = 0
		Local cursorX% = 0
		For Local txt$ = EachIn textLines
			DrawText(txt, 0, currentLineCount * LineHeight )
			If CursorPos >= currentCharCount And CursorPos < currentCharCount + txt.Length + 1 Then
				cursLineNum = currentLineCount
				cursPosInCurLine = CursorPos - currentCharCount
				cursorX = TextWidth(txt[..CursPosInCurLine])
			EndIf
			currentCharCount :+ txt.Length + 1
			currentLineCount :+ 1
		Next
		Local cursorY% = cursLineNum * LineHeight
		
		
		'Draw Cursor
		DrawText("_", cursorX, cursorY)
		DrawText("_", cursorX, cursorY + 1)
		DrawText("_", cursorX, cursorY + 2)
		
		'Draw Command Output
		If OutList.Count() > 0 Then
			For Local count:Int = OutListPos To OutList.Count()-1
				DrawText(String(OutList.ValueAtIndex(count)), 0, (LineHeight) * (textLines.Count()+1+count))
				'GCCollect()
			Next
		EndIf
		'restore viewport and origin
		SetViewport(0,0,GraphicsWidth(), GraphicsHeight())
		SetOrigin(0,0)
		SetAlpha(1.0)
		
	End Method
	
	
	Method Update()
		If Visible() Then Draw()
		CheckInput()
	End Method
	
	
	Method CheckInput()
		
		'visibility of console
		If Not Visible() Then 
		
			If KeyHit(HotKey) And KeyDown(HotCtrlKey) Then 
				SetVisible(True)
				FlushKeys()
			EndIf
			
			Return
		EndIf
		
		If KeyHit(HotKey) And KeyDown(HotCtrlKey) Then
			SetVisible(False)
		EndIf


		'Main input section
		
		
		If KeyHit(KEY_RETURN) Or KeyHit(KEY_ENTER)
			If KeyDown(KEY_LCONTROL) Or KeyDown(KEY_RCONTROL) Then
				InputBuffer = InputBuffer[..CursorPos]+"~n"+InputBuffer[CursorPos..]
				CursorPos:+1
			Else
				If Len(InputBuffer)>0 Then
					History.AddFirst(InputBuffer)
					CmdProcessor.Execute(InputBuffer)
				EndIf
				InputBuffer = "" 'return
				CursorPos = 0
				HistoryPos = -1
			EndIf
		ElseIf KeyHit(KEY_ESCAPE) Then
			InputBuffer = ""
			CursorPos = 0
			HistoryPos = -1
		Else
			Local ch% = GetChar()			
			
			If (ch > 31) And (ch < 126) Then 
				InputBuffer = InputBuffer[..CursorPos]+Chr(ch)+InputBuffer[CursorPos..]':+Chr(ch)
				CursorPos:+1
			EndIf
		EndIf
		
		Local SpecialKey = GetKey()
			
		Select SpecialKey
			Case KEY_BACKSPACE
				If CursorPos > 0 Then
					InputBuffer = InputBuffer[..CursorPos-1]+InputBuffer[CursorPos..] 'backspace
					CursorPos:-1
				EndIf
			Case KEY_LEFT 
				If CursorPos>0 Then CursorPos:- 1
				
			Case KEY_RIGHT
				If CursorPos < Len(InputBuffer) Then CursorPos:+ 1
				
			Case KEY_UP
				If History.Count() > 0 Then
					If HistoryPos < History.Count()-1 Then HistoryPos:+ 1
					InputBuffer = String(History.ValueAtIndex(HistoryPos))
					CursorPos = Len(InputBuffer)
				EndIf
				
			Case KEY_DOWN
				If History.Count() > 0 Then
					If HistoryPos > -1 Then HistoryPos:- 1
					If HistoryPos < 0 Then 
						InputBuffer = ""
					Else
						InputBuffer = String(History.ValueAtIndex(HistoryPos))
					EndIf
					CursorPos = Len(InputBuffer)
				EndIf
				
			Case KEY_DELETE
				If CursorPos < Len(InputBuffer) Then
					InputBuffer = InputBuffer[..CursorPos]+InputBuffer[CursorPos+1..]
				EndIf
				
			Case KEY_END
				CursorPos = Len(InputBuffer)
				
			Case KEY_HOME
				CursorPos = 0
				
			Case KEY_TAB
				'find next command that begins with the current InputBuffer text (i.e. if the user has typed "Cle" then show Clear)
				'NEED TO IMPLEMENT LATER
		End Select
					
	End Method
	
	
	Method Out(outString:String)
		OutList.AddFirst(outString)
	End Method
	
	
	Function Create:TOpenConsole(Visible:Int, X:Float, Y:Float, Width:Float, Height:Float, FontCol:Int = $FFFFFF, BGCol:Int = $000000)
		Local tempConsole:TOpenConsole = New TOpenConsole
			tempConsole.CmdProcessor = TCommandProcessor.Create()
				tempConsole.CmdProcessor.Parent = tempConsole
			tempConsole.SetVisible(Visible)
			tempConsole.SetX(X)
			tempConsole.SetY(Y)
			tempConsole.SetWidth(Width)
			tempConsole.SetHeight(Height)
			
			tempConsole._FontCol:TRGB = New TRGB
				tempConsole._FontCol.FromInt(FontCol)
						
			tempConsole._BGCol:TRGB = New TRGB
				tempConsole._BGCol.FromInt(BGCol)
				
			tempConsole.History:TList = New TList
			
			tempConsole.OutList:TList = New TList
		
		Return tempConsole
	End Function
End Type


'Parameter Types
Const ptByte		: Int = 0
Const ptInteger		: Int = 1
Const ptFloat		: Int = 2
Const ptString		: Int = 3



Type TCommand
	Field Command	: String
	Field Action(Owner:TOpenConsole Var, params:TList Var)
	Field HelpText : String
	
	
	Function Create:TCommand(cmd:String, Action(Owner:TOpenConsole Var, params:TList Var), HelpTxt:String)
		If Len(cmd)=0 Then Return Null
		
		
		
		Local tempCommand:TCommand = New TCommand
			tempCommand.Command = cmd
			tempCommand.Action = Action
			tempCommand.HelpText = HelpTxt
		Return tempCommand
		
	End Function
	
End Type


Type TCommandProcessor
	Field CommandList	: TList
	Field Parent:TOpenConsole
	
	Method Execute(cmd:String)
		?Debug
			Print "Command String: " + cmd
			Print "Command List Count: " + CommandList.Count()
		?
		Local cmdList:TList = SplitString(cmd, " ")
		
		?Debug
			Print "cmdList val 0: " + String(cmdList.ValueAtIndex(0))
			Print "Command List Val 0 String:" + String(TCommand(CommandList.ValueAtIndex(0)).Command).ToUpper()
		?
		Local command:TCommand = GetCommand(String(cmdList.ValueAtIndex(0)))
		
		If command <> Null Then
			?Debug
				Print "Command: "+command.command
				Print "Help: " + command.HelpText
			?
			command.Action(Parent, cmdList)
		Else
			Parent.Out("Command not found: " + String(cmdList.ValueAtIndex(0)))
		EndIf
	End Method
	
	Method RegisterCommand(cmd:TCommand)
		If Not GetCommand(cmd.command) Then
			
			ListAddLast(CommandList, cmd)
			
		EndIf
	End Method
	
	
	Method GetCommand:TCommand(cmd:String)	
		?Debug
			Print "Entered GetCommand with " + cmd
		?
		'iterate through command list and check each TCommand entry for cmd$
		If CommandList.Count() < 1 Then Return Null
		
		?Debug
			Print "commandList cound greater than 0"
		?
		
		For Local tempCommand:TCommand = EachIn CommandList
			?Debug
				Print "Iterating through CommandList"
				Print tempCommand.Command.ToUpper() + " ------ " + cmd.ToUpper()
			?
			If tempCommand.Command.ToUpper() = cmd.ToUpper() Then 
				Return tempCommand
			EndIf
			'GCCollect()
		Next
		Return Null
	End Method
	
	
	Function Create:TCommandProcessor()
		Local tempCommandProcessor:TCommandProcessor = New TCommandProcessor
			tempCommandProcessor.CommandList:TList = New TList
		Return tempCommandProcessor
	End Function
End Type


''''''''''''''''''''
''''''''''''''''''''
''''''' TEST '''''''
''''''''''''''''''''
''''''''''''''''''''


Graphics 640,480,0,0

Global con:TOpenConsole = TOpenConsole.Create(False, 0,0,640,200, $99FF99, $006600)
	con.OutList.AddLast("Press CTRL+TAB to show/hide console")

'COMMAND SetConsoleAlpha
Global cmdSetConsoleAlpha:TCommand = TCommand.Create("SetConsoleAlpha", cmdSetConsoleAlpha_Action, "Set the alpha value of the console")
	
	Function cmdSetConsoleAlpha_Action(Owner:TOpenConsole Var, params:TList Var)
		Local val:Float
		
		If params.Count() >1 Then
			val = String(params.ValueAtIndex(1)).ToFloat()
			
			If val => 0.1 And val <= 1.0 Then
				owner.Alpha = val
			Else
				Owner.Out("Error: alpha value range from 0.1 to 1.0")
			EndIf
		Else
			Owner.Out("Error: alpha value is not optional")
		EndIf
	End Function

	con.cmdProcessor.RegisterCommand(cmdSetConsoleAlpha)



'COMMAND Quit
Global cmdQuit:TCommand = TCommand.Create("Quit", cmdQuit_Action, "Quit the program")

	Function cmdQuit_Action(Owner:TOpenConsole Var, params:TList Var)
		End
	End Function

	con.cmdProcessor.RegisterCommand(cmdQuit)



'COMMAND ListCommands
Global cmdListCommands:TCommand = TCommand.Create("ListCommands", cmdListCommands_Action, "List all the commands")

	Function cmdListCommands_Action(Owner:TOpenConsole Var, params:TList Var)
		For Local tempCommand:TCommand = EachIn Owner.cmdProcessor.CommandList
			Owner.Out(tempCommand.Command + " - " + tempCommand.HelpText)
			'GCCollect()
		Next
	End Function

	con.cmdProcessor.RegisterCommand(cmdListCommands)



'COMMAND Help
Global cmdHelp:TCommand = TCommand.Create("Help", cmdHelp_Action, "Provides help on the specified command (USAGE: Help <command>)")
	
	Function cmdHelp_Action(Owner:TOpenConsole Var, params:TList Var)
		'if too many parameters passed
		If params.Count() > 2 Then 
			Owner.Out(cmdHelp.HelpText)
			Owner.Out("Maximum of one parameter allowed")
		EndIf
		
		'if one parameter passed then look it up
		If Params.Count()>1 Then
			Local paramString:String = String(Params.ValueAtIndex(1))
			Local tempCommand:TCommand = Owner.cmdProcessor.GetCommand(ParamString)
		
			If tempCommand <> Null Then		
				If Len(tempCommand.HelpText)>0 Then
					owner.out(tempCommand.HelpText)
				Else
					owner.out("No help found for " + ParamString)
				EndIf
			Else
				owner.out("Command not found: " + ParamString)
			EndIf
		Else 'if no parameters passed, return the Help for cmdHelp
			Owner.Out("Type ListCommands for a full list of all commands")
			Owner.Out(cmdHelp.HelpText)
		EndIf
	End Function
	
	con.cmdProcessor.RegisterCommand(cmdHelp)



'COMMAND ClearHistory
Global cmdClearHistoryList:TCommand = TCommand.Create("ClearHistory", cmdClearHistoryList_Action, "Clears the command history.")

	Function cmdClearHistoryList_Action(Owner:TOpenConsole Var, params:TList Var)
		If Params.Count()>1 Then 
			If String(Params.ValueAtIndex(1)) = "/?" Then
				 Owner.Out(cmdClearHistoryList.HelpText)
				Return
			EndIf
		EndIf
		Owner.History.Clear()
		Owner.HistoryPos = -1
		Owner.Out("History cleared.")
	End Function

	con.cmdProcessor.RegisterCommand(cmdClearHistoryList)



'COMMAND Cls
Global cmdClearOutList:TCommand = TCommand.Create("Cls", cmdClearOutList_Action, "Clears the output buffer.")

	Function cmdClearOutList_Action(Owner:TOpenConsole Var, params:TList Var)
		Owner.OutList.Clear()
		Owner.OutListPos = 0
	End Function

	con.cmdProcessor.RegisterCommand(cmdClearOutList)





Global CurrentMem:Int
Global LastMem : Int


While Not (KeyDown(KEY_ESCAPE) And (KeyDown(KEY_LSHIFT) Or KeyDown(KEY_RSHIFT)))
	CurrentMem = GCMemAlloced()
	If CurrentMem <> LastMem Then
		'SetAppTitle is in AppFuncs.mod ( <a href="http://www.blitzbasic.com/Community/posts.php?topic=43341" target="_blank">www.blitzbasic.com/Community/posts.php?topic=43341</a> )
		'just comment this part out If you don't have it
		AppTitle = "Open Console test - Press Shift+Escape to Quit " + CurrentMem
		LastMem = CurrentMem
	EndIf
	Cls
		'DRAW A BLOCK TO SHOW THE ALPHA
		SetColor(255,0,0)
		DrawRect(10,10,600,250)	
		con.Update()
		'GCCollect()
	Flip

Wend
End

Perturbatio

(Posted 2007) [#14]

Pertubatio, would you mind if I included a modified version of this console code with BVM 2?

No, I don't mind. :)

Obviously I would like it, if you made any changes, for you to post them here.

(ideally in a codebox :) )

Koriolis

(Posted 2007) [#15]

Well, no problem, but the idea is to use the console to allow the execution of BVM scripts, as the application runs. So without BVM itself it won't be of much use. What I posted in the previous post will most probably be the only change I do to your code that can be compiled on its own.

BTW, I replaced the code tag with a codebox. Well spotted :)

Perturbatio

(Posted 2007) [#16]

Ah well, I've still no problem with you using this :)

altitudems

(Posted 2007) [#17]

Here is my contribution, a console with debug variable watching / changing. Comes in very handy for me all the time.

Example program:

SuperStrict
Include "includes/console.bmx"
Include "includes/debug.bmx"

Graphics 640,480
SetBlend ALPHABLEND


'Some example console commands:
Local _HelpText:String = "Passing a command name will return|"+ ..
				         "help information on that command.|"+ ..
				         "Passing the 'all' parmeter instead|"+ ..
				         "will display a list of available commands."
Debug.Console.RegisterCommand("Help","S",cmd_Help,_HelpText)
Debug.Console.RegisterCommand("?","S",cmd_Help,_HelpText)
Function cmd_Help(_cmd:TConsoleCommand)
	Local cmd:TConsoleCommand = _cmd.Console.FindCommand(_cmd.Parameters[0])
	If cmd
		Local help:String = _cmd.Mask.ToLower()
		help = help.Replace("i","Int, ")
		help = help.Replace("f","Float, ")
		help = help.Replace("s","String, ")
		help = help[..help.Length-2]
		_cmd.Console.Output ""
		_cmd.Console.Output "USAGE:"
		_cmd.Console.Output "  /"+_cmd.Name+" "+help
		_cmd.Console.Output ""
		_cmd.Console.Output "DESCRIPTION:"
		Local helpt:String [] = StringToStringArray(_cmd.HelpText,"|")
		For help = EachIn helpt
			_cmd.Console.Output "  "+help
		Next
	ElseIf _cmd.Parameters[0].ToLower() = "all"
		_cmd.Console.Output "AVAILABLE COMMANDS:"
		For Local c:TConsoleCommand = EachIn _cmd.Console.CommandList
			Local help:String = c.Mask.ToLower()
			help = help.Replace("i","Int, ")
			help = help.Replace("f","Float, ")
			help = help.Replace("s","String, ")
			help = help[..help.Length-2]
			_cmd.Console.Output "/"+c.Name+" "+help
		Next
	Else
		_cmd.Console.Output "ERROR: Command '" + _cmd.Parameters[0] + "' does not exist!"
	End If
End Function

Debug.Console.RegisterCommand("End","",cmd_End,"Quits Program.")
Debug.Console.RegisterCommand("Quit","",cmd_End,"Quits Program.")
Function cmd_End(_cmd:TConsoleCommand)
	End
End Function

Debug.Console.RegisterCommand("Set","SS",cmd_Set,"Sets a debug variables value.|Example:|  /Set VariableA, 200")
Function cmd_Set(_cmd:TConsoleCommand)
	Local _Name:String = _cmd.Parameters[0]
	For Local _dv:TDebugVariable = EachIn Debug.Variables
		If _dv.Name.ToLower().Trim() = _Name.ToLower().Trim()
			_dv.SetValue(Double(_cmd.Parameters[1].Trim()))
			Exit
		End If
	Next
End Function

Debug.Console.RegisterCommand("Ignore","S",cmd_Ignore,"Ignores a debug variable.")
Function cmd_Ignore(_cmd:TConsoleCommand)
	Debug.IgnoreVariable(_cmd.Parameters[0])
End Function

'Enable Debug & Console
Debug.Enable

'Create some variables to watch
Local MX:Float, MY:Float, RAD:Float
'Tell Debug to watch them
Debug.WatchFloat("MX",MX)
Debug.WatchFloat("MY",MY)
Debug.WatchFloat("RAD",RAD)

While Not KeyHit(KEY_ESCAPE)
		'Update  variables w/ mouse position
		MX = MouseX()
		MY = MouseY()
		
		Debug.Update
	Cls
		
		DrawOval MX-RAD,MY-RAD,RAD*2,RAD*2
		
		'Render console and debug variables
		Debug.Render
	Flip
Wend

debug.bmx:
Manages the console and debug variables

Global Debug:TDebug = New TDebug

Type TDebug
	Field Variables:TList
	Field VarX:Float,VarY:Float
	Field Enabled:Byte
	Field Console:TConsole

	Method New()
		Variables:TList = CreateList()
		Console:TConsole = CreateConsole()
	End Method
	
	Method Enable()
		Enabled = True
		Console.Active = True
		Debug.Console.UpdatePosition
	End Method

	Method Disable()
		Enabled = False
		Console.Active = False
	End Method
	
	Method WatchInt (_Name:String, _Variable:Int Var)
		Local _dv:TDebugVariable = New TDebugVariable
		_dv.Kind = "%"
		_dv.Name = _Name
		_dv.ValueInt = Varptr _Variable
		Variables.AddLast(_dv)
	End Method

	Method WatchFloat (_Name:String, _Variable:Float Var)
		Local _dv:TDebugVariable = New TDebugVariable
		_dv.Kind = "#"
		_dv.Name = _Name
		_dv.ValueFloat = Varptr _Variable
		Variables.AddLast(_dv)
	End Method

	Method WatchDouble (_Name:String, _Variable:Double Var)
		Local _dv:TDebugVariable = New TDebugVariable
		_dv.Kind = "!"
		_dv.Name = _Name
		_dv.ValueDouble = Varptr _Variable
		Variables.AddLast(_dv)
	End Method
	
	Method IgnoreVariable (_Name:String)
		For Local _dv:TDebugVariable = EachIn Variables
			If _dv.Name.ToLower().Trim() = _Name.ToLower().Trim() Variables.Remove(_dv); Return
		Next
	End Method
	
	Method Render()
		If Not Enabled Return
		SetViewport 0,0,GraphicsWidth(),GraphicsHeight()
		SetScale 1,1
		SetRotation 0
		SetBlend ALPHABLEND
		SetAlpha 1
		SetColor 255,255,255
		Console.Render()
		Local i:Int = 0
		For Local _dv:TDebugVariable = EachIn Variables
			DrawText _dv.ToString(),VarX,VarY + (i*15)
			i :+ 1
		Next
	End Method

	Method Update()
		If Not Enabled Return
		Console.Update()
	End Method
End Type

Type TDebugVariable
	Field Name:String
	Field Kind:String
	Field ValueInt:Int Ptr
	Field ValueFloat:Float Ptr
	Field ValueDouble:Double Ptr
	Method ToString:String()
		Select Kind.ToLower().Trim()
			Case "%"
				Return Name + " = " + ValueInt[0]
			Case "#"
				Return Name + " = " + ValueFloat[0]
			Case "!"
				Return Name + " = " + ValueDouble[0]
		End Select
	End Method
	Method SetValue(_Value:Double)
		Select Kind.ToLower().Trim()
			Case "%"
				ValueInt[0] = Int(_Value)
			Case "#"
				ValueFloat[0] = Float(_Value)
			Case "!"
				ValueFloat[0] = Double(_Value)
		End Select
	End Method
End Type

console.bmx:

Const CONSOLE_TOPLEFT:Int = 0
Const CONSOLE_TOPCENTER:Int = 1
Const CONSOLE_TOPRIGHT:Int = 2
Function CreateConsole:TConsole (_Width:Float = 400, _Height:Float = 250, _Position:Int = 1)
	Local c:TConsole = New TConsole
	c.ToggleKey = KEY_TAB
	c.Width = _Width
	c.Height = _Height
	c.Position = _Position
	c.UpdatePosition
	c.Padding = 5
	c.Alpha = .5
	c.BackgroundColor = [128,128,128]
	c.TextColor = [255,255,255]
	c.CommandColor = [0,255,0]
	c.CursorTimer = MilliSecs()
	c.CursorInterval = 300
	c.CursorState = 1
	c.DisplayTextTimer = MilliSecs()
	c.DisplayTextInterval = 20000
	c.DisplayText = CreateList()
	c.History = CreateList() 
	c.CommandList = CreateList()
	Return c
End Function
Type TConsole
	Field Active:Int
	Field ToggleKey:Int
	Field X:Float, Y:Float, Width:Float, Height:Float, Padding:Int
	Field TargetY:Float
	Field Alpha:Float, BackgroundColor:Int[3], TextColor:Int[3], CommandColor:Int[3], Position:String
	Field CursorX:Int, CursorY:Int, CursorState:Int, CursorTimer:Long, CursorInterval:Int
	Field History:TList, HistoryPosition:Int
	Field DisplayText:TList, DisplayTextTimer:Long, DisplayTextInterval:Int
	Field InputBuffer:String
	Field CommandList:TList
	
	Method Update()
		If KeyHit(ToggleKey)
			If Active Then Active = False;TargetY=-Height Else Active = True;TargetY=0
			FlushKeys
		End If
		Y :+ (TargetY-Y)*.1
		If Not Active Return

		If MilliSecs() > CursorTimer + CursorInterval
			CursorTimer = MilliSecs()
			CursorState :* -1
		End If

		If MilliSecs() > DisplayTextTimer + DisplayTextInterval And DisplayText.Count()
			DisplayTextTimer = MilliSecs()
			DisplayText.Remove(DisplayText.Last())
		End If
		
		GetInput
	End Method
	
	Method GetInput()
		Local CharHeight:Int = TextHeight("E")
		Local CharWidth:Int = TextWidth("E") 
		Local CharPerLine:Int = (Width - Padding) / CharWidth
		
		Local Char:Int = GetChar()
		If (Char > 31) And (Char < 126)
			If (InputBuffer.Length < CharPerLine)
				InputBuffer = InputBuffer[..CursorX]+Chr(Char)+InputBuffer[CursorX..]
				CursorX :+ 1
			EndIf
		EndIf

		If Char = KEY_ENTER
			InputBuffer = InputBuffer.Trim()
			If InputBuffer.length > 0
				DisplayText.AddFirst(InputBuffer)
				History.AddFirst(InputBuffer)
				ProcessInput
				InputBuffer = ""
				CursorX = 0
				CursorY = 0
			End If
		EndIf
		
		If (DisplayText.Count() * CharHeight) > (height - (CharHeight + Padding))
			CursorY :+ (KeyDown(KEY_PAGEUP)-KeyDown(KEY_PAGEDOWN))*2
			If CursorY < 0 CursorY = 0
			If CursorY > (DisplayText.Count() * CharHeight)-(height - (CharHeight + Padding))
				CursorY = (DisplayText.Count() * CharHeight)-(height - (CharHeight + Padding))
			End If
		End If
		
		Local Key:Int = GetKey()
		Select Key
			Case KEY_UP
				If History.Count() > 0 Then
					If HistoryPosition < History.Count()-1 Then HistoryPosition :+ 1
					InputBuffer = String(History.ValueAtIndex(HistoryPosition))
					CursorX = InputBuffer.Length
				EndIf
			Case KEY_DOWN
				If History.Count() > 0 Then
					If HistoryPosition > -1 Then HistoryPosition :- 1
					If HistoryPosition < 0 Then 
						InputBuffer = ""
					Else
						InputBuffer = String(History.ValueAtIndex(HistoryPosition))
					EndIf
					CursorX = InputBuffer.Length
				EndIf
			Case KEY_LEFT
				If cursorX > 0 Then cursorX :- 1		
			Case KEY_RIGHT
				If cursorX < InputBuffer.Length Then cursorX :+ 1
			Case KEY_HOME
				CursorX = 0
			Case KEY_END
				CursorX = InputBuffer.Length
			Case KEY_BACKSPACE
				If CursorX > 0
					InputBuffer = InputBuffer[..(CursorX - 1)] + InputBuffer[CursorX..]
					CursorX :- 1
				EndIf  
			Case KEY_DELETE
				If CursorX < InputBuffer.Length
					InputBuffer = InputBuffer[..CursorX] + InputBuffer[(CursorX+1)..]
				EndIf  
		End Select
	End Method
	
	Method ProcessInput()
		If InputBuffer[..1] = "/"
			Local cmdN:String = InputBuffer[1..InputBuffer.Find(" ")]
			If InputBuffer.Find(" ") < 0 cmdN = InputBuffer[1..]
			Local cmd:TConsoleCommand = FindCommand(cmdN)
			If cmd
				Local _par:String[] = StringToStringArray(InputBuffer[InputBuffer.Find(" ")..],",")
				If InputBuffer.Find(" ") < 0 _par = Null
				cmd.Execute(_par)
			Else
				Output "ERROR: Command '" + cmdN + "' does not exist!"
			End If
		End If
	End Method
		
	Method Render()
		If Not Active And Y <= -Height  Return

		Local _Alpha:Float, _Color:Int[3], _Mode:Int
		_Alpha = GetAlpha()
		_Mode = GetBlend()
		GetColor _color[0],_color[1],_color[2]

		SetBlend ALPHABLEND
		SetAlpha Alpha
		SetColor BackgroundColor[0], BackgroundColor[1], BackgroundColor[2]
		
		Local CharHeight:Int = TextHeight("E") 
		Local CharWidth:Int = TextWidth("E") 
		
		DrawRect X,Y,width,height - (CharHeight + Padding + 1)
		DrawRect X,Y + height - (CharHeight + Padding), width, CharHeight + Padding
		
		SetAlpha Alpha * 2
		SetColor TextColor[0],TextColor[1],TextColor[2]
				
		If CursorState = 1 Then DrawRect X + Padding + (CursorX * CharWidth), Y + (height - Padding/2 - 2),CharWidth,2
		If InputBuffer[..1] = "/" And InputBuffer.Find(" ") > 0 
			SetColor CommandColor[0],CommandColor[1],CommandColor[2]
			DrawText InputBuffer[..InputBuffer.Find(" ")],X + Padding, Y + (height - (CharHeight + Padding/2))
			SetColor TextColor[0],TextColor[1],TextColor[2]
			DrawText InputBuffer[InputBuffer.Find(" ")..],X + Padding + InputBuffer[..InputBuffer.Find(" ")].Length * CharWidth, Y + (height - (CharHeight + Padding/2))
		ElseIf InputBuffer[..1] = "/"
			SetColor CommandColor[0],CommandColor[1],CommandColor[2]
			DrawText InputBuffer, X + Padding, Y + (height - (CharHeight + Padding/2))
			SetColor TextColor[0],TextColor[1],TextColor[2]
		Else
			DrawText InputBuffer, X + Padding, Y + (height - (CharHeight + Padding/2))
		End If
		SetViewport X,Y,width,height - (CharHeight + Padding + 1)
		Local MaxLines:Int = (height - (CharHeight + Padding)) / CharHeight 
		Local TextCount:Int
		For Local t:String = EachIn DisplayText
			If (TextCount * CharHeight) - CursorY < height - (CharHeight + Padding + 1)
				If t[..1] = "/" And t.Find(" ") > 0
					SetColor CommandColor[0],CommandColor[1],CommandColor[2]
					DrawText t[..t.Find(" ")] , X + Padding , Y + ( (height - (Padding * 4 + 1) - CharHeight) - (TextCount * CharHeight) ) + CursorY
					SetColor TextColor[0],TextColor[1],TextColor[2]
					DrawText t[t.Find(" ")..] , X + Padding + t[..t.Find(" ")].Length*CharWidth, Y + ( (height - (Padding * 4 + 1) - CharHeight) - (TextCount * CharHeight) ) + CursorY
				ElseIf t[..1] = "/"
					SetColor CommandColor[0],CommandColor[1],CommandColor[2]
					DrawText t , X + Padding , Y + ( (height - (Padding * 4 + 1) - CharHeight) - (TextCount * CharHeight) ) + CursorY
				SetColor TextColor[0],TextColor[1],TextColor[2]
				Else
					DrawText t , X + Padding , Y + ( (height - (Padding * 4 + 1) - CharHeight) - (TextCount * CharHeight) ) + CursorY
				End If
			End If
			TextCount :+ 1
		Next
		SetViewport 0,0,GraphicsWidth(),GraphicsHeight()
		SetBlend _Mode
		SetAlpha _Alpha
		SetColor _color[0], _color[1], _color[2]
	End Method
	
	Method UpdatePosition ()
		Select Position
			Case CONSOLE_TOPLEFT
				X = 0
				Y = 0
			Case CONSOLE_TOPCENTER
				X = GraphicsWidth()/2-Width/2			
				Y = 0
			Case CONSOLE_TOPRIGHT
				X = GraphicsWidth()-Width
				Y = 0
		End Select
	End Method
	
	Method FindCommand:TConsoleCommand (_Name:String)
		For Local cmd:TConsoleCommand = EachIn CommandList
			If cmd.Name.ToLower() = _Name.ToLower() Return cmd
		Next
	End Method
	
	Method RegisterCommand (_Name:String , _Mask:String , _Action(_cmd:TConsoleCommand) , _HelpText:String)
		Local cmd:TConsoleCommand = New TConsoleCommand
		cmd.Console = Self
		cmd.Name = _Name.Trim()
		cmd.Mask = _Mask.Trim()
		cmd.Action = _Action
		cmd.HelpText = _HelpText
		CommandList.AddLast(cmd)
	End Method
	
	Method Output(_str:String)
		DisplayText.AddFirst(_str)
	End Method
End Type

Type TConsoleCommand
	Field Console:TConsole
	Field Name:String
	Field Mask:String
	Field Parameters:String []
	Field Action(_cmd:TConsoleCommand)
	Field HelpText:String
	
	Method VerifyParams:Int(_Params:String[])
		If _Params.Length <> Mask.Length And Mask.Length > 0
			Console.Output "ERROR: Incorrect number of parameters"
			Return False
		End If
		Return True
	End Method
	
	Method Execute(_Params:String[])
		If Not VerifyParams(_Params) Return
		Parameters = _Params
		If Action <> Null Action(Self)
		Return
	End Method
End Type
	
Function StringToStringArray:String [] (_String:String, _Delimiter:String)
	Local TempArray:String [1]
	Local TempString:String
	While _String.Find(_Delimiter) <> -1
		TempString = _String[.._String.Find(_Delimiter)]
		_String = _String[TempString.Length + 1..]
		TempArray[TempArray.Length - 1] = TempString.Trim()
		TempArray = TempArray[..TempArray.Length + 1]
	Wend
	TempString = _String
	TempArray[TempArray.Length - 1] = TempString.Trim()
	Return TempArray
End Function

Function GetKey:Int()
	Const RepeatRate : Int = 100 'ms
	Global LastTime:Long = MilliSecs()
	Global LastKey:Int = 0
	Local key:Int = 0
		
	While  Key <= 226
		If KeyDown(key) Then Exit
		Key:+ 1
	Wend
	
	GCCollect()
	
	If Key = 227 Then Return 0
	
	If Key = LastKey Then
		If MilliSecs()-LastTime < RepeatRate Then Return 0
	EndIf
	
	LastTime = MilliSecs()
	LastKey = Key
	If Key < 227 Then Return Key Else Return 0
End Function

Feel free to make any suggestions or changes (Just make sure to post them here) and if you use this in your project let us know.

Enjoy!

altitudems

(Posted 2007) [#18]

Anyone else getting slowdowns when running the code above?

altitudems

(Posted 2007) [#19]

Has anyone had a chance to try this? I'm trying to figure out why I'm getting random(?) slowdowns here.