-
Notifications
You must be signed in to change notification settings - Fork 1
/
M100LE.DO
295 lines (295 loc) · 10.6 KB
/
M100LE.DO
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
0 CLEAR 512
2 DIM HI$(5)
3 DIM SO$(6,5)
4 DIM UL$(6)
5 DIM DA(12)
7 DATA 31,28,31,30,31,30,31,31,30,31,30,31
8 FOR I = 1 TO 12: READ DA(I):NEXT I
9 YY=-1
10 '
16 ''MD=1 ' USE 1 TO MANUALLY ENTER DATE DEFAULT OF 0 USES SYSTEM DATE$
17 GOSUB 8000: 'SET DF$ (date format) TO "USA", "NEC", or "K85".
18 GOSUB 8100
19 RF=0
20 DB=0:VR$="v0.l": 'V UPDATE
21 WN=0
22 GOSUB 4000
23 VX=1: VY=1
24 CO$=AT$+CHR$(32+2)+CHR$(32+30)
26 DL=30:QL$="!@#$%^&*()": 'DELAY'
27 CC=1
28 SV=0
31 FOR I=1 TO 6
32 G$(I)=AT$+CHR$(32+I)+CHR$(32+1)
33 H$(I)=AT$+CHR$(32+I)+CHR$(32+7)
34 NEXT I
36 PX=14:PY=4
37 P1$=AT$+CHR$(32+PY) +CHR$(32+PX): A1$="ABCDEFGHIJKLM": 'ALPHABET BOARD
38 P2$=AT$+CHR$(32+PY+1)+CHR$(32+PX): A2$="NOPQRSTUVWXYZ"
39 FOR I=1 TO 6:FOR J=1 TO 5:SO$(I,J)=".":NEXT J:NEXT I
41 SCREEN 0,0
42 CLS
44 FOR I=1 TO 6
45 PRINT G$(I)"_____";: PRINT H$(I)".....";
46 NEXT I
48 VY=0:VX=16:GOSUB 4200:PRINT "-m100le-": PRINT P1$A1$;: PRINT P2$A2$;
49 VX=28:VY=1:GOSUB 4200:FOR VY=1 TO 6: PRINT"|";DN$;LT$;: NEXT VY
50 ON ERROR GOTO 9000
60 PRINT CV$;
65 WF$="": 'YEAR'S WORDLIST FILENAME
73 IF RF<>1 THEN DY=0
75 GN=1
78 TW$="":TM$="" 'TODAY'S WORD/TEMP WORD
79 N=0:I=0:R=0:C=0
82 GOSUB 8200
84 GOSUB 8300
410 GOSUB 6000
910 VX=1: VY=GN
920 GOSUB 4200
1000 '
1010 GOSUB 7000
1020 GOSUB 7100
1999 GOTO 1000
2000 '
2008 GOSUB 2100
2010 ID=PEEK(1)
2012 ' RD: RAM DIRECTORY ADDRESS. (Anderson's "Programming Tips" gives RD=63842 for M100/102 and 62034 for T200.)
2016 RD=-( 63842*(ID=51 OR ID=167) + 62034*(ID=171) + 63633*(ID=148) + 63849*(ID=225 OR ID=35 OR ID=125) )
2017 IF RD=0 THEN PRINT "Error: Unknown machine ID";ID;". Please file a bug report.": END
2018 IF RD=125 THEN PRINT "This is an M10 (USA)! Please file a bug report if this works or not.": FOR T=0 TO 1000: NEXT T
2020 FOR T1 = RD TO 65535 STEP 11
2029 ' Attribute flag: See Oppedahl's "Inside the TRS-80 Model 100" for details.
2030 FL=PEEK(T1)
2040 IF FL=255 THEN GOTO 2080
2045 IF (FL AND 128)=0 THEN NEXT T1
2050 WA=PEEK(T1+1)+256*PEEK(T1+2)
2060 FOR T2=1 TO 8: IF ASC(MID$(WL$,T2, 1)) <> PEEK(T1+2+T2) THEN NEXT T1: ELSE NEXT T2
2070 IF T2=9 THEN RETURN
2080 '
2085 ERROR 52
2090 WA=0: RETURN
2100 '
2101 REM E.g. "FOO.DO" -> "FOO DO"
2110 T1=INSTR(1,WL$,".")
2115 FN$=WL$:EX$=""
2120 IF T1>0 THEN FN$=MID$(WL$,1,T1-1): EX$=MID$(WL$,T1+1,2)
2130 IF LEN(FN$)>6 THEN PRINT "filename too long": STOP
2140 IF LEN(FN$)<6 THEN FN$=FN$+" ": GOTO 2140
2150 IF LEN(EX$)<2 THEN EX$=EX$+" ": GOTO 2150
2160 FN$=FN$+EX$: WL$=""
2170 FOR T1=1 TO 8
2172 T2=ASC(MID$(FN$,T1,1)): IF (T2>=ASC("a")) AND (T2<=ASC("z")) THEN T2=T2-32
2173 WL$=WL$+CHR$(T2)
2175 NEXT T1
2180 RETURN
3000 '
3010 CO$=AT$+CHR$(32+2)+CHR$(32+30)
3020 PRINT CO$;
3030 IF CC<=1 THEN PRINT "HMMM...";
3040 IF CC =2 THEN PRINT "OK...";
3050 IF CC =3 THEN PRINT "NICE";
3060 IF CC>=4 THEN PRINT "WELL DONE";
3090 FOR NQ=1 TO DL: NEXT NQ
3095 PRINT CO$;" ";
3099 RETURN
4000 '
4010 ES$=CHR$(27)
4020 AT$=ES$+"Y" ' Move cursor at
4030 RV$=ES$+"p" ' Reverse Video
4040 NV$=ES$+"q" ' Normal Video
4050 UP$=ES$+"A" ' Up 1 step
4060 DN$=ES$+"B" ' Down 1 step
4070 RT$=ES$+"C" ' Right 1 step
4080 LT$=ES$+"D" ' Left 1 step
4081 LT$=CHR$(8)
4090 CV$=ES$+"P" ' Cursor Visible
4095 CI$=ES$+"Q" ' Cursor Invisible
4120 UL$(0)=""
4130 FOR I=1 TO 6
4140 UL$(I)=UL$(I-1)+LT$
4150 NEXT I
4160 FOR I=1 TO 6
4170 UL$(I)=STRING$(I, "_")+UL$(I)
4180 NEXT I
4190 RETURN
4200 '
4210 PRINT AT$;CHR$(32+VY);CHR$(32+VX);
4220 RETURN
4400 '
4410 FOR QZ=1 TO INT(RND(1)*DL)+1:QR=INT(RND(1)*10)+1:PRINT MID$(QL$,QR,1);:FOR QI=1 TO 10:NEXT QI:PRINT LT$;" ";LT$;:NEXT QZ:RETURN
5000 '
5020 CLS:VX=16:VY=0:GOSUB 4200
5022 PRINT "-m100le-"
5024 VY=1: VX=40-LEN(WF$): GOSUB 4200: PRINT WF$;
5026 IF RF=1 THEN DY$=RIGHT$(STR$(DY), LEN(STR$(DY))-1): AD$=RIGHT$(STR$(Y), 2)+"/"+DY$
5027 VY=VY+1: VX=40-LEN(AD$): GOSUB 4200: PRINT AD$;
5028 VY=VY+1: VX=40-LEN(VR$): GOSUB 4200: PRINT VR$;
5029 VY=VY+1: VX=40-LEN(STR$(DY)): GOSUB 4200:PRINT DY;
5030 FOR I=1 TO 6: VX=13: VY=I
5035 GOSUB 4200: PRINT I;"- ";:FOR J=1 TO 5:PRINT SO$(I,J);:NEXT J: NEXT I
5038 IF WN=0 THEN GN=0
5040 VY=1: VX=25: GOSUB 4200
5045 PRINT RV$;GN: GOSUB 4200: PRINT RT$RT$;"/6 "NV$
5050 VX=1: VY=1: GOSUB 4200:PRINT "WORDLE FOR"
5060 VY=2: GOSUB 4200: PRINT "m100"
5100 K$=INKEY$: IF K$="" THEN GOTO 5100
5500 CLS
5510 VY=0:VX=16:GOSUB 4200
5520 PRINT "-m100le-"
5560 SV=1:GOTO 8910
6000 '
6002 VY=1: VX=32: GOSUB 4200
6003 PRINT RV$ "LOADING" NV$;
6005 WL$=WF$
6009 ' Search directory for "WL20xx.CO", set WA to its address in RAM.
6010 GOSUB 2000
6015 IF WA=0 THEN PRINT "Error: File '";WF$;"' File not found.": END
6016 GOSUB 4200: PRINT "LOADING";
6019 REM Set TW$ to today
6020 IF RIGHT$(WF$,2)="CO" THEN GOSUB 6100 ELSE GOSUB 6200
6065 GOSUB 4200: PRINT " ": VY=1: VX=40-LEN(STR$(DY)): GOSUB 4200: PRINT DY;: 'CLEAR LOADING TEXT, PRINT WORD SEQ. NUM
6067 IF DB=1 THEN TW$="HIPPY": 'OVERRIDE CURRENT WORD IF DB=1(DEBUG ON)'
6070 RETURN
6100 '
6110 X=WA+6+(DY-1)*3
6130 A=PEEK(X)+256*PEEK(X+1)+256*256*PEEK(X+2)
6140 FOR I=1 TO 5
6150 B=INT(A/26)
6160 TW$=TW$+CHR$(A-B*26+ASC("A"))
6170 A=B
6180 NEXT I
6190 RETURN
6200 '
6210 X=WA+(DY-1)*7
6230 FOR I=0 TO 4
6240 A=(PEEK(X+I) AND 95)
6250 TW$=TW$+CHR$(A)
6270 NEXT I
6290 RETURN
6990 GOTO 10000
7000 '
7010 K$ = INKEY$: IF K$="" GOTO 7010
7015 X=ASC(K$)
7020 IF X=8 OR X=13 OR X=21 THEN :K$="":RETURN: 'BKSP, ENTER, ^U. EXIT. NO MORE PROCESSING NEEDED'
7022 IF X<65 THEN K$="": 'FILTER FOR NON-LETTERS
7025 IF X>90 AND X<97 THEN K$=""
7026 IF X>122 THEN K$=""
7040 IF K$="" THEN GOTO 7010
7050 IF ASC(K$)>=97 THEN K$=CHR$(X-32)
7060 RETURN
7100 '
7105 IF X=8 THEN GOSUB 7200:RETURN
7107 IF X=13 THEN GOTO 7300
7108 IF X=21 THEN TM$="":GOSUB 7600:RETURN ' CTRL-U CLEAR INPUT
7150 IF LEN(TM$)=5 THEN TM$=LEFT$(TM$,4): PRINT LT$;
7160 PRINT K$;
7170 TM$=TM$+K$
7190 REM RETURN FROM ENTER CHECK AND UPDATE'
7195 RETURN
7200 '
7210 N=LEN(TM$)
7220 IF N>=1 THEN TM$=LEFT$(TM$,N-1) : ELSE RETURN
7230 PRINT LT$"_"LT$;
7290 RETURN
7300 '
7315 IF LEN(TM$)< 5 THEN GOTO 7000
7320 PRINT RT$;
7325 ''
7330 FOR I=1 TO 5: HI$(I)=".": SO$(GN,I)=".": NEXT I
7340 FOR I = 1 TO 5
7342 IF MID$(TM$,I,1) = MID$(TW$,I,1) THEN HI$(I) = MID$(TW$,I,1): SO$(GN,I) = "*" :CC=CC+1
7344 NEXT I
7346 FOR I = 1 TO 5
7348 IF SO$(GN,I)="*" THEN GOTO 7358: ' IF TEST CHARACTER HAS BEEN FOUND THEN MOVE ON TO NEXT I
7350 FOR J = 1 TO 5
7351 IF HI$(J)<>"." THEN GOTO 7356: ' IF FOUND FLAG FOUND, NEXT J
7353 IF MID$(TM$,J,1) = MID$(TW$,I,1) THEN HI$(J)="?":SO$(GN,J)="?":CC=CC+1: J=5 'MARK THE GUESS AND INCREMENT COMMENT VALUE'
7356 NEXT J
7358 NEXT I
7360 GOSUB 7400
7370 PRINT H$(GN);
7371 FOR I=1 TO 5:PRINT HI$(I);:NEXT I
7375 VX=1: VY=GN+1
7380 IF TM$=TW$ THEN FOR I=1 TO 100: NEXT I: WN=1: VX=15: VY=1: GOSUB 4400: GOSUB 4200: PRINT RV$ " CONGRATS! " NV$;: FOR I = 1 TO DL: NEXT I: GOTO 8900: 'WIN. SET WIN FLAGS'
7382 GOSUB 3000:CC=1
7384 IF WN=1 THEN GOTO 8900
7385 IF GN=6 THEN GOTO 8900
7390 GN=GN+1: TM$="":GOSUB 7600:GOTO 7190: 'RESET AND GET NEXT GUESS'
7400 '
7406 ' SO$(GN,I) is replacement symbol, "*" for right place, "?" for wrong place, "." for wrong letter.
7410 FOR I = 1 TO 5
7420 T=ASC(MID$(TM$,I,1))-64
7430 IF T<=13 THEN VY=PY : VX=PX-1+T: ELSE VY=PY+1: VX=PX-14+T
7440 GOSUB 4200
7450 PRINT SO$(GN,I);
7452 IF T<=13 THEN VY=VY-1:VX=PX-1+T:ELSE VY=VY+1: VX=PX-14+T
7453 GOSUB 4200
7455 IF SO$(GN,I)="*" THEN PRINT RV$;CHR$(T+64);NV$;
7456 IF SO$(GN,I)="?" THEN PRINT CHR$(T+64);
7460 NEXT I
7499 RETURN
7600 '
7610 GOSUB 4200
7620 PRINT G$(GN)TM$UL$(5-LEN(TM$));
7630 RETURN
7810 IF ID<>148 THEN PRINT @(VY*40+VX), "_____":PRINT @(VY*40+VX), TM$;: ELSE LOCATE VX,VY: PRINT "_____":LOCATE VX,VY: PRINT TM$;
7820 RETURN
7900 GOTO 10000
8000 '
8004 ' "NEC", "USA", or "K85"
8010 ID=PEEK(1)
8020 IF ID=148 THEN DF$="NEC": ELSE IF (ID=225 OR ID=35) THEN DF$="K85": ELSE DF$="USA"
8030 RETURN
8100 '
8110 IF AD$ = "" THEN AD$=DATE$
8120 IF MD<>1 THEN RETURN
8130 CLS
8140 PRINT "Input date as ";
8145 IF DF$="NEC" THEN PRINT "YY/MM/DD";:ELSE IF DF$="K85" THEN PRINT "DD/MM/YY";: ELSE PRINT "MM/DD/YY";
8150 PRINT " or YY/DAY or DAY"
8160 PRINT "hit ENTER for ";AD$: PRINT
8170 PRINT " DATE";
8180 INPUT "";AD$
8190 RETURN
8200 REM Set YY, two-digit year and DY, Ordinal ("Julian") day
8210 I=0: IX=0
8220 D(I)=VAL(MID$(AD$, IX+1, 15))
8230 IX=INSTR(IX+1, AD$, "/")
8240 IF IX<>0 THEN I=I+1:GOTO 8220
8250 IF I=0 THEN DY=D(0): CM=0: IF YY=-1 THEN IF DF$="NEC" THEN YY=VAL(LEFT$(DATE$, 2)): ELSE YY=VAL(RIGHT$(DATE$, 2))
8260 IF I=1 THEN YY=D(0): DY=D(1): CM=0
8270 IF I=2 AND DF$="NEC" THEN YY=D(0): CM=D(1): DY=D(2)
8280 IF I=2 AND DF$="K85" THEN YY=D(2): CM=D(1): DY=D(0)
8290 IF I=2 AND DF$="USA" THEN YY=D(2): CM=D(0): DY=D(1)
8295 YY=YY MOD 100
8298 RETURN
8300 '
8302 ' OUTPUT: DY is day of year (ordinal) Y is four digit year YY$ is 2 digit year (str) LP is 1 if Y is a leap year WF$ is "WL20yy.CO"
8310 IF CM>1 THEN: FOR I = 1 TO CM-1: DY=DY+DA(I): NEXT I
8320 Y=2000+YY
8330 LP=-( (Y MOD 4 = 0) AND ( (Y MOD 100 <> 0) OR (Y MOD 400 = 0) ) )
8340 IF CM>2 THEN DY=DY+LP
8350 IF DY<0 OR DY>365+LP THEN ERROR 6
8360 WF$="WL20"+RIGHT$(STR$(Y), 2)+".CO" '2-digit year
8370 VY=0: VX=40-LEN(WF$): GOSUB 4200: PRINT WF$;
8390 RETURN
8860 RETURN
8900 '
8903 PRINT CI$;
8905 IF GN>=6 AND WN<>1 THEN VX=16: VY=1: GOSUB 4400:GOSUB 4200: PRINT RV$ " SORRY! " NV$: 'CANADIAN 'EH?'
8910 IF SV=1 THEN CO$=AT$+CHR$(32+2)+CHR$(32+16)
8912 PRINT CO$;"[A]GAIN?":PRINT CO$DN$;"[R]ANDOM?":PRINT CO$DN$DN$;"[S]OCIAL?":PRINT CO$DN$DN$DN$;"[Q]UIT?";
8915 ''
8920 K$ = INKEY$: IF K$="" GOTO 8920
8925 IF K$="a" OR K$="A" THEN CLS:MD=1: GOTO 10: 'COMPLETE RESTART, ASK FOR DATE
8930 IF K$="r" OR K$="R" THEN CLS: RF=1:RT=VAL(RIGHT$(TIME$,2)): FOR I=1 TO RT:DY=FIX(RND(RT)*(365+LP)):NEXT I: DY$=RIGHT$(STR$(DY), LEN(STR$(DY))-1): AD$=RIGHT$(STR$(Y), 2)+"/"+DY$: MD=0: GOTO 20
8935 IF K$="s" OR K$="S" THEN GOTO 5000: 'GOTO SOCIAL THEN END
8938 IF K$="q" OR K$="Q" THEN MENU
8940 PRINT CO$LT$LT$;" ":PRINT CO$DN$;" ":PRINT CO$DN$DN$;" ":PRINT CO$;"ENDING...";:FOR I = 1 TO DL: NEXT I: CLS: END
9000 '
9010 IF ERR=52 THEN CLS: PRINT "PROGAM STOP": PRINT "DATA FILE NOT FOUND (";WF$")": GOTO 9900
9020 IF ERR=6 THEN CLS: PRINT"PROGRAM STOP": PRINT "DATE OUT OF RANGE (";AD$")": GOTO 9900
9900 VX=30: VY=1: GOSUB 4200: PRINT RV$ ERR;"-";ERL NV$
9910 PRINT"Error"; ERR ;"in line"; ERL
9999 ERROR ERR
10000 PRINT "ERROR - YOU SHOULD NOT HAVE GOTTEN SO FAR":STOP