Making your own fast font routine? (or speed up this one?)

[Rocket Boy]

For my program, I was hoping someone could point me towards a tutorial or something that would give me a basic idea of how to make a fast font routine... or maybe help me by telling me if theres a way you could speed this one up - or both.

Okay, thanks.

SUB font (text$, X%, Y%, clr%)
X% = X% - 7
FOR d% = 1 TO LEN(text$)
FOR c% = 0 TO 7
DEF SEG = -90
l% = PEEK(14 + 8 * ASC(MID$(text$, d%, 1)) + c%)
x1% = X% + d% * 8 - 1
x2% = X% + d% * 8 + 15: a% = 7
FOR B% = x1% TO x2%
IF l% AND 2 ^ a% THEN
PSET (B%, c% + Y%), clr%
END IF: a% = a% - 1
NEXT
NEXT
NEXT
DEF SEG
END SUB

[Z!re]

By poking to mem
By using line to plot entire rows of pixel data as opposed to single pixels..

[moneo]

I don't know what you're doing, but I have a small suggestion for speeding up the code.

x1% = X% + d% * 8 - 1
x2% = X% + d% * 8 + 15: a% = 7
'Instead of the above 2 lines, do this:
tmp1% = X% + d% * 8
x1% = tmp1% - 1
x2% = tmp1% + 15: a% = 7

*****

[Z!re]

Using a lookup table could improve speed more, and trying to get rid of those pesky - and +

[Antoni]

An example:

Code: Select all

declare SUB font (text$, X%, Y%, clr%)
screen 12
k%=0
for i%=0 to 7
for j%=0 to 60
font "This is a demo",120*i%,8*j%,k%+1
k%=((k%+1) mod 14)
next
next

sleep
end

SUB font (text$, X%, Y%, clr%)
x%=x%-7
DEF SEG = -90
'make even the length
if len(text$) and 1 then text$=text$+" "
FOR d% = 1 TO LEN(text$) step 2
 ll% = 8 * ASC(MID$(text$, d%, 1))+14
 ll1% = 8 * ASC(MID$(text$, d%+1, 1))+14 
 x1% = X% + d% * 8 - 1
 x2%=x1%+15  
 FOR c% = 0 TO 7
  l&=256&*peek(ll%+c%) +peek(ll1%+c%)
  line (x1%,c%+y%)-(x2%,c%+y%),clr%,,l&
 NEXT
NEXT
DEF SEG
END SUB

BTW: Using DEFSEG=-90 may not work in all PC's, you should call INT 10 to get the correct address of the font. I can't check it now...

[Marc]

Doesn't work unfortunately

[Guest]

Do you have a portable? Usually the assumption the 8x8 font is in SEG -90 is false in the portables, a call interrupt is needed to get the correct segment.
This should work. Load to the ide with the /lqb option...

Code: Select all

'$include:'qb.bi'
declare SUB font (text$, X%, Y%, clr%)
screen 12
dim regs as regtypex
dim shared segm, offs
regs.ax=&h1130
regs.bx=&h0300
call interruptx(&h10,regs,regs)
segm=regs.es
offs=regs.bp

k%=0
for i%=0 to 7
for j%=0 to 60
font "This is a demo",120*i%,8*j%,k%+1
k%=((k%+1) mod 14)
next
next

sleep
end

SUB font (text$, X%, Y%, clr%)
x%=x%-7
DEF SEG = segm
'make even the length
if len(text$) and 1 then text$=text$+" "
FOR d% = 1 TO LEN(text$) step 2
 ll% = 8 * ASC(MID$(text$, d%, 1))+offs
 ll1% = 8 * ASC(MID$(text$, d%+1, 1))+offs
 x1% = X% + d% * 8 - 1
 x2%=x1%+15 
 FOR c% = 0 TO 7
  l&=256&*peek(ll%+c%) +peek(ll1%+c%)
  line (x1%,c%+y%)-(x2%,c%+y%),clr%,,l&
 NEXT
NEXT
DEF SEG 
end sub

[Guest]

I got an overflow with both :/

[Antoni]

Ok, this is a problem with QB not having unsigned integers. You can try compiling the code or try this (i hope last) one using LONG variables:

Code: Select all

'$include:'qb.bi'
declare SUB font (text$, X%, Y%, clr%)
screen 12
dim regs as regtypex
dim shared segm%, offs&
regs.ax=&h1130
regs.bx=&h0300
call interruptx(&h10,regs,regs)
segm%=regs.es
offs&=regs.bp

k%=0
for i%=0 to 7
for j%=0 to 60
font "This is a demo",120*i%,8*j%,k%+1
k%=((k%+1) mod 14)
next
next

sleep
end

SUB font (text$, X%, Y%, clr%)
x%=x%-7
DEF SEG = segm%
'make even the length
if len(text$) and 1 then text$=text$+" "
FOR d% = 1 TO LEN(text$) step 2
 ll& = offs& + 8& * ASC(MID$(text$, d%, 1))
 ll1& = offs& + 8& * ASC(MID$(text$, d%+1, 1))
 x1% = X% + d% * 8 - 1
 x2%=x1%+15
 FOR c% = 0 TO 7
  l&=256&*peek(ll&+c%) +peek(ll1&+c%)
  line (x1%,y%+c%)-(x2%,y%+c%),clr%,,l&
 NEXT
NEXT
DEF SEG
end sub