MicroFont, a 5x7 dot-matrix font

[dcromley]

Years ago you could see a single pixel.  Nowadays you need a magnifying glass.
 A dot-matrix 5x7 font was quite readable.  Now it's a micro font.
 Just what I wanted to label some things on my plots.
 So I made a routine -- MicroFont.
 It can be drawn anywhere on the screen.
 MicroFont is a self-contained routine at the bottom of the program.

Code: (Select All)

  MicroFont(string, ix, iy)
  ' where string is the text and ix,iy is where it is to be drawn.

 The font is loaded once into a static variable.
 This demo was the easy part - just using the font.
 The hard part was making the font.  I will post MicroFontEditor in a separate thread.

Code: (Select All)

_Title "MicroFont 1.0"
Option _Explicit
DefSng A-Z: DefLng I-N: DefStr S
Randomize Timer
Screen _NewImage(1024, 768, 256)
Color 0, 15
Cls
' == MAIN start ==
Dim Shared void, sWord, sWords(100), xy(100, 4), nWords
Dim i, nloop, velocity
Data Twas,brillig,and,the,slithy,toves,/
Data Did,gyre,and,gimble,in,the,wabe,/
Data All,mimsy,were,the,borogoves,/
Data And,the,mome,raths,outgrabe.,~

MicroFont "Demo of MicroFont", 440, 6 ' == DRAWS THE TITLE ==
Circle (440, 6), 2 ' shows the ix, iy used above
loadWords ' load data into array

Do ' == Main loop ==
  _Limit 60
  nloop = nloop + 1
  If nloop = 180 Then velocity = .01 '
  If nloop > 180 Then velocity = velocity * 1.01
  If velocity > 1 Then velocity = 1
  For i = 1 To nWords ' move all words
    xy(i, 1) = xy(i, 1) + xy(i, 3) * velocity
    xy(i, 2) = xy(i, 2) + xy(i, 4) * velocity
    MicroFont sWords(i), xy(i, 1), xy(i, 2) ' draws individual words
    If xy(i, 1) < 0 Then xy(i, 3) = Abs(xy(i, 3)) ' bounce
    If xy(i, 2) < 6 Then xy(i, 4) = Abs(xy(i, 4))
    If xy(i, 1) > 1000 Then xy(i, 3) = -Abs(xy(i, 3))
    If xy(i, 2) > 767 Then xy(i, 4) = -Abs(xy(i, 4))
  Next i
Loop While InKey$ = ""
System

Sub loadWords ()
  Dim ang, ix, iy, sword: ix = 400: iy = 300
  Do
    Read sword
    If sword = "~" Then Exit Do ' ck EOF
    If sword = "/" Then ix = 400: iy = iy + 12: GoTo continue1 ' ck EOL
    MicroFont sword, ix, iy ' == DRAWS ONE WORD ==
    nWords = nWords + 1 ' into array for moving
    sWords(nWords) = sword
    xy(nWords, 1) = ix
    xy(nWords, 2) = iy
    ang = Rnd * 6.2832
    xy(nWords, 3) = Cos(ang)
    xy(nWords, 4) = Sin(ang)
    ix = ix + Len(sword) * 6 + 5
    continue1:
  Loop
End Sub

DefStr S: DefLng I-N ' This is needed
Sub MicroFont (sstr, ixx0, iyy0) ' ==== THIS IS THE MicroFont ROUTINE ====
  ' -- prints string sstr at position ixx0 and iy0 --
  Static sFont, s96
  If sFont = "" Then ' load once only
    sFont = sFont + "€€€€€€€û€€€à€à€”¾”¾”ªÿª„¢„ˆ¢†¹Í²…€€ð€€€œ¢Á€€Á¢œ€ˆªœªˆˆˆ¾ˆˆ"
    sFont = sFont + "€‡†€€ˆˆˆˆˆ€ƒƒ€€‚„ˆ ¾ÅÉѾ€¡ÿ¡ÃÅɱ¢ÉÉɶŒ”¤ÿ„úÉÉÉƾÉÉɦÃÄÈÐà"
    sFont = sFont + "¶ÉÉɶ²ÉÉɾ€€¶€€€¶€€€ˆ”¢€€”””€€¢”ˆ€ ÀÅÈ°¾ÁÝż¿ÈÈÈ¿ÿÉÉɶ¾ÁÁÁ¢"
    sFont = sFont + "ÿÁÁÁ¾ÿÉÉÉÁÿÈÈÈÀ¾ÁÁŦÿˆˆˆÿ€ÁÿÁ€‚ÁþÀÿˆ”¢Áÿÿ  ÿÿ ˜„ÿ¾ÁÁÁ¾"
    sFont = sFont + "ÿÄÄĸ¸ÄÄÄÿÿÈÌʱ²ÉÉɦÀÀÿÀÀþþü‚‚üþ†þÁ¶ˆ¶ÁÀ°°ÀÃÅÉÑကÿÁ€"
    sFont = sFont + " ˆ„‚€Áÿ€€„ˆˆ„€Àà €‚•••þ‘‘‘ŽŽ‘‘‘‘Ž‘‘‘þŽ•••Œ€ˆ¿È ˆ•••Ž"
    sFont = sFont + "ÿ€€Þ€€Þ€€ÿ„Š‘‘€€þŸŸŸˆŸŽ‘‘‘Ž’’’ŒŒ’’’Ÿˆˆˆ•••‚"
    sFont = sFont + "€þ‘ž‚Ÿœ‚‚œž†ž‘Š„Š‘™……‚œ‘“•™‘€ˆ¶Á€€€÷€€€Á¶ˆ€ˆˆ„ˆˆ„ˆ"
    s96 = s96 + " !##$%&'()*+,-./0123456789:;<=>?"
    s96 = s96 + "@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_"
    s96 = s96 + "`abcdefghijklmnopqrstuvwxyz{|}~"
    Mid$(s96, 3, 1) = Chr$(34) ' fix quote "
  End If ' end of once only
  Dim iposStr, ipos96, ipos480, ix0, iy0, ix, iy, imask, ich
  ix0 = ixx0 - 1: iy0 = iyy0 + 1 ' byValue
  For iposStr = 1 To Len(sstr) ' one character at a time
    ipos96 = InStr(1, s96, Mid$(sstr, iposStr, 1))
    If ipos96 = 0 Then ipos96 = 4 ' invalid character -> #
    ipos480 = (ipos96 - 1) * 5 ' index to sFont
    For ix = 0 To 6: imask = 1 ' OxxxxxO 5 columns in character
      If 1 <= ix And ix <= 5 Then ich = Asc(Mid$(sFont, ipos480 + ix, 1))
      For iy = 0 To 8 ' OxxxxxxxO 7 rows in character
        If ix < 1 Or ix > 5 Or iy < 1 Or iy > 7 Then
          PSet (ix0 + ix, iy0 - iy), 15 ' BG
        Else ' choose FG or BG
          If ich And imask Then ' ck bit
            PSet (ix0 + ix, iy0 - iy), 0 ' FG
          Else
            PSet (ix0 + ix, iy0 - iy), 15 ' BG
          End If
          imask = imask + imask ' next bit in column
        End If
      Next iy
    Next ix
    ix0 = ix0 + 6 ' next char output
  Next iposStr
  ' could modify ix here
End Sub

[bplus]

Thumbs up very nice, I can read that font even with my eyes!

[James D Jarvis]

Two thumbs up. I can see uses for this micro font.