Making your own fast font routine? (or speed up this one?)
-
- Coder
- Posts: 19
- Joined: Thu Sep 08, 2005 3:14 am
Making your own fast font routine? (or speed up this one?)
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
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
An example:
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...
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
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...
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
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