#!/usr/local/bin/yabasic
rem version 1.0 Freeware
if peek("argument")<1 then
print "Usage : scalfont.yab <NameofFont.ybm> \n"
end
else
usefont$=peek$("argument")
rem usefont$="f16x8.ybm"
rem usefont$="f17x10.ybm"
fi
 DIM Font(100, 12, 20), XS(12), YS(20)

gosub Initialize
  gosub ReadYbm
  gosub InitFont
clear screen
print "\n Loaded Font : ",FontTitle$
print "Font original width = ",fontwidth
print "Font original height = ",fontheight
open window WinWidth,WinHeight

 for t=1 to 3
 read  offsetx , offsety, Message$
 gosub DrawText
 next t
k$=inkey$
goto Start
end


label Initialize
data 40,10, " This is the original Font read from a ybitmap"
data 1,30
data "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
data 40,50, " The following are the fonts processed by scaling routine"
dim ybmfont$(24)
WinWidth=640
WinHeight=480
return : rem Initialize

Label ReadYbm
open #1, usefont$,"r"
input #1 tem$,FontTitle$
input #1 tem$,ancho$,coma$,alto$
height=val(alto$)
width=val(ancho$)
for i=1 to height
if (not eof(1)) then
input #1 tem$, ybmfont$(i)
fi
next i
close 1
return : rem ReadYbm

Label InitFont
  fontwidth=width/96
  fontheight=height
for k=1 to 96
  for v=1 to fontheight
  for h=1 to fontwidth
  if mid$( ybmfont$(v), k*fontwidth+h+1, 1)  ="1" then
  rem dot offsetx + (letter-1)*fontwidth +h, offsety +fontheight+ v
  Font(k,h,v)=1
  else
  Font(k,h,v)=0
  fi
  next h
  next v
next k

Char1=1
   For Char2=1 to 95
    I=fontwidth: A=0
label 2691
     FOR J=1 TO fontheight
       IF Font(Char1, I, J)<>0 then A =1 fi
     NEXT J
rem        if A=0 then I=I-1
rem        if I<>1 then goto 2691 fi
rem        endif
rem Font(Char1,0,0) = I-1
 Font(Char1,0,0) = fontwidth
Char1=Char1+1
Next Char2
return

Label DrawText
rem needs Message$
for letter=1 to len(Message$)
letra$=mid$(Message$,letter,1)

alfaindex=asc(letra$)
k=alfaindex-32
for v=1 to fontheight
for h=1 to fontwidth
rem if mid$( ybmfont$(v),k*fontwidth+h,1)  ="1" then
if Font(k,h,v)=1 then
dot offsetx + (letter-1)*fontwidth +h, offsety +fontheight+ v
fi
next h
next v

next letter
return : rem DrawText



Label PrintText
rem  A$    = String to print
rem  T     = Tool (0=none, 1=underline, 2=italics, 4=shadow)
rem  X     = Starting X position       (in pixels)
rem  Y     = Starting Y position       (in pixels)
rem  XSize = Size of font horizontally (in pixels)
rem  YSize = Size of font vertically   (in pixels)
IX = int(XSize / fontwidth) : IY = int(YSize / fontheight)

rem T1 = T AND 1
rem T2 = T AND 2: IF T2 <> 0 THEN T2 = 1 fi
rem T3 = T AND 4: IF T3 <> 0 THEN T3 = 1 fi
if T=0 then T1=0:T2=0:T3=0 fi
if T=1 then T1=1:T2=0:T3=0 fi
if T=2 then T1=0:T2=1:T3=0 fi
if T=3 then T1=1:T2=1:T3=0 fi
if T=4 then T1=0:T2=0:T3=1 fi
if T=7 then T1=1:T2=1:T3=1 fi


XS = IX * fontwidth: YS = IY * fontheight
FOR I = 1 TO fontwidth: XS(I) = IX: NEXT I
FOR I = 1 TO fontheight: YS(I) = IY: NEXT I

IF XS <> XSize THEN FOR I = 1 TO XSize - XS: XS(I) = XS(I) + 1: NEXT I
fi
IF YS <> YSize THEN FOR I = 1 TO YSize - YS: YS(I) = YS(I) + 1: NEXT I
fi
FOR I = 1 TO LEN(A$): C = ASC(MID$(A$, I, 1))

