It is currently Tue Oct 23, 2018 9:32 am

All times are UTC + 1 hour




Post new topic Reply to topic  [ 4 posts ] 
Author Message
 Post subject: Module: TerminalGadget
PostPosted: Mon Jan 11, 2016 10:37 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Mon Sep 20, 2004 7:12 am
Posts: 477
Location: Hell
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:
;*******************************************
;*
;*   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

_________________
Link dead?
Change h3x0r.ath.cx into hex0rs.coderbu.de and all will be fine.


Top
 Profile  
Reply with quote  
 Post subject: Re: Module: TerminalGadget
PostPosted: Mon Jan 11, 2016 11:05 pm 
Offline
Addict
Addict

Joined: Sun Sep 07, 2008 12:45 pm
Posts: 3979
Location: Germany
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


Top
 Profile  
Reply with quote  
 Post subject: Re: Module: TerminalGadget
PostPosted: Mon Jan 11, 2016 11:09 pm 
Offline
User
User

Joined: Sun Jun 16, 2013 6:27 am
Posts: 77
Location: Tasmania (Australia)
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


Top
 Profile  
Reply with quote  
 Post subject: Re: Module: TerminalGadget
PostPosted: Tue Jan 12, 2016 10:10 pm 
Offline
Addict
Addict

Joined: Fri Nov 09, 2012 11:04 pm
Posts: 1592
Location: Uttoxeter, UK
@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


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 4 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 4 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye