home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 3 / FREEWARE.BIN / towns_os / colorful / src / colorful.bas < prev    next >
BASIC Source File  |  1980-01-02  |  59KB  |  642 lines
  1. 5 CLEAR ,,1024,300000,4096
  2. 10 DEFINT A-Z:DIM CO%(2),CH%(2048),G%(24000),COL$(5),COL%(5),NOU$(4),NOU%(4),MIDL$(3),MID%(3),OCM$(3),OCM%(3),SCM$(4),LUM$(6),LUM%(6),G2%(256),G3%(256),GD$(10),GD%(8192),PAL&(255),IP%(7,3),PAL$(2),PALT&(256),BY&(15),CMD&(10)
  3. 20 MCX=220:MCY=180:SCREEN@ 0:GOSUB *ABOUT_WRT:WAIT 150
  4. 30 MNDPF=1:SCSI=1:     'mndpf=1:GT-4000/互換機  2:GT-6000
  5. 40 CLS:MAB=1:MABP=1:PRF=0:SAF=0:DI=3:PALM=0:FPAL=0:FCX=0:FCY=0:XLEN=1:YLEN=1:OFA=&H600
  6. 50 FDPF$="A:\PREVIEW.PAT":FDSF$="A:\SCANDATA.TIF":DFD$="A:":DFF$="\GDATA.TIF":DPD$=DFD$:DPF$="\SCAN0001.SPF":MD$="A:\WORK"
  7. 60 ON ERROR GOTO 900:OPEN "I",#1,".\COLORFUL.ENV":MNDPF=ASC(INPUT$(1,1)):SCSI=ASC(INPUT$(1,1)):DUM=ASC(INPUT$(1,1)):FDPF$=INPUT$(DUM,1):DUM=ASC(INPUT$(1,1)):FDSF$=INPUT$(DUM,1):DFD$=INPUT$(1,1)+":":DUM=ASC(INPUT$(1,1)):DFF$=INPUT$(DUM,1):DPD$=DFD$
  8. 70 DUM=ASC(INPUT$(1,1)):DPF$=INPUT$(DUM,1):DUM=ASC(INPUT$(1,1)):MD$=INPUT$(DUM,1):CLOSE:ON ERROR GOTO 0
  9. 100 IF INKEY$="" THEN 1000
  10. 110 CONSOLE 5,1:LOCATE 20,0:PRINT "ColorfulStick 環境設定";
  11. 120 LOCATE 0,5:PRINT "使用機種 (1:GT-4000/FMSC-611G  2:GT-6000) ["+STR$(MNDPF)+"]";:MIN=1:MAX=2:YN=MNDPF:GOSUB *GETONEVAL:MNDPF=YN:CLS 1
  12. 130 LOCATE 0,5:PRINT "SCSI接続 (0:接続無し  1:接続あり) ["+STR$(SCSI)+"]";:MIN=0:MAX=1:YN=SCSI:GOSUB *GETONEVAL:SCSI=YN:CLS 1
  13. 140 LOCATE 0,6:M$="プレビューファイル ["+FDPF$+"]":YNM$=FDPF$:GOSUB *GETSTR:FDPF$=YNM$:CLS 3:IF RIGHT$(FDPF$,4)<>".PAT" THEN IF INSTR(FDPF$,".")=0 THEN FDPF$=FDPF$+".PAT" ELSE FDPF$=LEFT$(FDPF$,INSTR(FDPF$,"."))+"PAT"
  14. 150 LOCATE 0,6:M$="スキャンファイル ["+FDSF$+"]":YNM$=FDSF$:GOSUB *GETSTR:FDSF$=YNM$:CLS 3:IF RIGHT$(FDSF$,4)<>".TIF" THEN IF INSTR(FDSF$,".")=0 THEN FDSF$=FDSF$+".TIF" ELSE FDSF$=LEFT$(FDSF$,INSTR(FDSF$,"."))+"TIF"
  15. 160 LOCATE 0,6:M$="デフォルトセーブファイル ["+DFD$+DFF$+"]":YNM$=DFD$+DFF$:GOSUB *GETSTR:IF INSTR(YNM$,":")=0 THEN DFF$=YNM$ ELSE YN=INSTR(YNM$,":"):DFD$=LEFT$(YNM$,YN):DFF$=RIGHT$(YNM$,LEN(YNM$)-YN)
  16. 170 CLS 3:LOCATE 0,6:M$="デフォルトパラメータファイル ["+DPF$+"]":YNM$=DPF$:GOSUB *GETSTR:DPF$=YNM$:CLS 3
  17. 180 LOCATE 0,6:M$="モジュール格納パス ["+MD$+"]":YNM$=MD$:GOSUB *GETSTR:MD$=YNM$:WHILE (RIGHT$(MD$,1)="\"):MD$=LEFT$(MD$,LEN(MD$)-1):WEND:CLS 3
  18. 200 DPD$=DFD$:ON ERROR GOTO 950:OPEN "O",#1,".\COLORFUL.ENV"
  19. 210 PRINT #1,CHR$(MNDPF,SCSI);:PRINT #1,CHR$(LEN(FDPF$))+FDPF$;::PRINT #1,CHR$(LEN(FDSF$))+FDSF$;:PRINT #1,LEFT$(DFD$,1);:PRINT #1,CHR$(LEN(DFF$))+DFF$;
  20. 220 PRINT #1,CHR$(LEN(DPF$))+DPF$;:PRINT #1,CHR$(LEN(MD$))+MD$;:CLOSE:ON ERROR GOTO 850
  21. 230 A=0:SAVE@ FDPF$,G%
  22. 240 A=1:OPEN "O",#1,FDSF$:ON ERROR GOTO 880:PRINT #1,"DUMMYだよ";:CLOSE:ON ERROR GOTO 0:GOTO 1000
  23. 500 *GETONEVAL
  24. 510 YNX=POS(0)
  25. 520 YNM$=INPUT$(1):LOCATE 5,YNX:PRINT YNM$;:IF INSTR("0123456789"+CHR$(13),YNM$)=0 THEN BEEP:GOTO 520
  26. 530 IF YNM$=CHR$(13) THEN RETURN ELSE IF VAL(YNM$)<MIN OR VAL(YNM$)>MAX THEN BEEP:GOTO 520
  27. 540 YN=VAL(YNM$):RETURN
  28. 600 *GETSTR
  29. 610 CLS 3:LOCATE 0,6:PRINT M$:LINE INPUT YN$:IF YN$="" THEN RETURN
  30. 620 FOR A=1 TO LEN(YN$):A$=MID$(YN$,A,1):IF A$>="a" AND A$=<"z" THEN A$=CHR$(ASC(A$)-32):MID$(YN$,A,1)=A$
  31. 630 IF INSTR("ABCDEFGHIJKLMNOPQRSTUVWXYZ.\0123456789$&#%^~!:_@",A$)=0 THEN A=500
  32. 640 NEXT:IF A>300 THEN BEEP:GOTO 610
  33. 650 YNM$=YN$:RETURN
  34. 850 IF A=0 THEN RESUME 240 ELSE ON ERROR GOTO 0:RESUME 1000
  35. 880 ON ERROR GOTO 0:CLS:PRINT USING "実行環境整備中に異常が発生しました｡ erl: ##### err: ###";ERL;ERR;:BEEP:CLOSE:WAIT 300:END
  36. 900 ON ERROR GOTO 0:CLOSE:RESUME 110
  37. 950 IF ERR=64 THEN KILL ".\COLORFUL.ENV":RESUME
  38. 960 ON ERROR GOTO 0:CLS:PRINT USING "環境ファイル書き込み中に異常が発生しました｡ erl: ##### err: ###";ERL;ERR;:BEEP:CLOSE:WAIT 300:RESUME 1000
  39. 1000 LOADM MD$+"\GTPOINT.REX",0:IF SCSI=0 THEN LOADM MD$+"\RS232C.REX",&H600 ELSE LOADM MD$+"\SCSI.REX",&H600
  40. 1010 A&=CALLM(OFA,VARPTR(CMD&(0))):IF A&<>0 AND SCSI=1 THEN BEEP:PRINT "SCSIがスキャナに未接続です":END ELSE FOR A=0 TO 10:CMD&(A)=CMD&(A)+OFA:NEXT
  41. 1020 RA=&H600:GETH&=CMD&(0):PUTC&=CMD&(1):RCLOSE&=CMD&(2):RCMD&=CMD&(3):RGET1&=CMD&(4):RINIT&=CMD&(5):RPUT1&=CMD&(6):RSTAT2&=CMD&(7):RSTAT&=CMD&(8):RGET2&=CMD&(9):RPUT2&=CMD&(10):ERRC&=&H7FFFFFFF:PSCM=10:SCM=0:DSCM=SCM
  42. 1030 DEF FNF$(F)=RIGHT$("  "+STR$(F),3):DEF FNG$(G)=RIGHT$("  "+STR$(G),4):DEF FNM(X1,X2)=(X2-X1)\2+X1:DEF FND(N)=CVI(INPUT$(2,N)):DEF FNL$(A$)=CHR$(LEN(A$))+A$:DEF FND$(N)=INPUT$(ASC(INPUT$(1,N)),N):IF SCSI<>1 THEN CALLM RINIT&:CALLM RCLOSE&
  43. 1040 RESTORE 1110:FOR A=0 TO 2:READ CO%(A):NEXT:GOSUB *SET_DPI:DIM DPI%(MNDP):FOR A=0 TO MNDP:READ DPI%(A):NEXT
  44. 1050 RESTORE *N_DPI:FOR A=0 TO 5:READ COL$(A),COL%(A):NEXT:FOR A=0 TO 4:READ NOU$(A),NOU%(A):NEXT:FOR A=0 TO 3:READ MIDL$(A),MID%(A):NEXT
  45. 1060 FOR A=0 TO 3:READ OCM$(A),OCM%(A):NEXT:FOR A=0 TO 3:READ SCM$(A):NEXT:FOR A=0 TO 6:READ LUM$(A),LUM%(A):NEXT:FOR A=0 TO 7:FOR B=0 TO 3:READ IP%(A,B):NEXT:NEXT:FOR A=0 TO 2:READ PAL$(A):NEXT:GOTO 1220
  46. 1070 *SET_DPI:ON MNDPF+1 GOTO 1080,1090,1100
  47. 1080 CLS:PRINT "指定された機種は対応してません｡":END
  48. 1090 RESTORE *DPI1:MNDP=15:RETURN
  49. 1100 RESTORE *DPI2:MNDP=18:RETURN
  50. 1110 DATA 4,2,1
  51. 1120 *DPI1:DATA 50,72,80,90,100,120,144,150,160,180,200,240,300,320,360,400
  52. 1130 *DPI2:DATA 50,72,75,80,90,100,120,144,150,160,180,200,240,300,320,360,400,480,600
  53. 1140 *N_DPI:DATA "  モノクロ  ",0,モノクロ(赤),16,モノクロ(緑),32,モノクロ(青),48,カラー(面順),1,カラー(線順),2
  54. 1150 DATA " ＣＲＴ(２値表示) ",1,"  ＣＲＴ(中間調)  ",2," プリンタ(高密度) ",0," プリンタ(低密度) ",16,プリンタ(文字混在),32
  55. 1160 DATA 中間調Ａ(硬調),0,中間調Ｂ(軟調),16,中間調Ｃ(網点),32,中間調処理なし,1
  56. 1170 DATA "Impact Dot Printer",16,"  熱転写プリンタ  ",32," Ink-Jet Printer  ",64,"ＣＲＴディスプレイ",128
  57. 1180 DATA "     16色モード   ","   32768色モード  "," 256色モード(2Bit)"," 256色モード(3Bit)"
  58. 1190 DATA "|        -3",253," |       -2",254,"  |      -1",255,"   |      0",0,"    |     1",1,"     |    2",2,"      |   3",3
  59. 1200 DATA 0,0,0,0 ,3,0,0,255 ,28,0,255,0 ,31,0,255,255 ,224,255,0,0 ,227,255,0,255 ,252,255,255,0 ,255,255,255,255
  60. 1210 DATA " モノクロ多階調モード "," パレット4096色モード ","パレット1677万色モード"
  61. 1220 ESC$=CHR$(27):STX$=CHR$(2):ACK$=CHR$(6):CAN$=CHR$(24)
  62. 1230 TY=0:CCOL=1:DFO=1:MID=0:SZOMX=100:SZOMY=100:R1=100:R2=100:OCM=128:NOU=1:LUM=0:MAX=8*(INT((8.56!*R1*SZOMX/100)/8)):MAY=INT(11.6!*R2*SZOMY/100):XST=0:YST=0:XEN=639:YEN=479:GOSUB *SCREEN_MODE:GOSUB *PALETTE_PALETTE:GOTO *MENU
  63. 1240 *READ:CLS:GOSUB *SCREEN_MODE:MAX=8*(INT((8.56!*R1*SZOMX/100)/8)):MAY=INT(11.6!*R2*SZOMY/100)
  64. 1250 IF XST+XEN>MAX-1 THEN PRINT USING "主走査方向領域(####)をはみ出しました。";MAX:RETURN
  65. 1260 IF YST+YEN>MAY-1 THEN PRINT USING "副走査方向領域(####)をはみ出しました。";MAY:RETURN
  66. 1270 IF PALM=0 THEN GOSUB *PALETTE_PALETTE ELSE GOSUB *PALETTE_SET
  67. 1280 PIT&=CALLM(RINIT&):SCOM$="C":PAR$=CHR$(CCOL):GOSUB *SENDDATAC:SCOM$="D":PAR$=CHR$(DFO):GOSUB *SENDDATA:SCOM$="B":PAR$=CHR$(MID):GOSUB *SENDDATA:SCOM$="H":PAR$=CHR$(SZOMX)+CHR$(SZOMY):GOSUB *SENDDATA
  68. 1290 SCOM$="M":PAR$=CHR$(OCM):GOSUB *SENDDATA:SCOM$="L":PAR$=CHR$(LUM):GOSUB *SENDDATA:SCOM$="Z":PAR$=CHR$(NOU):GOSUB *SENDDATA:SCOM$="R":PAR$=CHR$(R1 MOD 256)+CHR$(R1 \ 256)+CHR$(R2 MOD 256)+CHR$(R2 \ 256):GOSUB *SENDDATA
  69. 1300 SCOM$="A":PAR$=CHR$(XST MOD 256)+CHR$(XST \ 256)+CHR$(YST MOD 256)+CHR$(YST \ 256)+CHR$((XEN+1) MOD 256)+CHR$((XEN+1) \ 256):PAR$=PAR$+CHR$((YEN+1) MOD 256)+CHR$((YEN+1) \ 256):GOSUB *SENDDATA:GOSUB *SENDG:A&=1
  70. 1310 IF CCOL=0 OR CCOL=32 THEN CCO0=0
  71. 1320 IF CCOL=16 THEN CCO0=1 ELSE IF CCOL=48 THEN CCO0=2
  72. 1330 IF CCOL=1 OR CCOL=2 THEN CCO0=0:CCO1=2 ELSE CCO1=CCO0
  73. 1340 MODE&=FPAL*16777216+PALM*65536+TY*256+SCM:GRAP&=VARPTR(CH%(0)):DUM=0:ON SCM+1 GOTO *SCAN_16,*SCAN_32768,*SCAN_256
  74. 1350 *SCAN_16:ON PALM GOTO 1870 '     データＲＥＡＤ
  75. 1360 IF TY=1 THEN *DIR_Y16
  76. 1370 *DIR_T16:IF CCOL=1 THEN 1390
  77. 1380 FOR L=0 TO YEN:FOR COL=CCO0 TO CCO1:GOTO *WAIT_T16
  78. 1390 FOR COL=CCO0 TO CCO1:FOR L=0 TO YEN
  79. 1400  *WAIT_T16
  80. 1410   A&=CALLM(GETH&,VARPTR(GD%(0)),A&):IF A&=ERRC& THEN *ERR2
  81. 1420   IF INKEY$=ESC$ THEN GOSUB *SENDC:L=YEN+1:COL=3:GOTO 1450
  82. 1430   CALLM 0,MODE&,XEN,VARPTR(GD%(0)),GRAP&,0,COL
  83. 1440   PUT@ (0,L)-(XEN,L),CH%,OR,CO%(COL)
  84. 1450 NEXT:NEXT:CALLM RCLOSE&,PIT&
  85. 1460 RETURN
  86. 1470 *DIR_Y16:XEN1=(XEN+1)*MABP-1:LLEN=BDX-YEN*MABP:IF CCOL=1 THEN 1490
  87. 1480 FOR L=BDX-0 TO LLEN STEP -1*MABP:FOR COL=CCO0 TO CCO1:GOTO *WAIT_Y16
  88. 1490 FOR COL=CCO0 TO CCO1:FOR L=BDX-0 TO LLEN STEP -1*MABP
  89. 1500  *WAIT_Y16
  90. 1510   A&=CALLM(GETH&,VARPTR(GD%(0)),A&):IF A&=ERRC& THEN *ERR2
  91. 1520   IF INKEY$=ESC$ THEN GOSUB *SENDC:L=-1:COL=3:IF CCO0=CCO1 THEN LOCATE 40,24:COLOR 4:PRINT "スキャナからの読込を中止しました。";:COLOR 7:GOTO 1550 ELSE 1550
  92. 1530   CALLM 0,MODE&,XEN,VARPTR(GD%(0)),GRAP&,0,COL
  93. 1540   PUT@ (L-MABP+1,0)-(L,XEN1),CH%,OR,CO%(COL)
  94. 1550 NEXT:NEXT:CALLM RCLOSE&,PIT&
  95. 1560 RETURN
  96. 1570 *SCAN_32768:DD=1
  97. 1580 IF TY=1 THEN *DIR_Y32
  98. 1590 *DIR_T32
  99. 1600 *DIR_T:IF CCOL=2 THEN FOR L=0 TO YEN:FOR COL=CCO0 TO CCO1:GOTO *WAIT_T32
  100. 1610 FOR COL=CCO0 TO CCO1:FOR L=0 TO YEN
  101. 1620  *WAIT_T32
  102. 1630   A&=CALLM(GETH&,VARPTR(GD%(0)),A&):IF A&=ERRC& THEN *ERR2
  103. 1640   IF INKEY$=ESC$ THEN GOSUB *SENDC:L=YEN+1:COL=3:GOTO 1670
  104. 1650   CALLM 0,MODE&,XEN,VARPTR(GD%(0)),VARPTR(CH%(0)),0,COL,DFO
  105. 1660   PUT@A (0,L)-(XEN,L),CH%,OR
  106. 1670 NEXT:NEXT:CALLM RCLOSE&,PIT&
  107. 1680 RETURN
  108. 1690 *DIR_Y32
  109. 1700 *DIR_Y:LLEN=BDX-YEN:IF CCOL=2 THEN FOR L=BDX TO LLEN STEP -1:FOR COL=CCO0 TO CCO1:GOTO *WAIT_Y32
  110. 1710 FOR COL=CCO0 TO CCO1:FOR L=BDX TO LLEN STEP -1
  111. 1720  *WAIT_Y32
  112. 1730   A&=CALLM(GETH&,VARPTR(GD%(0)),A&):IF A&=ERRC& THEN *ERR2
  113. 1740   IF INKEY$=ESC$ THEN GOSUB *SENDC:L=-1:COL=3:GOTO 1770
  114. 1750 CALLM 0,MODE&,XEN,VARPTR(GD%(0)),VARPTR(CH%(0)),0,COL,DFO
  115. 1760 PUT@A (L,0)-(L,XEN),CH%,OR
  116. 1770 NEXT:NEXT:CALLM RCLOSE&,PIT&
  117. 1780 RETURN
  118. 1790 *SCAN_256:ON PALM GOTO 1850,1870,1880
  119. 1800 IF DFO=2 THEN 1830
  120. 1810   DD=1
  121. 1820   IF TY=0 THEN *DIR_T ELSE *DIR_Y
  122. 1830   DD=2
  123. 1840   IF TY=0 THEN *DIR_T ELSE *DIR_Y
  124. 1850   DD=2
  125. 1860   IF TY=0 THEN *DIR_T ELSE *DIR_Y
  126. 1870 DD=960:GOTO 1890
  127. 1880 DD=480
  128. 1890 IF TY=1 THEN *DIR_YP
  129. 1900 FOR L=0 TO YEN:FOR COL=0 TO 2
  130. 1910   A&=CALLM(GETH&,VARPTR(GD%(0)),A&):IF A&=ERRC& THEN *ERR2
  131. 1920 IF INKEY$=ESC$ THEN GOSUB *SENDC:L=YEN+1:COL=3:NEXT:GOTO 1960
  132. 1930 CALLM 0,MODE&,XEN,VARPTR(GD%(0)),VARPTR(G%(0)),0,COL,1
  133. 1940 NEXT
  134. 1950   CALLM 0,MODE&,XEN,VARPTR(CH%(0)),VARPTR(G%(0)),VARPTR(PAL&(0)),0,0:PUT@A (0,L)-(XEN,L),CH%,PSET
  135. 1960 NEXT:CALLM RCLOSE&,PIT&
  136. 1970 RETURN
  137. 1980 *DIR_YP:LLEN=BDX-YEN:FOR L=BDX TO LLEN STEP -1:FOR COL=0 TO 2
  138. 1990   A&=CALLM(GETH&,VARPTR(GD%(0)),A&):IF A&=ERRC& THEN *ERR2
  139. 2000 IF INKEY$=ESC$ THEN GOSUB *SENDC:ST=DST+1:L=-1:COL=3:NEXT:GOTO 2040
  140. 2010 CALLM 0,MODE&,XEN,VARPTR(GD%(0)),VARPTR(G%(0)),0,COL,1
  141. 2020 NEXT
  142. 2030   CALLM 0,MODE&,XEN,VARPTR(CH%(0)),VARPTR(G%(0)),VARPTR(PAL&(0)),0,0:PUT@A (L,0)-(L,XEN),CH%,PSET
  143. 2040 NEXT:CALLM RCLOSE&,PIT&
  144. 2050 RETURN
  145. 2060 *SENDDATA2C:A&=CALLM(PUTC&,ASC(SCOM$),VARPTR(PAR$)):IF A&<>ERRC& THEN RETURN ELSE *SENDDATA2
  146. 2070 *SENDDATAC:A&=CALLM(PUTC&,ASC(SCOM$),VARPTR(PAR$)):IF A&<>ERRC& THEN RETURN
  147. 2080 *SENDDATA:A&=CALLM(PUTC&,ASC(SCOM$),VARPTR(PAR$)):IF A&=ERRC& THEN *ERR
  148. 2090 RETURN
  149. 2100 *SENDDATA2:A&=CALLM(PUTC&,ASC(SCOM$),VARPTR(PAR$)):IF A&=ERRC& THEN *ERR3
  150. 2110 RETURN
  151. 2120 *SENDC:CALLM RPUT1&,ASC(CAN$):RETURN
  152. 2130 *SENDA:CALLM RPUT1&,ASC(ACK$):RETURN
  153. 2140 *SENDG:IF SCSI=1 THEN RETURN ELSE CALLM RPUT1&,ASC(ESC$):CALLM RPUT1&,ASC("G"):FOR W=0 TO 100:FOR W1=0 TO 50:NEXT:NEXT:RETURN
  154. 2150 *ERR:CLS:BEEP:PRINT RIGHT$(SCOM$,1);"コマンドにエラーが発生しました。":CALLM RCLOSE&,PIT&:RETURN 2160
  155. 2160 FOR DUM=0 TO 32000:NEXT:RETURN
  156. 2170 *ERR2:CLS:PRINT "通信回線にエラーが発生しました。":CALLM RCLOSE&,PIT&:END
  157. 2180 *ERR3:BEEP:LOCATE 20,24:PRINT RIGHT$(SCOM$,1);"コマンドにエラーが発生しました。";:CALLM RCLOSE&,PIT&:FOR DUM=0 TO 32000:NEXT:LOCATE 20,24:PRINT SPC(40);:RETURN 2160
  158. 2190 *SCAN_PUT:CLS:GOSUB *SCREEN_MODE:ON ERROR GOTO 2210:LOAD@ FDSF$:PS$=FDSF$:GOSUB *PALETTE_LOAD_IN:GOSUB *PALETTE_CHANGE
  159. 2200 ON ERROR GOTO 0:GOSUB *PALETTE_INI:RETURN
  160. 2210 GOSUB *PALETTE_PALETTE:RESUME 2200
  161. 2220 *PREV_PUT:OSCM=SCM:SCM=0:GOSUB *SCREEN_MODE:PALETTE:SCM=OSCM:MCX=220:MCY=180
  162. 2230 *PREV_PUT_IN:LOAD@ FDPF$,G%:CLS:PUT@ (60,0)-(639,423),G%,PSET,4:RETURN
  163. 2240 *MENU_WRT:GET@A (MCX,MCY)-(MCX+199,MCY+119),G%:LINE (MCX,MCY)-(MCX+199,MCY+119),PSET,7,BF,1:MOUSE 0:MOUSE 1,MCX+100,MCY+60,1:MOUSE 4,MCX,MCY,MCX+199,MCY+119:RETURN
  164. 2250 *MOUSE_GET:A=0:MMX=MOUSE(0)-MCX:MMY=MOUSE(1)-MCY:IF MOUSE(2,0)=0 THEN A$=INKEY$:IF A$=CHR$(13) OR A$=CHR$(24) THEN A=ASC(A$):RETURN ELSE *MOUSE_GET
  165. 2260 *MOUSE_CHK:WHILE MOUSE(6,0)=0:WEND:RETURN
  166. 2270 *MENU:IF PSCM<>1 THEN MCX=220:MCY=180 ELSE MCX=60:MCY=60
  167. 2280 GET@A (MCX,MCY)-(MCX+199,MCY+119),G%
  168. 2290 *MENU_IN:GOSUB *PALETTE_INI:LINE (MCX,MCY)-(MCX+199,MCY+119),PSET,7,BF,1:A!=FRE(4):FOR A=0 TO 128:A$=INKEY$:NEXT
  169. 2300 SYMBOL (MCX+4,MCY+2), "   仮読込       読込    ",1,1,4:SYMBOL (MCX+4,MCY+22)," パラメータ  モード設定 ",1,1,4:SYMBOL (MCX+4,MCY+42),"イメージ設定パレット設定",1,1,4:SYMBOL (MCX+4,MCY+62),"解像度&倍率   画面領域  ",1,1,4
  170. 2310 SYMBOL (MCX+3,MCY+82),"ファイル関連    終了    ",1,1,4
  171. 2320 LINE (MCX+1,MCY+101)-(MCX+198,MCY+118),PSET,3,BF,0:SYMBOL (MCX+4,MCY+102),"ColorfulStick Ver. 1.12j",1,.5!,4:SYMBOL (MCX+4,MCY+110),"(C)1990-Pineapple Marmalade",.9!,.5!,5
  172. 2330 LINE (MCX+1,MCY+20)-(MCX+198,MCY+20),PSET,7:LINE (MCX+1,MCY+40)-(MCX+198,MCY+40),PSET,7:LINE (MCX+1,MCY+60)-(MCX+198,MCY+60),PSET,7:LINE (MCX+1,MCY+80)-(MCX+198,MCY+80),PSET,7:LINE (MCX+1,MCY+100)-(MCX+198,MCY+100),PSET,7
  173. 2340 LINE (MCX+99,MCY+1)-(MCX+99,MCY+100),PSET,7
  174. 2350 MOUSE 0:MOUSE 1,MCX+100,MCY+60,1:MOUSE 4,MCX,MCY,MCX+199,MCY+119
  175. 2360 IF MOUSE (2,0) THEN A=MOUSE(6,0):GOSUB *MOUSE_CHK ELSE 2360
  176. 2370 MMX=MOUSE(0)-MCX:MMY=MOUSE(1)-MCY
  177. 2380 IF MMY>100 THEN GOSUB *ABOUT:GOTO *MENU_IN
  178. 2390 CMD=(MMY) \ 20:CMD=CMD*2+((MMX) \ 99):MMX=(CMD MOD 2)*99+MCX:MMY=(CMD \ 2)*20+MCY:LINE (MMX+1,MMY+1)-(MMX+98,MMY+19),XOR,7,BF
  179. 2400 LINE (MCX,MCY)-(MCX+199,MCY+119),PSET,7,BF,1:ON CMD+1 GOTO *PREVIEW,*READ_S,*PARA,*MODE,*IMAGE,*PALETTE,*ZOOM,*AREA,*FILE,*END:GOTO *MENU_IN
  180. 2410 *NON_SAP:LINE (MCX+114,MCY+99)-(MCX+199,MCY+119),PSET,7,B:SYMBOL (MCX+124,MCY+101),"メニュー",1,1,4:SYMBOL (MCX+4,MCY+22),"この機能は現在",1,1,4:SYMBOL (MCX+4,MCY+40),"サポートされていません。",1,1,4:WHILE MOUSE(6,0)=0:WEND:RETURN
  181. 2420 *ABOUT:GOSUB *ABOUT_WRT:GOSUB *MOUSE_CHK:RETURN
  182. 2430 *ABOUT_WRT:LINE (MCX,MCY)-(MCX+199,MCY+119),PSET,7,BF,1:SYMBOL (MCX+3,MCY+17),"ColorfulStick",1,1,4,,,10:SYMBOL (MCX+3,MCY+48),"Version 1.12j (91/01/01)",1,1,5,,,5:SYMBOL (MCX+3,MCY+66),"Copyright 1990-",1,1,3,,,8
  183. 2440 SYMBOL (MCX+6,MCY+84),"Studio Pineapple Maramalade",.85!,1,6,,,24:SYMBOL (MCX+64,MCY+102),"[ Miwa Suguru ]",1,1,6,,,9:GET@A (MCX+3,MCY+17)-(MCX+110,MCY+34),GD%:FOR A=1 TO 10:Y=MCY+(17-A):PUT@A (MCX+3,Y)-(MCX+110,Y+17),GD%,PSET,1+A*.075!,1+A/10:NEXT
  184. 2450 CIRCLE (MCX+162,MCY+12),4,6,,,,F,,2:LINE (MCX+3,MCY+41)-(MCX+196,MCY+44),PSET,6,BF,2:RETURN
  185. 2460 *PREVIEW
  186. 2470 SYMBOL (MCX+4,MCY+22),"  仮読込を実行します。  ",1,1,4:SYMBOL (MCX+6,MCY+101),"    取消        実行",1,1,4:LINE (MCX+1,MCY+99)-(MCX+198,MCY+99),PSET,7:LINE (MCX+132,MCY+99)-(MCX+165,MCY+119),PSET,5,B,&H5555
  187. 2480 SYMBOL (MCX+126,MCY+79),"まびき",1,.5!,4:SYMBOL (MCX+102,MCY+89),"なし  あ り",1,.5!,4:LINE (MCX+99,MCY+99)-(MCX+99,MCY+119),PSET,7
  188. 2490 GOSUB *MOUSE_GET:IF A=0 AND MMY<100 THEN 2490 ELSE IF MMX<99 OR A=24 THEN *MENU_IN
  189. 2500 IF A=0 THEN MABP=SGN((MMX-100)\33)+1:GOSUB 2540:CCOL=(MMX\166)*OCOL
  190. 2510 TY=1:DFO=1:MID=0:SZOMX=100/MABP:SZOMY=100/MABP:R1=50:R2=50:NOU=1:XST=0:YST=0:XEN=207:YEN=289:SCM=0:LUM=0:OCM=128:FPAL=1:PALM=0:IF MABP<2 THEN XEN=423:YEN=579:FPAL=0
  191. 2520 MOUSE 5:GOSUB *READ:IF DUM<>0 THEN 2530 ELSE LOCATE 0,24:COLOR 4:PRINT "パターン読込中...";:GET@ (60,0)-(639,423),G%,4,5,6,7:LOCATE 0,24:PRINT "ディスクにデータを退避しています。";:COLOR 7:KILL FDPF$:SAVE@ FDPF$,G%
  192. 2530 MABP=1:PRF=1:GOSUB 2540:CLS 4:GOSUB *SCREEN_MODE:GOTO *MENU
  193. 2540 SWAP TY,OTY:SWAP CCOL,OCOL:SWAP DFO,ODFO:SWAP MID,OMID:SWAP SZOMX,OZMX:SWAP SZOMY,OZMY:SWAP R1,OOR1:SWAP R2,OOR2:SWAP NOU,ONOU:SWAP XST,OXST:SWAP YST,OYST:SWAP XEN,OXEN:SWAP YEN,OYEN:SWAP SCM,OSCM:SWAP LUM,OLUM:SWAP OCM,OOCM:SWAP FPAL,OFPAL
  194. 2550 SWAP PALM,OPALM:RETURN
  195. 2560 *READ_S:SYMBOL (MCX+4,MCY+22),"  読込を実行します。",1,1,4:SYMBOL (MCX+6,MCY+101),"    取消        実行",1,1,4:LINE (MCX+1,MCY+99)-(MCX+198,MCY+99),PSET,7:LINE (MCX+99,MCY+99)-(MCX+99,MCY+119),PSET,7
  196. 2570 GOSUB *MOUSE_GET:IF A=13 THEN 2590 ELSE IF A=24 THEN *MENU_IN
  197. 2580 IF MMY<100 THEN 2570 ELSE IF MMX<99 THEN *MENU_IN
  198. 2590 MOUSE 5:GOSUB *PALETTE_UNDO:GOSUB *READ:IF DUM<>0 THEN *MENU ELSE IF PSCM<>2 THEN COLOR 4:LOCATE 0,24:PRINT "ディスクにデータを退避しています。";:COLOR 7
  199. 2600 KILL FDSF$:SAVE@ FDSF$,(0,0)-(BDX,BDY):PS$=FDSF$:GOSUB *PALETTE_SAVE_IN:IF PSCM<>2 THEN CLS 4:GOTO *MENU ELSE *MENU
  200. 2610 *PARA:DPD=ASC(DPD$)-65:SYMBOL (MCX+4,MCY+4),"パラメータファイル",1,1,4:LINE (MCX,MCY+21)-(MCX+199,MCY+21),PSET,7:SYMBOL (MCX+38,MCY+101),"取消        実行",1,1,4:LINE (MCX+1,MCY+99)-(MCX+198,MCY+99),PSET,7:LINE (MCX+99,MCY+99)-(MCX+99,MCY+119),PSET,7
  201. 2620 LINE (MCX+2,MCY+78)-(MCX+197,MCY+97),PSET,3,B:LSF=0:GOSUB 2850:GOSUB 2860
  202. 2630 GOSUB *MOUSE_GET:IF A>0 THEN IF A=24 THEN *MENU_IN ELSE 2770
  203. 2640 IF MMY>99 THEN IF MMX<99 THEN *MENU_IN ELSE 2770
  204. 2650 IF MMX>2 AND MMY>78 AND MMX<197 AND MMY<97 THEN 2680
  205. 2660 IF MMX<14 OR MMY<56 OR MMX>181 OR MMY>75 THEN 2630
  206. 2670 IF MMX\99=LSF THEN 2630 ELSE LSF=1-LSF:LINE (MCX+15,MCY+57)-(MCX+180,MCY+74),XOR,2,BF:GOTO 2630
  207. 2680 ODPD=DPD:LINE (MCX+2,MCY+78)-(MCX+197,MCY+97),PSET,4,BF,1:SYMBOL (MCX+4,MCY+80),"ABCDEFGHIJKLMNOPQ",1,1,4:SYMBOL (MCX+144,MCY+80),"取消 実行",.75!,1,4:LINE (MCX+141,MCY+78)-(MCX+170,MCY+97),PSET,4,B:MOUSE 4,MCX+2,MCY+78,MCX+197,MCY+97
  208. 2690 LINE (MCX+4+DPD*8,MCY+80)-(MCX+11+DPD*8,MCY+95),XOR,7,BF:GOSUB *MOUSE_GET:LINE (MCX+4+DPD*8,MCY+80)-(MCX+11+DPD*8,MCY+95),XOR,7,BF:IF A>0 THEN IF A=24 THEN DPD=ODPD:GOTO 2880 ELSE 2710
  209. 2700 IF MMX>141 THEN IF MMX<170 THEN DPD=ODPD:GOTO 2880 ELSE 2710 ELSE DPD=(MMX-4)\8:GOTO 2690
  210. 2710 DPD$=CHR$(DPD+65)+":":GOSUB 2860:LINE (MCX+162,MCY+78)-(MCX+180,MCY+97),PSET,4,B:SYMBOL (MCX+163,MCY+80),"取消実行",.5!,1,4,,,,1:IMX=MCX+18:IMY=MCY+80:C=4:BC=1:I$=DPF$:IS$=I$:ILEN=LEN(DPF$):MLEN=18:RE=0
  211. 2720 MOUSE 4,MCX+162,MCY+79,MCX+196,MCY+96:MOUSE 1,MCX+170,MCY+100,1:GOSUB 7850:LINE (MCX+162,MCY+79)-(MCX+196,MCY+96),PSET,1,BF:MOUSE 4,MCX,MCY,MCX+199,MCY+119:IF RIGHT$(I$,4)<>".SPF" THEN I$=I$+".SPF" ELSE I$=I$
  212. 2730 IF RE=1 THEN MMX=MOUSE(0)-MCX:YN=MMX\180:GOTO 2760 ELSE IF A$=CHR$(24) THEN YN=0:GOTO 2760
  213. 2740 DPF$=I$:A$="":WHILE MOUSE(2,0)=0 AND A$<>CHR$(13) AND A$<>CHR$(24):A$=INKEY$:WEND:IF A$<>"" THEN YN=SGN(24-YN):GOTO 2760
  214. 2750 WHILE MOUSE(6,0)=0:WEND:MMX=MOUSE(0)-MCX:YN=MMX\180
  215. 2760 IF YN=0 THEN 2880 ELSE DPF$=I$
  216. 2770 LINE (MCX+99,MCY+99)-(MCX+199,MCY+119),XOR,1,BF,4:IF LSF=1 THEN 2820
  217. 2780 LOCATE 0,0:ON ERROR GOTO 5000:OPEN "I",#1,DPD$+DPF$:DUM$=INPUT$(4,1):IF DUM$<>"SPF1" THEN 2800 ELSE TY=FND(1):CCOL=FND(1):DFO=FND(1):MID=FND(1):SZOMX=FND(1):SZOMY=FND(1):R1=FND(1):R2=FND(1):OCM=FND(1):NOU=FND(1):LUM=FND(1):FPAL=FND(1)
  218. 2790 XST=FND(1):YST=FND(1):XEN=FND(1):YEN=FND(1):PALM=FND(1):SCM=FND(1):DSCM=FND(1):SAF=FND(1):FCX=FND(1):FCY=FND(1):XLEN=FND(1):YLEN=FND(1):DFD$=INPUT$(2,1):DFF$=FND$(1):DPD$=INPUT$(2,1):DPF$=FND$(1)
  219. 2795 IF PALM<>0 THEN GOSUB *PARAPALL
  220. 2800 CLOSE:ON ERROR GOTO 0:GOTO *MENU_IN
  221. 2810 ON ERROR GOTO 0:LINE (MCX+4,MCY+24)-(MCX+195,MCY+43),PSET,1,BF:LINE (MCX+99,MCY+99)-(MCX+199,MCY+119),XOR,1,BF,4:MOUSE 4,MCX,MCY,MCX+199,MCY+119:GOTO 2630
  222. 2820 LOCATE 0,0:ON ERROR GOTO 5000:OPEN "O",#1,DPD$+DPF$:PRINT #1,"SPF1"+MKI$(TY)+MKI$(CCOL)+MKI$(DFO)+MKI$(MID)+MKI$(SZOMX)+MKI$(SZOMY)+MKI$(R1)+MKI$(R2)+MKI$(OCM)+MKI$(NOU)+MKI$(LUM)+MKI$(FPAL);
  223. 2830 PRINT #1,MKI$(XST)+MKI$(YST)+MKI$(XEN)+MKI$(YEN)+MKI$(PALM)+MKI$(SCM)+MKI$(DSCM)+MKI$(SAF)+MKI$(FCX)+MKI$(FCY)+MKI$(XLEN)+MKI$(YLEN)+DFD$+FNL$(DFF$)+DPD$+FNL$(DPF$);
  224. 2835 IF PALM<>0 THEN GOSUB *PARAPALS
  225. 2840 CLOSE:ON ERROR GOTO 0:GOTO *MENU_IN
  226. 2850 LINE (MCX+14,MCY+56)-(MCX+181,MCY+75),PSET,3,BF,4:SYMBOL (MCX+30,MCY+58),"ロード    セーブ",1,1,2,,,5,1:IF LSF=0 THEN LINE (MCX+99,MCY+57)-(MCX+180,MCY+74),XOR,2,BF:RETURN ELSE LINE (MCX+15,MCY+57)-(MCX+98,MCY+74),XOR,2,BF:RETURN
  227. 2860 LINE (MCX+3,MCY+79)-(MCX+196,MCY+96),PSET,1,BF:SYMBOL (MCX+4,MCY+80),CHR$(DPD+65)+":",1,1,4:ILEN=LEN(DPF$):IF ILEN>20 THEN IMX=MCX+18:IMY=MCY+80:C=4:BC=1:I$=DPF$:IS$=I$:MLEN=20:RE=0:GOSUB 7960:RETURN
  228. 2870 SYMBOL (MCX+18,MCY+80),DPF$,1,1,4:RETURN
  229. 2880 MOUSE 4,MCX,MCY,MCX+199,MCY+119:GOSUB 2860:GOTO 2630
  230. 3000 *PARAPALS
  231. 3010 ON SCM+1 GOTO 3030,3020,3040
  232. 3020 RETURN
  233. 3030 FOR A=0 TO 15:PRINT #1,MKL$(PAL&(A));:NEXT:RETURN
  234. 3040 FOR A=0 TO 255:PRINT #1,MKL$(PAL&(A));:NEXT:RETURN
  235. 4000 *PARAPALL
  236. 4010 ON SCM+1 GOTO 4030,4020,4040
  237. 4020 RETURN
  238. 4030 FOR A=0 TO 15:PAL&(A)=CVL(INPUT$(4,1)):NEXT:FOR A=16 TO 255:PAL&(A)=0:NEXT:A&=16:RETURN
  239. 4040 FOR A=0 TO 255:PAL&(A)=CVL(INPUT$(4,1)):NEXT:A&=256:RETURN
  240. 5000 BEEP:IF ERR=64 THEN M$="同名のファイルがあります":GOSUB 5130:IF YN=0 THEN RESUME 2810 ELSE KILL DPD$+DPF$:RESUME
  241. 5010 IF ERR=73 THEN M$="ディスクは書込禁止です":GOSUB 5130:IF YN=0 THEN RESUME 2810 ELSE RESUME
  242. 5020 IF ERR=53 THEN M$="装置に異常が発生しました":GOSUB 5110:RESUME 2810
  243. 5030 IF ERR=55 THEN M$="ファイル記述に誤りがあります":GOSUB 5110:RESUME 2810
  244. 5040 IF ERR=60 THEN M$="入出力装置は使用不可です":GOSUB 5110:RESUME 2810
  245. 5050 IF ERR=63 THEN M$="ファイルが見つかりません":GOSUB 5110:RESUME 2810
  246. 5060 IF ERR=65 THEN M$="ディレクトリ領域がいっぱいです":GOSUB 5110:RESUME 2810
  247. 5070 IF ERR=67 THEN M$="空き領域がありません":GOSUB 5110:RESUME 2810
  248. 5080 IF ERR=71 THEN M$="ファイル構成が不正です":GOSUB 5110:RESUME 2810
  249. 5090 IF ERR=72 THEN M$="ディスク装置が使用不可です":GOSUB 5110:RESUME 2810
  250. 5100 IF ERR=75 THEN M$="アクセスが拒否されました":GOSUB 5110:RESUME 2810 ELSE  M$="ｴﾗｰ ID="+FNF$(ERR)+" Line ="+FNG$(ERL):GOSUB 5130:CALLM RCLOSE&,PIT&:END
  251. 5110 GOSUB 5120:MOUSE 4,MCX+120,MCY+56,MCX+169,MCY+75:LINE (MCX+120,MCY+56)-(MCX+169,MCY+75),PSET,4,B:SYMBOL (MCX+122,MCY+58),"確認",1,1,4:GOSUB *MOUSE_GET:GOSUB 2850:RETURN
  252. 5120 LINE (MCX+14,MCY+56)-(MCX+181,MCY+75),PSET,1,BF:LINE (MCX+4,MCY+24)-(MCX+195,MCY+43),PSET,2,BF,1:IF LEN(M$)<23 THEN SYMBOL (MCX+8,MCY+26),M$,1,1,4:RETURN ELSE SYMBOL (MCX+8,MCY+26),M$,.75!,1,4:RETURN
  253. 5130 GOSUB 5120:MOUSE 4,MCX+80,MCY+56,MCX+159,MCY+75:LINE (MCX+80,MCY+56)-(MCX+159,MCY+75),PSET,4,B:SYMBOL (MCX+84,MCY+58),"取消 続行",1,1,4:LINE (MCX+120,MCY+56)-(MCX+120,MCY+75),PSET,4:GOSUB *MOUSE_GET:IF A>0 THEN YN=SGN(24-A) ELSE YN=MMX\120
  254. 5140 GOSUB 2850:RETURN
  255. 5150 *MODE:GOSUB *PREV_PUT:GOSUB *MENU_WRT:SYMBOL (MCX+3,MCY+4),"取込映像上方",1,1,4:SYMBOL (MCX+39,MCY+41),"スクリーンモード",1,1,4:SYMBOL (MCX+38,MCY+101),"取消        実行",1,1,4:LINE (MCX+4,MCY+39)-(MCX+195,MCY+57),PSET,3,B
  256. 5160 LINE (MCX+1,MCY+99)-(MCX+198,MCY+99),PSET,7:LINE (MCX+116,MCY+3)-(MCX+196,MCY+39),PSET,6,BF,4:SYMBOL (MCX+120,MCY+6),"♀",2,2,2:SYMBOL (MCX+190,MCY+6),"♀",2,2,2,3:LINE (MCX+156,MCY+4)-(MCX+156,MCY+38),PSET,1
  257. 5170 LINE (MCX+4,MCY+58)-(MCX+195,MCY+76),PSET,6,BF,4:LINE (MCX+2,MCY+3)-(MCX+115,MCY+21),PSET,3,B:LINE (MCX+20,MCY+58)-(MCX+179,MCY+76),PSET,6,BF,0:LINE (MCX+99,MCY+99)-(MCX+99,MCY+119),PSET,7:LINE (MCX+115,MCY+3)-(MCX+197,MCY+39),PSET,3,B
  258. 5180 SYMBOL (MCX+5,MCY+74),"▲",1,1,2,1:SYMBOL (MCX+194,MCY+60),"▲",1,1,2,3:ODSCM=DSCM:OTY=TY:GOSUB 5280
  259. 5190 LINE (MCX+21,MCY+59)-(MCX+178,MCY+75),PSET,0,BF:SYMBOL (MCX+24,MCY+59),SCM$(DSCM),1,1,4:GOSUB *MOUSE_GET
  260. 5200 IF A>0 THEN IF A=24 THEN MMX=50:MMY=100 ELSE 5290
  261. 5210 IF MMY>98 THEN IF MMX<99 THEN DSCM=ODSCM:TY=OTY:GOTO *MENU_IN ELSE 5290
  262. 5220 IF (MMY<40 AND MMX<116) OR (MMY>39 AND MMY<58) OR MMY>76 THEN 5190
  263. 5230 IF MMY>57 AND MMX>20 AND MMX<179 THEN 5190
  264. 5240 IF MMY<40 THEN GOSUB 5280:IF MMX<156 THEN TY=1:GOSUB 5280:GOTO 5190 ELSE TY=0:GOSUB 5280:GOTO 5190
  265. 5250 IF MMX<21 THEN DSCM=DSCM-1:IF DSCM<0 THEN DSCM=3
  266. 5260 IF MMX>178 THEN DSCM=DSCM+1:IF DSCM>3 THEN DSCM=0
  267. 5270 GOTO 5190
  268. 5280 A=MCX+116+TY*41:LINE (A,MCY+4)-(A+39,MCY+38),XOR,1,BF:RETURN
  269. 5290 IF OTY<>TY THEN SWAP XEN,YEN:XEN=((XEN+1)\8)*8-1 ELSE 5330
  270. 5300 MAX=8*(INT((8.56!*R1*SZOMX/100)/8)):MAY=INT(11.6!*R2*SZOMY/100)
  271. 5310 IF XST+XEN>MAX THEN IF XST>0 THEN XST=XST-1:GOTO 5310 ELSE XEN=(((XEN+1)-8)\8)*8-1:GOTO 5310
  272. 5320 IF YST+YEN>MAY THEN IF YST>0 THEN YST=YST-1:GOTO 5320 ELSE YEN=YEN-1:GOTO 5320
  273. 5330 IF DSCM=0 THEN DFO=1:SCM=DSCM
  274. 5340 IF DSCM=1 THEN DFO=5:SCM=DSCM:PALM=0
  275. 5350 IF DSCM=2 THEN DFO=2:SCM=DSCM
  276. 5360 IF DSCM=3 THEN DFO=3:SCM=2
  277. 5370 IF SCM<>OSCM THEN GOSUB *PALETTE_PALETTE_IN:PALM=0:FPAL=0
  278. 5380 GOSUB *SCREEN_CALC:IF TY THEN BDM=BDY:BDS=BDX ELSE BDM=BDX:BDS=BDY
  279. 5390 IF XEN>BDM THEN XEN=BDM
  280. 5400 IF YEN>BDS THEN YEN=BDS
  281. 5410 GOTO *MENU_IN
  282. 5420 *IMAGE:SYMBOL (MCX+3,MCY+4),"色指定",1,1,4:SYMBOL (MCX+3,MCY+24)," 明度",1,1,4:SYMBOL (MCX+3,MCY+44),"濃度補正",.75!,1,4:SYMBOL (MCX+3,MCY+64),"中間調",1,1,4:SYMBOL (MCX+3,MCY+84),"色補正",1,1,4:LINE (MCX+51,MCY+2)-(MCX+51,MCY+100),PSET,3
  283. 5430 FOR W=1 TO 4:A=MCY+2+20*W:LINE (MCX+2,A)-(MCX+198,A),PSET,3:NEXT:SYMBOL (MCX+38,MCY+105),"取消        実行",1,.8!,4:LINE (MCX+1,MCY+103)-(MCX+198,MCY+103),PSET,7:LINE (MCX+99,MCY+103)-(MCX+99,MCY+119),PSET,7
  284. 5440 FOR W=0 TO 4:A=MCY+3+20*W:LINE (MCX+52,A)-(MCX+197,A+18),PSET,6,BF,4:NEXT:FOR W=0 TO 4:A=MCY+3+20*W:LINE (MCX+62,A)-(MCX+187,A+18),PSET,6,BF,0:NEXT:LINE (MCX+2,MCY+2)-(MCX+198,MCY+102),PSET,3,B
  285. 5450 SYMBOL (MCX+54,MCY+99),"▲▲▲▲▲",1,.5!,2,1,,,4:SYMBOL (MCX+195,MCY+5),"▲▲▲▲▲",1,.5!,2,3,,,4
  286. 5460 CLP=0:FOR A=0 TO 5:IF COL%(A)=CCOL THEN CLP=A:NEXT ELSE NEXT
  287. 5470 LUMP=0:FOR A=0 TO 6:IF LUM%(A)=LUM THEN LUMP=A:NEXT ELSE NEXT
  288. 5480 NOUP=0:FOR A=0 TO 4:IF NOU%(A)=NOU THEN NOUP=A:NEXT ELSE NEXT
  289. 5490 MIDP=0:FOR A=0 TO 3:IF MID%(A)=MID THEN MIDP=A:NEXT ELSE NEXT
  290. 5500 OCMP=0:FOR A=0 TO 3:IF OCM%(A)=OCM THEN OCMP=A:NEXT ELSE NEXT
  291. 5510 CMD=0:PX!=1:PCX=16:M$=COL$(CLP):GOSUB 5640:CMD=1:PX!=1:PCX=0:M$=LUM$(LUMP):GOSUB 5640:CMD=2:PX!=.9!:PCX=0:M$=NOU$(NOUP):GOSUB 5640:CMD=3:PX!=1:PCX=8:M$=MIDL$(MIDP):GOSUB 5640:CMD=4:PX!=.9!:PCX=0:M$=OCM$(OCMP):GOSUB 5640
  292. 5520 GOSUB *MOUSE_GET:IF A>0 THEN IF A=13 THEN MMX=150:MMY=105 ELSE *MENU_IN
  293. 5530 IF MMY>103 THEN IF MMX>99 THEN CCOL=COL%(CLP):LUM=LUM%(LUMP):NOU=NOU%(NOUP):MID=MID%(MIDP):OCM=OCM%(OCMP):IF SCM=2 AND PALM=1 AND (CCOL=1 OR CCOL=2) THEN CCOL=0:GOTO *MENU_IN ELSE *MENU_IN ELSE *MENU_IN
  294. 5540 IF MMX<52 OR (MMX>62 AND MMX<187) THEN 5520
  295. 5550 IF MMY<22 THEN CMD=0:PX!=1:PCX=16:CMDP=CLP:CMDM=5:GOSUB 5610:CLP=CMDP:M$=COL$(CLP):GOTO 5600
  296. 5560 IF MMY<42 THEN CMD=1:PX!=1:PCX=0:CMDP=LUMP:CMDM=6:GOSUB 5610:LUMP=CMDP:M$=LUM$(LUMP):GOTO 5600
  297. 5570 IF MMY<62 THEN CMD=2:PX!=.9!:PCX=0:CMDP=NOUP:CMDM=4:GOSUB 5610:NOUP=CMDP:M$=NOU$(NOUP):GOTO 5600
  298. 5580 IF MMY<82 THEN CMD=3:PX!=1:PCX=8:CMDP=MIDP:CMDM=3:GOSUB 5610:MIDP=CMDP:M$=MIDL$(MIDP):GOTO 5600
  299. 5590 CMD=4:PX!=.9!:PCX=0:CMDP=OCMP:CMDM=3:GOSUB 5610:OCMP=CMDP:M$=OCM$(OCMP)
  300. 5600 GOSUB 5640:GOTO 5520
  301. 5610 IF MMX>98 THEN CMDP=CMDP+1:IF CMDP>CMDM THEN CMDP=CMDM
  302. 5620 IF MMX<99 THEN CMDP=CMDP-1:IF CMDP<0 THEN CMDP=0
  303. 5630 RETURN
  304. 5640 A=MCY+4+20*CMD:LINE (MCX+63,A)-(MCX+186,A+16),PSET,0,BF:SYMBOL (MCX+PCX+62,A),M$,PX!,1,4:RETURN
  305. 5650 GOTO 5650
  306. 5660 *PALETTE:IF SCM=1 THEN LINE (MCX+114,MCY+99)-(MCX+199,MCY+119),PSET,7,B:SYMBOL (MCX+124,MCY+101),"メニュー",1,1,4:SYMBOL (MCX+20,MCY+22),"現在の画面モードでは",1,1,4:SYMBOL (MCX+20,MCY+40),"設定できません",1,1,4:GOSUB *MOUSE_GET:GOTO *MENU_IN
  307. 5670 GOSUB *SCREEN_MODE:GOSUB *PREV_PUT_IN:LINE (60,0)-(639,423),PSET,7,B:LINE (13,435)-(226,454),PSET,6,BF,4:LINE (229,435)-(402,454),PSET,6,BF,4:LINE (30,435)-(209,454),PSET,6,BF,0:LINE (246,435)-(385,454),PSET,6,BF,0:LOCATE 52,23:COLOR (SCM+1)*2
  308. 5680 PRINT "メニュー  取り込み  初期化":LINE (412,435)-(483,454),XOR,3,BF,4:LINE (492,435)-(563,454),XOR,3,BF,4:LINE (572,435)-(627,454),XOR,3,BF,4:MOUSE 0:MOUSE 1,320,240,1:GOSUB 6280:COLOR 4:LOCATE 31,23:PRINT "固定パレット":COLOR 6:LOCATE 2,24
  309. 5690 PRINT "Palette Mode";:LINE (13,455)-(115,472),XOR,2,BF,1:LINE (115,455)-(146,472),PSET,2,BF,0:SYMBOL (14,452),"▲",1,1,2,1:SYMBOL (210,452),"▼",1,1,2,1:SYMBOL (230,452),"▲",1,1,2,1:SYMBOL (386,452),"▼",1,1,2,1:COLOR 6:GOSUB *PALETTE_CHANGE
  310. 5700 IF SCM=2 THEN *PALETTE_256
  311. 5710 *PALETTE_16:MPAL=16:FOR A=0 TO 15:LINE (10,A*19+10)-(49,A*19+30),PSET,7,BF,%A:NEXT:PAL1=PALM-1:PAL2=FPAL:GOSUB 6080:GOSUB 6100:PALX=0:PALY=0:PALL=16:GOSUB 6130
  312. 5720 GOSUB 5850:IF CMD=1 THEN FPAL=PAL2:LINE (0,0)-(59,479),PSET,0,BF:LINE (0,424)-(639,479),PSET,0,BF:CLS 4:GOSUB 6130:FPAL=PAL2:DFO=PALM*3+1:IF DFO=4 THEN CCOL=2:GOTO *MENU ELSE *MENU
  313. 5730 IF CMD=3 THEN GOSUB 6100:GOSUB 6080:GOSUB 5840:GOTO 5720 ELSE LGP2=16:IF PAL2=16 THEN BEEP:GOTO 5720 ELSE LGP=8:LGP3=4:LGP4=16-PAL2:GOSUB 5780:PALM=1:GOSUB 6080:GOTO 5720
  314. 5740 *PALETTE_256:MPAL=256:MOUSE 1,,,0:FOR A=0 TO 15:FOR B=0 TO 15:LINE (B*3,A*3)-(B*3+2,A*3+2),PSET,%(A*16+B),BF:NEXT:NEXT:MOUSE 1,,,1:PAL1=PALM-1:PAL2=FPAL:GOSUB 6080:GOSUB 6100:PALX=0:PALY=0:PALL=64:GOSUB 6130
  315. 5750 GOSUB 5850:IF CMD<>1 THEN 5770 ELSE PALM=PAL1+1:LINE (0,0)-(59,479),PSET,0,BF:LINE (0,424)-(639,479),PSET,0,BF:GOSUB 6130:IF PAL1>=0 THEN DFO=8-(PAL1 MOD 2)*4 ELSE DFO=DSCM
  316. 5760 IF PAL1<>0 THEN FPAL=0:CCOL=2:GOTO *MENU ELSE FPAL=PAL2 MOD 3:GOSUB *PALETTE_SET:IF CCOL<3 THEN CCOL=0:GOTO *MENU ELSE *MENU
  317. 5770 IF CMD=3 THEN GOSUB 6100:GOSUB 6080:GOSUB 5840:GOTO 5750 ELSE LGP2=64:IF PAL1<1 OR PAL2=256 THEN BEEP:GOTO 5750 ELSE LGP=32*PAL1:LGP3=4*PAL1:LGP4=256-PAL2:GOSUB 5780:GOTO 5750
  318. 5780 LINE (148,455)-(331,472),PSET,0,BF:LOCATE 20,24:PRINT "スキャナ読み込み中…   ";:PIT&=CALLM(RINIT&):SCOM$="C":PAR$=CHR$(2):GOSUB *SENDDATA2C:SCOM$="D":PAR$=CHR$(LGP3):GOSUB *SENDDATA2
  319. 5790 SCOM$="H":PAR$=CHR$(100,100):GOSUB *SENDDATA2:SCOM$="M":PAR$=CHR$(OCM):GOSUB *SENDDATA2:SCOM$="L":PAR$=CHR$(LUM):GOSUB *SENDDATA2:SCOM$="Z":PAR$=CHR$(NOU):GOSUB *SENDDATA2:SCOM$="R":PAR$=CHR$(50,0,50,0):GOSUB *SENDDATA2
  320. 5800 SCOM$="A":PAR$=CHR$(PALY MOD 256,PALY \ 256,PALX MOD 256,PALX \ 256,PALL,0,PALL,0):GOSUB *SENDDATA2:GOSUB *SENDG:A&=1
  321. 5810 FOR L=0 TO LGP2-1:FOR COL=0 TO 2
  322. 5820 A&=CALLM(GETH&,VARPTR(GD%(0))+LGP*COL,A&):IF A&=ERRC& THEN *ERR2
  323. 5830 NEXT:CALLM 0,LGP,0,VARPTR(GD%(0)),VARPTR(G%(L*2*LGP2)):NEXT:CALLM RCLOSE&,PIT&:LOCATE 20,24:PRINT "パレットデータ作成中… ";:A&=CALLM(0,LGP,LGP4,0,VARPTR(G%(0)),VARPTR(PAL&(0))):GOSUB *PALETTE_CHANGE
  324. 5840 LOCATE 20,24:PRINT "定義済パレット数 :";FNF$(MPAL-A&);" ";:LINE (148,455)-(331,472),PSET,6,B:RETURN
  325. 5850 WHILE MOUSE(2,0)=0:WEND:MMX=MOUSE(0):MMY=MOUSE(1):IF MMX<640-PALX AND MMY=>PALY AND MMX>639-PALX-PALL AND MMY<PALY+PALL THEN GOSUB 6270:GOTO 5850
  326. 5860 WHILE MOUSE(6,0)=0:A=MOUSE(2,1):WEND:MMX=MOUSE(0):MMY=MOUSE(1):IF MMY<435 THEN 5930 ELSE IF MMY>454 THEN 5850 ELSE IF MMX>411 THEN 6140
  327. 5870 IF MMX<31 AND SCM=2 THEN PAL1=PAL1-1:IF PAL1<0 THEN PAL1=2
  328. 5880 IF MMX>208 AND MMX<227 AND SCM=2 THEN PAL1=PAL1+1:IF PAL1>2 THEN PAL1=0
  329. 5890 IF MMX>228 AND MMX<247 THEN PAL2=PAL2-1+A*3.5!:IF PAL2<0 THEN IF A THEN PAL2=0 ELSE PAL2=MPAL
  330. 5900 IF MMX>384 AND MMX<403 THEN PAL2=PAL2+1-A*3.5!:IF PAL2>MPAL THEN IF A THEN PAL2=MPAL ELSE PAL2=0
  331. 5910 IF MMX>246 AND MMX<385 THEN PAL2=MPAL-A&
  332. 5920 GOSUB 6100:GOSUB 6080:GOTO 5850
  333. 5930 IF SCM=2 THEN 5850 ELSE IF MMX>9 AND MMX<49 AND MMY>9 AND MMY<314 THEN COLOR 7 ELSE 5850
  334. 5940 PCY=(MMY-10)\19:GET@A (50,PCY*19+5)-(259,PCY*19+124),G%:LINE (76,PCY*19+5)-(259,PCY*19+124),PSET,7,BF,1:CONNECT (76,PCY*19+12)-(50,PCY*19+17)-(76,PCY*19+22),7,PSET,F,1:LOCATE 30,PCY+1:PRINT "□":PRINT SPC(10);"パレット修正"
  335. 5950 PRINT SPC(10);"G ＜";SPC(16);"＞":PRINT SPC(10);"R ＜";SPC(16);"＞":PRINT SPC(10);"B ＜";SPC(16);"＞":FOR A=0 TO 2:GOSUB 6040:NEXT:FOR A=3 TO 5:LINE (76,(PCY+A)*19-2)-(259,(PCY+A)*19+17),PSET,7,B:LINE(89,(PCY+A)*19-2)-(111,(PCY+A)*19+17),PSET,7,B
  336. 5960 LINE (239,(PCY+A)*19-2)-(239,(PCY+A)*19+17),PSET,7,B:NEXT:LINE (240,PCY*19+19)-(254,PCY*19+34),PSET,7:LINE (254,PCY*19+19)-(240,PCY*19+34),PSET,7:LINE (80,PCY*19+9)-(119,PCY*19+28),PSET,7,BF,%PCY:MOUSE 4,76,PCY*19+5,259,PCY*19+124
  337. 5970 WHILE MOUSE(2,0)=0:WEND:MMX=MOUSE(0):MMY=MOUSE(1):IF MMX>239 AND MMY>PCY*19+18 AND MMX<255 AND MMY<PCY*19+35 THEN WHILE MOUSE(6,0)=0:WEND:PUT@A (50,PCY*19+5)-(259,PCY*19+124),G%,PSET:GOSUB 6280:LOCATE 0,PCY:FOR A=0 TO 5:PRINT SPC(40):NEXT:GOTO 5850
  338. 5980 IF MMX<76 OR MMX>259 OR MMY<(PCY+3)*19-2 OR MMY>(PCY+5)*19+17 THEN 5970 ELSE A=(MMY-PCY*19+2)\19-3:IF MMX<111 OR MMX>239 THEN GOSUB 6000:GOTO 5970
  339. 5990 B=(MMX-111)\8:GOSUB 6010:GOTO 5970
  340. 6000 GOSUB 6050:WHILE MOUSE(6,0)=0:WEND:BB=B:B=B+SGN(MMX-150):IF B>15 OR B<0 THEN B=BB
  341. 6010 ON A GOTO 6020,6030:PAL&(PCY)=(PAL&(PCY) AND 65535)+B*1048576:GOTO 6040
  342. 6020 PAL&(PCY)=(PAL&(PCY) AND 16711935)+B*4096:GOTO 6040
  343. 6030 PAL&(PCY)=(PAL&(PCY) AND 16776960)+B*16
  344. 6040 PALETTE PCY,[(PAL&(PCY) AND 16711680)\65536,(PAL&(PCY) AND 65280)\256,PAL&(PCY) AND 255]
  345. 6050 ON A GOTO 6060,6070:B=(PAL&(PCY) AND 16711680)\1048576:A$=SPACE$(16):MID$(A$,B+1)="|":LOCATE 14,PCY+3:PRINT A$:RETURN
  346. 6060 B=(PAL&(PCY) AND 65280)\4096:A$=SPACE$(16):MID$(A$,B+1)="|":LOCATE 14,PCY+4:PRINT A$:RETURN
  347. 6070 B=(PAL&(PCY) AND 255)\16:A$=SPACE$(16):MID$(A$,B+1)="|":LOCATE 14,PCY+5:PRINT A$:RETURN
  348. 6080 LOCATE 15,24:IF (SCM=2 AND PAL1<0) OR (SCM=0 AND PALM=0) THEN PRINT "OFF"; ELSE PRINT "ON ";
  349. 6090 LINE (13,455)-(146,472),PSET,2,B:RETURN
  350. 6100 LOCATE 43,23:COLOR 4:GOSUB 6110:LINE (246,454)-(385,454),PSET,6:LOCATE 4,23:IF SCM=0 OR PAL1=-1 THEN PRINT SPC(22);:LINE (30,454)-(209,454),PSET,6,BF,%7:COLOR 6:RETURN ELSE PRINT PAL$(PAL1);:COLOR 6:LINE (30,454)-(209,454),PSET,6:RETURN
  351. 6110 IF PAL1=0 AND SCM=2 THEN IF (PAL2 MOD 3)=0 THEN PRINT " 無し":RETURN ELSE PRINT FNF$((PAL2 MOD 3)*8)+"色":RETURN
  352. 6120 IF PAL2=0 THEN PRINT " 無し":RETURN ELSE PRINT FNF$(PAL2)+"色":RETURN
  353. 6130 LINE (639-PALX,PALY)-(640-PALX-PALL,PALY+PALL-1),XOR,7,B:RETURN
  354. 6140 CMD=0:IF MMX>411 AND MMX<484 THEN CMD=1 ELSE IF MMX>491 AND MMX<564 THEN CMD=2 ELSE IF MMX>571 AND MMX<628 THEN CMD=3
  355. 6150 IF CMD=0 THEN 5850 ELSE PCX=CMD*80+280:IF CMD=3 THEN 6180 ELSE GET@A (PCX,416)-(PCX+109,436),G%:LINE (PCX,416)-(PCX+109,436),PSET,3,BF,4:SYMBOL (PCX+12,418),"取消   実行",1,1,2,,,5:LINE (PCX+56,416)-(PCX+56,436),PSET,3
  356. 6160 MOUSE 1,PCX+30,425,1:MOUSE 4,PCX,416,PCX+109,436:GOSUB *MOUSE_GET:MMX=MMX+MCX:IF A>0 THEN MMX=60*SGN(24-A)+PCX
  357. 6170 GOSUB 6280:PUT@A (PCX,416)-(PCX+109,436),G%,PSET:MMX=MMX-PCX:IF MMX<56 THEN 5850 ELSE RETURN
  358. 6180 GET@A (PCX,332)-(PCX+109,437),G%:LINE (PCX,332)-(PCX+109,437),PSET,3,BF,4:RESTORE 6260:FOR A=0 TO 5:READ M$:IF PSCM=0 AND A=4 THEN M$="――――――"
  359. 6190 SYMBOL (PCX+4,334+17*A),M$,1,1,2,,,5:NEXT:MOUSE 1,PCX+30,425,1:MOUSE 4,PCX,334,PCX+109,435:CMD=9
  360. 6200 MMY=MOUSE(1):IF INKEY$=CHR$(24) THEN 6250 ELSE OCMD=CMD:CMD=(MMY-334)\17
  361. 6210 IF CMD<>OCMD THEN LINE (PCX,334+17*OCMD)-(PCX+109,349+17*OCMD),XOR,4,BF:LINE (PCX,334+17*CMD)-(PCX+109,349+17*CMD),XOR,4,BF
  362. 6220 IF MOUSE(2,0)=0 THEN 6200 ELSE WHILE MOUSE(6,0)=0:WEND:IF CMD=5 THEN 6250 ELSE IF CMD=4 THEN IF PSCM=0 THEN 6250 ELSE PAL1=0
  363. 6230 GOSUB *PALETTE_FIX:IF CMD=0 THEN IF PSCM=0 THEN PALM=0 ELSE PAL1=-1
  364. 6240 IF CMD>1 AND CMD<4 THEN IF PSCM=0 THEN PALM=1 ELSE IF PAL1<2 THEN PAL1=2
  365. 6250 PUT@A (PCX,332)-(PCX+109,437),G%,PSET:GOSUB 6280:CMD=3:RETURN
  366. 6260 DATA "Towns System","MaskT_Paint","Rainbow","ColofulStick","GrayScale"," 取 消 "
  367. 6270 GOSUB 6130:MMX=639-PALX:MMY=PALY+PALL-1:MOUSE 1,MMX,MMY,1:MOUSE 4,59+PALL,PALL-1,639,423:WHILE MOUSE(6,0)=0:PALX=639-MOUSE(0):PALY=MOUSE(1)-PALL+1:GOSUB 6130:GOSUB 6130:WEND:GOSUB 6130
  368. 6280 MOUSE 4,0,0,639,454:RETURN
  369. 6290 *ZOOM:SYMBOL (MCX+3,MCY+4),"解像度",1,1,4:SYMBOL (MCX+3,MCY+38),"倍率",1,1,4:SYMBOL (MCX+52,MCY+4),"主",1,1,3:SYMBOL (MCX+52,MCY+21),"副",1,1,3:SYMBOL (MCX+52,MCY+38),"主",1,1,3:SYMBOL (MCX+52,MCY+55),"副",1,1,3
  370. 6300 LINE (MCX+74,MCY+2)-(MCX+189,MCY+71),PSET,3,BF,4:LINE (MCX+90,MCY+2)-(MCX+173,MCY+71),PSET,3,BF,6:LINE (MCX+106,MCY+2)-(MCX+157,MCY+71),PSET,3,BF,0:LINE (MCX+90,MCY+20)-(MCX+173,MCY+54),PSET,3,B:LINE (MCX+74,MCY+37)-(MCX+189,MCY+37),PSET,3:GOSUB 6580
  371. 6310 SYMBOL (MCX+77,MCY+68),"▲▲",2,.7!,2,1,,,2:SYMBOL (MCX+186,MCY+5),"▲▲",2,.7!,2,3,,,2:SYMBOL (MCX+93,MCY+69),"▲▲▲▲",1,.7!,2,1,,,1:SYMBOL (MCX+170,MCY+4),"▲▲▲▲",1,.7!,2,3,,,1:SYMBOL (MCX+3,MCY+76),"↑主        ％",1,1,4,,,8
  372. 6320 SYMBOL (MCX+3,MCY+94),"←副",1,1,4,,,8:LINE (MCX,MCY+73)-(MCX+199,MCY+73),PSET,7:LINE (MCX+90,MCY+73)-(MCX+90,MCY+119),PSET,7:SYMBOL (MCX+92,MCY+91),"Zoom",.75!,.5!,5,,,8:SYMBOL (MCX+4,MCY+110),"Screen",.75!,.5!,5,,,8
  373. 6330 OZMX=SZOMX:OZMY=SZOMY:SYMBOL (MCX+102,MCY+101),"取消   実行",1,1,4:LINE (MCX+90,MCY+99)-(MCX+199,MCY+99),PSET,7:LINE (MCX+145,MCY+99)-(MCX+145,MCY+119),PSET,7:SYMBOL (MCX+124,MCY+75),"M     S",.8!,.5!,5:MOUSE 1,MCX+100,MCY+60,1
  374. 6340 GOSUB 6520:GOSUB 6530:GOSUB 6540:GOSUB 6550:GOSUB 6560:A=0:I=0
  375. 6350 IF MOUSE(2,0)=0 THEN I$=INKEY$:IF MOUSE(2,1) THEN SZOMX=OZMX:SZOMY=OZMY:GOTO 6340 ELSE IF I$=CHR$(13) OR I$=CHR$(24) THEN I=ASC(I$):MMX=100+50*SGN(24-I):GOTO 6510 ELSE 6350
  376. 6360 IF MOUSE(6,0)=0 THEN A=A+1 ELSE A=0
  377. 6370 MMX=MOUSE(0)-MCX:MMY=MOUSE(1)-MCY:IF MMY>72 THEN IF MMY<99 OR MMX<90 THEN A=0:GOTO 6350 ELSE 6510
  378. 6380 IF MMX<74 OR MMX>189 OR (MMX>106 AND MMX<157) THEN A=0:GOTO 6350
  379. 6390 ADP=SGN(MMX-120):IF A>10 THEN ADP=ADP*10
  380. 6400 IF MMY<37 THEN 6410 ELSE 6460
  381. 6410 IF MMX>90 AND MMX<173 THEN IF MMY>20 THEN GOSUB 6440:FOR W=0 TO 1000:NEXT:GOTO 6350 ELSE 6420 ELSE GOSUB 6440
  382. 6420 SR1P=R1P:R1P=R1P+SGN(ADP):IF R1P<0 OR R1P>MNDP THEN R1P=SR1P
  383. 6430 GOSUB 6520:FOR W=0 TO 1000:NEXT:GOTO 6350
  384. 6440 SR2P=R2P:R2P=R2P+SGN(ADP):IF R2P<0 OR R2P>MNDP THEN R2P=SR2P
  385. 6450 GOSUB 6530:RETURN
  386. 6460 IF MMX>90 AND MMX<173 THEN IF MMY>54 THEN GOSUB 6490:GOSUB 6560:GOTO 6350 ELSE 6470 ELSE GOSUB 6490
  387. 6470 SZOMX=SZOMX+ADP:IF SZOMX<50 THEN SZOMX=50 ELSE IF SZOMX>200 THEN SZOMX=200
  388. 6480 GOSUB 6540:GOSUB 6560:GOTO 6350
  389. 6490 SZOMY=SZOMY+ADP:IF SZOMY<50 THEN SZOMY=50 ELSE IF SZOMY>200 THEN SZOMY=200
  390. 6500 GOSUB 6550:RETURN
  391. 6510 IF MMX<145 THEN SZOMX=OZMX:SZOMY=OZMY:GOTO *MENU_IN ELSE R1=DPI%(R1P):R2=DPI%(R2P):GOTO *MENU_IN
  392. 6520 LINE (MCX+120,MCY+3)-(MCX+143,MCY+18),PSET,0,BF:SYMBOL (MCX+120,MCY+3),FNF$(DPI%(R1P)),1,1,4:GOSUB 6560:RETURN
  393. 6530 LINE (MCX+120,MCY+21)-(MCX+143,MCY+35),PSET,0,BF:SYMBOL (MCX+120,MCY+21),FNF$(DPI%(R2P)),1,1,4:GOSUB 6560:RETURN
  394. 6540 LINE (MCX+120,MCY+38)-(MCX+143,MCY+53),PSET,0,BF:SYMBOL (MCX+120,MCY+38),FNF$(SZOMX),1,1,4:RETURN
  395. 6550 LINE (MCX+120,MCY+55)-(MCX+143,MCY+70),PSET,0,BF:SYMBOL (MCX+120,MCY+55),FNF$(SZOMY),1,1,4:RETURN
  396. 6560 LINE (MCX+46,MCY+76)-(MCX+86,MCY+116),PSET,1,BF:RHI!=(SZOMY/SZOMX)*(DPI%(R2P)/DPI%(R1P)):IF RHI!>1 THEN RLN!=20/RHI! ELSE RLN!=20
  397. 6570 CIRCLE (MCX+66,MCY+96),RLN!,4,RHI!:LINE (MCX+128,MCY+83)-(MCX+197,MCY+98),PSET,1,BF:SYMBOL (MCX+130,MCY+83),FNF$(INT(SZOMX/OZMX*100))+"  "+FNF$(INT(SZOMY/OZMY*100)),1,1,4:RETURN
  398. 6580 R1P=0:FOR A=0 TO MNDP:IF DPI%(A)=R1 THEN R1P=A:NEXT ELSE NEXT
  399. 6590 R2P=0:FOR A=0 TO MNDP:IF DPI%(A)=R2 THEN R2P=A:NEXT ELSE NEXT
  400. 6600 RETURN
  401. 6610 *AREA:GOSUB *PREV_PUT:LINE (60,0)-(639,423),PSET,7,B:LINE (504,428)-(599,449),PSET,%8,BF,%7:SYMBOL (504,430)," 取消  実行 ",1,1,4:LINE (551,428)-(551,449),PSET,%8
  402. 6620 LINE (0,0)-(58,423),PSET,%7,BF,%1:LINE (6,10)-(52,18),PSET,7,B:SYMBOL (4,30),"ｽｷｬﾅ読取",.75!,1,5:SYMBOL (4,46),"可能領域",.75!,1,5:LINE (6,70)-(52,78),PSET,7,B,&H3333:SYMBOL (4,90),"読取",.75!,1,5:SYMBOL (4,106),"指定領域",.75!,1,5:COLOR 6
  403. 6630 RSM!=(100/SZOMX)*(50/R1):RSS!=(100/SZOMY)*(50/R2):LINE (6,435)-(482,454),PSET,3,BF,%1:SYMBOL (36,76),"xor",.75!,1,4,,,,1:OXST=XST:OYST=YST:OXEN=XEN:OYEN=YEN:IF TY THEN DI$="  ↑":BDM=BDY+1:BDS=BDX+1 ELSE DI$="  →":BDM=BDX+1:BDS=BDY+1
  404. 6640 LINE (6,457)-(625,476),PSET,2,BF,%1:SYMBOL (16,459),"解像度(dpi)  主: "+FNF$(R1)+" 副: "+FNF$(R2)+"   倍率(%)  主: "+FNF$(SZOMX)+" 副: "+FNF$(SZOMY)+"   映像上方:"+DI$,1,1,5:MAX=8*(INT((8.56!*R1*SZOMX/100)/8))-1:MAY=INT(11.6!*R2*SZOMY/100)-1
  405. 6650 A!=FRE(4):IF XST+XEN>MAX THEN IF XST>0 THEN XST=XST-1:GOTO 6650 ELSE XEN=(((XEN+1)-8)\8)*8-1:GOTO 6650
  406. 6660 IF YST+YEN>MAY THEN IF YST>0 THEN YST=YST-1:GOTO 6660 ELSE YEN=YEN-1:GOTO 6660
  407. 6670 ASM=XST*RSM!:ARM=(XEN+1)*RSM!+ASM-1:ASS=YST*RSS!:ARS=639-((YEN+1)*RSS!+ASS-1):ASS=639-ASS
  408. 6680 IF ARM>423 THEN IF XST>0 THEN XST=XST-1:GOTO 6670 ELSE XEN=(((XEN+1)-8)\8)*8-1:GOTO 6670
  409. 6690 IF ASS<60 THEN IF YST>0 THEN YST=YST-1:GOTO 6670 ELSE YEN=YEN-1:GOTO 6670
  410. 6700 GOSUB 7010
  411. 6710 GOSUB 7250:MOUSE 4,60,0,639,449:MOUSE 1,FNM(ARS,ASS),FNM(ASM,ARM),1:GOTO 6730
  412. 6720 IF MOUSE(2,1) THEN GOSUB 7240:WHILE MOUSE(6,1)=0:WEND:XST=OOXST:YST=OOYST:XEN=OOXEN:YEN=OOYEN:ASS=OASS:ASM=OASM:ARS=OARS:ARM=OARM:GOSUB 7250
  413. 6730 I=0:LINE (ASS,ASM)-(ARS,ARM),XOR,7,B,&H0F0F:LINE (ASS,ASM)-(ARS,ARM),XOR,7,B:IF MOUSE(2,0) THEN A=MOUSE(6,0):OOXST=XST:OOYST=YST:OOXEN=XEN:OOYEN=YEN:OASS=ASS:OASM=ASM:OARS=ARS:OARM=ARM ELSE I$=INKEY$:IF I$="" THEN 6720 ELSE I=ASC(I$)
  414. 6740 GOSUB 7240:IF I>0 THEN MMX=510+50*SGN(24-I):GOTO 7220
  415. 6750 MMX=MOUSE(0):MMY=MOUSE(1):IF MMX>504 AND MMY>428 AND MMX<599 AND MMY<449 THEN 7220 ELSE IF MMX>ASS+DI OR MMX<ARS-DI OR MMY<ASM-DI OR MMY>ARM+DI THEN 6720 ELSE CMD=0
  416. 6760 IF MMX>ASS-DI THEN CMD=1:GOTO 6780
  417. 6770 IF MMX<ARS+DI THEN CMD=4
  418. 6780 IF MMY<ASM+DI THEN CMD=CMD+8:GOTO 6800
  419. 6790 IF MMY>ARM-DI THEN CMD=CMD+2
  420. 6800 IF CMD=0 THEN 7160 ELSE LNX=60:LNY=0:CPX=639:CPY=423
  421. 6810 IF CMD AND 1 THEN MMX=ASS:LNX=ARS:CPX=639:IF BDS*RSS!<CPX-LNX THEN CPX=BDS*RSS!+LNX
  422. 6820 IF CMD AND 2 THEN MMY=ARM:LNY=ASM:CPY=423:IF BDM*RSM!<CPY-LNY THEN CPY=BDM*RSM!+LNY
  423. 6830 IF CMD AND 4 THEN MMX=ARS:LNX=60:CPX=ASS:IF BDS*RSS!<CPX-LNX THEN LNX=CPX-BDS*RSS!
  424. 6840 IF CMD AND 8 THEN MMY=ASM:LNY=0:CPY=ARM:IF BDM*RSM!<CPY-LNY THEN LNY=CPY-BDM*RSM!
  425. 6850 MOUSE 4,LNX,LNY,CPX,CPY:MOUSE 1,MMX,MMY,0
  426. 6860 MMX=MOUSE(0):MMY=MOUSE(1):ON CMD GOSUB 6880,6900,6890,6920,20,6910,20,6940,6930,20,20,6950:LINE (ASS,ASM)-(ARS,ARM),XOR,7,B:LINE (ASS,ASM)-(ARS,ARM),XOR,7,B:GOSUB 6960:GOSUB 7010
  427. 6870 IF MOUSE(6,0)<>0 THEN GOSUB 6960:GOTO 6650 ELSE IF MOUSE(2,1) THEN 7020 ELSE 6860
  428. 6880 ASS=MMX:RETURN
  429. 6890 GOSUB 6880
  430. 6900 ARM=MMY:RETURN
  431. 6910 GOSUB 6900
  432. 6920 ARS=MMX:RETURN
  433. 6930 GOSUB 6880
  434. 6940 ASM=MMY:RETURN
  435. 6950 GOSUB 6920:GOTO 6940
  436. 6960 LNX=639-ASS:LNY=ASM:XST=LNY/RSM!:YST=LNX/RSS!:LNX=ASS-ARS:LNY=ARM-ASM+1:XEN=((LNY/RSM!)\8)*8-1:YEN=LNX/RSS!
  437. 6970 IF CMD MOD 3 THEN IF CMD=1 OR CMD=4 THEN XST=OOXST:XEN=OOXEN ELSE YST=OOYST:YEN=OOYEN
  438. 6980 IF XEN<7 THEN XEN=7 ELSE IF XEN>=BDM THEN XEN=BDM-1
  439. 6990 IF XEN<7 THEN XEN=7 ELSE IF YEN>=BDS THEN YEN=BDS-1
  440. 7000 RETURN
  441. 7010 LOCATE 0,23:PRINT USING " スキップ長  主:#### 副:####    読み取り長  主:#### 副:####";XST;YST;XEN+1;YEN+1;:RETURN
  442. 7020 IF CMD MOD 3=0 THEN RETURN ELSE MOUSE 4,0,0,639,479:GOSUB 6960:CPX=MOUSE(9):CPY=MOUSE(10):WHILE MOUSE(6,1)=0 AND MOUSE(6,0)=0:IF CMD=2 OR CMD=8 THEN 7080
  443. 7030 CPY=MOUSE(9):IF CPY=0 THEN 7130 ELSE IF CMD=4 THEN YEN=YEN-CPY ELSE YST=YST-CPY:YEN=YEN+CPY
  444. 7040 IF YST<0 THEN YST=0
  445. 7050 IF YEN>=BDS THEN YEN=BDS-1
  446. 7060 IF YST+YEN>MAY THEN IF YST>0 THEN YST=YST-1:GOTO 7060 ELSE YEN=YEN-1:GOTO 7060
  447. 7070 ASS=YST*RSS!:ARS=639-((YEN+1)*RSS!+ASS-1):ASS=639-ASS:GOTO 7130
  448. 7080 CPX=MOUSE(10):IF CPX=0 THEN 7130 ELSE IF CMD=2 THEN XEN=XEN+CPX ELSE XST=XST+CPX:XEN=XEN-CPX
  449. 7090 IF XST<0 THEN XST=0
  450. 7100 IF XEN>=BDM THEN XEN=BDM-1
  451. 7110 IF XST+XEN>MAX THEN IF XST>0 THEN XST=XST-1:GOTO 7110 ELSE XEN=(((XEN+1)-8)\8)*8-1:GOTO 7110
  452. 7120 ASM=XST*RSM!:ARM=(XEN+1)*RSM!+ASM-1
  453. 7130 GOSUB 7010:LINE (ASS,ASM)-(ARS,ARM),XOR,7,B:LINE (ASS,ASM)-(ARS,ARM),XOR,7,B:WEND
  454. 7140 IF CMD=1 THEN MMX=ASS ELSE IF CMD=2 THEN MMY=ARM ELSE IF CMD=4 THEN MMX=ARS ELSE MMY=ASM
  455. 7150 GOTO 6800
  456. 7160 LNX=ASS-ARS:LNY=ARM-ASM:MOUSE 1,ARS,ASM,0:MOUSE 4,60,0,639-LNX,423-LNY
  457. 7170 MMX=MOUSE(0):MMY=MOUSE(1):LINE (MMX,MMY)-(MMX+LNX,MMY+LNY),XOR,7,B:LINE (MMX,MMY)-(MMX+LNX,MMY+LNY),XOR,7,B:GOSUB 7210:GOSUB 7010
  458. 7180 IF MOUSE(6,0)<>0 THEN 7190 ELSE IF MOUSE(2,1) THEN A=MOUSE(6,1):GOTO 7200 ELSE 7170
  459. 7190 GOSUB 7210:GOTO 6650
  460. 7200 GOTO 7170
  461. 7210 ARS=MMX:ASM=MMY:ASS=ARS+LNX:ARM=ASM+LNY:PCX=639-ASS:PCY=ASM:XST=PCY/RSM!:YST=PCX/RSS!:RETURN
  462. 7220 IF MMX<551 THEN XST=OXST:YST=OYST:XEN=OXEN:YEN=OYEN
  463. 7230 CLS 4:LINE (0,0)-(58,423),PSET,0,BF:LINE (0,424)-(639,479),PSET,0,BF:GOTO *MENU
  464. 7240 LINE (ASS,ASM)-(ARS,ARM),PSET,0,B:PUT@ (ASS,ASM)-(ARS,ASM),G%,PSET,4:PUT@ (ASS,ARM)-(ARS,ARM),CH%,PSET,4:PUT@ (ASS,ASM)-(ASS,ARM),G2%,PSET,4:PUT@ (ARS,ASM)-(ARS,ARM),G3%,PSET,4:LINE (60,0)-(639,423),PSET,7,B:RETURN
  465. 7250 GET@ (ASS,ASM)-(ARS,ASM),G%,4,5,6,7:GET@ (ASS,ARM)-(ARS,ARM),CH%,4,5,6,7:GET@ (ASS,ASM)-(ASS,ARM),G2%,4,5,6,7:GET@ (ARS,ASM)-(ARS,ARM),G3%,4,5,6,7:RETURN
  466. 7260 GOTO *MENU
  467. 7270 COLOR 7:CALLM RCLOSE&,PIT&:END
  468. 7280 *FILE:GOSUB *SCAN_PUT:GOSUB *FBOX_CHK:GOSUB 7660:OSCM=SCM:DFD=ASC(DFD$)-65:GOSUB 7720:MOUSE 4,0,0,BSX,BSY:IF SAF=1 THEN GOSUB 7510
  469. 7290 IF MOUSE(2,1) THEN WHILE MOUSE(6,1)=0:WEND:GOTO 7440
  470. 7300 IF MOUSE(2,0) THEN A=MOUSE(6,0) ELSE 7290
  471. 7310 MMX=MOUSE(0):MMY=MOUSE(1):IF MMX>9 AND MMX<311 AND MMY>=MCY AND MMY<=MCY+36 THEN 7520
  472. 7320 IF SAF=0 THEN 7460 ELSE GOSUB 7510:CMD=0:IF NOT(MMX>FCX-DI AND MMX<FCX+XLEN+DI AND MMY<FCY+YLEN+DI AND MMY>FCY-DI) THEN 7460
  473. 7330 IF ABS(MMX-FCX)<DI THEN CMD=1 ELSE IF ABS(MMX-(FCX+XLEN-1))<DI THEN CMD=2
  474. 7340 IF ABS(MMY-FCY)<DI THEN CMD=CMD+4 ELSE IF ABS(MMY-(FCY+YLEN-1))<DI THEN CMD=CMD+8
  475. 7350 IF CMD=0 THEN GOSUB 7630:WHILE MOUSE(6,0)=0:FCX=MOUSE(0)-LNX:FCY=MOUSE(1)-LNY:GOSUB 7510:GOSUB 7710:GOSUB 7510:WEND:GOSUB 7510:SAF=1:MOUSE 4,0,0,BSX,BSY:GOTO 7290
  476. 7360 LNX=MMX:LNY=MMY:CPX=MMX:CPY=MMY:MMX=FCX+XLEN-1:MMY=FCY+YLEN-1:IF CMD AND 1 THEN LNX=0:CPX=MMX:MMX=FCX:FCX=CPX ELSE IF CMD AND 2 THEN LNX=FCX:CPX=BSX
  477. 7370 IF CMD AND 4 THEN LNY=0:CPY=MMY:MMY=FCY:FCY=CPY ELSE IF CMD AND 8 THEN LNY=FCY:CPY=BSY
  478. 7380 IF CPX>BSX THEN CPX=BSX
  479. 7390 IF CPY>BSY THEN CPY=BSY
  480. 7400 MOUSE 4,LNX,LNY,CPX,CPY:MOUSE 1,MMX,MMY,1:WHILE MOUSE(6,0)=0:ON CMD GOSUB 7410,7410,20,7430,7420,7420,20,7430,7420,7420:GOSUB 7500:GOSUB 7700:GOSUB 7500:WEND:GOSUB 7500:MOUSE 4,0,0,BSX,BSY:GOTO 7470
  481. 7410 MMX=MOUSE(0):XLEN=ABS(MMX-FCX)+1:RETURN
  482. 7420 GOSUB 7410
  483. 7430 MMY=MOUSE(1):YLEN=ABS(MMY-FCY)+1:RETURN
  484. 7440 IF SAF=1 THEN GOSUB 7510
  485. 7450 GOSUB 7690:MMM=1-MMM:GOSUB 7660:GOSUB 7720:IF SAF=1 THEN GOSUB 7510:GOTO 7290 ELSE 7290
  486. 7460 FCX=MMX:FCY=MMY:GOSUB 7620:GOSUB 7500
  487. 7470 SAF=1:IF MMX<FCX THEN SWAP MMX,FCX
  488. 7480 IF MMY<FCY THEN SWAP MMY,FCY
  489. 7490 GOSUB 7710:GOTO 7290
  490. 7500 LINE (FCX,FCY)-(MMX,MMY),XOR,7,B:RETURN
  491. 7510 LINE (FCX,FCY)-(FCX+XLEN-1,FCY+YLEN-1),XOR,7,B:RETURN
  492. 7520 MMY=MMY-MCY:IF MMY>18 THEN 7580 ELSE GOSUB 7730:IF SAF=1 THEN GOSUB 7510
  493. 7530 IF MMX>226 THEN SCM=OSCM:GOSUB 7690:GOTO *MENU
  494. 7540 IF MMX>122 THEN M$="全領域セーブ":GOSUB 7740:GOSUB 7690:IF YN=0 THEN 7570 ELSE SAVE@ DFD$+DFF$,(0,0)-(BDX,BDY):GOSUB *PALETTE_SAVE:GOTO 7570
  495. 7550 IF MMX>68 THEN M$="セーブ":GOSUB 7740:GOSUB 7690:IF YN=0 THEN 7570 ELSE SAVE@ DFD$+DFF$,(FCX,FCY)-(FCX+XLEN-1,FCY+YLEN-1):GOSUB *PALETTE_SAVE:GOTO 7570
  496. 7560 M$="ロード":GOSUB 7740:GOSUB 7690:IF YN=0 THEN 7570 ELSE LOAD@ DFD$+DFF$:GOSUB *PALETTE_LOAD:GOSUB *PALETTE_CHANGE:GOSUB *PALETTE_INI
  497. 7570 GOSUB 7660:GOSUB 7720:ON ERROR GOTO 0:MOUSE 4,0,0,BSX,BSY:IF SAF=1 THEN GOSUB 7510:GOTO 7290 ELSE 7290
  498. 7580 IF MMX>288 THEN GOSUB 7730:GOTO 7440
  499. 7590 IF MMX>114 THEN GOSUB 7700:GOSUB 7730:GOSUB 7710:GOTO 7290
  500. 7600 GOSUB 7730:SCM=SCM+1:IF SCM>2 THEN SCM=0
  501. 7610 CLS:GOSUB *SCREEN_MODE:GOSUB 7660:GOSUB 7720:MOUSE 4,0,0,BSX,BSY:MOUSE 1,MMX,MMY+MCY,1:SAF=0:GOTO 7290
  502. 7620 WHILE MOUSE(6,0)=0:MMX=MOUSE(0):MMY=MOUSE(1):XLEN=ABS(MMX-FCX)+1:YLEN=ABS(MMY-FCY)+1:GOSUB 7500:GOSUB 7700:GOSUB 7500:WEND:RETURN
  503. 7630 LNX=BDX-(FCX+XLEN-1)+MMX:IF LNX>BSX THEN LNX=BSX
  504. 7640 LNY=BDY-(FCY+YLEN-1)+MMY:IF LNY>BSY THEN LNY=BSY
  505. 7650 MOUSE 4,MMX-FCX,MMY-FCY,LNX,LNY:LNX=MMX-FCX:LNY=MMY-FCY:RETURN
  506. 7660 IF MMM=0 THEN MCY=10 ELSE MCY=160
  507. 7670 GET@A (10,MCY)-(310,MCY+36),G%:LINE (10,MCY)-(310,MCY+36),PSET,4,BF,1:SYMBOL (16,MCY+2),"ロード セーブ 全領域セーブ メニュー",1,1,4:SYMBOL (12,MCY+20),"ScreenMode"+STR$(SCM)+" (    ,   )-(    ,   ) ◆",1,1,4:LINE (10,MCY+18)-(310,MCY+18),PSET,4
  508. 7680 LINE (68,MCY)-(122,MCY+18),PSET,4,B:LINE (226,MCY)-(226,MCY+18),PSET,4:LINE (114,MCY+18)-(288,MCY+36),PSET,4,B:RETURN
  509. 7690 PUT@A (10,MCY)-(310,MCY+36),G%,PSET:RETURN
  510. 7700 LINE (116,MCY+20)-(283,MCY+35),PSET,1,BF:SYMBOL (116,MCY+20),"セーブ領域 ("+FNG$(XLEN)+","+FNF$(YLEN)+")",1,1,4:RETURN
  511. 7710 LINE (116,MCY+20)-(283,MCY+35),PSET,1,BF
  512. 7720 SYMBOL (116,MCY+20),"("+FNG$(FCX)+","+FNF$(FCY)+")-("+FNG$(FCX+XLEN-1)+","+FNF$(FCY+YLEN-1)+")",1,1,4:RETURN
  513. 7730 WHILE MOUSE(6,0)=0:WEND:RETURN
  514. 7740 ON ERROR GOTO 7990:IF MMM=0 THEN MCY=10 ELSE MCY=160
  515. 7750 LINE (10,MCY)-(310,MCY+36),PSET,4,BF,1:SYMBOL (16,MCY+2),M$,1,1,4,,,1,1:GOSUB 8180:SYMBOL (126,MCY+2),"ドライブを選んで下さい",1,1,6:LINE (10,MCY+18)-(310,MCY+18),PSET,4
  516. 7760 SYMBOL (12,MCY+20),"A B C D E F G H I J K L M N O P Q ",1,1,4:SYMBOL (286,MCY+19),"実行",.75!,1,6:LINE (284,MCY+18)-(284,MCY+36),PSET,4:MOUSE 1,296,MCY+28,1:MOUSE 4,12,MCY+20,309,MCY+35
  517. 7770 LINE (12+16*DFD,MCY+20)-(27+16*DFD,MCY+34),XOR,7,BF:A$=""
  518. 7780 WHILE MOUSE(2,0)=0 AND A$<>CHR$(13):A$=INKEY$:WEND:IF A$=CHR$(13) THEN 7800 ELSE WHILE MOUSE(6,0)=0:WEND:MMX=MOUSE(0):IF MMX>283 THEN 7800
  519. 7790 LINE (12+16*DFD,MCY+20)-(27+16*DFD,MCY+34),XOR,7,BF:DFD=(MMX-12)\16:GOTO 7770
  520. 7800 GOSUB 8180:DFD$=CHR$(DFD+65)+":":SYMBOL (124,MCY+2),"パス､ファイル名を入力して下さい",.75!,1,6:LINE (10,MCY+18)-(310,MCY+36),PSET,4,BF,1:SYMBOL (12,MCY+20),DFD$,1,1,6:IMX=28:IMY=MCY+20:C=4:BC=1:I$=DFF$:IS$=I$:ILEN=LEN(DFF$):MLEN=28
  521. 7810 MOUSE 1,286,MCY+28,1:MOUSE 4,260,MCY+20,309,MCY+35:LINE (260,IMY-2)-(286,IMY+16),PSET,4,B:SYMBOL (263,IMY),"取消実行",.75!,1,4:RE=0:GOSUB 7850:IF RIGHT$(I$,4)<>".TIF" THEN DFF$=I$+".TIF" ELSE DFF$=I$
  522. 7820 IF RE=0 THEN IF A$=CHR$(24) THEN YN=0:RETURN ELSE A$="":WHILE MOUSE(2,0)=0 AND A$<>CHR$(13) AND A$<>CHR$(24):A$=INKEY$:WEND:IF A$<>"" THEN YN=SGN(24-YN):RETURN
  523. 7830 MMX=MOUSE(0):WHILE MOUSE(6,0):WEND:IF MMX>286 THEN YN=1:RETURN ELSE YN=0:RETURN
  524. 7840 *INPUT:I$="":ILEN=0:RE=0
  525. 7850 LINE (IMX,IMY)-(IMX+8*MLEN-1,IMY+15),PSET,BC,BF:IS$=I$:IF ILEN<MLEN THEN SYMBOL (IMX,IMY),IS$,1,1,C ELSE GOSUB 7960
  526. 7860 A!=FRE(4):LINE (IMX+LEN(IS$)*8,IMY)-(IMX+LEN(IS$)*8,IMY+15),XOR,3
  527. 7870 A$=INKEY$:IF A$="" THEN IF MOUSE(2,0) THEN WHILE MOUSE(6,0)=0:WEND:RE=1:RETURN ELSE 7870 ELSE LINE (IMX+LEN(IS$)*8,IMY)-(IMX+LEN(IS$)*8,IMY+15),XOR,3:K=KTYPE(A$,1)
  528. 7880 IF A$=CHR$(13) THEN RETURN
  529. 7890 IF A$=CHR$(24) THEN RETURN
  530. 7900 IF A$=CHR$(29) OR A$=CHR$(8) THEN 7940
  531. 7910 IF K=0 THEN IF A$=<" " OR A$>=CHR$(127) THEN 7850
  532. 7920 IF K=0 THEN IF A$>="a" AND A$<="z" THEN A$=CHR$(ASC(A$)-32)
  533. 7930 I$=I$+A$:ILEN=LEN(I$):GOTO 7850
  534. 7940 IF ILEN=0 THEN 7850 ELSE ILEN=ILEN-1-KTYPE(I$,KLEN(I$)):IF ILEN<0 THEN ILEN=0:BEEP:GOTO 7850
  535. 7950 I$=LEFT$(I$,ILEN):GOTO 7850
  536. 7960 IS$=RIGHT$(I$,MLEN-1):IF ILEN>MLEN AND KTYPE(RIGHT$(I$,MLEN),1)=1 THEN IS$=RIGHT$(I$,MLEN-2)
  537. 7970 IF LEN(IS$)<MLEN THEN IS$=CHR$(29)+IS$
  538. 7980 SYMBOL (IMX,IMY),IS$,1,1,C:RETURN
  539. 7990 GET@A (10,MCY)-(310,MCY+36),G%:LINE (10,MCY)-(310,MCY+36),PSET,2,BF,1:IF ERR=112 THEN M$="画面モードを正しく合わせてください":GOSUB 8170:RESUME NEXT
  540. 8000 IF ERR=64 THEN M$="指定のファイルは既に存在しています":GOSUB 8120:IF YN=0 THEN RESUME NEXT ELSE KILL DFD$+DFF$:RESUME
  541. 8010 IF ERR=53 THEN M$="入出力装置に異常が発生しました":GOSUB 8170:RESUME NEXT
  542. 8020 IF ERR=55 THEN M$="ファイルの記述に誤りがあります":GOSUB 8170:RESUME NEXT
  543. 8030 IF ERR=60 THEN M$="指定の入出力装置は使用できません":GOSUB 8170:RESUME NEXT
  544. 8040 IF ERR=63 THEN M$="指定のファイルが見つかりません":GOSUB 8170:RESUME NEXT
  545. 8050 IF ERR=65 THEN M$="ディスクのディレクトリ領域がいっぱいです":GOSUB 8170:RESUME NEXT
  546. 8060 IF ERR=67 THEN M$="ディスクに空き領域がありません":GOSUB 8170:RESUME NEXT
  547. 8070 IF ERR=71 THEN M$="ディスクのファイルの構成が正しくありません":GOSUB 8170:RESUME NEXT
  548. 8080 IF ERR=72 THEN M$="ディスク装置が使用可能な状態になっていません":GOSUB 8170:RESUME NEXT
  549. 8090 IF ERR=73 THEN M$="指定されたディスクは書込が禁止されています":GOSUB 8120:IF YN=0 THEN RESUME NEXT ELSE RESUME
  550. 8100 IF ERR=75 THEN M$="アクセスが拒否されました":GOSUB 8170:RESUME NEXT
  551. 8110 PRINT "エラーが発生しました。 ID =";ERR;" Line =";ERL:CALLM RCLOSE&,PIT&:END
  552. 8120 GOSUB 8150:SYMBOL (180,MCY+20),"中断   続行",1,1,4:SYMBOL (212,MCY+28),"[取消]        [実行]",.5!,.5!,5:LINE (180,MCY+18)-(235,MCY+36),PSET,2,B:LINE (291,MCY+18)-(291,MCY+36),PSET,2:MOUSE 1,212,MCY+24,1:MOUSE 4,180,MCY+18,291,MCY+36
  553. 8130 A$="":WHILE MOUSE(2,0)=0 AND A$<>CHR$(13) AND A$<>CHR$(24):A$=INKEY$:WEND:IF A$="" THEN WHILE MOUSE(6,0)=0:WEND:YN=MOUSE(0)\231:GOSUB 7690:RETURN
  554. 8140 YN=SGN(24-ASC(A$)):GOSUB 7690:RETURN
  555. 8150 ML=KLEN(M$):IF ML<19 THEN SYMBOL (16,MCY+2),M$,1,1,4 ELSE IF ML<25 THEN SYMBOL (16,MCY+2),M$,.75!,1,4 ELSE SYMBOL (16,MCY+2),M$,.5!,1,4
  556. 8160 SYMBOL (12,MCY+20),"Error ID ="+FNF$(10),1,1,4:LINE (10,MCY+18)-(310,MCY+18),PSET,2:RETURN
  557. 8170 GOSUB 8150:SYMBOL (240,MCY+20),"確認",1,1,4:LINE (238,MCY+18)-(273,MCY+36),PSET,2,B:MOUSE 1,256,MCY+24,1:MOUSE 4,238,MCY+18,273,MCY+36:WHILE MOUSE(6,0)=0:WEND:GOSUB 7690:RETURN
  558. 8180 LINE (124,MCY+1)-(307,MCY+17),PSET,0,BF:RETURN
  559. 8190 *FBOX_CHK:IF FCX+XLEN-1>BSX THEN FCX=0:XLEN=8
  560. 8200 IF FCY+YLEN-1>BSY THEN FCY=0:YLEN=8
  561. 8210 RETURN
  562. 8220 *END:LINE (MCX,MCY)-(MCX+199,MCY+119),PSET,0,BF,7:SYMBOL (MCX+4,MCY+22),"プログラムを終了します",1,1,0:SYMBOL (MCX+3,MCY+101),"  取消            実行",1,1,0:LINE (MCX+1,MCY+99)-(MCX+198,MCY+99),PSET,0:LINE (MCX+66,MCY+99)-(MCX+132,MCY+119),PSET,0,B
  563. 8230 GOSUB *MOUSE_GET:IF A=0 AND MMY<100 THEN 8230 ELSE IF A<>0 THEN IF A=24 THEN *MENU_IN ELSE 8260
  564. 8240 CMD=MMX \ 66:ON CMD+1 GOTO *MENU_IN,8250,8260
  565. 8250 GOSUB *PALETTE_UNDO:MOUSE 1,,,0:PUT@A (MCX,MCY)-(MCX+199,MCY+119),G%,PSET:GOSUB *MOUSE_GET:GOTO *MENU
  566. 8260 PUT@A (MCX,MCY)-(MCX+199,MCY+119),G%,PSET:IF INKEY$=CHR$(27) THEN END ELSE SYSTEM
  567. 8270 *SCREEN_MODE:IF PSCM=SCM THEN RETURN ELSE ON SCM+1 GOTO 8280,8290,8300
  568. 8280 SCREEN@ 0:WINDOW (0,0)-(1023,511):VIEW (0,0)-(1023,511):BDX=639:BDY=511:BSX=639:BSY=479:PSCM=0:RETURN
  569. 8290 SCREEN@ 1:WINDOW (0,0)-(511,255):VIEW (0,0)-(511,255):BDX=319:BDY=255:BSX=319:BSY=239:PSCM=1:RETURN
  570. 8300 SCREEN@ 2:WINDOW (0,0)-(1023,511):VIEW (0,0)-(1023,511):BDX=639:BDY=511:BSX=639:BSY=479:PSCM=2:RETURN
  571. 8310 *SCREEN_CALC:ON SCM+1 GOTO 8320,8330,8340
  572. 8320 BDX=639:BDY=511:BSX=639:BSY=479:RETURN
  573. 8330 BDX=319:BDY=255:BSX=319:BSY=239:RETURN
  574. 8340 BDX=639:BDY=511:BSX=639:BSY=479:RETURN
  575. 8350 *PALETTE_SET:IF PSCM=1 THEN RETURN ELSE PALETTE
  576. 8360 IF SCM=2 THEN 8370 ELSE *PALETTE_CHANGE
  577. 8370 ON PALM GOTO 8380,*PALETTE_CHANGE,*PALETTE_CHANGE:RETURN
  578. 8380 ON (CCOL\16)+1 GOSUB 8400,8410,8420,8430:GOSUB 8440:GOSUB *PALETTE_CHANGE:RETURN
  579. 8390 *PAL_PAL:OFPAL=FPAL:FPAL=PAL2 MOD 3:ON (CCOL\16)+1 GOSUB 8400,8410,8420,8430:GOSUB 8440:FPAL=OFPAL:RETURN
  580. 8400 FOR A=0 TO 255:PAL&(A)=A*65536+A*256+A:NEXT:RETURN
  581. 8410 FOR A=0 TO 255:PAL&(A)=A*256:NEXT:RETURN
  582. 8420 FOR A=0 TO 255:PAL&(A)=A*65536:NEXT:RETURN
  583. 8430 FOR A=0 TO 255:PAL&(A)=A:NEXT:RETURN
  584. 8440 ON FPAL GOTO 8450,8460:RETURN
  585. 8450 FOR A=0 TO 7:PAL&(A)=IP%(A,1)*65536+IP%(A,2)*256+IP%(A,3):NEXT:PAL&(8)=0:RETURN
  586. 8460 PAL&(0)=0:PAL&(8)=4210752:FOR A=1 TO 7:PAL&(A)=((IP%(A,1)+1)\2)*65536+((IP%(A,2)+1)\2)*256+((IP%(A,3)+1)\2):PAL&(A+8)=IP%(A,1)*65536+IP%(A,2)*256+IP%(A,3):NEXT:PAL&(16)=0:RETURN
  587. 8470 *PALETTE_CHANGE:IF SCM<>PSCM THEN RETURN
  588. 8480 ON SCM+1 GOTO 8500,8490,8510
  589. 8490 RETURN
  590. 8500 FOR A=0 TO 15:PALETTE A,[(PAL&(A) AND 16711680)\65536,(PAL&(A) AND 65280)\256,PAL&(A) AND 255]:NEXT:RETURN
  591. 8510 FOR A=0 TO 255:PALETTE A,[(PAL&(A) AND 16711680)\65536,(PAL&(A) AND 65280)\256,PAL&(A) AND 255]:NEXT:RETURN
  592. 8520 *PALETTE_INI
  593. 8530 ON PSCM+1 GOTO 8550,8540,8560
  594. 8540 RETURN
  595. 8550 FOR A=0 TO 7:PALETTE A+SGN(A)*8,[IP%(A,1),IP%(A,2),IP%(A,3)]:NEXT:RETURN
  596. 8560 FOR A=0 TO 7:PALETTE IP%(A,0),[IP%(A,1),IP%(A,2),IP%(A,3)]:NEXT:RETURN
  597. 8570 *PALETTE_UNDO
  598. 8580 ON PSCM+1 GOTO 8600,8590,8610
  599. 8590 RETURN
  600. 8600 FOR A=0 TO 7:B=A+SGN(A)*8:PALETTE B,[(PAL&(B) AND 16711680)\65536,(PAL&(B) AND 65280)\256,PAL&(B) AND 255]:NEXT:RETURN
  601. 8610 FOR A=0 TO 7:K=IP%(A,0):PALETTE K,[(PAL&(K) AND 16711680)\65536,(PAL&(K) AND 65280)\256,PAL&(K) AND 255]:NEXT:RETURN
  602. 8620 *PALETTE_SAVE:PS$=DFD$+DFF$
  603. 8630 *PALETTE_SAVE_IN:PS$=LEFT$(PS$,LEN(PS$)-4)+".PLT":ON ERROR GOTO 8670:ON SCM+1 GOSUB 8650,8640,8660:ON ERROR GOTO 0:RETURN
  604. 8640 RETURN
  605. 8650 IF PALM=0 THEN OPEN "O",#1,PS$:PRINT #1,CHR$(&HF0,0,0,0);:CLOSE:RETURN ELSE OPEN "O",#1,PS$:FOR A=0 TO 15:PRINT #1,MKL$(PAL&(A));:NEXT:CLOSE:RETURN
  606. 8660 IF PALM=0 THEN OPEN "O",#1,PS$:PRINT #1,CHR$(&HF0,0,0,0);:CLOSE:RETURN ELSE SAVE@ PS$,PAL&:RETURN
  607. 8670 IF ERR=64 THEN KILL PS$:RESUME
  608. 8680 IF CMD=8 THEN 8010
  609. 8690 PRINT "Error ";ERR;" in ";ERL:CALLM RCLOSE&,PIT&:END
  610. 8700 *PALETTE_LOAD:PS$=DFD$+DFF$
  611. 8710 *PALETTE_LOAD_IN:PS$=LEFT$(PS$,LEN(PS$)-4)+".PLT":ON ERROR GOTO 8760:IF SCM<>1 THEN 8730
  612. 8720 ON ERROR GOTO 0:RETURN
  613. 8730 OPEN "I",#1,PS$:A!=CVL(INPUT$(4,1)):CLOSE:IF HEX$(A!)="F0000000" THEN *PALETTE_PALETTE ELSE ON SCM+1 GOTO 8740,8720,8750
  614. 8740 OPEN "I",#1,PS$:FOR A=0 TO 15:PAL&(A)=CVL(INPUT$(4,1)):NEXT:CLOSE:PALM=1:RETURN
  615. 8750 LOAD@ PS$,PAL&:PALM=1:RETURN
  616. 8760 IF ERR=63 THEN GOSUB *PALETTE_PALETTE:RESUME 8720
  617. 8770 PRINT "Error ";ERR;" in ";ERL:CALLM RCLOSE&,PIT&:END
  618. 8780 *PALETTE_FIX:ON CMD+1 GOSUB *PALETTE_PALETTE,8790,8810,8840,8870:GOSUB *PALETTE_CHANGE:RETURN
  619. 8790 PAL&(0)=0:IF PSCM=0 THEN PAL&(7)=8421504:PAL&(15)=16777215:RETURN
  620. 8800 PAL&(182)=12566463:PAL&(255)=16777215:RETURN
  621. 8810 IF PSCM=0 THEN GOSUB *PALETTE_PALETTE:RETURN
  622. 8820 RESTORE 9010:FOR A=1 TO 6:READ BY&(A):NEXT:FOR A=0 TO 31:A!=263172*A:GOSUB 8880:PAL&(A)=A!:A!=263172*A:GOSUB 8880:PAL&(255-A)=A!:NEXT:C=32:FOR B=1 TO 6:FOR A=0 TO 31:A!=BY&(B)*((31-A)*8+7):GOSUB 8880:PAL&(B*32+A)=A!:NEXT:NEXT
  623. 8830 FOR A=0 TO 31:A!=8618883+263172*A:GOSUB 8880:PAL&(224+A)=A!:NEXT:RETURN
  624. 8840 IF PSCM=0 THEN GOSUB *PALETTE_PALETTE_IN:FOR A=1 TO 7:SWAP PAL&(A),PAL&(A+8):NEXT:RETURN
  625. 8850 RESTORE 9010:FOR A=1 TO 6:READ BY&(A):NEXT:FOR A=0 TO 31 STEP 2:FOR B=1 TO 6:A!=BY&(B)*((31-(A\2))*8+7):GOSUB 8880:PAL&(A*8+B)=A!:A!=BY&(B)*((15-(A\2))*8+7):GOSUB 8880:PAL&((A+1)*8+B)=A!:NEXT:NEXT
  626. 8860 FOR A=0 TO 31 STEP 2:A!=263172*(A\2):GOSUB 8880:PAL&(A*8)=A!:A!=263172*(16+(A\2)):GOSUB 8880:PAL&((A+1)*8)=A!:A!=16777215-263172*(A\2):GOSUB 8880:PAL&(A*8+7)=A!:A!=16777215-263172*(16+(A\2)):GOSUB 8880:PAL&((A+1)*8+7)=A!:NEXT:RETURN
  627. 8870 GOSUB *PAL_PAL:RETURN
  628. 8880 IF A!>=2147483648# THEN A!=A!-4294967296#
  629. 8890 RETURN
  630. 8900 SCREEN@ 0:CLS:PALETTE:FOR A=0 TO 255:PRINT USING "### : [G : ###  R : ###  B : ### ]";A;(PAL&(A) AND 16711680)\65536;(PAL&(A) AND 65280)\256;PAL&(A) AND 255:A$=INPUT$(1):NEXT:CALLM RCLOSE&,PIT&:END
  631. 8910 SCREEN@ 0:CLS:PALETTE:A#=8421504:PRINT USING "[G : ###  R : ###  B : ### ]";(A# AND 16711680)\65536;(A# AND 65280)\256;A# AND 255:A$=INPUT$(1):CALLM RCLOSE&,PIT&:END
  632. 8920 *PALETTE_PALETTE:ON ERROR GOTO 0:ON PSCM+1 GOTO 8940,8930,8950
  633. 8930 RETURN
  634. 8940 GOSUB 8970:PALETTE:RETURN
  635. 8950 GOSUB 8980:PALETTE:RETURN
  636. 8960 *PALETTE_PALETTE_IN:ON ERROR GOTO 0:ON SCM+1 GOTO 8970,8930,8980
  637. 8970 RESTORE 8990:FOR A=0 TO 15:READ PAL&(A):NEXT:FOR A=16 TO 255:PAL&(A)=0:NEXT:A&=16:RETURN
  638. 8980 A=0:FOR G=0 TO 7:FOR R=0 TO 7:FOR B=0 TO 3:PAL&(A)=(G*32+31*SGN(G))*65536+(R*32+31*SGN(R))*256+(B*64+63*SGN(B)):A=A+1:NEXT:NEXT:NEXT:A&=256:RETURN
  639. 8990 DATA 0,128,32768,32896,8388608,8388736,8421376,8421504,4210752,255,65280,65535,16711680,16711935,16776960,16777215
  640. 9000 DATA 8158332,255,65280,65535,16711680,16711935,16776960,16777215,                263172,7,1792,1799,458752,458759,460544,263172
  641. 9010 DATA 1,256,257,65536,65537,65792
  642.