text mode buffering

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
dumbledore
Posts: 680
Joined: May 28, 2005 1:11
Contact:

text mode buffering

Postby dumbledore » May 29, 2005 4:17

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
Posts: 100
Joined: Jun 23, 2005 16:48

Postby aetherFox » Jun 23, 2005 16:50

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
Posts: 680
Joined: May 28, 2005 1:11
Contact:

Postby dumbledore » Jun 23, 2005 23:04

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
Posts: 100
Joined: Jun 23, 2005 16:48

Postby aetherFox » Jun 23, 2005 23:25

:D

That's right :D
MystikShadows
Posts: 612
Joined: Jun 15, 2005 13:22
Location: Upstate NY
Contact:

Postby MystikShadows » Jun 24, 2005 1:03

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
Posts: 680
Joined: May 28, 2005 1:11
Contact:

Postby dumbledore » Jun 24, 2005 2:00

:D well i'm glad you finally saw it. (see the original post date? :P )
MystikShadows
Posts: 612
Joined: Jun 15, 2005 13:22
Location: Upstate NY
Contact:

Postby MystikShadows » Jun 24, 2005 2:48

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
Site Admin
Posts: 2116
Joined: May 27, 2005 18:39
Location: Midwestern USA
Contact:

Postby DrV » Jun 24, 2005 3:01

I'd be glad to oblige. ;)

Looks like it works fine in DOS with latest 0.14 build. Very cool.
MystikShadows
Posts: 612
Joined: Jun 15, 2005 13:22
Location: Upstate NY
Contact:

Postby MystikShadows » Jun 24, 2005 3:08

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
Site Admin
Posts: 2116
Joined: May 27, 2005 18:39
Location: Midwestern USA
Contact:

Postby DrV » Jun 24, 2005 3:13

I'll expand on that for you: Absolutely Awesome ASCII Art :)
Frobozz
Posts: 33
Joined: Jun 12, 2005 20:32

Postby Frobozz » Jun 24, 2005 3:18

This is going to be really useful during the roguelike compo. ^_^
dumbledore
Posts: 680
Joined: May 28, 2005 1:11
Contact:

Postby dumbledore » Jun 24, 2005 3:39

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
Posts: 100
Joined: Jun 23, 2005 16:48

Postby aetherFox » Jun 24, 2005 9:06

:| Wow.

That's insanely faster.
dumbledore
Posts: 680
Joined: May 28, 2005 1:11
Contact:

Postby dumbledore » Jun 24, 2005 15:05

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

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 1 guest