home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 5 / FREESOFT.BIN / fb386 / 16edit / 16edit.bas next >
BASIC Source File  |  1992-08-19  |  14KB  |  210 lines
  1. 10 CLEAR ,,,400000:DEFINT A-Z:SCREEN@0:COLOR 7,0,0,0:CLS 4
  2. 20 DIM PIC全(76800),PL(2,15),PIC1(64),PIC絵(76800),SE$(11),PIC2(640)
  3. 30 GET@A(0,0)-(639,479),PIC全:MOUSE 0:MOUSE 1,320,240,1:MOUSE 4,0,0,640,480
  4. 40 FOR A=0 TO 11:READ SE$(A):NEXT:CO=15
  5. 50 FOR A=0 TO 15:FOR B=0 TO 2:READ PL(B,A):NEXT:PALETTE A,[PL(0,A),PL(1,A),PL(2,A)]:NEXT:GOTO *MAIN
  6. 60 DATA 画面消去,16*16拡大,32*32拡大,ﾊﾟﾚｯﾄ変更,絵のＳＡＶＥorＬＯＡＤ,絵のﾊﾟﾚｯﾄのSAVEorLOAD,ＣＤＰＬＡＥＲ,塗り潰し,絵の複写,プログラムＳＴＯＰ,絵の拡大,絵の反転
  7. 70 DATA 0,0,0,0,0,128,0,128,0,0,128,128,128,0,0,128,0,128,128,128,0,128,128,128,64,64,64,0,0,255,0,255,0,0,255,255,255,0,0,255,0,255,255,255,0,255,255,255
  8. 80 *PICIN:GET@A(0,0)-(639,479),PIC全:RETURN
  9. 90 *PICOUT:PUT@A(0,0)-(639,479),PIC全:RETURN
  10. 100 *YN
  11. 110 WAIT 9:LINE(400,100)-(465,133),PSET,7,B:SYMBOL(401,101),"ＹＮ",2,2,6:MOUSE 4,400,100,463,132
  12. 120 YN=INT((MOUSE(0)-400)/32):LINE(400+YN*32,100)-(431+YN*32,133),XOR,7,BF:LINE(400+YN*32,100)-(431+YN*32,133),XOR,7,BF
  13. 130 IF MOUSE(2,0)=0 THEN 120 ELSE RETURN
  14. 140 *色表示
  15. 150 LINE(0,448)-(640,480),PSET,0,BF:FOR A=0 TO 15:LINE(40+A*32,448)-(71+A*32,479),PSET,%A,BF:LINE(40+A*32,448)-(71+A*32,479),PSET,7,B:NEXT:RETURN
  16. 160 *MAIN
  17. 170 CX=MOUSE(0):CY=MOUSE(1):GET@A(C1X,C1Y)-(C1X+15,C1Y+15),PIC1:GET@A(C2X,C2Y)-(C2X+31,C2Y+31),PIC2:LINE(C2X,C2Y)-(C2X+31,C2Y+31),XOR,7,B:LINE(C1X,C1Y)-(C1X+15,C1Y+15),XOR,7,B:PUT@A(C1X,C1Y)-(C1X+15,C1Y+15),PIC1
  18. 180 PUT@A(C2X,C2Y)-(C2X+31,C2Y+31),PIC2
  19. 190 IF MOUSE(2,0)=-1 THEN C1X=CX:C1Y=CY:C2X=INT(CX/32)*32:C2Y=INT(CY/32)*32:GOTO 170
  20. 200 IF MOUSE(2,1)=0 THEN 170
  21. 210 GOSUB *PICIN
  22. 220 LINE(100,50)-(300,252),PSET,0,BF
  23. 230 FOR A=0 TO 11:LINE(100,50+A*17)-(300,67+A*17),PSET,7,B:SYMBOL(101,50+A*17),SE$(A),1,1,7:NEXT:MOUSE 4,100,50,300,251
  24. 240 CY=INT((MOUSE(1)-50)/17):LINE(100,50+CY*17)-(300,67+CY*17),XOR,7,BF:WAIT 5:LINE(100,50+CY*17)-(300,67+CY*17),XOR,7,BF
  25. 250 IF MOUSE(2,0)=-1 THEN 270
  26. 260 IF MOUSE(2,1)=-1 THEN GOSUB *PICOUT:MOUSE 4,0,0,639,479:GOTO *MAIN ELSE 240
  27. 270 MOUSE 4,0,0,639,479:GOSUB *PICOUT:IF CY=0 THEN *画面消去
  28. 280 IF CY=1 THEN *B16
  29. 290 IF CY=2 THEN *B32
  30. 300 IF CY=3 THEN *PA
  31. 310 IF CY=4 THEN *DISK
  32. 320 IF CY=5 THEN *DISK2
  33. 330 IF CY=6 THEN *CDC
  34. 340 IF CY=7 THEN *塗り潰し
  35. 350 IF CY=8 THEN *絵の複写
  36. 360 IF CY=9 THEN GOSUB *PICOUT:STOP
  37. 370 IF CY=10 THEN *絵の拡大
  38. 380 IF CY=11 THEN *反転
  39. 390 GOTO *MAIN
  40. 400 *画面消去
  41. 410 GOSUB *YN:MOUSE 4,0,0,639,479:GOSUB *PICOUT:IF YN=0 THEN CLS:GOSUB *PICIN:GOTO *MAIN ELSE *MAIN
  42. 420 *B16
  43. 430 GOSUB *PICOUT:GET@A(C1X,C1Y)-(C1X+15,C1Y+15),PIC2:LINE(42,42)-(313,313),PSET,0,BF:PUT@A(50,50)-(65,65),PIC2,PSET,16,16:LINE(310,310)-(346,346),PSET,0,BF:PUT@A(320,320)-(335,335),PIC2
  44. 440 FOR A=0 TO 15:LINE(50+A*16,50)-(50+A*16,305),PSET,%1:LINE(50,50+A*16)-(305,50+A*16),PSET,%1:A$=RIGHT$(STR$(A),1+INT(A/10)):SYMBOL(54+A*16,42),A$,.5!,.5!,6:SYMBOL(42,54+A*16),A$,.5!,.5!,6:NEXT:GOSUB *色表示:LINE(570,448)-(601,480),PSET,%CO,BF
  45. 450 LINE(570,448)-(601,479),XOR,7,B:SYMBOL(605,460),STR$(CO),1,1,6
  46. 460 CX=MOUSE(0):CY=MOUSE(1)
  47. 470 IF MOUSE(2,1)=-1 THEN GET@A(320,320)-(335,335),PIC2:GOSUB *PICOUT:PUT@A(C1X,C1Y)-(C1X+15,C1Y+15),PIC2:GOTO *MAIN
  48. 480 IF MOUSE(2,0)=0 THEN 460
  49. 490 IF CY>50 AND CX>50 AND CX<305 AND CY<305 THEN 510 
  50. 500 IF CX>40 AND CY>448 AND CX<551 THEN 530 ELSE 460
  51. 510 CX=INT((CX-50)/16):CY=INT((CY-50)/16)
  52. 520 LINE(CX*16+51,CY*16+51)-(CX*16+65,CY*16+65),PSET,%CO,BF:PSET(320+CX,CY+320),%CO:GOTO 460
  53. 530 CO=INT((CX-40)/32):LINE(570,448)-(601,479),PSET,%CO,BF:LINE(570,448)-(601,479),XOR,7,B:LINE(605,460)-(640,479),PSET,0,BF:SYMBOL(605,460),STR$(CO),1,1,6:GOTO 460
  54. 540 *CDC
  55. 550 LINE(300,200)-(400,250),PSET,0,BF:FOR A=0 TO 1:LINE(300,210+A*17)-(400,227+A*17),PSET,7,B:NEXT:SYMBOL(301,211),"ＣＤを聞く",1,1,6:SYMBOL(301,228),"ＣＤを止める",1,1,6:MOUSE 4,300,200,400,233
  56. 560 CY=INT((MOUSE(1)-200)/17):LINE(300,210+CY*17)-(400,227+CY*17),XOR,7,BF:LINE(300,210+CY*17)-(400,227+CY*17),XOR,7,BF
  57. 570 IF MOUSE(2,0)=0 THEN 560
  58. 580 IF CY=0 THEN CD PLAY ELSE CD STOP
  59. 590 MOUSE 4,0,0,639,479:GOSUB *PICOUT:GOTO *MAIN
  60. 600 *B32
  61. 610 GOSUB *PICOUT
  62. 620 GET@A(C2X,C2Y)-(C2X+31,C2Y+31),PIC2:LINE(C2X,C2Y)-(C2X+31,C2Y+31),PSET,7,B
  63. 630 PUT@A(100,50)-(131,81),PIC2,,12,12:LINE(499,199)-(559,249),PSET,7,BF:PUT@A(510,210)-(541,241),PIC2
  64. 640 FOR A=0 TO 31:LINE(100+A*12,50)-(100+A*12,432),PSET,%1:LINE(100,50+A*12)-(482,50+A*12),PSET,%1:NEXT:GOSUB *色表示:LINE(570,448)-(601,480),PSET,%CO,BF:LINE(570,448)-(601,479),XOR,7,B:SYMBOL(605,460),STR$(CO),1,1,6
  65. 650 FOR A=0 TO 2:LINE(196+A*96,50)-(196+A*96,432),PSET,7,,&H0707:LINE(100,146+A*96)-(482,146+A*96),PSET,7,,&H0707:NEXT
  66. 660 CX=MOUSE(0):CY=MOUSE(1)
  67. 670 IF MOUSE(2,1)=-1 THEN GET@A(510,210)-(541,241),PIC2:GOSUB *PICOUT:PUT@A(C2X,C2Y)-(C2X+31,C2Y+31),PIC2:GOTO *MAIN
  68. 680 IF MOUSE(2,0)=0 THEN 660
  69. 690 IF CX>40 AND CY>448 AND CX<551 THEN 720
  70. 700 IF CX>100 AND CY>50 AND CX<481 AND CY<431 THEN 710 ELSE 660
  71. 710 CX=INT((CX-100)/12):CY=INT((CY-50)/12):LINE(101+CX*12,51+CY*12)-(111+CX*12,61+CY*12),PSET,%CO,BF:PSET(510+CX,210+CY),%CO:GOTO 660
  72. 720 CO=INT((CX-40)/32):LINE(570,448)-(601,479),PSET,%CO,BF:LINE(570,448)-(601,479),XOR,7,B:LINE(605,460)-(640,479),PSET,0,BF:SYMBOL(605,460),STR$(CO),1,1,6:GOTO 660
  73. 730 *PA
  74. 740 FOR A=0 TO 15:LINE(A*36,100)-(A*36+35,135),PSET,%A,BF:LINE(A*36,100)-(A*36+35,135),PSET,7,B:FOR B=0 TO 2:LINE(A*36+B*12,150)-(A*36+B*12+9,PL(B,A)+150),PSET,7,BF:NEXT:NEXT:MOUSE 4,0,150,568,406
  75. 750 CX=INT(MOUSE(0)/12):CCP=INT((MOUSE(1)-150)/16)*16:CPC=INT(CX/3):COC=CX-CPC*3:LINE(CX*12,150)-(CX*12+10,PL(COC,CPC)+150),XOR,7,BF:LINE(CX*12,150)-(CX*12+10,PL(COC,CPC)+150),XOR,7,BF
  76. 760 IF CCP>255 THEN CCP=255
  77. 770 LINE(0,0)-(100,64),PSET,0,BF:SYMBOL(0,0),STR$(CCP),1,1,7:SYMBOL(0,16),STR$(PL(COC,CPC)),1,1,7
  78. 780 IF MOUSE(2,1)=-1 THEN GOSUB *PICOUT:GOTO *MAIN
  79. 790 IF MOUSE(2,0)=0 THEN 750
  80. 800 PL(COC,CPC)=CCP:PALETTE CPC,[PL(0,CPC),PL(1,CPC),PL(2,CPC)]
  81. 810 LINE(CPC*36+COC*12,150)-(CPC*36+COC*12+9,406),PSET,0,BF:LINE(CPC*36+COC*12,150)-(CPC*36+COC*12+9,150+PL(COC,CPC)),PSET,7,BF:GOTO 750
  82. 820 *DISK
  83. 830 CLS:FOR A=0 TO 1:LINE(100,100+A*32)-(240,131+A*32),PSET,7,B:SYMBOL(101,101+A*32),MID$("ＳＡＶＥＬＯＡＤ",A*8+1,8),2,2,7:NEXT
  84. 840 MOUSE 4,100,100,240,163
  85. 850 CY=INT((MOUSE(1)-100)/32):LINE(100,100+CY*32)-(240,131+CY*32),XOR,7,BF:LINE(100,100+CY*32)-(240,131+CY*32),XOR,7,BF
  86. 860 IF MOUSE(2,1)=-1 THEN MOUSE 4,0,0,639,479:GOSUB *PICOUT:GOTO *MAIN
  87. 870 IF MOUSE(2,0)=0 THEN 850
  88. 880 IF CY=1 THEN 930
  89. 890 CLS:INPUT"SAVEFILES";F$:CLS:MOUSE 4,0,0,640,480
  90. 900 CX=INT(MOUSE(0)/32)*32-1:CY=INT(MOUSE(1)/32)*32-1:LINE(0,0)-(CX,CY),PSET,7,B:GOSUB *PICOUT
  91. 910 IF MOUSE(2,0)=0 THEN 900
  92. 920 ON ERROR GOTO *E1:SAVE@ "A:"+F$+".TIF",(0,0)-(CX,CY):MOUSE 4,0,0,639,479:ON ERROR GOTO 0:GOTO *MAIN
  93. 930 CLS:ON ERROR GOTO *E2:FILES "A:*.TIF":INPUT "LOADFILES";F$:MOUSE 4,0,0,639,479:CLS
  94. 940 CX=INT(MOUSE(0)/32)*32:CY=INT(MOUSE(1)/32)*32:LINE(CX,CY)-(639,479),PSET,7,B:GOSUB *PICOUT
  95. 950 IF MOUSE(2,0)=0 THEN 940
  96. 960 LOAD@ "A:"+F$+".TIF",(CX,CY):ON ERROR GOTO 0:GOTO *MAIN
  97. 970 *E1
  98. 980 IF ERR=64 THEN KILL "A:"+F$+".TIF":RESUME
  99. 990 IF ERR=60 OR ERR=72 OR ERR=73 THEN CLS:SYMBOL(50,50),"ＳＡＶＥに失敗しました",1,1,7:BEEP:WAIT 300:GOSUB *PICOUT:RESUME *MAIN
  100. 1000  CLS:SYMBOL(50,50),"エラーが発生しました",1,1,7:SYMBOL(50,70),"行番号"+STR$(ERL)+"エラー番号"+STR$(ERR),1,1,7:BEEP:WAIT 300:GOSUB *PICOUT:RESUME *MAIN
  101. 1010 *E2
  102. 1020 IF ERR=63 THEN CLS:SYMBOL(50,50),"指定のファイルは存在していません",1,1,7:BEEP:WAIT 300:GOSUB *PICOUT:ON ERROR GOTO 0:RESUME *MAIN ELSE 1000
  103. 1030 *E3
  104. 1040 IF ERR=64 THEN KILL "A:"+F$+".DAT":RESUME ELSE 990
  105. 1050 *DISK2
  106. 1060 CLS:FOR A=0 TO 1:LINE(100,100+A*32)-(240,131+A*32),PSET,7,B:SYMBOL(101,101+A*32),MID$("ＳＡＶＥＬＯＡＤ",A*8+1,8),2,2,7:NEXT
  107. 1070 MOUSE 4,100,100,240,163
  108. 1080 CY=INT((MOUSE(1)-100)/32):LINE(100,100+CY*32)-(240,131+CY*32),XOR,7,BF:LINE(100,100+CY*32)-(240,131+CY*32),XOR,7,BF
  109. 1090 IF MOUSE(2,1)=-1 THEN GOSUB *PICOUT:MOUSE 4,0,0,639,479:GOTO *MAIN
  110. 1100 IF MOUSE(2,0)=0 THEN 1080
  111. 1110 CLS:MOUSE 4,0,0,639,479:IF CY=0 THEN 1140
  112. 1120 ON ERROR GOTO *E2:FILES "A:*.DAT":INPUT "LOAD PALETTE FILES";F$:CLS 4
  113. 1130 OPEN "I",#1,"A:"+F$+".DAT":FOR A=0 TO 15:INPUT #1,PL(0,A),PL(1,A),PL(2,A):PALETTE A,[PL(0,A),PL(1,A),PL(2,A)]:NEXT:CLOSE #1:GOSUB *PICOUT:ON ERROR GOTO 0:GOTO *MAIN
  114. 1140 INPUT "SAVE PALETTE FILES";F$:CLS 4
  115. 1150 ON ERROR GOTO *E3:OPEN "O",#1,"A:"+F$+".DAT":FOR A=0 TO 15:WRITE #1,PL(0,A),PL(1,A),PL(2,A):NEXT:CLOSE #1:GOSUB *PICOUT:ON ERROR GOTO 0:GOTO *MAIN
  116. 1160 *塗り潰し
  117. 1170 LINE(100,50)-(250,129),PSET,0,BF:FOR A=0 TO 4:LINE(100,50+A*16)-(250,65+A*16),PSET,7,B
  118. 1180 SYMBOL(100,50+A*16),MID$("　範囲塗り潰し　　１６＊１６四角の枠１６＊１６キャラ　３２＊３２四角の枠同色塗り潰し",A*18+1,18),1,1,7:NEXT:MOUSE 4,100,50,250,129
  119. 1190 CY=INT((MOUSE(1)-50)/16):LINE(100,50+CY*16)-(250,65+CY*16),XOR,7,BF:LINE(100,50+CY*16)-(250,65+CY*16),XOR,7,BF
  120. 1200 IF MOUSE(2,1)=-1 THEN MOUSE 4,0,0,639,479:GOSUB *PICOUT:GOTO *MAIN
  121. 1210 IF MOUSE(2,0)=0 THEN 1190
  122. 1220 CC=-1:MOUSE 4,0,0,639,479:GOSUB *PICOUT:IF CY=0 THEN 1340
  123. 1230 IF CY=4 THEN WAIT 70:GOTO 1280
  124. 1240 IF CY=1 THEN LINE(C1X,C1Y)-(C1X+15,C1Y+15),PSET,%CO,BF
  125. 1250 IF CY=2 THEN CX=INT(C1X/16)*16:CCY=INT(C1Y/16)*16:LINE(CX,CCY)-(CX+15,CCY+15),PSET,%CO,BF
  126. 1260 IF CY=3 THEN LINE(C2X,C2Y)-(C2X+31,C2Y+31),PSET,%CO,BF
  127. 1270 GOTO *MAIN
  128. 1280 CX=MOUSE(0):CY=MOUSE(1):C1=1-INT(CX/320)
  129. 1290 IF C1<>CC THEN CC=C1:PUT@A(0,0)-(639,479),PIC全
  130. 1300 GET@A(CX-2,CY-2)-(CX+2,CY+2),PIC1:C1=320-INT(CX/320)*320:PUT@A(100+C1,200)-(104+C1,204),PIC1,,12,12:LINE(124+C1,224)-(135+C1,235),XOR,7,B:LINE(110+C1,80)-(200+C1,96),PSET,0,BF:SYMBOL(110+C1,80),STR$(CX)+STR$(CY),1,1,7
  131. 1310 IF MOUSE(2,1)=-1 THEN GOSUB *PICOUT:GOTO *MAIN
  132. 1320 IF MOUSE(2,0)=0 THEN 1280
  133. 1330 PUT@A(0,0)-(639,479),PIC全:PAINT @ (CX,CY),%CO:GOTO *MAIN
  134. 1340 CX=MOUSE(0):CY=MOUSE(1):C1=1-INT(CX/320)
  135. 1350 IF C1<>CC THEN CC=C1:PUT@A(0,0)-(639,479),PIC全
  136. 1360 GET@A(CX-2,CY-2)-(CX+2,CY+2),PIC1:C1=320-INT(CX/320)*320:PUT@A(100+C1,200)-(104+C1,204),PIC1,,12,12:LINE(124+C1,224)-(135+C1,235),XOR,7,B:LINE(110+C1,80)-(200+C1,96),PSET,0,BF:SYMBOL(110+C1,80),STR$(CX)+STR$(CY),1,1,7
  137. 1370 IF MOUSE(2,1)=-1 THEN GOSUB *PICOUT:GOTO *MAIN
  138. 1380 IF MOUSE(2,0)=0 THEN 1340
  139. 1390 C3X=CX:C3Y=CY:PUT@A(0,0)-(639,479),PIC全
  140. 1400 CX=MOUSE(0):CY=MOUSE(1):C1=1-INT(CX/320)
  141. 1410 IF C1<>CC THEN CC=C1:PUT@A(0,0)-(639,479),PIC全
  142. 1420 GET@A(CX-2,CY-2)-(CX+2,CY+2),PIC1:C1=320-INT(CX/320)*320:PUT@A(100+C1,200)-(104+C1,204),PIC1,,12,12:LINE(124+C1,224)-(135+C1,235),XOR,7,B:LINE(110+C1,80)-(200+C1,96),PSET,0,BF:SYMBOL(110+C1,80),STR$(CX)+STR$(CY),1,1,7:LINE(C3X,C3Y)-(CX,CY),XOR,7,B
  143. 1430 LINE(C3X,C3Y)-(CX,CY),XOR,7,B:IF MOUSE(2,1)=-1 THEN GOSUB *PICOUT:GOTO *MAIN
  144. 1440 IF MOUSE(2,0)=0 THEN 1400
  145. 1450 PUT@A(0,0)-(639,479),PIC全:LINE(C3X,C3Y)-(CX,CY),PSET,%CO,BF:GOTO *MAIN
  146. 1460 *絵の複写
  147. 1470 LINE(100,50)-(250,97),PSET,0,BF:FOR A=0 TO 2:LINE(100,50+A*16)-(250,67+A*16),PSET,7,B:SYMBOL(100,50+A*16),MID$("１６＊１６キャラ３２＊３２キャラ範囲複写",1+A*16,16),1,1,7:NEXT:MOUSE 4,100,50,250,97
  148. 1480 CY=INT((MOUSE(1)-50)/16)
  149. 1490 LINE(100,50+CY*16)-(250,67+CY*16),XOR,7,BF:LINE(100,50+CY*16)-(250,67+CY*16),XOR,7,BF
  150. 1500 IF MOUSE(2,1)=-1 THEN MOUSE 4,0,0,639,479:GOSUB *PICOUT:GOTO *MAIN
  151. 1510 IF MOUSE(2,0)=0 THEN 1480
  152. 1520 WAIT 50:MOUSE 4,0,0,639,479:PUT@A(0,0)-(639,479),PIC全:IF CY=0 THEN 1540
  153. 1530 IF CY=1 THEN 1590 ELSE 1640
  154. 1540 C4X=INT(C1X/16)*16:C4Y=INT(C1Y/16)*16:GET@A(C4X,C4Y)-(C4X+15,C4Y+15),PIC2
  155. 1550 CX=INT(MOUSE(0)/16)*16:CY=INT(MOUSE(1)/16)*16:PUT@A(CX,CY)-(CX+15,CY+15),PIC2:PUT@A(0,0)-(639,479),PIC全
  156. 1560 IF MOUSE(2,1)=-1 THEN *MAIN
  157. 1570 IF MOUSE(2,0)=0 THEN 1550
  158. 1580 PUT@A(CX,CY)-(CX+15,CY+15),PIC2:GOSUB *PICIN:GOTO 1550
  159. 1590 GET@A(C2X,C2Y)-(C2X+31,C2Y+31),PIC2
  160. 1600 CX=INT(MOUSE(0)/32)*32:CY=INT(MOUSE(1)/32)*32:PUT@A(CX,CY)-(CX+31,CY+31),PIC2:PUT@A(0,0)-(639,479),PIC全
  161. 1610 IF MOUSE(2,1)=-1 THEN *MAIN
  162. 1620 IF MOUSE(2,0)=0 THEN 1600
  163. 1630 PUT@A(CX,CY)-(CX+31,CY+31),PIC2:GOSUB *PICIN:GOTO 1600
  164. 1640 CX=MOUSE(0):CY=MOUSE(1):GET@A(CX-2,CY-2)-(CX+2,CY+2),PIC1:C1=320-INT(CX/320)*320:PUT@A(100+C1,200)-(104+C1,204),PIC1,,12,12:LINE(124+C1,224)-(135+C1,235),XOR,7,B:SYMBOL(110+C1,80),STR$(CX)+STR$(CY),1,1,7
  165. 1650 PUT@A(0,0)-(639,479),PIC全
  166. 1660 IF MOUSE(2,1)=-1 THEN GOSUB *PICOUT:GOTO *MAIN
  167. 1670 IF MOUSE(2,0)=0 THEN 1640
  168. 1680 C3X=CX:C3Y=CY
  169. 1690 CX=MOUSE(0):CY=MOUSE(1):GET@A(CX-2,CY-2)-(CX+2,CY+2),PIC1:C1=320-INT(CX/320)*320:PUT@A(100+C1,200)-(104+C1,204),PIC1,,12,12:LINE(124+C1,224)-(135+C1,235),XOR,7,B:SYMBOL(110+C1,80),STR$(CX)+STR$(CY),1,1,7:LINE(C3X,C3Y)-(CX,CY),PSET,7,B
  170. 1700 PUT@A(0,0)-(639,479),PIC全:IF MOUSE(2,1)=-1 THEN GOSUB *PICOUT:GOTO *MAIN
  171. 1710 IF MOUSE(2,0)=0 THEN 1690
  172. 1720 GET@A(C3X,C3Y)-(CX,CY),PIC絵:C3X=C3X-CX:C3Y=C3Y-CY
  173. 1730 CX=MOUSE(0):CY=MOUSE(1):PUT@A(CX,CY)-(CX+C3X,CY+C3Y),PIC絵:PUT@A(0,0)-(639,479),PIC全
  174. 1740 IF MOUSE(2,0)=0 THEN 1730
  175. 1750 PUT@A(CX,CY)-(CX+C3X,CY+C3Y),PIC絵:GOTO *MAIN
  176. 1760 *絵の拡大
  177. 1770 CLS 4:COLOR 12:PRINT "何処から拡大しますか":COLOR 7
  178. 1780 CX=INT(MOUSE(0)/16)*16:CY=INT(MOUSE(1)/16)*16
  179. 1790 IF MOUSE(2,1)=-1 THEN *MAIN
  180. 1800 IF MOUSE(2,0)=0 THEN 1780
  181. 1810 IF MOUSE(2,0)=-1 THEN 1810
  182. 1820 CCX=CX:CCY=CY:CLS 4:COLOR 13:PRINT "何処まで拡大しますか":COLOR 7
  183. 1830 CX=INT(MOUSE(0)/16)*16-1:CY=INT(MOUSE(1)/16)*16-1
  184. 1840 LINE(CCX,CCY)-(CX,CY),XOR,7,B:LINE(CCX,CCY)-(CX,CY),XOR,7,B
  185. 1850 IF MOUSE(2,0)=0 THEN 1830
  186. 1860 GET@A(CCX,CCY)-(CX,CY),PIC絵:CCX=CCX-CX:CCY=CCY-CY
  187. 1870 CLS 4:COLOR 12:PRINT "何処に複写しますか":COLOR 7
  188. 1880 CX=INT(MOUSE(0)/16)*16:CY=INT(MOUSE(1)/16)*16
  189. 1890 PUT@A(CX,CY)-(CX-CCX,CY-CCY),PIC絵,,2,2
  190. 1900 PUT@A(0,0)-(639,479),PIC全
  191. 1910 IF MOUSE(2,0)=0 THEN 1880
  192. 1920 PUT@A(CX,CY)-(CX-CCX,CY-CCY),PIC絵,,2,2:GOTO *MAIN
  193. 1930 *反転
  194. 1940 LINE(200,100)-(266,134),PSET,7,BF,0:SYMBOL(201,101),"左右反転",1,1,7:SYMBOL(201,117),"上下反転",1,1,7:MOUSE 4,201,101,265,131
  195. 1950 CY=INT((MOUSE(1)-100)/16)
  196. 1960 LINE(201,101+CY*16)-(265,116+CY*16),XOR,7,BF:LINE(201,101+CY*16)-(265,116+CY*16),XOR,7,BF
  197. 1970 IF MOUSE(2,1)=-1 THEN MOUSE 4,0,0,639,479:GOSUB *PICOUT:GOTO *MAIN
  198. 1980 IF MOUSE(2,0)=0 THEN 1950
  199. 1990 MOUSE 4,0,0,639,479:GOSUB *PICOUT:GET@A(C2X,C2Y)-(C2X+31,C2Y+31),PIC絵:IF CY=0 THEN 2020
  200. 2000 FOR A=0 TO 31:PUT@A(C2X,C2Y+A)-(C2X+31,C2Y+A),PIC絵,,,,,248-A*8
  201. 2010 NEXT:GOTO *MAIN
  202. 2020 AD!=512*C2Y+INT(C2X/2)
  203. 2030 C1=0:FOR A=0 TO 31:FOR B=15 TO 0 STEP -1
  204. 2040 C=PEEK([&H1C]AD!+A*512+B)
  205. 2050 C2=INT(C/16):C3=C-C2*16:PIC絵(C1*2)=C2:PIC絵(C1*2+1)=C3:C1=C1+1
  206. 2060 NEXT:NEXT
  207. 2070 C1=0:FOR A=0 TO 31:FOR B=0 TO 31
  208. 2080 PSET(C2X+B,C2Y+A),%PIC絵(C1):C1=C1+1
  209. 2090 NEXT:NEXT:GOTO *MAIN
  210.