home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 5 / FREESOFT.BIN / fb386 / bmpgen / bmpgen.bas next >
BASIC Source File  |  1992-08-19  |  4KB  |  137 lines
  1. 1000 '                   <<<<<  BITMAP GENERATOR  >>>>>
  2. 1010 '                      1992  STUDIO MU PRESENTS
  3. 1020 '            Programmed by  Gandalf of the Valley of Wind
  4. 1030 '
  5. 1040 SCREEN @0:WIDTH 80,25:CONSOLE 22,3,0:CLS
  6. 1050 ON ERROR GOTO *TRAPERR
  7. 1060 WID=320
  8. 1070 HEIGHT=240
  9. 1080 DIM PAT$(40000),WIN%(13000)
  10. 1090 GOSUB *BOX
  11. 1100 '
  12. 1110 *MENU
  13. 1120 GET@A(0,400)-(639,479),WIN%
  14. 1130 LINE(0,400)-(639,479),PRESET,,BF
  15. 1140 LOCATE 0,24:PRINT USING"SIZE X=### / Y=###";WID,HEIGHT;
  16. 1150 IF F$<>"" THEN PRINT "    FILENAME=";F$ ELSE PRINT
  17. 1160 PRINT"COMMAND ";
  18. 1170 PRINT"(1:データロード 2:サイズ設定 3:ビットマップ作成 4:反転) ?";
  19. 1180 BEEP:CMD=VAL(INPUT$(1))
  20. 1190 IF CMD<1 OR CMD>4 THEN GOTO 1180
  21. 1200 PRINT CMD
  22. 1210 ON CMD GOSUB *DATALOAD,*SIZE,*GENERATE,*REVERSE
  23. 1220 GOTO *MENU
  24. 1230 '
  25. 1240 *DATALOAD
  26. 1250 INPUT"FILENAME ";A$
  27. 1260 IF A$<>"" THEN F$=A$
  28. 1270 IF F$="" THEN 1250
  29. 1280 '
  30. 1290 GOSUB *BOX
  31. 1300 LOAD@ F$+".TIF"
  32. 1310 GOSUB *BOX
  33. 1320 RETURN
  34. 1330 '
  35. 1340 *SIZE
  36. 1350 PUT@A(0,400)-(639,479),WIN%
  37. 1360 PRINT"サイズ設定 (←/→/↓/↑ or 4/6/2/8 , END=[RET])"
  38. 1370 '
  39. 1380 CMD=ASC(INPUT$(1))
  40. 1390 GOSUB *BOX
  41. 1400 WID=WID+(CMD=&H1D)*8-(CMD=&H1C)*8+(CMD=&H34)*8-(CMD=&H36)*8
  42. 1410 HEIGHT=HEIGHT+(CMD=&H1E)-(CMD=&H1F)+(CMD=&H38)*8-(CMD=&H32)*8
  43. 1420 WID=WID-(WID<1)*640+(WID>640)*640
  44. 1430 HEIGHT=HEIGHT-(HEIGHT<1)*480+(HEIGHT>480)*480
  45. 1440 GOSUB *BOX
  46. 1450 LOCATE 0,24:PRINT USING"SIZE X=### / Y=###";WID,HEIGHT;
  47. 1460 IF CMD<>13 THEN 1380
  48. 1470 PRINT:RETURN
  49. 1480 '
  50. 1490 *GENERATE
  51. 1500 PUT@A(0,400)-(639,479),WIN%
  52. 1510 PRINT"ビットマップを作成します。よろしいですか (Y/N)？ ";
  53. 1520 A$=INPUT$(1):PRINT A$
  54. 1530 IF A$="N" OR A$="n" THEN RETURN
  55. 1540 GOSUB *BOX
  56. 1550 'LINE(0,0)-(WID-1,HEIGHT-1),XOR,7,BF
  57. 1560 '
  58. 1570 FOR Y=0 TO HEIGHT-1
  59. 1580   FOR X=0 TO WID-8 STEP 8
  60. 1590     A=0
  61. 1600     FOR I=7 TO 0 STEP -1
  62. 1610       P=POINT(X+I,Y)
  63. 1620       IF P=0 THEN PSET(X+I,Y) ELSE PRESET(X+I,Y)
  64. 1630       A=A*2:A=A-(P=0)
  65. 1640     NEXT
  66. 1650     PAT$(N)=HEX$(A)
  67. 1660     IF LEN(PAT$(N))=1 THEN PAT$(N)="0"+PAT$(N)
  68. 1670     N=N+1
  69. 1680   NEXT
  70. 1690 NEXT
  71. 1700 '
  72. 1710 PRINT"変換終了。ファイルを出力します。"
  73. 1720 PRINT"準備ができたらキーを押してください。"
  74. 1730 A$=INPUT$(1)
  75. 1740 OPEN "O",#1,F$+".BMP"
  76. 1750 PRINT #1,"#define ";F$;"_width";WID
  77. 1760  'PRINT "#define ";F$;"_width";WID
  78. 1770 PRINT #1,"#define ";F$;"_height";HEIGHT
  79. 1780  'PRINT "#define ";F$;"_height";HEIGHT
  80. 1790 PRINT #1,"static char ";F$;"_bits[] = {"
  81. 1800  'PRINT "static char ";F$;"_bits[] = {"
  82. 1810 I=0
  83. 1820 *LOOP1
  84. 1830   PRINT #1,"   ";
  85. 1840    'PRINT "   ";
  86. 1850 *LOOP2
  87. 1860     PRINT #1,"0X";PAT$(I);
  88. 1870      'PRINT "0X";PAT$(I);
  89. 1880     I=I+1:IF I=N THEN GOTO *FIN
  90. 1890     PRINT #1,",";
  91. 1900      'PRINT ",";
  92. 1910     IF (I MOD 12)<>0 THEN *LOOP2
  93. 1920     PRINT #1,""
  94. 1930       'PRINT
  95. 1940     GOTO *LOOP1
  96. 1950 *FIN
  97. 1960 PRINT #1,"};"
  98. 1970  'PRINT "};"
  99. 1980 CLOSE
  100. 1990 '
  101. 2000 LINE(0,0)-(WID-1,HEIGHT-1),XOR,7,BF
  102. 2010 GOSUB *BOX
  103. 2020 PRINT"ビットマップ作成終了。"
  104. 2030 RETURN
  105. 2040 '
  106. 2050 *REVERSE
  107. 2060 PUT@A(0,400)-(639,479),WIN%
  108. 2070 LINE(0,0)-(639,479),XOR,7,BF
  109. 2080 RETURN
  110. 2090 '--------------------------------------------------------------------
  111. 2100 '
  112. 2110 *BOX
  113. 2120 LINE(0,0)-(WID-1,HEIGHT-1),XOR,7,B
  114. 2130 RETURN
  115. 2140 '
  116. 2150 *TRAPERR
  117. 2160 BEEP
  118. 2170 '
  119. 2180 IF ERR<>64 THEN 2250
  120. 2190   PRINT"ファイル ";F$;".BMP を上書きします。よろしいですか (Y/N)？ ";
  121. 2200   A$=INPUT$(1):PRINT A$
  122. 2210   IF A$<>"N" AND A$<>"n" THEN 2230
  123. 2220     PRINT "ビットマップ作成を中止します。":RESUME *MENU
  124. 2230   KILL F$+".BMP":RESUME
  125. 2240 '
  126. 2250 IF ERR<>63 THEN 2300
  127. 2260   PRINT"ファイル ";F$;".TIF が見つかりません。"
  128. 2270 GOSUB *BOX
  129. 2280   RESUME *MENU
  130. 2290 '
  131. 2300 IF ERR<>112 THEN 2340
  132. 2310   PRINT"１６色モードのデータではありません。"
  133. 2320   RESUME *MENU
  134. 2330 '
  135. 2340 PRINT"エラー";ERR;" / エラー行";ERL
  136. 2350 ON ERROR GOTO 0
  137.