REM Attempt to fix broken font installations which have non-Base0 copies of the REM ROM fonts in !Fonts on disc. ON ERROR ON ERROR OFF: PRINT REPORT$ + " (at line " + STR$ERL + ")": END DIM f$(11) f$() = "Corpus.Bold","Corpus.Bold.Oblique","Corpus.Medium","Corpus.Medium.Oblique","Homerton.Bold","Homerton.Bold.Oblique","Homerton.Medium","Homerton.Medium.Oblique","Trinity.Bold","Trinity.Bold.Italic","Trinity.Medium","Trinity.Medium.Italic" PRINT "FONT INSTALLATION FIX" PRINT PRINT "Checking ROM fonts" PRINT ok% = TRUE FOR f% = 0 TO 11 PROCcheck_rom_font(f$(f%)) NEXT PRINT IF NOT ok% THEN PRINT "One or more of the standard ROM fonts are missing!" PRINT "Please contact the developers stating your RISC OS version." END ENDIF PRINT "Searching for obsolete copies in Boot:Resources.!Fonts" PRINT ok% = TRUE FOR f% = 0 TO 11 PROCcheck_disc_font(f$(f%)) NEXT PRINT IF ok% THEN PRINT "No problems were found." END ENDIF PRINT "One or more obsolete fonts were found in !Fonts." PRINT PRINT "Press Y to move these fonts to a new directory" PRINT "called 'ObsolFonts' and remove them from the" PRINT "font list ('Messages1')," PRINT "or any other key to exit without changes." key$ = GET$ IF INSTR("Yy", key$) = 0 THEN PRINT PRINT "Exiting without changes." END ENDIF PRINT PRINT "Creating 'ObsolFonts' directory - "; SYS"OS_File", 8, ".^.ObsolFonts" PRINT "done" PRINT PRINT "Closing open files - "; SYS"OS_FSControl", 22 PRINT "done" PRINT PRINT "Removing fonts from font list - "; file% = OPENIN ".Resources.!Fonts.Messages1" IF file% THEN new% = OPENOUT ".Resources.!Fonts.Messages_" IF new% = 0 THEN PRINT "Failed to open new font list" END ENDIF WHILE NOT EOF#file% line$ = GET$#file% ok% = TRUE FOR f% = 0 TO 11 IF INSTR(line$, "Font_" + f$(f%) + ":") <> 0 THEN ok% = FALSE NEXT IF ok% THEN BPUT#new%, line$ ENDIF ENDWHILE CLOSE#file% CLOSE#new% SYS"OS_File", 18, ".Resources.!Fonts.Messages_", &fff SYS"XOS_FSControl", 27, ".^.ObsolFonts.Messages1" SYS"OS_FSControl", 25, ".Resources.!Fonts.Messages1", ".^.ObsolFonts.Messages1" SYS"OS_FSControl", 25, ".Resources.!Fonts.Messages_", ".Resources.!Fonts.Messages1" ENDIF PRINT "done" PRINT PRINT "Moving away obsolete fonts" PRINT FOR f% = 0 TO 11 PROCfix_font(f$(f%)) NEXT PRINT PRINT "Finished" PRINT "Please restart your machine for the changes to take effect." END DEF PROCcheck_rom_font(f$) PRINT " "; f$; SYS"OS_File", 17, "Resources:$.Fonts." + f$ + ".Outlines0" TO t1% SYS"OS_File", 17, "Resources:$.Fonts." + f$ + ".IntMetric0" TO t2% IF t1% = 1 AND t2% = 1 THEN PRINT " - ok" ELSE PRINT " - MISSING" ok% = FALSE ENDIF ENDPROC DEF PROCcheck_disc_font(f$) SYS"OS_File", 17, ".Resources.!Fonts." + f$ + ".Outlines" TO t% IF t% <> 0 THEN PRINT " "; f$ ok% = FALSE ENDIF ENDPROC DEF PROCfix_font(f$) SYS"OS_File", 17, ".Resources.!Fonts." + f$ + ".Outlines" TO t% IF t% = 0 THEN ENDPROC PRINT " "; f$; " - "; i% = 0 REPEAT i% = INSTR(f$, ".", i% + 1) IF i% <> 0 THEN SYS"OS_File", 8, ".^.ObsolFonts." + LEFT$(f$, i% - 1) ENDIF UNTIL i% = 0 SYS"OS_File", 8, ".^.ObsolFonts." + f$ SYS"OS_FSControl", 25, ".Resources.!Fonts." + f$ + ".Outlines", ".^.ObsolFonts." + f$ + ".Outlines" SYS"OS_File", 17, ".Resources.!Fonts." + f$ + ".IntMetrics" TO t% IF t% <> 0 THEN SYS"OS_FSControl", 25, ".Resources.!Fonts." + f$ + ".IntMetrics", ".^.ObsolFonts." + f$ + ".IntMetrics" ENDIF PRINT "done" ENDPROC