home *** CD-ROM | disk | FTP | other *** search
/ Boston 2 / boston-2.iso / DOS / PROGRAM / BASIC / POWBASIC / LIBRARY4 / APLIB.ZIP / INIT-U.BAS < prev    next >
BASIC Source File  |  1990-08-18  |  6KB  |  185 lines
  1.  
  2. '                      ╔════════════════════════════╗
  3. '                      ║                            ║
  4. '                      ║         INIT_U.BAS         ║
  5. '                      ║                            ║
  6. '                      ║ HB's AP LIBRARY INITIALIZE ║
  7. '                      ║                            ║
  8. '                      ╚════════════════════════════╝
  9.  
  10.  
  11.                             $COMPILE UNIT
  12.                             $ERROR ALL OFF
  13.  
  14.  %False = 0
  15.  %True = NOT %False
  16.  
  17.  DEFINT A-Z
  18.  
  19.  EXTERNAL RD$, VideoSeg&, ColorDisplay, NeedDCon, CursorTop, CursorBottom
  20.  EXTERNAL OrigL, OrigC
  21.  EXTERNAL Up2B$, Esc2Q$, F1Help$, F2Fun$, EnHelp$
  22.  EXTERNAL InitPrt$, GraphicsChrSetOn$, GraphicsChrSetOff$, BoldPrtOn$
  23.  EXTERNAL BoldPrtOff$, ItalicPrtOn$, ItalicPrtOff$, RegPrt$, FastPrt$
  24.  EXTERNAL WidePrt$, BigPrtOn$, BigPrtOff$, LQPrt$, DraftPrt$
  25.  EXTERNAL MicroPrtOn$, MicroPrtOff$, ElitePrt$, PicaPrt$, ReverseLF$
  26.  
  27.  
  28.  DECLARE SUB SCREENPUSH ()
  29.  DECLARE FUNCTION GetYesOrNo ()
  30.  DECLARE FUNCTION IsRodent ()
  31.  
  32. SUB Initialize (PrinterType) PUBLIC
  33.  
  34.  %Star10X  = 1: %StarNX1000  = 2: %IBMX24  = 3: %LQ2500 = 4 ' Printer constants
  35.  
  36.  LOCAL VideoSegError
  37.  
  38.  Up2B$ = " ["+CHR$(24)+"] to back up "
  39.  Esc2Q$ = " [ESC] to Quit "
  40.  F1Help$ = " [F1] for Help "
  41.  F2Fun$ = " [F2] for Search/Save/Clear/etc. "
  42.  EnHelp$ = "  Keys: ["+CHR$(26)+"] & ["+CHR$(27)+"], [HOME]"+_
  43.                 " & [END], [INS] & [DELETE], ^T & ^Y. To go on: ["+CHR$(25)+"]"
  44.  
  45.  IF PrinterType = %Star10X THEN
  46.  
  47. '            <<<  PRINTER CODES FOR STAR GEMINI 10X  >>>
  48.  
  49.  InitPrt$ = CHR$(27) + "F" + CHR$(27) + "P" + CHR$(27) + "W0" + CHR$ (18)
  50.  BoldPrtOn$ = CHR$(27) + "G"
  51.  BoldPrtOff$ = CHR$(27) + "H"
  52.  MicroPrt$ = CHR$(27) + "F" + CHR$(15)
  53.  ElitePrt$ = CHR$(27)+"B"+CHR$(2)
  54.  ItalicPrtOn$ = CHR$(27) + "4"
  55.  ItalicPrtOff$ = CHR$(27) + "5"
  56.  RegPrt$ = CHR$(27) + "E"
  57.  FastPrt$ = CHR$(18) + CHR$(27) + "F"
  58.  WidePrt$ = CHR$(14)
  59.  
  60.  
  61.  ELSEIF PrinterType = %StarNX1000 THEN
  62.  
  63. '              <<<  PRINTER CODES FOR STAR NX - 1000  >>>
  64.  
  65.  InitPrt$ = CHR$(27) + "@"
  66.  BoldPrtOn$ = CHR$(27) + "G"
  67.  BoldPrtOff$ = CHR$(27) + "H"
  68.  MicroPrt$ = CHR$(15)
  69.  ElitePrt$ = CHR$(27) + "M"
  70.  ItalicPrtOn$ = CHR$(27) + "4"
  71.  ItalicPrtOff$ = CHR$(27) + "5"
  72.  RegPrt$ = CHR$(27) + "E"
  73.  FastPrt$ = CHR$(18) + CHR$(27) + "F"
  74.  WidePrt$ = CHR$(14)
  75.  
  76.  ELSEIF PrinterType = %IBMX24 THEN
  77.  
  78. '    <<<  PRINTER CODES FOR PANASONIC KX-P1124 EMULATING PROPRINTER X24  >>>
  79.  
  80.  InitPrt$ = CHR$(27) + "I" + CHR$(0) + CHR$(27) + "[@" + CHR$(4) + CHR$(0) + _
  81.         CHR$(0) + CHR$(0) + CHR$(17) + CHR$(1) + CHR$(27) + "F" + CHR$(27) + _
  82.            "H" + CHR$(18)
  83.  BoldPrtOn$ = CHR$(27) + "G"
  84.  BoldPrtOff$ = CHR$(27) + "H"
  85.  LQPrt$ = CHR$(27) + "I" + CHR$(2)
  86.  MicroPrt$ = CHR$(27)+"I"+CHR$(16)
  87.  MicroLQPrt$ = CHR$(27)+"I"+CHR$(18)
  88.  ElitePrt$ = CHR$(27) + "I" + CHR$(8)
  89.  EliteLQPrt$ = CHR$(27) + "I" + CHR$(10)
  90.  ItalicPrtOn$ = ""
  91.  ItalicPrtOff$ = ""
  92.  RegPrt$ = CHR$(27) + "E"
  93.  FastPrt$ = CHR$(18) + CHR$(27) + "F"
  94.  WidePrt$ = CHR$(14)
  95.  BigPrt$ = CHR$(27) + "[@" + CHR$(4) + CHR$(0) + CHR$(0) + CHR$(0) + _
  96.                  CHR$(17) + CHR$(1) + CHR$(27) + "G"
  97.  
  98.  ELSEIF PrinterType = %LQ2500 THEN
  99.  
  100. '    <<<  PRINTER CODES FOR PANASONIC KX-P1124 EMULATING LQ-2500  >>>
  101.  
  102.  InitPrt$ = CHR$(27) + "@"
  103.  GraphicsChrSetOn$ = CHR$(27) + "t" + CHR$(1) + CHR$(27) + "6"
  104.  GraphicsChrSetOff$ = CHR$(27) + "t" + CHR$(0)
  105.  BoldPrtOn$ = CHR$(27) + "G"
  106.  BoldPrtOff$ = CHR$(27) + "H"
  107.  ItalicPrtOn$ = CHR$(27) + "4"
  108.  ItalicPrtOff$ = CHR$(27) + "5"
  109.  RegPrt$ = CHR$(27) + "E"
  110.  FastPrt$ = CHR$(18) + CHR$(27) + "F"
  111.  WidePrt$ = CHR$(14)
  112.  BigPrtOn$ = CHR$(27) + "w" + CHR$(1) + CHR$(27) + "W" + CHR$(1)
  113.  BigPrtOff$ = CHR$(27) + "w" + CHR$(0) + CHR$(27) + "W" + CHR$(0)
  114.  
  115.  LQPrt$ = CHR$(27) + "x" + CHR$(1)
  116.  DraftPrt$ = CHR$(27) + "x" + CHR$(0)
  117.  MicroPrtOn$ = CHR$(15) '                        137 chr/ln
  118.  MicroPrtOff$ = CHR$(18)
  119.  ElitePrt$ = CHR$(27) + "M"  '                    96 chr/ln
  120.  PicaPrt$ = CHR$(27) + "P"
  121.  ReverseLF$ = CHR$(27) + "j" + CHR$ (30)
  122.  
  123.  END IF
  124.  
  125. '  GetMonitorType
  126.  
  127.  DEF SEG = &H40
  128.  IF PEEK(&H63)+256*PEEK(&H64)+6 = &H3BA THEN
  129.     ColorDisplay = %False '                      I got this from a .ASM file by
  130.  ELSE                     '                      Mike Mefford -- tho' I don't
  131.     ColorDisplay = %True  '                      speak ASM at all. I just took
  132.  END IF                   '                      the address & byte to check
  133.                           '                      for and it seems to work ...
  134.  
  135. '  CheckVideoAddress
  136.  
  137.  GOSUB SetVideoAddress
  138.  OrigL = CSRLIN: OrigC = CSRLIN
  139.  CALL SCREENPUSH
  140.  GOSUB WriteAndPeek
  141.  IF VideoSegError THEN
  142.    COLOR 3,0: LOCATE 10,10
  143.    PRINT "ERROR READING MONITOR TYPE. IS THIS A COLOR MONITOR?";
  144.    ColorDisplay = GetYesOrNo
  145.    GOSUB SetVideoAddress
  146.    GOSUB WriteAndPeek
  147.    IF VideoSegError THEN
  148.      COLOR 3,0: LOCATE 12,10
  149.      PRINT "UNABLE TO SET ADDRESS OF DISPLAY CORRECTLY FOR THIS MACHINE"
  150.      LOCATE 14, 14: PRINT "SOME DEEP PROBLEM NEEDS CORRECTED. EXITING NOW."
  151.      STOP
  152.    END IF
  153.  END IF
  154.  
  155.  NeedDCon = (IsRodent <> %False)
  156.  
  157.  EXIT SUB
  158. '           ==================================   end of subroutine HBInit
  159.  
  160. SetVideoAddress:
  161.  
  162.  IF ColorDisplay THEN
  163.      VideoSeg& = &HB800: CursorTop = 6: CursorBottom = 7
  164.  ELSE
  165.      VideoSeg& = &HB000: CursorTop = 14: CursorBottom = 15
  166.  END IF
  167.  RETURN
  168.  
  169.  
  170. WriteAndPeek:
  171.  COLOR 0,0: CLS
  172.  PRINT "01234"
  173.  DEF SEG = VideoSeg&
  174.  FOR N = 0 TO 4
  175.     IF VAL(CHR$(PEEK(2*N))) <> N OR PEEK (2*N+1) <> 0 THEN
  176.       VideoSegError = %True
  177.       RETURN
  178.     END IF
  179.  NEXT
  180.  RETURN
  181.  
  182.  END SUB
  183.  
  184.  
  185.