#11 Article 588 Posted at 1987/11/15 19:41:21 by TO-Y68K (MAP533) [PRG.NL3]
Subject: NEDI68K.BAS
10 /* save"nedi68k.BAS"
20 /*
30 /* ＮＥＤＩ３－Ｘ６８０００ Version 1.00
40 /*
50 /* Programmed by Satoshi Igarashi / Special thanks to Ayako★
60 /*
70 key 1,"apage(1):wipe()@M"
80 key 2,"width 96:list@M"
90 dim char pic(64000)
100 dim int r(255),g(255),b(255),fp,tot,co1,co2,x,y
110 cls:print"ＮＥＤＩ３－Ｘ６８０００ Ｖｅｒｓｉｏｎ １.００":print
120 print"Copyright 1987 by S.Igarashi [ MAP533 / TO-Y_68K ]":print
130 print"ＣＲＴをイニシャライズしますか？ ( Y or N )"
140 str YN:YN=inkey$
150 if YN="Y" or YN="y" then {
160 screen 1,2,1,1:console 0,32,0:contrast(15)
170 vpage(3):apage(1):fill(0,0,160*3-1,100*4-1,1):apage(0):box(-1,-1,160*3,100*4,255)
180 line(0,490,511,490,255)
190 p_preset():for pl=1 to 63:plset(pl):next:pl=0
200 }:cls
210 mon()
220 int tr,tl,dm
230 pl=255:r(pl)=8:g(pl)=8:b(pl)=8:plset(pl):pl=0:plset(pl)
240 retset()
250 apage(0):mon()
260 repeat
270 msstat(dm,dm,tl,tr)
280 mspos(x,y)
290 if tl=-1 then {
300 if y<490 then piccolo(x,y) else { apage(0)
310 if x > 2 and x<210 then pl=colsel():continue
320 if x>253 and x<288 then dots():continue
330 if x>293 and x<328 then draw():continue
340 if x>333 and x<376 then dpaint():continue
350 /* if x>383 and x<416 then [ 機能拡張用 ] :continue
360 if x>423 and x<455 then conv():continue
370 if x>462 and x<501 then opfile():continue
380 }}
390 until(0)
400 end
410 /**** Draw Routine ****/
420 func draw()
430 int dm,x,y,tr,tl,c,d
440 box(293,493,328,511,255)
450 mon():apage(1):msarea(0,0,511,489)
460 repeat:msstat(dm,dm,tl,tr):until(tl=0)
470 repeat
480 msstat(dm,dm,tl,tr)
490 if tl=-1 then {
500 mspos(x,y)
510 if x>=490 then piccolo(x,y) else {
520 line(c,d,x,y,pl)
530 c=x:d=y
540 }} else mspos(c,d)
550 until(tr=-1)
560 apage(0):retset()
570 endfunc
580 /**** DotSet Routine ****/
590 func dots()
600 int dm,x,y,tr,tl,c,d
610 box(253,493,288,511,255)
620 mon():apage(1):msarea(0,0,511,489)
630 repeat:msstat(dm,dm,tl,tr):until(tl=0)
640 repeat
650 msstat(dm,dm,tl,tr)
660 if tl=-1 then {
670 mspos(x,y)
680 if x>=490 then piccolo(x,y) else {
690 x=x-1:y=y-1
700 x=(x\3)*3:y=(y\4)*4
710 fill(x,y,x+2,y+3,pl)
720 c=x:d=y
730 }} else mspos(c,d)
740 until(tr=-1)
750 apage(0):retset()
760 endfunc
770 func conv()
780 int x,y,px,py,br,dm:float co1,co2,co3,co4,co5,co6
790 box(422,493,456,511,255)
800 apage(1):mouse(0):locate 2,27
810 print"解像度変換中です。しばらくおまちください。"
820 print" 右ボタンのクリックで中止できます。 CountDown:
830 x=0:y=0
840 while x<160 and y<100 and br=0
850 px=x*3:py=y*4
860 co1=point(px,py)
870 co2=point(px,py+1)
880 co3=point(px,py+2)
890 co4=point(px,py+3)
900 co5=point(px+1,py)
910 co6=point(px+2,py)
920 if co1*co2*co3*co4*co5*co6=0 then co1=0
930 fill(px,py,px+2,py+3,co1)
940 msstat(dm,dm,dm,br)
950 y=y+1:if y=100 then y=0:x=x+1:locate 56,28:print 160-x
960 endwhile
970 apage(0):retset()
980 endfunc
990 /**** Color Select ****/
1000 func colsel()
1010 int dm,x,y,tr,tl,c,d
1020 apage(1)
1030 repeat:msstat(dm,dm,tl,tr):until(tl=0)
1040 plprint(pl)
1050 repeat
1060 msstat(dm,dm,tl,tr)
1070 if tl=-1 then {
1080 mspos(x,y)
1090 if y<=490 then pl=point(x,y):plprint(pl)
1100 if y>490 then {
1110 if x>48 and x<63 then pl=pl+1
1120 if x>104 and x<119 then pl=pl-1
1130 if x>136 and x<151 then r(pl)=r(pl)+1
1140 if x>184 and x<199 then r(pl)=r(pl)-1
1150 if x>216 and x<231 then g(pl)=g(pl)+1
1160 if x>264 and x<279 then g(pl)=g(pl)-1
1170 if x>296 and x<311 then b(pl)=b(pl)+1
1180 if x>344 and x<359 then b(pl)=b(pl)-1
1190 /*
1200 if pl<0 then pl=255
1210 if pl>255 then pl=0
1220 if r(pl)<0 then r(pl)=8
1230 if r(pl)>8 then r(pl)=0
1240 if g(pl)<0 then g(pl)=8
1250 if g(pl)>8 then g(pl)=0
1260 if b(pl)<0 then b(pl)=8
1270 if b(pl)>8 then b(pl)=0
1280 plprint(pl)
1290 }
1300 }
1310 until(tr=-1)
1320 apage(0):retset():return(pl)
1330 endfunc
1340 /*
1350 /**** Paint Sub ****/
1360 func dpaint()
1370 box(333,493,377,511,255)
1380 mon():apage(1):msarea(0,0,511,489)
1390 repeat:msstat(dm,dm,tl,tr):until(tl=0)
1400 repeat
1410 msstat(dm,dm,tl,tr)
1420 if tl=-1 then {
1430 mspos(x,y)
1440 if x>=490 then piccolo(x,y) else {
1450 if x<480 and y<400 then paint(x,y,pl):box(-1,-1,480,400,255)
1460 }}
1470 until(tr=-1)
1480 apage(0):retset()
1490 endfunc
1500 /**** File Operation Sub ****/
1510 func opfile()
1520 int nm:mouse(0):apage(1)
1530 locate 0,26:print" 選択して下さい (1) DATA LOAD (2) DATA SAVE"
1540 locate 0,27:input" (3) NL3 LOAD (4) NL3 SAVE ";nm
1550 if nm=1 then fload()
1560 if nm=2 then fsave()
1570 if nm=3 then ldnl3()
1580 if nm=4 then svnl3()
1590 apage(0):retset():mon()
1600 endfunc
1610 func fload()
1620 str fn:int fp,pl
1630 locate 0,29:input" ロードするファイル名を入力して下さい。";fn
1640 error off
1650 fp=fopen(fn+".nd1","r")
1660 if fp=-1 then locate 0,29:print" 無効なファイル名を入力しました ";chr$(7);:error on:fcloseall():wait(1000):return()
1670 locate 0,29:print " ";fn;" をロード中です。 ";
1680 fread(pic,64000,fp)
1690 put(0 , 0,159,399,pic)
1700 fp=fopen(fn+".nd2","r")
1710 fread(pic,64000,fp)
1720 put(160, 0,319,399,pic)
1730 fp=fopen(fn+".nd3","r")
1740 fread(pic,64000,fp)
1750 put(320, 0,479,399,pic)
1760 fp=fopen(fn+".RED","r")
1770 fread(r,64,fp)
1780 fp=fopen(fn+".GRN","r")
1790 fread(g,64,fp)
1800 fp=fopen(fn+".BLE","r")
1810 fread(b,64,fp)
1820 fcloseall()
1830 for pl=0 to 64:plset(pl):next
1840 endfunc
1850 func fsave()
1860 str fn,yn:int fp
1870 locate 0,29:input" セーブするファイル名を入力して下さい。";fn
1880 locate 0,29:print" ";fn;"<= このファイル名でよろしいですか (y/n)";:input yn
1890 if yn<>"y" and yn<>"Y"then return()
1900 locate 0,29:print " ";fn;" をセーブ中です。 ";
1910 fp=fopen(fn+".nd1","c")
1920 get(0 , 0,159,399,pic)
1930 fwrite(pic,64000,fp)
1940 fp=fopen(fn+".nd2","c")
1950 get(160, 0,319,399,pic)
1960 fwrite(pic,64000,fp)
1970 fp=fopen(fn+".nd3","c")
1980 get(320, 0,479,399,pic)
1990 fwrite(pic,64000,fp)
2000 fp=fopen(fn+".RED","c")
2010 fwrite(r,64,fp)
2020 fp=fopen(fn+".GRN","c")
2030 fwrite(g,64,fp)
2040 fp=fopen(fn+".BLE","c")
2050 fwrite(b,64,fp)
2060 fcloseall()
2070 endfunc
2080 /*
2090 /*
2100 func plset(pl;int)
2110 palet(pl,rgb(r(pl)*3,g(pl)*3,b(pl)*3)+0)
2120 apage(0)
2130 fill(2,492,37,511,pl)
2140 box(2,492,37,511,255)
2150 box(490,0,511,383,255)
2160 apage(1)
2170 fill(490,pl*6,512,pl*6+5,pl)
2180 locate 8,31: print using"P=###";pl;
2190 endfunc
2200 /*
2210 func mposi()
2220 int x,y,tr
2230 mon()
2240 repeat
2250 msstat(x,y,tr,tr)
2260 mspos(x,y)
2270 locate 0,0:print x,y
2280 until(tr=-1)
2290 endfunc
2300 /*
2310 func retset()
2320 cls:fill(200,492,511,511,0)
2330 locate 0,31: print using" P=### ";pl;
2340 print space$(13);
2370 print " Dots Draw Paint ---- Conv File";
2380 msarea(0,0,511,511):mon()
2390 endfunc
2400 func plprint(pl;int)
2410 locate 0,31:print using" ▲P=###▼";pl;
2420 print using" ▲R=##▼";r(pl);
2430 print using" ▲G=##▼";g(pl);
2440 print using" ▲B=##▼";b(pl);
2450 print " ";
2460 plset(pl)
2470 endfunc
2480 func wait(n;int)
2490 int i:for i=0 to n:next
2500 endfunc
2510 func piccolo(x;int,y;int)
2520 pl=point(x,y):plset(pl)