M100LE+comments.DO

0 CLEAR 512
2 DIM HI$(5)   'CURRENT HINT SYMBOLS
3 DIM SO$(6,5) 'Social, alphabet symbols
4 DIM UL$(6):  'Backspace+Underline
5 DIM DA(12):  'DAYS IN A MONTH ARRAY
6 'LOAD NUMBER OF DAYS FOR EACH MONTH INTO THE ARRAY DA()
7 DATA 31,28,31,30,31,30,31,31,30,31,30,31: 'DAYS IN EACH MONTH
8 FOR I = 1 TO 12: READ DA(I):NEXT I: 'POPULATE ARRAY'
9 YY=-1	       'Year starts unset
10 'WORDLE FOR TRS-80 MODEL 100, KYOCERA 85, NEC 8201-8400, OLIVETTI M10
13 'SMALL VERSIONS AND SUPPORTING FILES
14 'AT : https://github.com/bgri/m100LE
15 '
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: 'SET AD$ TO DATE$ IF MD=0; ASK FOR DATE INPUT WHEN MD=1.
19 RF=0: ' RANDOM FLAG
20 DB=0:VR$="v0.l": 'V UPDATE
21 WN=0: 'RESET WON FLAG
22 GOSUB 4000: ' Define VT52 movement strings (AT$, RV$, NV$, LT$, etc)
23 VX=1: VY=1  'CURSOR
24 CO$=AT$+CHR$(32+2)+CHR$(32+30) 'COMMENTS
26 DL=30:QL$="!@#$%^&*()": 'DELAY'
27 CC=1:   'WITTY COMMENT VALUE
28 SV=0:   'SOCIAL SCREEN VIEWED? BOOL
29 '
30 'Row positions for guesses and hints
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
35 ' Alphabet position
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
40 'SET UP SCREEN
41 SCREEN 0,0       ' Hide F-key labels
42 CLS:		' WORD AND RESULT BOXES
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: 'ERROR HANDLING'
60 PRINT CV$;: 'MAKE CURSOR VISIBLE
65 WF$="":     'YEAR'S WORDLIST FILENAME
70 '
73 IF RF<>1 THEN DY=0: 'DAYS FROM THE START OF THE YEAR'
75 GN=1: 'GUESS ATTEMPT NUMBER
78 TW$="":TM$="" 'TODAY'S WORD/TEMP WORD
79 N=0:I=0:R=0:C=0: 'LOCAL VARIABLES
80 '
82 GOSUB 8200: 'SET YY, CM, DY
84 GOSUB 8300: 'LOAD THE DATE/DAY/NUMBER & YEAR FOR WORDFILE (WF$)
90 ' RESERVED LINE NUMBERS FOR FUTURE FEATURES
100 '
299 '
300 'LOAD PLAYER STATS
400 'LOAD WORD LIST
410 GOSUB 6000: 'LOAD WORD FILE AND GET TODAY'S WORD (TW$)
500 '
900 'POSITION CURSOR BEFORE MAIN LOOP
910 VX=1: VY=GN
920 GOSUB 4200
999 '
1000 'MAIN LOOP
1010 GOSUB 7000: 'GET KEYBOARD INPUT
1015 '
1020 GOSUB 7100: 'PROCESS KEYBOARD INPUT
1999 GOTO 1000
2000 REM RNDACC subroutine
2001 REM Input: WL$ is file to locate.
2002 REM Output: WA is address in RAM.
2003 REM Temp: ID, RD, FL, FN$, T1, T2
2004 REM
2005 REM Warning: Run CLEAR at start of program or this will return an invalid address.
2006 REM
2007 ' Normalize WL$ to 8 chars, no dot
2008 GOSUB 2100
2009 'HW ID 51=M100, 171=T200, 167=T102,           148=NEC,  225=K85,                       35=M10 (Italy), 125=M10 (US)
2010 ID=PEEK(1)
2012 ' RD: RAM DIRECTORY ADDRESS. (Anderson's "Programming Tips" gives RD=63842 for M100/102 and 62034 for T200.)
2013 ' (Gary Weber's NEC.MAP gives RD=63567, but we can skip the system files by starting at 63633.)
2014 ' (Hackerb9 found K85 and M10 (with ROM ID=35) as having RD=63849)
2015 ' (Note: Strangely, the Italian-language Olivetti M10 manual says 63841, which is wrong. Perhaps that is for a different regional ROM, such as ID=125?)
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
2019 ' Search directory for WL$ (characters are in IW() for speed) 
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)
2039 ' Stop at end of directory (255)
2040 IF FL=255 THEN GOTO 2080
2044 ' Skip invalid files
2045 IF (FL AND 128)=0 THEN NEXT T1
2049 ' WA is file address in memory
2050 WA=PEEK(T1+1)+256*PEEK(T1+2)
2059 ' Filename matches WL$?
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: ' Found at address WA
2080 REM File not found
2085 ERROR 52: ' Raise FILE NOT FOUND
2090 WA=0: RETURN
2100 REM Normalize filename to 8 chars
2101 REM E.g. "FOO.DO" -> "FOO   DO"
2102 REM INPUT & OUTPUT: WL$
2103 REM Temp: T1, T2, FN$, EX$
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
2999 '
3000 'WITTY COMMENTS
3009 ' COMMENT DISPLAY LOCATION
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
3999 '
4000 REM VT52 CURSOR MOVEMENT
4001 ' IN: None, OUT: Strings defined
4002 ' AT$ positions cursor at X, Y.
4003 ' Usage: ?AT$CHR$(32+X)CHR$(32+Y);
4004 ' UP$ DN$ RT$ LT$ move 1 step.
4005 ' RV$ NV$ reverse/normal video.
4006 '
4010 ES$=CHR$(27)   ' Escape char
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)    ' Shortcut for Left
4090 CV$=ES$+"P"    ' Cursor Visible
4095 CI$=ES$+"Q"    ' Cursor Invisible
4100 ' Optimize printing n underlines
4101 ' followed by n backspaces.
4120 UL$(0)=""
4129 ' First build up the move-lefts.
4130 FOR I=1 TO 6
4140 UL$(I)=UL$(I-1)+LT$
4150 NEXT I
4160 FOR I=1 TO 6
4169 ' Second prepend the underlines.
4170 UL$(I)=STRING$(I, "_")+UL$(I)
4180 NEXT I
4190 RETURN
4199 '
4200 REM Position cursor at VX, VY
4201 '  IN: 0<=VX<=39, 0<=VY<=7.
4202 ' OUT: NONE
4203 ' (On Tandy 200, VY<=15.)
4210 PRINT AT$;CHR$(32+VY);CHR$(32+VX);
4220 RETURN
4400 'PAUSE
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
4999 '
5000 'SOCIAL
5010 '
5020 CLS:VX=16:VY=0:GOSUB 4200 'MVCURS
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 '
6001 'LOAD WORD OF THE DAY
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's word from either compressed .CO or ASCII .DO file.
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
6099 '
6100 REM READ WORD FROM BINARY .CO FILE
6101 ' INPUT: WA is address of file,                  DY is day of the year
6102 ' OUTPUT: TW$ is today's word
6103 ' TEMP: A, B, X, I
6110 X=WA+6+(DY-1)*3
6129 ' In: Three Base-256 digits
6130 A=PEEK(X)+256*PEEK(X+1)+256*256*PEEK(X+2)
6139 ' Out: Five Base-26 letters
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
6199 '
6200 REM READ WORD FROM ASCII .DO FILE
6201 ' INPUT: WA is address of file,                   DY is day of the year
6202 ' OUTPUT: TW$ is today's word
6203 ' TEMP: A, B, X, I
6209 ' 7 bytes per word (5 chars + CRLF)
6210 X=WA+(DY-1)*7
6229 ' Read five ASCII chars
6230 FOR I=0 TO 4
6240 A=(PEEK(X+I) AND 95) ' CAPITALIZE
6250 TW$=TW$+CHR$(A)
6270 NEXT I
6290 RETURN
6990 GOTO 10000: 'WENT TOO FAR -- abort, abort.
7000 '
7001 'GET KEYBOARD INPUT
7002 '
7005 'N=LEN(TM$) ' vestigial
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): 'CONVERT LC TO UC
7060 RETURN
7070 '
7100 ' PROCESS KEYBOARD INPUT (K$ AND X)
7105 IF X=8 THEN GOSUB 7200:RETURN' BKSP
7107 IF X=13 THEN GOTO 7300: ' ENTER KEY
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$; 'TRIM TO 4 CHARACTERS, BKSP
7160 PRINT K$;
7170 TM$=TM$+K$: 'POPULATE TEMPWORD'
7180 '
7190 REM RETURN FROM ENTER CHECK AND UPDATE' DON'T DELETE ME
7195 RETURN
7199 '
7200 'PROCESS BACKSPACE'
7210 N=LEN(TM$)
7219 ' Remove last letter
7220 IF N>=1 THEN TM$=LEFT$(TM$,N-1)               : ELSE RETURN
7229 ' Use BKSP to overwrite the letter.
7230 PRINT LT$"_"LT$;
7290 RETURN
7299 '
7300 'PROCESS ENTER KEY. THIS CAME FROM A GOTO IN LINE 7107
7301 'UPDATE HINTS AND ALPHABET SCREEN
7302 'AND IF WORD MATCHES GOTO WIN
7310 '
7315 IF LEN(TM$)< 5 THEN GOTO 7000: 'WORD IS TOO SHORT, GET OUT!'
7320 PRINT RT$;  ' Subtle feedback that ENTER was heard.
7325 ''
7329 'RESET MARKERS HI$ & SO$ TO .....'
7330 FOR I=1 TO 5: HI$(I)=".": SO$(GN,I)=".": NEXT I
7334 '==== PROCESS THE GUESS ===='
7339 'TEST CHARACTER EXACT MATCH
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: 'TEST CHARACTER SOURCE - LETTERS 1 - 5 W1-W5
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: 'GUESS TEST - COMPARE G1 VS W1, G2 VS W1...
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: 'UPDATE ALPHABET BOARD
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: 'GET COMMENTS AND RESET COMMENT INCREMENT
7384 IF WN=1 THEN GOTO 8900: 'GO TO WIN SCREEN'
7385 IF GN=6 THEN GOTO 8900
7390 GN=GN+1: TM$="":GOSUB 7600:GOTO 7190: 'RESET AND GET NEXT GUESS'
7399 '
7400 ' UPDATE ALPHABET BOARD
7401 ' IN: TM$: the word guessed.
7402 '     GN: guess number
7403 '     SO$(GN,I): symbols to draw
7404 ' OUT: None
7405 ' For each letter (I) in TM$,
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
7429 ' Place cursor in alphabet
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);
7451 ' move clue letter above/below alphabet board
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
7599 '
7600 'REDRAW WORD, POSITION CURSOR
7601 ' Speed test x100 = 6 seconds
7610 GOSUB 4200
7620 PRINT G$(GN)TM$UL$(5-LEN(TM$));
7630 RETURN
7699 '
7800 'REDRAW using PRINT @ / LOCATE
7801 ' Speed test x100 = 6 seconds
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
7999 'SMALL ROUTINES
8000 REM Detect machine platform.
8001 ' INPUT: None
8002 ' OUTPUT: ID is PEEK(1) and 
8003 '         DF$ is date format.
8004 '         "NEC", "USA", or "K85"
8005 '      YY/MM/DD, MM/DD/YY, DD/MM/YY
8006 '
8009 'Use ID to determine date format
8010 ID=PEEK(1)
8011 '  51=M100, 167=T102, 171=T200 (US)
8012 ' 125=Olivetti US M10 (?MM/DD/YY?)
8013 ' 148=NEC (YY/MM/DD)
8014 ' 225=K85, 35=M10 (DD/MM/YY)
8020 IF ID=148 THEN DF$="NEC":          ELSE IF (ID=225 OR ID=35) THEN DF$="K85":                         ELSE DF$="USA"
8030 RETURN
8099 '
8100 REM MANUAL DATE ENTRY. MD=1 TO ENABLE MANUAL DATE ENTRY. AD$=ALTERNATE DATE
8101 'Note: AD$ may already be set from a previous game.
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";
8179 'Don't use LINE INPUT as it changes AD$ on ENTER key.
8180 INPUT "";AD$
8190 RETURN
8199 '
8200 REM Set YY, two-digit year and                  DY, Ordinal ("Julian") day
8201 ' IN: AD$ is YY/MM/DD (NEC)                       or MM/DD/YY (US)                        or DD/MM/YY (K85)
8202 '         or YY/ddd
8203 '         or ddd  (ordinal day #)
8204 ' OUT: DY is ordinal day (1 to 366)
8205 '      YY is two-digit year. 
8207 ' TEMP: IX, I, D(I)
8208 '
8209 ' Count number of slashes and split values into d()
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
8249 ' No slashes in input: Ordinal day.
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))
8259 ' One slash. Year / Ordinal day.
8260 IF I=1 THEN YY=D(0): DY=D(1): CM=0
8269 ' Two slashes and NEC: YY/MM/DD
8270 IF I=2 AND DF$="NEC" THEN               YY=D(0): CM=D(1): DY=D(2)
8279 ' Two slashes and K85: DD/MM/YY
8280 IF I=2 AND DF$="K85" THEN               YY=D(2): CM=D(1): DY=D(0)
8289 ' Two slashes and USA: MM/DD/YY
8290 IF I=2 AND DF$="USA" THEN               YY=D(2): CM=D(0): DY=D(1)
8295 YY=YY MOD 100 ' Ignore century
8298 RETURN
8299 '
8300 REM CALCULATE DAY (#) OF THE YEAR
8301 ' INPUT: YY (2 digit year),                      CM (current month),                     DY (day of month, day of year if CM==0)
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"
8309 'LOOP MONTH # OF TIMES - 1: 'ADD DAYS FROM EACH MONTH PREVIOUS: 'ADD DAYS OF CURRENT MONTH
8310 IF CM>1 THEN: FOR I = 1 TO CM-1: DY=DY+DA(I): NEXT I
8320 Y=2000+YY: 'FOUR DIGIT YEAR
8330 LP=-( (Y MOD 4 = 0) AND ( (Y MOD 100 <> 0) OR (Y MOD 400 = 0) ) ): ' LP is 1 in leap years, 0 otherwise.
8339 ' If month is past February, leap.
8340 IF CM>2 THEN DY=DY+LP
8350 IF DY<0 OR DY>365+LP THEN ERROR 6: ' Overflow error if DY is not in the calendar.
8359 ' CREATE THE WORDLIST FILENAME
8360 WF$="WL20"+RIGHT$(STR$(Y), 2)+".CO" '2-digit year
8370 VY=0: VX=40-LEN(WF$): GOSUB 4200: PRINT WF$;
8390 RETURN
8399 '
8800 'DEBUG ROUTINES
8860 RETURN
8900 'WIN OR FAIL AFTER 6 GUESSES
8903 PRINT CI$;: 'HIDE CURSOR
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 'ERROR HANDLING'
9009 'FILE NOT FOUND
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