| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943 |
- Listing:
- 1
- 2 IMPLEMENTATION MODULE DBScreen;
- 3 (*
- 4 * ModBase
- 5 * Release 3.0
- 6 * By Don Fletcher & John McMonagle
- 7 * (c) Copyright 1986 - 1991 PMI
- 8 * P.O. Box 8402
- 9 * Green Bay Wi 53308
- 10 * All Rights Reserved
- 11 *
- 12 *)
- 13
- 14 IMPORT SYSTEM;
- 15
- 16 (*Repertoire modules*)
- 17 IMPORT BigSets;
- 18 IMPORT LowLevel;
- 19 IMPORT KbdInput;
- 20 IMPORT SmartScreen;
- 21 IMPORT StrEdit;
- 22 IMPORT StrInput;
- 23 IMPORT StrConv;
- 24 IMPORT M2Strings;
- 25 IMPORT VWindows;
- 26 IMPORT WindowPrims;
- 27 IMPORT ModBase3;
- 28 IMPORT ErrorManager;
- 29 FROM MiscFunctions IMPORT FieldName, FieldNameChar,
- 30 Alph, Trim, Upper;
- 31 CONST Blank = ' ';
- 32 MaxGets = 80;
- 33 MaxField = 128;
- 34 MaxLength = 256;
- 35 MaxNLength = 18;
- 36
- 37 CRnum = 13;
- 38 TABnum = 9;
- 39 BSPnum = 8;
- 40 ESCnum = 27;
- 41 BTBnum = 15 + KbdInput.Extended;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 42 (*back tab numeric code for extended scan code*)
- 43 LARWnum = 75 + KbdInput.Extended;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 44 (*left arrow numeric code*)
- 45 RARWnum = 77 + KbdInput.Extended;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 46 (*right arrow*)
- 47 UARWnum = 72 + KbdInput.Extended;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 48 (*up arrow*)
- 49 DARWnum = 80 + KbdInput.Extended;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 50
- 51 TYPE
- 52 String = ARRAY [0..MaxField] OF CHAR;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 53
- 54 StrPtr = POINTER TO String;
- ***** ^ not supported yet
- 55
- 56 GetType = RECORD
- 57 row: CARDINAL;
- 58 col: CARDINAL;
- 59 len: CARDINAL;
- 60 val: StrPtr;
- 61 END;
- ***** ^ not supported yet
- 62
- 63 InputArray = ARRAY [1..MaxGets] OF GetType;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 64
- 65 VAR input: InputArray;
- ***** ^ not supported yet
- 66 lastget: CARDINAL;
- 67
- 68 PROCEDURE ValidType(ch: CHAR): BOOLEAN;
- 69 BEGIN
- 70 RETURN (CAP(ch)='C') OR (CAP(ch)='N') OR (CAP(ch)='L') OR
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 71 (CAP(ch)='D') OR (CAP(ch)='M');
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 72 END ValidType;
- ***** ^ not supported yet
- 73
- 74 PROCEDURE ValidSize(size: CARDINAL; fieldtype: CHAR): BOOLEAN;
- 75 (* Checks to see whether size is valid for the given fieldtype*)
- 76 BEGIN
- 77 CASE CAP(fieldtype) OF
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 78 'C': RETURN (size >= 1) AND (size <= MaxLength);
- 79 | 'N': RETURN (size >= 1) AND (size <= MaxNLength);
- 80 | 'L': RETURN (size = 1);
- 81 | 'D': RETURN (size = 8);
- 82 | 'M': RETURN (size = 10);
- 83 END;
- 84 RETURN FALSE;
- 85 END ValidSize;
- ***** ^ not supported yet
- 86
- 87 PROCEDURE ValidDec(size, decimalplaces: CARDINAL): BOOLEAN;
- 88 BEGIN
- 89 RETURN (decimalplaces <= size);
- 90 END ValidDec;
- ***** ^ not supported yet
- 91
- 92 PROCEDURE GetDescriptors(VAR fields: ARRAY OF ModBase3.DBFieldDescriptor);
- ***** ^ not supported yet
- 93
- 94 VAR
- 95 i, j, crow, ccol, lastfield, pagebottom, pagetop: CARDINAL;
- 96 sizestring: ARRAY [0..2] OF CHAR;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 97 decstr: ARRAY [0..1] OF CHAR;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 98 confirmed: CHAR;
- 99 ok: BOOLEAN;
- 100
- 101 PROCEDURE UniqueName(testname: ARRAY OF CHAR): BOOLEAN;
- ***** ^ not supported yet
- 102 VAR i, matches: CARDINAL;
- 103 BEGIN
- 104 i := 0;
- 105 matches := 0;
- 106 WHILE (i <= lastfield) DO
- 107 IF (M2Strings.CompareStr(fields[i].name, testname) = 0) THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 108 INC(matches)
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 109 END;
- 110 INC(i)
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 111 END;
- 112 RETURN matches = 1;
- 113 END UniqueName;
- ***** ^ not supported yet
- 114
- 115 BEGIN
- 116 WindowPrims.PushColors();
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 117 SmartScreen.ClearScreen();
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 118 i := 0;
- 119 pagetop := i;
- 120 pagebottom := i+29;
- 121 confirmed := 'N';
- 122 Say(2, 5, 'NAME------ TYPE SIZE DEC');
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 123 SmartScreen.SetAttribOrColor( SmartScreen.red,
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 124 SmartScreen.blue, SmartScreen.ReverseVideo );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 125 REPEAT
- 126 crow := (i MOD 15) + 4;
- 127 ccol := 5+((i DIV 15) * 35);
- 128 Say(crow, ccol, fields[i].name);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 129 Say(crow, ccol+12, fields[i].fldtype);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 130 StrConv.CardinalToStr(fields[i].size, 3, sizestring);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 131 Say(crow, ccol+18, sizestring);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 132 StrConv.CardinalToStr(fields[i].decplaces, 3, decstr);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 133 Say(crow, ccol+24, decstr);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 134 INC(i);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 135 UNTIL (NOT FieldName(fields[i].name)) OR (i >= pagebottom);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 136 lastfield := i-1;
- 137 REPEAT
- 138 i := 0;
- 139 REPEAT
- 140 REPEAT
- 141 crow := (i MOD 15) + 4;
- 142 ccol := 5+((i DIV 15) * 35);
- 143 Get(crow, ccol, fields[i].name);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 144 Get(crow, ccol + 12, fields[i].fldtype);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 145 ReadGets;
- ***** ^ undeclared identifier
- 146 fields[i].fldtype := CAP(fields[i].fldtype);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 147 Upper(fields[i].name);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 148 Say(crow, ccol, fields[i].name);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 149 Say(crow, ccol + 12, fields[i].fldtype);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 150 UNTIL (FieldName(fields[i].name) AND UniqueName(fields[i].name))
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 151 AND (ValidType(fields[i].fldtype))
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 152 OR (fields[i].name[0] = ' ')
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 153 OR (lastdirection = Escape);
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- 154 IF ((fields[i].name[0]) # ' ') AND (lastdirection # Back) THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- 155 CASE fields[i].fldtype OF
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 156 'D' : fields[i].size := 8 |
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 157 'M' : fields[i].size := 10 |
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 158 'L' : fields[i].size := 1
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 159 ELSE
- 160 StrConv.CardinalToStr(fields[i].size, 3, sizestring);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 161 StrConv.CardinalToStr(fields[i].decplaces, 3, decstr);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 162 REPEAT
- 163 Get(crow, ccol + 18, sizestring);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 164 ReadGets;
- ***** ^ undeclared identifier
- 165 Trim(sizestring);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 166 ok := StrConv.StrToCardinal(sizestring, 0, fields[i].size);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 167 UNTIL ok AND ValidSize(fields[i].size, fields[i].fldtype);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 168 IF fields[i].fldtype = 'N' THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 169 REPEAT
- 170 Get(crow, ccol + 24, decstr);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 171 ReadGets;
- ***** ^ undeclared identifier
- 172 Trim(decstr);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 173 ok := StrConv.StrToCardinal(decstr, 0, fields[i].decplaces);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 174 UNTIL ok AND ValidDec(fields[i].size, fields[i].decplaces);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 175 END;
- 176 END; (* case *)
- 177 END;
- 178 IF (i < lastfield) AND (fields[i].name[0] = ' ') THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 179 (* the user has deleted a field in mid-record so the subsequent
- 180 fields must be 'sucked up' *)
- 181 FOR j := i TO lastfield DO
- 182 fields[j] := fields[j+1]
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 183 END (* for *);
- 184 END;
- 185 IF lastdirection = Ahead THEN
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- 186 IF i < MaxField-1 THEN
- 187 IF i >= lastfield THEN INC(lastfield) END;
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 188 INC(i)
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 189 END;
- 190 ELSIF lastdirection = Back THEN
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- 191 IF i > 0 THEN
- 192 DEC(i)
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 193 END;
- 194 END;
- 195 UNTIL (lastdirection = Escape)
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- 196 OR (fields[i-1].name[0] = ' ')
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 197 OR (i < pagetop)
- 198 OR (i > pagebottom);
- 199 (* CONFIRM *)
- 200 Say(24,5, 'Enter "Y" to confirm - ');
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 201 Get(24, 28, confirmed);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 202 ReadGets;
- ***** ^ undeclared identifier
- 203 UNTIL CAP(confirmed) = 'Y';
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 204 WindowPrims.PopColors();
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 205 END GetDescriptors;
- ***** ^ not supported yet
- 206
- 207 PROCEDURE ModifyDBStruc(VAR alias: ModBase3.DBFile);
- ***** ^ not supported yet
- 208 VAR displayoffset: CARDINAL;
- 209 new: ModBase3.DBFile;
- ***** ^ not supported yet
- 210 BEGIN
- 211 (* new = alias;
- 212 ChangeExt(alias.name, 'BAK');
- 213 (* Rename alias to *.bak *)
- 214 Rename(alias.fileID, alias.name);
- 215 CloseDBF(alias);
- 216
- 217 (* Rename alias to *.bak *)
- 218 GetDescriptors(new.fieldlist);
- 219 BuildDBF(new.name, new.fieldlist, alias);
- 220 CloseDBF(alias);
- 221 (* UpDate from *.bak *)
- 222 *)
- 223 END ModifyDBStruc;
- ***** ^ not supported yet
- 224
- 225 (*
- 226 PROCEDURE ChangeExt(VAR filename: ARRAY OF CHAR; ext: ARRAY OF CHAR);
- 227 (* add the ext after the last period in the filename *)
- 228 VAR i, j: CARDINAL;
- 229 BEGIN
- 230 i := M2Strings.Length(filename)-1;
- 231 WHILE (i > 0) AND (filename[i] # '.') DO
- 232 DEC(i)
- 233 END;
- 234 IF i = 0 THEN
- 235 i := M2Strings.Length(filename)-1;
- 236 END;
- 237 FOR j := i+1 TO i+M2Strings.Length(ext)+1 DO
- 238 filename[j] := ext[j-(i+1)]
- 239 END;
- 240 IF HIGH(filename) > (i+M2Strings.Length(ext)+1) THEN
- 241 filename[i+M2Strings.Length(ext)] := 0C;
- 242 END;
- 243 END ChangeExt;
- 244 *)
- 245
- 246 PROCEDURE CreateDBF(dbfilename: ARRAY OF CHAR; VAR alias: ModBase3.DBFile);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 247 VAR descarray: ARRAY [0..MaxField-1] OF ModBase3.DBFieldDescriptor;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 248 i: CARDINAL;
- 249 BEGIN
- 250 (* initialize field descriptor array *)
- 251 FOR i := 0 TO MaxField-1 DO
- 252 WITH descarray[i] DO
- ***** ^ not supported yet
- ***** ^ not supported yet
- 253 name := ' ';
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 254 size := 0;
- ***** ^ undeclared identifier
- 255 fldtype := ' ';
- ***** ^ undeclared identifier
- 256 decplaces := 0;
- ***** ^ undeclared identifier
- 257 offset := 0;
- ***** ^ undeclared identifier
- 258 END;
- ***** ^ not supported yet
- 259 END;
- 260 GetDescriptors(descarray);
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- 261 IF ModBase3.BuildDBF(descarray,MaxField, alias) # 0 THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- 262 ErrorManager.WARN('Unable to create DataBase File')
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 263 END;
- 264 END CreateDBF;
- ***** ^ not supported yet
- 265
- 266
- 267
- 268 PROCEDURE Row(): CARDINAL;
- 269 VAR row, col: CARDINAL;
- 270 BEGIN
- 271 WindowPrims.GetCursorCoords( col, row );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 272 RETURN row;
- 273 END Row;
- ***** ^ not supported yet
- 274
- 275 PROCEDURE Col(): CARDINAL;
- 276 VAR row, col: CARDINAL;
- 277 BEGIN
- 278 WindowPrims.GetCursorCoords( col, row );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 279 RETURN col;
- 280 END Col;
- ***** ^ not supported yet
- 281
- 282
- 283 PROCEDURE Say(row, col: CARDINAL; s: ARRAY OF CHAR);
- ***** ^ not supported yet
- 284 BEGIN
- 285 WindowPrims.PushColors();
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 286 (* Note that we don't push and pop the cursor size or
- 287 position here or in Get, and we don't turn it off,
- 288 because we don't want it to flash between fields as they
- 289 are initially written. Means you ought to turn it off
- 290 before doing a series of Say and Get statements. *)
- 291 SmartScreen.SetAttribOrColor( writeattr.fore, writeattr.back,
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 292 writeattr.MonoAttr );
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 293 SmartScreen.WriteAt( col, row, s );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 294 SmartScreen.GotoXY( SmartScreen.NominalCol,
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 295 SmartScreen.NominalRow );
- ***** ^ not supported yet
- ***** ^ not supported yet
- 296 (* The GotoXY guarantees consistent cursor placement between
- 297 VideoMethods; in DMA mode, WriteAt doesn't move the
- 298 cursor. See documentation for SmartScreen in the
- 299 Repertoire manual. *)
- 300 WindowPrims.PopColors();
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 301 END Say;
- ***** ^ not supported yet
- 302
- 303 PROCEDURE Get(row, col: CARDINAL; VAR s: ARRAY OF CHAR);
- ***** ^ not supported yet
- 304 BEGIN
- 305 WindowPrims.PushColors();
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 306 (* pad the string with trailing blanks *)
- 307 WHILE M2Strings.Length(s) <= HIGH(s) DO
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 308 StrEdit.Append( s, Blank );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 309 END;
- 310 INC(lastget);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 311 input[lastget].row := row;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 312 input[lastget].col := col;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 313 input[lastget].len := HIGH(s)+1;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 314 input[lastget].val := SYSTEM.ADR(s);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 315
- 316 SmartScreen.SetAttribOrColor( readattr.fore, readattr.back,
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 317 readattr.MonoAttr );
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 318
- 319 SmartScreen.GotoXY( col, row );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 320 SmartScreen.WriteAt( col, row, s );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 321 SmartScreen.GotoXY( SmartScreen.NominalCol,
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 322 SmartScreen.NominalRow );
- ***** ^ not supported yet
- ***** ^ not supported yet
- 323 WindowPrims.PopColors();
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 324 END Get;
- ***** ^ not supported yet
- 325
- 326
- 327 PROCEDURE ReadGets;
- 328 VAR
- 329 tmpLen, currentget, CursorPos, LastKey : CARDINAL;
- 330 ExitKeys: KbdInput.KeyNumSet;
- ***** ^ not supported yet
- 331 InsertMode: BOOLEAN;
- 332 TmpStr: ARRAY [0..128] OF CHAR;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 333 tmpStrPtr: StrPtr;
- ***** ^ not supported yet
- 334 LocalInput: InputArray;
- ***** ^ not supported yet
- 335 BEGIN
- 336 LocalInput := input;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 337 (* We do this to make the routine easier to follow in the
- 338 runtime debugger. The global input variable isn't
- 339 normally visible there because it's global to a module
- 340 outside the calling chain. *)
- 341 WindowPrims.PushColors();
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 342 WindowPrims.PushCursorCoords();
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 343 (* Insulates calling procedures from the color choices and
- 344 cursor-position changes we make here. We don't need to
- 345 push and pop the cursor size or turn it off because
- 346 ReadWithEdits handles that internally. *)
- 347 SmartScreen.SetAttribOrColor( readattr.fore, readattr.back,
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 348 readattr.MonoAttr );
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 349 InsertMode := TRUE;
- 350 BigSets.InitSet( ExitKeys );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 351 BigSets.AppendSet( ExitKeys, '{8, 9, 13, 27, 271, 328, 329, 336, 337}' );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 352 (* Means BackSpace, TAB, BackTab, CR, ESC, and the arrow
- 353 keys let you out of a field. *)
- 354 IF lastget > 0 THEN
- 355 currentget:= 1;
- 356 lastdirection := Nowhere;
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- 357 WHILE (lastdirection # Escape) AND
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- 358 (currentget > 0) AND
- 359 (currentget <= lastget) DO
- 360 CursorPos := 0;
- 361 tmpStrPtr := LocalInput[currentget].val;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 362 (* Break out the steps because otherwise Stony Brook
- 363 generates code that causes a protection fault
- 364 when the pointer is dereferenced. *)
- 365 tmpLen := LocalInput[currentget].len;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 366 LowLevel.Move(tmpStrPtr, SYSTEM.ADR(TmpStr), tmpLen);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 367 (* We have to do this to prevent overflows; since val
- 368 points to an area of memory larger than what we are
- 369 really considering the variable here, ReadWithEdits
- 370 can't reliably tell whether it should put a length
- 371 byte at the end of the string. Notice that we can't
- 372 use M2Strings.Copy because it will begin by trying to
- 373 make a copy of all HIGH+1 bytes of the first argument
- 374 on the stack. In this case, they aren't all there.*)
- 375 StrInput.ReadWithEdits( VWindows.CurrentWindow, TmpStr,
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 376 LocalInput[currentget].col, LocalInput[currentget].row,
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 377 LocalInput[currentget].len, CursorPos, InsertMode, FALSE,
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 378 LastKey, KbdInput.AnyKeyNum, ExitKeys );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 379
- 380 LowLevel.Move( SYSTEM.ADR(TmpStr), LocalInput[currentget].val,
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 381 LocalInput[currentget].len );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 382 CASE LastKey OF
- 383 BSPnum, BTBnum, LARWnum, UARWnum:
- ***** ^ not supported yet
- 384 DEC( currentget );
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 385 lastdirection := Back;
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- 386 | CRnum, TABnum, RARWnum, DARWnum:
- ***** ^ not supported yet
- ***** ^ not supported yet
- 387 INC(currentget);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 388 lastdirection := Ahead;
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- 389 | ESCnum:
- ***** ^ not supported yet
- 390 lastdirection := Escape
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- 391 ELSE (* nothing *)
- 392 END;
- 393
- 394 END; (*WHILE*)
- 395
- 396 FOR currentget := 1 TO lastget DO
- 397 tmpStrPtr := LocalInput[currentget].val;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 398 tmpLen := LocalInput[currentget].len;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 399 LowLevel.Move(tmpStrPtr, SYSTEM.ADR(TmpStr), tmpLen);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 400 (* Same problem here; the procedure that strips the
- 401 blanks can't reliably determine where the end of the
- 402 string is because we are trying to pass it only a
- 403 part of the string. So we copy into a local
- 404 variable. *)
- 405 StrEdit.CutTrailingChars( Blank, TmpStr );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 406 LowLevel.Move( SYSTEM.ADR(TmpStr), LocalInput[currentget].val,
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 407 LocalInput[currentget].len );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 408 END;
- 409 lastget := 0;
- 410 END; (* if *)
- 411 WindowPrims.PopCursorCoords();
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 412 WindowPrims.PopColors();
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 413 input := LocalInput;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 414 END ReadGets;
- ***** ^ not supported yet
- 415
- 416 BEGIN (* main *)
- 417 WITH readattr DO
- ***** ^ undeclared identifier
- 418 MonoAttr := SmartScreen.ReverseVideo;
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 419 fore := SmartScreen.blue;
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 420 back := SmartScreen.lightgrey;
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 421 END;
- ***** ^ not supported yet
- 422 WITH writeattr DO
- ***** ^ undeclared identifier
- 423 MonoAttr := SmartScreen.plain;
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 424 fore := SmartScreen.lightgrey;
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 425 back := SmartScreen.blue;
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 426 END;
- ***** ^ not supported yet
- 427 lastget := 0;
- 428 END DBScreen.
- ***** ^ not supported yet
- 429
- 508 errors
|