|
|
SET TEXT FONT文で指定するフォント名を直接TTFファイルから読み出します。
TTFファイルから"name"タグを読み込み、シークして目標とする文字列(フォント名)を読み込みます。
但し、IDの種類がいくつもあり、またシステム(OS)がどのIDで認識しているのか不明であるため
プログラムでは、
Platform_ID=1,Name_ID=1 及び Platform_ID=1,Name_ID=2
存在するなら
Platform_ID=1,Name_ID=4 の文字列を優先的に読み込んでいます。
IDが見つからない、オフセット値がおかしい等の理由により読み込みに失敗した場合
リードエラーを起こすので、エラー処理で飛ばし「Error File」としています。
TTFファイル以外のフォント形式には対応していません。(TTCファイルは分割するとTTFファイルになる)
読み込みには時間がかかるため、読み出したフォント名はDATA文形式で書き出します。
●TTFファイルの中身を知りたい方(解析に使用したツール)
下記URLより「fonttools.exe」(自己解凍形式)をダウンロード
実行して、その中から「TTFDump.zip」を解凍し、コマンドラインから
ttfdump TTFファイル名 > out.txt
のようにタイプすると巨大なテキストファイルが出来る。
(ttfdump のみでhelp表示)
バイトオーダーにご注意(big-endian)
●フリーフォントサイト
文字だけでなく、図形やキャラクターなどがある。
LET PASS$="C:\WINDOWS\FONTS\" !'フォントフォルダ
LET FILTER$="*.TTF" !' TTFファイル
LET FONTDIR$=PASS$&FILTER$
LET N=FILES(FONTDIR$)
DIM FONTFILE$(N)
FILE LIST FONTDIR$,FONTFILE$
FOR I=1 TO N
!' PRINT "No.";I;"ファイル名:";FONTFILE$(I),"フォント名:";GETFONTNAME$(PASS$&FONTFILE$(I))
PRINT "DATA ";CHR$(34);GETFONTNAME$(PASS$&FONTFILE$(I));CHR$(34);" ! ";FONTFILE$(I)
NEXT I
END
EXTERNAL FUNCTION GETFONTNAME$(F$)
IF POS(UCASE$(F$),".TTF")=0 THEN
LET GETFONTNAME$=""
EXIT FUNCTION
END IF
OPTION CHARACTER BYTE
DIM A$(12)
WHEN EXCEPTION IN !'エラー処理
OPEN #1:NAME F$,ACCESS INPUT
FOR I=1 TO 12
CHARACTER INPUT #1:A$(I)
LET ADR=ADR+1
NEXT I
LET SFNTVER=CVI(A$(1)&A$(2))
LET NUMTABLES=CVL(A$(3)&A$(4)&A$(5)&A$(6))
LET SEARCHRANGE=CVI(A$(7)&A$(8))
LET ENTERYSELECTOR=CVI(A$(9)&A$(10))
LET RANGESHIFT=CVI(A$(11)&A$(12))
FOR I=1 TO NUMTABLES
LET TAG$=""
FOR J=1 TO 4
CHARACTER INPUT #1:S$
LET ADR=ADR+1
LET TAG$=TAG$&S$
NEXT J
FOR J=1 TO 12
CHARACTER INPUT #1:A$(J)
LET ADR=ADR+1
NEXT J
IF TAG$="name" THEN !' 'name'タグ
LET NAMEOFFSET=CVL(A$(5)&A$(6)&A$(7)&A$(8))
LET NAMELENGTH=CVL(A$(9)&A$(10)&A$(11)&A$(12))
EXIT FOR
END IF
NEXT I
DO
CHARACTER INPUT #1:S$ !'シーク
LET ADR=ADR+1
LOOP UNTIL ADR=NAMEOFFSET
FOR J=1 TO 6
CHARACTER INPUT #1:A$(J)
LET ADR=ADR+1
NEXT J
LET FORMAT=CVI(A$(1)&A$(2))
LET COUNT=CVI(A$(3)&A$(4))
LET STRINGOFFSET=CVI(A$(5)&A$(6))
FOR I=1 TO COUNT
FOR J=1 TO 12
CHARACTER INPUT #1:A$(J)
LET ADR=ADR+1
NEXT J
LET PLATFORM_ID=CVI(A$(1)&A$(2))
LET SPECIFIC_ID=CVI(A$(3)&A$(4))
LET LANGUAGE_ID=CVI(A$(5)&A$(6))
LET NAME_ID=CVI(A$(7)&A$(8))
LET LENGTH=CVI(A$(9)&A$(10))
LET OFFSET=CVI(A$(11)&A$(12))
IF PLATFORM_ID=1 AND NAME_ID=1 THEN
LET LENGTH1=LENGTH
LET OFFSET1=OFFSET
ELSEIF PLATFORM_ID=1 AND NAME_ID=2 THEN
LET LENGTH2=LENGTH
LET OFFSET2=OFFSET
ELSEIF PLATFORM_ID=1 AND NAME_ID=4 THEN
LET LENGTH1=LENGTH
LET OFFSET1=OFFSET
LET LENGTH2=-1
LET OFFSET2=-1
EXIT FOR
END IF
IF LANGUAGE_ID=1033 AND SPECIFIC_ID=1 THEN
IF LENGTH1=0 AND PLATFORM_ID=3 AND NAME_ID=1 THEN
LET LENGTH1=LENGTH
LET OFFSET1=OFFSET
ELSEIF LENGTH2=0 AND PLATFORM_ID=3 AND NAME_ID=2 THEN
LET LENGTH2=LENGTH
LET OFFSET2=OFFSET
ELSEIF LENGTH2=0 AND PLATFORM_ID=3 AND NAME_ID=4 THEN
LET LENGTH1=LENGTH
LET OFFSET1=OFFSET
LET LENGTH2=-1
LET OFFSET2=-1
EXIT FOR
END IF
END IF
NEXT I
DO UNTIL ADR=NAMEOFFSET+STRINGOFFSET+OFFSET1
CHARACTER INPUT #1:S$
LET ADR=ADR+1
LOOP
FOR J=1 TO LENGTH1 !'フォント名読み込み
CHARACTER INPUT #1:S$
LET ADR=ADR+1
IF S$<>CHR$(0) THEN LET F1$=F1$&S$
NEXT J
IF OFFSET2>0 THEN
DO UNTIL ADR=NAMEOFFSET+STRINGOFFSET+OFFSET2
CHARACTER INPUT #1:S$
LET ADR=ADR+1
LOOP
FOR J=1 TO LENGTH2 !'フォント名読み込み
CHARACTER INPUT #1:S$
LET ADR=ADR+1
IF S$<>CHR$(0) THEN LET F2$=F2$&S$
NEXT J
END IF
IF UCASE$(F2$)<>"REGULAR" AND F2$<>"" THEN !' "regular"は除外?
LET GETFONTNAME$=F1$&" "&F2$
ELSE
LET GETFONTNAME$=F1$
END IF
USE
LET GETFONTNAME$="(Error File)" !'リードエラー(読み出し失敗)
END WHEN
CLOSE #1
END FUNCTION
EXTERNAL FUNCTION CVI(A$) !'Big-Endian(2byte整数)
OPTION CHARACTER BYTE
DECLARE NUMERIC A
LET A$=LEFT$(A$,2)
LET A=ORD(A$(2:2))+ORD(A$(1:1))*256
IF A>32767 THEN LET A=A-65536
LET CVI=A
END FUNCTION
EXTERNAL FUNCTION CVL(A$) !'Big-Endian(4byte整数)
OPTION CHARACTER BYTE
DECLARE NUMERIC A
LET A$=LEFT$(A$,4)
LET A=ORD(A$(4:4))+ORD(A$(3:3))*256+ORD(A$(2:2))*256^2+ORD(A$(1:1))*256^3
IF A>=2^31-1 THEN LET A=A-2^32
LET CVL=A
END FUNCTION
読み出したDATA文は下記のプログラムとマージすると簡易フォントビューワになります。(0x00～0xFF)
前回表示と変化がない場合、読み出しに失敗している可能性があります。
(SET TEXT FONT文で存在しないフォント名を指定してもエラーにはならない)
OPTION CHARACTER BYTE
CALL GINIT(700,700)
LET SIZE=40
SET TEXT JUSTIFY "LEFT" , "TOP"
DO
SET TEXT COLOR 4
SET TEXT FONT "ＭＳ 明朝",SIZE*.7
FOR X=0 TO 15
PLOT TEXT ,AT 50+X*SIZE,0:RIGHT$("0"&BSTR$(X,16),2)
NEXT X
FOR Y=0 TO 15
PLOT TEXT ,AT 0,50+Y*SIZE:RIGHT$("0"&BSTR$(Y*16,16),2)
NEXT Y
FOR X=0 TO 16
CALL LINE(50+X*SIZE,50,50+X*SIZE,50+16*SIZE,6)
NEXT X
FOR Y=0 TO 16
CALL LINE(50,50+Y*SIZE,50+16*SIZE,50+Y*SIZE,6)
NEXT Y
READ IF MISSING THEN EXIT DO:FONTNAME$
PRINT FONTNAME$
SET TEXT FONT FONTNAME$,SIZE*.6
SET TEXT COLOR 7
FOR I=0 TO 15
FOR J=0 TO 15
PLOT TEXT ,AT 50+J*SIZE,50+I*SIZE :CHR$(I*16+J)
NEXT J
NEXT I
INPUT S$ !'一時停止
CLEAR
LOOP
!ここからDATA文を置く
END
EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
SET POINT STYLE 1
SET COLOR MODE "REGULAR"
SET COLOR MIX(0) 0,0,0
SET COLOR MIX(1) 0,0,1
SET COLOR MIX(2) 1,0,0
SET COLOR MIX(3) 1,0,1
SET COLOR MIX(4) 0,1,0
SET COLOR MIX(5) 0,1,1
SET COLOR MIX(6) 1,1,0
SET COLOR MIX(7) 1,1,1
SET TEXT JUSTIFY "LEFT","TOP"
CLEAR
END SUB
EXTERNAL SUB LINE(XS,YS,XE,YE,C)
SET COLOR C
PLOT LINES
PLOT LINES:XS,YS;XE,YE
END SUB
|
|