home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
FM Towns: Free Software Collection 5
/
FREESOFT.BIN
/
fb386
/
bmpgen
/
bmpgen.bas
next >
Wrap
BASIC Source File
|
1992-08-19
|
4KB
|
137 lines
1000 ' <<<<< BITMAP GENERATOR >>>>>
1010 ' 1992 STUDIO MU PRESENTS
1020 ' Programmed by Gandalf of the Valley of Wind
1030 '
1040 SCREEN @0:WIDTH 80,25:CONSOLE 22,3,0:CLS
1050 ON ERROR GOTO *TRAPERR
1060 WID=320
1070 HEIGHT=240
1080 DIM PAT$(40000),WIN%(13000)
1090 GOSUB *BOX
1100 '
1110 *MENU
1120 GET@A(0,400)-(639,479),WIN%
1130 LINE(0,400)-(639,479),PRESET,,BF
1140 LOCATE 0,24:PRINT USING"SIZE X=### / Y=###";WID,HEIGHT;
1150 IF F$<>"" THEN PRINT " FILENAME=";F$ ELSE PRINT
1160 PRINT"COMMAND ";
1170 PRINT"(1:データロード 2:サイズ設定 3:ビットマップ作成 4:反転) ?";
1180 BEEP:CMD=VAL(INPUT$(1))
1190 IF CMD<1 OR CMD>4 THEN GOTO 1180
1200 PRINT CMD
1210 ON CMD GOSUB *DATALOAD,*SIZE,*GENERATE,*REVERSE
1220 GOTO *MENU
1230 '
1240 *DATALOAD
1250 INPUT"FILENAME ";A$
1260 IF A$<>"" THEN F$=A$
1270 IF F$="" THEN 1250
1280 '
1290 GOSUB *BOX
1300 LOAD@ F$+".TIF"
1310 GOSUB *BOX
1320 RETURN
1330 '
1340 *SIZE
1350 PUT@A(0,400)-(639,479),WIN%
1360 PRINT"サイズ設定 (←/→/↓/↑ or 4/6/2/8 , END=[RET])"
1370 '
1380 CMD=ASC(INPUT$(1))
1390 GOSUB *BOX
1400 WID=WID+(CMD=&H1D)*8-(CMD=&H1C)*8+(CMD=&H34)*8-(CMD=&H36)*8
1410 HEIGHT=HEIGHT+(CMD=&H1E)-(CMD=&H1F)+(CMD=&H38)*8-(CMD=&H32)*8
1420 WID=WID-(WID<1)*640+(WID>640)*640
1430 HEIGHT=HEIGHT-(HEIGHT<1)*480+(HEIGHT>480)*480
1440 GOSUB *BOX
1450 LOCATE 0,24:PRINT USING"SIZE X=### / Y=###";WID,HEIGHT;
1460 IF CMD<>13 THEN 1380
1470 PRINT:RETURN
1480 '
1490 *GENERATE
1500 PUT@A(0,400)-(639,479),WIN%
1510 PRINT"ビットマップを作成します。よろしいですか (Y/N)? ";
1520 A$=INPUT$(1):PRINT A$
1530 IF A$="N" OR A$="n" THEN RETURN
1540 GOSUB *BOX
1550 'LINE(0,0)-(WID-1,HEIGHT-1),XOR,7,BF
1560 '
1570 FOR Y=0 TO HEIGHT-1
1580 FOR X=0 TO WID-8 STEP 8
1590 A=0
1600 FOR I=7 TO 0 STEP -1
1610 P=POINT(X+I,Y)
1620 IF P=0 THEN PSET(X+I,Y) ELSE PRESET(X+I,Y)
1630 A=A*2:A=A-(P=0)
1640 NEXT
1650 PAT$(N)=HEX$(A)
1660 IF LEN(PAT$(N))=1 THEN PAT$(N)="0"+PAT$(N)
1670 N=N+1
1680 NEXT
1690 NEXT
1700 '
1710 PRINT"変換終了。ファイルを出力します。"
1720 PRINT"準備ができたらキーを押してください。"
1730 A$=INPUT$(1)
1740 OPEN "O",#1,F$+".BMP"
1750 PRINT #1,"#define ";F$;"_width";WID
1760 'PRINT "#define ";F$;"_width";WID
1770 PRINT #1,"#define ";F$;"_height";HEIGHT
1780 'PRINT "#define ";F$;"_height";HEIGHT
1790 PRINT #1,"static char ";F$;"_bits[] = {"
1800 'PRINT "static char ";F$;"_bits[] = {"
1810 I=0
1820 *LOOP1
1830 PRINT #1," ";
1840 'PRINT " ";
1850 *LOOP2
1860 PRINT #1,"0X";PAT$(I);
1870 'PRINT "0X";PAT$(I);
1880 I=I+1:IF I=N THEN GOTO *FIN
1890 PRINT #1,",";
1900 'PRINT ",";
1910 IF (I MOD 12)<>0 THEN *LOOP2
1920 PRINT #1,""
1930 'PRINT
1940 GOTO *LOOP1
1950 *FIN
1960 PRINT #1,"};"
1970 'PRINT "};"
1980 CLOSE
1990 '
2000 LINE(0,0)-(WID-1,HEIGHT-1),XOR,7,BF
2010 GOSUB *BOX
2020 PRINT"ビットマップ作成終了。"
2030 RETURN
2040 '
2050 *REVERSE
2060 PUT@A(0,400)-(639,479),WIN%
2070 LINE(0,0)-(639,479),XOR,7,BF
2080 RETURN
2090 '--------------------------------------------------------------------
2100 '
2110 *BOX
2120 LINE(0,0)-(WID-1,HEIGHT-1),XOR,7,B
2130 RETURN
2140 '
2150 *TRAPERR
2160 BEEP
2170 '
2180 IF ERR<>64 THEN 2250
2190 PRINT"ファイル ";F$;".BMP を上書きします。よろしいですか (Y/N)? ";
2200 A$=INPUT$(1):PRINT A$
2210 IF A$<>"N" AND A$<>"n" THEN 2230
2220 PRINT "ビットマップ作成を中止します。":RESUME *MENU
2230 KILL F$+".BMP":RESUME
2240 '
2250 IF ERR<>63 THEN 2300
2260 PRINT"ファイル ";F$;".TIF が見つかりません。"
2270 GOSUB *BOX
2280 RESUME *MENU
2290 '
2300 IF ERR<>112 THEN 2340
2310 PRINT"16色モードのデータではありません。"
2320 RESUME *MENU
2330 '
2340 PRINT"エラー";ERR;" / エラー行";ERL
2350 ON ERROR GOTO 0