(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP")

(FILECREATED "15-Jun-90 12:33:48" |{DSK}<usr>local>lde>lispcore>internal>library>COLORFONTHACK.;2|
 2214   

      |changes| |to:|  (VARS COLORFONTHACKCOMS)

      |previous| |date:| " 6-Dec-88 21:52:32" 
|{DSK}<usr>local>lde>lispcore>internal>library>COLORFONTHACK.;1|)


; Copyright (c) 1990 by Venue.  All rights reserved.

(PRETTYCOMPRINT COLORFONTHACKCOMS)

(RPAQQ COLORFONTHACKCOMS
 ((FNS COLORFONTHACK)))
(DEFINEQ

(COLORFONTHACK

  (LAMBDA NIL
                                            (* \; "Edited  6-Dec-88 21:46 by shih")


    (* |;;| "Run through all the  color fonts, replacing their bitmaps with appropriate ones.")


    (* |;;| "Should be run *after* (COLORDISPLAY 'ON) is called.")


    (* |;;| "")


    (LET (FONTS FONTDESC CSINFO CSBITMAP NEWBM)
         (SETQ FONTS (FONTSAVAILABLE '* '* '* 0 '8DISPLAY))
         (FOR
 FONT IN
 FONTS DO
 (SETQ FONTDESC (FONTCREATE FONT))
                                          (SETQ CSINFO (\\GETCHARSETINFO 0 FONTDESC))
                                          (SETQ CSBITMAP (FETCH
 (CHARSETINFO CHARSETBITMAP)
                                                            OF
 CSINFO))
                                          (IF
 (NEQ 8 (BITSPERPIXEL CSBITMAP))
                                              THEN
 (SETQ NEWBM (BITMAPCREATE (BITMAPWIDTH 
                                                                                        CSBITMAP)
                                                                          (BITMAPHEIGHT CSBITMAP)
                                                                          8)) 

                                                    (* |;;| 

                                          "Bitblt knows how to coerce a 1 bppixel to an 8 bppixel.")


                                                    (BITBLT CSBITMAP NIL NIL NEWBM)
                                                    (REPLACE
 (CHARSETINFO CHARSETBITMAP)
                                                       OF
 CSINFO WITH
 NEWBM))))))
)
(PUTPROPS COLORFONTHACK COPYRIGHT ("Venue" 1990))
(DECLARE\: DONTCOPY
  (FILEMAP (NIL (477 2141 (COLORFONTHACK 487 . 2139)))))
STOP