conLib makes a comeback

User projects written in or related to FreeBASIC.
cha0s
Site Admin
Posts: 5317
Joined: May 27, 2005 6:42
Location: Illinois
Contact:

conLib makes a comeback

Postby cha0s » Dec 22, 2006 11:49

Here's my little library for fast console text operations. BASIC compatibility is of the utmost importance. If you find ANY mistakes, or have any requests, please post them.

This should work on Windows, Linux, and DOS. I have tested it only on Windows. If you have an OS besides Windows and find any troubles, let me know ASAP.

You'll need CVS to compile and/or use this.

conlib.bi: the header

Code: Select all

namespace chi

   #libpath __path__
   #inclib "conlib"

   type console
   
      declare constructor( byval pages as integer = 1, byval spec as integer = -1 )
      declare destructor( )
      declare sub close( )
      
      declare property pages( byval pages as integer )
      declare property pages( ) as integer
      
      declare property activePage( byval active_ as uinteger )
      declare property activePage( ) as uinteger
      
      declare sub flip( )
      declare sub cls( byval toColor as integer = -1 )
      declare sub print( byref printing as string, byval as integer = -1 )
      declare function color( byval fg as integer = -1, byval bg as integer = -1 ) as integer
      declare sub locate( byval y as integer, byval x as integer = 0 )

      private:
      
         core as any ptr
         as integer total, active
         
   end type
   
end namespace

extern conLib as chi.Console


conlib.bas: the library

Code: Select all

'' written by cha0s Dec. 22, 2006
'' public domain because cha0s loves you

#include "crt.bi"

#define CHARCLEAR(x) x and= not &hFF

#define CHARMASK(x) (x and &hFF)
#define FCOLORMASK(x) ((x shr 8) and &hF)
#define BCOLORMASK(x) ((x shr 12) and &hF)

#define CHARSET(x,c) x and= (not &hFF): x or= (c and &hFF)
#define FCOLORSET(x,c) x and= (not (&hF shl 8)): x or= ((c and &hF) shl 8)
#define BCOLORSET(x,c) x and= (not (&hF shl 12)): x or= ((c and &hF) shl 12)

#define fLen(s) (cast( integer ptr, @s )[1])

'#undef __FB_Win32__
'#define __FB_Dos__
'#define __FB_Linux__

#IfDef __FB_Win32__
   #Include "windows.bi"
#endif
#IfDef __FB_Linux__
   #Include "curses.bi"
   private Sub curses_InitColorTable()
   
      Dim As Integer c = 0
      
      For y as integer = 0 To 15
      
         For x as integer = 0 To 7
         
            c += 1
            init_pair( c, x, y )
         
         Next
      
      Next
   
   End Sub
   
#endif
#IfDef __FB_Dos__
   #include "dos/dpmi.bi"
   #Include "dos/go32.bi"
   #Include "dos/pc.bi"
   #Include "dos/sys/farptr.bi"
#endif

