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