Author Topic: SafeLoadFont (preserve cursor position)  (Read 1837 times)

Offline The Librarian

  • Moderator
  • Newbie
  • Posts: 27
SafeLoadFont (preserve cursor position)
« on: August 27, 2019, 09:57:41 PM »
SafeLoadFont (preserve cursor position)

Contributor(s): SMcNeill
Source: qb64.org Forum
URL: https://www.qb64.org/forum/index.php?topic=1597.msg108787#msg108787
Tags: [font]

Description:
Safely loads a font without destroying our current print location and making it revert to the top left corner.

Source Code:
Code: QB64: [Select]
  1. DIM fonts(3) AS LONG
  2. SCREEN _NEWIMAGE(640, 480, 32)
  3.  
  4. font(0) = _LOADFONT("cour.ttf", 16, "monospace")
  5. font(1) = _LOADFONT("courbd.ttf", 16, "monospace")
  6. font(2) = _LOADFONT("courbi.ttf", 16, "monospace")
  7. font(3) = _LOADFONT("couri.ttf", 16, "monospace")
  8.  
  9. PRINT "First, I want to showcase the exisinging issue with the _FONT command."
  10. PRINT "Let's start out typing something, and then pause before loading a"
  11. PRINT "new font..."
  12.  
  13. _FONT font(0)
  14. COLOR &HFFF00000, &HFFFFFF00
  15. slowprint "NOW WHERE IS OUR PRINT CURSOR AT??"
  16. CLS , 0
  17. COLOR -1, 0
  18.  
  19. PRINT "Now, let's try this same type of thing, while using SafeLoadFont"
  20. PRINT "We'll start typing something, and then pause before safe loading"
  21. PRINT "a new font..."
  22.  
  23.  
  24. slowprint "Slowly watch what happens to our print cursor "
  25. SafeLoadFont font(1)
  26. slowprint "as we use SafeLoadFont to change "
  27. SafeLoadFont font(2)
  28. slowprint "fonts while happily printing to "
  29. SafeLoadFont 16
  30. slowprint "the screen, without a concern in the world! "
  31. PRINT "Now, isn't that something?!"
  32.  
  33.  
  34. SUB slowprint (text$)
  35.     FOR i = 1 TO LEN(text$)
  36.         PRINT MID$(text$, i, 1);
  37.         _LIMIT 5
  38.     NEXT
  39.  
  40. SUB SafeLoadFont (font#)
  41.     'Safely loads a font without destroying our current print location and making it revert to the top left corner.
  42.  
  43.     down = CSRLIN: right = POS(0)
  44.     down = (down - 1) * _FONTHEIGHT
  45.     IF _FONTWIDTH <> 0 THEN 'we start with a monospace font
  46.         right = (right - 1) * _PRINTWIDTH(" ") 'convert the monospace LOC to a graphic X coordinate
  47.     END IF
  48.     _FONT font#
  49.     IF _FONTWIDTH <> 0 THEN 'we swapped to a monospace font
  50.         right = (right / _PRINTWIDTH(" ")) + 1 'convert the graphic X coordinate back to a monospace LOC column
  51.     END IF
  52.     down = (down / _FONTHEIGHT) + 1
  53.     IF right < 1 THEN right = 1
  54.     LOCATE down, right
  55.