namespace chi

   #macro Console_LineFeed(__LF__)                                                   
                                                                                  
      If __LF__ = 0 Then                                                           
      
         .cCursor = 0                                                         
         .rCursor += 1                                                       
         /' new row, column reset '/                                             
         
         If .rCursor = .y Then                                           
         /' move it up '/                                                       
         
            For i as integer = 0 To ( .y - 1 ) - 1                                     
            /' shuffle rows up '/                                             
               MemCpy( @.data[i * .x], @.data[(i + 1) * .x], Len( Console_Node ) * .x )
            
            Next                                                                 
            
            cell = @.data[(.y - 1) * .x]
            For i as integer = 0 To .x - 1
               
               FCOLORSET(*cell, .fColor)
               BCOLORSET(*cell, .bColor)
               CHARCLEAR(*cell)
               cell += 1
   
            next
            
            /' scoot up! stay in bounds '/                                         
            .rCursor -= 1                                                     
            cell -= .x
         
         End If                                                                   
         
      End If                                                                 
   
   #endmacro 
   
   #macro Console_CheckColumn()
   
      If ( .x = .cCursor ) Then
      '' cursor past right side of console
      
         If i = fLen( printing ) - 1 Then
         '' if the printing ended on the edge of the console, line feed only once, not twice.
            Console_LineFeed( iif( (.rCursor < (.y-1)), 0, op ) )
            overflow = -1
         
         Else
            Console_LineFeed( 0 )
         
         End If
      
      End If
      
   #endmacro
   
    type Console_Node as uinteger
   Type Console_Core
   
     data As Console_Node Ptr
    
     bColor As Byte
     fColor As Byte
    
     rCursor As uShort
     cCursor As uShort
     visible As Integer
    
     x As Integer
     y As Integer
    
   End Type

   type console
   
      declare constructor( byval pages as integer = 1, byval spec as integer = -1 )
      declare destructor( )
      
      declare property pages( byval pages_ as integer )
      declare property pages( ) as integer
      
      declare property ActivePage( byval active_ as uinteger )
      declare property ActivePage( ) as uinteger
      
      declare sub close( )
      declare sub flip( )
      declare sub cls( byval toColor as integer = -1 )
      declare sub print( byref printing as string, byval op as integer )
      declare function color( byval fg as integer, byval bg as integer ) as integer
      declare sub locate( byval y as integer, byval x as integer )

      private:
      
         core as Console_Core ptr
         as integer total, active
         
         declare sub initEx( byval x As Integer, byval y As Integer, byref c As Console_Core )
         declare Sub freeData( byref core As Console_Core )
   
   end type
   
   Sub Console.freeData( byref core As Console_Core )
      
      deallocate( core.data )
   
   end sub

   Sub Console.initEx( byval x As Integer, byval y As Integer, byref core As Console_Core )
   
      With core

         if x = -1 then
            
            Dim As uInteger w = Width
            
            x = LoWord( w )
            y = HiWord( w )
            
         end if
         
         .data = CAllocate( y * x * Len( Console_Node ) )
         
         .y = y
         .x = x
         
         .bColor = 0
         .fColor = 7
         .visible = -1
         
         .rCursor = 0
         .cCursor = 0
      
      End With
   
   End Sub

   private constructor console( byval pages_ as integer = 1, byval spec as integer = -1 )
      
      #IfDef __FB_Linux__
      
         initscr( )
         start_color( )
         curses_InitColorTable()
      
      #EndIf
      
      If pages_ < 1 Then
      
         exit sub
      
      End If
      
      this.active = 0
      this.total = pages_
      
      dim as integer rect_x, rect_y
      If ( spec = -1 ) Then
      '' spec not set, grab from current fb settings
      
         rect_x = spec
      
      Else
      '' use the spec settings sent
      
         rect_x = LoWord( spec )
         rect_y = HiWord( spec )
      
      End If
      
      '' allocate the pages we need
      this.core = CAllocate( pages_ * Len( Console_Core ) )
      
      For i as integer = 0 To pages_ - 1
      '' iterate thru pages, initializing them
         this.initEx( rect_x, rect_y, this.core[i] )
      
      Next

   end constructor
   
   private destructor Console( )
      
      this.closE( )
      
   end destructor
   
   property Console.activePage( byval active_ as uinteger )

      if active_ < this.total then
         this.active = active_
      end if

   end property
   
   property Console.activePage( ) as uinteger

      return this.active

   end property
   
   property Console.pages( byval pages_ as integer )
   
      if this.total < pages_ then
         
         this.core = reallocate( this.core, pages_ * Len( Console_Core ) )
         
         dim as integer diff = pages_ - this.total
         dim as integer x, y
         
         if this.total > 0 then
            x = this.core[0].x
            y = this.core[0].y
         else
            x = -1
         end if
         
         for i as integer = this.total to diff
            this.initEx( x, y, this.core[i] )
         next
         
         this.total = pages_
         
      elseif this.total > pages_ then
         
          for i as integer = pages_ to this.total - 1
            this.freeData( this.core[i] )
         next

         if pages_ = 0 then
            deallocate( this.core )
         end if
         this.total = pages_

         if this.active >= this.total then this.active = 0
         
      end if
   
   end property
   
   property Console.pages( ) as integer
      return this.total
   end property
   
   sub Console.close( )
      
      if this.core = 0 then exit sub
      
      this.cls( 0 )
      this.flip( )
      
      for i as integer = 0 to this.total - 1
         freeData( this.core[i] )
      next
      deallocate( this.core )
      this.core = 0
      
   end sub
   
   function Console.color( byval fg as integer, byval bg as integer ) as integer
      
      if this.core = 0 then return -1
      
      with this.core[this.active]
      
         if (fg and bg) = -1 then return .fColor
         
         if (fg > -1) and (fg < 16) then
            .fColor = fg
         end if
         
         if (bg > -1) and (bg < 16) then
            .bColor = bg          
         end if
         
      end with
   
   end function

   sub Console.locate( byval y as integer, byval x as integer )
      
      if this.core = 0 then exit sub
      
      with this.core[this.active]
           
         if (y > 0) and (y <= .y) then
            .rCursor = y - 1
            if (x > 0) and (x <= .x) then
               .cCursor = x - 1
            else
               .cCursor = 1
            end if
         end if
         
      end with
   
   end sub

   sub Console.print( byref printing as string, byval op as integer )
      
       if this.core = 0 then exit sub
      
       if fLen( printing ) < 1 then exit sub
      
       dim as integer overflow = 0
      
       with this.core[this.active]
           
            dim as integer ptr cell = varptr( .data[(.rCursor * .x) + .cCursor] )
         for i as integer = 0 to fLen( printing ) - 1
            
            Console_CheckColumn( )
            
            CHARSET(*cell, printing[i])
            FCOLORSET(*cell, .fColor)
            BCOLORSET(*cell, .bColor)
            
            .cCursor += 1
            cell += 1
            
            Console_CheckColumn( )
            
         next

         If overflow = 0 Then
         '' not at the right edge of the console
            Console_LineFeed( op )
         
         End If
         
      end with
   
   
   end sub

   sub Console.cls( byval toColor as integer )
      
       if this.core = 0 then exit sub
      
      Dim As Integer x, y, clearColor
      
      With this.core[this.active]
      
         clearColor = .bColor
         
         If ( toColor > -1 ) And ( toColor < 16 ) Then
            clearColor = toColor
         
         End If
         
         for i as integer = 0 to (.x * .y) -1
            
            BCOLORSET(.data[i], clearColor)
            FCOLORSET(.data[i], .fColor)
            CHARCLEAR(.data[i])
         
         next
         
         .cCursor = 0
         .rCursor = 0
      
      End With
     
   end sub

   #IfDef __FB_Win32__
   
      Sub Console.flip( )
         
          if this.core = 0 then exit sub
         
         Dim As COORD con_Area, con_UpLeft
         Dim As SMALL_RECT con_Destination
         
         Dim As Integer y, x
         
         with this.core[this.active]
               
            Dim As CHAR_INFO con_BlitBuffer( 0 to (.y * .x) - 1 )
            
            for i as integer = 0 to (.y * .x) - 1
               con_BlitBuffer(i).char.AsciiChar = CHARMASK(.data[i])
               con_BlitBuffer(i).attributes = ( BCOLORMASK(.data[i]) Shl 4 ) Or FCOLORMASK(.data[i])
            next
            
            con_Area.x = .x
            con_Area.y = .y
            
            con_Destination.top    = 0
            con_Destination.Left   = 0
            con_Destination.bottom = .y - 1
            con_Destination.Right  = .x - 1
         
         end with
         
         con_UpLeft.x = 0
         con_UpLeft.y = 0
         
         WriteConsoleOutput( GetStdHandle( STD_OUTPUT_HANDLE ), _
                                Varptr( con_BlitBuffer( 0 ) ),     _
                                con_Area,                          _
                                con_UpLeft,                        _
                                Varptr( con_Destination ) )
         
      End Sub
   
   
   #EndIf

   #IfDef __FB_Linux__

      Sub Console.flip( )
      
         if this.core = 0 then exit sub
      
         Dim As Integer y, x
         
         With this.core[this.active]
         
            Dim As chType charBlit
            
            move( 0, 0 )
            
            for i as integer = 0 to (.x * .y) - 1

               charBlit = IIf( CHARMASK(.data[i]) = 0, _
                                    32    Or color_pair( ( BCOLORMASK(.data[i]) Shl 3 ) + 1 ), _
                                    CHARMASK(.data[i]) Or color_pair( ( BCOLORMASK(.data[i]) Shl 3 ) + 1 + ( FCOLORMASK(.data[i]) And &b0111 ) ) Or IIf( FCOLORMASK(.data[i]) And &b1000, a_bold, 0 ) _
                                    )
                                   
                    addch( charBlit )
                                                
            next
         
         End With
         
         refresh( ) '' curses ...
      
      End Sub
      
      private sub cleanupCurses( )
         endwin( )
      end sub
   
   #EndIf


   #IfDef __FB_Dos__
   
      '' DOS Blitter routine written by DrV a.k.a Daniel Verkamp
      '' DrV's e-mail address is daniel[AT]drv[DOT]nu
      
      Sub Console.flip( )
         
          if this.core = 0 then exit sub
         
         Dim As Integer scr
         
         scr = ScreenPrimary
         
         _farsetsel( _dos_ds )
         
         With this.core[this.active]
            
            for i as integer = 0 to (.x * .y) - 1
            
               _farnspokeb( scr, CHARMASK(.data[i]) )
               scr += 1
               _farnspokeb( scr, ( BCOLORMASK(.data[i]) Shl 4 ) Or FCOLORMASK(.data[i]) )
               scr += 1

            next
         
         End With
      
      End Sub
   
   #EndIf
   
   

