' $INCLUDE: 'E:\bc7\bin\t90feb\tFONTS\FontScr.BI'

DIM SHARED CS AS CurrentSetUp
DIM SHARED FI AS FontInfo
DIM SHARED Totalfonts AS INTEGER
DIM SHARED CurrentFont AS INTEGER
DIM SHARED CurrentMode AS INTEGER

FUNCTION CalcGPos% (GLine%, GCol%, VPos, HPos)
   VPos = GLine% * FI.PixHeight - FI.PixHeight
   HPos = GCol% * FI.AvgWidth - FI.AvgWidth
   IF VPos > CS.YMax OR VPos < 0 OR HPos > CS.XMax OR HPos < 0 THEN
      CalcGPos% = False
   ELSE
      CalcGPos% = True
   END IF
END FUNCTION

FUNCTION GCentered% (GLine%, Text$)
   GCol% = 1
   Res% = CalcGPos%(GLine%, GCol%, VPos, HPos)
   PPos% = (CS.XMax - GetGTextLen%(Text$)) \ 2
   IF PPos% >= 0 THEN
      PLen% = OutGText%(CSNG(PPos%), VPos, Text$)
   END IF
   GCentered% = PPos%
END FUNCTION

FUNCTION GInput$ (GLine%, GCol%, GLen%)
   GPos% = GCol%

   CR$ = CHR$(13): Tab$ = CHR$(9): Esc$ = CHR$(27)
   TestStr$ = CR$ + Tab$ + Esc$
   CurRefresh% = 300: CurCtr% = 0
   SetCOff% = False: CurOff% = True    'Initialize cursor
   DO
      GOSUB DoCursor
      a$ = INKEY$
      EndChr% = (LEN(a$) * INSTR(TestStr$, a$)) > 0 'Mult then cmp because of instr null match
      IF a$ <> "" AND NOT EndChr% THEN
         SetCOff% = True
         GOSUB DoCursor
         IF a$ = CHR$(8) THEN
            IF LEN(Istr$) > 0 THEN
               Istr$ = LEFT$(Istr$, LEN(Istr$) - 1)
               GPos% = GPos% - 1
               Res% = GSpace(GLine%, GPos%, CS.BGColor%)
            END IF
         ELSE
            SetGTextColor CS.FGColor%
            Istr$ = Istr$ + a$
            Res% = GPLine%(GLine%, GPos%, a$)
            GPos% = GPos% + 1
         END IF
         SetCOff% = False
      END IF
   LOOP UNTIL EndChr% OR LEN(Istr$) = GLen%
   SetCOff% = True
   GOSUB DoCursor
   GInput$ = Istr$
   COLOR CS.FGColor%
   EXIT FUNCTION

DoCursor:

   CurCtr% = CurCtr% + 1
   Refreshing% = CurCtr% > CurRefresh%
   IF (Refreshing% AND NOT CurOff%) OR SetCOff% THEN  'Turn the cursor off
      Res% = CalcGPos%(GLine%, GPos%, VPos, HPos)
      COLOR CS.BGColor
      LINE (HPos, VPos)-(HPos, VPos + FI.PixHeight)
      CurOff% = True
   ELSEIF (Refreshing% AND CurOff%) THEN              'Turn the cursor on
      Res% = CalcGPos%(GLine%, GPos%, VPos, HPos)
      COLOR CS.FGColor
      LINE (HPos, VPos)-(HPos, VPos + FI.PixHeight)
      CurOff% = False
   END IF
   IF Refreshing% THEN CurCtr% = 0
   RETURN
                                                                   
END FUNCTION

FUNCTION GPLine% (GLine%, GCol%, Text$)
   GPLine% = -1
   IF GLine% > CS.NbrLines OR GCol% > CS.NbrCols THEN EXIT FUNCTION
   Res% = CalcGPos%(GLine%, GCol%, VPos, HPos)
   XPPos = HPos + GetGTextLen%(Text$)
   IF XPPos > CS.XMax THEN EXIT FUNCTION
   Res% = OutGText%(HPos, VPos, Text$)
   GPLine% = GCol% + LEN(Text$)
END FUNCTION

FUNCTION GSpace% (GLine%, GCol%, GColor%)
   Res% = CalcGPos%(GLine%, GCol%, VPos, HPos)
   LINE (HPos, VPos)-(HPos + FI.AvgWidth, VPos + FI.PixHeight), GColor%, BF
