diff --git a/lispusers/FONTSAMPLER b/lispusers/FONTSAMPLER
index 3b3b609c..c409c92b 100644
--- a/lispusers/FONTSAMPLER
+++ b/lispusers/FONTSAMPLER
@@ -1,21 +1,26 @@
-(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
-(FILECREATED "29-Apr-87 22:43:49" {ERIS}<LISPUSERS>LYRIC>FONTSAMPLER.;4 7992   
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-      changes to%:  (FNS FontSample)
+(FILECREATED " 2-Feb-2025 22:56:24" {DSK}<home>matt>Interlisp>medley>lispusers>FONTSAMPLER.;2 8799   
 
-      previous date%: "29-Apr-87 22:41:24" {ERIS}<LISPUSERS>KOTO>FONTSAMPLER.;6)
+      :EDIT-BY "mth"
+
+      :CHANGES-TO (FNS FontTable)
+
+      :PREVIOUS-DATE "29-Apr-87 22:43:49" {DSK}<home>matt>Interlisp>medley>lispusers>FONTSAMPLER.;1
+)
 
 
-(* "
-Copyright (c) 1985, 1987 by Xerox Corporation.  All rights reserved.
+(* ; "
+Copyright (c) 1985, 1987, 2025 by Xerox Corporation.
 ")
 
 (PRETTYCOMPRINT FONTSAMPLERCOMS)
 
-(RPAQQ FONTSAMPLERCOMS ((FNS FontSample FontSampleFaked FontTable)
-                        [VARS (*INTERESTING-CHARSETS* '(0 33 34 38 39 238 239 240 241]
-                        (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
-                                                                FONT))))
+(RPAQQ FONTSAMPLERCOMS
+       ((FNS FontSample FontSampleFaked FontTable)
+        [VARS (*INTERESTING-CHARSETS* '(0 33 34 38 39 238 239 240 241]
+        (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
+                                                FONT))))
 (DEFINEQ
 
 (FontSample
@@ -55,94 +60,113 @@ Copyright (c) 1985, 1987 by Xerox Corporation.  All rights reserved.
 
 (FontTable
   [LAMBDA (Font CharacterSet Stream FormFeed TitleFont InchesToPrinterUnits)
+                                                             (* ; "Edited  2-Feb-2025 22:50 by mth")
                                                              (* edited%: "29-Apr-87 22:36")
-    (LET* ((Family (FONTPROP Font 'FAMILY))
-           (Face (FONTPROP Font 'FACE))
-           (Size (FONTPROP Font 'SIZE))
-           (Title (CONCAT " " Size "pt " (L-CASE Family T)
-                         " "
-                         (L-CASE Face T)
-                         " Character set ")))
-          (printout T Title |.I0.8| CharacterSet "Q")
-          (RESETLST (RESETSAVE (RADIX 8))
-                 (for XPosition from (TIMES 0.65 InchesToPrinterUnits) by (TIMES 0.45 
-                                                                                 InchesToPrinterUnits
-                                                                                 ) as Counter
-                    from 0 to 15 bind (YPosition _ (TIMES 9.5 InchesToPrinterUnits))
-                    do (MOVETO XPosition YPosition Stream)
-                       (PRIN1 Counter Stream))
-                 (for YPosition from (TIMES 9 InchesToPrinterUnits) by (TIMES -0.5 
-                                                                              InchesToPrinterUnits)
-                    as Counter from 0 to 240 by 16 bind (XPosition _ (TIMES 0.25 InchesToPrinterUnits
-                                                                            ))
-                    do (MOVETO XPosition YPosition Stream)
-                       (PRIN1 Counter Stream)))
-          (DRAWLINE (TIMES 0.25 InchesToPrinterUnits)
-                 (TIMES 9.25 InchesToPrinterUnits)
-                 (TIMES 8.0 InchesToPrinterUnits)
-                 (TIMES 9.25 InchesToPrinterUnits)
-                 (DSPSCALE NIL Stream)
-                 'PAINT Stream)
-          (DRAWLINE (TIMES 0.6 InchesToPrinterUnits)
-                 (TIMES 9.7 InchesToPrinterUnits)
-                 (TIMES 0.6 InchesToPrinterUnits)
-                 (TIMES 1.25 InchesToPrinterUnits)
-                 (DSPSCALE NIL Stream)
-                 'PAINT Stream)
-          (DSPFONT Font Stream)
-          (for YPosition from (TIMES 9 InchesToPrinterUnits) by (TIMES -0.5 InchesToPrinterUnits)
-             as YCounter from 0 to 15 bind (CharacterCode _ 0)
-             do (for XPosition from (TIMES 0.75 InchesToPrinterUnits) by (TIMES 0.45 
-                                                                                InchesToPrinterUnits)
-                   as XCounter from 0 to 15
-                   do (MOVETO XPosition YPosition Stream)
-                      (if (AND (NEQ CharacterCode (CHARCODE FF))
-                               (if (MEMB (IMAGESTREAMTYPE Stream)
-                                         '(DISPLAY INTERPRESS))
-                                   then (OR (AND (IGREATERP CharacterCode 31)
-                                                 (ILESSP CharacterCode 127))
-                                            (AND (IGREATERP CharacterCode 160)
-                                                 (ILESSP CharacterCode 255)))
-                                 else T))
-                          then (PRINTCCODE (IPLUS (ITIMES CharacterSet 256)
-                                                  CharacterCode)
-                                      Stream))
-                      (SETQ CharacterCode (ADD1 CharacterCode)))
-                (printout T "."))
-          (MOVETO (FTIMES 0.75 InchesToPrinterUnits)
-                 (FTIMES 0.75 InchesToPrinterUnits)
-                 Stream)
-          (DSPFONT TitleFont Stream)
-          (printout Stream Title |.I0.8| CharacterSet)
-          (DSPYPOSITION (PLUS (DSPYPOSITION NIL Stream)
-                              (TIMES -0.4 (FONTHEIGHT TitleFont)))
-                 Stream)
-          (printout Stream "8")
-          [if (EQ (FILENAMEFIELD (FULLNAME Stream)
-                         'HOST)
-                  'LPT)
-              then (MOVETO (FTIMES 0.75 InchesToPrinterUnits)
-                          (FTIMES 0.5 InchesToPrinterUnits)
-                          Stream)
-                   (printout Stream " on " (L-CASE (OR (FILENAMEFIELD (FULLNAME Stream)
-                                                              'DEVICE)
-                                                       (FILENAMEFIELD (FULLNAME Stream)
-                                                              'NAME))
-                                                  T)
-                          ", "
-                          (GDATE NIL (DATEFORMAT NO.TIME SPACES]
-          (if FormFeed
-              then (DSPNEWPAGE Stream))
-          (printout T " done." T])
+    (LET*
+     [(Family (FONTPROP Font 'FAMILY))
+      (Face (FONTPROP Font 'FACE))
+      (Size (FONTPROP Font 'SIZE))
+      (Title (CONCAT " " Size "pt " (L-CASE Family T)
+                    " "
+                    (L-CASE Face T)
+                    " Character set "))
+      [UseDisplayFontBitmaps (AND (EQ (FONTPROP Font 'DEVICE)
+                                      'DISPLAY)
+                                  (NOT (EQ (IMAGESTREAMTYPE Stream)
+                                           'DISPLAY]
+      (CharSetInfo (\GETCHARSETINFO CharacterSet Font T))
+      (CharSetAscent (fetch (CHARSETINFO CHARSETASCENT) of CharSetInfo))
+      (CharSetDescent (fetch (CHARSETINFO CHARSETDESCENT) of CharSetInfo))
+      (CharSetRelativeDescent (FQUOTIENT CharSetDescent (IPLUS CharSetAscent CharSetDescent]
+     (printout T Title .I0.8 CharacterSet "Q" T)
+     (RESETLST
+         (RESETSAVE (RADIX 8))
+         (for XPosition from (TIMES 0.65 InchesToPrinterUnits) by (TIMES 0.45 InchesToPrinterUnits)
+            as Counter from 0 to 15 bind (YPosition _ (TIMES 9.5 InchesToPrinterUnits))
+            do (MOVETO XPosition YPosition Stream)
+               (PRIN1 Counter Stream))
+         (for YPosition from (TIMES 9 InchesToPrinterUnits) by (TIMES -0.5 InchesToPrinterUnits)
+            as Counter from 0 to 240 by 16 bind (XPosition _ (TIMES 0.25 InchesToPrinterUnits))
+            do (MOVETO XPosition YPosition Stream)
+               (PRIN1 Counter Stream)))
+     (DRAWLINE (TIMES 0.25 InchesToPrinterUnits)
+            (TIMES 9.25 InchesToPrinterUnits)
+            (TIMES 8.0 InchesToPrinterUnits)
+            (TIMES 9.25 InchesToPrinterUnits)
+            (DSPSCALE NIL Stream)
+            'PAINT Stream)
+     (DRAWLINE (TIMES 0.6 InchesToPrinterUnits)
+            (TIMES 9.7 InchesToPrinterUnits)
+            (TIMES 0.6 InchesToPrinterUnits)
+            (TIMES 1.25 InchesToPrinterUnits)
+            (DSPSCALE NIL Stream)
+            'PAINT Stream)
+     (CL:UNLESS UseDisplayFontBitmaps (DSPFONT Font Stream))
+     (for YPosition from (TIMES 9 InchesToPrinterUnits) by (TIMES -0.5 InchesToPrinterUnits)
+        as YCounter from 0 to 15 bind (CharacterCode _ 0)
+        do
+        (for XPosition from (TIMES 0.75 InchesToPrinterUnits) by (TIMES 0.45 InchesToPrinterUnits)
+           as XCounter from 0 to 15
+           do [LET ((CCode (IPLUS (ITIMES CharacterSet 256)
+                                  CharacterCode)))
+                   (MOVETO XPosition YPosition Stream)
+                   (if UseDisplayFontBitmaps
+                       then (LET* ((Glyph (GETCHARBITMAP CCode Font))
+                                   (ImSize (BITMAPIMAGESIZE Glyph NIL Stream)))
+                                  (BITBLT Glyph 0 0 Stream XPosition (- YPosition (TIMES (CDR ImSize)
+                                                                                         
+                                                                               CharSetRelativeDescent
+                                                                                         ))
+                                         (CAR ImSize)
+                                         (CDR ImSize)
+                                         'INPUT
+                                         'REPLACE))
+                     else (if (AND (NEQ CharacterCode (CHARCODE FF))
+                                   (if (MEMB (IMAGESTREAMTYPE Stream)
+                                             '(DISPLAY INTERPRESS))
+                                       then (OR (AND (IGREATERP CharacterCode 31)
+                                                     (ILESSP CharacterCode 127))
+                                                (AND (IGREATERP CharacterCode 160)
+                                                     (ILESSP CharacterCode 255)))
+                                     else T))
+                              then (PRINTCCODE CCode Stream]
+              (SETQ CharacterCode (ADD1 CharacterCode)))
+        (printout T "."))
+     (MOVETO (FTIMES 0.75 InchesToPrinterUnits)
+            (FTIMES 0.75 InchesToPrinterUnits)
+            Stream)
+     (DSPFONT TitleFont Stream)
+     (printout Stream Title .I0.8 CharacterSet)
+     (DSPYPOSITION (PLUS (DSPYPOSITION NIL Stream)
+                         (TIMES -0.4 (FONTHEIGHT TitleFont)))
+            Stream)
+     (printout Stream "8")
+     [if (EQ (FILENAMEFIELD (FULLNAME Stream)
+                    'HOST)
+             'LPT)
+         then (MOVETO (FTIMES 0.75 InchesToPrinterUnits)
+                     (FTIMES 0.5 InchesToPrinterUnits)
+                     Stream)
+              (printout Stream " on " (L-CASE (OR (FILENAMEFIELD (FULLNAME Stream)
+                                                         'DEVICE)
+                                                  (FILENAMEFIELD (FULLNAME Stream)
+                                                         'NAME))
+                                             T)
+                     ", "
+                     (GDATE NIL (DATEFORMAT NO.TIME SPACES]
+     (if FormFeed
+         then (DSPNEWPAGE Stream))
+     (printout T " done." T])
 )
 
 (RPAQQ *INTERESTING-CHARSETS* (0 33 34 38 39 238 239 240 241))
 (DECLARE%: EVAL@COMPILE DONTCOPY 
+
 (FILESLOAD (LOADCOMP)
        FONT)
 )
-(PUTPROPS FONTSAMPLER COPYRIGHT ("Xerox Corporation" 1985 1987))
+(PUTPROPS FONTSAMPLER COPYRIGHT ("Xerox Corporation" 1985 1987 2025))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (689 7765 (FontSample 699 . 2154) (FontSampleFaked 2156 . 2965) (FontTable 2967 . 7763))
+  (FILEMAP (NIL (706 8566 (FontSample 716 . 2171) (FontSampleFaked 2173 . 2982) (FontTable 2984 . 8564))
 )))
 STOP
diff --git a/lispusers/FONTSAMPLER.LCOM b/lispusers/FONTSAMPLER.LCOM
new file mode 100644
index 00000000..1288e315
Binary files /dev/null and b/lispusers/FONTSAMPLER.LCOM differ
diff --git a/library/FONTSAMPLE b/obsolete/library/IPFONTSAMPLE
similarity index 100%
rename from library/FONTSAMPLE
rename to obsolete/library/IPFONTSAMPLE
diff --git a/library/FONTSAMPLE.LCOM b/obsolete/library/IPFONTSAMPLE.LCOM
similarity index 100%
rename from library/FONTSAMPLE.LCOM
rename to obsolete/library/IPFONTSAMPLE.LCOM
diff --git a/library/FONTSAMPLE.TEDIT b/obsolete/library/IPFONTSAMPLE.TEDIT
similarity index 100%
rename from library/FONTSAMPLE.TEDIT
rename to obsolete/library/IPFONTSAMPLE.TEDIT
