'
' Utility to change the font numbers of all files
' matching specified template.  Prompts for each file
'
' Written by Keith Baines in HiSoft Basic.
' January 1990
'
'

DEFINT A-Z
LIBRARY "GEMDOS"

DIM SHARED DTA(21)			' Buffer for fsfirst/fsnext calls

CONST TRUE=-1
CONST FALSE=0

BANNER

CommandParse

GetFont FontPath$,FontName$
NewNum=VAL(FNGetToken$(1))

IF FontName$="" THEN
   Usage
   GetKey
   STOP -1
END IF

IF NewNum=0 THEN
   IF FNGetToken$(1)<>"" THEN
      PRINT "Invalid Font Number: ";FNGetToken$(1)
      PRINT
   END IF
   Usage
   GetKey
   STOP -1
END IF

CALL Init_DTA
Get_Files FontPath$+FontName$

IF Num_Files<=0 THEN
   PRINT "No matching files"
   Usage
ELSE
   Renumber_Files FontPath$,NewNum
END IF
Reset_DTA
GetKey
STOP -1




SUB BANNER
   PRINT " FONT_NUM  --  a PD utility by Keith Baines  --  January 1990"
END SUB

'
' Display usage message
'

Sub Usage
   PRINT
   PRINT " USAGE:     FONT_NUM  <Template>  <Number>"
   PRINT
   PRINT " EXAMPLE:   FONT_NUM  B:\GDOS.SYS\ATSS*.FNT  3"
   PRINT
END SUB


'
' Wait for a key press
'
SUB GetKey
   PRINT " === Press any key  ===";
   WHILE INKEY$="":WEND
END SUB



'
' Set internal buffer for fsfirst/fsnext calls
'
SUB Init_DTA
   SHARED Old_DTA&,Our_DTA&
   Old_Dta&=FNfgetdta&
   Our_DTA&=VARPTR(DTA(0))
   fsetdta Our_DTA&
END SUB

'
' Restore original GEMDOS DTA buffer
'
SUB Reset_DTA
   SHARED Old_DTA&
   fsetdta Old_DTA&
END SUB


'
' Get path and template for fonts from command line
'
SUB GetFont(P$,N$)
   LOCAL T$,L

   T$=FNGetToken$(0)
   L=LEN(T$)

   IF L=0 THEN
      P$=""
      N$=""
      EXIT SUB
   END IF

   DO UNTIL INSTR("\:",MID$(T$,L,1))
      DECR L
   LOOP WHILE L>0
   
   N$=MID$(T$,L+1)
   IF L>0 THEN
      P$=LEFT$(T$,L)
   ELSE
      P$=""
   END IF
END SUB


'
' Get a command line token
'
DEF FNGetToken$(I)
   SHARED C__Tokens$(),N__Tokens
   IF I>N__Tokens THEN
      FNGetToken$=""
   ELSE
      FNGetToken$=C__Tokens$(I)
   END IF
END DEF


'
' Split command line into blank and comma separated tokens
'
SUB CommandParse
   SHARED C__Tokens$(),N__Tokens
   LOCAL I,L,C$
   DIM C__Tokens$(10)
   
   L=LEN(COMMAND$)

   I=0
   N__Tokens=0
   C__Tokens$(0)=""
   
   FOR I=1 TO L
      C$=MID$(COMMAND$,I,1)
      IF C$="," THEN
         INCR N__Tokens
         C__Tokens$(N__Tokens)=""
      ELSEIF C$=" " THEN
         IF C__Tokens$(N__Tokens)<>"" THEN
            INCR N__Tokens
            C__Tokens$(N__Tokens)=""
         END IF
      ELSE
         C__Tokens$(N__Tokens)=C__Tokens$(N__Tokens)+C$
      END IF
      IF N__Tokens=10 THEN EXIT FOR
   NEXT I
   
END SUB
         
   
'
' Find all files matching Template$
'
SUB Get_Files(Template$)
   SHARED Num_Files,Max_Files,Files$()
   LOCAL RC

   Max_Files=100
   Num_Files=0
   DIM Files$(Max_Files)

   RC=FNfsfirst(Template$,0)
   DO WHILE RC=0
      Files$(Num_Files)=FNGetName$
      INCR Num_Files
      IF Num_Files>Max_Files THEN
         Max_Files=Max_Files+100
         REDIM APPEND Files$(Max_Files)
      END IF
      RC=FNfsnext
   LOOP
END SUB


'
' Get file name from the DTA
'
DEF FNGetName$
   SHARED Our_DTA&
   LOCAL N$,P&,I,B
   P&=Our_DTA&+30
   N$=""
   FOR I=1 TO 14
      B=PEEKB(P&)
      IF B=0 THEN EXIT FOR
      N$=N$+CHR$(B)
      INCR P&
   NEXT I
   FNGetName$=N$
END DEF


'
' Change the font file font numbers
'

SUB Renumber_Files(P$,NN)
   SHARED Num_Files,Files$()
   LOCAL I,C$,NN$,L
   
   L=LEN(P$)+16

   NN$=MKI$(NN)
   NN$=RIGHT$(NN$,1)+LEFT$(NN$,1)

   FOR I=0 TO Num_Files-1
      OPEN P$+Files$(I) FOR RANDOM AS #1 LEN=2
      FIELD #1,2 AS C$
      GET #1,1
      IF EOF(1) THEN
         PRINT " ";P$+Files$(I);": Empty File!"
      ELSE
         PRINT " ";P$+Files$(I);
         PRINT TAB(L) "(";FNIntel(C$);")  ";
         IF FNGetAnswer("Change to"+STR$(NN)) THEN
            MID$(C$,1,2)=NN$
            PUT #1,1
         END IF
      END IF
      CLOSE #1
   NEXT I
END SUB


'
' Get yes/no answer to question P$
'
DEF FNGetAnswer(P$)
   LOCAL K$
   PRINT P$;" ?  [Y/N]";
   LOCATE ,,1
   DO
      K$=UCASE$(INKEY$)
   LOOP UNTIL (K$="Y") OR (K$="N")
   LOCATE ,,0
   PRINT STRING$(5,CHR$(8));CHR$(27)+"K";K$
   FNGetAnswer = (K$="Y")
END DEF

      
'
' Swap bytes of an integer
'
DEF FNIntel(C$)
   IF LEN(C$)<>2 THEN
      FNIntel=-1
   ELSE
      FNIntel=CVI(RIGHT$(C$,1)+LEFT$(C$,1))
   END IF
END DEF