Listing: 1 MODULE Test; 2 3 FROM ModBase3 IMPORT UpdateDBFile,WriteDBRec,DeleteRecord,ReadDBRec, 4 AppendBlank; 5 FROM Scrn2DBF IMPORT FrameToDBF, DBFToFrame; 6 FROM PosUtils IMPORT Equal; 7 FROM StrEdit IMPORT CrunchBlanks,DeleteRightJustified,CAPstr; 8 FROM M2Strings IMPORT Length; 9 FROM LowLevel IMPORT Fill; 10 FROM StringIO IMPORT PrintMessage; 11 FROM Drectory IMPORT SetDefaultDrive,ChDir,GetCurrentDir; 12 FROM EnvironUtils IMPORT ReadEnvironment; 13 FROM SmartScreen IMPORT ClearScreen; 14 FROM VWindows IMPORT ClearPart, CurrentWindow, SetCursorHeight; 15 FROM ScrnTypes IMPORT DisplayFrame,InitDisplayFrame,AFrameName; 16 FROM FramePainter IMPORT ShowDisplayFrame; 17 FROM InputManager IMPORT ControlFrame; 18 FROM FrameManager IMPORT EraseFrame; 19 FROM Prompts IMPORT Prompt,PromptStr; 20 FROM SYSTEM IMPORT ADR,SIZE; 21 FROM ControlUtils IMPORT ControlSeparately, LoadFrameList,Control; 22 FROM DspFiles IMPORT OpenDisplayFile,ReadDisplayFrame; 23 FROM HandleIO IMPORT FileExists; 24 FROM Prompts IMPORT Prompt; ***** ^ duplicate identifier ***** ^ duplicate identifier 25 FROM LowLevel IMPORT Fill; ***** ^ duplicate identifier ***** ^ duplicate identifier 26 FROM GenLists IMPORT GenList, NewList,ListLength,GetElmt; 27 FROM ScrnTypes IMPORT AFrameName, InitDisplayFrame,DisplayFile; ***** ^ duplicate identifier ***** ^ duplicate identifier ***** ^ duplicate identifier 28 FROM DBFTest IMPORT TestDBF, OpenTestDBF, 29 CloseTestDBF, 30 31 FindTestByTest, 32 NextTest,PrevTest,FirstTest,LastTest; 33 IMPORT InitCompilerMods; 34 35 36 VAR 37 Status : INTEGER; 38 Environ : ARRAY [0..60] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 39 J : CARDINAL; 40 TopMenu : GenList; 41 FirstTime: BOOLEAN; 42 NextFrame,EndingFrame : AFrameName; 43 SelChar : CHAR; 44 NoData : BOOLEAN; (* true when no data is on the screen *) 45 TestDF : DisplayFrame; 46 DSPFile : DisplayFile; 47 PullDnMenu : GenList; 48 49 50 PROCEDURE FileMenu(SelChar: CHAR); 51 VAR 52 B : BOOLEAN; 53 Str : ARRAY [0..80] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 54 BEGIN 55 CASE SelChar OF 56 'A' : ReadDisplayFrame(DSPFile,TestDF,'Test'); (*Clear out any of the fields *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 57 ShowDisplayFrame(TestDF,0,0,0,0); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 58 Control(TestDF); (* alow user input *) ***** ^ not supported yet ***** ^ not supported yet 59 AppendBlank(TestDBF); ***** ^ not supported yet ***** ^ not supported yet 60 B := FrameToDBF(TestDBF,TestDF); (* do something if couldn't add*) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 61 WriteDBRec(TestDBF); ***** ^ not supported yet ***** ^ not supported yet 62 |'F' : FirstTest(); ***** ^ not supported yet ***** ^ not supported yet 63 DBFToFrame(TestDBF,TestDF); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 64 ShowDisplayFrame(TestDF,0,0,0,0); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 65 |'L' : LastTest(); ***** ^ not supported yet ***** ^ not supported yet 66 DBFToFrame(TestDBF,TestDF); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 67 ShowDisplayFrame(TestDF,0,0,0,0); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 68 69 |'N' : IF NextTest() ***** ^ not supported yet ***** ^ not supported yet 70 THEN 71 DBFToFrame(TestDBF,TestDF); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 72 ShowDisplayFrame(TestDF,0,0,0,0); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 73 END; 74 75 |'P' : IF PrevTest() ***** ^ not supported yet ***** ^ not supported yet 76 THEN 77 DBFToFrame(TestDBF,TestDF); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 78 ShowDisplayFrame(TestDF,0,0,0,0); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 79 END; 80 81 82 |'T' : (* The first unused letter in the index name or 'Q' *) 83 Fill(ADR(Str),SIZE(Str),0); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 84 85 PromptStr('Enter Test Test ',Str); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 86 87 88 CrunchBlanks(Str); ***** ^ not supported yet ***** ^ not supported yet 89 IF NOT FindTestByTest(Str) ***** ^ not supported yet ***** ^ not supported yet 90 THEN 91 Prompt('Test Not Found'); ***** ^ not supported yet ***** ^ not supported yet 92 ELSE 93 DBFToFrame(TestDBF,TestDF); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 94 ShowDisplayFrame(TestDF,0,0,0,0); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 95 END; 96 END; (* end of case *) 97 END FileMenu; ***** ^ not supported yet 98 99 PROCEDURE EditMenu(SelChar : CHAR); 100 VAR 101 B:BOOLEAN; 102 BEGIN 103 CASE SelChar OF 104 'U' : Control(TestDF); ***** ^ not supported yet ***** ^ not supported yet 105 B:=FrameToDBF(TestDBF,TestDF); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 106 WriteDBRec(TestDBF); ***** ^ not supported yet ***** ^ not supported yet 107 |'D' : DeleteRecord(TestDBF); ***** ^ not supported yet ***** ^ not supported yet 108 NoData := TRUE; 109 END; 110 END EditMenu; ***** ^ not supported yet 111 112 113 BEGIN 114 115 (* if there is an environment variable set to m2test=path *) 116 (* the program will set the default drive and path *) 117 (* this is needed because running under the debuggers the *) 118 (* debugger will start the program with the default drive *) 119 (* and path = c:\ - aint nothing gona work if looking for *) 120 (* files there *) 121 ReadEnvironment('M2TEST', Environ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 122 CrunchBlanks(Environ); ***** ^ not supported yet ***** ^ not supported yet 123 IF Length(Environ) > 0 ***** ^ not supported yet ***** ^ not supported yet 124 THEN 125 CAPstr(Environ); ***** ^ not supported yet ***** ^ not supported yet 126 IF Environ[1] = ':' ***** ^ not supported yet ***** ^ not supported yet 127 THEN SetDefaultDrive(Environ[0]); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 128 DeleteRightJustified(Environ,0,2); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 129 END; 130 IF 0#ChDir(Environ) ***** ^ not supported yet ***** ^ not supported yet 131 THEN (* this is bullet proof code here *) 132 END; 133 END; 134 135 PrintMessage(GetCurrentDir('z',Environ)); (* check *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 136 IF NOT OpenDisplayFile(DSPFile,'Test.DSP') ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 137 THEN 138 Prompt('Could not open Test.dsp file'); ***** ^ not supported yet ***** ^ not supported yet 139 HALT; ***** ^ undeclared identifier 140 END; 141 ClearScreen(); ***** ^ not supported yet ***** ^ not supported yet 142 InitDisplayFrame(TestDF,CurrentWindow); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 143 NewList(PullDnMenu); ***** ^ not supported yet ***** ^ not supported yet 144 LoadFrameList(DSPFile,'TopMenu',PullDnMenu); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 145 NoData := TRUE; 146 OpenTestDBF(TRUE); ***** ^ not supported yet ***** ^ not supported yet 147 ReadDisplayFrame(DSPFile,TestDF,'Test'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 148 REPEAT 149 NextFrame := 'TopMenu'; ***** ^ not supported yet ***** ^ not supported yet 150 ControlSeparately(PullDnMenu,NextFrame,SelChar,EndingFrame); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 151 IF Equal(EndingFrame,'FileMenu') ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 152 THEN FileMenu(SelChar); ***** ^ not supported yet ***** ^ not supported yet 153 ELSIF Equal(EndingFrame,'EditMenu') ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 154 THEN EditMenu(SelChar); ***** ^ not supported yet ***** ^ not supported yet 155 END; 156 157 UNTIL SelChar='X'; (* Assumes 'X' is only used to exit *) 158 CloseTestDBF(); ***** ^ not supported yet ***** ^ not supported yet 159 ClearScreen(); ***** ^ not supported yet ***** ^ not supported yet 160 161 162 163 END Test. 156 errors