SafeLoadFont (preserve cursor position) by SMcNeill

[The Librarian]

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