home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 1 / FREEWARE.BIN / basic / fos / font.bas next >
BASIC Source File  |  1989-10-17  |  4KB  |  99 lines
  1. 10000 '２４ドット文字表示プログラム　　〔Ｔｏｗｎｓ－ＦＯＳ対応〕
  2. 10010 '　　　　　　　　　　　　　　Programed by Chama7 and Hokkon-Club!　　
  3. 10020 '
  4. 10030 'プログラム中から　　： A$ : 文 字 種  [MARU,GOTH,KYOU,MINN]
  5. 10040 '  *FONTを、GOSUBする｡  B$ : 文 字 列
  6. 10050 '                       A  : 0=横書き /  1=縦書き
  7. 10060 '                       B  : 文 字 色  (0-7)
  8. 10070 '                       C  : 横 座 標
  9. 10080 '                       D  : 縦 座 標
  10. 10090 '                       J  : 文 字 間
  11. 10100 ' 
  12. 10110 ' 汎用変数として、E,F,G,H,I,Z$,FD$(0),PSP%()  を使用しています｡
  13. 10120 ' ファイル番号            1,2                 を使用しています｡
  14. 10130 '
  15. 10140 '
  16. 10150 'ＴｏｗｎｓＦＯＳから： FONT <Sentence> [<X> [<Y>]]
  17. 10160 '    この時、 環境変数  FONT は 文 字 種  を｡(無指定時MARU)
  18. 10170 '                      WRITE は 書式(0/1) を｡(        0   )
  19. 10180 '                      COLOR は 文 字 色  を｡(        7   )
  20. 10190 '                       STEP は 文 字 間  を｡(        0   )
  21. 10200 '
  22. 10210 DEFLNG A-Z
  23. 10220 IF ARGC%>1 THEN *PARA_1  ELSE PRINT
  24. 10230 INPUT "文字列            ：",B$ : IF B$="" THEN END
  25. 10240 INPUT "位置Ｘ(省略時0)   ：",Z$ : C=VAL(Z$)
  26. 10250 INPUT "    Ｙ(省略時0)   ：",Z$ : D=VAL(Z$)
  27. 10260 INPUT "文字種            ：",A$ : IF A$="" THEN A$="MARU"
  28. 10270 INPUT "横書き=0／縦書き=1：",Z$ : A=VAL(Z$) : IF A<0 OR A>1 THEN A=0
  29. 10280 INPUT "文字間            ：",Z$ : J=VAL(Z$)
  30. 10290 INPUT "色番号            ：",Z$ : B=VAL(Z$) : IF B<0 OR B>7 THEN B=7
  31. 10300 PRINT : GOTO *PARA_2
  32. 10310 '
  33. 10320 *PARA_1
  34. 10330 B$=ARGV$(1)
  35. 10340 IF ARGC%>2 THEN C=VAL(ARGV$(2))  ELSE C=0
  36. 10350 IF ARGC%>3 THEN D=VAL(ARGV$(3))  ELSE D=0
  37. 10360 '
  38. 10370 *PARA_2
  39. 10380 IF ARGC%<1 THEN GOSUB *FONT : END  ELSE A$="MARU" : A=0 : B=7
  40. 10390 S_I$="FONT"  : GOSUB *S_GETVAR : IF S_A%>=0 THEN A$=S_A$
  41. 10400 S_I$="WRITE" : GOSUB *S_GETVAR : IF S_A%>=0 THEN A=VAL(S_A$)
  42. 10410 S_I$="COLOR" : GOSUB *S_GETVAR : IF S_A%>=0 THEN B=VAL(S_A$)
  43. 10420 S_I$="STEP"  : GOSUB *S_GETVAR : IF S_A%>=0 THEN J=VAL(S_A$)
  44. 10430 IF A<0 OR A>1 THEN A=0
  45. 10440 IF B<0 OR B>7 THEN B=7
  46. 10450 '
  47. 10460 *FONT
  48. 10470 IF B$="" THEN RETURN  ELSE DIM PSP%(35)
  49. 10480 OPEN "R",#1,"q:(2)\fj\fnt\"+A$+"\"+A$+"24hk.fnt"
  50. 10490 OPEN "R",#2,"q:(2)\fj\fnt\"+A$+"\"+A$+"24.fnt"
  51. 10500   FOR E=1 TO KLEN(B$)
  52. 10510     F=KTYPE(B$,E)
  53. 10520     IF F=0 THEN G=ASC(KMID$(B$,E,1)) : GOSUB *HFNTGET : GOTO 10540
  54. 10530                 G=JIS(KMID$(B$,E,1)) : GOSUB *JISCNV  : GOSUB *FNTGET
  55. 10540     PUT@ (C,D)-(C+23,D+23),PSP%,PSET,B
  56. 10550     IF F=1 THEN IF A=0 THEN C=C+24+J : GOTO 10570                                                    ELSE D=D+24+J : GOTO 10570
  57. 10560                 IF A=0 THEN C=C+12+J/2 ELSE D=D+24+J
  58. 10570   NEXT
  59. 10580 ERASE PSP% : CLOSE : RETURN
  60. 10590 '
  61. 10600 *HFNTGET
  62. 10610 IF G=ASC("ﾟ") THEN G=11:GOTO *FNTGET
  63. 10620 FIELD #1,2 AS FD$(0)
  64. 10630 GET #1,(G*74+2)/2+1
  65. 10640   FOR H=0 TO 35
  66. 10650     I=ASC(RIGHT$(FD$(0),1))*256+ASC(LEFT$(FD$(0),1)) : GET #1
  67. 10660     PSP%(H)=I+(I>32767)*65536!
  68. 10670   NEXT
  69. 10680 RETURN
  70. 10690 '
  71. 10700 *FNTGET
  72. 10710 FIELD #2,2 AS FD$(0)
  73. 10720 GET #2,(G*74+18)/2+1
  74. 10730   FOR H=0 TO 35
  75. 10740     I=ASC(RIGHT$(FD$(0),1))*256+ASC(LEFT$(FD$(0),1)) : GET #2
  76. 10750     PSP%(H)=I+(I>32767)*65536!
  77. 10760   NEXT
  78. 10770 RETURN
  79. 10780 '
  80. 10790 *JISCNV
  81. 10800 IF G>=20513 THEN G=G-16095-162*((G AND 65280)-20480)/256 : RETURN
  82. 10810 IF G>=12321 THEN G=G-10911-162*((G AND 65280)-12288)/256 : RETURN
  83. 10820 IF G>=9008  AND G<=9017  THEN G=G-8805 : RETURN
  84. 10830 IF G>=9025  AND G<=9050  THEN G=G-8805 : RETURN
  85. 10840 IF G>=9057  AND G<=9082  THEN G=G-8805 : RETURN
  86. 10850 IF G>=9249  AND G<=9332  THEN G=G-8967 : RETURN
  87. 10860 IF G>=9505  AND G<=9590  THEN G=G-9129 : RETURN
  88. 10870 IF G>=9761  AND G<=9784  THEN G=G-9291 : RETURN
  89. 10880 IF G>=9793  AND G<=9816  THEN G=G-9291 : RETURN
  90. 10890 IF G>=10017 AND G<=10049 THEN G=G-9453 : RETURN
  91. 10900 IF G>=10065 AND G<=10097 THEN G=G-9453 : RETURN
  92. 10910 IF G>=8762  AND G<=8825  THEN G=G-8643 : RETURN
  93. 10920 IF G>=8737  AND G<=8750  THEN G=G-8643 : RETURN
  94. 10930 IF G>=8993  AND G<=8998  THEN G=G-8096 : RETURN
  95. 10940 IF G>=8999  AND G<=9007  THEN G=G-8093 : RETURN
  96. 10950 IF G>=9018  AND G<=9022  THEN G=G-8103 : RETURN
  97. 10960 IF G>=9824  AND G<=9851  THEN G=G-8694 : RETURN
  98. 10970 G=G-8481 : RETURN
  99.