New Library - ConsoleX

[DoubleDutch]

I've uploaded a new zip, nothing changed - just different size... (!!)

[SFSxOI]

Got it. Thanks for a great library DoubleDutch

I've uploaded a new zip, nothing changed - just different size... (!!)

[flaith]

Am i the only one to have pb (see my previous post)

[DoubleDutch]

Am i the only one to have pb (see my previous post)

I don't understand.

I've checked out the example you mentioned, your right - it doesn't work now. I think its because of the way arguments are now processed in TailBite.

Before you could have arguments of different types, if the number of arguments was different. Looks like this is now not the case?? Maybe its PureBasic that changed?

Can anyone shed any light on this?

If all else fails I'll change the syntax to work with the new tailbite/purebasic - but I did like the old ability to have different types dependent on # of arguments.

btw. Is anyone else having problems that the forum is not notifying you if someone has replied to a post. I get notifications to other posts I replied to, but not to some posts like this one... (I have to keep checking it)

[quickie]

Hi,

I'm interested in your lib, but I can't seem to DL it anymore.
Any chance of acquiring it now?

Thanks.

[DoubleDutch]

It should be at:

http://www.sinistersoft.com/downloads/ConsoleX.zip

It's still in beta for V4, unfortunately V3.xx not supported anymore (I don't have it installed on my machine!)

Sorry for the address changes from ddd, the reason for all the URL changes is because DoubleDutchDesigns is now split into 4 seperate companies, needing 4 seperate domains. All my PureBasic stuff will soon be (or linked to) on SinisterSoft.com (or on ApplePanic.com with regard to ReportBuilder).

-Anthony

[quickie]

Hi and thanks DoubleDutch.

Oh, no problem about the url changes

I've tried the lib and noticed that I couldn't run the program with EnableExplicit on. Is this normal?

Also, the text seemed really garbled in the examples. Could this be because my Win OS is in Japanese?

Otherwise, seems to work great

Thanks!

[DoubleDutch]

Also, the text seemed really garbled in the examples. Could this be because my Win OS is in Japanese?

Possibly. Its not unicode compatible (yet).

I've tried the lib and noticed that I couldn't run the program with EnableExplicit on. Is this normal?

I'll take a look at that over the weekend.

[quickie]

Oh, I see.

Yeah, lots of changes seem to have been made in version 4.

Thanks!

[DoubleDutch]

Made some directory changes, its now at:
http://sinistersoft.com/download/consolex.zip

[Manfred]

Thanks for the great library. I tested v1.06 at the old version of purebasic, but it's not working on 4.x (4.40) and download links don't work) If you have 2.x version of lib, please reupload this anywhere.

[DoubleDutch]

Will look at making a new version in the next few days for you.

[Rook Zimbabwe]

I should like to play with it as well!

[DoubleDutch]

What I'll do is I'll put the (pretty untidy) source here in the public domain:

Code: Select all

#MyBlack=0
#MyBlue=1
#MyGreen=2
#MyCyan=3
#MyRed=4
#MyMagenta=5
#MyBrown=6
#MyLGrey=7
#MyGrey=8
#MyLBlue=9
#MyLGreen=10
#MyLCyan=11
#MyLRed=12
#MyLMagenta=13
#MyYellow=14
#MyWhite=15
Global FullScreen,FontH,FontW,RealFontH,FColour,BColour,mywindow,myfont,mysprite1,mysprite2,CursorX,CursorY,Intensity,CX,CY,DisplayChanged,Drawing,Flags
Global InitDB

Procedure GetColour(colour)

  Select (colour & $f)
    Case #MyBlack
      rgb=RGB(0,0,0)
    Case #MyBlue
      rgb=RGB(0,0,180)
    Case #MyGreen
      rgb=RGB(0,180,0)
    Case #MyCyan
      rgb=RGB(0,180,180)
    Case #MyRed
      rgb=RGB(0,0,180)
    Case #MyMagenta
      rgb=RGB(180,0,180)
    Case #MyBrown
      rgb=RGB(180,180,0)
    Case #MyLGrey
      rgb=RGB(120,120,120)
    Case #MyGrey
      rgb=RGB(64,64,64)
    Case #MyLBlue
      rgb=RGB(64,64,255)
    Case #MyLGreen
      rgb=RGB(64,255,64)
    Case #MyLCyan
      rgb=RGB(64,255,255)
    Case #MyLRed
      rgb=RGB(255,64,64)
    Case #MyLMagenta
      rgb=RGB(255,64,255)
    Case #MyYellow
      rgb=RGB(255,255,64)
    Case #MyWhite
      rgb=RGB(255,255,255)
  EndSelect
  ProcedureReturn rgb
