幻聴で思ったSu事その４
2023.01.23(Mon)
福岡大
10 REM *****************************************
20 REM * Programed by Dai Fukuoka 2011.01.7 *
30 REM * copyright 2011.01.7-1.30 *
40 REM * DotPresetEditor2011β *
50 REM *****************************************7430-7680 8330
60 *START
70 WIDTH 80,25:CONSOLE 0,25,0,1:SCREEN 3,0,0,1:COLOR 0,7,0,7,2:CLS 2
80 YY$=LEFT$(DATE$,2):MM$=RIGHT$(DATE$,5):MM$=LEFT$(MM$,2):DD$=RIGHT$(DATE$,2)
90 MOUSE(2)ON:MOUSE(3)ON
100 REM ON ERROR GOTO *ERRCD
110 LET FLAGS$="LINE":LET LMP=7:LET RMP=0:CX=1:CY=1
120 LET FLX=0:LET FLY=0:LET FLS=2::D=0:C=0:CP=7:LET LAY=0
130 LET RST=0:IVC=99:DIM IVX(99):DIM IVY(99):LET LAY=0:LET BG=0:LET BC=0
140 DIM UDX(99):DIM UDY(99):DIM UDF$(99):DIM UNDO(64,64,99)
150 DIM LAYER(65,65,7):DIM DITH(64,64,4):DIM W(64,64):DIM T(64,64):
160 DIM UDXL(99):DIM UDYL(99):DIM MOVABLEMAP(8,8,5)
170 DIM Y(64,64):DIM LAYER$(65,65,7):LET LAYER$="":DIM DATAFLOOR$(64,7)
180 DIM MASK(64,64):DIM IVPENTRM(99):REM DIM IVPENX(4096,99):DIM IVPENY(4096,99)
190 DIM IVXL(64,99):DIM IVYL(64,99):DIM IVFLAGS$(99)
200 DIM RAMSAVE(64,64,7):DIM IVENTMOTION(256,8,64):DIM IMF$(256,64)
210 DIM DARKSOLID(64,64):DIM HEVYPALE(64,64):DIM HEVYHARF(64,64):DIM HARF(64,64):
220 DIM LIGHT(64,64):DIM LIGHTPALE(64,64):DIM LIGHTSOLID(64,64):DIM CP(128,128,8)
230 DIM DM$(8,8):DIM DM(64,64,8):DIM DM2(64,64,8):DIM CHECKBOX(64,64):DIM MLCLOUMN(80,25,2):DIM MLC(80):DIM MLF(25):DIM MLCP(80):DIM MLFP(25)
240 IF MOVABLEMAP(SELECTBLOCX,SELECTBLOCY,1)=8 THEN GOSUB *BLUPMASK
250 IF MOVABLEMAP(SELECTBLOCX,SELECTBLOCY,2)=4 THEN GOSUB *BLLFMASK
260 IF MOVABLEMAP(SECECTBLOCX,SELECTBLOCY,3)=6 THEN GOSUB *BLRIMASK
270 IF POINT(639,399)=POINT(639,479) THEN SHOWVIEW=1 ELSE SHOWVIEW=-1
280 *NEARDISTANCE LET X=0:LET Y=0
290 IF SHOWVIEW=-1 THEN FOR I=0 TO 79 STEP 1:MLCP(I)=I*8 :NEXT
300 IF SHOWVIEW=-1 THEN FOR I=0 TO 24 STEP 1:MLFP(I)=I*16:NEXT
310 *LONGDISTANCE LET X=0:LET Y=0
320 IF SHOWVIEW=1 THEN FOR I=0 TO 79 STEP 1:MLCP(I) =I*8 :NEXT
330 IF SHOWVIEW=1 THEN FOR I=1 TO 25 STEP 1:MLFP(I) =I*18.8#:NEXT
340 ::
350 DIM BLPASS(8,8):DIM BLSTART(8,8)
360 LET DFL=1
370 REM GOSUB *DITHERMAPPING:GOSUB *DITHERFILTERLING:GOSUB *PREDISPLAYPASS
380 *RUNNINGPROGRAM
390 GOSUB *DITHERFILTERLING
400 LINE(0,0)-(640,480),15,BF:LINE(20,20)-(468,468),0,BF
410 FOR I=20 TO 468 STEP 7:LINE (I,20)-(I,468),12:NEXT I
420 FOR T=20 TO 468 STEP 7:LINE (20,T)-(468,T),12:NEXT T
430 LINE (488,18)-(616,468),7,BF:COLOR 0:LOCATE 61,2:PRINT"COLOR PALLETE"
440 I=0:IF PE=0 THEN FOR C=61 TO 76:LINE (MLCP(C),MLFP(2))-(MLCP(C+1),MLFP(3)),I,BF:I=I+1:NEXT C:PE=1
450 GOSUB *REFRESHTXT:GOTO *SETTING
460 *REFRESHTXT
470 COLOR 0:LOCATE 61,2:PRINT"COLOR PALLETE"
480 LOCATE 61,5:PRINT"COLOR LEVEL 0":LOCATE 61,6:PRINT"000 RGB"
490 LOCATE 61,7:PRINT"0123456789ABCDEF"
500 LOCATE 61,8:PRINT"DITHER 0-7< 01 >":LOCATE 61,10:PRINT"TOOL BOX"
510 LOCATE 61,11:PRINT"LINE / CARV":LOCATE 61,12:PRINT"PAINT / DOT"
520 LOCATE 61,13:PRINT"LAYER 012345 M/C":LOCATE 61,14:PRINT"PEN C / B 3 5":LOCATE 61,15:PRINT"SPOIT / GLID"
530 LOCATE 61,16:PRINT"UNDO 00 / RESET"
540 LOCATE 61,18:PRINT"FILE COMMAND":LOCATE 61,19:PRINT"RAM SAVE LOAD":LOCATE 61,20:PRINT"DISK SAVE LOAD"
550 LOCATE 61,21:PRINT":MYPIC"+YY$+MM$+DD$+".ASC":LOCATE 61,22:PRINT"STATUS"
560 LOCATE 61,23:PRINT"MATRIX X:64 Y:64":LOCATE 61,24:PRINT"/ LINE"
570 RETURN:::::
580 *SETTING
590 FOR X=0 TO 1:FOR I=1 TO 64:FOR T=1 TO 64:LET LAYER(I,T,X)=0:NEXT T:NEXT I:NEXT X
600 P=1:LBX=4:LBY=13:GOSUB *CP
610 P=2:LBX=13:LBY=13:GOSUB *CP
620 P=3:LBX=7:LBY=7:GOSUB *CP
630 P=5:LBX=0:LBY=5:GOSUB *CP
640 P=4:LBX=5:LBY=5:GOSUB *CP
650 P=0:LBX=0:LBY=2:GOSUB *CP
660 P=6:LBX=7:LBY=2:GOSUB *CP
670 GOTO *ASKIP
680 *LOBX
690 I=61:WHILE I<76:I=I+1:IF I<>LBX THEN WEND:I=0 ELSE *LOBXA
700 *LOBXA:LINE(MLCP(LBX+61),MLFP(LBY))-(MLCP(LBX+62),MLFP(LBY+1)),P,B:RETURN
710 *CP:I=61:WHILE I<76:I=I+1:IF NOT I=LBX THEN ELSE *CPB:GOTO *LOBF
720 WEND
730 *CPB :LINE(MLCP(LBX+61),MLFP(LBY))-(MLCP(LBX+62),MLFP(LBY+1)),P,B:RETURN
740 *LOBF I=61:WHILE I<76:I=I+1:IF NOT I=LBX AND I=0 THEN ELSE *LOBFA
750 WEND
760 *LOBFA RETURN
770 *ASKIP CX=1:CY=1:X=1:Y=1:LB=0:RB=0
780 LET A=0
790 *GOMOUSE CXB=CX:CYB=CY:XB=X:YB=Y
800 *CLICKMOUSE
810 X=MOUSE(0):Y=MOUSE(1)
820 IF CX<>MOUSE(4,1) OR CY<>MOUSE(5,1) THEN IF CX<>0 AND CY<>0 THEN CX=MOUSE(4,1):CY=MOUSE(5,1)
830 RCX=MOUSE(4,2):RCY=MOUSE(5,2):IF RCX<>O OR RCY<>0 THEN RB=1
840 GOTO *MOUSEIF:
850 *GTM GOTO *GOMOUSE
860 *MOUSEIF IF CXB<>CX OR CYB<>CY OR XB<>X OR YB<>Y THEN *MENUS ELSE *GTM
870 GOTO *MENUS
880 END
890 *MENUS IF CX<469 OR X<469 THEN *AREASC ELSE IF CX>469 OR X>469 THEN *TOOLS
900 END
910 *AREASC
920 GOTO *FIELDCNT
930 COLOR 7
940 *FLAGC
950 IF FLAGS$="DOT" THEN *FDOT ELSE IF FLAGS$="LINE" THEN *FLINE ELSE IF FLAGS$="CARV" THEN *FCARV
960 IF FLAGS$="PAINT" THEN *FPAINT ELSE IF FLAGS$="PEN" THEN *FPEN ELSE *AREASC
970 END
980 *FIELDCNT: COLOR 7:XX=1:YY=1
990 IF RST<>0 THEN *SKRSFC ELSE RST=1
1000 LET MCXX=0:MCYY=0:MCXB=0:MCYB=0:MCX=0:MCY=0:MCXR=0:MCYR=0:MSX=0:MSY=0:FMX=0:FMY=0:
1010 LET MCNX=0:MCNY=0:MCLX=0:MCLY=0:MCLBX=0:MCLBY=0:
1020 LET CLY=0:CLX=0:MSX=0:MSY=0:MCCL=0:MCCR=0:MDAD=0:MDADR=0:XXL=0:YYL=0:
1030 *SKRSFC
1040 MSXB=MSX:MSYB=MSY:MCXB=MCX:MCYB=MCY:MCXRB=MCXR:MCYRB=MCYR
1050 IF IVE=1 AND IVC=1 THEN IVC=99
1060 IF MCX=0 OR MCY=0 THEN MCX=MSX:MCY=MSY
1070 MSX=MOUSE(0):MSY=MOUSE(1):MCCL=MOUSE(3,1):MCCR=MOUSE(3,2):MDAD=MOUSE(2,1):MDADR=MOUSE(2,2)
1080 IF MSX=0 OR MSY=0 THEN MSX=MOUSE(0):MSY=MOUSE(1)
1090 *COUNTERA
1100 IF IVC>1 AND UDX(IVC)=UDX(IVC-1) AND UDY(IVC)=UDY(IVC-1) AND NOT UDX(IVC)=0 AND FLAGS$="LINE" THEN *DOUBLEPROCESS
1110 IF IVC>1 AND UDX(IVC)=UDX(IVC-1) AND UDY(IVC)=UDY(IVC-1) AND NOT UDX(IVC)=0 AND FLAGS$="CARV" THEN *DOUBLEPROCESS
1120 IF IVC>1 AND IVX(IVC)+4>IVX(IVC-1) AND IVX(IVC)-4<IVX(IVC-1) AND IVY(IVC)+4>IVY(IVC-1) AND IVY(IVC)-4<IVY(IVC-1) AND NOT IVX(IVC)=0 AND FLAGS$="LINE" THEN *DOUBLEPROCESS
1130 IF IVC>1 AND IVX(IVC)+4>IVX(IVC-1) AND IVX(IVC)-4<IVX(IVC-1) AND IVY(IVC)+4>IVY(IVC-1) AND IVY(IVC)-4<IVY(IVC-1) AND NOT IVX(IVC)=0 AND FLAGS$="CARV" THEN *DOUBLEPROCESS
1140 LOCATE 0,0:PRINT " "
1150 *DSKIP
1160 CLX=0:CLY=0:RB=0:T=0:WHILE T<1
1170 IF MCCL<>MOUSE(3,1) THEN CPASS=1:MCCL=MOUSE(3,1)
1180 IF MCCR<>MOUSE(3,2) THEN RB=1:CPASS=2:MCCR=MOUSE(3,2)
1190 IF CPASS=1 THEN CPASS=0:T=1:CLX=MOUSE(4,1):CLY=MOUSE(5,1)
1200 IF CPASS=2 THEN CPASS=0:T=1:MCYR=MOUSE(5,2):MCXR=MOUSE(4,2)
1210 WEND::MSX=MOUSE(0):MSY=MOUSE(1):LOCATE 20,10:PRINT"CLICK"
1220 IF CLX<20 OR CLY<20 OR CLY>468 THEN *COUNTERA
1230 IF RB=1 THEN IF MCXR<20 OR MCYR<20 OR MCXR>468 OR MCYR>468 THEN *COUNTERA
1240 IVC=IVC+1:IF IVC=100 THEN IVC=1
1250 IF CLX>468 THEN IVX(IVC)=CLX:IVY(IVC)=CLY:GOTO *TOOLS
1260 IF CLX=0 OR CLY=0 THEN IF RB=0 THEN *COUNTERA
1270 IF CLX=MCX AND CLY=MCY AND FLAGS$="LINE" THEN IF DOUBLE=0 THEN *DOUBLEPROCESS
1280 IF CLX=MCX AND CLY=MCY AND FLAGS$="CARV" THEN IF DOUBLE=0 THEN *DOUBLEPROCESS
1290 IF CLX+5>MCX AND CLX-5<MCX AND CLY+5>MCY AND CLY-5<MCY AND FLAGS$="LINE" THEN IF DOUBLE="0" THEN *DOUBLEPROCESS
1300 IF CLX+5>MCX AND CLX-5<MCX AND CLY+5>MCY AND CLY-5<MCY AND FLAGS$="CARV" THEN IF DOUBLE="0" THEN *DOUBLEPROCESS
1310 IF MCX<>CLX OR MCY<>CLY AND CLX<>0 AND CLY<>0 THEN MCX=CLX:MCY=CLY:LOCATE 20,10:PRINT"CLICKB"
1320 IF MSX=0 OR MSY=0 THEN MSX=MOUSE(0):MSY=MOUSE(1)
1330 IF MCX=0 OR MCY=0 THEN MCX=MOUSE(4,1):MCY=MOUSE(5,1)
1340 MCX=CLX:MCY=CLY
1350 *LBBLC
1360 IF IVC=100 THEN IVC=1
1370 DOUBLE=0
1380 IF MCX>468 AND MCX<20 OR MCY>468 OR MCY<20 THEN *AREASC
1390 IF MCX=MCXM AND MCY=MCYM THEN *RBBLC
1400 MCXX=MCX:IVX(IVC)=MCX:MCYY=MCY:IVY(IVC)=MCY
1410 REM IF IVX(IVC-1)=MCX OR IVY(IVC-1)=MCY THEN DOUBLE=1
1420 FOR I=1 TO 64:FOR T=1 TO 64:
1430 IF T*7+13<MSX AND T*7+20>MSX THEN FMX=T
1440 NEXT T:IF I*7+13<MSY AND I*7+20>MSY THEN FMY=I:
1450 NEXT I:LB=0
1460 FOR I=1 TO 64:FOR T=1 TO 64:
1470 IF T*7+13<MCX AND T*7+20>MCX THEN UDX(IVC)=T
1480 NEXT T:IF I*7+13<MCY AND I*7+20>MCY THEN UDY(IVC)=I
1490 NEXT I:LB=0:
1500 LOCATE 20,20:PRINT DOUBLE
1510 *ZEROSKIP
1520 IF IVX(IVC)=0 THEN IVX(IVC)=MSX
1530 IF IVY(IVC)=0 THEN IVY(IVC)=MSY
1540 IF UDX(IVC)=0 AND IVX(IVC)<>0 THEN *MEPROCESS
1550 IF UDY(IVC)=0 AND IVY(IVC)<>0 THEN *MEPROCESS
1560 GOTO *RBBLC
1570 *MEPROCESS
1580 MCXX=MSX:IVX(IVC)=MSX:MCYY=MSY:IVY(IVC)=MSY
1590 FOR I=1 TO 64:FOR T=1 TO 64:
1600 IF T*7+20<MSX AND T*7+27>MSX THEN UDX(IVC)=T:
1610 NEXT T:IF I*7+20<MSY AND I*7+27>MSY THEN UDY(IVC)=I:
1620 NEXT I:LB=0
1630 IF UDX(IVC)=0 AND UDY(IVC)=0 THEN MSX=MOUSE(0):MSY=MOUSE(1):GOTO *MEPROCESS
1640 IF UDX(IVC)=0 THEN MSX=MOUSE(0):GOTO *MEPROCESS
1650 IF UDY(IVC)=0 THEN MSY=MOUSE(1):GOTO *MEPROCESS
1660 *RBBLC REM
1670 IF MCXR=MCXRM AND MCYR=MCYRM THEN *EMC
1680 FOR I=1 TO 64:T=1:WHILE T<65
1690 IF T*7+13<MCXR AND T*7+20>MCXR AND MCX<>0 THEN FRMX=T:
1700 IF I*7+13<MCYR AND I*7+20>MCYR AND MCX<>0 THEN FRMY=I:
1710 IF T*7+13<MCXR AND T*7+20>MCXR AND MCX<>0 THEN MCXR=T*7+13:MCXRM=T
1720 IF I*7+13<MCYR AND I*7+20>MCYR AND MCX<>0 THEN MCYR=I*7+13:MCYRM=I
1730 T=T+1:WEND:NEXT I:LOCATE 0,3:PRINT "RB" RB=0:GOTO *EMC
1740 *EMC
1750 IF MCX>468 AND MCX<20 OR MCY>468 OR MCY<20 THEN *AREASC
1760 IF IVC>1 AND UDX(IVC)<>UDX(IVC-1) THEN XXL=UDX(IVC)-UDX(IVC-1)
1770 IF IVC>1 AND UDY(IVC)<>UDY(IVC-1) THEN YYL=UDY(IVC)-UDY(IVC-1)
1780 IF IVC=100 THEN IVC=1
1790 IF IVC=1 AND UDX(1)<>UDX(99) THEN XXL=UDX(1)-UDX(99)
1800 IF IVC=1 AND UDY(1)<>UDX(99) THEN YYL=UDY(1)-UDY(99)
1810 IF IVC>1 AND XXL=UDX(IVC) THEN XXL=UDX(IVC)-UDX(IVC-1)
1820 IF IVC>1 AND YYL=UDY(IVC) THEN YYL=UDY(IVC)-UDY(IVC-1)
1830 IF IVN<>IVC THEN LOCATE 1,4:PRINT IVX(IVC);T;XXL;UDX(IVC);,IVC;"X "
1840 IF IVN<>IVC THEN LOCATE 1,5:PRINT IVY(IVC);I;YYL;UDY(IVC);"Y "
1850 UDXL(IVC)=XXL:UDYL(IVC)=YYL
1860 IXX=IVX(IVC):IYY=IVY(IVC):IVN=IVC
1870 IF SWICH=0 THEN SWICH=1:GOTO *AREASC
1880 IF DC=1 THEN *AREASC
1890 GOTO *FLAGC
1900 END
1910 *DOUBLEPROCESS
1920 LOCATE 0,0:PRINT "DOUBLE"
1930 IF FLAGS$="LINE" OR FLAGS$="CARV" THEN ELSE MCX=CLX:MCY=CLY:GOTO *LBBLC
1940 MCCL=MOUSE(3,1)
1950 DOUBLE=1:MCX=CLX:MCY=CLY:LOCATE 0,22:PRINT"dp"
1960 IF CLX>468 THEN IF IVC>1 THEN IVC=IVC-1:GOTO *TOOLS ELSE IF IVC=99 THEN IVC=1:GOTO *TOOLS
1970 T=0:WHILE T<1
1980 IF MCCL<>MOUSE(3,1) THEN CPASS=1:MCCL=MOUSE(3,1)
1990 IF MCCR<>MOUSE(3,2) THEN RB=1:CPASS=2:MCCR=MOUSE(3,2)
2000 IF CPASS=1 THEN CPASS=0:T=1:MDCX=MOUSE(4,1):MDCY=MOUSE(5,1)
2010 IF CPASS=2 THEN CPASS=0:T=1:MCYR=MOUSE(5,2):MCXR=MOUSE(4,2)
2020 WEND::MSX=MOUSE(0):MSY=MOUSE(1):LOCATE 10,10:PRINT"mdc1"
2030 IF MDCX>468 THEN IF IVC>1 THEN IVC=IVC-1:GOTO *TOOLS ELSE IF IVC=99 THEN IVC=1:GOTO *TOOLS
2040 IF MDCX<20 OR MDCY<20 OR MDCX>468 OR MDCY>468 THEN *COUNTERA
2050 IF RB=1 THEN IF MCXR<20 OR MCYR<20 OR MCXR>468 OR MCYR>468 THEN *COUNTERA
2060 MSX=MOUSE(0):MSY=MOUSE(1)
2070 IVC=IVC+1:IF IVC=100 THEN IVC=1
2080 IVX(IVC)=MDCX:IVY(IVC)=MDCY
2090 IF MDCX=0 AND MDCY=0 THEN *DOUBLEPROCESS
2100 IF IVX(IVC)<>MDCX AND IVY(IVC)<>MDCY THEN *DOUBLEPROCESS
2110 FOR I=1 TO 64:FOR T=1 TO 64:
2120 IF T*7+20<MDCX AND T*7+27>MDCX THEN UDX(IVC)=T
2130 NEXT T:IF I*7+20<MDCY AND I*7+27>MDCY THEN UDY(IVC)=I
2140 NEXT I:LB=0:
2150 MCX=MDCX:MCY=MDCY
2160 IF UDX(IVC)=0 OR UDY(IVC)=0 THEN GOSUB *SUBPROCESSDC
2170 *DPROCESSB
2180 MCCL=MOUSE(3,1)
2190 T=0:WHILE T<1
2200 IF MCCL<>MOUSE(3,1) THEN CPASS=1:MCCL=MOUSE(3,1)
2210 IF MCCR<>MOUSE(3,2) THEN RB=1:CPASS=2:MCCR=MOUSE(3,2)
2220 IF CPASS=1 THEN CPASS=0:T=1:MDCX=MOUSE(4,1):MDCY=MOUSE(5,1)
2230 IF CPASS=2 THEN CPASS=0:T=1:MCYR=MOUSE(5,2):MCXR=MOUSE(4,2)
2240 WEND::MSX=MOUSE(0):MSY=MOUSE(1):LOCATE 10,10:PRINT"mdc2"
2250 IF CLX>468 THEN *TOOLS
2260 IF MDCX<20 OR MDCY<20 OR MDCX>468 OR MDCY>468 THEN *COUNTERA
2270 IVC=IVC+1:IF IVC=100 THEN IVC=1
2280 IF RB=1 THEN IF MCXR<20 OR MCYR<20 OR MCXR>468 OR MCYR>468 THEN *COUNTERA
2290 IVX(IVC)=MDCX:IVY(IVC)=MDCY
2300 IF MDCX=0 AND MDCY=0 THEN *DPROCESSB
2310 IF IVX(IVC)<>MDCX AND IVY(IVC)<>MDCY THEN *DPROCESSB
2320 FOR I=1 TO 64:FOR T=1 TO 64:
2330 IF T*7+13<MDCX AND T*7+20>MDCX THEN UDX(IVC)=T
2340 NEXT T:IF I*7+13<MDCY AND I*7+20>MDCY THEN UDY(IVC)=I
2350 NEXT I:LB=0:
2360 MCX=MDCX:MCY=MDCY
2370 MSX=MOUSE(0):MSY=MOUSE(1)
2380 IF UDX(IVC)=0 OR UDY(IVC)=0 THEN GOSUB *SUBPROCESSDC
2390 IF IVN<>IVC THEN LOCATE 1,4:PRINT IVX(IVC);T;XXL;UDX(IVC);,IVC;"X "
2400 IF IVN<>IVC THEN LOCATE 1,5:PRINT IVY(IVC);I;YYL;UDY(IVC);"Y "
2410 *DPROCESSC
2420 MCCL=MOUSE(3,1)
2430 T=0:WHILE T<1
2440 IF MCCL<>MOUSE(3,1) THEN CPASS=1:MCCL=MOUSE(3,1)
2450 IF MCCR<>MOUSE(3,2) THEN RB=1:CPASS=2:MCCR=MOUSE(3,2)
2460 IF CPASS=1 THEN CPASS=0:T=1:MCX=MOUSE(4,1):MCY=MOUSE(5,1)
2470 IF CPASS=2 THEN CPASS=0:T=1:MCYR=MOUSE(5,2):MCXR=MOUSE(4,2)
2480 WEND::MSX=MOUSE(0):MSY=MOUSE(1):LOCATE 10,10:PRINT"mdc3"
2490 IF CLX>468 THEN *TOOLS
2500 IF MCX<20 OR MCY<20 OR MCX>468 OR MCY>468 THEN *COUNTERA
2510 IF RB=1 THEN IF MCXR<20 OR MCYR<20 OR MCXR>468 OR MCYR>468 THEN *COUNTERA
2520 MSX=MOUSE(0):MSY=MOUSE(1)
2530 IVC=IVC+1:IF IVC=100 THEN IVC=1
2540 IF MCX=0 OR MCY=0 THEN *DPROCESSC
2550 IVX(IVC)=MCX:IVY(IVC)=MCY
2560 FOR I=1 TO 64:FOR T=1 TO 64:
2570 IF (T*7)+20<MCX AND (T*7)+27>MCX THEN UDX(IVC)=T
2580 NEXT T:IF (I*7)+20<MCY AND (I*7)+27>MCY THEN UDY(IVC)=I
2590 NEXT I:LB=0:
2600 IF UDX(IVC)=0 OR UDY(IVC)=0 THEN GOSUB *SUBPROCESSDC
2610 *EMDC
2620 IF IVC>1 AND UDX(IVC)<>UDX(IVC-1) THEN XXL=UDX(IVC)-UDX(IVC-1)
2630 IF IVC>1 AND UDY(IVC)<>UDY(IVC-1) THEN YYL=UDY(IVC)-UDY(IVC-1)
2640 IF IVC=100 THEN IVC=1:RFOF=1
2650 IF IVC=1 AND UDX(1)<>UDX(99) THEN XXL=UDX(1)-UDX(99)
2660 IF IVC=1 AND UDY(1)<>UDX(99) THEN YYL=UDY(1)-UDY(99)
2670 IF IVC>1 AND XXL=UDX(IVC) THEN XXL=UDX(IVC)-UDX(IVC-1)
2680 IF IVC>1 AND YYL=UDY(IVC) THEN YYL=UDY(IVC)-UDY(IVC-1)
2690 IF IVN<>IVC THEN LOCATE 1,8:PRINT IVX(IVC);T;XXL;UDX(IVC);,IVC;"X "
2700 IF IVN<>IVC THEN LOCATE 1,9:PRINT IVY(IVC);I;YYL;UDY(IVC);"Y "
2710 UDXL(IVC)=XXL:UDYL(IVC)=YYL
2720 PRINT"AAAAAAAAAAAAAAA":DOUBLE=0:IF RFOF=1 AND IVC=1 THEN *REFRESHOF ELSE GOTO *FLAGC
2730 END
2740 *SUBPROCESSDC
2750 FOR I=1 TO 64:FOR T=1 TO 64:
2760 IF T*7+13<MSX AND T*7+20>MSX THEN UDX(IVC)=T:
2770 NEXT T:IF I*7+13<MSY AND I*7+20>MSY THEN UDY(IVC)=I:
2780 NEXT I:LB=0
2790 IF UDX(IVC)=0 AND UDY(IVC)=0 THEN MSX=MOUSE(0):MSY=MOUSE(1):GOTO *SUBPROCESSDC
2800 IF UDX(IVC)=0 THEN MSX=MOUSE(0):GOTO *SUBPROCESSDC
2810 IF UDY(IVC)=0 THEN MSY=MOUSE(1):GOTO *SUBPROCESSDC
2820 RETURN
2830 *REFRESHOF
2840 IF RFOF=1 THEN RFOF=0
2850 FOR I=2 TO 99:MIV=MIV+1:IF MIV=256 THEN MIV=0:MIVCNT=MIVCNT+1:IF MIVCNT=64 THEN MIVCNT=0:MIV=0
2860 IVENTMOTION(MIV,1,CNTMIV)=UDX(I):UDX(I)=0:IVENTMOTION(MIV,2,CNTMIV)=UDY(I):UDY(I)=0:
2870 IVENTMOTION(MIV,3,CNTMIV)=UDXL(I):UDXL(I)=0:IVENTMOTION(MIV,4,CNTMIV)=UDYL(I):UDYL(I)=0:
2880 IVENTMOTION(MIV,5,CNTMIV)=IVX(I):IVX(I)=0:IVENTMOTION(MIV,6,CNTMIV)=IVY(I):IVY(I)=0:
2890 IMF$(MIV,CNTMIV)=IVFLAGS$(I):NEXT
2900 GOTO *FLAGC
2910 END
2920 *DITHERMAPPING
2930 REM darksolid / Hevypale / Hevyharf / harf / light / lightpale / lightsolid
2940 DATA "11111111","11111111","11111111","01010101","00000000","00000000","00000000","10000001"
2950 DATA "11111111","10111011","10101010","10101010","10101010","00100010","00000000","01000010"
2960 DATA "11111111","11111111","11111111","01010101","00000000","00000000","00000000","00100100"
2970 DATA "11111111","11101110","10101010","10101010","10101010","10001000","00000000","00011000"
2980 DATA "11111111","11111111","11111111","01010101","00000000","00000000","00000000","00011000"
2990 DATA "11111111","10111011","10101010","10101010","10101010","00100010","00000000","00100100"
3000 DATA "11111111","11111111","11111111","01010101","00000000","00000000","00000000","01000010"
3010 DATA "11111111","11101110","10101010","10101010","10101010","10001000","00000000","10000001"
3020 FOR T=1 TO 8:FOR I=1 TO 8:READ DM$(T,I):NEXT I:NEXT T
3030 FOR R=1 TO 8:FOR T=1 TO 8:RN=0:FOR I=1 TO 8:RN=RN+1:DMS=VAL(RIGHT$(LEFT$(DM$(T,R),RN),1))
3040 DMS$=LEFT$(DM$(T,R),9-I):DMS$=RIGHT$(DMS$,1):DMS=VAL(DMS$)
3050 DM(I,T,R)=DMS:NEXT I:NEXT T:NEXT R
3060 TT=0:FOR T=1 TO 64:II=0:TT=TT+1:FOR I=1 TO 8:II=II+1:REM PRINT DM(II,TT,1);"+++";:
3070 IF TT>8 THEN TT=1
3080 DLG=DM(II,TT,1)
3090 DARKSOLID(I,T)=DLG:DARKSOLID(8+I,T)=DLG:DARKSOLID(16+II,T)=DLG
3100 DARKSOLID(24+II,T)=DLG:DARKSOLID(32+II,T)=DLG:DARKSOLID(40+II,T)=DLG
3110 DARKSOLID(48+II,T)=DLG:DARKSOLID(56+II,T)=DLG
3120 DLG=DM(II,TT,2)
3130 HEVYPALE(I,T)=DLG:HEVYPALE(8+II,T)=DLG:HEVYPALE(16+II,T)=DLG
3140 HEVYPALE(24+II,T)=DLG:HEVYPALE(32+II,T)=DLG:HEVYPALE(40+II,T)=DLG
3150 HEVYPALE(48+II,T)=DLG:HEVYPALE(56+II,T)=DLG
3160 DLG=DM(II,TT,3)
3170 HEVYHARF(I,T)=DLG:HEVYHARF(8+II,T)=DLG:HEVYHARF(16+II,T)=DLG
3180 HEVYHARF(24+II,T)=DLG:HEVYHARF(32+II,T)=DLG:HEVYHARF(40+II,T)=DLG
3190 HEVYHARF(48+II,T)=DLG:HEVYHARF(56+II,T)=DLG
3200 DLG=DM(II,TT,4)
3210 HARF(I,T)=DLG:HARF(8+II,T)=DLG:HARF(16+II,T)=DLG
3220 HARF(24+II,T)=DLG:HARF(32+II,T)=DLG:HARF(40+II,T)=DLG
3230 HARF(48+I,T)=DLG:HARF(56+II,T)=DLG
3240 DLG=DM(II,TT,5)
3250 LIGHT(I,T)=DLG:LIGHT(8+II,T)=DLG:LIGHT(16+II,T)=DLG
3260 LIGHT(24+II,T)=DLG:LIGHT(32+II,T)=DLG:LIGHT(40+II,T)=DLG
3270 LIGHT(48+II,T)=DLG:LIGHT(56+II,T)=DLG
3280 DLG=DM(II,TT,6)
3290 LIGHTPALE(I,T)=DLG:LIGHTPALE(8+II,T)=DLG:LIGHTPALE(16+II,T)=DLG
3300 LIGHTPALE(24+II,T)=DLG:LIGHTPALE(32+II,T)=DLG:LIGHTPALE(40+II,T)=DLG
3310 LIGHTPALE(48+II,T)=DLG:LIGHTPALE(56+II,T)=DLG
3320 DLG=DM(II,TT,7)
3330 LIGHTSOLID(I,T)=DLG:LIGHTSOLID(8+II,T)=DLG:LIGHTSOLID(16+II,T)=DLG
3340 LIGHTSOLID(24+II,T)=DLG:LIGHTSOLID(32+II,T)=DLG:LIGHTSOLID(40+II,T)=DLG
3350 LIGHTSOLID(48+II,T)=DLG:LIGHTSOLID(56+II,T)=DLG
3360 DLG=DM(II,TT,8)
3370 CHECKBOX(I,T)=DLG:CHECKBOX(8+II,T)=DLG:CHECKBOX(16+II,T)=DLG
3380 CHECKBOX(24+II,T)=DLG:CHECKBOX(32+II,T)=DLG:CHECKBOX(40+II,T)=DLG
3390 CHECKBOX(48+II,T)=DLG:CHECKBOX(56+II,T)=DLG
3400 NEXT I:NEXT T
3410 :::::::::::::::::::::: REM DM2 PROCESS
3420 FOR T=1 TO 64:FOR I=1 TO 64:DM2(I,T,1)=DARKSOLID(I,T):NEXT I:NEXT T
3430 FOR T=1 TO 64:FOR I=1 TO 64:DM2(I,T,2)=HEVYPALE(I,T):NEXT I:NEXT T
3440 FOR T=1 TO 64:FOR I=1 TO 64:DM2(I,T,3)=HEVYHARF(I,T):NEXT I:NEXT T
3450 FOR T=1 TO 64:FOR I=1 TO 64:DM2(I,T,4)=HARF(I,T):NEXT I:NEXT T
3460 FOR T=1 TO 64:FOR I=1 TO 64:DM2(I,T,5)=LIGHT(I,T):NEXT I:NEXT T
3470 FOR T=1 TO 64:FOR I=1 TO 64:DM2(I,T,6)=LIGHTPALE(I,T):NEXT I:NEXT T
3480 FOR T=1 TO 64:FOR I=1 TO 64:DM2(I,T,7)=LIGHTSOLID(I,T):NEXT I:NEXT T
3490 FOR T=1 TO 64:FOR I=1 TO 64:DM2(I,T,8)=CHECKBOX(I,T):NEXT I:NEXT T
3500 RETURN
2023.01.23(Mon)
福岡大
10 REM *****************************************
20 REM * Programed by Dai Fukuoka 2011.01.7 *
30 REM * copyright 2011.01.7-1.30 *
40 REM * DotPresetEditor2011β *
50 REM *****************************************7430-7680 8330
60 *START
70 WIDTH 80,25:CONSOLE 0,25,0,1:SCREEN 3,0,0,1:COLOR 0,7,0,7,2:CLS 2
80 YY$=LEFT$(DATE$,2):MM$=RIGHT$(DATE$,5):MM$=LEFT$(MM$,2):DD$=RIGHT$(DATE$,2)
90 MOUSE(2)ON:MOUSE(3)ON
100 REM ON ERROR GOTO *ERRCD
110 LET FLAGS$="LINE":LET LMP=7:LET RMP=0:CX=1:CY=1
120 LET FLX=0:LET FLY=0:LET FLS=2::D=0:C=0:CP=7:LET LAY=0
130 LET RST=0:IVC=99:DIM IVX(99):DIM IVY(99):LET LAY=0:LET BG=0:LET BC=0
140 DIM UDX(99):DIM UDY(99):DIM UDF$(99):DIM UNDO(64,64,99)
150 DIM LAYER(65,65,7):DIM DITH(64,64,4):DIM W(64,64):DIM T(64,64):
160 DIM UDXL(99):DIM UDYL(99):DIM MOVABLEMAP(8,8,5)
170 DIM Y(64,64):DIM LAYER$(65,65,7):LET LAYER$="":DIM DATAFLOOR$(64,7)
180 DIM MASK(64,64):DIM IVPENTRM(99):REM DIM IVPENX(4096,99):DIM IVPENY(4096,99)
190 DIM IVXL(64,99):DIM IVYL(64,99):DIM IVFLAGS$(99)
200 DIM RAMSAVE(64,64,7):DIM IVENTMOTION(256,8,64):DIM IMF$(256,64)
210 DIM DARKSOLID(64,64):DIM HEVYPALE(64,64):DIM HEVYHARF(64,64):DIM HARF(64,64):
220 DIM LIGHT(64,64):DIM LIGHTPALE(64,64):DIM LIGHTSOLID(64,64):DIM CP(128,128,8)
230 DIM DM$(8,8):DIM DM(64,64,8):DIM DM2(64,64,8):DIM CHECKBOX(64,64):DIM MLCLOUMN(80,25,2):DIM MLC(80):DIM MLF(25):DIM MLCP(80):DIM MLFP(25)
240 IF MOVABLEMAP(SELECTBLOCX,SELECTBLOCY,1)=8 THEN GOSUB *BLUPMASK
250 IF MOVABLEMAP(SELECTBLOCX,SELECTBLOCY,2)=4 THEN GOSUB *BLLFMASK
260 IF MOVABLEMAP(SECECTBLOCX,SELECTBLOCY,3)=6 THEN GOSUB *BLRIMASK
270 IF POINT(639,399)=POINT(639,479) THEN SHOWVIEW=1 ELSE SHOWVIEW=-1
280 *NEARDISTANCE LET X=0:LET Y=0
290 IF SHOWVIEW=-1 THEN FOR I=0 TO 79 STEP 1:MLCP(I)=I*8 :NEXT
300 IF SHOWVIEW=-1 THEN FOR I=0 TO 24 STEP 1:MLFP(I)=I*16:NEXT
310 *LONGDISTANCE LET X=0:LET Y=0
320 IF SHOWVIEW=1 THEN FOR I=0 TO 79 STEP 1:MLCP(I) =I*8 :NEXT
330 IF SHOWVIEW=1 THEN FOR I=1 TO 25 STEP 1:MLFP(I) =I*18.8#:NEXT
340 ::
350 DIM BLPASS(8,8):DIM BLSTART(8,8)
360 LET DFL=1
370 REM GOSUB *DITHERMAPPING:GOSUB *DITHERFILTERLING:GOSUB *PREDISPLAYPASS
380 *RUNNINGPROGRAM
390 GOSUB *DITHERFILTERLING
400 LINE(0,0)-(640,480),15,BF:LINE(20,20)-(468,468),0,BF
410 FOR I=20 TO 468 STEP 7:LINE (I,20)-(I,468),12:NEXT I
420 FOR T=20 TO 468 STEP 7:LINE (20,T)-(468,T),12:NEXT T
430 LINE (488,18)-(616,468),7,BF:COLOR 0:LOCATE 61,2:PRINT"COLOR PALLETE"
440 I=0:IF PE=0 THEN FOR C=61 TO 76:LINE (MLCP(C),MLFP(2))-(MLCP(C+1),MLFP(3)),I,BF:I=I+1:NEXT C:PE=1
450 GOSUB *REFRESHTXT:GOTO *SETTING
460 *REFRESHTXT
470 COLOR 0:LOCATE 61,2:PRINT"COLOR PALLETE"
480 LOCATE 61,5:PRINT"COLOR LEVEL 0":LOCATE 61,6:PRINT"000 RGB"
490 LOCATE 61,7:PRINT"0123456789ABCDEF"
500 LOCATE 61,8:PRINT"DITHER 0-7< 01 >":LOCATE 61,10:PRINT"TOOL BOX"
510 LOCATE 61,11:PRINT"LINE / CARV":LOCATE 61,12:PRINT"PAINT / DOT"
520 LOCATE 61,13:PRINT"LAYER 012345 M/C":LOCATE 61,14:PRINT"PEN C / B 3 5":LOCATE 61,15:PRINT"SPOIT / GLID"
530 LOCATE 61,16:PRINT"UNDO 00 / RESET"
540 LOCATE 61,18:PRINT"FILE COMMAND":LOCATE 61,19:PRINT"RAM SAVE LOAD":LOCATE 61,20:PRINT"DISK SAVE LOAD"
550 LOCATE 61,21:PRINT":MYPIC"+YY$+MM$+DD$+".ASC":LOCATE 61,22:PRINT"STATUS"
560 LOCATE 61,23:PRINT"MATRIX X:64 Y:64":LOCATE 61,24:PRINT"/ LINE"
570 RETURN:::::
580 *SETTING
590 FOR X=0 TO 1:FOR I=1 TO 64:FOR T=1 TO 64:LET LAYER(I,T,X)=0:NEXT T:NEXT I:NEXT X
600 P=1:LBX=4:LBY=13:GOSUB *CP
610 P=2:LBX=13:LBY=13:GOSUB *CP
620 P=3:LBX=7:LBY=7:GOSUB *CP
630 P=5:LBX=0:LBY=5:GOSUB *CP
640 P=4:LBX=5:LBY=5:GOSUB *CP
650 P=0:LBX=0:LBY=2:GOSUB *CP
660 P=6:LBX=7:LBY=2:GOSUB *CP
670 GOTO *ASKIP
680 *LOBX
690 I=61:WHILE I<76:I=I+1:IF I<>LBX THEN WEND:I=0 ELSE *LOBXA
700 *LOBXA:LINE(MLCP(LBX+61),MLFP(LBY))-(MLCP(LBX+62),MLFP(LBY+1)),P,B:RETURN
710 *CP:I=61:WHILE I<76:I=I+1:IF NOT I=LBX THEN ELSE *CPB:GOTO *LOBF
720 WEND
730 *CPB :LINE(MLCP(LBX+61),MLFP(LBY))-(MLCP(LBX+62),MLFP(LBY+1)),P,B:RETURN
740 *LOBF I=61:WHILE I<76:I=I+1:IF NOT I=LBX AND I=0 THEN ELSE *LOBFA
750 WEND
760 *LOBFA RETURN
770 *ASKIP CX=1:CY=1:X=1:Y=1:LB=0:RB=0
780 LET A=0
790 *GOMOUSE CXB=CX:CYB=CY:XB=X:YB=Y
800 *CLICKMOUSE
810 X=MOUSE(0):Y=MOUSE(1)
820 IF CX<>MOUSE(4,1) OR CY<>MOUSE(5,1) THEN IF CX<>0 AND CY<>0 THEN CX=MOUSE(4,1):CY=MOUSE(5,1)
830 RCX=MOUSE(4,2):RCY=MOUSE(5,2):IF RCX<>O OR RCY<>0 THEN RB=1
840 GOTO *MOUSEIF:
850 *GTM GOTO *GOMOUSE
860 *MOUSEIF IF CXB<>CX OR CYB<>CY OR XB<>X OR YB<>Y THEN *MENUS ELSE *GTM
870 GOTO *MENUS
880 END
890 *MENUS IF CX<469 OR X<469 THEN *AREASC ELSE IF CX>469 OR X>469 THEN *TOOLS
900 END
910 *AREASC
920 GOTO *FIELDCNT
930 COLOR 7
940 *FLAGC
950 IF FLAGS$="DOT" THEN *FDOT ELSE IF FLAGS$="LINE" THEN *FLINE ELSE IF FLAGS$="CARV" THEN *FCARV
960 IF FLAGS$="PAINT" THEN *FPAINT ELSE IF FLAGS$="PEN" THEN *FPEN ELSE *AREASC
970 END
980 *FIELDCNT: COLOR 7:XX=1:YY=1
990 IF RST<>0 THEN *SKRSFC ELSE RST=1
1000 LET MCXX=0:MCYY=0:MCXB=0:MCYB=0:MCX=0:MCY=0:MCXR=0:MCYR=0:MSX=0:MSY=0:FMX=0:FMY=0:
1010 LET MCNX=0:MCNY=0:MCLX=0:MCLY=0:MCLBX=0:MCLBY=0:
1020 LET CLY=0:CLX=0:MSX=0:MSY=0:MCCL=0:MCCR=0:MDAD=0:MDADR=0:XXL=0:YYL=0:
1030 *SKRSFC
1040 MSXB=MSX:MSYB=MSY:MCXB=MCX:MCYB=MCY:MCXRB=MCXR:MCYRB=MCYR
1050 IF IVE=1 AND IVC=1 THEN IVC=99
1060 IF MCX=0 OR MCY=0 THEN MCX=MSX:MCY=MSY
1070 MSX=MOUSE(0):MSY=MOUSE(1):MCCL=MOUSE(3,1):MCCR=MOUSE(3,2):MDAD=MOUSE(2,1):MDADR=MOUSE(2,2)
1080 IF MSX=0 OR MSY=0 THEN MSX=MOUSE(0):MSY=MOUSE(1)
1090 *COUNTERA
1100 IF IVC>1 AND UDX(IVC)=UDX(IVC-1) AND UDY(IVC)=UDY(IVC-1) AND NOT UDX(IVC)=0 AND FLAGS$="LINE" THEN *DOUBLEPROCESS
1110 IF IVC>1 AND UDX(IVC)=UDX(IVC-1) AND UDY(IVC)=UDY(IVC-1) AND NOT UDX(IVC)=0 AND FLAGS$="CARV" THEN *DOUBLEPROCESS
1120 IF IVC>1 AND IVX(IVC)+4>IVX(IVC-1) AND IVX(IVC)-4<IVX(IVC-1) AND IVY(IVC)+4>IVY(IVC-1) AND IVY(IVC)-4<IVY(IVC-1) AND NOT IVX(IVC)=0 AND FLAGS$="LINE" THEN *DOUBLEPROCESS
1130 IF IVC>1 AND IVX(IVC)+4>IVX(IVC-1) AND IVX(IVC)-4<IVX(IVC-1) AND IVY(IVC)+4>IVY(IVC-1) AND IVY(IVC)-4<IVY(IVC-1) AND NOT IVX(IVC)=0 AND FLAGS$="CARV" THEN *DOUBLEPROCESS
1140 LOCATE 0,0:PRINT " "
1150 *DSKIP
1160 CLX=0:CLY=0:RB=0:T=0:WHILE T<1
1170 IF MCCL<>MOUSE(3,1) THEN CPASS=1:MCCL=MOUSE(3,1)
1180 IF MCCR<>MOUSE(3,2) THEN RB=1:CPASS=2:MCCR=MOUSE(3,2)
1190 IF CPASS=1 THEN CPASS=0:T=1:CLX=MOUSE(4,1):CLY=MOUSE(5,1)
1200 IF CPASS=2 THEN CPASS=0:T=1:MCYR=MOUSE(5,2):MCXR=MOUSE(4,2)
1210 WEND::MSX=MOUSE(0):MSY=MOUSE(1):LOCATE 20,10:PRINT"CLICK"
1220 IF CLX<20 OR CLY<20 OR CLY>468 THEN *COUNTERA
1230 IF RB=1 THEN IF MCXR<20 OR MCYR<20 OR MCXR>468 OR MCYR>468 THEN *COUNTERA
1240 IVC=IVC+1:IF IVC=100 THEN IVC=1
1250 IF CLX>468 THEN IVX(IVC)=CLX:IVY(IVC)=CLY:GOTO *TOOLS
1260 IF CLX=0 OR CLY=0 THEN IF RB=0 THEN *COUNTERA
1270 IF CLX=MCX AND CLY=MCY AND FLAGS$="LINE" THEN IF DOUBLE=0 THEN *DOUBLEPROCESS
1280 IF CLX=MCX AND CLY=MCY AND FLAGS$="CARV" THEN IF DOUBLE=0 THEN *DOUBLEPROCESS
1290 IF CLX+5>MCX AND CLX-5<MCX AND CLY+5>MCY AND CLY-5<MCY AND FLAGS$="LINE" THEN IF DOUBLE="0" THEN *DOUBLEPROCESS
1300 IF CLX+5>MCX AND CLX-5<MCX AND CLY+5>MCY AND CLY-5<MCY AND FLAGS$="CARV" THEN IF DOUBLE="0" THEN *DOUBLEPROCESS
1310 IF MCX<>CLX OR MCY<>CLY AND CLX<>0 AND CLY<>0 THEN MCX=CLX:MCY=CLY:LOCATE 20,10:PRINT"CLICKB"
1320 IF MSX=0 OR MSY=0 THEN MSX=MOUSE(0):MSY=MOUSE(1)
1330 IF MCX=0 OR MCY=0 THEN MCX=MOUSE(4,1):MCY=MOUSE(5,1)
1340 MCX=CLX:MCY=CLY
1350 *LBBLC
1360 IF IVC=100 THEN IVC=1
1370 DOUBLE=0
1380 IF MCX>468 AND MCX<20 OR MCY>468 OR MCY<20 THEN *AREASC
1390 IF MCX=MCXM AND MCY=MCYM THEN *RBBLC
1400 MCXX=MCX:IVX(IVC)=MCX:MCYY=MCY:IVY(IVC)=MCY
1410 REM IF IVX(IVC-1)=MCX OR IVY(IVC-1)=MCY THEN DOUBLE=1
1420 FOR I=1 TO 64:FOR T=1 TO 64:
1430 IF T*7+13<MSX AND T*7+20>MSX THEN FMX=T
1440 NEXT T:IF I*7+13<MSY AND I*7+20>MSY THEN FMY=I:
1450 NEXT I:LB=0
1460 FOR I=1 TO 64:FOR T=1 TO 64:
1470 IF T*7+13<MCX AND T*7+20>MCX THEN UDX(IVC)=T
1480 NEXT T:IF I*7+13<MCY AND I*7+20>MCY THEN UDY(IVC)=I
1490 NEXT I:LB=0:
1500 LOCATE 20,20:PRINT DOUBLE
1510 *ZEROSKIP
1520 IF IVX(IVC)=0 THEN IVX(IVC)=MSX
1530 IF IVY(IVC)=0 THEN IVY(IVC)=MSY
1540 IF UDX(IVC)=0 AND IVX(IVC)<>0 THEN *MEPROCESS
1550 IF UDY(IVC)=0 AND IVY(IVC)<>0 THEN *MEPROCESS
1560 GOTO *RBBLC
1570 *MEPROCESS
1580 MCXX=MSX:IVX(IVC)=MSX:MCYY=MSY:IVY(IVC)=MSY
1590 FOR I=1 TO 64:FOR T=1 TO 64:
1600 IF T*7+20<MSX AND T*7+27>MSX THEN UDX(IVC)=T:
1610 NEXT T:IF I*7+20<MSY AND I*7+27>MSY THEN UDY(IVC)=I:
1620 NEXT I:LB=0
1630 IF UDX(IVC)=0 AND UDY(IVC)=0 THEN MSX=MOUSE(0):MSY=MOUSE(1):GOTO *MEPROCESS
1640 IF UDX(IVC)=0 THEN MSX=MOUSE(0):GOTO *MEPROCESS
1650 IF UDY(IVC)=0 THEN MSY=MOUSE(1):GOTO *MEPROCESS
1660 *RBBLC REM
1670 IF MCXR=MCXRM AND MCYR=MCYRM THEN *EMC
1680 FOR I=1 TO 64:T=1:WHILE T<65
1690 IF T*7+13<MCXR AND T*7+20>MCXR AND MCX<>0 THEN FRMX=T:
1700 IF I*7+13<MCYR AND I*7+20>MCYR AND MCX<>0 THEN FRMY=I:
1710 IF T*7+13<MCXR AND T*7+20>MCXR AND MCX<>0 THEN MCXR=T*7+13:MCXRM=T
1720 IF I*7+13<MCYR AND I*7+20>MCYR AND MCX<>0 THEN MCYR=I*7+13:MCYRM=I
1730 T=T+1:WEND:NEXT I:LOCATE 0,3:PRINT "RB" RB=0:GOTO *EMC
1740 *EMC
1750 IF MCX>468 AND MCX<20 OR MCY>468 OR MCY<20 THEN *AREASC
1760 IF IVC>1 AND UDX(IVC)<>UDX(IVC-1) THEN XXL=UDX(IVC)-UDX(IVC-1)
1770 IF IVC>1 AND UDY(IVC)<>UDY(IVC-1) THEN YYL=UDY(IVC)-UDY(IVC-1)
1780 IF IVC=100 THEN IVC=1
1790 IF IVC=1 AND UDX(1)<>UDX(99) THEN XXL=UDX(1)-UDX(99)
1800 IF IVC=1 AND UDY(1)<>UDX(99) THEN YYL=UDY(1)-UDY(99)
1810 IF IVC>1 AND XXL=UDX(IVC) THEN XXL=UDX(IVC)-UDX(IVC-1)
1820 IF IVC>1 AND YYL=UDY(IVC) THEN YYL=UDY(IVC)-UDY(IVC-1)
1830 IF IVN<>IVC THEN LOCATE 1,4:PRINT IVX(IVC);T;XXL;UDX(IVC);,IVC;"X "
1840 IF IVN<>IVC THEN LOCATE 1,5:PRINT IVY(IVC);I;YYL;UDY(IVC);"Y "
1850 UDXL(IVC)=XXL:UDYL(IVC)=YYL
1860 IXX=IVX(IVC):IYY=IVY(IVC):IVN=IVC
1870 IF SWICH=0 THEN SWICH=1:GOTO *AREASC
1880 IF DC=1 THEN *AREASC
1890 GOTO *FLAGC
1900 END
1910 *DOUBLEPROCESS
1920 LOCATE 0,0:PRINT "DOUBLE"
1930 IF FLAGS$="LINE" OR FLAGS$="CARV" THEN ELSE MCX=CLX:MCY=CLY:GOTO *LBBLC
1940 MCCL=MOUSE(3,1)
1950 DOUBLE=1:MCX=CLX:MCY=CLY:LOCATE 0,22:PRINT"dp"
1960 IF CLX>468 THEN IF IVC>1 THEN IVC=IVC-1:GOTO *TOOLS ELSE IF IVC=99 THEN IVC=1:GOTO *TOOLS
1970 T=0:WHILE T<1
1980 IF MCCL<>MOUSE(3,1) THEN CPASS=1:MCCL=MOUSE(3,1)
1990 IF MCCR<>MOUSE(3,2) THEN RB=1:CPASS=2:MCCR=MOUSE(3,2)
2000 IF CPASS=1 THEN CPASS=0:T=1:MDCX=MOUSE(4,1):MDCY=MOUSE(5,1)
2010 IF CPASS=2 THEN CPASS=0:T=1:MCYR=MOUSE(5,2):MCXR=MOUSE(4,2)
2020 WEND::MSX=MOUSE(0):MSY=MOUSE(1):LOCATE 10,10:PRINT"mdc1"
2030 IF MDCX>468 THEN IF IVC>1 THEN IVC=IVC-1:GOTO *TOOLS ELSE IF IVC=99 THEN IVC=1:GOTO *TOOLS
2040 IF MDCX<20 OR MDCY<20 OR MDCX>468 OR MDCY>468 THEN *COUNTERA
2050 IF RB=1 THEN IF MCXR<20 OR MCYR<20 OR MCXR>468 OR MCYR>468 THEN *COUNTERA
2060 MSX=MOUSE(0):MSY=MOUSE(1)
2070 IVC=IVC+1:IF IVC=100 THEN IVC=1
2080 IVX(IVC)=MDCX:IVY(IVC)=MDCY
2090 IF MDCX=0 AND MDCY=0 THEN *DOUBLEPROCESS
2100 IF IVX(IVC)<>MDCX AND IVY(IVC)<>MDCY THEN *DOUBLEPROCESS
2110 FOR I=1 TO 64:FOR T=1 TO 64:
2120 IF T*7+20<MDCX AND T*7+27>MDCX THEN UDX(IVC)=T
2130 NEXT T:IF I*7+20<MDCY AND I*7+27>MDCY THEN UDY(IVC)=I
2140 NEXT I:LB=0:
2150 MCX=MDCX:MCY=MDCY
2160 IF UDX(IVC)=0 OR UDY(IVC)=0 THEN GOSUB *SUBPROCESSDC
2170 *DPROCESSB
2180 MCCL=MOUSE(3,1)
2190 T=0:WHILE T<1
2200 IF MCCL<>MOUSE(3,1) THEN CPASS=1:MCCL=MOUSE(3,1)
2210 IF MCCR<>MOUSE(3,2) THEN RB=1:CPASS=2:MCCR=MOUSE(3,2)
2220 IF CPASS=1 THEN CPASS=0:T=1:MDCX=MOUSE(4,1):MDCY=MOUSE(5,1)
2230 IF CPASS=2 THEN CPASS=0:T=1:MCYR=MOUSE(5,2):MCXR=MOUSE(4,2)
2240 WEND::MSX=MOUSE(0):MSY=MOUSE(1):LOCATE 10,10:PRINT"mdc2"
2250 IF CLX>468 THEN *TOOLS
2260 IF MDCX<20 OR MDCY<20 OR MDCX>468 OR MDCY>468 THEN *COUNTERA
2270 IVC=IVC+1:IF IVC=100 THEN IVC=1
2280 IF RB=1 THEN IF MCXR<20 OR MCYR<20 OR MCXR>468 OR MCYR>468 THEN *COUNTERA
2290 IVX(IVC)=MDCX:IVY(IVC)=MDCY
2300 IF MDCX=0 AND MDCY=0 THEN *DPROCESSB
2310 IF IVX(IVC)<>MDCX AND IVY(IVC)<>MDCY THEN *DPROCESSB
2320 FOR I=1 TO 64:FOR T=1 TO 64:
2330 IF T*7+13<MDCX AND T*7+20>MDCX THEN UDX(IVC)=T
2340 NEXT T:IF I*7+13<MDCY AND I*7+20>MDCY THEN UDY(IVC)=I
2350 NEXT I:LB=0:
2360 MCX=MDCX:MCY=MDCY
2370 MSX=MOUSE(0):MSY=MOUSE(1)
2380 IF UDX(IVC)=0 OR UDY(IVC)=0 THEN GOSUB *SUBPROCESSDC
2390 IF IVN<>IVC THEN LOCATE 1,4:PRINT IVX(IVC);T;XXL;UDX(IVC);,IVC;"X "
2400 IF IVN<>IVC THEN LOCATE 1,5:PRINT IVY(IVC);I;YYL;UDY(IVC);"Y "
2410 *DPROCESSC
2420 MCCL=MOUSE(3,1)
2430 T=0:WHILE T<1
2440 IF MCCL<>MOUSE(3,1) THEN CPASS=1:MCCL=MOUSE(3,1)
2450 IF MCCR<>MOUSE(3,2) THEN RB=1:CPASS=2:MCCR=MOUSE(3,2)
2460 IF CPASS=1 THEN CPASS=0:T=1:MCX=MOUSE(4,1):MCY=MOUSE(5,1)
2470 IF CPASS=2 THEN CPASS=0:T=1:MCYR=MOUSE(5,2):MCXR=MOUSE(4,2)
2480 WEND::MSX=MOUSE(0):MSY=MOUSE(1):LOCATE 10,10:PRINT"mdc3"
2490 IF CLX>468 THEN *TOOLS
2500 IF MCX<20 OR MCY<20 OR MCX>468 OR MCY>468 THEN *COUNTERA
2510 IF RB=1 THEN IF MCXR<20 OR MCYR<20 OR MCXR>468 OR MCYR>468 THEN *COUNTERA
2520 MSX=MOUSE(0):MSY=MOUSE(1)
2530 IVC=IVC+1:IF IVC=100 THEN IVC=1
2540 IF MCX=0 OR MCY=0 THEN *DPROCESSC
2550 IVX(IVC)=MCX:IVY(IVC)=MCY
2560 FOR I=1 TO 64:FOR T=1 TO 64:
2570 IF (T*7)+20<MCX AND (T*7)+27>MCX THEN UDX(IVC)=T
2580 NEXT T:IF (I*7)+20<MCY AND (I*7)+27>MCY THEN UDY(IVC)=I
2590 NEXT I:LB=0:
2600 IF UDX(IVC)=0 OR UDY(IVC)=0 THEN GOSUB *SUBPROCESSDC
2610 *EMDC
2620 IF IVC>1 AND UDX(IVC)<>UDX(IVC-1) THEN XXL=UDX(IVC)-UDX(IVC-1)
2630 IF IVC>1 AND UDY(IVC)<>UDY(IVC-1) THEN YYL=UDY(IVC)-UDY(IVC-1)
2640 IF IVC=100 THEN IVC=1:RFOF=1
2650 IF IVC=1 AND UDX(1)<>UDX(99) THEN XXL=UDX(1)-UDX(99)
2660 IF IVC=1 AND UDY(1)<>UDX(99) THEN YYL=UDY(1)-UDY(99)
2670 IF IVC>1 AND XXL=UDX(IVC) THEN XXL=UDX(IVC)-UDX(IVC-1)
2680 IF IVC>1 AND YYL=UDY(IVC) THEN YYL=UDY(IVC)-UDY(IVC-1)
2690 IF IVN<>IVC THEN LOCATE 1,8:PRINT IVX(IVC);T;XXL;UDX(IVC);,IVC;"X "
2700 IF IVN<>IVC THEN LOCATE 1,9:PRINT IVY(IVC);I;YYL;UDY(IVC);"Y "
2710 UDXL(IVC)=XXL:UDYL(IVC)=YYL
2720 PRINT"AAAAAAAAAAAAAAA":DOUBLE=0:IF RFOF=1 AND IVC=1 THEN *REFRESHOF ELSE GOTO *FLAGC
2730 END
2740 *SUBPROCESSDC
2750 FOR I=1 TO 64:FOR T=1 TO 64:
2760 IF T*7+13<MSX AND T*7+20>MSX THEN UDX(IVC)=T:
2770 NEXT T:IF I*7+13<MSY AND I*7+20>MSY THEN UDY(IVC)=I:
2780 NEXT I:LB=0
2790 IF UDX(IVC)=0 AND UDY(IVC)=0 THEN MSX=MOUSE(0):MSY=MOUSE(1):GOTO *SUBPROCESSDC
2800 IF UDX(IVC)=0 THEN MSX=MOUSE(0):GOTO *SUBPROCESSDC
2810 IF UDY(IVC)=0 THEN MSY=MOUSE(1):GOTO *SUBPROCESSDC
2820 RETURN
2830 *REFRESHOF
2840 IF RFOF=1 THEN RFOF=0
2850 FOR I=2 TO 99:MIV=MIV+1:IF MIV=256 THEN MIV=0:MIVCNT=MIVCNT+1:IF MIVCNT=64 THEN MIVCNT=0:MIV=0
2860 IVENTMOTION(MIV,1,CNTMIV)=UDX(I):UDX(I)=0:IVENTMOTION(MIV,2,CNTMIV)=UDY(I):UDY(I)=0:
2870 IVENTMOTION(MIV,3,CNTMIV)=UDXL(I):UDXL(I)=0:IVENTMOTION(MIV,4,CNTMIV)=UDYL(I):UDYL(I)=0:
2880 IVENTMOTION(MIV,5,CNTMIV)=IVX(I):IVX(I)=0:IVENTMOTION(MIV,6,CNTMIV)=IVY(I):IVY(I)=0:
2890 IMF$(MIV,CNTMIV)=IVFLAGS$(I):NEXT
2900 GOTO *FLAGC
2910 END
2920 *DITHERMAPPING
2930 REM darksolid / Hevypale / Hevyharf / harf / light / lightpale / lightsolid
2940 DATA "11111111","11111111","11111111","01010101","00000000","00000000","00000000","10000001"
2950 DATA "11111111","10111011","10101010","10101010","10101010","00100010","00000000","01000010"
2960 DATA "11111111","11111111","11111111","01010101","00000000","00000000","00000000","00100100"
2970 DATA "11111111","11101110","10101010","10101010","10101010","10001000","00000000","00011000"
2980 DATA "11111111","11111111","11111111","01010101","00000000","00000000","00000000","00011000"
2990 DATA "11111111","10111011","10101010","10101010","10101010","00100010","00000000","00100100"
3000 DATA "11111111","11111111","11111111","01010101","00000000","00000000","00000000","01000010"
3010 DATA "11111111","11101110","10101010","10101010","10101010","10001000","00000000","10000001"
3020 FOR T=1 TO 8:FOR I=1 TO 8:READ DM$(T,I):NEXT I:NEXT T
3030 FOR R=1 TO 8:FOR T=1 TO 8:RN=0:FOR I=1 TO 8:RN=RN+1:DMS=VAL(RIGHT$(LEFT$(DM$(T,R),RN),1))
3040 DMS$=LEFT$(DM$(T,R),9-I):DMS$=RIGHT$(DMS$,1):DMS=VAL(DMS$)
3050 DM(I,T,R)=DMS:NEXT I:NEXT T:NEXT R
3060 TT=0:FOR T=1 TO 64:II=0:TT=TT+1:FOR I=1 TO 8:II=II+1:REM PRINT DM(II,TT,1);"+++";:
3070 IF TT>8 THEN TT=1
3080 DLG=DM(II,TT,1)
3090 DARKSOLID(I,T)=DLG:DARKSOLID(8+I,T)=DLG:DARKSOLID(16+II,T)=DLG
3100 DARKSOLID(24+II,T)=DLG:DARKSOLID(32+II,T)=DLG:DARKSOLID(40+II,T)=DLG
3110 DARKSOLID(48+II,T)=DLG:DARKSOLID(56+II,T)=DLG
3120 DLG=DM(II,TT,2)
3130 HEVYPALE(I,T)=DLG:HEVYPALE(8+II,T)=DLG:HEVYPALE(16+II,T)=DLG
3140 HEVYPALE(24+II,T)=DLG:HEVYPALE(32+II,T)=DLG:HEVYPALE(40+II,T)=DLG
3150 HEVYPALE(48+II,T)=DLG:HEVYPALE(56+II,T)=DLG
3160 DLG=DM(II,TT,3)
3170 HEVYHARF(I,T)=DLG:HEVYHARF(8+II,T)=DLG:HEVYHARF(16+II,T)=DLG
3180 HEVYHARF(24+II,T)=DLG:HEVYHARF(32+II,T)=DLG:HEVYHARF(40+II,T)=DLG
3190 HEVYHARF(48+II,T)=DLG:HEVYHARF(56+II,T)=DLG
3200 DLG=DM(II,TT,4)
3210 HARF(I,T)=DLG:HARF(8+II,T)=DLG:HARF(16+II,T)=DLG
3220 HARF(24+II,T)=DLG:HARF(32+II,T)=DLG:HARF(40+II,T)=DLG
3230 HARF(48+I,T)=DLG:HARF(56+II,T)=DLG
3240 DLG=DM(II,TT,5)
3250 LIGHT(I,T)=DLG:LIGHT(8+II,T)=DLG:LIGHT(16+II,T)=DLG
3260 LIGHT(24+II,T)=DLG:LIGHT(32+II,T)=DLG:LIGHT(40+II,T)=DLG
3270 LIGHT(48+II,T)=DLG:LIGHT(56+II,T)=DLG
3280 DLG=DM(II,TT,6)
3290 LIGHTPALE(I,T)=DLG:LIGHTPALE(8+II,T)=DLG:LIGHTPALE(16+II,T)=DLG
3300 LIGHTPALE(24+II,T)=DLG:LIGHTPALE(32+II,T)=DLG:LIGHTPALE(40+II,T)=DLG
3310 LIGHTPALE(48+II,T)=DLG:LIGHTPALE(56+II,T)=DLG
3320 DLG=DM(II,TT,7)
3330 LIGHTSOLID(I,T)=DLG:LIGHTSOLID(8+II,T)=DLG:LIGHTSOLID(16+II,T)=DLG
3340 LIGHTSOLID(24+II,T)=DLG:LIGHTSOLID(32+II,T)=DLG:LIGHTSOLID(40+II,T)=DLG
3350 LIGHTSOLID(48+II,T)=DLG:LIGHTSOLID(56+II,T)=DLG
3360 DLG=DM(II,TT,8)
3370 CHECKBOX(I,T)=DLG:CHECKBOX(8+II,T)=DLG:CHECKBOX(16+II,T)=DLG
3380 CHECKBOX(24+II,T)=DLG:CHECKBOX(32+II,T)=DLG:CHECKBOX(40+II,T)=DLG
3390 CHECKBOX(48+II,T)=DLG:CHECKBOX(56+II,T)=DLG
3400 NEXT I:NEXT T
3410 :::::::::::::::::::::: REM DM2 PROCESS
3420 FOR T=1 TO 64:FOR I=1 TO 64:DM2(I,T,1)=DARKSOLID(I,T):NEXT I:NEXT T
3430 FOR T=1 TO 64:FOR I=1 TO 64:DM2(I,T,2)=HEVYPALE(I,T):NEXT I:NEXT T
3440 FOR T=1 TO 64:FOR I=1 TO 64:DM2(I,T,3)=HEVYHARF(I,T):NEXT I:NEXT T
3450 FOR T=1 TO 64:FOR I=1 TO 64:DM2(I,T,4)=HARF(I,T):NEXT I:NEXT T
3460 FOR T=1 TO 64:FOR I=1 TO 64:DM2(I,T,5)=LIGHT(I,T):NEXT I:NEXT T
3470 FOR T=1 TO 64:FOR I=1 TO 64:DM2(I,T,6)=LIGHTPALE(I,T):NEXT I:NEXT T
3480 FOR T=1 TO 64:FOR I=1 TO 64:DM2(I,T,7)=LIGHTSOLID(I,T):NEXT I:NEXT T
3490 FOR T=1 TO 64:FOR I=1 TO 64:DM2(I,T,8)=CHECKBOX(I,T):NEXT I:NEXT T
3500 RETURN
※コメント投稿者のブログIDはブログ作成者のみに通知されます