Module: TerminalGadget

Share your advanced PureBasic knowledge/code with the community.
User avatar
HeX0R
Addict
Addict
Posts: 973
Joined: Mon Sep 20, 2004 7:12 am
Location: Hell

Module: TerminalGadget

Post by HeX0R »

I were in need of VT100 terminal functionality in one of my tools.
After a long fight with the PB inbuild console i never were satisfied with the result, therefore I created a terminal gadget with a few gimmicks...

Example included (thanks to BasicallyPure for his nice background picture)

It should be crossplatform, at least windows and linux are tested (not with the background image functionality, I just added this a few minutes ago and didn't test it on linux yet)

Code: Select all

;*******************************************
;*
;*   Filename:     Terminal_Gadget.pbi
;*   Version:      V1.0.0
;*   Date:         11.01.2016
;*   Author:       HeX0R
;*                 http://hex0rs.coderbu.de
;*
;*   License:      BEER-WARE
;*                 Thomas 'HeX0R' Milz wrote this file. As long as you retain this notice you
;*                 can do whatever you want with this stuff. If we meet some day, and you think
;*                 this stuff is worth it, you can buy me a beer in return.
;*                                                               HeX0R@coderbu.de
;*
;*   OS:           [x] Windows
;*                 [x] Linux
;*                 [ ] MacOS (untested, should work though)
;*
;*   Description:  This is a module for a Terminal Gadget
;*                 You can create a VT100 terminal or something similar and can put it in a nice GUI
;*
;*   useful links: http://www.ccs.neu.edu/research/gpc/MSim/vona/terminal/VT100_Escape_Codes.html
;*
;*
;*   Usage
;*   Please have a look at the comments and at the example at the bottom of the code.
;*
;*
;*******************************************

DeclareModule TERM

	;Default VT100 flags
	#CHAR_FLAG_NORMAL     = $0000
	#CHAR_FLAG_BOLD       = $0001
	#CHAR_FLAG_UNDERLINED = $0002
	#CHAR_FLAG_REVERSE    = $0004
	#CHAR_FLAG_LOWINTENSE = $0008
	#CHAR_FLAG_INVISIBLE  = $0010
	#CHAR_FLAG_BLINKING   = $0020 ;<- not (yet) integrated!

	;Flags for the background picture
	Enumeration
		#IMAGE_FLAG_CLIPPED
		#IMAGE_FLAG_STRETCHED_PROPORTIONAL
		#IMAGE_FLAG_STRETCHED
	EndEnumeration


	;Global Procedures
	Declare CreateTerminalGadget   (Gadget, x, y, Width, Height, TerminalCharsX = 80, TerminalCharsY = 24, Flags = 0)
	Declare FreeTerminalGadget     (Gadget)
	Declare ClearTerminal          (Gadget)
	Declare RedrawTerminal         (Gadget)
	Declare LocateCursor           (Gadget, x, y)
	Declare PrintText              (Gadget, Text.s)
	Declare PrintTextN             (Gadget, Text.s)
	Declare GetTerminalCursorPos   (Gadget, *x.INTEGER, *y.INTEGER)
	Declare SetTerminalCharStyle   (Gadget, Flags)
	Declare ChangeTerminalCharCount(Gadget, CharsX, CharsY)
	Declare SetTerminalFont        (Gadget, FontName.s, ySize)
	Declare SetTerminalColors      (Gadget, FrontColor, BackColor, ScrollBarBackColor = $525252, ScrollBarSliderColor = $A0A0A0, LowIntenseColor = $999999)
	Declare SetBackgroundImage     (Gadget, Image, Mode                              = 0)

EndDeclareModule

Module TERM
	EnableExplicit

	;IDENT will help us to identify a Gadget as Terminal-Gadget
	#TERM_GADGET_IDENT    = $ab1f4519

	
	;Structure for each single characters
	Structure _SINGLE_CHAR_
		s.s{1}
		Flags.w
	EndStructure

	;This will contain the whole terminal characters
	Structure _CHAR_
		c._SINGLE_CHAR_[0]
	EndStructure

	;Variables belonging to the Terminal Gadget
	Structure _GADGET_VARS_
		Ident.i                    ;<- must stay on first place!!
		ThreadID.i                 ;<- we need a thread for the blinking cursor
		Mutex.i                    ;<- we need also a Mutex to make sure the Thread will not get in conflict with the rest
		GadgetID.i                 ;<- GadgetID of the Terminal Gadget
		BackgroundOriginalImage.i  ;<- [optional] a background image for the terminal
		BackgroundImage.i          ;<- [optional] will be a sized copy of above
		ImageMode.i                ;<- modes for the image sizing
		StopThread.i               ;<- to safely stop the thread
		CharsX.i                   ;<- the max horizontal characters
		CharsY.i                   ;<- the max vertical SEEABLE characters.
		BlinkingFrequency.i        ;<- frequency of the blinking cursor (in ms)
		CursorState.i              ;<- 1 = cursor, 0 = character showing
		CursorElapsed.i            ;<- little helper for the blinking time
		FlagsActive.i              ;<- whenever you set flags via SetTerminalCharStyle() it will be kept in mind for any further text outputs
		FontNormal.i               ;<- the FontID, which is used for normal text
		FontBold.i                 ;<- the FontID, which is used for bold text
		FontUnderline.i            ;<- the FontID, which is used for underlined text
		BackColor.i                ;<- default back color of the terminal
		FrontColor.i               ;<- default front color of the terminal
		LowIntenseColor.i          ;<- VT100 does have a lowintense flag
		ScrollBarBackColor.i       ;<- back color of the scroll bar
		ScrollBarSliderColor.i     ;<- color of the slider of the scroll bar
		CharPixelW.i               ;<- width in pixel of one character (depends on the font)
		CharPixelH.i               ;<- height in pixel of one character (depends on the font)
		PosX.i                     ;<- current x position
		PosY.i                     ;<- current y position
		CursorHeight.i             ;<- the heihgt (in pixel) of the used cursor
		*Arr._CHAR_                ;<- array which contains all of the characters in the terminal
		LinesOverall.i             ;<- how many lines do we really have? Can also be much more than CharsY
		PosOffsetX.i               ;<- cursor pos offset x
		PosOffsetY.i               ;<- cursor pos offset y
		DrawScrollArea.i           ;<- if mouse is near the edge, DrawScrollArea will be #True and the scroll bar will be drawn
		LastPrintedLine.i          ;<- Last seeable line, useful for the scroll bar
		MoverX.i                   ;<- needed for the slider
		MoverY.i                   ;<- needed for the slider
		MoverCatched.i             ;<- if mouse is over the slider and LMB is pressed
		MouseYOffset.i             ;<- used for the scroll bar
		ScrollBarWidth.i           ;<- width of the scrollbar
		RedrawInAction.i           ;<- for speed improvements, especially when you have a background image
	EndStructure

	Macro _MACRO_REDRAW_
		;this macro will redraw the whole (seeable) content
		StoreX            = *G\PosX
		StoreY            = *G\PosY
		*G\RedrawInAction = #True
		If StartDrawing(CanvasOutput(*G\GadgetID))
			Box(0, 0, GadgetWidth(*G\GadgetID), GadgetHeight(*G\GadgetID), *G\BackColor)
			If *G\BackgroundImage <> -1
				DrawImage(ImageID(*G\BackgroundImage), 0, 0)
				DrawingMode(#PB_2DDrawing_Transparent)
			EndIf
			For y2 = *G\PosOffsetY To *G\PosOffsetY + *G\CharsY - 1
				For x2 = *G\PosOffsetX To *G\PosOffsetX + *G\CharsX - 1
					*G\PosX = x2
					*G\Posy = y2
					DrawChar(*G)
				Next x2
			Next y2
			DoScrollBar(*G)
			StopDrawing()
		EndIf
		*G\PosX           = StoreX
		*G\PosY           = StoreY
		*G\RedrawInAction = #False
	EndMacro
	
	Procedure ResizeBackgroundImage(*G._GADGET_VARS_)
		;INTERNAL
		;whenever someone resizes (or creates) the terminal, or changes the font size,
		;we need to make sure, that the background image will fit
		
		Protected x, y, f1.f, f2.f
		
		If *G\BackgroundOriginalImage <> -1
			If *G\BackgroundImage <> -1
				FreeImage(*G\BackgroundImage)
			EndIf
			*G\BackgroundImage = CopyImage(*G\BackgroundOriginalImage, #PB_Any)
			Select *G\ImageMode
				Case #IMAGE_FLAG_CLIPPED
					;ready
				Case #IMAGE_FLAG_STRETCHED
					ResizeImage(*G\BackgroundImage, *G\CharsX * *G\CharPixelW, *G\CharsY * *G\CharPixelH)
				Case #IMAGE_FLAG_STRETCHED_PROPORTIONAL
					x  = *G\CharsX * *G\CharPixelW
					y  = *G\CharsY * *G\CharPixelH
					f1 = x / ImageWidth(*G\BackgroundImage)
					f2 = y / ImageHeight(*G\BackgroundImage)
					If f1 > f2
						ResizeImage(*G\BackgroundImage, ImageWidth(*G\BackgroundImage) * f2, y)
					Else
						ResizeImage(*G\BackgroundImage, x, ImageHeight(*G\BackgroundImage) * f1)
					EndIf
			EndSelect
		EndIf
		
	EndProcedure

	Procedure DrawChar(*G._GADGET_VARS_, NewChar.s = "")
		;INTERNAL
		;This procedure draws just one single character
		
		Protected Flag, FrontColor, BackColor, Pos, x, y, Image, x2, y2

		;show character
		Pos = *G\PosX + *G\PosY * *G\CharsX
		If NewChar <> ""
			*G\Arr\c[Pos]\s     = NewChar
			*G\Arr\c[Pos]\Flags = *G\FlagsActive
		EndIf
		Flag       = *G\Arr\c[Pos]\Flags
		FrontColor = *G\FrontColor
		BackColor  = *G\BackColor
		If Flag & #CHAR_FLAG_BOLD
			DrawingFont(FontID(*G\FontBold))
		ElseIf Flag & #CHAR_FLAG_UNDERLINED
			DrawingFont(FontID(*G\FontUnderline))
		Else
			DrawingFont(FontID(*G\FontNormal))
		EndIf
		If Flag & #CHAR_FLAG_INVISIBLE
			FrontColor = BackColor
		EndIf
		If Flag & #CHAR_FLAG_LOWINTENSE
			FrontColor = *G\LowIntenseColor
		EndIf
		If Flag & #CHAR_FLAG_REVERSE
			Swap FrontColor, BackColor
		EndIf
		;first remove background
		x = (*G\PosX * *G\CharPixelW) - (*G\PosOffsetX * *G\CharPixelW)
		y = (*G\PosY * *G\CharPixelH) - (*G\PosOffsetY * *G\CharPixelH)
		If *G\BackgroundImage <> -1
			;we have a background image, so we need to reset the original part of the picture behind the character,
			If *G\RedrawInAction = #False ;<- if we redraw the whole content, we don't have to care about each single background
				If x < 0 Or y < 0
					x2 = x
					y2 = y
					If x2 < 0
						x2 = 0
					EndIf
					If y2 < 0
						y2 = 0
					EndIf
					Image = GrabImage(*G\BackgroundImage, #PB_Any, x2, y2, *G\CharPixelW, *G\CharPixelH)
					DrawImage(ImageID(Image), x, y)
				Else
					Image = GrabImage(*G\BackgroundImage, #PB_Any, x, y, *G\CharPixelW, *G\CharPixelH)
					DrawImage(ImageID(Image), x, y)
				EndIf
				FreeImage(Image)
			EndIf
			DrawingMode(#PB_2DDrawing_Transparent)
		Else
			;no image? well, then it's easy, just draw a box
			Box(x, y, *G\CharPixelW, *G\CharPixelH, BackColor)
		EndIf
		DrawText(x, y, *G\Arr\c[Pos]\s, FrontColor, BackColor)

	EndProcedure

	Procedure DoScrollBar(*G._GADGET_VARS_)
		;INTERNAL
		;Procedure to show the scrollbar
		
		Protected f.f, i, h, Pos

		If *G\DrawScrollArea
			Box(GadgetWidth(*G\GadgetID) - *G\ScrollBarWidth, 0, *G\ScrollBarWidth, GadgetHeight(*G\GadgetID), *G\ScrollBarBackColor)
			i = 1 + *G\LastPrintedLine - *G\CharsY
			If i <= 0
				i = 1
			EndIf
			h   = GadgetHeight(*G\GadgetID) - 35
			f   = h / i
			Pos = f * *G\PosOffsetY
			If Pos < 0
				Pos = 0
			EndIf
			*G\MoverX = GadgetWidth(*G\GadgetID) - *G\ScrollBarWidth + 2
			*G\MoverY = Pos
			Box(*G\MoverX, Pos, *G\ScrollBarWidth - 4, 30, *G\ScrollBarSliderColor)
			LineXY(*G\MoverX + 2, Pos + 12, *G\MoverX + *G\ScrollBarWidth - 8, Pos + 12, *G\ScrollBarBackColor)
			LineXY(*G\MoverX + 2, Pos + 15, *G\MoverX + *G\ScrollBarWidth - 8, Pos + 15, *G\ScrollBarBackColor)
			LineXY(*G\MoverX + 2, Pos + 18, *G\MoverX + *G\ScrollBarWidth - 8, Pos + 18, *G\ScrollBarBackColor)
		EndIf

	EndProcedure

	Procedure SetScrollBar(*G._GADGET_VARS_, PixY)
		;INTERNAL
		;Procedure to set the slider position within the scroll bar.
		
		Protected f.f, i, h, Pos, StoreX, StoreY, x2, y2

		If *G\DrawScrollArea
			i = 1 + *G\LastPrintedLine - *G\CharsY
			If i <= 0
				i = 1
			EndIf
			h             = GadgetHeight(*G\GadgetID) - 35
			f             = h / i
			*G\PosOffsetY = PixY / f
			*G\MoverX     = GadgetWidth(*G\GadgetID) - *G\ScrollBarWidth + 2
			*G\MoverY     = PixY
			LockMutex(*G\Mutex)
			_MACRO_REDRAW_
			UnlockMutex(*G\Mutex)
		EndIf

	EndProcedure

	Procedure GadgetThread(*G._GADGET_VARS_)
		;INTERNAL
		;we just use the thread for the blinking cursor
		;It should be also used to get the #CHAR_FLAG_BLINKING working (no need for now)
		
		Protected x, y
		
		
		Repeat

			LockMutex(*G\Mutex)

			If *G\CursorElapsed < ElapsedMilliseconds()
				*G\CursorElapsed = ElapsedMilliseconds() + *G\BlinkingFrequency
				*G\CursorState ! 1
				If *G\CursorState
					x = (*G\PosX * *G\CharPixelW) - (*G\PosOffsetX * *G\CharPixelW)
					y = (*G\PosY * *G\CharPixelH) - (*G\PosOffsetY * *G\CharPixelH)
					If StartDrawing(CanvasOutput(*G\GadgetID))
						If *G\BackgroundImage
							DrawingMode(#PB_2DDrawing_Transparent)
						Else
							Box(x, y, *G\CharPixelW, *G\CharPixelH, *G\BackColor)
						EndIf
						;show cursor
						Box(x, y + *G\CharPixelH - *G\CursorHeight, *G\CharPixelW, *G\CursorHeight, *G\FrontColor)
						DoScrollBar(*G)
						StopDrawing()
					EndIf
				Else
					If StartDrawing(CanvasOutput(*G\GadgetID))
						DrawChar(*G)
						DoScrollBar(*G)
						StopDrawing()
					EndIf
				EndIf
			EndIf
			UnlockMutex(*G\Mutex)

			Delay(20)
			If *G\StopThread
				Break
			EndIf

		ForEver

	EndProcedure

	Procedure ClearTerminal(Gadget)
		;EXTERNAL
		;Clear the whole terminal and reset a few of the variables
		
		Protected *G._GADGET_VARS_, w, h, i, Size

		If IsGadget(Gadget)
			*G = GetGadgetData(Gadget)
			If *G = 0 Or *G\Ident <> #TERM_GADGET_IDENT
				ProcedureReturn 0
			EndIf
			LockMutex(*G\Mutex)
			w = GadgetWidth(Gadget)
			h = GadgetHeight(Gadget)
			If StartDrawing(CanvasOutput(Gadget))
				Box(0, 0, w, h, *G\BackColor)
				If *G\BackgroundImage <> -1
					DrawImage(ImageID(*G\BackgroundImage), 0, 0)
				EndIf
				StopDrawing()
			EndIf
			*G\PosX            = 0
			*G\PosY            = 0
			*G\PosOffsetX      = 0
			*G\PosOffsetY      = 0
			*G\LastPrintedLine = 0
			Size               = *G\CharsX * *G\LinesOverall - 1
			For i = 0 To Size
				*G\Arr\c[i]\s     = " "
				*G\Arr\c[i]\Flags = 0
			Next i
			UnlockMutex(*G\Mutex)
		EndIf
	EndProcedure

	Procedure RedrawTerminal(Gadget)
		;EXTERNAL
		;Redraw the content of the terminal
		
		Protected *G._GADGET_VARS_, x2, y2, StoreX, StoreY

		If IsGadget(Gadget)
			*G = GetGadgetData(Gadget)
			If *G = 0 Or *G\Ident <> #TERM_GADGET_IDENT
				ProcedureReturn 0
			EndIf
			LockMutex(*G\Mutex)
			ResizeBackgroundImage(*G)
			_MACRO_REDRAW_
			UnlockMutex(*G\Mutex)
		EndIf
	EndProcedure

	Procedure ChangeTerminalCharCount(Gadget, CharsX, CharsY)
		;EXTERNAL
		;You can change the terminal size on-the-fly.
		;To make sure anything is fine, you should call RedrawTerminal afterwards
		
		Protected *G._GADGET_VARS_, Result, x, y, *Buffer._CHAR_

		If IsGadget(Gadget)
			*G = GetGadgetData(Gadget)
			If *G = 0 Or *G\Ident <> #TERM_GADGET_IDENT
				ProcedureReturn 0
			EndIf
			LockMutex(*G\Mutex)
			If CharsX <> *G\CharsX Or CharsY <> *G\CharsY
				*Buffer = AllocateMemory(CharsX * *G\LinesOverall * SizeOf(_SINGLE_CHAR_))
				If *Buffer
					For y = 0 To *G\LinesOverall - 1
						For x = 0 To CharsX - 1
							If x < *G\CharsX
								*Buffer\c[x + y * CharsX]\Flags = *G\Arr\c[x + y * *G\CharsX]\Flags
								*Buffer\c[x + y * CharsX]\s     = *G\Arr\c[x + y * *G\CharsX]\s
							Else
								*Buffer\c[x + y * CharsX]\Flags = 0
								*Buffer\c[x + y * CharsX]\s     = " "
							EndIf
						Next x
					Next y
					FreeMemory(*G\Arr)
					*G\Arr    = *Buffer
					*G\CharsX = CharsX
					*G\CharsY = CharsY
					Result    = #True
				EndIf
			EndIf
			UnlockMutex(*G\Mutex)
		EndIf

		ProcedureReturn Result
	EndProcedure

	Procedure GadgetEvent_MouseWheel()
		;INTERNAL
		;To make sure the terminal will scroll down/up via the mouse wheel
		
		Protected x, y, Gadget, x2, y2, StoreX, StoreY
		Protected *G._GADGET_VARS_

		Gadget = EventGadget()
		If IsGadget(Gadget)
			*G = GetGadgetData(Gadget)
			If *G = 0 Or *G\Ident <> #TERM_GADGET_IDENT
				ProcedureReturn 0
			EndIf
		EndIf
		;   If *G\DrawScrollArea
		If *G\LastPrintedLine > *G\CharsY - 1
			x = GetGadgetAttribute(*G\GadgetID, #PB_Canvas_WheelDelta)
			*G\PosOffsetY - x
			If *G\PosOffsetY < 0
				*G\PosOffsetY = 0
			ElseIf *G\PosOffsetY > 2 + *G\LastPrintedLine - *G\CharsY
				*G\PosOffsetY = 2 + *G\LastPrintedLine - *G\CharsY
			EndIf
			LockMutex(*G\Mutex)
			_MACRO_REDRAW_
			UnlockMutex(*G\Mutex)
		EndIf

	EndProcedure

	Procedure GadgetEvent_MouseMove()
		;INTERNAL
		;Needed for the scroll bar
		
		Protected x, y, i, f.f, h, Gadget, x2, y2, StoreX, StoreY, DeltaY
		Protected *G._GADGET_VARS_

		Gadget = EventGadget()
		If IsGadget(Gadget)
			*G = GetGadgetData(Gadget)
			If *G = 0 Or *G\Ident <> #TERM_GADGET_IDENT
				ProcedureReturn 0
			EndIf
		EndIf
		x = GetGadgetAttribute(*G\GadgetID, #PB_Canvas_MouseX)
		y = GetGadgetAttribute(*G\GadgetID, #PB_Canvas_MouseY)

		If *G\MoverCatched Or (x > GadgetWidth(*G\GadgetID) - 45 And x < GadgetWidth(*G\GadgetID) And *G\LastPrintedLine > *G\CharsY)
			;yes, right side
			If *G\DrawScrollArea = #False
				LockMutex(*G\Mutex)
				*G\DrawScrollArea = #True
				_MACRO_REDRAW_
				UnlockMutex(*G\Mutex)
			EndIf
			If *G\MoverCatched
				;scroll!
				DeltaY = y - *G\MouseYOffset
				If DeltaY < 0
					DeltaY = 0
				ElseIf DeltaY > GadgetHeight(Gadget) - 30
					DeltaY = GadgetHeight(Gadget) - 30
				EndIf
				SetScrollBar(*G, DeltaY)
			EndIf
		ElseIf *G\DrawScrollArea = #True
			LockMutex(*G\Mutex)
			*G\DrawScrollArea = #False
			_MACRO_REDRAW_
			UnlockMutex(*G\Mutex)
		EndIf

	EndProcedure

	Procedure GadgetEvent_LeftButtonDown()
		;INTERNAL
		;Needed for the scroll bar
		
		Protected *G._GADGET_VARS_, x, y, Gadget

		Gadget = EventGadget()
		If IsGadget(Gadget)
			*G = GetGadgetData(Gadget)
			If *G = 0 Or *G\Ident <> #TERM_GADGET_IDENT
				ProcedureReturn 0
			EndIf
		EndIf
		*G\MoverCatched = #False
		If *G\DrawScrollArea
			x = GetGadgetAttribute(*G\GadgetID, #PB_Canvas_MouseX)
			y = GetGadgetAttribute(*G\GadgetID, #PB_Canvas_MouseY)
			If x >= *G\MoverX And x < *G\MoverX + *G\ScrollBarWidth - 4 And y >= *G\MoverY And y < *G\MoverY + 30
				*G\MoverCatched = #True
				*G\MouseYOffset = y - *G\MoverY
			EndIf
		EndIf
	EndProcedure

	Procedure GadgetEvent_LeftButtonUp()
		;INTERNAL
		;Needed for the scroll bar
		
		Protected *G._GADGET_VARS_, Gadget

		Gadget = EventGadget()
		If IsGadget(Gadget)
			*G = GetGadgetData(Gadget)
			If *G = 0 Or *G\Ident <> #TERM_GADGET_IDENT
				ProcedureReturn 0
			EndIf
		EndIf
		*G\MoverCatched = #False
	EndProcedure

	Procedure CreateTerminalGadget(Gadget, x, y, Width, Height, TerminalCharsX = 80, TerminalCharsY = 24, Flags = 0)
		;EXTERNAL
		;Main procedure to create the Gadget
		;No need to specify the real amount of lines.
		;The gadget will expand the memory on-the-fly
		
		Protected Result, *Buffer._GADGET_VARS_

		Result = CanvasGadget(Gadget, x, y, Width, Height, #PB_Canvas_Keyboard)
		If Result
			If Gadget = #PB_Any
				Gadget = Result
			EndIf
			*Buffer = AllocateMemory(SizeOf(_GADGET_VARS_))
			If *Buffer = 0
				FreeGadget(Gadget)
				ProcedureReturn 0
			EndIf
			With *Buffer
				\Ident                   = #TERM_GADGET_IDENT
				\GadgetID                = Gadget
				\StopThread              = #False
				\CharsX                  = TerminalCharsX
				\CharsY                  = TerminalCharsY
				\BlinkingFrequency       = 400 ;ms
				\FontNormal              = LoadFont(#PB_Any, "Lucida Console", 10)
				\FontBold                = LoadFont(#PB_Any, "Lucida Console", 10, #PB_Font_Bold)
				\FontUnderline           = LoadFont(#PB_Any, "Lucida Console", 10, #PB_Font_Underline)
				\BackColor               = 0
				\LastPrintedLine         = 0
				\FrontColor              = $FFFFFF
				\ScrollBarBackColor      = $525252
				\ScrollBarSliderColor    = $A0A0A0
				\LowIntenseColor         = $999999
				\LinesOverall            = 16384  ;<- 16384 lines = 5MB
				\ScrollBarWidth          = 20
				\CursorHeight            = 3
				\BackgroundImage         = -1
				\BackgroundOriginalImage = -1
				\Mutex                   = CreateMutex()
				If StartDrawing(CanvasOutput(Gadget))
					DrawingFont(FontID(\FontNormal))
					\CharPixelW    = TextWidth("W") + 1
					\CharPixelH    = TextHeight("W") + 1
					StopDrawing()
				EndIf
				\Arr      = AllocateMemory(\CharsX * \LinesOverall * SizeOf(_SINGLE_CHAR_))
				\ThreadID = CreateThread(@GadgetThread(), *Buffer)
			EndWith
			SetGadgetData(Gadget, *Buffer)
			ClearTerminal(Gadget)
			BindGadgetEvent(Gadget, @GadgetEvent_MouseMove(), #PB_EventType_MouseMove)
			BindGadgetEvent(Gadget, @GadgetEvent_MouseWheel(), #PB_EventType_MouseWheel)
			BindGadgetEvent(Gadget, @GadgetEvent_LeftButtonDown(), #PB_EventType_LeftButtonDown)
			BindGadgetEvent(Gadget, @GadgetEvent_LeftButtonUp(), #PB_EventType_LeftButtonUp)

		EndIf

		ProcedureReturn Result
	EndProcedure

	Procedure SetTerminalColors(Gadget, FrontColor, BackColor, ScrollBarBackColor = $525252, ScrollBarSliderColor = $A0A0A0, LowIntenseColor = $999999)
		;EXTERNAL
		;You can set a few colors here
		
		Protected *G._GADGET_VARS_, Result
		Protected StoreX, StoreY, x2, y2

		If IsGadget(Gadget)
			*G = GetGadgetData(Gadget)
			If *G = 0 Or *G\Ident <> #TERM_GADGET_IDENT
				ProcedureReturn 0
			EndIf

			LockMutex(*G\Mutex)
			*G\BackColor            = BackColor
			*G\FrontColor           = FrontColor
			*G\ScrollBarBackColor   = ScrollBarBackColor
			*G\ScrollBarSliderColor = ScrollBarSliderColor
			*G\LowIntenseColor      = LowIntenseColor
			_MACRO_REDRAW_
			UnlockMutex(*G\Mutex)
		EndIf
	EndProcedure

	Procedure SetBackgroundImage(Gadget, Image, Mode = 0)
		;EXTERNAL
		;Want to have a background image?
		;No problem, just use it.
		;But the performance will be a little lower than without background image.
		
		Protected *G._GADGET_VARS_, Result
		Protected StoreX, StoreY, x2, y2

		If IsGadget(Gadget)
			*G = GetGadgetData(Gadget)
			If *G = 0 Or *G\Ident <> #TERM_GADGET_IDENT
				ProcedureReturn 0
			EndIf
			If *G\BackgroundImage <> -1
				FreeImage(*G\BackgroundImage)
				FreeImage(*G\BackgroundOriginalImage)
			EndIf
			*G\BackgroundImage         = -1
			*G\BackgroundOriginalImage = -1
			If IsImage(Image)
				*G\BackgroundOriginalImage = Image
			EndIf
			*G\ImageMode = Mode
			ResizeBackgroundImage(*G)
			LockMutex(*G\Mutex)
			_MACRO_REDRAW_
			UnlockMutex(*G\Mutex)
		EndIf

	EndProcedure

	Procedure FreeTerminalGadget(Gadget)
		;EXTERNAL
		;Useful to free all of the things we were in need of.
		
		Protected *G._GADGET_VARS_, Result

		If IsGadget(Gadget)
			*G = GetGadgetData(Gadget)
			If *G = 0 Or *G\Ident <> #TERM_GADGET_IDENT
				ProcedureReturn 0
			EndIf
			If *G\ThreadID And IsThread(*G\ThreadID)
				*G\StopThread = #True
				If WaitThread(*G\ThreadID, 1000) = 0
					KillThread(*G\ThreadID)
				EndIf
			EndIf
			FreeMutex(*G\Mutex)
			FreeMemory(*G\Arr)
			FreeFont(*G\FontNormal)
			FreeFont(*G\FontBold)
			FreeFont(*G\FontUnderline)
			If *G\BackgroundImage <> -1
				FreeImage(*G\BackgroundImage)
				FreeImage(*G\BackgroundOriginalImage)
			EndIf
			FreeMemory(*G)
			FreeGadget(Gadget)
			Result = #True
		EndIf

		ProcedureReturn Result
	EndProcedure

	Procedure LocateCursor(Gadget, x, y)
		;EXTERNAL
		;Same than LocateCursor of the PB console commands
		
		Protected *G._GADGET_VARS_, StoreX, StoreY, x2, y2

		If IsGadget(Gadget)
			*G = GetGadgetData(Gadget)
			If *G = 0 Or *G\Ident <> #TERM_GADGET_IDENT
				ProcedureReturn 0
			EndIf
			LockMutex(*G\Mutex)
			If *G\CursorState
				;cursor will move, so print the stored Char
				If StartDrawing(CanvasOutput(*G\GadgetID))
					DrawChar(*G)
					StopDrawing()
				EndIf
				*G\CursorElapsed = 0
				*G\CursorState   = 0
			EndIf
			If x >= 0 And x < *G\CharsX
				*G\PosX = x
			EndIf
			If y >= 0 And y < *G\LinesOverall
				*G\PosY = y
				If y >= *G\PosOffsetY + *G\CharsY
					*G\PosOffsetY = y - *G\CharsY + 1
					If *G\PosOffsetY <= 0
						*G\PosOffsetY = 0
					EndIf
					;redraw terminal
					_MACRO_REDRAW_
					;RedrawTerminal(Gadget)
				ElseIf y < *G\PosOffsetY
					*G\PosOffsetY = y
					If *G\PosOffsetY > *G\LinesOverall
						Debug "??"
					EndIf
					;redraw terminal
					_MACRO_REDRAW_
					;RedrawTerminal(Gadget)
				EndIf
			EndIf
			If y > *G\LastPrintedLine
				*G\LastPrintedLine = y
			EndIf
			UnlockMutex(*G\Mutex)

		EndIf

		ProcedureReturn *G
	EndProcedure

	Procedure PrintText(Gadget, Text.s)
		;EXTERNAL
		;Same than PrintText of the PB console commands
		
		Protected *G._GADGET_VARS_, i

		If IsGadget(Gadget)
			*G = GetGadgetData(Gadget)
			If *G = 0 Or *G\Ident <> #TERM_GADGET_IDENT
				ProcedureReturn 0
			EndIf
			LockMutex(*G\Mutex)
			If StartDrawing(CanvasOutput(*G\GadgetID))
				For i = 1 To Len(Text)
					DrawChar(*G, Mid(Text, i, 1))
					*G\PosX + 1
					If *G\PosX >= *G\CharsX
						*G\PosX = *G\CharsX - 1
					EndIf
				Next i
				DoScrollBar(*G)
				StopDrawing()
			EndIf
			If *G\CursorState
				*G\CursorElapsed = 0
				*G\CursorState   = 0
			EndIf
			UnlockMutex(*G\Mutex)

		EndIf

		ProcedureReturn *G
	EndProcedure

	Procedure PrintTextN(Gadget, Text.s)
		;EXTERNAL
		;Same than PrintTextN of the PB console commands
		Protected *G._GADGET_VARS_, i, x2, y2, StoreX, StoreY

		If IsGadget(Gadget)
			*G = GetGadgetData(Gadget)
			If *G = 0 Or *G\Ident <> #TERM_GADGET_IDENT
				ProcedureReturn 0
			EndIf
			LockMutex(*G\Mutex)
			If StartDrawing(CanvasOutput(*G\GadgetID))
				For i = 1 To Len(Text)
					DrawChar(*G, Mid(Text, i, 1))
					*G\PosX + 1
					If *G\PosX >= *G\CharsX
						*G\PosX = *G\CharsX - 1
					EndIf
				Next i
				*G\PosY + 1
				*G\PosX = 0
				If *G\PosY >= *G\PosOffsetY + *G\CharsY
					*G\PosOffsetY = *G\PosY - *G\CharsY + 1
					;redraw terminal
					StopDrawing()
					_MACRO_REDRAW_
					;RedrawTerminal(Gadget)
				Else
					DoScrollBar(*G)
					StopDrawing()
				EndIf
			EndIf
			If *G\CursorState
				*G\CursorElapsed = 0
				*G\CursorState   = 0
			EndIf
			If *G\PosY > *G\LastPrintedLine
				*G\LastPrintedLine = *G\PosY
			EndIf
			UnlockMutex(*G\Mutex)

		EndIf

		ProcedureReturn *G
	EndProcedure


	Procedure GetTerminalCursorPos(Gadget, *x.INTEGER, *y.INTEGER)
		;EXTERNAL
		;Useful to find out the current position of the cursor
		
		Protected *G._GADGET_VARS_

		If IsGadget(Gadget)
			*G = GetGadgetData(Gadget)
			If *G = 0 Or *G\Ident <> #TERM_GADGET_IDENT
				ProcedureReturn 0
			EndIf
			If *x
				*x\i = *G\PosX
			EndIf
			If *y
				*y\i = *G\PosY
			EndIf
			ProcedureReturn #True
		EndIf
	EndProcedure

	Procedure SetTerminalCharStyle(Gadget, Flags)
		;EXTERNAL
		;Set the character flags
		;Any upcoming PrintText[N] command will use this flags
		
		Protected *G._GADGET_VARS_

		If IsGadget(Gadget)
			*G = GetGadgetData(Gadget)
			If *G = 0 Or *G\Ident <> #TERM_GADGET_IDENT
				ProcedureReturn 0
			EndIf
			*G\FlagsActive = Flags
		EndIf
	EndProcedure

	Procedure SetTerminalFont(Gadget, FontName.s, ySize)
		;EXTERNAL
		;Set the font and size of the terminal Gadget
		
		Protected *G._GADGET_VARS_, x2, y2, StoreX, StoreY

		If IsGadget(Gadget)
			*G = GetGadgetData(Gadget)
			If *G = 0 Or *G\Ident <> #TERM_GADGET_IDENT
				ProcedureReturn 0
			EndIf
			LockMutex(*G\Mutex)
			FreeFont(*G\FontBold)
			FreeFont(*G\FontNormal)
			FreeFont(*G\FontUnderline)
			*G\FontNormal    = LoadFont(#PB_Any, FontName, ySize)
			*G\FontBold      = LoadFont(#PB_Any, FontName, ySize, #PB_Font_Bold)
			*G\FontUnderline = LoadFont(#PB_Any, FontName, ySize, #PB_Font_Underline)
			If StartDrawing(CanvasOutput(*G\GadgetID))
				DrawingFont(FontID(*G\FontNormal))
				*G\CharPixelW    = TextWidth("W") + 1
				*G\CharPixelH    = TextHeight("W") + 1
				StopDrawing()
			EndIf
			ResizeBackgroundImage(*G)
			_MACRO_REDRAW_
			UnlockMutex(*G\Mutex)
		EndIf

	EndProcedure

EndModule

;------------------------------------------------
;
;    E X A M P L E
;
;------------------------------------------------


CompilerIf #PB_Compiler_IsMainFile

Procedure SizeMyWindow()

	ResizeGadget(0, #PB_Ignore, #PB_Ignore, WindowWidth(0) - 10, WindowHeight(0) - 20)
	TERM::RedrawTerminal(0)
EndProcedure

Procedure main()
	Protected a, b, x, y, i, c, z, t

	;picture from BasicallyPure: http://www.purebasic.fr/english/viewtopic.php?f=12&t=64524
	CreateImage(0, 630, 375, 32, 0)
	If StartDrawing(ImageOutput(0))
		DrawingMode(#PB_2DDrawing_AlphaBlend)

		For y = 0 To OutputHeight() - 1
			For x = 0 To OutputWidth() - 1
				c = (x * y) | % 01010101
				z = (x + y) | z
				Plot(x, y, c ! z + (c | z) << 8 + (c | z) << 16 + C << 27 )
			Next
		Next
		StopDrawing()
	EndIf

	OpenWindow(0, 0, 0, 640, 510, "Terminal ©HeX0R 2016", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_SizeGadget)
	TERM::CreateTerminalGadget(0, 5, 5, 630, 490)

	BindEvent(#PB_Event_SizeWindow, @SizeMyWindow(), 0)

	SetActiveGadget(0)
	TERM::SetBackgroundImage(0, 0, TERM::#IMAGE_FLAG_STRETCHED_PROPORTIONAL)
	TERM::SetTerminalColors(0, $00FFFF, 0) ;<- background color doesn't care, when we have a background image


	TERM::PrintTextN(0, "Hi Fans!!")
	TERM::SetTerminalCharStyle(0, TERM::#CHAR_FLAG_BOLD)
	For i = 1 To 10
		TERM::PrintTextN(0, "This is line number [" + RSet(Str(i), 2, "0") + "] in bold")
	Next i
	TERM::SetTerminalCharStyle(0, TERM::#CHAR_FLAG_UNDERLINED)
	For i = 11 To 20
		TERM::PrintTextN(0, "This is line number [" + RSet(Str(i), 2, "0") + "] underlined")
	Next i
	TERM::SetTerminalCharStyle(0, 0)
	For i = 21 To 30
		TERM::PrintTextN(0, "This is line number [" + RSet(Str(i), 2, "0") + "] in default style")
	Next i
	TERM::GetTerminalCursorPos(0, @x, @y)
	TERM::SetTerminalFont(0, "Consolas", 12) ;<-- now we change the whole font size (usually we do this at the beginning)

	Repeat
		Select WaitWindowEvent()
			Case #PB_Event_CloseWindow
				Break
			Case #PB_Event_Gadget
				Select EventGadget()
					Case 0
						Select EventType()
							Case #PB_EventType_Input
								a = GetGadgetAttribute(0, #PB_Canvas_Input)
								TERM::PrintText(0, Chr(a))
								x + 1
								If x >= 80
									x = 79
								EndIf
							Case #PB_EventType_KeyDown
								Select GetGadgetAttribute(0, #PB_Canvas_Key)
									Case #PB_Shortcut_Return
										x = 0
										y + 1
										TERM::LocateCursor(0, x, y)
									Case #PB_Shortcut_Left
										x - 1
										If x < 0
											x = 0
										EndIf
										TERM::LocateCursor(0, x, y)
									Case #PB_Shortcut_Right
										x + 1
										If x >= 80
											x = 79
										EndIf
										TERM::LocateCursor(0, x, y)
									Case #PB_Shortcut_Up
										y - 1
										If y < 0
											y = 0
										EndIf
										TERM::LocateCursor(0, x, y)
									Case #PB_Shortcut_Down
										y + 1
										TERM::LocateCursor(0, x, y)
									Case #PB_Shortcut_Back;8
										TERM::PrintText(0, " ")
										x - 1
										If x < 0
											x = 0
										EndIf
										TERM::LocateCursor(0, x, y)
										TERM::PrintText(0, " ")
										TERM::LocateCursor(0, x, y)
									Case #PB_Shortcut_Delete
										TERM::PrintText(0, " ")
										TERM::LocateCursor(0, x, y)
								EndSelect
						EndSelect
					EndSelect
			EndSelect
		ForEver
	EndProcedure

	main()

	TERM::FreeTerminalGadget(0)

CompilerEndIf
infratec
Always Here
Always Here
Posts: 6810
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Re: Module: TerminalGadget

Post by infratec »

Hi , hi,

long time ago, one of my first PB programs, was a telnet terminal emulation for a linux console.
Tomorow I'll have a look if it still works in PB 5.41.
But it was without mouse stuff.
Only the escape sequences were emulated.

Bernd
TassyJim
Enthusiast
Enthusiast
Posts: 149
Joined: Sun Jun 16, 2013 6:27 am
Location: Tasmania (Australia)

Re: Module: TerminalGadget

Post by TassyJim »

This looks to be exactly what I needed.
I was working on converting IDLE's TextEditGadgetEx but making slow progress.

Wrong side of the world to buy you a beer but we might find a way someday.

Thank you.

Jim
davido
Addict
Addict
Posts: 1890
Joined: Fri Nov 09, 2012 11:04 pm
Location: Uttoxeter, UK

Re: Module: TerminalGadget

Post by davido »

@HeX0R,
Works on MacOSX, with one minor imperfection: The window is a little to big leaving a black/blank space at the bottom. This is easily cured by manually re-sizing the window.

Very impressive, thank you for sharing. :D
DE AA EB
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: Module: TerminalGadget

Post by Kwai chang caine »

Works nice here :D
Thanks for sharing 8)
ImageThe happiness is a road...
Not a destination
Post Reply