IF C = 13 THEN X = 0: Y = Y + YSize
  IF Y < 480 then GOTO Oops ELSE goto regresa fi
fi
IF C = 32 THEN X = X + XSize 
 IF X < 640 then GOTO Oops ELSE goto regresa fi
fi 
IF C >= 33 AND C <= 127 THEN Char = C - 32 fi

Label TD1
    XS2 = Font(Char, 0, 0): XS3 = 0
        FOR A = 1 TO XS2: XS3 = XS3 + XS(A): NEXT A
        IF X + XS3 > 639 THEN goto regresar fi
        X2 = X: Y2 = Y
        FOR K = 1 TO fontheight
 Z1 = YS(K)
 IF Z1 = 0 THEN goto 96 fi
        FOR J = 1 TO XS2
 Z2 = XS(J)
 IF Z2 = 0 THEN goto 95 fi
        IF Font(Char, J, K) = 0 then GOTO TD2 fi
        X9 = X + Z2 - 1: Y9 = Y + Z1 - 1
        IF T2 = 1 then GOTO T2 fi
        IF T3 = 1 THEN LINE X + IX, Y + IY to X9 + IX, Y9 + IY 
	fi
        LINE X, Y to X9, Y9
        GOTO TD2
Label T2
     Q = (4 - int(K / 2)) * IX
        IF T3 = 1 THEN 
	LINE X + Q + IX, Y + IY to X9 + Q + IX, Y9 + IY
	fi
        LINE X + Q, Y to  X9 + Q, Y9
Label TD2
    X = X + Z2
Label 95

NEXT J

 X = X2: Y = Y + Z1
Label 96
      NEXT K: Y = Y2
        IF T1 = 1 THEN 
	LINE X, Y + YSize - 2  to  X + XS3, Y + YSize - 2
	fi
        IF T1 = 1 AND T3 = 1 THEN 
	LINE X + 1, Y + YSize - 1  to  X + XS3 + 1, Y + YSize - 1
	fi
        X = X + XS3 + 1
Label Oops
   NEXT I
label regresar
k$=inkey$
RETURN : rem PrintText


Label Start
PRINT "Please wait..."
 X = 0: Y = 0: T = 0
XSize = fontwidth
YSize = fontheight

CLear screen 
 
A$ = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789!@#$%^&*)"
 
PRINT "This is a sample of the ",XSize,"x",YSize
print " font normal...\n"
 X = 1: Y = 96: GOSUB PrintText

PRINT " font underlined...": PRINT
 T = 1: X = 1: Y = 128: GOSUB PrintText

PRINT " italicized...": PRINT
 T = 2: X = 1: Y = 160: GOSUB PrintText

 PRINT " underlined, italicized "
 PRINT ""
  T = 3: X = 0: Y = 192: GOSUB PrintText


 XSize = 2*fontwidth
PRINT "\nThis is a sample of the ",XSize,"x",YSize 
print "font normal...\n"
 T = 0: X = 1: Y = 224
 GOSUB PrintText

PRINT "font underlined ..": PRINT
 T = 1: X = 1: Y = 256
GOSUB PrintText

PRINT " font Italicized ..": PRINT
 T = 2: X = 1: Y = 288
 GOSUB PrintText

PRINT "font Italicized underlined ..": PRINT
 T = 3: X = 1: Y = 320
 GOSUB PrintText

XSize=fontwidth
YSize=fontheight*2
PRINT "\nThis is a sample of the ",XSize,"x",YSize,"font...\n"
 T=0 : X = 0: Y = 352
 GOSUB PrintText


 XSize = 1.5*fontwidth: YSize = 2*fontheight
PRINT "This is a sample of the ",XSize,"x",YSize," font underlined, !":
  T = 1: X = 0: Y = 384
 GOSUB PrintText

 XSize = 2*fontwidth: YSize = 2*fontheight
PRINT "This is a sample of the ",XSize,"x",YSize,"  font underlined, !":
  T = 1: X = 0: Y = 416
 GOSUB PrintText

 END