#11 Article 891 Posted at 1988/01/15 01:16:13 by ｱﾙﾙｶﾝ (MAP475) [PRG.NL3]
Subject: NED7 FOR FM7
1 ' SAVE"NED7"
2 '
3 CLEAR300,&H3FFF:LOADM"sv.":LOADM"ld.":LOADM"gr."
4 WIDTH 80,25:CONSOLE 0,1,0,0:CLS
5 LOCATE 0,1:PRINT"ﾊｲｹｲﾊ ﾅﾆｲﾛﾆ ｽﾙｯﾁｬ? (0-7) =";:GOSUB 180
6 IF VAL(I$)<0 OR VAL(I$)>7 THEN BEEP:GOTO 5
7 LINE(0,0)-(639,199),PSET,VAL(I$),BF
8 '
9 DEFINT A-Z
10 SPA=&H4000:SSORT=SPA+0
11 SCHECK=SPA+3:SSAVE=SPA+6:SPN=PEEK(SPA+9)*256+PEEK(SPA+10)
12 LPA=&H5800:LLOAD=LPA
13 MPA=&H6000:MDA=&H6000+21
14 MPPSET=MPA+0
15 MPLINE=MPA+3
16 MPPAINT=MPA+6
17 MPCHANGE=MPA+9
18 MPGET=MPA+12
19 MPGETBIT=MPA+15
20 MPLINEBF=MPA+18
21 MDX1=MDA+0:MDY1=MDA+1:MDX2=MDA+2:MDY2=MDA+3
22 MDCB1=MDA+4:MDCR1=MDA+5:MDCG1=MDA+6:MDCB2=MDA+7:MDCR2=MDA+8:MDCG2=MDA+9
23 '
24 GOSUB 189
25 X=80:Y=50:C(0)=8:C(1)=8:C(2)=8
26 GOSUB 40:IF K=27 THEN BEEP:GOTO 26
27 '
28 LINE(X*4,Y*2)-(X*4+3,Y*2+1),XOR,7,BF
29 K$=INPUT$(1):K=ASC(K$)
30 CMD=INSTR(CMD$,K$)
31 MOV=INSTR(MK$,K$)
32 IF MOV+CMD=0 THEN BEEP:GOTO 29
33 LINE(X*4,Y*2)-(X*4+3,Y*2+1),XOR,7,BF
34 IF CMD<>0 THEN GOSUB 37:GOTO 28
35 X=(X+MKX(MOV))MOD 160:Y=(Y+MKY(MOV))MOD 100
36 GOTO 27
37 '
38 ON ((CMD-1)\ 3)+1 GOTO 40,44,50,58,68,100,115
39 BEEP:RETURN
40 ' color
41 C0=C(0):C1=C(1):C2=C(2):GOSUB 124
42 IF K=27 THEN C(0)=C0:C(1)=C1:C(2)=C2 ELSE LF=0
43 RETURN
44 ' pset
45 POKE MDX1,X:POKE MDY1,Y
46 POKE MDCB1,CL(C(0)):POKE MDCR1,CL(C(1)):POKE MDCG1,CL(C(2))
47 EXEC MPPSET
48 XX=X:YY=Y:LF=1
49 RETURN
50 ' line
51 IF LF=0 THEN BEEP:RETURN
52 POKE MDX1,XX:POKE MDY1,YY
53 POKE MDX2,X:POKE MDY2,Y
54 POKE MDCB1,CL(C(0)):POKE MDCR1,CL(C(1)):POKE MDCG1,CL(C(2))
55 EXEC MPLINE
56 XX=X:YY=Y:LF=1
57 RETURN
58 ' paint
59 C0=C(0):C1=C(1):C2=C(2)
60 GOSUB 124:IF K=27 THEN 66ELSE PC0=C(0):PC1=C(1):PC2=C(2)
61 GOSUB 124:IF K=27 THEN 66 ELSE KC0=C(0):KC1=C(1):KC2=C(2)
62 POKE MDX1,X:POKE MDY1,Y
63 POKE MDCB1,CL(PC0):POKE MDCR1,CL(PC1):POKE MDCG1,CL(PC2)
64 POKE MDCB2,CL(KC0):POKE MDCR2,CL(KC1):POKE MDCG2,CL(KC2)
65 EXEC MPPAINT
66 LF=1:C(0)=C0:C(1)=C1:C(2)=C2
67 RETURN
68 ' change
69 WX=X:WY=Y:C0=C(0):C1=C(1):C2=C(2)
70 GOSUB 79:IF K=27 THEN 78 ELSE X1=X:Y1=Y
71 GOSUB 87:IF K=27 THEN 78 ELSE X2=X:Y2=Y
72 GOSUB 124:IF K=27 THEN 78 ELSE DC0=C(0):DC1=C(1):DC2=C(2)
73 GOSUB 124:IF K=27 THEN 78 ELSE CC0=C(0):CC1=C(1):CC2=C(2)
74 POKE MDX1,X1:POKE MDY1,Y1:POKE MDX2,X2:POKE MDY2,Y2
75 POKE MDCB1,CL(CC0):POKE MDCR1,CL(CC1):POKE MDCG1,CL(CC2)
76 POKE MDCB2,CL(DC0):POKE MDCR2,CL(DC1):POKE MDCG2,CL(DC2)
77 EXEC MPCHANGE
78 X=WX:Y=WY:C(0)=C0:C(1)=C1:C(2)=C2:RETURN
79 '
80 LINE(X*4,Y*2)-(X*4+3,Y*2+1),XOR,7,BF
81 K$=INPUT$(1):K=ASC(K$)
82 LINE(X*4,Y*2)-(X*4+3,Y*2+1),XOR,7,BF
83 IF K=27 OR K=13 THEN RETURN
84 MOV=INSTR(MK$,K$)
85 X=(X+MKX(MOV))MOD 160:Y=(Y+MKY(MOV))MOD 100
86 GOTO 80
87 '
88 GOSUB 95
89 K$=INPUT$(1):K=ASC(K$)
90 GOSUB 95
91 IF K=27 OR K=13 THEN RETURN
92 MOV=INSTR(MK$,K$)
93 X=(X+MKX(MOV))MOD 160:Y=(Y+MKY(MOV))MOD 100
94 GOTO 88
95 LINE(X1*4,Y1*2)-(X1*4+3,Y*2+1),XOR,7,BF
96 LINE(X1*4,Y *2)-(X *4+3,Y*2+1),XOR,7,BF
97 LINE(X*4+3,Y *2+1)-(X *4,Y1*2),XOR,7,BF
98 LINE(X*4+3,Y1*2+1)-(X1*4,Y1*2),XOR,7,BF
99 RETURN
100 ' save
101 EXEC SCHECK:EXEC SSORT
102 GOSUB 176
103 A=PEEK(SPN)*256+PEEK(SPN+1)
104 LOCATE 0,0:PRINT A;" ﾊﾟﾀｰﾝ ｱﾙｯﾁｬ ! ｾｰﾌﾞ ｽﾙｯﾁｬ? (y/n) ";
105 A$=INPUT$(1):IF INSTR("nNP",A$)<>0 THEN 111
106 IF INSTR("yY]",A$)=0 THEN BEEP:GOTO 105
107 PRINT:PRINT"ｾｰﾌﾞｽﾙ ﾅﾏｴﾊ ﾅﾝﾀﾞｯﾁｬ? = ";:GOSUB 180:IF I$="" THEN 111
108 GOSUB 178
109 ON ERROR GOTO 113
110 FILE$=I$:EXEC SSAVE
111 GOSUB 178
112 ON ERROR GOTO 0:RETURN
113 GOSUB 176:BEEP:LOCATE 0,0:PRINT"ｴﾗｰｶﾞ ｵｷﾀｯﾁｬ!! ﾅﾆｶ ｷｰｦ ｵｽｯﾁｬ !";
114 A$=INPUT$(1):RESUME 111
115 ' load
116 GOSUB 176
117 LOCATE0,0:PRINT"ﾛｰﾄﾞｽﾙ ﾅﾏｴﾊ ﾅﾝﾀﾞｯﾁｬ? = ";:GOSUB 180
118 IF I$="" THEN GOSUB 178:GOTO 121
119 ON ERROR GOTO 122
120 FILE$=I$:EXEC LLOAD
121 ON ERROR GOTO 0:RETURN
122 BEEP:LOCATE 0,0:PRINT"ｴﾗｰｶﾞ ｵｷﾀｯﾁｬ!! ﾅﾆｶ ｷｰｦ ｵｽｯﾁｬ !";
123 A$=INPUT$(1):GOSUB 178:RESUME 121
124 ' color set
125 WX=X:WY=Y
126 GOSUB 163
127 LINE(X*4,Y*2)-(X*4+3,Y*2+1),XOR,7,BF
128 K$=INPUT$(1):K=ASC(K$)
129 KK=INSTR("1234560",K$):IF KK<>0 THEN GOSUB 140:GOTO 128
130 LINE(X*4,Y*2)-(X*4+3,Y*2+1),XOR,7,BF
131 IF K=13 OR K=27 THEN GOSUB 173:X=WX:Y=WY:RETURN
132 MOV=INSTR(MK$,K$):IF MOV<>0 THEN GOSUB 134
133 GOTO 127
134 '
135 X=(X+MKX(MOV))MOD 160:Y=(Y+MKY(MOV))MOD 100
136 IF Y<42 OR Y>65 THEN RETURN
137 IF CX=60 THEN IF X>=120 AND X<=129 THEN GOSUB 173:GOTO 163 ELSE RETURN
138 IF X>=140 AND X<=149 THEN GOSUB 173:GOSUB 163
139 RETURN
140 '
141 ON KK GOSUB 143,143,143,144,144,144,145:GOSUB 150
142 RETURN
143 A=KK-1:C(A)=C(A)-1:IF C(A)<0 THEN C(A)=0:RETURNELSE RETURN
144 A=KK-4:C(A)=C(A)+1:IF C(A)>8 THEN C(A)=8:RETURNELSE RETURN
145 LINE(X*4,Y*2)-(X*4+3,Y*2+1),XOR,7,BF
146 POKE MDX1,X:POKE MDY1,Y:EXEC MPGET:EXEC MPGETBIT
147 C(0)=PEEK(MDCB1):C(1)=PEEK(MDCR1):C(2)=PEEK(MDCG1)
148 LINE(X*4,Y*2)-(X*4+3,Y*2+1),XOR,7,BF
149 RETURN
150 ' data write
151 LOCATE CX+1,CY+4:PRINT CHR$(C(0)+&H30)+CHR$(C(1)+&H30)++CHR$(C(2)+&H30);
152 AY=GY+30
153 A=0:AX=GX+ 8:GOSUB 160
154 A=1:AX=GX+16:GOSUB 160
155 A=2:AX=GX+24:GOSUB 160
156 POKE MDX1,CX*2+2:POKE MDY1,CY*4+4:POKE MDX2,CX*2+7:POKE MDY2,CY*4+9
157 POKE MDCB1,CL(C(0)):POKE MDCR1,CL(C(1)):POKE MDCG1,CL(C(2))
158 EXEC MPLINEBF
159 RETURN
160 IF C(A)<>0 THEN LINE(AX,AY)-(AX+7,AY-C(A)+1),PSET,2^A,BF
161 IF 8-C(A)<>0 THEN LINE(AX,AY-C(A))-(AX+7,AY-7),PSET,0,BF
162 RETURN
163 ' open color window
164 CX=60
165 IF Y>=42 AND Y<=65 THEN IF X>=120 AND X<=129 THEN CX=70
166 CY=10:GX=CX*8:GY=CY*8
167 GET@A(GX+4,GY+6)-(GX+35,GY+49),WK,G
168 LINE(GX+4,GY+6)-(GX+35,GY+49),PSET,0,BF
169 LINE(GX+4,GY+6)-(GX+35,GY+49),PSET,7,B
170 LOCATE CX+1,CY+5:PRINT"BRG";
171 GOSUB 150
172 RETURN
173 ' close window
174 PUT@A(GX+4,GY+6)-(GX+35,GY+49),WK,PSET
175 RETURN
176 ' open msg window
177 GET@A(0,0)-(639,7),WK,G:LOCATE 0,0:PRINT:RETURN
178 ' close msg window
179 PUT@A(0,0)-(639,7),WK,PSET:RETURN
180 ' input
181 I$="":EXEC &HFBF7
182 K$=INPUT$(1):IF K$=CHR$(13) THEN EXEC &HFBEB:PRINT:RETURN
183 IF INSTR(CHR$(8)+CHR$(29),K$)<>0 THEN GOSUB 186:GOTO 182
184 IF K$<" " OR LEN(I$)=10 THEN 182
185 I$=I$+K$:PRINT K$;:GOTO 182
186 IF LEN(I$)=0 THEN RETURN
187 I$=LEFT$(I$,LEN(I$)-1):PRINT CHR$(29)+" "+CHR$(29);:RETURN
188 I$=""
189 ' init
190 DIM MKX(8),MKY(8),WK(1000),ND(729),CL(8)
191 MK$=CHR$(28)+CHR$(29)+CHR$(30)+CHR$(31)+CHR$(6)+CHR$(2)+CHR$(25)+CHR$(26)
192 MKX(1)=1:MKX(2)=159:MKX(5)=10:MKX(6)=150
193 MKY(3)=99:MKY(4)=1:MKY(7)=90:MKY(8)=10
194 CMD$="cC?,,H"+CHR$(13)+CHR$(13)+CHR$(13)+"pP>xX;sSDlLX"
195 FOR I=0 TO 8:READ CL(I):NEXT
196 DATA &H00,&H04,&H24,&H26,&H66,&H6E,&H7E,&HFE,&HFF
197 RETURN