'===========================================================================
' Subject: VARIABLE FONT                     Date: 04-02-00 (15:17)       
' Author:  Dieter Folger                     Code: PB                     
' Origin:  folger@bnv-bamberg.de           Packet: PB.ABC
'===========================================================================
' VFONT.BAS - Variable font in graphic mode
' Original QBASIC-Program: H. Foerter
' Converted to PowerBASIC and improved: D. Folger
DEFINT A-Z
SCREEN 12
GetFontAdr
LINE (0,   0)-(639, 479), 7, BF
LINE (10, 10)-(629, 329), 4, BF
Prints 45,  10, 20, 20,  0, "ABC", 1 'shadow effect
Prints 40,   5, 20, 20, 14, "ABC", 1
Prints 590, 285,  2,  2, 14, "The ABC Archive", 4
Prints 52, 246,  4,  6,  0, "All Basic Code", 1
Prints 50, 244,  4,  6, 14, "All Basic Code", 1
Prints 575, 360,  1,  1,  0, "Your source for BASIC sources", 2
Prints 500, 462,  0,  1,  0, "Press key to end", 1
ShowFont 'show all ASCII chars
DO: LOOP WHILE INKEY$=""
END
'-----------------------------------------------------------------------
SUB Prints(x1, y1, SizeX, SizeY, Colr, Text$, FontMode)
'-------------------------------------------------------------------------
SHARED Seg16??,Ofs16??
 COLOR Colr
 WordLen = LEN(Text$)
 DEF SEG=Seg16??
 IF SizeX = 0 OR SizeY = 0 then FontMode = 0
 SELECT CASE FontMode
 '--------------------------
 CASE 0   'No Scaling
 '---------------------------
FOR i = 1 TO WordLen
    CharNr = ASC(MID$(Text$, i, 1))
    Adr?? =Ofs16??+16*CharNr
    x1 = x1 + 7
    FOR j = 1 TO 8
        FOR k = 1 TO 16
           z = PEEK(Adr?? + k - 1)
           IF BIT(z, 8 - j) THEN PSET (x1+j, y1 + k)
        NEXT k
    NEXT j
NEXT i
       '----------------
 CASE 1 'Normal
       '----------------
      xx = -SizeX - 1
      FOR i = 1 TO WordLen
          CharNr = ASC(MID$(Text$, i, 1))
          Adr?? = Ofs16?? + 16 * CharNr
          FOR j = 1 TO 8
              xx = xx + SizeX: yy = -SizeY - 1
              FOR k = 1 TO 16
                  z=PEEK(Adr??+k-1)
                  yy = yy + SizeY
                  IF BIT(z, 8 - j) THEN
                     LINE (x1 + xx, y1 + yy)-(x1+xx+SizeX,y1+yy+SizeY),Colr, BF
                  END IF
              NEXT k
          NEXT j
      NEXT i
 '----------------
 CASE 2 'Upside down
 '----------------
      xx = -SizeX - 1
      FOR i = 1 TO WordLen
          CharNr = ASC(MID$(Text$, i, 1))
          Adr?? = Ofs16?? +16 * CharNr
          FOR j = 1 TO 8
              xx = xx - SizeX : yy = SizeY - 1
              FOR k = 1 TO 16
                  z=PEEK(Adr??+k-1)
                  yy = yy - SizeY
                  IF BIT(z, 8 - j) THEN
                     LINE (x1 + xx, y1 + yy)-(x1+xx+SizeX,y1+yy+SizeY),Colr,BF
                  END IF
              NEXT k
          NEXT j
      NEXT i
 '----------------
 CASE 3 'Vertical down
 '----------------
       yy = SizeX - 1
       FOR i = 1 TO WordLen
           CharNr = ASC(MID$(Text$, i, 1))
           Adr?? = Ofs16?? + 16*CharNr
           FOR j = 1 TO 8
               xx = SizeX - 1:yy = yy - SizeY
               FOR k = 1 TO 16
                   z=PEEK(Adr??+k-1)
                   xx = xx + SizeY
                   IF BIT (z,8-j) THEN
                      LINE (x1 - xx, y1 - yy)-(x1-xx-SizeX,y1-yy-SizeY),Colr,BF
                   END IF
               NEXT k
           NEXT j
       NEXT i
 '----------------
 CASE 4 'Vertical up
 '----------------
      yy = -SizeX - 1
      FOR i = 1 TO WordLen
          CharNr = ASC(MID$(Text$, i, 1))
          Adr??=Ofs16??+16*CharNr
          FOR j = 1 TO 8
              xx = SizeY + 1: yy = yy + SizeX
              FOR k = 1 TO 16
                  z=PEEK(Adr??+k-1)
                  xx = xx - SizeY
                  IF BIT(z,8-j) THEN
                     LINE (x1 - xx, y1 - yy - m)-(x1-xx+SizeX,y1-yy-SizeY),Colr,BF
                  END IF
              NEXT k
          NEXT j
      NEXT i
 END SELECT
 DEF SEG
END SUB
'------------
SUB GetFontAdr
'------------
 SHARED Seg16??,Ofs16??
 ! push bp
 ! mov ax,&H1130
 ! mov bx,&H0600
 ! int &H10
 ! mov Seg16??,es
 ! mov Ofs16??,bp
 ! pop bp
END SUB
'-----------
SUB ShowFont
'-----------
'Just a demonstration: Shows ASCII characters 1-254
SHARED Seg16??,Ofs16??
y = 380
COLOR 15
DEF SEG=Seg16??
FOR i = 1 TO 254
    Adr&=Ofs16??+16*i
    x = (i MOD 62) * 10
    IF x = 0 THEN y = y + 20
    FOR j = 1 TO 8
        FOR k = 1 TO 16
           z = PEEK(Adr& + k - 1)
           IF BIT(z, 8 - j) THEN PSET (x + j + 10, y + k)
        NEXT k
    NEXT j
NEXT i
DEF SEG
END SUB