home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
FreeWare Collection 2
/
FreeSoftwareCollection2pd199x-jp.img
/
fbasic
/
paled
/
basfile
/
paled.bas
< prev
Wrap
BASIC Source File
|
1990-06-14
|
25KB
|
728 lines
10000 '***PALED・V1.02 By Dante '90.4/19***
10010 '設定
10020 DEFINT A-Z
10030 CLEAR ,,10000,400000,20000
10040 LOADM "..\REXFILE\IO.REX",0
10050 FLGLF=0 '1:TIFF、2:P25、3:GRP
10060 FLGSQG=0 '1:最初にグラデボードを描く
10070 LTF$="..\TIFFILE\TESTL.TIF" '最初にロードするTIFファイル
10080 LPF$="..\PICFILE\TESTL.P25" '最初にロードするP25ファイル
10090 LGR$="Q:\DEMO\ROOT\6_05.GRP" '最初にロードするGRPファイル
10100 STF$="..\TIFFILE\TESTS.TIF" 'TIFFのセーブネーム
10110 TLP$="..\TELOP\TESTS.TLP" 'パレット情報のテロップファイル
10120 PLDIR$="..\PALFILE\" 'パレットファイルのディレクトリ
10130 IPFN=0 'イニシャライズ用PALファイル番号
10140 BPFN=100 'セーブ時のオフセット
10150 CT=0:CB=255 '文字、背景色
10160 ICSA=30:ICSB=225 'A色、B色
10170 ICS1=2:ICS2=5:ICS3=30:ICS4=225 'グラデボードの4色
10180 MMH=16 'クリックorドラッグの判断
10190 MOUSE 0
10200 MOUSE 3,0,4:MOUSE 3,1,4 'マウスカウント
10210 '起動
10220 DIM R%(255)
10230 DIM G%(255)
10240 DIM B%(255)
10250 DIM PA%(779)
10260 DIM ST%(255)
10270 DIM SR%(255)
10280 DIM SP%(0)
10290 DIM SRT&(255)
10300 IOA&=&H440:IOB&=&H442
10310 LG2#=LOG(2)
10320 SCREEN@ 2
10330 VIEW(0,0)-(1023,511)
10340 WINDOW(0,0)-(1023,511)
10350 PALETTE
10360 COLOR 0,%CB:CLS
10370 GOSUB *GRGO
10380 PF$=LPF$
10390 ON FLGLF GOSUB *LDLTF,*LDLPC,*LDLGR
10400 IF FLGLF<2 THEN PFN=IPFN:GOSUB *SETPF:GOSUB *PFLOAD
10410 GOSUB *SETPAL
10420 GOSUB *EDGO
10430 ON MOUSE(3) GOSUB *MOUSE
10440 ON MOUSE(4) GOSUB *GRGO
10450 ON MOUSE(5) GOSUB *EDGO
10460 MOUSE(3) ON
10470 MOUSE(4) ON
10480 MOUSE(5) ON
10490 ON KEY(1) GOSUB *SETINIT
10500 KEY(1) ON
10510 ON ERROR GOTO 0
10520 '準備
10530 LINE( 2, 2)-(381,477),PSET,%CT,B
10540 LINE( 3, 3)-(380,476),PSET,%CT,B
10550 LINE(191, 2)-(192,477),PSET,%CT,B
10560 LINE( 2,191)-(381,191),PSET,%CT
10570 LINE( 2,379)-(381,380),PSET,%CT,B
10580 GOSUB *INITVAR
10590 GOSUB *BLOCK1
10600 GOSUB *BLOCK2
10610 GOSUB *BLOCK3
10620 GOSUB *BLOCK5
10630 GOSUB *BLOCK6
10640 GOSUB *BLOCK4
10650 MOUSE 1,100,100,1
10660 WHILE 0=0
10670 WEND
10680 'マウスルーチン
10690 *GRGO
10700 CALLM &H0000,IOA&,17
10710 CALLM &H0000,IOB&,48
10720 CALLM &H0000,IOA&,21
10730 CALLM &H0000,IOB&,48
10740 RETURN
10750 *EDGO
10760 CALLM &H0000,IOA&,17
10770 CALLM &H0000,IOB&,0
10780 CALLM &H0000,IOA&,21
10790 CALLM &H0000,IOB&,0
10800 RETURN
10810 *MOUSE
10820 MX0=MOUSE(4,0):MY0=MOUSE(5,0)
10830 MX=MOUSE(7,0):MY=MOUSE(8,0)
10840 MH&=(MX-MX0)^2+(MY-MY0)^2
10850 IF MH&<MMH THEN GOSUB *CLICK ELSE GOSUB *DRAG
10860 RETURN
10870 *CLICK
10880 IF ( 8<MX)AND(MX<185)AND( 8<MY)AND(MY<185) THEN GOTO *MCL1
10890 IF (198<MX)AND(MX<375)AND( 8<MY)AND(MY<185) THEN GOTO *MCL2
10900 IF ( 61<MX)AND(MX<182)AND(196<MY)AND(MY<373) THEN GOTO *MCL3
10910 IF (200<MX)AND(MX<372)AND(199<MY)AND(MY<371) THEN GOTO *MCL4
10920 IF ( 2<MX)AND(MX<191)AND(443<MY)AND(MY<476) THEN GOTO *MCL5
10930 IF ( 61<MX)AND(MX<182)AND(387<MY)AND(MY<436) THEN GOTO *MCLFN
10940 IF (191<MX)AND(MX<380)AND(379<MY)AND(MY<476) THEN GOTO *MCL6
10950 RETURN
10960 *MCL1
10970 I0=(MX-9)\11+((MY-9)\11)*16
10980 CSA0=SR%(I0)
10990 GOSUB *SETCSA
11000 GOSUB *SETCSB
11010 RETURN
11020 *MCL2
11030 I0=(MX-199)\11+((MY-9)\11)*16
11040 CSA0=I0
11050 GOSUB *SETCSA
11060 GOSUB *SETCSB
11070 RETURN
11080 *MCL3
11090 IF ((MY-197) MOD 32)>15 THEN RETURN
11100 I0=(MY-197)\32:I1=(MX-62)\40
11110 IF (I0 MOD 2)=0 THEN I2=1 ELSE I2=-1
11120 IF (MX-62) MOD 40<10 THEN I3=16 ELSE I3=1
11130 ON I0\2+1 GOSUB *MCSA,*MCSB,*MSFT
11140 RETURN
11150 *MCSA
11160 I4=ST%(CSA)
11170 ON I1+1 GOSUB *SETR,*SETG,*SETB
11180 GOSUB *SETCSA
11190 GOSUB *SETCSB
11200 PALETTE I4,[G%(I4),R%(I4),B%(I4)],1
11210 RETURN
11220 *MCSB
11230 I4=ST%(CSB)
11240 ON I1+1 GOSUB *SETR,*SETG,*SETB
11250 GOSUB *SETCSA
11260 GOSUB *SETCSB
11270 PALETTE I4,[G%(I4),R%(I4),B%(I4)],1
11280 RETURN
11290 *SETR
11300 IF 255-I2*(R%(I4)*2-255)<I3*2 THEN R%(I4)=(255+I2*255)\2 ELSE R%(I4)=R%(I4)+I2*I3
11310 RETURN
11320 *SETG
11330 IF 255-I2*(G%(I4)*2-255)<I3*2 THEN G%(I4)=(255+I2*255)\2 ELSE G%(I4)=G%(I4)+I2*I3
11340 RETURN
11350 *SETB
11360 IF 255-I2*(B%(I4)*2-255)<I3*2 THEN B%(I4)=(255+I2*255)\2 ELSE B%(I4)=B%(I4)+I2*I3
11370 RETURN
11380 *MSFT
11390 ON I1+1 GOSUB *SFTR,*SFTG,*SFTB
11400 GOSUB *SETSFT
11410 RETURN
11420 *SFTR
11430 IF 255-I2*SFR<I3 THEN SFR=I2*255 ELSE SFR=SFR+I2*I3
11440 RETURN
11450 *SFTG
11460 IF 255-I2*SFG<I3 THEN SFG=I2*255 ELSE SFG=SFG+I2*I3
11470 RETURN
11480 *SFTB
11490 IF 255-I2*SFB<I3 THEN SFB=I2*255 ELSE SFB=SFB+I2*I3
11500 RETURN
11510 *MCL4
11520 X=MX-222:Y=MY-221
11530 IF ( -1<X)AND(X<129)AND( -1<Y)AND(Y<129) THEN GOTO *GRADCSA
11540 IF ( -1<X)AND(X<129)AND(-22<Y)AND(Y< 0) THEN GOTO *GDCSA1
11550 IF (128<X)AND(X<140)AND( -1<Y)AND(Y<129) THEN GOTO *GDCSA2
11560 IF ( -1<X)AND(X<129)AND(128<Y)AND(Y<150) THEN GOTO *GDCSA3
11570 IF (-22<X)AND(X< 0)AND( -1<Y)AND(Y<129) THEN GOTO *GDCSA4
11580 IF (-22<X)AND(X< 0)AND(-22<Y)AND(Y< 0) THEN GOTO *GD1
11590 IF (128<X)AND(X<150)AND(-22<Y)AND(Y< 0) THEN GOTO *GD2
11600 IF (-22<X)AND(X< 0)AND(128<Y)AND(Y<150) THEN GOTO *GD3
11610 IF (128<X)AND(X<150)AND(128<Y)AND(Y<150) THEN GOTO *GD4
11620 RETURN
11630 *GRADCSA
11640 R%(ST%(CSA))=(R%(ST%(CS1))*(128-X)*(128-Y)+R%(ST%(CS2))*X*(128-Y)+R%(ST%(CS3))*(128-X)*Y+R%(ST%(CS4))*X*Y+8191)\16384
11650 G%(ST%(CSA))=(G%(ST%(CS1))*(128-X)*(128-Y)+G%(ST%(CS2))*X*(128-Y)+G%(ST%(CS3))*(128-X)*Y+G%(ST%(CS4))*X*Y+8191)\16384
11660 B%(ST%(CSA))=(B%(ST%(CS1))*(128-X)*(128-Y)+B%(ST%(CS2))*X*(128-Y)+B%(ST%(CS3))*(128-X)*Y+B%(ST%(CS4))*X*Y+8191)\16384
11670 GOTO *MCL4R
11680 *GDCSA1
11690 R%(ST%(CSA))=(R%(ST%(CS1))*(128-X)+R%(ST%(CS2))*X+63)\128
11700 G%(ST%(CSA))=(G%(ST%(CS1))*(128-X)+G%(ST%(CS2))*X+63)\128
11710 B%(ST%(CSA))=(B%(ST%(CS1))*(128-X)+B%(ST%(CS2))*X+63)\128
11720 GOTO *MCL4R
11730 *GDCSA2
11740 R%(ST%(CSA))=(R%(ST%(CS2))*(128-Y)+R%(ST%(CS4))*Y+63)\128
11750 G%(ST%(CSA))=(G%(ST%(CS2))*(128-Y)+G%(ST%(CS4))*Y+63)\128
11760 B%(ST%(CSA))=(B%(ST%(CS2))*(128-Y)+B%(ST%(CS4))*Y+63)\128
11770 GOTO *MCL4R
11780 *GDCSA3
11790 R%(ST%(CSA))=(R%(ST%(CS3))*(128-X)+R%(ST%(CS4))*X+63)\128
11800 G%(ST%(CSA))=(G%(ST%(CS3))*(128-X)+G%(ST%(CS4))*X+63)\128
11810 B%(ST%(CSA))=(B%(ST%(CS3))*(128-X)+B%(ST%(CS4))*X+63)\128
11820 GOTO *MCL4R
11830 *GDCSA4
11840 R%(ST%(CSA))=(R%(ST%(CS1))*(128-Y)+R%(ST%(CS3))*Y+63)\128
11850 G%(ST%(CSA))=(G%(ST%(CS1))*(128-Y)+G%(ST%(CS3))*Y+63)\128
11860 B%(ST%(CSA))=(B%(ST%(CS1))*(128-Y)+B%(ST%(CS3))*Y+63)\128
11870 GOTO *MCL4R
11880 *GD1
11890 R%(ST%(CSA))=R%(ST%(CS1))
11900 G%(ST%(CSA))=G%(ST%(CS1))
11910 B%(ST%(CSA))=B%(ST%(CS1))
11920 GOTO *MCL4R
11930 *GD2
11940 R%(ST%(CSA))=R%(ST%(CS2))
11950 G%(ST%(CSA))=G%(ST%(CS2))
11960 B%(ST%(CSA))=B%(ST%(CS2))
11970 GOTO *MCL4R
11980 *GD3
11990 R%(ST%(CSA))=R%(ST%(CS3))
12000 G%(ST%(CSA))=G%(ST%(CS3))
12010 B%(ST%(CSA))=B%(ST%(CS3))
12020 GOTO *MCL4R
12030 *GD4
12040 R%(ST%(CSA))=R%(ST%(CS4))
12050 G%(ST%(CSA))=G%(ST%(CS4))
12060 B%(ST%(CSA))=B%(ST%(CS4))
12070 GOTO *MCL4R
12080 *MCL4R
12090 GOSUB *SETCSA
12100 GOSUB *SETCSB
12110 PALETTE ST%(CSA),[G%(ST%(CSA)),R%(ST%(CSA)),B%(ST%(CSA))],1
12120 RETURN
12130 *MCL5
12140 I0=(MX-2)\47
12150 ON I0+1 GOSUB *SETPFLD,*SETPFSV,*SETPFKL,*SETSRSV
12160 RETURN
12170 *MCLFN
12180 IF ((MY-388) MOD 32)>15 THEN RETURN
12190 I0=(MX-62)\40+((MY-388)\32)*3
12200 ON I0+1 GOSUB *P1,*P2,*P3,*P4,*P5,*P6
12210 GOSUB *SETFN
12220 RETURN
12230 *MCL6
12240 I0=(MX-192)\47+((MY-380)\32)*4
12250 IF I0>7 THEN RETURN
12260 ON I0+1 GOSUB *SETINIT,*SETSORT,*SETSQGR,*SETGRAD,*SETSFT1,*SETSFT2,*SETTFSV,*SETTLSV
12270 RETURN
12280 *DRAG
12290 MX=MOUSE(7,0):MY=MOUSE(8,0)
12300 IF (198<MX0)AND(MX0<375)AND( 8<MY0)AND(MY0<185)AND(198<MX)AND(MX<375)AND( 8<MY)AND(MY<185) THEN GOTO *MDR0
12310 IF (200<MX)AND(MX<222)AND(199<MY)AND(MY<221) THEN GOTO *MDR1
12320 IF (350<MX)AND(MX<372)AND(199<MY)AND(MY<221) THEN GOTO *MDR2
12330 IF (200<MX)AND(MX<222)AND(349<MY)AND(MY<371) THEN GOTO *MDR3
12340 IF (350<MX)AND(MX<372)AND(349<MY)AND(MY<371) THEN GOTO *MDR4
12350 RETURN
12360 *MDR0
12370 I0=(MX0-199)\11+((MY0-9)\11)*16
12380 CSA0=I0
12390 GOSUB *SETCSA
12400 I0=(MX-199)\11+((MY-9)\11)*16
12410 CSB0=I0
12420 GOSUB *SETCSB
12430 RETURN
12440 *MDR1
12450 GOSUB *SETSPOIT
12460 CS1=CSP
12470 LINE(202,201)-(220,219),PSET,%ST%(CS1),BF
12480 RETURN
12490 *MDR2
12500 GOSUB *SETSPOIT
12510 CS2=CSP
12520 LINE(352,201)-(370,219),PSET,%ST%(CS2),BF
12530 RETURN
12540 *MDR3
12550 GOSUB *SETSPOIT
12560 CS3=CSP
12570 LINE(202,351)-(220,369),PSET,%ST%(CS3),BF
12580 RETURN
12590 *MDR4
12600 GOSUB *SETSPOIT
12610 CS4=CSP
12620 LINE(352,351)-(370,369),PSET,%ST%(CS4),BF
12630 RETURN
12640 '汎用サブルーチン
12650 *LDLTF
12660 LOAD@ LTF$,(384,0)
12670 RETURN
12680 *LDLPC
12690 I0=INSTR (LPF$,":")
12700 OPEN "R",#1,LEFT$(LPF$,I0)+"(1)"+RIGHT$(LPF$,LEN(LPF$)-I0)
12710 FSI&=LOF(1)
12720 CLOSE #1
12730 DIM PC%(FSI&\2-1)
12740 LOAD@ LPF$,PC%
12750 I0=PC%(8)
12760 PUT@A (384,0)-(1023,479),PC%,,,,,787
12770 IF I0=1 THEN RETURN
12780 I1&=154387
12790 FOR I=2 TO I0
12800 POX1&=(PC%(I1&+5)+65536) MOD 65536
12810 POY1&=(PC%(I1&+6)+65536) MOD 65536
12820 POX2&=(PC%(I1&+7)+65536) MOD 65536
12830 POY2&=(PC%(I1&+8)+65536) MOD 65536
12840 POI1&=(PC%(I1&+1)+65536) MOD 65536
12850 POI2&=(PC%(I1&+2)+65536) MOD 65536
12860 POM1&=(PC%(I1&+3)+65536) MOD 65536
12870 POM2&=(PC%(I1&+4)+65536) MOD 65536
12880 PUT@A (384+POX1&,POY1&)-(384+POX2&,POY2&),PC%,MATTE,,,%255,I1&+9
12890 I1&=I1&+(POI1&+POI2&*65536)\2+(POM1&+POM2&*65536)\2+9
12900 NEXT
12910 GOSUB *PFLOAD
12920 RETURN
12930 *LDLGR
12940 DIM PC%(153999)
12950 LOAD@ LGR$,PC%
12960 PUT@A (384,0)-(1023,479),PC%,,,,,400
12970 LOAD@ PF$,PA%
12980 FOR I=0 TO 127
12990 B%(I*2 )=ASC(RIGHT$(MKI$(PC%(I*3+16)),1))
13000 R%(I*2 )=ASC( LEFT$(MKI$(PC%(I*3+16)),1))
13010 G%(I*2 )=ASC(RIGHT$(MKI$(PC%(I*3+17)),1))
13020 B%(I*2+1)=ASC( LEFT$(MKI$(PC%(I*3+17)),1))
13030 R%(I*2+1)=ASC(RIGHT$(MKI$(PC%(I*3+18)),1))
13040 G%(I*2+1)=ASC( LEFT$(MKI$(PC%(I*3+18)),1))
13050 NEXT
13060 RETURN
13070 *SETPAL
13080 FOR I=0 TO 255
13090 PALETTE I,[G%(I),R%(I),B%(I)],0
13100 NEXT
13110 RETURN
13120 *INITVAR
13130 CSA0=ICSA:CSB0=ICSB
13140 CS1=ICS1:CS2=ICS2:CS3=ICS3:CS4=ICS4
13150 SFR=0:SFG=0:SFB=0
13160 PFN=IPFN
13170 RETURN
13180 *SETSPOIT
13190 GET@A(MX0,MY0)-(MX0,MY0),SP%
13200 CSP=SR%(SP%(0))
13210 RETURN
13220 *SC
13230 H0&=196608
13240 FOR I=3 TO 255
13250 H&=(R%(I)-R)^2+(G%(I)-G)^2+(B%(I)-B)^2
13260 IF H&<H0& THEN I0=I:H0&=H&
13270 NEXT
13280 FOR I=0 TO 2
13290 H&=(R%(I)-R)^2+(G%(I)-G)^2+(B%(I)-B)^2
13300 IF H&<H0& THEN I0=I:H0&=H&
13310 NEXT
13320 RETURN
13330 'ブロック1
13340 *BLOCK1
13350 FOR I=0 TO 255
13360 LINE(10+(I MOD 16)*11,10+(I\16)*11)-(18+(I MOD 16)*11,18+(I\16)*11),PSET,%I,BF
13370 NEXT
13380 RETURN
13390 'ブロック2
13400 *BLOCK2
13410 ST%(0)=0:SR%(0)=0:ST%(1)=182:SR%(182)=1:ST%(2)=255:SR%(255)=2
13420 FOR I=3 TO 183
13430 ST%(I)=I-2:SR%(I-2)=I
13440 NEXT
13450 FOR I=184 TO 255
13460 ST%(I)=I-1:SR%(I-1)=I
13470 NEXT
13480 LINE(199, 9)-(374,184),PSET,%CB,BF
13490 FOR I=0 TO 255
13500 LINE(200+(I MOD 16)*11,10+(I\16)*11)-(208+(I MOD 16)*11,18+(I\16)*11),PSET,%ST%(I),BF
13510 NEXT
13520 RETURN
13530 'ブロック3
13540 *BLOCK3
13550 FOR I=0 TO 11
13560 LINE( 62,197+I*16)-(182,197+I*16),PSET,%CT
13570 LINE( 62+(I MOD 4)*40,197+(I\4)*64)-(62+(I MOD 4)*40,245+(I\4)*64),PSET,%CT
13580 NEXT
13590 FOR I=0 TO 17
13600 LINE( 72+(I MOD 3)*40,197+(I\3)*32)-(72+(I MOD 3)*40,213+(I\3)*32),PSET,%CT
13610 NEXT
13620 FOR I=0 TO 8
13630 SYMBOL( 80+(I MOD 3)*40,200+(I\3)*64),"▲",1,.8!,%CT
13640 SYMBOL( 80+(I MOD 3)*40,231+(I\3)*64),"▼",1,.8!,%CT
13650 NEXT
13660 LINE( 22,213)-( 62,229),PSET,%CT,B
13670 LINE( 22,277)-( 62,293),PSET,%CT,B
13680 SYMBOL( 11,216),"A",1,.8!,%CT
13690 SYMBOL( 11,280),"B",1,.8!,%CT
13700 SYMBOL( 17,344),"SHIFT",1,.8!,%CT
13710 SYMBOL( 76,248),"RGB",1,.8!,%CT,,,,24
13720 SYMBOL( 76,312),"RGB",1,.8!,%CT,,,,24
13730 GOSUB *SETCSA
13740 GOSUB *SETCSB
13750 GOSUB *SETSFT
13760 RETURN
13770 *SETCSA
13780 LINE(199+(CSA MOD 16)*11, 9+(CSA\16)*11)-(209+(CSA MOD 16)*11, 19+(CSA\16)*11),PSET,%CB,B,&HCE73
13790 LINE(199+(CSA0 MOD 16)*11, 9+(CSA0\16)*11)-(209+(CSA0 MOD 16)*11, 19+(CSA0\16)*11),PSET,%CT,B,&HCE73
13800 CSA=CSA0
13810 LINE( 23,214)-( 61,228),PSET,%ST%(CSA),BF
13820 LINE( 32,200)-( 47,212),PSET,%CB,BF
13830 SYMBOL( 32,200),RIGHT$("0"+HEX$(CSA),2),1,.8!,%CT
13840 LINE( 32,232)-( 47,244),PSET,%CB,BF
13850 SYMBOL( 32,232),RIGHT$("0"+HEX$(ST%(CSA)),2),1,.8!,%CT
13860 LINE( 79,216)-( 94,228),PSET,%CB,BF
13870 SYMBOL( 79,216),RIGHT$("0"+HEX$(R%(ST%(CSA))),2),1,.8!,%CT
13880 LINE(119,216)-(134,228),PSET,%CB,BF
13890 SYMBOL(119,216),RIGHT$("0"+HEX$(G%(ST%(CSA))),2),1,.8!,%CT
13900 LINE(159,216)-(174,228),PSET,%CB,BF
13910 SYMBOL(159,216),RIGHT$("0"+HEX$(B%(ST%(CSA))),2),1,.8!,%CT
13920 RETURN
13930 *SETCSB
13940 LINE(199+(CSB MOD 16)*11, 9+(CSB\16)*11)-(209+(CSB MOD 16)*11, 19+(CSB\16)*11),PSET,%CB,B,&H318C
13950 LINE(199+(CSB0 MOD 16)*11, 9+(CSB0\16)*11)-(209+(CSB0 MOD 16)*11, 19+(CSB0\16)*11),PSET,%CT,B,&H318C
13960 CSB=CSB0
13970 LINE( 23,278)-( 61,292),PSET,%ST%(CSB),BF
13980 LINE( 32,264)-( 47,276),PSET,%CB,BF
13990 LINE( 32,296)-( 47,308),PSET,%CB,BF
14000 SYMBOL( 32,296),RIGHT$("0"+HEX$(ST%(CSB)),2),1,.8!,%CT
14010 LINE( 79,280)-( 94,292),PSET,%CB,BF
14020 SYMBOL( 79,280),RIGHT$("0"+HEX$(R%(ST%(CSB))),2),1,.8!,%CT
14030 LINE(119,280)-(134,292),PSET,%CB,BF
14040 SYMBOL(119,280),RIGHT$("0"+HEX$(G%(ST%(CSB))),2),1,.8!,%CT
14050 LINE(159,280)-(174,292),PSET,%CB,BF
14060 SYMBOL(159,280),RIGHT$("0"+HEX$(B%(ST%(CSB))),2),1,.8!,%CT
14070 RETURN
14080 *SETSFT
14090 SFRX$=RIGHT$("0"+HEX$(ABS(SFR)),2)
14100 IF SFR<0 THEN SFRX$="-"+SFRX$ ELSE SFRX$=" "+SFRX$
14110 SFGX$=RIGHT$("0"+HEX$(ABS(SFG)),2)
14120 IF SFG<0 THEN SFGX$="-"+SFGX$ ELSE SFGX$=" "+SFGX$
14130 SFBX$=RIGHT$("0"+HEX$(ABS(SFB)),2)
14140 IF SFB<0 THEN SFBX$="-"+SFBX$ ELSE SFBX$=" "+SFBX$
14150 LINE( 71,344)-( 94,356),PSET,%CB,BF
14160 SYMBOL( 71,344),SFRX$,1,.8!,%CT
14170 LINE(111,344)-(134,356),PSET,%CB,BF
14180 SYMBOL(111,344),SFGX$,1,.8!,%CT
14190 LINE(151,344)-(174,356),PSET,%CB,BF
14200 SYMBOL(151,344),SFBX$,1,.8!,%CT
14210 RETURN
14220 'ブロック4
14230 *BLOCK4
14240 IF FLGSQG<>0 THEN GOSUB *SQGRAD
14250 GOSUB *SETGRADB
14260 RETURN
14270 *SETSQGR
14280 LINE(286,380)-(333,412),XOR,%CB,BF
14290 GOSUB *SQGRAD
14300 GOSUB *SETGRADB
14310 LINE(286,380)-(333,412),XOR,%CB,BF
14320 RETURN
14330 *SQGRAD
14340 R1=R%(ST%(CS1)):R2=R%(ST%(CS2)):R3=R%(ST%(CS3)):R4=R%(ST%(CS4))
14350 G1=G%(ST%(CS1)):G2=G%(ST%(CS2)):G3=G%(ST%(CS3)):G4=G%(ST%(CS4))
14360 B1=B%(ST%(CS1)):B2=B%(ST%(CS2)):B3=B%(ST%(CS3)):B4=B%(ST%(CS4))
14370 RR=36*R1+17:RX=6*(R2-R1):RY=6*(R3-R1):RH=R1+R4-R2-R3
14380 GG=36*G1+17:GX=6*(G2-G1):GY=6*(G3-G1):GH=G1+G4-G2-G3
14390 BB=36*B1+17:BX=6*(B2-B1):BY=6*(B3-B1):BH=B1+B4-B2-B3
14400 FOR Y=0 TO 6
14410 FOR X=0 TO 6
14420 R=(RR+RX*X+RY*Y+RH*X*Y)\36
14430 G=(GG+GX*X+GY*Y+GH*X*Y)\36
14440 B=(BB+BX*X+BY*Y+BH*X*Y)\36
14450 GOSUB *SC
14460 LINE(220+19*X,219+19*Y)-(238+19*X,237+19*Y),PSET,%I0,BF
14470 NEXT
14480 NEXT
14490 RETURN
14500 *SETGRADB
14510 LINE(221,220)-(351,350),PSET,%CT,B
14520 LINE(220,219)-(352,351),PSET,%CB,B
14530 LINE(201,200)-(371,370),PSET,%CT,B
14540 LINE(201,200)-(221,220),PSET,%CT,B
14550 LINE(351,200)-(371,220),PSET,%CT,B
14560 LINE(201,350)-(221,370),PSET,%CT,B
14570 LINE(351,350)-(371,370),PSET,%CT,B
14580 LINE(202,201)-(220,219),PSET,%ST%(CS1),BF
14590 LINE(352,201)-(370,219),PSET,%ST%(CS2),BF
14600 LINE(202,351)-(220,369),PSET,%ST%(CS3),BF
14610 LINE(352,351)-(370,369),PSET,%ST%(CS4),BF
14620 RETURN
14630 'ブロック5
14640 *BLOCK5
14650 FOR I=0 TO 3
14660 LINE( 62,388+I*16)-(182,388+I*16),PSET,%CT
14670 LINE( 62+(I MOD 4)*40,388+(I\4)*64)-(62+(I MOD 4)*40,436+(I\4)*64),PSET,%CT
14680 NEXT
14690 LINE( 2,444)-(191,444),PSET,%CT,B
14700 SYMBOL( 17,407),"PFILE",1,.8!,%CT
14710 FOR I=0 TO 2
14720 SYMBOL( 74+I*40,391),"▲",1,.8!,%CT
14730 SYMBOL( 74+I*40,423),"▼",1,.8!,%CT
14740 NEXT
14750 GOSUB *SETFN
14760 FOR I=0 TO 2
14770 LINE( 50+I*47,444)-( 50+I*47,477),PSET,%CT
14780 NEXT
14790 SYMBOL( 10,453),"PFLD",1,1,%CT
14800 SYMBOL( 57,453),"PFSV",1,1,%CT
14810 SYMBOL(104,453),"PFKL",1,1,%CT
14820 SYMBOL(151,453),"SRSV",1,1,%CT
14830 RETURN
14840 *SETFN
14850 GOSUB *SETPF
14860 LINE( 78,407)-( 85,419),PSET,%CB,BF:SYMBOL( 78,407),PFN2$,1,.8!,%CT
14870 LINE(118,407)-(125,419),PSET,%CB,BF:SYMBOL(118,407),PFN1$,1,.8!,%CT
14880 LINE(158,407)-(165,419),PSET,%CB,BF:SYMBOL(158,407),PFN0$,1,.8!,%CT
14890 RETURN
14900 *SETPFLD
14910 LINE(3,444)-(50,476),XOR,%CB,BF
14920 ON ERROR GOTO *ETPLD
14930 I0=0
14940 GOSUB *PFLOAD
14950 IF I0<>0 THEN GOTO *PLDR
14960 GOSUB *SETPAL
14970 GOSUB *BLOCK2
14980 GOSUB *SETCSA
14990 GOSUB *SETCSB
15000 GOTO *PLDR
15010 *ETPLD
15020 I0=1
15030 RESUME NEXT
15040 *PLDR
15050 ON ERROR GOTO 0
15060 LINE( 3,444)-( 50,476),XOR,%CB,BF
15070 RETURN
15080 *SETPFSV
15090 LINE( 50,444)-( 97,476),XOR,%CB,BF
15100 ON ERROR GOTO *ETPSV
15110 PFN=BPFN
15120 *PSV1
15130 GOSUB *SETPF
15140 GOSUB *PFSAVE
15150 GOTO *PSVR
15160 *ETPSV
15170 PFN=PFN+1
15180 IF PFN>999 THEN RESUME NEXT
15190 RESUME *PSV1
15200 *PSVR
15210 GOSUB *SETFN
15220 ON ERROR GOTO 0
15230 LINE( 50,444)-( 97,476),PSET,%CT,BF
15240 LINE( 51,445)-( 96,475),PSET,%CB,BF
15250 SYMBOL( 57,453),"PFSV",1,1,%CT
15260 RETURN
15270 *SETPFKL
15280 LINE( 97,444)-(144,476),XOR,%CB,BF
15290 ON ERROR GOTO *ETPKL
15300 KILL PF$
15310 GOTO *PKLR
15320 *ETPKL
15330 RESUME NEXT
15340 *PKLR
15350 ON ERROR GOTO 0
15360 LINE( 97,444)-(144,476),XOR,%CB,BF
15370 RETURN
15380 *SETSRSV
15390 LINE(144,444)-(191,476),XOR,%CB,BF
15400 PFN=BPFN
15410 ON ERROR GOTO *ETSSV
15420 *SSV1
15430 GOSUB *SETPF
15440 GOSUB *SRSAVE
15450 GOTO *SSVR
15460 *ETSSV
15470 PFN=PFN+1
15480 IF PFN>999 THEN RESUME NEXT
15490 RESUME *SSV1
15500 *SSVR
15510 GOSUB *SETFN
15520 ON ERROR GOTO 0
15530 LINE(144,444)-(191,476),PSET,%CT,BF
15540 LINE(145,445)-(190,475),PSET,%CB,BF
15550 SYMBOL(151,453),"SRSV",1,1,%CT
15560 RETURN
15570 *PFLOAD
15580 LOAD@ PF$,PA%
15590 FOR I=0 TO 255
15600 R%(I)=ASC(MKI$(PA%(I*3+12)))
15610 G%(I)=ASC(MKI$(PA%(I*3+13)))
15620 B%(I)=ASC(MKI$(PA%(I*3+14)))
15630 NEXT
15640 RETURN
15650 *PFSAVE
15660 FOR I=0 TO 255
15670 PA%(I*3+12)=CVI(RIGHT$(MKI$(R%(I)),1)+CHR$(0))
15680 PA%(I*3+13)=CVI(RIGHT$(MKI$(G%(I)),1)+CHR$(0))
15690 PA%(I*3+14)=CVI(RIGHT$(MKI$(B%(I)),1)+CHR$(0))
15700 NEXT
15710 SAVE@ PF$,PA%
15720 RETURN
15730 *SRSAVE
15740 I=0:I0=ST%(0):GOSUB *SRSV1
15750 I=182:I0=ST%(1):GOSUB *SRSV1
15760 I=255:I0=ST%(2):GOSUB *SRSV1
15770 FOR I=1 TO 181
15780 I0=ST%(I+2):GOSUB *SRSV1
15790 NEXT
15800 FOR I=183 TO 254
15810 I0=ST%(I+1):GOSUB *SRSV1
15820 NEXT
15830 GOTO *SRSVR
15840 *SRSV1
15850 PA%(I*3+12)=CVI(RIGHT$(MKI$(R%(I0)),1)+CHR$(0))
15860 PA%(I*3+13)=CVI(RIGHT$(MKI$(G%(I0)),1)+CHR$(0))
15870 PA%(I*3+14)=CVI(RIGHT$(MKI$(B%(I0)),1)+CHR$(0))
15880 RETURN
15890 *SRSVR
15900 SAVE@ PF$,PA%
15910 RETURN
15920 *SETPF
15930 PFN0=PFN MOD 10:PFN0$=RIGHT$(STR$(PFN0),1)
15940 PFN1=PFN\10 MOD 10:PFN1$=RIGHT$(STR$(PFN1),1)
15950 PFN2=PFN\100 MOD 10:PFN2$=RIGHT$(STR$(PFN2),1)
15960 PF$=PLDIR$+"PAL"+PFN2$+PFN1$+PFN0$+".P25"
15970 RETURN
15980 *P1
15990 IF PFN>899 THEN PFN=999 ELSE PFN=PFN+100
16000 GOSUB *SETFN
16010 RETURN
16020 *P2
16030 IF PFN>989 THEN PFN=999 ELSE PFN=PFN+10
16040 GOSUB *SETFN
16050 RETURN
16060 *P3
16070 IF PFN>998 THEN PFN=999 ELSE PFN=PFN+1
16080 GOSUB *SETFN
16090 RETURN
16100 *P4
16110 IF PFN<100 THEN PFN=0 ELSE PFN=PFN-100
16120 GOSUB *SETFN
16130 RETURN
16140 *P5
16150 IF PFN<10 THEN PFN=0 ELSE PFN=PFN-10
16160 GOSUB *SETFN
16170 RETURN
16180 *P6
16190 IF PFN<1 THEN PFN=0 ELSE PFN=PFN-1
16200 GOSUB *SETFN
16210 RETURN
16220 'ブロック6
16230 *BLOCK6
16240 LINE(192,412)-(381,412),PSET,%CT,B
16250 LINE(192,444)-(381,412),PSET,%CT,B
16260 FOR I=0 TO 2
16270 LINE(239+I*47,380)-(239+I*47,477),PSET,%CT
16280 NEXT
16290 SYMBOL(199,389),"INIT",1,1,%CT
16300 SYMBOL(246,389),"SORT",1,1,%CT
16310 SYMBOL(293,389),"SQGR",1,1,%CT
16320 SYMBOL(340,389),"GRAD",1,1,%CT
16330 SYMBOL(199,421),"SFT1",1,1,%CT
16340 SYMBOL(246,421),"SFT2",1,1,%CT
16350 SYMBOL(293,421),"TFSV",1,1,%CT
16360 SYMBOL(340,421),"TLSV",1,1,%CT
16370 RETURN
16380 *SETINIT
16390 LINE(192,380)-(239,412),XOR,%CB,BF
16400 GOSUB *INITVAR
16410 GOSUB *SETFN
16420 GOSUB *SETPFLD
16430 GOSUB *SETGRADB
16440 LINE(192,380)-(239,412),XOR,%CB,BF
16450 RETURN
16460 *SETSORT
16470 LINE(239,380)-(286,412),XOR,%CB,BF
16480 FOR I=3 TO 255
16490 SRT&(I)=G%(ST%(I))*65536+R%(ST%(I))*256+B%(ST%(I))
16500 NEXT
16510 FOR I=255 TO 0 STEP -1
16520 FOR J=3 TO I-1
16530 IF SRT&(J)>SRT&(J+1) THEN SWAP SRT&(J),SRT&(J+1):SWAP ST%(J),ST%(J+1)
16540 NEXT
16550 LINE(200+(I MOD 16)*11,10+(I\16)*11)-(208+(I MOD 16)*11,18+(I\16)*11),PSET,%ST%(I),BF
16560 NEXT
16570 FOR I=0 TO 255
16580 SR%(ST%(I))=I
16590 NEXT
16600 GOSUB *SETGRADB
16610 LINE(239,380)-(286,412),XOR,%CB,BF
16620 RETURN
16630 *SETGRAD
16640 IF CSA=CSB THEN RETURN
16650 LINE(333,380)-(380,412),XOR,%CB,BF
16660 I0=ABS(CSB-CSA)
16670 FOR I=CSA TO CSB STEP SGN(CSB-CSA)
16680 R%(ST%(I))=(R%(ST%(CSA))*ABS(CSB-I)+R%(ST%(CSB))*ABS(CSA-I)+I0\2)\I0
16690 G%(ST%(I))=(G%(ST%(CSA))*ABS(CSB-I)+G%(ST%(CSB))*ABS(CSA-I)+I0\2)\I0
16700 B%(ST%(I))=(B%(ST%(CSA))*ABS(CSB-I)+B%(ST%(CSB))*ABS(CSA-I)+I0\2)\I0
16710 PALETTE ST%(I),[G%(ST%(I)),R%(ST%(I)),B%(ST%(I))],1
16720 NEXT
16730 LINE(333,380)-(380,412),XOR,%CB,BF
16740 RETURN
16750 *SETSFT1
16760 IF (SFR=0)AND(SFG=0)AND(SFB=0) THEN RETURN
16770 LINE(192,412)-(239,444),XOR,%CB,BF
16780 FOR I=CSA TO CSB STEP SGN(CSB-CSA)
16790 R%(ST%(I))=R%(ST%(I))+SFR
16800 IF R%(ST%(I))< 0 THEN R%(ST%(I))=0
16810 IF R%(ST%(I))>255 THEN R%(ST%(I))=255
16820 G%(ST%(I))=G%(ST%(I))+SFG
16830 IF G%(ST%(I))< 0 THEN G%(ST%(I))=0
16840 IF G%(ST%(I))>255 THEN G%(ST%(I))=255
16850 B%(ST%(I))=B%(ST%(I))+SFB
16860 IF B%(ST%(I))< 0 THEN B%(ST%(I))=0
16870 IF B%(ST%(I))>255 THEN B%(ST%(I))=255
16880 PALETTE ST%(I),[G%(ST%(I)),R%(ST%(I)),B%(ST%(I))],1
16890 NEXT
16900 GOSUB *SETCSA
16910 GOSUB *SETCSB
16920 SFR=0:SFG=0:SFB=0:GOSUB *SETSFT
16930 LINE(192,412)-(239,444),XOR,%CB,BF
16940 RETURN
16950 *SETSFT2
16960 IF (SFR=0)AND(SFG=0)AND(SFB=0) THEN RETURN
16970 LINE(239,412)-(286,444),XOR,%CB,BF
16980 FOR I=CSA TO CSB STEP SGN(CSB-CSA)
16990 I0&=INT(R%(ST%(I))*EXP(SFR*LG2#/64)+.5!)
17000 IF I0&>255 THEN R%(ST%(I))=255 ELSE R%(ST%(I))=I0&
17010 I0&=INT(G%(ST%(I))*EXP(SFG*LG2#/64)+.5!)
17020 IF I0&>255 THEN G%(ST%(I))=255 ELSE G%(ST%(I))=I0&
17030 I0&=INT(B%(ST%(I))*EXP(SFB*LG2#/64)+.5!)
17040 IF I0&>255 THEN B%(ST%(I))=255 ELSE B%(ST%(I))=I0&
17050 IF B%(ST%(I))>255 THEN B%(ST%(I))=255
17060 PALETTE ST%(I),[G%(ST%(I)),R%(ST%(I)),B%(ST%(I))],1
17070 NEXT
17080 GOSUB *SETCSA
17090 GOSUB *SETCSB
17100 SFR=0:SFG=0:SFB=0:GOSUB *SETSFT
17110 LINE(239,412)-(286,444),XOR,%CB,BF
17120 RETURN
17130 *SETTFSV
17140 LINE(286,412)-(333,444),XOR,%CB,BF
17150 SAVE@ STF$,(384,0)-(1023,479)
17160 LINE(286,412)-(333,444),XOR,%CB,BF
17170 RETURN
17180 *SETTLSV
17190 LINE(333,412)-(380,444),XOR,%CB,BF
17200 OPEN "O",#1,TLP$
17210 FOR I=0 TO 255
17220 PRINT#1,USING "### ' ### ### ###";I,R%(I),G%(I),B%(I)
17230 NEXT
17240 CLOSE #1
17250 LINE(333,412)-(380,444),XOR,%CB,BF
17260 RETURN