[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
AST

To: Moon@scrc-stony-brook.arpa
Subject: AST
From: David Vinayak Wallace <GUMBY@mc.lcs.mit.edu>
Date: Wed, 25 Nov 87 00:38:48 EST
Cc: slug@r20.utexas.edu, SINGER@spar-20.spar.slb.com
In-reply-to: Msg of Tue 24 Nov 87 21:32 EST from David A. Moon <Moon at STONY-BROOK.SCRC.Symbolics.COM>
Resent-date: Wed 25 Nov 87 03:02:52-CST
Resent-from: CMP.SLUG@r20.utexas.edu
Resent-message-id: <12353372683.7.CMP.SLUG@R20.UTEXAS.EDU>
Resent-to: SLUG:;
    Date: Tue, 24 Nov 87 21:32 EST
    From: David A. Moon <Moon at STONY-BROOK.SCRC.Symbolics.COM>

        Date: Tue 24 Nov 87 12:56:09-PST
        From: David Singer <SINGER@SPAR-20.SPAR.SLB.COM>
        
        I'm looking for software to convert Mac and/or Sun screen fonts to
        Symbolics screen fonts.

    The formats that the symbolics font editor can read are: BFD, BIN, KST,
    AST, AC, AL, or PXL.  The first two are specific to Symbolics, the third
    is a very simple textual format (bits represented by spaces and asterisks),
    the next three are Xerox formats, and the last is a TEX format.  If you
    have software to convert your MAC and/or SUN fonts into one of these,
    you can probably do it.  PXL looks like a good bet.  Use [Read File]
    and [Write File] in the Font Editor to read in the PXL file and write
    out a BFD file.

    If you have to write the conversion program yourself, KST is the
    easiest.  Use the Font Editor to write out a KST file from an existing
    screen font as a sample and just copy the obvious format.

AST is the text format.  FED's AST support is buggy; you'll need the
patches below.  I think PXL doesn't include the baseline and kerning
info; it's just the raw bits.  AST is just a textual version of KST
("suitable for editing in TECO" says my copy of the XGP font
catalogue) and so includes this info.

I thought KST came from Stanford?

Your friendly neighbourhood computer archaeologist.


;=====================================
(SYSTEM-INTERNALS:BEGIN-PATCH-SECTION)
(SYSTEM-INTERNALS:PATCH-SECTION-SOURCE-FILE "SYS:IO1;BFD.LISP.102")
(SYSTEM-INTERNALS:PATCH-SECTION-ATTRIBUTES
  "-*- Mode:Lisp; Package:FED; Lowercase:T; Base: 8 -*-")

D,#TD1PsT[Begin using 006 escapes](1 0 (NIL 0) (NIL :BOLD NIL) "CPTFONTCB")(cl:defsetf bfd-blinker-height bfd-set-blinker-height)
(cl:defsetf bfd-blinker-width bfd-set-blinker-width)


(2 0 (NIL 0) (NIL NIL NIL) "CPTFONT");=====================================
(SYSTEM-INTERNALS:BEGIN-PATCH-SECTION)
(SYSTEM-INTERNALS:PATCH-SECTION-SOURCE-FILE "SYS:IO1;FNTCNV.LISP.92")
(SYSTEM-INTERNALS:PATCH-SECTION-ATTRIBUTES
  "-*-Mode:LISP; Package:FED; Base:8-*-")


(DEFUN READ-AST-INTO-FONT-DESCRIPTOR (FILENAME &OPTIONAL FONTNAME &AUX FD)
  (MULTIPLE-VALUE (FILENAME FONTNAME)
    (GET-INPUT-FILENAME-AND-FONTNAME FILENAME FONTNAME ':AST))
  (WITH-OPEN-FILE (STREAM FILENAME)
    (SETQ FD (MAKE-FONT-DESCRIPTOR FD-NAME FONTNAME MAKE-ARRAY (:LENGTH #o200)))
    (READ-AST-DN STREAM)			;DISCARD KSTID
    (SETF (FD-LINE-SPACING FD) (READ-AST-DN STREAM))
    (SETF (FD-BASELINE FD) (READ-AST-DN STREAM))
    (READ-AST-DN STREAM)			;COLUMN POSITION ADJUSTMENT
    (SETF (FD-SPACE-WIDTH FD) 0)		;Just in case no space character.
    (SETF (FD-BLINKER-HEIGHT FD)
	  (FD-LINE-SPACING FD))
    (SETF (FD-NAME FD) FONTNAME)
    (LET (KERN CHAR-CODE RASTER-WIDTH INPUT-RASTER-WIDTH CHAR-WIDTH
	  CD CH (LINE-HEIGHT (FD-LINE-SPACING FD)))
      (DO ()
	  ((NULL (READ-AST-NEXT-PAGE STREAM)))
	(SETQ CHAR-CODE (READ-AST-ON STREAM))
	(SETQ INPUT-RASTER-WIDTH (READ-AST-DN STREAM) RASTER-WIDTH INPUT-RASTER-WIDTH)
	(SETQ CHAR-WIDTH (READ-AST-DN STREAM))
	(SETQ KERN (READ-AST-DN STREAM))
	(COND ((< KERN 0)			;FED COMPACT RASTER LOSSAGE
	       (SETQ RASTER-WIDTH (+ RASTER-WIDTH (ABS KERN)))
	       (SETQ KERN 0)))
	(SETQ CD (MAKE-CHAR-DESCRIPTOR
		   MAKE-ARRAY (:TYPE ART-1B :LENGTH (LIST LINE-HEIGHT RASTER-WIDTH))))
	(SETF (CD-CHAR-WIDTH CD) CHAR-WIDTH)
	(SETF (CD-CHAR-LEFT-KERN CD) KERN)
	(FD-STORE-CD FD CD CHAR-CODE)
	(AND (= CHAR-CODE (CHAR-CODE #\SP))
	     (SETF (FD-SPACE-WIDTH FD) CHAR-WIDTH))
	(DO-NAMED TOP ((VPOS 0 (1+ VPOS)))
		  ((= VPOS LINE-HEIGHT))
	  (DO ((HCNT 0 (1+ HCNT)))
	      ((= HCNT INPUT-RASTER-WIDTH)
	       (DO ((CH1 (CL:READ-CHAR STREAM NIL)2)) ()
		 (COND ((OR (NULL CH)
			    (1CHAR-EQUAL2 CH #\RETURN))
			(RETURN NIL))
		       (1(CHAR-EQUAL CH #\PAGE)
2			(FUNCALL STREAM ':UNTYI CH)
			(RETURN-FROM TOP NIL))
		       ((NOT (1CHAR-EQUAL2 CH #\SPACE))
			(FERROR NIL "non-space seen past raster width: ~S" ch)))))
	    (SETQ CH 1(CL:READ-CHAR STREAM NIL)2)
	    (COND ((NULL CH)
		   (RETURN-FROM TOP NIL))
		  (1(CHAR-EQUAL CH #\PAGE)
2		   (FUNCALL STREAM ':UNTYI CH)
		   (RETURN-FROM TOP NIL))
1		  ((OR (CHAR< CH #\SPACE) (CL:CHAR>= CH (CODE-CHAR #o200)))
2		   (DO () ((1CHAR-EQUAL2 CH #\RETURN)) (SETQ CH (FUNCALL STREAM ':TYI)))
		   (RETURN NIL))
		  (1(CHAR> CH #\SPACE)
2		   (ASET 1 CD VPOS (+ HCNT (- RASTER-WIDTH INPUT-RASTER-WIDTH)))))))
	)
      ;; Truncate fd to discard unused elements at the end.
      (DO ((I (1- (ARRAY-LENGTH FD)) (1- I)))
	  ((OR (MINUSP I)
	       (AREF FD I))
	   (ADJUST-ARRAY-SIZE FD (1+ I))))
      (SETF (FD-FILL-POINTER FD) (ARRAY-LENGTH FD))
      ;; Set width of blinker and space fields from the space character.
      (SETF (FD-BLINKER-WIDTH FD)
	    (FD-SPACE-WIDTH FD))
      FD)))

1(defun read-ast-dn (stream)
  (read-number-from-ast stream 10.))

(defun read-ast-on (stream)
  (read-number-from-ast stream 8.))

(defun read-number-from-ast (stream b)
  (let ((number (let ((cl:*read-base* b))
		  (read stream))))
    (cl:check-type number cl:integer)
    (readline stream)					;discard rest of line (a comment)
    number))

(defun read-ast-next-page (stream)
  (let ((char (cl:read-char stream nil)))
    (when char
      (if (char-not-equal char #\page)
	  (cl:error "2~S encountered where  expected1" char)
	(not (null (cl:listen stream)))))))


2;=====================================
(SYSTEM-INTERNALS:BEGIN-PATCH-SECTION)
(SYSTEM-INTERNALS:PATCH-SECTION-SOURCE-FILE "SYS:IO1;FED.LISP.202")
(SYSTEM-INTERNALS:PATCH-SECTION-ATTRIBUTES
  "-*- Mode:LISP; Package:FED; Base:8 -*-")

(DEFCONST *KNOWN-READABLE-TYPES*
	  (COPYLIST `(1:AST2 :BFD :KST ,SI:*DEFAULT-BINARY-FILE-TYPE* :AC :AL :PXL)
		    PERMANENT-STORAGE-AREA))

(DEFCONST *KNOWN-WRITEABLE-TYPES*
	  (COPYLIST `(1:AST2 :BFD :KST ,SI:*DEFAULT-BINARY-FILE-TYPE* :AC :PXL)
		    PERMANENT-STORAGE-AREA))

(DEFUN-IN-FLAVOR (FED-READ-FONT-FILE BASIC-FED) (PATHNAME TYPE FONT-NAME)
  (CONDITION-CASE (ERR)
      (PROGN
	(SELECTQ TYPE
	  (:BFD
	   (LET ((FONT (FONT-FROM-BFD (READ-BFD-FROM-FILE PATHNAME FONT-NAME))))
	     (SET FONT-NAME FONT)
	     (PUTPROP FONT-NAME FONT 'BFONT-DESCRIBED)))
	  (:KST
	   (LET ((FD (READ-KST-INTO-FONT-DESCRIPTOR PATHNAME FONT-NAME)))
	     (PUTPROP FONT-NAME PATHNAME 'KST-FILE)
	     (FONT-NAME-SET-FONT-AND-DESCRIPTOR FONT-NAME FD)))
	  ((:BIN :QBIN)
	   (LOAD PATHNAME "FONTS"))
	  (:AC
	   (READ-AC-INTO-FONT PATHNAME FONT-NAME))
	  (:AL
	   (READ-AL-INTO-FONT PATHNAME FONT-NAME))
	  (:PXL
	   (SET FONT-NAME (FONT-FROM-BFD (READ-PXL-FILE PATHNAME))))
1	  (:AST
	   (LET ((FD (READ-AST-INTO-FONT-DESCRIPTOR PATHNAME FONT-NAME)))
	     (PUTPROP FONT-NAME PATHNAME 'AST-FILE)
	     (FONT-NAME-SET-FONT-AND-DESCRIPTOR FONT-NAME FD)))
2	  (T (BARPH "Unknown font file type: ~S" TYPE)))
	(AND (BOUNDP FONT-NAME) (SYMEVAL FONT-NAME)
	     (SELECT-FONT FONT-NAME)))
    (FS:FILE-LOOKUP-ERROR
      (BARPH "~A" ERR))))

(DEFUN-IN-FLAVOR (FED-WRITE-FONT-FILE BASIC-FED) (PATHNAME TYPE)
  (SELECTQ TYPE
    (:BFD (WRITE-BFD-TO-FILE CURRENT-FONT PATHNAME))
    (:KST
     (WRITE-FONT-INTO-KST CURRENT-FONT PATHNAME)
     (PUTPROP CURRENT-FONT PATHNAME 'KST-FILE))
    (:PXL
     (WRITE-PXL-FILE (GET CURRENT-FONT 'BFONT-DESCRIPTOR) PATHNAME))
    ((:BIN :QBIN)
     (LET ((FONT (SYMEVAL CURRENT-FONT)))
       #+3600
       ;;--- Kludgery.  When FED loads a font when one of the same name
       ;;already exists, FONT-NAME-SET-FONT-AND-DESCRIPTOR structure-forwards 
       ;;the old font structure to the new one.  When we try to dump the
       ;;old one here, the old array is :DISPLACED-TO a locative, which
       ;;DUMP-FORM barfs over.
       (multiple-value-bind (dims options) (si:decode-array font)
	 (let ((displ (get (locf options) ':displaced-to)))
	   (when (typep displ ':locative)
	     (let ((arr (%find-structure-header displ)))
	       (when (and (arrayp arr) (eq (typep arr) (typep font))
			  (equal dims (array-dimensions font))
			  (loop for i below (array-leader-length font)
				always (eq (array-leader arr i)
					   (array-leader font i))))
		 (setq font arr))))))
       (COMPILER:DUMP-FORMS-TO-FILE PATHNAME `((SETQ ,CURRENT-FONT ',font))
				    '(:PACKAGE :FONTS))))
    (:AC (WRITE-FONT-INTO-AC CURRENT-FONT PATHNAME))
1    (:AST (WRITE-FONT-INTO-AST CURRENT-FONT PATHNAME)
     (PUTPROP CURRENT-FONT PATHNAME 'AST-FILE))
2    (T (BARPH "Unknown font file type: ~S" TYPE))))
Follow-Ups:
- AST
  - From: "David A. Moon" <Moon@scrc-stony-brook.arpa>
Prev by Date: version numbers, RCS
Next by Date: Re: version numbers
Previous by thread: RCS
Next by thread: AST
Index(es):
- Date
- Thread