[bmx] OpenConsole by Perturbatio [ 1+ years ago ]

Started by BlitzBot, June 29, 2017, 00:28:42

Previous topic - Next topic

BlitzBot

Title : OpenConsole
Author : Perturbatio
Posted : 1+ years ago

Description : (BMax)
An example is shown at the bottom of the code.


Code :
Code (blitzmax) Select
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
SuperStrict

Import pert.appfuncs 'if you don't have this module remember to comment this line
 'and the SetAppTitle command below

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
'
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



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))

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:Int = 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 count  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

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)

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)


con.SetVisible(True)


Global CurrentMem:Int
Global LastMem : Int


While Not (KeyDown(KEY_ESCAPE) And (KeyDown(KEY_LSHIFT) Or KeyDown(KEY_RSHIFT)))
CurrentMem = GCMemAlloced()
If (CurrentMem < (LastMem - 18000)) Or (CurrentMem > (LastMem + 18000)) Then
'SetAppTitle is in AppFuncs.mod ( http://www.blitzbasic.com/Community/posts.php?topic=43341 )
'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()
'DrawText(CurrentMem, 0,GraphicsHeight()-20)
Flip

Wend
End


Comments :


Booticus(Posted 1+ years ago)

 Hey cool! Thanks! I noticed everyone else who made a console hasnt updated it to work with bmax 1.14 and above (BAD FILAX AND KLEPTO! hahahaha just kidding!) Anyways, thanks again Pert! Nice, clean, and minimalist.


Booticus(Posted 1+ years ago)

 (oops double post)