end namespace

extern conLib as chi.Console
dim as chi.console conLib


I included a couple tests, too.

speedtest.bas: FPS please! ;)

Code: Select all

#include "conlib.bi"

width 80, 25

dim as double fpsTime, fpsCount, fps
dim as integer mx, my
do

   for i as integer = 0 to 15
      
       conLib.color( 7, 0 )
      conLib.cls( )
      conLib.print( str(fps) )
      conLib.color( 7, i )
      dim as integer j
      for j = 0 to (80 * 25)-len(str(fps)) - 1
         
         conLib.print( chr((rnd * (asc("z")-asc("A"))) + asc("A")), 1 )
         
      next
      
      conLib.flip( )
      
      if timer > fpsTime then
         
         fpsTime = timer + 1
         fps = fpsCount
         fpsCount = 0
         
      end if
      fpsCount += 1
      
      if multikey(1) then exit do

   next
   
   sleep 1, 1

loop

conLib.close( )


locatetest.bas

Code: Select all

#include "conlib.bi"

width 80, 25

conLib.locate 25, 76
conLib.print( "Hello" )

conLib.flip( )
sleep

conLib.print( "SKL:DJALSKJDLAKSJLDKASJLDK" )

conLib.flip( )
sleep

conLib.close( )


safetytest.bas: don't dim your own Console...

