home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / FNTPAK32.ZIP / BASIC.EXE / DEMO_LIN.BAS < prev    next >
BASIC Source File  |  1995-08-16  |  5KB  |  118 lines
  1. '************************************************************ Demo_Lin.Bas
  2. '    Demo_Lin.Pas                Copyright 1994, Rob W. Smetana
  3. '
  4. '    Font Pak demo program which shows how to:
  5. '
  6. '      1.  Use SetMaxLines (...) to switch to 12 - 100 lines on
  7. '          the screen -- in TEXT mode!
  8. '
  9. '      2.  Load a Font Pak font (from 4 to 24 points) to finish the job.
  10. '
  11. '      3.  Using a local sub-routine (PrintIt) as an interface to
  12. '          our assembler WriteChar routine.
  13. '
  14. '    Requires:
  15. '      a.  A callable Font Pak font (e.g., Tiny04.F06)
  16. '      b.  Procedures in Video.Obj (SetmaxLines, WriteChar, etc.)
  17. '      c.  Procedures in Fonts.Obj
  18. '
  19. '************************************************************ Demo_Lin.Bas
  20.    DEFINT A-Z
  21.  
  22.    '$INCLUDE: 'Font_Pak.Inc'    '... for Microsoft BASICS
  23.  
  24. '======================================================== PowerBASIC Users
  25. ''$INCLUDE "Font_Pak.Inc"       '... PB users, UN-REM these ines
  26.  
  27. ''$Link    "Tiny04.OBJ"         '... ALL users:  A tiny callable font
  28.  
  29. ''$Link    "FontPakP.OBJ"       '... SHAREWARE users only
  30.  
  31. ''$Link    "Fonts.OBJ"          '... REGISTERED users only
  32. ''$Link    "Video.OBJ"
  33.  
  34. '======================================================== PowerBASIC Users
  35.  
  36.    DECLARE SUB TINY04 (BYVAL Block%)     '... declare a "callable font"
  37.  
  38.    COLOR 7, 0: CLS
  39.    CALL FPInitialize: CLS                '... for shareware versions only
  40.  
  41.    SELECT CASE GetMonitor
  42.       CASE 7, 8:  MaxLines = 50          '... VGA
  43.       CASE 4:     MaxLines = 43          '... EGA
  44.       CASE ELSE:  PRINT "Sorry, an EGA or VGA monitor is required.": END
  45.    END SELECT
  46.  
  47.    WIDTH , MaxLines                      '... assuming a SMALL font, set
  48.                                          '    up for maximum # of lines
  49.                                          '    But ALWAYS change screen-modes
  50.                                          '    BEFORE calling SetMaxLines!
  51.  
  52.    ThisLine$ = " This is line #:      Press a key ..." ' fill the blanks later
  53.  
  54.    FontHeight = 6                        '...tiny04 is a 4-point font
  55.                                          '   in 6x8 grid
  56.    Numlines = SETMAXLINES(BYVAL FontHeight)
  57.    CALL TINY04(BYVAL 100)                  '... re-map block 0 -- the default
  58.  
  59.    COLOR 0, 7: LOCATE 1, 14
  60.    PRINT " Using font Tiny04, we can get"; Numlines; "lines on the screen! ";
  61.  
  62.    FOR Row = 3 TO Numlines
  63.        MID$(ThisLine$, 18, 3) = LTRIM$(STR$(Row))
  64.        GOSUB PrintIt                     '...use a local interface to
  65.    NEXT                                  '   WriteChar (see notes below)
  66.  
  67.    d$ = INPUT$(1)                        '... pause
  68.    WIDTH , 25                            '... restore some normalcy
  69.  
  70. '=== IF you have a VGA, this uses the default 8x14 to get 28 lines!!!
  71.  
  72.    IF GetMonitor > 6 THEN
  73.  
  74.        WIDTH , MaxLines
  75.        FontHeight = 14                       '...the default 8x14
  76.        Numlines = SETMAXLINES(BYVAL FontHeight)
  77.        CALL rsLoadDefault(FontHeight, 100)   '... re-map block 0 -- the default
  78.  
  79.        COLOR 0, 7: LOCATE 1, 8
  80.        PRINT " On VGA monitors, we can get"; Numlines; "lines using the default 8x14 font! ";
  81.  
  82.        FOR Row = 3 TO Numlines
  83.            MID$(ThisLine$, 18, 3) = LTRIM$(STR$(Row)) + "  "
  84.            GOSUB PrintIt                     '...use a local interface to
  85.        NEXT                                  '   WriteChar (see notes below)
  86.  
  87.        d$ = INPUT$(1)                        '... pause
  88.        WIDTH , 25                            '... restore some normalcy
  89.    END IF
  90.  
  91. END
  92.  
  93. '======================================================================
  94. PrintIt:
  95.  
  96. 'NOTE:  This is a simple interface to our WriteChar assembler routine.
  97. '       If you plan to use WriteChar, I suggest you put these few lines
  98. '       in : : :  SUB PrintIt (Row%, StartCol%, Colr%, ThisLine$)
  99. '       That way you'll be able to use WriteChar from any program.
  100. '======================================================================
  101.  
  102.     StartCol = 22               '...hard code 2 parameters here
  103.     Colr = 79                   '...79 = white on red
  104.  
  105.     FOR Char = 1 TO LEN(ThisLine$)
  106.         ASCIICode = ASC(MID$(ThisLine$, Char))
  107.         CALL WRITECHAR(Row, StartCol + Char, ASCIICode, Colr)
  108.     NEXT
  109.  
  110. 'ALSO NOTE:  We must print a character at a time -- passing the ASCII
  111. '            code of the character.  If you have an assembler "quick print"
  112. '            routine that's optimized for BASIC, use IT!   WriteChar is
  113. '            admittedly simple -- so we can use it in C, Pascal, and ALL
  114. '            BASICs without having to worry about how strings are passed!
  115.  
  116. RETURN
  117.  
  118.