home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / FNTPAK32.ZIP / BASIC.EXE / DEMOFNT1.BAS < prev    next >
BASIC Source File  |  1995-08-16  |  8KB  |  231 lines
  1. DEFINT A-Z
  2.  
  3. '$INCLUDE: 'Font_Pak.Inc'           '... For QB/PDS/VB-DOS
  4.  
  5. '======================================================== PowerBasic Users
  6. ''$INCLUDE "Font_Pak.Inc"             '... PB users, UN-REM these lines
  7.  
  8. ''$Link    "Hollow9.Obj"              '... ALL users
  9. ''$Link    "Script1.Obj"              '... Examples of "callable" fonts
  10. ''$Link    "Frazzl16.Obj"
  11.  
  12. ''$Link    "FontPakP.OBJ"             '... SHAREWARE users
  13.  
  14. ''$Link    "Video.OBJ"                '... REGISTERED users
  15. ''$Link    "Fonts.OBJ"                '... REGISTERED users
  16.  
  17. '======================================================== PowerBasic Users
  18.  
  19. '============================================================ DemoFnt1.Bas
  20. '
  21. ' A Font Pak Demonstration         Copyright 1991-1994 Rob W. Smetana
  22. '
  23. ' Demonstrates how to:  - CALL fonts to load them (e.g., Call OldEng(Block) ).
  24. '                       - Use rsWhichFonts to "activate" 1 -or- 2 fonts.
  25. '                       - Use color intensity to select which font(s) appear.
  26. '
  27. ' Requires:  - EGA/VGA, we'll check below
  28. '
  29. '            - Font_Pak.LIB (QB/PDS/VB-DOS) -or- Font_Pak.PBU (PowerBasic)
  30. '
  31. '============================================================ DemoFnt1.Bas
  32.  
  33. DECLARE SUB Demo.CALLing.Fonts ()
  34.  
  35. DECLARE SUB Script1 (BYVAL Block)    '...Declare "callable fonts"
  36. DECLARE SUB Hollow9 (BYVAL Block)    '   NOTE:  Pass BlockNumber BYVAL!!!
  37. DECLARE SUB Frazzle (BYVAL Block)
  38.  
  39. '============================================================
  40. 'GetMonitor returns an integer (0 - 8) indicating the type of
  41. 'monitor in use.  If two monitors are being used, GetMonitor
  42. 'returns the type of the primary monitor.
  43. '
  44. '   0 = None (no monitor)    1 = Monochrome
  45. '   3 = Color (CGA)          4 = EGA (or MultiSync)
  46. '   7 = VGA Monochrome       8 = VGA Color (or MultiSync)
  47. '============================================================
  48.  
  49. COLOR 7, 1: CLS
  50.  
  51. CALL fpInitialize               '=== SHAREWARE versions ONLY
  52.  
  53. SCREEN , 0                      '...this helps ensure QB/QBX/VBDOS restore
  54.                                 '   the default font (note the comma)
  55.  
  56. SELECT CASE GetMonitor
  57.  
  58.     CASE 4, 7, 8                '...we're okay; it's EGA, VGA or compatible
  59.  
  60.     CASE ELSE
  61.         CLS
  62.         PRINT "Sorry, this demo requires an EGA or VGA monitor."
  63.         END
  64. END SELECT
  65.  
  66.  
  67. CALL Demo.CALLing.Fonts
  68.  
  69. PRINT
  70. PRINT "NOTE:  Here we CALLed fonts that we converted to OBJ files (using Font2Asm)."
  71. PRINT
  72. PRINT "       Loading fonts from DISK is almost as easy.  We'd just:"
  73. PRINT
  74. PRINT "         Declare Function LoadFontFile (FontFile$, Block)"
  75. PRINT
  76. PRINT "         ErrorCode = LoadFontFile (Font1$, Block1)"
  77. PRINT
  78. PRINT
  79. PRINT "         If ErrorCode = 0 then               '...if no error, select it"
  80. PRINT "            Call rsWhichFonts(Block1, Block1)"
  81. PRINT "         Else ...                            '...otherwise handle error"
  82. PRINT "         End If"
  83. PRINT : PRINT
  84.  
  85. END
  86.  
  87. '
  88. SUB Demo.CALLing.Fonts
  89.  
  90. PressAKey$ = "Press a key to continue . . ."
  91. WhichFont$ = "                                    "   '=== to describe font(s)
  92.  
  93.  
  94. '=== Pre-load blocks 1-3.  If we DON'T do this, the line-draw
  95. '    characters will VANISH when we switch to blocks 1-3 exclusively.
  96. '    To see what I mean, comment out the 3 Call rsLoadDefault... lines,
  97. '    and add a SCREEN 9: SCREEN 0 here.
  98.  
  99.  
  100. '=== If VGA load 8x16; otherwise load 8x14.
  101.  
  102. IF GetMonitor > 6 THEN FontSize = 16 ELSE FontSize = 14
  103.  
  104. '=== Try 8x8 and notice the GAPS between vertical lines.
  105.  
  106.      'FontSize = 8
  107.  
  108. CALL rsLoadDefault(FontSize, 1)    '...Once you load these blocks, they'll
  109. CALL rsLoadDefault(FontSize, 2)    '   stay loaded (unless you switch screen modes).
  110. CALL rsLoadDefault(FontSize, 3)
  111.  
  112.  
  113. '=== 1st, load three fonts into blocks 1 - 3
  114.  
  115.     Script = 1                  '...We'll load fonts into blocks 1-3.
  116.     Hollow = 2                  '   The leaves the default font intact
  117. FrazzleLin = 3                  '   and available in block 0.
  118.  
  119. CALL Script1(Script)            '...Notice nothing will happen by just
  120. CALL Hollow9(Hollow)            '   loading fonts (unless we re-map block 0).
  121. CALL Frazzle(FrazzleLin)        '...Below we'll CALL rsWhichFonts to
  122.                                 '   "activate" 1 or 2 fonts.
  123.  
  124. COLOR 7, 1
  125.  
  126. '=========================================== Part 1:   Show 1 font at a time
  127.  
  128. CLS
  129. PRINT TAB(37); "Font Demo":
  130.  
  131. PRINT "          Here's how easy it is to change fonts by CALLing [font name]."
  132.  
  133. '========================
  134.  
  135. LOCATE 4, 1
  136.  
  137. GOSUB DisplayDemo                           '===== 1st, display some text
  138. LSET WhichFont$ = "This is your normal text font."
  139.     GOSUB PauseForKey
  140.  
  141.                                             '===== 2nd, "activate" fonts
  142.  
  143. LSET WhichFont$ = "Normal -- with frazzled lines!"
  144.     CALL rsWhichFonts(FrazzleLin, FrazzleLin)   '===== "Activate" Frazzle exclusively
  145.     GOSUB PauseForKey
  146.  
  147. LSET WhichFont$ = "CALL Hollow9 -- our Hollow Font."
  148.     CALL rsWhichFonts(Hollow, Hollow)       '===== "Activate" Hollow exclusively
  149.     GOSUB PauseForKey
  150.  
  151. LSET WhichFont$ = "CALL SCRIPT1 -- our Script Font."
  152.     CALL rsWhichFonts(Script, Script)       '===== "Activate" Script exclusively
  153.     GOSUB PauseForKey
  154.  
  155.  
  156. '============================================ Part 2:  Show 2 fonts at once
  157.  
  158. CLS
  159.  
  160. GOSUB DisplayDemo                           '===== 1st, display some text
  161. PRINT
  162. COLOR 0, 7
  163. PRINT " This shows 2 fonts at once.  Look at the code later to see how simple this is. "
  164. PRINT
  165. COLOR 11, 1
  166. GOSUB DisplayDemo                           '===== 2nd, display some in bright
  167.  
  168. CALL rsWhichFonts(0, 0)                     '===== "activate" the default font
  169.  
  170. LSET WhichFont$ = "The default text font again."
  171.     GOSUB PauseForKey
  172.  
  173.  
  174. LSET WhichFont$ = "Frazzle and Script"
  175.     CALL rsWhichFonts(FrazzleLin, Script)   '===== "Activate" two fonts
  176.     GOSUB PauseForKey
  177.  
  178. LSET WhichFont$ = "Hollow and Frazzle"
  179.     CALL rsWhichFonts(Hollow, FrazzleLin)
  180.     GOSUB PauseForKey
  181.  
  182. LSET WhichFont$ = "Script and Hollow"
  183.     CALL rsWhichFonts(Script, Hollow)
  184.     GOSUB PauseForKey
  185.  
  186. LSET WhichFont$ = "The same, but with a palette change."
  187.     CALL DefaultPalette(2)               '===== 2 = bright, 1 = low intensity
  188.     GOSUB PauseForKey
  189.  
  190. CALL rsWhichFonts(0, 0)                  '===== back to the default
  191. CALL DefaultPalette(0)                   '      palette also
  192.  
  193. CLS
  194.  
  195. EXIT SUB
  196.  
  197.  
  198. '========================
  199. PauseForKey:
  200. '========================
  201.  
  202. LOCATE 25, 5: PRINT WhichFont$;
  203. LOCATE , 47: PRINT PressAKey$;
  204.  
  205. d$ = INPUT$(1)
  206.  
  207. RETURN
  208.  
  209. '========================
  210. DisplayDemo:
  211. '========================
  212.  
  213. d$ = "  "           '=== used to easily adjust shift printing left/right
  214.  
  215. PRINT d$; "┌─░░░░░░░░░▒▒▒▒▒▒▒▒▒▒▒▓▓▓▓▓▓▓▓▓▓▓ FONT DEMO ▓▓▓▓▓▓▓▓▓▓▓▒▒▒▒▒▒▒▒▒▒▒░░░░░░░░─┐"
  216. PRINT d$; "│ We are NOT displaying different screens!  We'll display this once. Then, │"
  217. PRINT d$; "│ as we ACTIVATE different fonts, the appearance changes.  Fonts remain in │"
  218. PRINT d$; "│ effect until we activate another or until a program changes screen modes.│"
  219. PRINT d$; "│ ┌───┬─────────┐    ╔═══╦═════════╗    ╒═══╤═════════╕    ╓───╥────────╖  │"
  220. PRINT d$; "│ │   ├─────────┼─   ║   ╠═════════╬═   │   ╞═════════╪═   ║   ╟────────╫─ │
  221. PRINT d$; "│ └───┴─────────┘    ╚═══╩═════════╝    ╘═══╧═════════╛    ╙───╨────────╜  │"
  222. PRINT d$; "│     ABCDEFGHIJKLMNOPQRSTUVWXYZ          abcdefghijklmnopqrstuvwxyz       │"
  223. PRINT d$; "│ 1234567890 -=!@#$%^&*()_+[] {};'<>?,./\|~`ÇüéâäàåçêëèïîìÄÅÉæÆôöòûùÿÖÜ¢£¥ │"
  224. PRINT d$; "└──────────────────────────────────────────────────────────────────────────┘"
  225.  
  226. RETURN
  227.  
  228.  
  229. END SUB
  230.  
  231.