10 DEFFNS="LPenSp" 20 MODE7:VDU23;8202;0;0;0; 30 W%=10:REM WORD TO COPY 40 G%=14:REM WORD SO FAR 50 S%=18:REM ALPHABET 60 H%=5:REM LINE SO FAR 70 B%=96:*FX202 48 80 J%=0 90 K%=50:REM MAXIMUM AND INITIAL NUMBER OF WORDS 100 T%=0 110 Q%=0 120 R%=0 130 DIM E$(K%) 140 FORL%=1TOK% 150 E$(L%)="*" 160 NEXT 170 PROCsetup 180 ONERROR:VDU0 190 PROCtitles 200 REPEAT 210 REPEAT 220 *FX21 230 A$=GET$ 240 IFA$="1"PROCInfo:PROCtitles 250 IFA$="4"PROCcreate:PROCtitles 260 IFA$="5"PROCoptions:PROCtitles 270 IFA$="6":OSCLI"FX202 32":END 280 UNTILINSTR("23",A$) 290 D%=VAL(A$) 300 IFD%=2 OR D%=3 PROCmain 310 UNTILFALSE 320 DEFPROCtitles 330 CLS 340 PRINT 350 PROCc("Light Pen Spelling.") 360 PROCc("Light Pen Spelling.") 370 PRINT 380 PROCc("By C.J.Richardson.") 390 PRINT 400 PROCc("Please Enter Your Choice 1-6") 410 PRINT''"1. Info. " 420 PRINT"2. Start using DATA in program. " 430 PRINT"3. Start using file from disc. " 440 PRINT"4. Edit/Add/View words on disc. " 450 PRINT"5. Options. " 460 PRINT"6. End. " 470 A$="" 480 ENDPROC 490 DEFPROCoptions 500 REPEAT 510 CLS 520 PRINT 530 PROCc("Options.") 540 PROCc("Options.") 550 PRINT 560 PROCc("Please Enter Your Choice 1-8") 570 PRINT''TAB(5)"1.Timing"; 580 IFT%=0 PRINT"off." ELSE IF T%=1 PRINT"on." 590 PRINTTAB(5)"2.Prompt stays"; 600 IFQ%<>0 PRINT"for ";STR$(Q%);" sec" 610 PRINTTAB(5)"3."; 620 IFR%=0 PRINT"Normal"; 630 IFR%=1 PRINT"Scrambled"; 640 PRINT"prompt." 650 PRINTTAB(5)"4.Force UPPER case." 660 PRINTTAB(5)"5.Force lower case." 670 PRINTTAB(5)"6.Set light pen offset." 680 PRINTTAB(5)"7.Set number of words used." 690 PRINTTAB(5)"8.Return to main menu." 700 REPEAT 710 *FX21 720 A$=GET$ 730 UNTILINSTR("12345678",A$) 740 IFA$="1"T%=1 EOR T% 750 IFA$="2"PRINTTAB(0,15);"Enter delay in secondsbefore prompt"'"disappears";:INPUT"";Q% 760 IFA$="3"R%=1 EOR R% 770 IFA$="4"B%=64 780 IFA$="5"B%=96 790 IFA$="6"PRINT''"Enter light pen offset (-1 0 1)":INPUT"";J% 800 IFA$="7"REPEAT:PRINT''"Enter number of words used."'"Presently ";STR$(K%-1);". Maximum 49.":INPUT"";K%:K%=K%+1:UNTILK%>1 AND K%<51:E$(K%)="*" 810 UNTILA$="8" 820 ENDPROC 830 DEFPROCc(A$) 840 PRINTTAB(20-LEN(A$)/2);A$ 850 ENDPROC 860 DEFPROCresetscreen 870 VDU12,30:FORL%=1TO23:VDU135,157,133,10,13:NEXT:VDU135,157,133 880 ENDPROC 890 DEFPROCscreen 900 PROCresetscreen 910 VDU31,7,S%,ASC"",10,8,ASC"",11,9 920 FORL%=B%+1 TO B%+13 930 VDUL%,10,8,L%,11,9 940 NEXT 950 VDU31,7,S%+2,ASC"",10,8,ASC"",11,9 960 FORL%=B%+14 TO B%+26 970 VDUL%,10,8,L%,11,9 980 NEXT 990 ENDPROC 1000 DEFPROCloadin(B$) 1010 REPEAT 1020 CLS 1030 *. 1040 PRINT 1050 PROCc(B$) 1060 INPUT'""F$ 1070 UNTILF$<>"" 1080 F%=OPENIN(F$) 1090 L%=0 1100 REPEAT 1110 L%=L%+1 1120 INPUT#F%,E$(L%) 1130 UNTILE$(L%)="*" 1140 CLOSE#F% 1150 E$(K%)="*" 1160 ENDPROC 1170 DEFPROCcreate 1180 REPEAT 1190 CLS 1200 PROCc("Maintenance Menu.") 1210 PROCc("Maintenance Menu.") 1220 PRINT 1230 PROCc("Please Enter Your Choice 1-7") 1240 PRINT'TAB(5)"1.Start new word file." 1250 PRINTTAB(5)"2.Load word file from disc." 1260 PRINTTAB(5)"3.Load word file from DATA." 1270 PRINTTAB(5)"4.Examine word file in memory." 1280 PRINTTAB(5)"5.Alter word in memory." 1290 PRINTTAB(5)"6.Save word file in memory." 1300 PRINTTAB(5)"7.Return to main menu."' 1310 REPEAT 1320 A$=GET$ 1330 UNTILINSTR("1234567",A$) 1340 IFA$="1"PROCent 1350 IFA$="2"PROCloadin("Enter file name to load: ") 1360 IFA$="3"PROCgetdata 1370 IFA$="4"PROCexamine 1380 IFA$="5"PROCalter 1390 IFA$="6"PROCsave 1400 UNTIL A$="7" 1410 ENDPROC 1420 DEFPROCalter 1430 PRINT'' 1440 PROCc("Enter word number to alter: ") 1450 REPEAT 1460 INPUT'"";L% 1470 UNTILL%>0 AND L%122 OR N%>90 AND N%<97 M%=1 1880 IF A$="*" M%=0 1890 NEXT 1900 UNTIL M%=0 1910 E$(L%)=A$:L%=L%+1 1920 ENDPROC 1930 DEFPROCsave 1940 L%=0 1950 E$(K%)="*" 1960 REPEAT 1970 CLS 1980 *. 1990 PRINT 2000 PROCc("Enter File Name to Save by: ") 2010 INPUT'"";F$ 2020 UNTILF$<>"" 2030 F%=OPENOUT(F$) 2040 FORL%=1TOK% 2050 PRINT#F%,E$(L%) 2060 NEXT 2070 CLOSE#F% 2080 ENDPROC 2090 DEFPROCmain 2100 IFD%=3 PROCloadin("Enter file name to load: ") 2110 IFD%=2 PROCgetdata 2120 REPEAT 2130 F%=1 2140 PROCscreen 2150 X$="" 2160 TIME=0 2170 REPEAT 2180 W$="" 2190 N$=E$(F%) 2200 F%=F%+1 2210 IF N$="*":PROCfinished ELSE PROCanother 2220 UNTIL N$="*" 2230 UNTILFALSE 2240 ENDPROC 2250 DEFPROCgetdata 2260 REPEAT 2270 CLS 2280 PRINT''"Select block of words (1 to 30): " 2290 INPUT'"";V% 2300 UNTILV%>0 AND V%<31 2310 L%=V% 2320 RESTORE 2330 IF L%=1 PROCreadin:ENDPROC 2340 REPEAT 2350 READA$ 2360 IFA$="*":L%=L%-1 2370 UNTILL%=1 2380 PROCreadin 2390 ENDPROC 2400 DEFPROCreadin 2410 FORL%=1TOK% 2420 READ E$(L%) 2430 NEXT 2440 E$(K%)="*" 2450 ENDPROC 2460 DEFPROCanother 2470 FORL%=1TOLEN(N$) 2480 IF B%=64 W$=W$+(CHR$(ASC(MID$(N$,L%,1))AND &DF)) 2490 IF B%=96 W$=W$+(CHR$(ASC(MID$(N$,L%,1))OR B%)) 2500 NEXT 2510 G$="" 2520 Y$=W$ 2530 IF R%=1 PROCscramble 2540 PRINTTAB(20-(LEN(W$)/2),W%);"";Y$ 2550 PRINTTAB(20-(LEN(W$)/2),W%+1);"";Y$ 2560 IF Q%<>0:Z%=TIME:REPEATUNTILTIME=Z%+Q%*100:PRINTTAB(5,W%)SPC(30):PRINTTAB(5,W%+1)SPC(30) 2570 REPEAT 2580 C%=0 2590 IF B%=64:*FX202 32 2600 IF B%=96:*FX202 48 2610 PROCGetPos 2620 PROCCalcLetter 2630 IF C%=ASC(MID$(W$,LEN(G$)+1,1)) G$=G$+CHR$C%:SOUND1,-12,70,1:SOUND1,0,1,1 2640 PRINTTAB(20-(LEN(G$)/2),G%)"";G$ 2650 PRINTTAB(20-(LEN(G$)/2),G%+1)"";G$ 2660 UNTILG$=W$ 2670 PROCWellDone 2680 X$=X$+" "+W$ 2690 X$=RIGHT$(X$,35) 2700 X$=MID$(X$,INSTR(X$," "),LEN(X$)) 2710 PRINTTAB(3,H%);"";X$;SPC(35-LEN(X$));TAB(3,H%+1);"";X$;SPC(35-LEN(X$)); 2720 ENDPROC 2730 DEFPROCscramble 2740 IF LEN(W$)<>1 REPEAT:Y$=W$ 2750 V$="" 2760 FORL%=1TOLEN(Y$) 2770 REPEAT 2780 I%=RND(LEN(Y$)) 2790 T$=MID$(Y$,I%,1) 2800 UNTILT$<>" " 2810 V$=V$+MID$(Y$,I%,1) 2820 Y$=LEFT$(Y$,I%-1)+" "+MID$(Y$,I%+1) 2830 NEXT 2840 Y$=V$ 2850 IF LEN(W$)<>1 UNTILY$<>W$ 2860 ENDPROC 2870 DEFPROCWellDone 2880 SOUND1,-12,70,1:SOUND1,0,1,1 2890 PRINTTAB(5,W%)SPC(30) 2900 PRINTTAB(5,W%+1)SPC(30) 2910 PRINTTAB(5,G%)SPC(30) 2920 PRINTTAB(5,G%+1)SPC(30) 2930 ENDPROC 2940 DEFPROCGetPos 2950 A%=!&74 2960 A%=A%+J% 2970 X%=(A%-8)MOD40 2980 Y%=A%DIV40-255 2990 ENDPROC 3000 DEFPROCCalcLetter 3010 IF INKEY(0)=ASC(MID$(W$,LEN(G$)+1,1)):C%=ASC(MID$(W$,LEN(G$)+1,1)):OSCLI"FX21":ENDPROC 3020 IF X%<0 OR Y%<0 ENDPROC 3030 IF Y%=S% OR Y%=S%+1 C%=(X%-5)/2+B%:ENDPROC 3040 IF Y%=S%+4 OR Y%=S%+5 C%=(X%-5)/2+B%+13:ENDPROC 3050 C%=32 3060 ENDPROC 3070 DEFPROCsetup 3080 FORL%=0TO2 STEP 2 3090 P%=&900 3100 [:OPTL%:.i SEI 3110 LDA#f MOD256:STA&206:LDA#f DIV256:STA&207 3120 LDA#&88:STA&FE4E:CLI:RTS 3130 .f LDA&FC:PHA:TXA:PHA:TYA:PHA 3140 LDA&FE4D:AND#&88:CMP#&88:BNEout 3150 LDA&FE40:LDX#16:STX&FE00:INX 3160 LDA&FE01:CMP&71:STA&71 3170 BNEd:STX&FE00:LDA&FE01 3180 TAY:SBC&70:CLC:ADC#1:BMIe 3190 CMP#3:BCSe:STY&74:LDA&71 3200 STA&75:JMPout 3210 .d STX&FE00:LDY&FE01 3220 .e STY&70:LDA#0:STA&74:STA&75 3230 .out PLA:TAY:PLA:TAX:PLA:STA&FC:RTI:] 3240 NEXT 3250 !&70=0:!&74=0 3260 *FX20,1 3270 CALLi 3280 VDU12 3290 ENDPROC 3300 DEFPROCInfo 3310 CLS 3320 PRINT"This program allows you to use a light"'"pen or the keyboard to type in words."'"When using the light pen, point at the"'"alphabet at the bottom of the screen." 3330 PRINT"The target word appears half way down"'"the screen. The word being built"'"appears below that. The last few words"'"appear at the top of the screen."'"There are options that" 3340 PRINT"allow you to set the length of time"'"this target word stays visible and"'"to scramble the target word." 3350 PRINT"There is an option to time how long"'"it takes to work through a set of"'"words. There are 30 sets of 49 words in"'"the program. There is an option to load"'"a set of words from disc. There are" 3360 PRINT"facilities to create, view and edit"'"your own word files on disc."'"You can also force upper or lower case"'"throughout the program." 3370 PRINT"It is possible to change the light pen"'"offset if the timing is different." 3380 PRINT'"PRESS A KEY TO CONTINUE."; 3390 *FX21 3400 REPEATUNTILGET 3410 ENDPROC 3420 DEFPROCfinished 3430 PRINTTAB(15,1);"Well done!" 3440 PRINTTAB(7,2);"Hold light pen here or press" 3450 PRINTTAB(7,3);"the SPACE BAR to play again." 3460 IF T%=1 PROCtime 3470 REPEAT 3480 PROCGetPos 3490 UNTILY%=2 OR INKEY(0)=32 3500 ENDPROC 3510 DEFPROCtime 3520 PRINTTAB(15,12);"That took you:" 3530 U%=TIME/100 3540 PRINTTAB(10,14);STR$(U%DIV60);" Minutes ";STR$(U%MOD60);" Seconds" 3550 ENDPROC 10000 DATAcar,jam,can,sad,hat,sat,man,ran,rag,fat,wag,bad,mat,wax,van,leg,pet,get,hen,pen,red,wet,met,let,jet,men,fed,set,den,sit,hit,pig,dig,did,fix,kid,bit,fit,lip,mix,hid,win,lid,fox,rob,log,lot,hot,box,* 10010 DATAcot,job,fog,hop,mop,pop,sob,hop,rub,fun,but,cup,mum,bun,run,cub,cut,gum,hug,hut,sun,sum,cry,fly,sky,shy,fry,try,spy,my,dry,by,sty,sly,why,late,same,game,cake,make,cave,make,hate,page,take,wake,gate,lane,wave,* 10020 DATAfine,bite,hide,bike,kite,wide,wife,ice,pie,pine,pipe,mice,size,line,hope,nose,note,hole,rose,rope,joke,pole,toe,hoe,vote,poke,woke,home,rude,use,tune,tube,mule,huge,cube,duke,rule,cute,due,dad,bad,red,bin,nod,big,mud 10025 DATAbed,did,bat,* 10030 DATAcub,rob,dog,bib,add,odd,address,middle,puddle,paddle,wedding,muddle,sadder,gladder,riddle,saddle,fiddle,off,offer,puff,puffin,toffee,coffee,office,officer,effect,effort,stiff,stuff,stuffy,cliff,egg,buggy,bigger,hugged,mugger 10040 DATAtrigger,wagged,leggings,biggest,beggar,digger,doll,well,full,wall,ball,kill,fall,* 10050 DATApull,fill,pillow,windmill,swallow,balloon,shallow,kiss,miss,less,lesson,mess,grass,cross,fuss,guess,message,classroom,missile,missing,loss,quick,quack,quilt,quite,quiet,quarter,queen,question,quickly,quality,quarrel,quantity 10060 DATAthat,then,this,them,they,mother,brother,these,those,bother,leather,father,feather,breathe,moth,cloth,* 10070 DATAtooth,bath,path,think,thank,thing,mouth,south,truth,thief,birthday,thirty,chin,chips,chop,much,child,chick,chain,cheer,cheese,cheeky,beach,chilly,cherry,chimney,ship,shop,shed,wash,rush,wish,shot,shell,crash,brush,shout 10080 DATAsheep,show,shower,ring,sing,rang,song,lung,long,longer,thing,sting,* 10090 DATAbring,cling,singer,strong,belong,back,pick,tick,sick,lick,kick,suck,stuck,clock,black,ticket,jacket,packet,stocking,guess,guard,guide,guitar,guest,tongue,guilty,guarantee,league,knee,knife,know,knot,knit,knock,kneel,knew 10100 DATAknob,knitting,knight,knowledge,unknown,knives,walk,chalk,talk,stalk,yolk,folk,walking,* 10110 DATAlamb,dumb,thumb,bomb,comb,climb,crumb,limb,debt,doubt,bomber,climber,phone,photo,elephant,phantom,dolphin,alphabet,telephone,graph,photograph,geography,listen,fasten,castle,whistle,thistle,fastener,listening,when,which,what 10120 DATAwhite,why,whale,while,wheel,whip,whisper,whistle,whisker,wheat,write,wrist,writer,wrong,wrap,wren,wreath,* 10130 DATAwriting,wreck,wrapper,wriggle,wrestling,edge,badge,badger,bridge,fidget,hedge,judge,fudge,fridge,midget,knowledge,catch,patch,watch,match,matchbox,pitch,hutch,ditch,witch,watching,stitch,batch,snatch,stretch,old,hold,held,gold 10140 DATAgoldfish,sold,cold,told,child,golden,bold,fold,children,shoulder,lamp,damp,imp,camp,jump,* 10150 DATAjumper,bump,lump,pump,pumpkin,simple,company,computer,mumps,hand,land,sand,band,bend,pond,wind,pound,sandwich,window,bandage,mending,defend,standard,pink,bunk,tank,sink,wink,sunk,bank,drink,think,blink,shrink,thanks,tanker 10160 DATAtwinkle,bent,went,tent,sent,hunt,dent,dentist,pants,wanted,haunted,front,grunt,* 10170 DATAlantern,event,desk,ask,mask,risk,rusk,asked,tusk,task,risky,frisky,basket,whisker,last,test,fast,post,postman,cost,west,mister,master,mistake,poster,faster,toast,sister,pinch,punch,munch,bunch,branch,lunch,bench,ranch,crunch 10180 DATAblack,blob,bless,block,blow,blink,blunt,blanket,bloom,blackboard,blossom,blood,* 10190 DATAblue,blindfold,clap,class,clock,cloth,clothes,club,cliff,clay,climb,clown,cloud,claw,classroom,clothing,flat,fly,flag,flame,flower,flash,flap,floor,flock,flesh,flood,cornflakes,butterfly,flight,glad,gleam,glass,glasses 10200 DATAglove,glue,glow,glowing,glimpse,gleaming,glide,glory,globe,plate,plus,play,planet,plant,place,* 10210 DATAplastic,plan,platform,plum,please,plenty,playground,plaster,bring,brick,brush,brave,brown,brownie,brother,brook,bread,bridge,breath,branch,breakfast,brain,crab,crack,cry,cross,crossing,crash,crown,cracker,crayon,cream,crime 10220 DATAcrew,crowd,cricket,dry,drum,drop,drive,driver,drip,drag,dragon,dress,drink,drain,drawer,drawing,* 10230 DATAdream,frog,from,frost,front,fresh,friend,fry,frame,freezer,fright,frightened,freedom,fruit,friendship,grin,green,grape,grass,granny,grandad,grow,growl,great,gravy,greengrocer,ground,group,grape,prize,prince,princess,problem 10240 DATApretty,press,prison,price,produce,protect,promise,proper,present,project,trip,trick,truck,trap,tractor,train,* 10250 DATAtree,treat,track,traffic,tramp,treasure,truthful,troublesome,scale,scar,scarf,scare,scared,score,scout,scooter,escape,hopscotch,scales,telescope,skip,skin,sky,skate,ski,skeleton,skirt,skating,skill,skipping,skid,skimmed,slow 10260 DATAslip,sleep,asleep,sledge,slide,slippers,slice,slowly,slave,slippery,slept,sleeve,smile,smell,smoke,smooth,* 10270 DATAsmart,smack,small,smash,smiling,smelly,snip,snap,snug,snail,snake,snow,snowman,snowball,snowflake,snatch,spin,spade,spite,spider,spell,spelling,space,sparrow,spark,spotted,speed,spear,sport,spoon,stop,stone,step,stick,star 10280 DATAstamp,story,stairs,stable,start,stocking,stool,study,storm,swim,swimming,swam,swing,swop,* 10290 DATAsweet,sweep,switch,swear,sweat,sweater,swan,swallow,twins,twig,twist,twinkle,twenty,between,twelve,twice,scrap,scrape,scratch,scream,screen,screw,scrub,scribble,describe,scrambled,string,strong,street,stroke,strip,stripe,strange 10300 DATAstrike,stranger,stream,straw,strap,strawberry,stretch,three,thread,throat,throne,throw,thrown,thrush,threaten,aid,* 10310 DATAwait,aim,sail,nail,rain,paint,painting,faith,gaining,raining,raise,raisin,sailor,mountain,pause,cause,because,aunt,haunt,author,autumn,audience,sauce,saucer,sausage,cauliflower,automobile,haunted,saw,paw,raw,crawl,yawn,draw 10320 DATAdrawer,lawn,jaw,hawk,dawn,law,lawyer,drawing,hay,lay,day,gay,say,play,clay,* 10330 DATAtray,crayon,saying,player,payment,railway,mayor,meal,seal,team,steam,beach,heaven,weapon,wealthy,meadow,leather,beast,heater,peanut,season,tree,need,needle,queen,feet,feeling,speed,bleed,cheek,cheese,meeting,seesaw,speech,teeth 10340 DATAreindeer,receive,seize,ceiling,deceive,deceit,conceited,received,few,flew,grew,crew,stew,drew,* 10350 DATAnewt,news,newspaper,jewel,screw,threw,they,obey,eye,key,monkey,honey,money,turkey,chimney,valley,jersey,journey,hockey,donkey,field,friend,chief,believe,mischief,thief,niece,friendly,friendship,handkerchief,oak,boat,road,coat 10360 DATAsoap,coach,toad,broad,coal,coast,float,roast,oats,toadstool,oil,boil,noise,noisy,soil,* 10370 DATApoint,poison,avoid,toilet,voice,boiling,pointed,food,fool,school,book,look,blood,spoon,bloom,brook,scooter,tooth,toothbrush,wooden,moonlight,about,round,pound,soup,group,trouble,couple,shout,shoulder,country,cousin,count 10380 DATAhousehold,trousers,show,blow,throw,brown,cowboy,clown,power,brownie,crowd,crown,growth,knowledge,mower,crow,* 10390 DATAtoy,boy,joy,enjoy,annoy,royal,destroy,oyster,cowboy,enjoyment,dark,park,mark,garden,march,garage,parade,argument,darling,darkness,market,parcel,artist,harvest,her,term,person,jersey,perfume,herd,very,period,overalls,mineral 10400 DATAservice,servant,several,perfect,girl,bird,birth,first,third,stir,skirt,shirt,dirty,thirty,thirsty,* 10410 DATAthirteen,birthday,blackbird,fork,short,corn,corner,morning,sports,fort,fortune,horse,border,effort,torch,force,orchard,word,work,worm,world,worth,worker,password,worthless,worse,worst,burn,turn,turnip,nurse,purse,church,turkey 10420 DATAturtle,murder,purpose,purchase,surprise,surface,surrender,fair,fairy,chair,pair,stairs,upstairs,dairy,downstairs,* 10430 DATAunfair,hairy,care,scare,caretaker,rare,dare,spare,share,careful,nightmare,compare,beware,software,ear,fear,clear,appear,near,nearly,tear,rear,nearby,disappear,beard,pearl,early,learn,earth,search,heard,year,learning,hire,wire 10440 DATAfire,fireman,fireworks,bonfire,admire,tired,retired,sore,store,snore,score,more,wore,shore,* 10450 DATAtore,swore,before,forehead,our,sour,hour,court,poured,your,journey,courage,neighbour,fourteen,tourist,favour,favourite,neighbourhood,eight,weigh,neigh,neighbour,sleigh,weight,eighty,eighteen,neighbourhood,high,sigh,highway,right 10460 DATAnight,sight,light,lightning,highest,nightmare,midnight,fright,bright,knight,plough,dough,though,rough,tough,cough,thought,bought,* 10470 DATAbrought,doughnut,fought,although,along,asleep,alive,alike,again,across,ashamed,about,around,apart,aboard,above,afraid,agree,before,behind,become,begin,beginning,below,behave,because,beside,behaviour,between,beneath,believe 10480 DATAbeyond,beware,concrete,condition,contest,control,continent,consider,conquer,concert,conduct,conductor,container,connect,continue,constable,desert,depart,* 10490 DATAdesign,defeat,delay,describe,definite,defence,deserve,demand,department,development,description,destroy,distance,district,discover,discovery,disease,disagree,dismay,dismiss,dislike,disappear,disaster,disappointed,disgusting 10500 DATAextra,exact,example,excuse,exciting,experience,expect,expert,examination,exchange,excitement,exercise,expedition,experiment,forbid,forgive,forget,forgotten,forwards,fortune,forty,fortnight,forest,image,* 10510 DATAimagine,imp,important,importance,immense,improve,impossible,imagination,imitate,improvement,inside,insect,invisible,interest,inform,invader,instead,instant,information,industry,influence,instrument,index,perhaps,person,permit 10520 DATApermission,perfect,period,perfume,persuade,personal,present,prefer,prevent,pretend,prepare,president,precious,prescription,promise,problem,proper,property,protect,protection,project,progress,professor,* 10530 DATAprocess,procession,product,protest,programme,referee,rely,reward,report,record,result,return,religion,relief,relative,relation,regard,refrigerator,respect,refreshments,unless,until,unfair,unpack,undress,unhappy,untidy,undo 10540 DATAuncover,unwell,uncertain,unfriendly,unknown,unpleasant,capable,lovable,comfortable,probable,suitable,unsuitable,valuable,uncomfortable,reasonable,vegetable,animal,final,hospital,sandal,signal,* 10550 DATAnatural,metal,petal,canal,general,several,sugar,collar,cellar,beggar,similar,burglar,lunar,vinegar,shouted,mended,hated,tasted,counted,haunted,nodded,wicked,delighted,comforted,crowded,painted,visited,wounded,cried,fried,sailed 10560 DATAhugged,pulled,snowed,robbed,smiled,frowned,scrubbed,tired,worried,shared,married,hoped,hopped,licked,picked,sucked,mashed,dropped,*