text mode buffering

[dumbledore]

made this a while ago, only thing missing i think is color support...
someone asked about it on feature request sf forums i think

Code: Select all

'by dumbledore
'a lightweight text-mode blitter
'should give a pretty impressive speed boost to text-mode games
'because the console won't be updated every time you print
'instead, stick the call to the blitter in a thread, or just
'call it when you want to ;P
type mConsole
   scr(80*25) as ubyte
   cursor as ushort
end type
dim parent as mConsole
parent.cursor=0
dim cons as mConsole ptr=@parent
declare sub _Print(byval cons as mConsole ptr,byval text as string)
declare sub _Blit(byval cons as mConsole ptr)
declare sub _Cls(byval cons as mConsole ptr)
declare sub _Locate(byval cons as mConsole ptr,byval row as integer=-1,byval col as integer=-1)

_cls cons
_locate cons,4
_print cons,"text blitter test..."
_print cons,"testing teh 1337 text blitter"
_blit cons
sleep

sub _Print(byval cons as mConsole ptr,byval text as string)
   dim mystr as ubyte ptr=sadd(text)
   for i=0 to len(text)-1
      cons->scr(cons->cursor)=mystr[i]
      cons->cursor+=1
   next
   cons->cursor=((cons->cursor\80)+1)*80
end sub

sub _Blit(byval cons as mConsole ptr)
   locate 1,1
   for i=0 to ubound(cons->scr)
      ? chr$(cons->scr(i));
   next
   locate 1,1
   locate (cons->cursor\80)+1,(cons->cursor-(cons->cursor\80)*80)+1
end sub

sub _Cls(byval cons as mConsole ptr)
   for i=0 to ubound(cons->scr)
      cons->scr(i)=32
   next
   cons->cursor=0
end sub

sub _Locate(byval cons as mConsole ptr,byval row as integer=-1,byval col as integer=-1)
   if row=-1 then row=cons->cursor\80
   if col=-1 then col=1
   cons->cursor=(row-1)*80+(col-1)
end sub

[aetherFox]

This is awesome.

How about adding a new parameter to the _Print function for colour? That would make this more applicable for complex games.

[dumbledore]

something like this?

Code: Select all

'by dumbledore
'a lightweight text-mode blitter
'should give a pretty impressive speed boost to text-mode games
'because the console won't be updated every time you print
'instead, stick the call to the blitter in a thread, or just
'call it when you want to ;P
type consoleChar
    char as ubyte
    col as ushort
end type

type mConsole
    scr(80*25-1) as consoleChar
    cursor as ushort
    curcol as ushort
end type
dim parent as mConsole
parent.cursor=0
dim cons as mConsole ptr=@parent
declare sub _Print(byval cons as mConsole ptr,byval text as string)
declare sub _Blit(byval cons as mConsole ptr)
declare sub _Cls(byval cons as mConsole ptr)
declare sub _Locate(byval cons as mConsole ptr,byval row as integer=-1,byval col as integer=-1)
declare sub _Color(byval cons as mConsole ptr,byval fgcol as ubyte=-1,byval bgcol as ubyte=-1)

_color cons,7,1
_cls cons
_locate cons,4
_color cons,7,2
_print cons,"text blitter test..."
_locate cons,6,7
_print cons,"testing teh 1337 text blitter"
_color cons,15,3
_print cons,"linebreaks too... ooh"
_blit cons
sleep

sub _Print(byval cons as mConsole ptr,byval text as string)
    dim mystr as ubyte ptr=sadd(text)
    for i=0 to len(text)-1
        cons->scr(cons->cursor).char=mystr[i]
        cons->scr(cons->cursor).col=cons->curcol
        cons->cursor+=1
    next
    cons->cursor=((cons->cursor\80)+1)*80
end sub

sub _Blit(byval cons as mConsole ptr)
    locate 1,1
    dim as ubyte curcol
    color 0,0
    for i=0 to ubound(cons->scr)
        if cons->scr(i).col <> curcol then
            color cons->scr(i).col shr 8, cons->scr(i).col and &hFF
            curcol = cons->scr(i).col
        end if
        ? chr$(cons->scr(i).char);
    next
    locate 1,1
    locate (cons->cursor\80)+1,(cons->cursor-(cons->cursor\80)*80)+1
end sub

