PureBasic Forums - English

Posted: **Tue Feb 15, 2011 4:30 am**

Code updated for 5.20+

Here's a procedure that is to be used for output text to a console. It allows a foreground/background colors to be specified that the entire string will be displayed with. It provides automatic text wrap, breaking the line displayed at spaces or at the full width of the console when no spaces are present. Manual line-breaks can be obtained by adding carriage returns (i.e. Chr(13) or #CR$) to the text to display. If there are no manual line-breaks the text will wrap as described above.

I designed it for the graphical console mode but if the #ConsoleWidth is set to 79 it will work fine for a non-graphical console.

Code: Select all

;File Mame : graphicalConsoleWrap.pb
;Date: 02-14-2011
;Last Update:  02-16-2011
;Author: Demivec (Jared Johnson)
;Coded for PureBasic V4.51
;Description: Allows specifications of colors with the string to display on console.
;  When the graphical console is used, allows string wrap at spaces or at #ConsoleWidth if no spaces present.
;  Can be used for wrap with a non-graphical console if #ConsoleWidth is <= 79
;  To cause a carriage return (instead of wrapping) the string needs to have #CR$ or chr(13) added to it.

EnableGraphicalConsole(#True)
Global isConsoleAvailable = OpenConsole()
Enumeration ;console colors
  #con_Black
  #con_Blue
  #con_Green
  #con_Cyan
  #con_Red
  #con_Magenta
  #con_Brown
  #con_Light_Grey
  #con_Dark_Grey
  #con_Bright_Blue
  #con_Bright_Green
  #con_Bright_Cyan
  #con_Bright_Red
  #con_Bright_Magenta
  #con_Yellow
  #con_White
EndEnumeration
#ConsoleWidth = 80 ;character width of console

Procedure display(text.s, textColor = #con_White, backColor = #con_Black)
  Static lastPrintPos = 0
  If isConsoleAvailable
    Protected lineCount, curLine = 1, lineText.s, maxWidth, wrapPos, outputText.s
    ConsoleColor(textColor, backColor)
    
    lineCount = CountString(text, #CR$)
    Repeat
      lineText = StringField(text, curLine, #CR$)
      While (lastPrintPos + Len(lineText)) >  #ConsoleWidth
        maxWidth = #ConsoleWidth - lastPrintPos
        wrapPos = maxWidth - FindString(ReverseString(Left(lineText, maxWidth)), " ", 1) ;wrap at space
        outputText = Left(lineText, wrapPos)
        If wrapPos <> maxWidth
          ;find last of a group of spaces
          Repeat
            wrapPos + 1
          Until Mid(lineText, wrapPos + 1, 1) <> " "
        ElseIf maxWidth <> #ConsoleWidth And FindString(lineText, " ", 1) <= #ConsoleWidth
          wrapPos = 0
          outputText = ""
        EndIf 
        
        PrintN(outputText)
        lineText = Mid(lineText, wrapPos + 1)
        lastPrintPos = 0
      Wend 
      
      If lineCount > 0
        PrintN(lineText)
        lastPrintPos = 0
      Else
        Print(lineText)
        lastPrintPos + Len(lineText)
      EndIf 
      lineCount - 1: curLine + 1
    Until lineCount < 0
  EndIf 
  ProcedureReturn lastPrintPos
EndProcedure

Procedure displayN(text.s, textColor = #con_Light_Grey, backColor = #con_Black)
  ProcedureReturn display(text + #CR$, textColor, backColor)
EndProcedure


PrintN("01234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789")
display("A simple string without a CR.", #con_Bright_Green)
displayN("A short string but with a CR.", #con_Bright_Cyan)
displayN("A long text with many short words for the wrap test that is longer than the console width and has a CR.", #con_Cyan, #con_White)
display("A long text with many short words for the wrap test that is longer than the console width and not a CR.", #con_Bright_Red)
display("A long text with many short words for the wrap test that is longer than the console width and not a CR.", #con_Magenta, #con_White)
display("A long text with many short words for the wrap test that is longer than the console width and not a CR.", #con_Bright_Magenta)
display("A_long_string_of_text_that_has_just_a_single space_for_testing_the_word_wrap_when_adding_text_to_a_line(no_CR).", #con_Black, #con_White)
displayN("Another_string_of_characters_that_is_longer_than_the_width_of_the_console_before_its_only_space_appears_near_its end(and_a_CR).")

displayN("A string of characters, each from a separate procedure call(shown by the different colors) and to show wrapping occurring at the edge of the console:")
Define i
For i = 0 To #ConsoleWidth + 3
  display(Left(Str(i), 1), (i % 5) + 10, 9)
Next

display(#CR$ + "CR_followed_by_a_single_group_consisting_of_twenty_spaces_to_test_wrap              followed_by_text_with_no_CR.", #con_Yellow)

Input()

Feel free to use, abuse, or modify the code as needed. But what's to worry, no buddy uses consoles anymore right?

@Edit: make a small correction by adding a single line of code. and included the additional wrapper function.

Posted: **Tue Feb 15, 2011 12:35 pm**

Cool ..thanks to sharing

Posted: **Wed Feb 16, 2011 2:43 am**

Here's a simple addition to the above code to cause a line break at the end, instead of manually adding #CR$:

Code: Select all

Procedure displayN(text.s, textColor = #con_Light_Grey, backColor = #con_Black)
  ProcedureReturn display(text + #CR$, textColor, backColor)
EndProcedure

Made changes to code in first post to include it and a one line error correction.

PureBasic Forums - English

Console text with colors and word wrap (at spaces).

Console text with colors and word wrap (at spaces).

Re: Console text with colors and word wrap (at spaces).

Re: Console text with colors and word wrap (at spaces).