END FUNCTION

SUB Pause (Msg$)
   CCol% = POS(0)
   CRow% = CSRLIN
   LOCATE 25, 1: PRINT Msg$; : BEEP
   WHILE INKEY$ = "": WEND
   LOCATE 25, 1: PRINT STRING$(79, " ");
   LOCATE CRow%, CCol%
END SUB

SUB PrtFontInfo
   PRINT "Number of Fonts Registered "; CS.NbrReg%
   PRINT "Number of Fonts Loaded "; CS.NbrLoaded%
   FOR I% = 1 TO CS.NbrReg%
      GetRFontInfo I%, FI
      PRINT "  Font number: "; FI.FontNum
      PRINT "       Ascent: "; FI.Ascent
      PRINT "       Points: "; FI.Points
      PRINT "  Pixel Width: "; FI.PixWidth
      PRINT " Pixel Height: "; FI.PixHeight
      PRINT "      Leading: "; FI.Leading
      PRINT "Average Width: "; FI.AvgWidth
      PRINT "Maximum Width: "; FI.MaxWidth
      DspFileName$ = LEFT$(FI.FileName, INSTR(FI.FileName, " ") - 1)
      PRINT "    File Name: "; DspFileName$
      PRINT "    Face Name: "; FI.FaceName
      PRINT " "
      PRINT "Press any key to view the next font specification."
      WHILE INKEY$ = "": WEND
      CLS
   NEXT I%
   Pause "Waiting for keypress..."
END SUB

FUNCTION RegLoadFonts% (FileName$, FontNbr)
   RegLoadFonts% = False      'Initialize status

   SetMaxFonts 10, 10
   X$ = DIR$(FileName$)

   IF X$ = "" THEN
      PRINT "The font file "; FileName$; " can't be found."
      PRINT "Please place the file in the correct directory and restart the program"
      EXIT FUNCTION
   ELSE
      CS.NbrReg% = RegisterFonts(FileName$)
      IF CS.NbrReg% = 0 THEN
         PRINT "Invalid Font File"
         EXIT FUNCTION
      ELSEIF FontErr THEN
         PRINT "Font error #"; FontErr
         EXIT FUNCTION
      END IF
   END IF

   IF FontNbr = 0 THEN     'Load all fonts
      LoadStr$ = LEFT$("N1/N2/N3/N4/N5/N6/N7/N8/N9", CS.NbrReg% * 3 - 1)
   ELSE                    'Load specific fonts
      LoadStr$ = "N" + RIGHT$(STR$(FontNbr), 1)
   END IF

   CS.NbrLoaded% = LoadFont(LoadStr$)
   RegLoadFonts% = True       'Successful
END FUNCTION

SUB ScreenSize (XMax%, YMax%)
   SELECT CASE CurrentMode
      CASE 1: XMax% = 320: YMax% = 200
      CASE 2: XMax% = 640: YMax% = 200
      CASE 3: XMax% = 720: YMax% = 350
      CASE 4: XMax% = 640: YMax% = 400
      CASE 7: XMax% = 320: YMax% = 200
      CASE 8: XMax% = 640: YMax% = 200
      CASE 9: XMax% = 640: YMax% = 350
      CASE 10: XMax% = 640: YMax% = 350
      CASE 11: XMax% = 640: YMax% = 480
      CASE 12: XMax% = 640: YMax% = 480
      CASE 13: XMax% = 320: YMax% = 200
   END SELECT
END SUB

FUNCTION SetFont% (FontNbr AS INTEGER, FontColor AS INTEGER)
   IF FontNbr <> 0 OR FontNbr <= CS.NbrReg THEN
      CurrentFont = FontNbr
      SelectFont CurrentFont
      GetRFontInfo CurrentFont, FI
      CS.NbrLines = CS.YMax \ FI.PixHeight
      CS.NbrCols = CS.XMax \ FI.AvgWidth
      SetGTextColor FontColor
      SetFont% = 0
   ELSE
      SetFont% = 1
   END IF
END FUNCTION

SUB SetScreen (FGColor%, BGColor%, SMode%)
   CurrentMode = SMode%      'Set for EGA/VGA screen mode
   SCREEN CurrentMode
   CALL ScreenSize(CS.XMax, CS.YMax)
   CS.FGColor = FGColor%
   CS.BGColor = BGColor%
   COLOR CS.FGColor, CS.BGColor   'Set screen colors
   CLS
END SUB