sub _Cls(byval cons as mConsole ptr)
    for i=0 to ubound(cons->scr)
        cons->scr(i).char=32
        cons->scr(i).col=cons->curcol
    next
    cons->cursor=0
end sub

sub _Locate(byval cons as mConsole ptr,byval row as integer=-1,byval col as integer=-1)
    if row=-1 then row=cons->cursor\80
    if col=-1 then col=1
    cons->cursor=(row-1)*80+(col-1)
end sub

sub _Color(byval cons as mConsole ptr,byval fgcol as ubyte=-1,byval bgcol as ubyte=-1)
    if fgcol = -1 then fgcol = cons->curcol shr 8
    if bgcol = -1 then bgcol = cons->curcol and &hFF
    cons->curcol = ( fgcol shl 8 ) or bgcol
end sub

[aetherFox]

:D

That's right :D

[MystikShadows]

Dumbledore, where do I join your cult? ;-).

I'm the one that asked for that feature a good while back on SF. Woohoo :-). Have you tried this with the DOS port of FreeBasic? If not, I will. But even if just in console windows, it's still awesome :-).

Thanks for take the time, and effort, to making this. :-). You have NO idea how well appreciated it is. Well...maybe you do :-)....

[dumbledore]

:D well i'm glad you finally saw it. (see the original post date? :P )

[MystikShadows]

Yeah, I noticed it...Better late than never they say right? what kinda crap is that? LOL I have no excuse ;-) and I don't need none either lol.

So far so good, it's working great ... haven't tried it in DOS yet....but it seems like that code is very standard....just might work...i'll let you know...

Took you a short period of time to create it...even shorter to alter it to add color and it took me a month to notice the answer to my ever lasting quest...IS NOTHING SACRED ANYMORE?

Somebody slap me silly with a wet noodle here! LOL

[DrV]

I'd be glad to oblige. ;)

Looks like it works fine in DOS with latest 0.14 build. Very cool.

[MystikShadows]

lol I expected nothing less of you DrV....LOL

And it's awesome news that it works in DOS....Absolutely Awesome :-) Capitalized intentionally to express my joy...and appreciation ;-).

[DrV]

I'll expand on that for you: Absolutely Awesome ASCII Art :)

[Frobozz]

This is going to be really useful during the roguelike compo. ^_^

[dumbledore]

2x speed boost during "blits" by using crt's putchar():

Code: Select all

'by dumbledore
'a lightweight text-mode blitter
'should give a pretty impressive speed boost to text-mode games
'because the console won't be updated every time you print
'instead, stick the call to the blitter in a thread, or just
'call it when you want to ;P
#include "crt.bi"
type consoleChar
    char as ubyte
    col as ushort
end type

type mConsole
    scr(80*25-1) as consoleChar
    cursor as ushort
    curcol as ushort
end type
'width 80, 25
dim parent as mConsole
parent.cursor=0
dim cons as mConsole ptr=@parent
declare sub _Print(byval cons as mConsole ptr,byval text as string)
declare sub _Blit(byval cons as mConsole ptr)
declare sub _Cls(byval cons as mConsole ptr)
declare sub _Locate(byval cons as mConsole ptr,byval row as integer=-1,byval col as integer=-1)
declare sub _Color(byval cons as mConsole ptr,byval fgcol as ubyte=-1,byval bgcol as ubyte=-1)

_color cons,7,1
_cls cons
_locate cons,4
_color cons,7,2
_print cons,"text blitter test..."
_locate cons,6,7
_print cons,"testing teh 1337 text blitter"
_color cons,15,3
_print cons,"linebreaks too... ooh"
_blit cons
sleep

sub _Print(byval cons as mConsole ptr,byval text as string)
    dim mystr as ubyte ptr=sadd(text)
    for i=0 to len(text)-1
        cons->scr(cons->cursor).char=mystr[i]
        cons->scr(cons->cursor).col=cons->curcol
        cons->cursor+=1
    next
    cons->cursor=((cons->cursor\80)+1)*80
end sub

sub _Blit(byval cons as mConsole ptr)
    locate 1,1
    dim as ubyte curcol
    color 0,0
    for i=0 to ubound(cons->scr)
        if cons->scr(i).col <> curcol then
            color cons->scr(i).col shr 8, cons->scr(i).col and &hFF
            curcol = cons->scr(i).col
        end if
        putchar(cons->scr(i).char)
    next
    locate 1,1
    locate (cons->cursor\80)+1,(cons->cursor-(cons->cursor\80)*80)+1
