(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)


(FILECREATED "10-Apr-2024 09:49:11" {WMEDLEY}<lispusers>NSDISPLAYSIZES.;5
 9232   

      :EDIT-BY rmk

      :CHANGES-TO (FNS NSDISPLAYSIZE)

      :PREVIOUS-DATE " 8-Apr-2024 11:48:01" {WMEDLEY}<lispusers>NSDISPLAYSIZES.;4)


(PRETTYCOMPRINT NSDISPLAYSIZESCOMS)

(RPAQQ NSDISPLAYSIZESCOMS

       [(FNS NSDISPLAYSIZE NS\FONTFILENAME NS\FONTFILENAME.OLD PURGENSFONTS)
        (ADDVARS (NSFONTFAMILIES CLASSIC MODERN TERMINAL OPTIMA TITAN))
        (INITVARS (*SMALLSCREEN* (ILESSP SCREENWIDTH 700)))
        [COMS                                                (* ; 

                         "VirtualKeyboard font needs adjusting so that real Classic 12 still appears")

              (FNS VKBD.FIX.FONT)
              (DECLARE%: EVAL@COMPILE DONTCOPY (P (OR (RECLOOK 'KEYBOARDCONFIGURATION)
                                                      (LOADDEF 'KEYBOARDCONFIGURATION 'RECORDS
                                                             'VIRTUALKEYBOARDS]
        (DECLARE%: DONTEVAL@LOAD DOCOPY (P (MOVD? '\FONTFILENAME 'OLD\FONTFILENAME)
                                           (MOVD 'NS\FONTFILENAME '\FONTFILENAME)
                                           (MOVD? '\FONTFILENAME.OLD 'OLD\FONTFILENAME.OLD)
                                           (MOVD 'NS\FONTFILENAME.OLD '\FONTFILENAME.OLD)
                                           (PURGENSFONTS)
                                           (VKBD.FIX.FONT])
(DEFINEQ

(NSDISPLAYSIZE

  [LAMBDA (FAMILY SIZE FACE EXTENSION)
                       (* ; "Edited 10-Apr-2024 09:48 by rmk")


                                                             (* ; "Edited  8-Apr-2024 11:47 by rmk")


                                                             (* ; "Edited 26-Dec-2023 21:15 by rmk")


                                                             (* ; "Edited 24-Dec-2023 13:49 by rmk")


                                                             (* ; "Edited 14-Sep-96 09:32 by rmk:")

                                                             (* ; "Edited 16-Nov-95 10:08 by ")

                                                             (* ; "Edited  5-Mar-93 18:12 by kaplan")

                                                             (* ; "Edited 15-Jan-87 15:22 by bvm:")


    (* ;; "What we really want for small NS font sizes (12 or below) is the next larger existing font, not a built-in knowledge here of what exists.")


    (* ;; "Returns size that we would prefer to see the font of requested family, size, face, extension.  Used to make bigger ns display fonts than you would get by default.  Don't do it for small screens, as on DOS and laptops.")


    (if
 (NOT (FIXP SIZE))
        then
                                                 (* ; "Could be *")

             SIZE
      elseif
 (AND (CL:MEMBER EXTENSION DISPLAYFONTEXTENSIONS :TEST 'STRING-EQUAL)
                  (COND
                     (*SMALLSCREEN* (CL:UNLESS (CL:MEMBER FAMILY NSFONTFAMILIES :TEST 'STRING-EQUAL)
                                                             (* ; 

                                                             " Small screen, shrink non-NS fonts ")

                                        (SELECTQ SIZE
                                            (12 10)
                                            (10 8)
                                            (8 6)
                                            NIL)))
                     ((CL:MEMBER FAMILY NSFONTFAMILIES :TEST 'STRING-EQUAL)
                                                             (* ; "Large screen, enlarge  NS fonts")

                      (SELECTQ (U-CASE (MKATOM FAMILY))
                          (TERMINAL                          (* ; "14 doesn't exist, oh well.")

                                    (CL:IF (ILEQ SIZE 10)
                                        (IPLUS SIZE 2)
                                        SIZE))
                          (TITAN (SELECTQ SIZE
                                     (6 9)
                                     (9 10)
                                     (10 12)
                                     (CL:IF (ILESSP SIZE 6)
                                         6
                                         SIZE)))
                          (CL:IF (ILEQ SIZE 12)
                              (IPLUS SIZE 2)
                              SIZE)))
                     ((AND NIL (CL:MEMBER EXTENSION INTERPRESSFONTEXTENSIONS :TEST 'STRING-EQUAL)
                           (STRING-EQUAL FAMILY 'SYMBOL))    (* ; 

                            "Fake NS size on Interpress printing, even tho display fonts don't exist")

                      10)))
      else
 SIZE])

(NS\FONTFILENAME

  [LAMBDA (FAMILY SIZE FACE EXTENSION CHARACTERSET)          (* ; "Edited 15-Jan-87 15:23 by bvm:")

    (OLD\FONTFILENAME FAMILY (NSDISPLAYSIZE
 FAMILY SIZE FACE EXTENSION)
           FACE EXTENSION CHARACTERSET])

(NS\FONTFILENAME.OLD

  [LAMBDA (FAMILY SIZE FACE EXTENSION CHARACTERSET)          (* ; "Edited 15-Jan-87 15:29 by bvm:")

    (OLD\FONTFILENAME.OLD FAMILY (NSDISPLAYSIZE
 FAMILY SIZE FACE EXTENSION)
           FACE EXTENSION CHARACTERSET])

(PURGENSFONTS

  [LAMBDA (TYPES)
                                        (* ; "Edited 14-Sep-96 09:27 by rmk:")

                                                             (* ; "Edited 14-Dec-87 14:53 by bvm:")

    (/SETTOPVAL
     '\FONTSINCORE
     (FOR
 ENTRY IN
 \FONTSINCORE BIND
 BADTYPES TMP
        COLLECT

        (SETQ BADTYPES (IF
 (AND (MEMB (CAR ENTRY)
                                          NSFONTFAMILIES)
                                    (OR (NULL TYPES)
                                        (EQMEMB 'NS TYPES)))
                           THEN
 (CONS 'DISPLAY TYPES)
                         ELSE
 (MKLIST TYPES)))
        (CONS
         (CAR ENTRY)
         (FOR
 SIZES IN
 (CDR ENTRY)
            WHEN
 [SETQ TMP
                      (IF
 (AND (NULL TYPES)
                                   (> (CAR SIZES)
                                      12))
                          THEN
                           (* ; 

                                                    "Only have to get rid of sizes smaller than 14")

                                (CDR SIZES)
                        ELSE
 (FOR
 FACE IN
 (CDR SIZES)
                                    WHEN
 (SETQ TMP
                                              (FOR
 ROT IN
 (CDR FACE)
                                                 WHEN
 (SETQ TMP (FOR
 DEV
                                                                       IN
 (CDR ROT) COLLECT

                                                                                        DEV
                                                                       UNLESS
 (MEMB (CAR DEV)
                                                                                        BADTYPES)))
                                                 COLLECT
 (CONS (CAR ROT)
                                                                   TMP)))
                                    COLLECT
 (CONS (CAR FACE)
                                                      TMP] COLLECT
 (CONS (CAR SIZES)
                                                                             TMP])
)

(ADDTOVAR NSFONTFAMILIES
 CLASSIC MODERN TERMINAL OPTIMA TITAN)

(RPAQ? *SMALLSCREEN*
 (ILESSP SCREENWIDTH 700))



(* ; "VirtualKeyboard font needs adjusting so that real Classic 12 still appears")


(DEFINEQ

(VKBD.FIX.FONT

  [LAMBDA (NEWFONT)
                                      (* ; "Edited  9-Mar-93 14:03 by rmk:")

                                                             (* ; "Edited  1-Jul-88 16:55 by bvm")


    (* ;; "Change the VirtualKeyboard's configuration definitions to use NEWFONT (default Classic 10).  The original font is Classic 12, but with NSDISPLAYSIZES loaded, that coerces to Classic 14, so we have to fool it by setting it back a notch.")


    [SETQ DEFAULTKEYBOARDDISPLAYFONT (OR NEWFONT (SETQ NEWFONT '(CLASSIC 10]
    (for
 X in
 (LISTP (EVALV 'VKBD.CONFIGURATIONS)) do
 (replace
 (KEYBOARDCONFIGURATION
                                                                                KEYBOARDDISPLAYFONT)
                                                                     of
 X with
 
                                                                           DEFAULTKEYBOARDDISPLAYFONT
                                                                         ])
)
(DECLARE%: EVAL@COMPILE DONTCOPY 

(OR (RECLOOK 'KEYBOARDCONFIGURATION)
    (LOADDEF 'KEYBOARDCONFIGURATION 'RECORDS 'VIRTUALKEYBOARDS))
)
(DECLARE%: DONTEVAL@LOAD DOCOPY 

(MOVD? '\FONTFILENAME 'OLD\FONTFILENAME)

(MOVD 'NS\FONTFILENAME '\FONTFILENAME)

(MOVD? '\FONTFILENAME.OLD 'OLD\FONTFILENAME.OLD)

(MOVD 'NS\FONTFILENAME.OLD '\FONTFILENAME.OLD)

(PURGENSFONTS
)

(VKBD.FIX.FONT
)
)
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (1522 7564 (NSDISPLAYSIZE 1532 . 4862) (NS\FONTFILENAME 4864 . 5105) (
NS\FONTFILENAME.OLD 5107 . 5356) (PURGENSFONTS 5358 . 7562)) (7776 8814 (VKBD.FIX.FONT 7786 . 8812))))
)
STOP