home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.barnyard.co.uk
/
2015.02.ftp.barnyard.co.uk.tar
/
ftp.barnyard.co.uk
/
cpm
/
walnut-creek-CDROM
/
SIMTEL
/
CPMUG
/
CPMUG080.ARK
/
TARNSFER.STB
< prev
next >
Wrap
Text File
|
1984-04-29
|
3KB
|
89 lines
10 Rem Copyright 1981 by David E. Trachtenbarg
20 Dim Check'file$(13),Dictionary$(13),Word$(14),Root$(14),Suffix$(14)
30 Dim Suffixes$(20)
40 Integer I,Old,Found,Endings,Endings2
50 For I=0 To 6
60 Read Suffixes$(I*3,(I+1)*3-1)
70 Next I
80 Data"es","s","ed","d","ing","ly","y"
90 Dictionary$="DICTION.DAT"
100 Check'file$="CHECK.DAT"
110 On Esc Goto Ender
120 *Transfer
130 Kopen\1\Check'file$
140 Kopen\2\Dictionary$
150 Endings=0
160 On Error Goto 440
170 Kgetfwd\1\
180 Kretrieve\1\Word$(-1)
190 Kdel\1,Word$(-1)\
191 Gosub Check'for'old
192 If Old=1 Then 430
200 On Error Stop
210 Gosub Check'for'root
220 On Error Stop
230 If Found>0 Then Do
235 On Error Goto 285
240 Kgetkey\2,Root$(-1)\Endings
250 Endings=Binor(Endings,2^(Found-1))
260 Kupdate\2,Root$(-1)\Endings
270 @ Word$;Tab(20);"new ending added to ";Root$
280 Word$=Root$
285 On Error Stop
290 Else
320 If Word$(0,0)>="A" And Word$(0,0)<="Z" Then Do
330 Endings=Binor(Endings,2^14)
340 Word$(0,0)=Chr$(Asc(Word$(0,0))+32)
360 Enddo
365 Kadd\2,Word$(-1)\Endings
380 @ Word$;Tab(20);"added"
390 Gosub Check'endings
400 On Error Stop
410 Enddo
430 Goto 150
440 Close
450 Run"Menu.sav"
451 *Check'for'old
452 Old=0
453 On Error Goto 458
454 Kgetkey\2,Word$(-1)\
455 Old=1
456 @ Word$;Tab(20);"already in dictionary"
458 On Error Stop
459 Return
460 *Check'endings
470 For I=1 To 7
480 Suffix$=Word$+Suffixes$((I-1)*3,(I*3)-1)
490 On Error Goto 560
500 Kgetkey\2,Suffix$(-1)\Endings2
510 If Endings2<>0 Then Goto 560
520 Endings=Binor(Endings,2^(I-1))
530 Kdel\2,Suffix$(-1)\
540 Kupdate\2,Word$(-1)\Endings
550 @ Suffix$;Tab(20);"deleted"
560 On Error Stop
570 Next I
580 Return
590 *Check'for'root
600 Local I,J,K
610 I=Len(Word$)
620 Found=0 : K=0
630 Repeat
640 K=K+1
650 Suffix$=Suffixes$((K-1)*3,K*3-1)
660 J=Len(Suffix$)
670 If Word$(I-J,I-1)=Suffix$ Then Do
680 Root$=Word$(0,I-J-1)
690 On Error Goto 720
700 Kgetkey\2,Root$(-1)\Endings
710 Found=K
720 Enddo
730 On Error Stop
740 Until Found>0 Or K>=7
750 Return
760 *Ender
770 Close
780 End