end sub

sub _Cls(byval cons as mConsole ptr)
    for i=0 to ubound(cons->scr)
        cons->scr(i).char=32
        cons->scr(i).col=cons->curcol
    next
    cons->cursor=0
end sub

sub _Locate(byval cons as mConsole ptr,byval row as integer=-1,byval col as integer=-1)
    if row=-1 then row=cons->cursor\80
    if col=-1 then col=1
    cons->cursor=(row-1)*80+(col-1)
end sub

sub _Color(byval cons as mConsole ptr,byval fgcol as ubyte=-1,byval bgcol as ubyte=-1)
    if fgcol = -1 then fgcol = cons->curcol shr 8
    if bgcol = -1 then bgcol = cons->curcol and &hFF
    cons->curcol = ( fgcol shl 8 ) or bgcol
end sub

[aetherFox]

:| Wow.

That's insanely faster.

[dumbledore]

same speed (for me), fills the whole screen (not in 9x according to v1c)

Code: Select all

'by dumbledore
'a lightweight text-mode blitter
'should give a pretty impressive speed boost to text-mode games
'because the console won't be updated every time you print
'instead, stick the call to the blitter in a thread, or just
'call it when you want to ;P
#include "crt.bi"
type consoleChar
    char as ubyte
    col as ushort
end type

type mConsole
    scr(80*25-1) as consoleChar
    cursor as ushort
    curcol as ushort
end type
width 80, 25
dim parent as mConsole
parent.cursor=0
dim cons as mConsole ptr=@parent
declare sub _Print(byval cons as mConsole ptr,byval text as string)
declare sub _Blit(byval cons as mConsole ptr)
declare sub _Cls(byval cons as mConsole ptr)
declare sub _Locate(byval cons as mConsole ptr,byval row as integer=-1,byval col as integer=-1)
declare sub _Color(byval cons as mConsole ptr,byval fgcol as ubyte=-1,byval bgcol as ubyte=-1)

_color cons,7,1
_cls cons
_locate cons,4
_color cons,7,2
_print cons,"text blitter test..."
_locate cons,6,7
_print cons,"testing teh 1337 text blitter"
_color cons,15,3
_print cons,"linebreaks too... ooh"
st! = TIMER
for i = 1 to 20
    _blit cons
next
? 20 / ( TIMER - st! )
sleep

sub _Print(byval cons as mConsole ptr,byval text as string)
    dim mystr as ubyte ptr=sadd(text)
    for i=0 to len(text)-1
        cons->scr(cons->cursor).char=mystr[i]
        cons->scr(cons->cursor).col=cons->curcol
        cons->cursor+=1
    next
    cons->cursor=((cons->cursor\80)+1)*80
end sub

sub _Blit(byval cons as mConsole ptr)
    locate 1,1
    dim as ubyte curcol
    color 0,0
    for i=0 to ubound(cons->scr)-1
        if cons->scr(i).col <> curcol then
            color cons->scr(i).col shr 8, cons->scr(i).col and &hFF
            curcol = cons->scr(i).col
        end if
        putchar(cons->scr(i).char)
    next
    if cons->scr(i).col <> curcol then
        color cons->scr(i).col shr 8, cons->scr(i).col and &hFF
        curcol = cons->scr(i).col
    end if
    ? chr$(cons->scr(i).char);
    locate 1,1
    locate (cons->cursor\80)+1,(cons->cursor-(cons->cursor\80)*80)+1
end sub

sub _Cls(byval cons as mConsole ptr)
    for i=0 to ubound(cons->scr)
        cons->scr(i).char=32
        cons->scr(i).col=cons->curcol
    next
    cons->cursor=0
end sub

sub _Locate(byval cons as mConsole ptr,byval row as integer=-1,byval col as integer=-1)
    if row=-1 then row=cons->cursor\80
    if col=-1 then col=1
    cons->cursor=(row-1)*80+(col-1)
end sub

sub _Color(byval cons as mConsole ptr,byval fgcol as ubyte=-1,byval bgcol as ubyte=-1)
    if fgcol = -1 then fgcol = cons->curcol shr 8
    if bgcol = -1 then bgcol = cons->curcol and &hFF
    cons->curcol = ( fgcol shl 8 ) or bgcol
end sub