EndProcedure

Procedure GetTextHeight(hdc) 
  tm.textmetric 
  PrevMapMode=SetMapMode_(hdc,#MM_TEXT) 
  GetTextMetrics_(hdc,tm) 
  If PrevMapMode 
    SetMapMode_(hdc,PrevMapMode) 
  EndIf 
  ProcedureReturn tm\tmHeight 
EndProcedure 

Procedure XGlobalCloseConsole()


  If mywindow
    CloseWindow(mywindow)
    mywindow=0
  EndIf
  If mysprite1
    FreeSprite(mysprite1)
    mysprite1=0
  EndIf
  If mysprite2
    FreeSprite(mysprite2)
    mysprite2=0
  EndIf
  CloseScreen()
  If myfont
    FreeFont(myfont)
    myfont=0
  EndIf
EndProcedure

Procedure CheckUpdateDisplay()
  If DisplayChanged
    Drawing=#True
    DisplaySprite(mysprite1,0,0)
    DisplayTranslucentSprite(mysprite2,CursorX,CursorY,Intensity)
    FlipBuffers()
    DisplayChanged=#False
    Drawing=#False
  EndIf
EndProcedure

Procedure MyWindowCallback(WindowID,Message,wParam,lParam) 
  Result=#PB_ProcessPureBasicEvents 
  If (Message=#WM_MOVE) Or (Message=#WM_SIZE) Or (Message=#WM_PAINT)
    DisplayChanged=#True
  EndIf 
  If Message=#WM_ERASEBKGND
    Result=-1
  EndIf
  If DisplayChanged And Drawing=#False
    DisplaySprite(mysprite1,0,0)
    DisplayTranslucentSprite(mysprite2,CursorX,CursorY,Intensity)
    FlipBuffers()
    DisplayChanged=#False
  EndIf
  ProcedureReturn Result 
EndProcedure 

Procedure XGlobalOpenConsole(OpenX,OpenY,OpenW,OpenH,Name$)
  XGlobalCloseConsole()
  result=0
  myfont=LoadFont(#PB_Any,"Terminal",FontH,#PB_Font_HighQuality)
  If myfont
    If InitSprite()
      mywindow=OpenWindow(#PB_Any,OpenX,OpenY,OpenW,OpenH,Name$,Flags)
      If mywindow
        If OpenWindowedScreen(WindowID(mywindow),0,0,40,40,#True,0,0)
          hdc=StartDrawing(WindowOutput(mywindow))
          DrawingFont(FontID(myfont))
          FontW=TextWidth(" ")
          RealFontH=TextHeight(" ")
          StopDrawing()
          CloseScreen()
        Else
          FontW=8
          RealFontH=8
        EndIf
        SizeX=(CX*FontW)+(FontW/2)
        SizeY=(CY*RealFontH)+(RealFontH/2)
        If OpenWindowedScreen(WindowID(mywindow),0,0,SizeX,SizeY,#True,0,0)
          mysprite1=CreateSprite(#PB_Any,SizeX,SizeY,#PB_Sprite_Texture)  ; screen sprite
          If mysprite1  
            mysprite2=CreateSprite(#PB_Any,FontW,RealFontH,#PB_Sprite_Texture)  ; cursor sprite
            If mysprite2
              StartDrawing(SpriteOutput(mysprite2))
              Box(0,0,FontW,RealFontH,RGB(255,255,255))
              StopDrawing()
              Drawing=#False
              SetWindowCallback(@MyWindowCallback(),mywindow)
              result=mywindow  ; all has passed test!
              FullScreen=#False
            EndIf
          EndIf
        EndIf
      EndIf
    EndIf  
  EndIf
  If result=0
    XGlobalCloseConsole()
  EndIf
  ProcedureReturn result
EndProcedure

Procedure XFullOpenConsole(OpenX,OpenY,OpenD,FontN$,FontD,Name$)
  XGlobalCloseConsole()
  result=0
  myfont=LoadFont(#PB_Any,FontN$,FontD)
  If myfont
    If InitSprite()
      If InitKeyboard()
        If OpenScreen(OpenX,OpenY,OpenD,Name$)
          hdc=StartDrawing(ScreenOutput())
          DrawingFont(FontID(myfont))
          FontW=TextWidth(" ")
          RealFontH=GetTextHeight(hdc)
          StopDrawing()
          CX=OpenX/FontW
          CY=OpenY/RealFontH
          SizeX=(CX*FontW)+(FontW/2)
          SizeY=(CY*RealFontH)+(RealFontH/2)
          mysprite1=CreateSprite(#PB_Any,SizeX,SizeY,#PB_Sprite_Texture)  ; screen sprite
          If mysprite1  
            mysprite2=CreateSprite(#PB_Any,FontW,RealFontH,#PB_Sprite_Texture)  ; cursor sprite
            If mysprite2
              StartDrawing(SpriteOutput(mysprite2))
              Box(0,0,FontW,RealFontH,RGB(255,255,255))
              StopDrawing()
              Drawing=#False
              result=#True  ; all has passed test!
              FullScreen=#True
            EndIf
          EndIf
        EndIf
      EndIf
    EndIf  
  EndIf
  If result=0
    XGlobalCloseConsole()
  EndIf
  ProcedureReturn result
EndProcedure

Procedure XGlobalPrint(string$)
  If myfont
    Drawing=#True
    StartDrawing(SpriteOutput(mysprite1))
    BackColor(RGB(BColour,BColour,BColour))
    FrontColor(RGB(FColour,FColour,FColour))
    DrawingFont(FontID(myfont))
    DrawText(CursorX,CursorY,string$)
    StopDrawing()
    Drawing=#False
    CursorX+(Len(string$)*FontW)
    DisplayChanged=#True
  EndIf
EndProcedure

Procedure XGlobalConsoleColor(colour1,colour2)
  BColour=GetColour(colour2)
  FColour=GetColour(colour1)
EndProcedure

Procedure XGlobalClearConsole()
  If myfont
    Drawing=#True
    StartDrawing(SpriteOutput(mysprite1))
    Box(0,0,(CX+1)*FontW,(CX+1)*RealFontH,BColour)
    StopDrawing()
    Drawing=#False
    CursorX=0
    CursorY=0    
    DisplayChanged=#True
  EndIf
EndProcedure

Procedure.s XGlobalInkey()
  CheckUpdateDisplay()
  Ascii$=""
  Ascii2$=""
  Delay(1) ; use a 1 millisecond delay, because not using WaitWindowEvent()!!!
  If FullScreen
    ExamineKeyboard()
    Ascii$=KeyboardInkey()
    If Ascii$=""
      If KeyboardReleased(#PB_Key_Back)
        Ascii$=Chr(#BS)
      EndIf  
      If KeyboardReleased(#PB_Key_Return)
        Ascii$=Chr(#CR)
      EndIf     
      If KeyboardReleased(#PB_Key_PadEnter)
        Ascii$=Chr(#CR)
      EndIf     
    EndIf
  Else
    EventID=WindowEvent()
    Select EventID
      Case #WM_KEYDOWN
        Ascii2$=Chr(EventwParam()-53)  ; convert function keys to the same as that produced by inkey function
      Case #WM_CHAR
        Ascii$=Chr(EventwParam()) ; hack to get windows key
      Case #PB_Event_CloseWindow
        End
    EndSelect
  EndIf
  If Ascii$=""
    If Ascii2$<>""
      Ascii$=Chr($ff)+Ascii2$
    EndIf
  Else
    Ascii$=Ascii$+Chr($ff)
  EndIf
  ProcedureReturn Ascii$
EndProcedure

ProcedureDLL XClearConsole()
  XGlobalClearConsole()
EndProcedure

ProcedureDLL XOpenConsole()
  Flags=#PB_Window_TitleBar|#PB_Window_SystemMenu|#PB_Window_BorderLess|#PB_Window_SizeGadget|#PB_Window_MaximizeGadget|#PB_Window_MinimizeGadget
  CX=80
  CY=25
  FontH=24
  Intensity=128
  result=XGlobalOpenConsole(50,50,640,480,"ConsoleX")
  XGlobalConsoleColor(#MyWhite,#MyBlack)
  XGlobalClearConsole()
  ProcedureReturn result
EndProcedure

ProcedureDLL XOpenConsole2(sizex,sizey)
  Flags=#PB_Window_TitleBar|#PB_Window_SystemMenu|#PB_Window_BorderLess|#PB_Window_SizeGadget|#PB_Window_MaximizeGadget|#PB_Window_MinimizeGadget
  CX=sizex
  CY=sizey
  FontH=24
  Intensity=128
  result=XGlobalOpenConsole(50,50,640,480,"ConsoleX")
  XGlobalConsoleColor(#MyWhite,#MyBlack)
  XGlobalClearConsole()
  ProcedureReturn result
EndProcedure

ProcedureDLL XOpenConsole3(sizex,sizey,sized,fontname$,fontsize,title$)
  Itensity=128
  result=XFullOpenConsole(sizex,sizey,sized,fontname$,fontsize,title$)
  XGlobalConsoleColor(#MyWhite,#MyBlack)
  XGlobalClearConsole()
  ProcedureReturn result
EndProcedure
  
ProcedureDLL XOpenConsole4(sizex,sizey,x,y,w,h,title$)
  Flags=#PB_Window_TitleBar|#PB_Window_SystemMenu|#PB_Window_BorderLess|#PB_Window_SizeGadget|#PB_Window_MaximizeGadget|#PB_Window_MinimizeGadget
  CX=sizex
  CY=sizey
  FontH=24
  Intensity=128
  result=XGlobalOpenConsole(x,y,w,h,title$)
  XGlobalConsoleColor(#MyWhite,#MyBlack)
  XGlobalClearConsole()
  ProcedureReturn result
EndProcedure

ProcedureDLL XOpenConsole5(sizex,sizey,x,y,w,h,title$,Flgs)
  Flags=Flgs
  CX=sizex
  CY=sizey
  FontH=24
  Intensity=128
  result=XGlobalOpenConsole(x,y,w,h,title$)
  XGlobalConsoleColor(#MyWhite,#MyBlack)
  XGlobalClearConsole()
  ProcedureReturn result
EndProcedure

ProcedureDLL XCloseConsole()
  XGlobalCloseConsole()
EndProcedure

ProcedureDLL XConsoleColor(fgnd,bgnd)
  XGlobalConsoleColor(fgnd,bgnd)
EndProcedure

ProcedureDLL XPrint(string$)
  XGlobalPrint(string$)
EndProcedure

ProcedureDLL XPrintN(string$)
  XGlobalPrint(string$)
  CursorX=0
  CursorY+RealFontH
EndProcedure

ProcedureDLL XConsoleLocate(x,y)
  CursorX=x*FontW
  CursorY=y*RealFontH
  DisplayChanged=#True
EndProcedure

ProcedureDLL XConsoleTitle(string$)
  If mywindow ; keep as mywindow for the time being
    SetWindowTitle(mywindow,string$)
  EndIf
EndProcedure

ProcedureDLL.s XInkey()
  Ascii$=XGlobalInkey()
  ProcedureReturn Ascii$
EndProcedure

ProcedureDLL.s XInput()
  string$=""
  Done=#False
  Repeat
    Ascii$=XGlobalInkey()
    If Ascii$>""
      Ascii$=Left(Ascii$,1)
      If Ascii$<>Chr($ff)
        Select Ascii$
          Case  Chr(#CR)
            Done=#True
          Case  Chr(#BS)
            If string$<>""
              string2$=Left(string$,Len(string$)-1)
              string$=string2$
              CursorX-FontW
              XGlobalPrint(" ")
              CursorX-FontW
            EndIf
          Default
            XGlobalPrint(Ascii$)
            string$+Ascii$
        EndSelect
      EndIf
    EndIf
  Until Done
  ProcedureReturn string$
EndProcedure

ProcedureDLL XConsoleCursor(size)
EndProcedure

ProcedureDLL XDelay(time)
  CheckUpdateDisplay()
  If time<2
    time=2
  EndIf
  For n=1 To time/2
    Delay(1) ; use a 1 millisecond delay, because not using WaitWindowEvent()!!!
    If FullScreen=0
      EventID=WindowEvent()
      Select EventID
        Case #PB_Event_CloseWindow
        End
      EndSelect
    EndIf
  Next
EndProcedure

ProcedureDLL XGetConsoleCX()
  ProcedureReturn CX
EndProcedure

ProcedureDLL XGetConsoleCY()
  ProcedureReturn CY
EndProcedure

ProcedureDLL XSetConsoleColorF(colour)
  FColour=colour
EndProcedure

ProcedureDLL XSetConsoleColorB(colour)
  BColour=colour
EndProcedure

I've renamed the procedures X.... rather than ....X, this way it will co-exist with ithe other lib if needed. The source (as previously mentioned) is pretty untidy and hasn't changed at all (except to get it working with 4.41) since it's first revision years ago! That's why the tailbite stuff may be out of date, but it seems to work as an include.

Please try not to laugh at the code, it was the first thing I wrote (released it June, 2004) with PureBasic and hasn't needed updating/rewriting until now!

Anyone want to update it and repost updated code here is welcome. If you use it in anything and have a credit screen then please mention me and/or Computing Data Limited. The demos in the original zip should work - you just need to swap over the X.

It could possibly work better now with Macros, completely replacing the original PureBasic commands?

Here is a demo:

Code: Select all

; ConsoleX test

; This example is a modified version of the example given with purebasic

IncludeFile "XConsole.pbi"
;
text$="Feel the Power of PureBasic!"	; just a small text$ string
dlay=4000															; delay will set to 4000

;
;-------- Open our Console --------
;

XOpenConsole()																; First we must open a console
XConsoleTitle("PureBasic - Console Example:")	; Now we can give the opened console a Titlename ;)

;                                                                                                   
;-------- Ask and display the UserName --------
;

XConsoleLocate(18,12)								; x y position 

XPrint("Please enter your name:")		; Ask for name
name$=XInput()											; Wait for user input

XClearConsole()											; This will clean the ConsoleScreen

XConsoleLocate(24,10)								; x y position 
XPrintN("Welcome "+name$)						; Print our text and the UserName
XConsoleLocate (24,12)							; x y position
XPrintN (text$) 										; Print our text

XDelay(dlay)												; Waits for moment

;
;-------- Cls and Cycle the Text-BG-Color 0 to 15 --------
;                                                  

XClearConsole()											; This will clean the ConsoleScreen

; Info: Standard colors are (8 for text, 0 for backround)
For i = 0 To 15
XConsoleColor(0,i)									; Change BackGround text color (max 15) in every loop         
XConsoleLocate(24,4+i)							; x y position 
XPrint(text$)												; Print our text
Next i
XDelay(dlay)												; Waits for moment

;
;-------- Cls and Cycle the Text-FG-Color 0 to 15 --------
;

XConsoleColor(0,0)									; Set back to black (0,0) for complete background...
XClearConsole()											; This will clean the ConsoleScreen
; Info: Standard colors are (8 for text, 0 for backround)
For i = 0 To 15
XConsoleColor(i,0)									; Change ForGround text color (max 15) in every loop         
XConsoleLocate(24,4+i)							; x y position 
XPrint(text$)												; Print our text
Next i

XDelay(dlay) 												; Waits for moment

;
;-------- Cls and Cycle the Background-Color 0 to 15 --------
;

For a = 1 To 15
XConsoleColor(a,a)									; Cycle background color...
XClearConsole()											; This will clean the ConsoleScreen

; Info: Standard colors are (8 for text, 0 for backround)
For i = 0 To 15
XConsoleColor(i,a)									; Change ForGround text color (max 15) in every loop         
XConsoleLocate(24,4+i)							; x y position 
XPrint(text$)												; Print our text
Next i
;
XDelay(dlay/10)											; Waits for moment
Next a    

;-------- Exit --------

XCloseConsole()

[AAT]

PB4.41
XConsole.pbi -> Procedure XGlobalCloseConsole() -> CloseScreen()
Is this unnecessary?

Code: Select all

Procedure XGlobalCloseConsole()
  If mywindow
    CloseWindow(mywindow)
    mywindow=0
  EndIf
  If mysprite1
    FreeSprite(mysprite1)
    mysprite1=0
  EndIf
  If mysprite2
    FreeSprite(mysprite2)
    mysprite2=0
  EndIf

;Is this unnecessary?
;-------------------->  CloseScreen()

  If myfont
    FreeFont(myfont)
    myfont=0
  EndIf
EndProcedure