Code: Select all

#include "conlib.bi"

width 80, 25

'' this will not compile!
'' do not attempt to dim your own Console!

dim ohnoes as chi.Console


mousetest.bas

Code: Select all

#include "conlib.bi"

width 80, 25

dim as integer mx, my, c
do
   
    getmouse mx, my

    conLib.locate my+1, mx+1
    conLib.color c

   conLib.print( "Hello, world!", 1 )

   conLib.flip( )
   conLib.cls

   c += 1
   c and= 15
      
   sleep 1, 1

loop until multikey( 1 )

conLib.close( )


pagetest.bas: how freakin easy can multiple pages get?!?

Code: Select all

#include "conlib.bi"

width 80, 25

conLib.pages = 2

cls
? "We have"; conLib.pages; " pages."
sleep

conLib.activePage = 0
conLib.print( "Hi, this is page "+str(conLib.activePage)+"!" )

conLib.activePage = 1
conLib.print( "Hi, this is page "+str(conLib.activePage)+"!" )


conLib.activePage = 0
conLib.flip( )
sleep

conLib.cls( )

conLib.activePage = 1
conLib.flip( )
sleep

conLib.close( )


Let me know what you think of it.

EDIT: Fixed a bug that'd make it crash on close
EDIT2: Fixed some linux-specific curses-related crap
Last edited by cha0s on Dec 22, 2006 13:18, edited 1 time in total.
acetoline
Posts: 228
Joined: Oct 27, 2006 6:50
Contact:

