home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / FNTPAK32.ZIP / PASCAL.EXE / DEMOFNT1.PAS < prev    next >
Pascal/Delphi Source File  |  1995-08-16  |  7KB  |  202 lines
  1. {*************************************************************************
  2.  
  3.   DemoFnt1.PAS                          Copyright 1994 Rob W. Smetana
  4.  
  5.   Demonstrate:
  6.      1. Using GetMonitor (in Video.OBJ) to see if we're using EGA/VGA
  7.         Also use it to set FontSize -- to restore the right default font.
  8.  
  9.      2. How to CALL Font Pak fonts (and use font-related procedures).
  10.  
  11.      3. How to get two fonts on the screen at once -- in text mode!
  12.  
  13.      4. Using Font_Pak.Pas to declare all Font Pak routines -- except
  14.         callable OBJ fonts.
  15.  
  16.   NOTE:  You MUST declare all Font Pak procedures -- including callable
  17.          OBJ fonts -- as FAR calls.  You'll crash if you do otherwise!
  18.  
  19.          We'll load 2 fonts plus 1 set of line-draw characters.  Then
  20.          notice how easy it is to switch back and forth between these
  21.          two fonts and the default font.
  22.  
  23.   There are 5 pieces in this demo:
  24.  
  25.     1.  Display some text -- in both Low and High intensity colors.
  26.  
  27.     2.  Pre-load blocks 1 and 2 so we'll have line-draw chars. in each block.
  28.  
  29.     3.  Load 2 fonts into blocks 1 and 2.  Also load custom line-draw
  30.         characters into 1 block.
  31.  
  32.     4.  Demonstrate how to switch fonts (several ways).
  33.  
  34.     5.  Restore the default font, select block 0, and exit.
  35.  
  36. *************************************************************************}
  37.  
  38. uses CRT, Font_Pak;              {use Font_Pak.Pas to declare everything}
  39.  
  40. {$F+}     { IMPORTANT: OBJ fonts (and all our procedures) are FAR calls.}
  41.           { You MUST declare these F+ -- or your programs may crash.    }
  42.  
  43. { declare the CALLable fonts we'll use }
  44.  
  45. procedure Hollow9 (Block: integer); external;
  46.    {$L Hollow9.OBJ}
  47. procedure Script1 (Block: integer); external;
  48.    {$L SCRIPT1.OBJ}
  49. procedure Frazzle (Block: integer); external;
  50.    {$L FRAZZL16.OBJ}
  51.  
  52. {$F-}
  53.  
  54. Var
  55.   Ch:Char;
  56.   HollowBlock, ScriptBlock, Block, FontSize, WhichMonitor: Integer;
  57.  
  58. Procedure Is_it_EGA_or_VGA;
  59. {************************************ Demonstrate GetMonitor          }
  60. {                                     Bail out if not EGA or VGA      }
  61.  
  62. Begin
  63.  
  64.      TextAttr := 23; ClrScr;
  65.  
  66.      fpInitialize; ClrScr;      { useful for shareware versions only }
  67.  
  68.      Write (' GetMonitor reports you have ');
  69.  
  70.      WhichMonitor := GetMonitor;
  71.  
  72.      { bail out if there's no EGA or VGA }
  73.      case WhichMonitor of
  74.           0, 4, 5:              { 0=No monitor, 4 = CGA, 5 = Monochrome }
  75.              Begin
  76.                  ClrScr;
  77.                  WriteLn('     This demo requires an EGA or VGA monitor.  Sorry, I have to end.');
  78.                  halt;
  79.              end;
  80.           3: Begin
  81.                 Write ('an EGA');
  82.                 FontSize := 14;     {restore the 8x14 default font}
  83.              end;
  84.  
  85.         7,8: Begin
  86.                 Write ('a VGA');
  87.                 FontSize := 16;     {restore the 8x16 default font}
  88.              end;
  89.  
  90.      end; {case}
  91.  
  92.      Write (' monitor.   OK to proceed.  Press <SPACE>.');
  93.      Ch := ReadKey;
  94. End;
  95.  
  96.  
  97. Procedure DisplayText;
  98.  
  99. Begin
  100.   { Put some text on screen }
  101.   Writeln('  ┌─░░░░░░░░░▒▒▒▒▒▒▒▒▒▒▒▓▓▓▓▓▓▓▓▓▓▓ FONT DEMO ▓▓▓▓▓▓▓▓▓▓▓▒▒▒▒▒▒▒▒▒▒▒░░░░░░░░─┐ ');
  102.   Writeln(' ░│ We''ll display this once.  Then, as we call different fonts, the appear-  │ ');
  103.   Writeln(' ░│ ance changes.  Note that we''re using partial fonts to re-map just some   │ ');
  104.   Writeln(' ░│ characters.  This lets us load different subsets of fonts, then change   │ ');
  105.   Writeln(' ░│ them whenever we want (without disturbing other subsets).                │ ');
  106.   Writeln(' ░│                                           ╒═══════╕   ╔══╦═══╗    ╓───╖  │ ');
  107.   Writeln(' ░│ ┌──────┼─────┐ ╔══════╦═══════╗     ╒═════╧═════╕ │   ║ ─╫───╫────╜   ║  │ ');
  108.   Writeln(' ░│ └──────┼─────┘ ╚═══════════╬══╝ ║   ╘═════╪═════╛     ║  ╙───╫────────╜  │ ');
  109.   Writeln(' ░│        │                   ╚════╝         ╘═════════  ╙──────╜           │ ');
  110.   Writeln(' ░└──────────────────────────────────────────────────────────────────────────┘ ');
  111.   Writeln(' ░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░   ');
  112.   Writeln('');
  113.  
  114. end;
  115.  
  116.  
  117. begin
  118.  
  119.   Is_it_EGA_or_VGA;             {end if there's no EGA/VGA}
  120.  
  121.   DarkBlue;                     {use a dark blue background}
  122.   ClrScr;
  123.  
  124.   { Put some text on screen }
  125.   TextColor (11);               {1st in a bright foreground color}
  126.   DisplayText;
  127.  
  128.   TextBackground (7);
  129.   TextColor (0);                {then in a normal foreground color}
  130.   DisplayText;
  131.  
  132.   TextAttr := 112;              {to print messages}
  133.  
  134.   {
  135.    Pre-load blocks 1 and 2.  This ensures we have line-draw characters
  136.    in these blocks since the fonts we're loading are "partial" fonts
  137.    with only keyboard characters in them.  Try commenting out the next
  138.    few lines to see what happens if we don't pre-load these blocks.
  139.    Note:  you must comment out the pre-load code BEFORE you run this.
  140.    Otherwise, the 1st time you run this, it'll load blocks 1 & 2.
  141.   }
  142.  
  143.   Block := 1;
  144.   rsLoadDefault (FontSize, Block);
  145.  
  146.   Block := 2;
  147.   rsLoadDefault (FontSize, Block);
  148.  
  149.  
  150.   { Load 2 fonts into blocks 1 and 2, leaving the default Block 0 intact. }
  151.  
  152.   HollowBlock := 1;
  153.   Hollow9 (HollowBlock);
  154.  
  155.   { replace the line-draw characters in 1 block -- only }
  156.   Frazzle (HollowBlock);
  157.  
  158.   ScriptBlock := 2;
  159.   Script1(ScriptBlock);
  160.  
  161.   GotoXY(20,25);  Write('The default font.       Press <SPACE>.');
  162.   Ch:= ReadKey;
  163.  
  164.  
  165.   { Now CHANGE the DISPLAY by selecting 1 or 2 fonts -- by selecting BLOCKS. }
  166.  
  167.  
  168.   GotoXY(20,25);  Write('Script and Hollow');
  169.        rsWhichFonts (HollowBlock, ScriptBlock);   Ch := ReadKey;
  170.  
  171.   GotoXY(20,25);  Write('Hollow and Script');
  172.        rsWhichFonts (ScriptBlock, HollowBlock);  Ch := ReadKey;
  173.  
  174.   GotoXY(20,25);  Write('Script exclusively   ');
  175.       rsWhichFonts (ScriptBlock, ScriptBlock);  Ch := ReadKey;
  176.  
  177.   GotoXY(20,25);  Write('Hollow exclusively   ');
  178.       rsWhichFonts (HollowBlock, HollowBlock);    Ch := ReadKey;
  179.  
  180.   GotoXY(20,25);  Write('The Default and Script');
  181.       HollowBlock := 0; rsWhichFonts (ScriptBlock, HollowBlock);
  182.  
  183.  
  184.   { Pause, then reset font to block 0 exclusively. }
  185.  
  186.  
  187.   Ch := ReadKey;
  188.   
  189.   DefaultPalette (0);           {restore default background colors}
  190.   GotoXY(20,25);  Write('Back to the default   ');
  191.       {
  192.         Load the default font into block 0.  This should NOT be necessary
  193.         because our demo didn't change block 0.  But if YOU edited this
  194.         and re-mapped block 0, this step ensures we end "clean."
  195.       }
  196.       Block := 0;
  197.       rsLoadDefault (FontSize, Block);
  198.       rsWhichFonts (Block, Block);  Ch := ReadKey;
  199.  
  200.  
  201. end.
  202.