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