10 REM ********* ALPHAMETRICS *********
11 REM *     Id` samt utf|rande:      *
12 REM *                              *
13 REM * MICHAEL WIDENIUS  11-04-1980 *
14 REM *                              *
15 REM ********************************
16 REM OMR]DE: PROBLEM & LOGIK
17 REM 
18 COMMON Meny$=16%,Qwerty$=16%,Highcolour%,Rambuffer%,Qwerty1%,Qwerty2%,Qwerty3%
19 ! 
20 DIM A$(9%)=15%,In$(9%)=15%,A1$=20%,In$=160%
21 DIM B%(9%,20%),C%(21%),F%(20%),F1%(20%)
22 ! 
23 ; FNRubrik$
24 ; : ; 
25 ; " Detta program l|ser problem av typen:"
26 ; 
27 ; TAB(17%) GRN "SEND"
28 ; TAB(17%) GRN "MORE"
29 ; TAB(17%) "-----"
30 ; TAB(16%) YEL "MONEY"
31 ; 
32 ; "d{r varje bostav representerar en"
33 ; "nummer ( 0-9 )."
34 ; " R{knes{ttet {r i detta program alltid"
35 ; "addition (+). Dessutom b|r f|ljande"
36 ; "punkter l{ggas p} minnet:"
37 ; 
38 ; "- Problemet skall ges i samma form som"
39 ; "  i exemplet ovan."
40 ; "- 9 {r det h|gsta antalet till}tna"
41 ; "  additioner i ett och samma problem."
42 ; "- Varje rad f}r ha max. 15 tecken !"
43 ON ERROR GOTO 213
44 ; 
45 INPUT "Tryck p} RETURN n{r du l{st f{rdigt:";In$
46 ; CHR$(12%) GRN "Ge problemet:"
47 ; : ; 
48 REM 
49 REM *** PROBLEMET MATAS IN ***
50 REM 
51 ON ERROR GOTO 213
52 A%=0% : S%=0% : F%=0%
53 ; SPACE$(40%) CHR$(13%);
54 INPUT " "In$
55 IF In$="SLUT" OR In$="slut" THEN 207
56 IF In$="" THEN 46
57 IF INSTR(1%,In$," ") THEN 221
58 IF INSTR(1%,In$,"-") THEN S%=1% : GOTO 53
59 IF LEN(In$)>15% THEN 223
60 In$(A%)=In$ : A$(A%)=In$
61 IF S%<>1% THEN IF A%<9% THEN A%=A%+1% : GOTO 53 ELSE 225
62 IF A%<2% THEN 227
63 ON ERROR GOTO 
64 ; 
65 REM 
66 REM *** L[NGDERNA JUSTERAS ***
67 REM 
68 Skr%=FNSort%(0%,A%-1%) ! I L[NGDORDNING
69 IF LEN(A$(A%))<LEN(A$(A%-1%)) THEN 229
70 L%=LEN(A$(A%)) : S%=0% : A$=""
71 FOR I%=0% TO A%-1%
72   In$(I%)=SPACE$(L%-LEN(In$(I%)))+In$(I%)
73   A$(I%)=SPACE$(L%-LEN(A$(I%)))+A$(I%)
74 NEXT I% 
75 M%=0%
76 FOR I%=0% TO 20% : F1%(I%)=0% : NEXT I% 
77 FOR I%=0% TO 9%
78   A%(I%)=0% : F2%(I%)=-1%
79 NEXT I% 
80 FOR I%=0% TO L%+1%
81   C%(I%)=0% : Maxc%(I%)=A% : F%(I%)=0%
82 NEXT I% 
83 FOR I%=0% TO A% : FOR J%=1% TO L%
84     B%(I%,J%)=0%
85 NEXT J% : NEXT I% 
86 REM 
87 REM ** STORLEKSORDNING **
88 REM 
89 FOR J%=L% TO 1% STEP -1% : FOR I%=0% TO A%
90     S$=MID$(A$(I%),J%,1%)
91     IF S$=" " THEN B%(I%,J%)=16% : Maxc%(J%-1%)=Maxc%(J%-1%)-1% : GOTO 104
92     IF INSTR(1%,A$,S$) THEN 104
93     M%=M%+1% : A$=A$+S$
94     IF M%>10% THEN 231 ! G]R INTE
95     FOR I1%=0% TO A% : S1%=1%
96       S1%=INSTR(S1%,A$(I1%),S$) : IF S1% A%(M%)=A%(M%)+1% : S1%=S1%+1% : GOTO 96
97     NEXT I1% 
98     S%=M%
99     WHILE S%<>1%
100       IF A%(S%)<=A%(S%-1%) THEN 104
101       S1%=A%(S%) : A%(S%)=A%(S%-1%) : S%=S%-1% : A%(S%)=S1%
102       A$=LEFT$(A$,S%-1%)+S$+MID$(A$,S%,1%)+RIGHT$(A$,S%+2%)
103     WEND 
104   NEXT I% 
105 NEXT J% 
106 A1%=1%
107 ! 
108 ! ** DEN MAXIMALA CARRYN JUSTERAS **
109 ! 
110 FOR I%=L%-1% TO 1% STEP -1%
111   IF Maxc%(I%)<Maxc%(I%+1%) THEN Maxc%(I%)=Maxc%(I%)+1%
112 NEXT I% 
113 REM 
114 REM *** LOGISK ORDNING ***
115 REM 
116 FOR J%=L% TO 1% STEP -1% : S%=0% : S$=""
117   FOR I%=0% TO A%
118     IF B%(I%,J%)=0% IF S% AND MID$(A$(I%),J%,1%)<>S$ THEN 124 ELSE S%=1% : S$=MID$(A$(I%),J%,1%)
119   NEXT I% 
120   IF S%=0% THEN 124
121   F%(A1%)=1% : S%=INSTR(1%,A$,S$)
122   A$=LEFT$(A$,A1%-1%)+S$+MID$(A$,A1%,S%-A1%)+RIGHT$(A$,S%+1%)
123   GOTO 127
124 NEXT J% 
125 ! 
126 S$=MID$(A$,A1%,1%)
127 A%(A1%)=0% : FOR I%=0% TO A% : S%=1%
128   S%=INSTR(S%,A$(I%),S$) : IF S% B%(I%,S%)=1% : S%=S%+1% : GOTO 128
129 NEXT I% 
130 A1%=A1%+1% : IF A1%<=M% THEN 116
131 REM 
132 REM *** NU B\RJAR VI P] ALLVAR ***
133 REM 
134 ; FNRubrik$ CUR(8%,12%) DBLE RED "ST[NG EJ !!"
135 ; : ; : ; 
136 ; TAB(10%) CYA "TANKEARBETE P]G]R !!"
137 ! 
138 ! *** B\RJAR P] NOLL ? ***
139 ! 
140 FOR I%=0% TO A% : S%=1%
141   S$=MID$(A$(I%),S%,1%) : IF S$=" " S%=S%+1% : GOTO 141
142   F2%(INSTR(1%,A$,S$))=0%
143 NEXT I% 
144 REM 
145 REM *** PR\VANDET KAN B\RJA ***
146 REM 
147 REM A%=ANTAL RADER    L%=L[NGDEN
148 REM M%=ANTAL TECKEN   C%(-)=CARRY
149 REM A%(-)=TECKNET     A$=TECKENRAD
150 REM B%(X,Y)=TECKNET P] RAD,PLATS
151 REM F%(-) ANGER IFALL KONTROLL
152 REM F1%(-) RADEN KONTROLLERAD
153 REM F2%(-) IFALL F\RSTA TECKNET
154 REM 
155 FOR I%=0% TO A% : FOR J%=1% TO L% : B%(I%,J%)=B%(I%,J%) AND 16% : NEXT J% : NEXT I% 
156 A1%=1% : A1$="" : C%(1%)=-32768% : C%(L%+1%)=16% : F1%(0%)=1%
157 B%=F2%(A1%)
158 S$=MID$(A$,A1%,1%)
159 A1$=LEFT$(A1$,A1%-1%) : B%=B%+1%
160 IF B%>9% THEN IF A1%<>1% THEN GOSUB 242 : GOTO 158 ELSE 193
161 IF INSTR(1%,A1$,NUM$(B%)) THEN 159
162 A1$=A1$+NUM$(B%) : A%(A1%)=B%
163 FOR I%=0% TO A% : S%=1%
164   S%=INSTR(S%,A$(I%),S$) : IF S% THEN B%(I%,S%)=B%+16% : S%=S%+1% : GOTO 164
165 NEXT I% 
166 IF F%(A1%)=0% THEN 169 ! TEST BEH\VS INTE
167 IF FNKontroll% THEN 159
168 IF SYS(5%) THEN GET Skr$ : IF ASCII(Skr$)=199% OR ASCII(Skr$)=231% THEN 200
169 A1%=A1%+1% : IF A1%<=M% THEN 157
170 REM 
171 REM ** [N L\SNING HAR HITTATS **
172 REM 
173 F%=F%+1% : S%=9%-L%/2%
174 IF F%<>1% THEN 177
175 FOR I%=1% TO 400% : Skr%=INP(5%)+2 : NEXT I% 
176 GOSUB 254 : ; CUR(9%+A%,0%) : GOTO 182
177 ; CUR(7%+A%,0%) GRN "Tryck p}" WHT "RETURN" GRN "f|r l|sning nr:" F%;
178 IF SYS(5%) THEN GET Skr$
179 GET Skr$
180 IF ASCII(Skr$)=231% OR ASCII(Skr$)=199% THEN 207
181 ; : ; : ; 
182 FOR I%=1% TO M% : ; MID$(A$,I%,1%) "=" A%(I%) "   "; : NEXT I% 
183 FOR I%=0% TO A% : ; CUR(I%+3%,19%+S%) YEL;
184   IF I%=A% THEN ; CHR$(8%,32%) STRING$(L%,45%) : ; CUR(I%+4%,19%+S%) YEL;
185   FOR J%=1% TO L%
186     ; MID$(" "+A1$,INSTR(1%,A$,MID$(In$(I%),J%,1%))+1%,1%);
187   NEXT J% 
188 NEXT I% 
189 A1%=M% : GOSUB 242 : GOTO 158
190 REM 
191 REM *** DET VAR ALLA L\SNINGARNA ***
192 REM 
193 IF F%<>0% THEN 199
194 GOSUB 253
195 ; : ; 
196 ; YEL "Till detta problem finns det inga"
197 ; YEL "l|sningar !!!"
198 GOTO 200
199 ; CUR(20%,0%) CYA "Det finns inga andra l|sningar."
200 ; CUR(22%,0%) CHR$(7%);
201 ON ERROR GOTO 213
202 INPUT " Tryck p} RETURN f|r n{sta problem:";A$
203 GOTO 46 ! n{sta problem
204 REM 
205 REM *** SLUT ***
206 REM 
207 ON ERROR GOTO 209
208 CHAIN Meny$
209 END 
210 REM 
211 REM *** ERROR ***
212 REM 
213 IF ERRCODE<>53% THEN 216
214 Skr%=SYS(6%) : GET Skr$
215 IF ASCII(Skr$)=231% RESUME 207
216 ; CHR$(7%,13%);
217 RESUME 
218 REM 
219 REM *** ERRORMEDDELANDENA ***
220 REM 
221 ; RED "DET D[R F\RSTOD JAG INTE !"
222 GOTO 237
223 ; RED "F|r l}ng rad"
224 GOTO 237
225 ; RED "H|gst 9 additioner stod det i reglerna!"
226 GOTO 234
227 ; RED "N}gon operand fattas!"
228 GOTO 234
229 ; RED "Summan kan ej ha endast" LEN(In$(A%)) "siffror!"
230 GOTO 234
231 ; 
232 ; RED "En siffra kan ej ha tv} tecken"
233 ! 
234 ; CHR$(7%) CYA "Om vi skulle f|rs|ka p} nytt:"
235 ; : ; 
236 GOTO 51
237 POKE 65363%,PEEK(65363%)-2% ! tv} steg upp}t
238 ; CHR$(7%); : GOTO 53
239 REM 
240 REM *** TILLBAKA ETT DRAG ***
241 REM 
242 A%(A1%)=0% : A1%=A1%-1%
243 FOR I%=0% TO A% : S%=1%
244   S%=INSTR(S%,A$(I%),S$) : IF S%=0% THEN 246 ELSE B%(I%,S%)=0%
245   C%(S%)=C%(S%) AND 65280% : C%(S%+1%)=C%(S%+1%) AND 255% : S%=S%+1% : GOTO 244
246 NEXT I% 
247 B%=A%(A1%)
248 FOR I%=1% TO L% : F1%(I%)=0% : NEXT I% 
249 RETURN 
250 REM 
251 REM *** SKRIVER UT PROBLEMET ***
252 REM 
253 S%=19%-L%/2%
254 ; CHR$(12%) MAG "PROBLEMET VAR F\LJANDE:"
255 ; : ; 
256 FOR I%=0% TO A%
257   IF I%=A% THEN ; TAB(S%+1%) STRING$(L%,45%)
258   ; TAB(S%) GRN In$(I%)
259 NEXT I% 
260 RETURN 
261 REM 
262 REM 
263 REM *** FUNKTIONERNA ***
264 REM 
265 DEF FNRubrik$=CHR$(12%)+DBLE+RED+SPACE$(12%)+"ALPHAMETICS" 
266 ! 
267 ! 
268 DEF FNKontroll%
269   FOR J%=L% TO 1% STEP -1%
270     IF F1%(J%) THEN 283
271     S%=0%
272     FOR I%=0% TO A%-1%
273     IF B%(I%,J%)=0% THEN 283 ELSE S%=S%+B%(I%,J%)-16% : NEXT I% 
274     IF B%(I%,J%)=0% THEN 283
275     S%=S%+(C%(J%+1%) AND 15%) : S1%=S%/10% : S%=MOD(S%,10%)
276     IF (C%(J%+1%) AND 255%) THEN IF S%<>B%(I%,J%)-16% THEN 288 ELSE 281
277     S2%=B%(I%,J%)-S%-16%
278     IF S2%<0% THEN S2%=S2%+10% : S1%=S1%+1%
279     IF S2%>=Maxc%(J%) THEN 288
280     C%(J%+1%)=SWAP%(S2%+128%)
281     IF C%(J%)<0% AND F1%(J%-1%) THEN IF (SWAP%(C%(J%)) AND 15%)<>S1% THEN 288
282     C%(J%)=S1% OR C%(J%) AND 65280% OR 16%
283   NEXT J% 
284   FOR J%=1% TO L% : IF F1%(J%) THEN 286
285     FOR I%=0% TO A% : IF B%(I%,J%) NEXT I% : F1%(J%)=1%
286   NEXT J% 
287   RETURN 0%
288   RETURN -1% ! FEL
289 FNEND 
290 ! 
291 ! 
292 DEF FNSort%(I%,J%) LOCAL I9%
293   X9%=LEN(A$(I%+J%/2%)) : I9%=I% : J9%=J%
294   WHILE LEN(A$(I9%))<X9% : I9%=I9%+1% : WEND 
295   WHILE LEN(A$(J9%))>X9% : J9%=J9%-1% : WEND 
296   IF I9%<=J9% THEN Skr$=A$(I9%) : A$(I9%)=A$(J9%) : A$(J9%)=Skr$ : I9%=I9%+1% : J9%=J9%-1%
297   IF I9%<J9% THEN 294
298   IF I%<J9% THEN Skr%=FNSort%(I%,J9%)
299   IF I9%<J% THEN Skr%=FNSort%(I9%,J%)
300   RETURN 0%
301 FNEND