Postby acetoline » Dec 22, 2006 13:06

Very well done, cha0s. Nice addition to the growing list of OO wrappers for fb.
cha0s
Site Admin
Posts: 5317
Joined: May 27, 2005 6:42
Location: Illinois
Contact:

Postby cha0s » Dec 22, 2006 13:19

Thanks dude. It's worth noting that this is more than just an OO wrapper, I actually reimplemented the commands at a lower level.
sir_mud
Posts: 1401
Joined: Jul 29, 2006 3:00
Location: US
Contact:

Postby sir_mud » Dec 23, 2006 2:30

That's awesome you got it ported to the other platforms. Had a little problem getting it to run in a terminal not set to 80x25 or above. FPS wise I get about 580 in an xterm, 450 in gnome-terminal and only 250 on a virtual terminal.
osiyo53
Posts: 96
Joined: Feb 17, 2006 4:53

Postby osiyo53 » Feb 18, 2007 17:53

Chaos,

I'm having a little problem here with your library. When trying to create the library file using 'fbc conlib.bas -lib' I get an error report for line 202 saying that there is an 'EXIT SUB' outside a SUB block.

Looking at the code, this appears to be true. At least to my limited abilities to follow your code.

Code: Select all

        Private Constructor console( Byval pages_ As Integer = 1, Byval spec As Integer = -1 )
               
                #IfDef __FB_Linux__
               
                        initscr( )
                        start_color( )
                        curses_InitColorTable()
               
                #EndIf
               
                If pages_ < 1 Then
               
                        Exit Sub
               
                End If


What I can't decipher is whether or not you intended to exit the constructor ... or not????? And just mistyped 'Sub' instead. Or what.

Sorry to bother you with this, but I'm puzzled and not nearly up to the type of coding you do so that I really understand it. Tho, I was hoping to do so by compiling the library and the examples, then playing with them, making modifications and such, so that I could start to understand by watching the changes as I made them.

I THINK I'm okay as far as what version of the compiler I'm using. Maybe, maybe not. Could be fooling myself thru shear ignorance. But what I have is FB 0.16 installed, clean. Then I downloaded latest stuff from the link for the daily update, the BIG package. Which I understand to include all the changes needed to be up to date as of today. Expanded the rar and copied everything over to my FreeBasic directory. Overwriting as needed to replace out of date stuff. So I THINK I have 0.17 with latest CVS changes. Did some test compiles of some of my own stuff and so forth. Everything seems to work okay.

Until I started to try to compile and use your conlib library.

Got any ideas? Am I doing something wrong? (probable) Or did you make a typo? (possible, not likely as others said they got it to run)

Thanks for any help you can give the clueless.
cha0s
Site Admin
Posts: 5317
Joined: May 27, 2005 6:42
Location: Illinois
Contact:

Postby cha0s » Feb 18, 2007 23:58

Yeah sorry, that should have been 'exit constructor', I could have sworn I've fixed that twice by now... hehe.

Well, just changing your version to 'exit constructor' will make it happy.
osiyo53
Posts: 96
Joined: Feb 17, 2006 4:53

Postby osiyo53 » Feb 19, 2007 1:53

cha0s wrote:Yeah sorry, that should have been 'exit constructor', I could have sworn I've fixed that twice by now... hehe.

Well, just changing your version to 'exit constructor' will make it happy.


Thanks,

It works now. Time to play and learn.

Return to “Projects”

Who is online

Users browsing this forum: No registered users and 1 guest