SCRNUTL1.MOD 46 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478
  1. IMPLEMENTATION MODULE ScrnUtl1;
  2. (*
  3. * REPERTOIRE
  4. * Release 1.6
  5. * By Charles Bradford and Cole Brecheen
  6. * (c) Copyright 1985-1992 PMI
  7. * Green Bay, Wisconsin
  8. * All rights reserved
  9. * (414) 468-6040
  10. *
  11. * $Header: D:/logfiles/mods/scrnutl1.mov 1.5 10 Mar 1991 15:32:22 coleb $
  12. *
  13. *)
  14. IMPORT ErrorNames;
  15. IMPORT GenLists;
  16. IMPORT ListUtils;
  17. IMPORT M2Strings;
  18. IMPORT MsColors;
  19. IMPORT NumTypes;
  20. IMPORT PosUtils;
  21. IMPORT Rectangles;
  22. IMPORT ScrnTypes;
  23. IMPORT StrConv;
  24. IMPORT StrEdit;
  25. IMPORT SYSTEM;
  26. IMPORT UserOps;
  27. IMPORT VEditor;
  28. IMPORT VWindows;
  29. VAR
  30. Initialized : BOOLEAN;
  31. PROCEDURE Init();
  32. BEGIN
  33. IF Initialized THEN
  34. RETURN;
  35. ELSE
  36. Initialized := TRUE;
  37. END;
  38. ErrorNames.Init();
  39. GenLists.Init();
  40. ListUtils.Init();
  41. M2Strings.Init();
  42. MsColors.Init();
  43. NumTypes.Init();
  44. PosUtils.Init();
  45. Rectangles.Init();
  46. ScrnTypes.Init();
  47. StrConv.Init();
  48. StrEdit.Init();
  49. UserOps.Init();
  50. VEditor.Init();
  51. VWindows.Init();
  52. END Init;
  53. CONST
  54. Bit15 = 15; (*most significant bit*)
  55. Bit14 = 14; (*next most significant*)
  56. AfterLastElmt = 65535;
  57. TYPE
  58. VariantType =
  59. RECORD
  60. CASE : CARDINAL OF
  61. 1: c: CARDINAL;
  62. | 2: l, h: CHAR;
  63. | 3: b: BITSET;
  64. END
  65. END;
  66. PROCEDURE AbsFieldCol( TheFrame: ScrnTypes.DisplayFrame;
  67. FieldNum: CARDINAL ): INTEGER;
  68. VAR
  69. tmp: CARDINAL;
  70. ImagePtr: ScrnTypes.ImageElmtPtr;
  71. BEGIN
  72. GetFieldImagePtr( TheFrame, FieldNum, ImagePtr );
  73. (*
  74. Diagnostics.diagC( 'ImagePtr^.col', ImagePtr^.col );
  75. *)
  76. tmp := ImagePtr^.col;
  77. DecodeWord( tmp );
  78. (*
  79. Diagnostics.diagC( 'TheFrame^.startcol', TheFrame^.startcol );
  80. Diagnostics.diagC( 'TheFrame^.ColsScrolled', TheFrame^.ColsScrolled );
  81. *)
  82. RETURN INTEGER( INTEGER(tmp) + INTEGER(TheFrame^.startcol)) -
  83. INTEGER(TheFrame^.ColsScrolled);
  84. END AbsFieldCol;
  85. PROCEDURE AbsFieldRow( TheFrame: ScrnTypes.DisplayFrame;
  86. FieldNum: CARDINAL ): INTEGER;
  87. VAR
  88. tmp: CARDINAL;
  89. ImagePtr: ScrnTypes.ImageElmtPtr;
  90. BEGIN
  91. GetFieldImagePtr( TheFrame, FieldNum, ImagePtr );
  92. (*
  93. Diagnostics.diagC( 'ImagePtr^.row', ImagePtr^.row );
  94. *)
  95. tmp := ImagePtr^.row;
  96. DecodeWord( tmp );
  97. (*
  98. IF (tmp + TheFrame^.startrow) < TheFrame^.RowsScrolled THEN
  99. END;
  100. Diagnostics.diagC( 'ImagePtr^.row', tmp );
  101. Diagnostics.diagC( 'TheFrame^.startrow', TheFrame^.startrow );
  102. Diagnostics.diagC( 'TheFrame^.RowsScrolled', TheFrame^.RowsScrolled );
  103. *)
  104. RETURN INTEGER( INTEGER(tmp) + INTEGER(TheFrame^.startrow)) -
  105. INTEGER(TheFrame^.RowsScrolled);
  106. END AbsFieldRow;
  107. PROCEDURE AllFieldsThisType( TheFrame: ScrnTypes.DisplayFrame;
  108. TheType: CHAR ): BOOLEAN;
  109. VAR
  110. FieldCount, LastField: CARDINAL;
  111. CountingDispFields: BOOLEAN;
  112. typ : CHAR;
  113. BEGIN
  114. FieldCount := 1;
  115. CountingDispFields := TheType = ScrnTypes.DispCode;
  116. LastField := FieldListTotal( TheFrame );
  117. WHILE (FieldCount <= LastField) DO
  118. typ := FieldType(TheFrame, FieldCount);
  119. IF (typ # TheType) THEN
  120. IF NOT CountingDispFields THEN
  121. IF typ # ScrnTypes.DispCode THEN
  122. RETURN FALSE;
  123. END;
  124. ELSE
  125. RETURN FALSE;
  126. END;
  127. END;
  128. INC( FieldCount );
  129. END;
  130. RETURN TRUE;
  131. END AllFieldsThisType;
  132. PROCEDURE BoxFrame( TheFrame: ScrnTypes.DisplayFrame; Active: BOOLEAN );
  133. VAR
  134. TheBoxStr: VWindows.BoxStr;
  135. BEGIN
  136. IF Active THEN
  137. TheBoxStr := TheFrame^.EntryBox;
  138. ELSE
  139. TheBoxStr := TheFrame^.ExitBox;
  140. END;
  141. IF TheBoxStr[0] # 0C THEN
  142. SetBorderColors( TheFrame );
  143. VWindows.DrawBox( TheFrame^.WindowHandle, TheBoxStr,
  144. TheFrame^.startcol + 1, TheFrame^.startrow + 1,
  145. TheFrame^.endcol + 1, TheFrame^.endrow + 1 );
  146. IF TheFrame^.Caption[0] # 0C THEN
  147. WriteBetween( TheFrame^.WindowHandle, TheFrame^.Caption,
  148. TheFrame^.startcol + 1, TheFrame^.startrow + 1,
  149. TheFrame^.endcol + 1, TheFrame^.endcol + 1 );
  150. END;
  151. END;
  152. END BoxFrame;
  153. PROCEDURE BoxInFrame( TheFrame: ScrnTypes.DisplayFrame ): BOOLEAN;
  154. BEGIN
  155. RETURN (TheFrame^.EntryBox[0] # 0C) OR (TheFrame^.ExitBox[0] # 0C);
  156. END BoxInFrame;
  157. PROCEDURE ChoiceNumber( TheFrame: ScrnTypes.DisplayFrame;
  158. TheField: CARDINAL ): CARDINAL;
  159. VAR
  160. FieldPtr: ScrnTypes.InputFieldPtr;
  161. BEGIN
  162. GetFieldPtr( TheFrame, TheField, FieldPtr );
  163. RETURN FieldPtr^.GroupID;
  164. END ChoiceNumber;
  165. PROCEDURE CoordsInField( TheFrame: ScrnTypes.DisplayFrame;
  166. TheField, TheCol, TheRow: CARDINAL ): BOOLEAN;
  167. VAR
  168. c1, r1, c2, r2: CARDINAL;
  169. BEGIN
  170. c1 := VirtualFieldCol( TheFrame, TheField );
  171. IF (TheCol < c1) THEN
  172. RETURN FALSE;
  173. END;
  174. r1 := VirtualFieldRow( TheFrame, TheField );
  175. IF (TheRow < r1) THEN
  176. RETURN FALSE;
  177. END;
  178. c2 := c1 + FieldWidth( TheFrame, TheField ) - 1;
  179. IF (TheCol > c2) THEN
  180. RETURN FALSE;
  181. END;
  182. r2 := r1 + FieldHeight( TheFrame, TheField ) - 1;
  183. IF (TheRow > r2) THEN
  184. RETURN FALSE;
  185. END;
  186. RETURN TRUE;
  187. END CoordsInField;
  188. PROCEDURE CurrentField( TheFrame: ScrnTypes.DisplayFrame ):
  189. CARDINAL;
  190. VAR
  191. ImagePtr: ScrnTypes.ImageElmtPtr;
  192. BEGIN
  193. GetFieldImagePtr( TheFrame, TheFrame^.CurrentField, ImagePtr );
  194. (*Make sure the list pointers are correct.*)
  195. RETURN TheFrame^.CurrentField;
  196. END CurrentField;
  197. PROCEDURE DecodeByte( VAR AnyByte: SYSTEM.BYTE );
  198. BEGIN
  199. IF CHAR(AnyByte) = 377C THEN
  200. AnyByte := SYSTEM.BYTE(0C);
  201. ELSIF CHAR(AnyByte) = 0C THEN
  202. ErrorNames.WarningName( 'EncodErr' );
  203. END;
  204. END DecodeByte;
  205. PROCEDURE DecodeImageRec( VAR TheImageRec:
  206. ScrnTypes.ImageElement );
  207. BEGIN
  208. DecodeWord( TheImageRec.row );
  209. DecodeWord( TheImageRec.col );
  210. DecodeWord( TheImageRec.field );
  211. DecodeByte( TheImageRec.foreg );
  212. DecodeByte( TheImageRec.backg );
  213. DecodeByte( TheImageRec.atrb );
  214. END DecodeImageRec;
  215. PROCEDURE DecodeWord( VAR AnyWord: SYSTEM.WORD );
  216. VAR
  217. v: VariantType;
  218. BEGIN
  219. v.c := CARDINAL(AnyWord);
  220. IF Bit14 IN v.b THEN
  221. v.l := 0C;
  222. EXCL( v.b, Bit14 );
  223. END;
  224. IF Bit15 IN v.b THEN
  225. v.h := 0C;
  226. END;
  227. AnyWord := SYSTEM.WORD(v.c);
  228. END DecodeWord;
  229. PROCEDURE EncodeByte( VAR AnyByte: SYSTEM.BYTE );
  230. BEGIN
  231. IF CHAR(AnyByte) = 0C THEN
  232. AnyByte := SYSTEM.BYTE(377C);
  233. ELSIF CHAR(AnyByte) = 377C THEN
  234. ErrorNames.WarningName( 'EncodErr' );
  235. END;
  236. END EncodeByte;
  237. PROCEDURE EncodeImageRec( VAR TheImageRec:
  238. ScrnTypes.ImageElement );
  239. BEGIN
  240. EncodeWord( TheImageRec.row );
  241. EncodeWord( TheImageRec.col );
  242. EncodeWord( TheImageRec.field );
  243. EncodeByte( TheImageRec.foreg );
  244. EncodeByte( TheImageRec.backg );
  245. EncodeByte( TheImageRec.atrb );
  246. END EncodeImageRec;
  247. PROCEDURE EncodeWord( VAR AnyWord: SYSTEM.WORD );
  248. VAR
  249. v: VariantType;
  250. BEGIN
  251. v.c := CARDINAL(AnyWord);
  252. IF v.c > 04000H THEN
  253. ErrorNames.WarningName( 'EncodErr' );
  254. END;
  255. IF (v.h = 0C) THEN
  256. INCL( v.b, Bit15 );
  257. END;
  258. IF (v.l = 0C) THEN
  259. INCL( v.b, Bit14 );
  260. v.l := 377C;
  261. END;
  262. AnyWord := SYSTEM.WORD(v.c);
  263. END EncodeWord;
  264. PROCEDURE EntirelyVisible( TheFrame: ScrnTypes.DisplayFrame;
  265. TheField: CARDINAL ): BOOLEAN;
  266. (* This procedure tells you whether TheField is entirely
  267. visible within TheFrame. *)
  268. VAR
  269. FirstVirtualColVisible, FirstVirtualRowVisible,
  270. VirtualPromptRow, LastVirtualColVisible,
  271. LastVirtualRowVisible, c1, r1, c2, r2: INTEGER;
  272. BEGIN
  273. c1 := INTEGER( VirtualFieldCol( TheFrame, TheField ) );
  274. r1 := INTEGER( VirtualFieldRow( TheFrame, TheField ) );
  275. c2 := c1 + INTEGER(FieldWidth( TheFrame, TheField )) - 1;
  276. r2 := r1 + INTEGER(FieldHeight( TheFrame, TheField )) - 1;
  277. FirstVirtualColVisible := INTEGER(TheFrame^.ColsScrolled)
  278. + 1;
  279. FirstVirtualRowVisible := (INTEGER(TheFrame^.RowsScrolled)
  280. + 1) + INTEGER(TheFrame^.headline);
  281. LastVirtualColVisible := TheFrame^.endcol -
  282. TheFrame^.startcol + 1 + TheFrame^.ColsScrolled;
  283. LastVirtualRowVisible := TheFrame^.endrow -
  284. TheFrame^.startrow + 1 + TheFrame^.RowsScrolled;
  285. IF BoxInFrame( TheFrame ) THEN
  286. (*There's a box in the window, so we have to adjust our
  287. numbers.*)
  288. IF TheFrame^.headline = 0 THEN
  289. (*But we don't have to adjust FirstVirtualRowVisible if
  290. there's a headline because we've added headline
  291. above, and the box takes up one of the lines in it.*)
  292. INC( FirstVirtualRowVisible );
  293. END;
  294. INC( FirstVirtualColVisible );
  295. DEC( LastVirtualRowVisible );
  296. DEC( LastVirtualColVisible );
  297. END;
  298. (*First determine whether it's entirely visible along
  299. its width.*)
  300. IF (c1 < FirstVirtualColVisible) OR (c2 >
  301. LastVirtualColVisible) THEN
  302. RETURN FALSE;
  303. END;
  304. (*Then determine whether it's entirely visible along
  305. its height.*)
  306. IF UserOps.DoPrompting THEN
  307. VirtualPromptRow := INTEGER(TheFrame^.RowsScrolled +
  308. UserOps.PromptRow) - INTEGER(TheFrame^.startrow);
  309. IF (r1 <= VirtualPromptRow) AND (r2 >= VirtualPromptRow) THEN
  310. RETURN FALSE;
  311. END;
  312. END;
  313. IF (r1 < FirstVirtualRowVisible) OR (r2 >
  314. LastVirtualRowVisible) THEN
  315. RETURN FALSE;
  316. END;
  317. RETURN TRUE;
  318. END EntirelyVisible;
  319. PROCEDURE FieldEntered( TheFrame: ScrnTypes.DisplayFrame;
  320. TheCol, TheRow: CARDINAL ): BOOLEAN;
  321. (*Scans the field list to determine whether these cursor
  322. coordinates are inside any field. If so, sets
  323. TheFrame^.CurrentField to the number of the entered field
  324. and returns TRUE.*)
  325. VAR
  326. cnt, ListEnd: CARDINAL;
  327. BEGIN
  328. cnt := 1;
  329. ListEnd := FieldListTotal( TheFrame );
  330. LOOP
  331. IF cnt > ListEnd THEN
  332. RETURN FALSE;
  333. END;
  334. IF CoordsInField( TheFrame, cnt, TheCol, TheRow ) THEN
  335. TheFrame^.CurrentField := cnt;
  336. RETURN TRUE;
  337. END;
  338. INC( cnt );
  339. END;
  340. END FieldEntered;
  341. PROCEDURE FieldGroupTotal( TheFrame: ScrnTypes.DisplayFrame ):
  342. CARDINAL;
  343. VAR
  344. ListEnd, ListCnt, GroupCnt: CARDINAL;
  345. FieldPtr: ScrnTypes.InputFieldPtr;
  346. BEGIN
  347. ListEnd := FieldListTotal( TheFrame );
  348. ListCnt := 1;
  349. GroupCnt := 0;
  350. WHILE ListCnt <= ListEnd DO
  351. GetFieldPtr( TheFrame, ListCnt, FieldPtr );
  352. IF (FieldPtr^.typ = ScrnTypes.DispCode) THEN
  353. (* Do nothing *)
  354. ELSIF (FieldPtr^.typ # ScrnTypes.GroupMember) THEN
  355. INC( GroupCnt );
  356. ELSIF NOT (FieldPtr^.GroupID > 1) THEN
  357. INC( GroupCnt );
  358. END;
  359. INC( ListCnt );
  360. END;
  361. RETURN GroupCnt;
  362. END FieldGroupTotal;
  363. PROCEDURE FieldHeight( TheFrame: ScrnTypes.DisplayFrame;
  364. TheField: CARDINAL ): CARDINAL;
  365. VAR
  366. FieldPtr: ScrnTypes.InputFieldPtr;
  367. BEGIN
  368. IF FieldType( TheFrame, TheField ) = ScrnTypes.EditorCode THEN
  369. GetFieldPtr( TheFrame, TheField, FieldPtr );
  370. RETURN (FieldPtr^.Row2 - VirtualFieldRow( TheFrame, TheField) ) + 1;
  371. ELSE
  372. RETURN 1;
  373. END;
  374. END FieldHeight;
  375. PROCEDURE FieldImageNum( TheFrame: ScrnTypes.DisplayFrame;
  376. FieldNumber: CARDINAL ): CARDINAL;
  377. VAR
  378. ImagePtr: ScrnTypes.InputFieldPtr;
  379. BEGIN
  380. GetFieldPtr( TheFrame, FieldNumber, ImagePtr );
  381. RETURN ImagePtr^.ImageNum;
  382. END FieldImageNum;
  383. PROCEDURE FieldIsBlank( TheFrame: ScrnTypes.DisplayFrame;
  384. FieldName: ARRAY OF CHAR; VAR FieldNumber: CARDINAL ):
  385. BOOLEAN;
  386. (*Pass this routine a DisplayFrame (normally this will be
  387. MainFrame) and a FieldName that appears somewhere in that
  388. frame, and it tells you whether the field is blank, and
  389. what its position is in the list of fields for the frame.*)
  390. VAR
  391. TmpPtr: ScrnTypes.InputFieldPtr;
  392. ImageRec: ScrnTypes.ImageElement;
  393. BEGIN
  394. IF NOT FindField( TheFrame, FieldName, TmpPtr, ImageRec ) THEN
  395. RETURN FALSE;
  396. END;
  397. FieldNumber := FieldNum( TheFrame, FieldName );
  398. RETURN PosUtils.IsBlank( ImageRec.text );
  399. END FieldIsBlank;
  400. PROCEDURE FieldListTotal( TheFrame: ScrnTypes.DisplayFrame ):
  401. CARDINAL;
  402. BEGIN
  403. IF NOT GenLists.Initialized( TheFrame^.FieldList ) THEN
  404. RETURN 0;
  405. ELSE
  406. RETURN GenLists.ListLength( TheFrame^.FieldList );
  407. END;
  408. END FieldListTotal;
  409. PROCEDURE FieldWidth( TheFrame: ScrnTypes.DisplayFrame;
  410. TheField: CARDINAL ): CARDINAL;
  411. VAR
  412. FieldPtr: ScrnTypes.InputFieldPtr;
  413. ImagePtr: ScrnTypes.ImageElmtPtr;
  414. BEGIN
  415. IF FieldType( TheFrame, TheField ) = ScrnTypes.EditorCode THEN
  416. GetFieldPtr( TheFrame, TheField, FieldPtr );
  417. RETURN (FieldPtr^.Col2 - VirtualFieldCol( TheFrame, TheField) ) + 1;
  418. ELSE
  419. GetFieldImagePtr( TheFrame, TheField, ImagePtr );
  420. RETURN M2Strings.Length( ImagePtr^.text );
  421. END;
  422. END FieldWidth;
  423. PROCEDURE FieldType( TheFrame: ScrnTypes.DisplayFrame; FieldNum:
  424. CARDINAL ): CHAR;
  425. VAR
  426. FieldPtr: ScrnTypes.InputFieldPtr;
  427. BEGIN
  428. GetFieldPtr( TheFrame, FieldNum, FieldPtr );
  429. RETURN FieldPtr^.typ;
  430. END FieldType;
  431. PROCEDURE FindField( TheFrame: ScrnTypes.DisplayFrame;
  432. FieldName: ARRAY OF CHAR; VAR FieldPtr:
  433. ScrnTypes.InputFieldPtr; VAR ImageRec:
  434. ScrnTypes.ImageElement ): BOOLEAN;
  435. VAR
  436. spot : CARDINAL;
  437. BEGIN
  438. spot := FieldNum( TheFrame, FieldName );
  439. IF spot = 0 THEN
  440. RETURN FALSE;
  441. ELSE RETURN FindFieldNum( TheFrame, spot, FieldPtr,
  442. ImageRec );
  443. END;
  444. END FindField;
  445. PROCEDURE FindFieldNum( TheFrame: ScrnTypes.DisplayFrame;
  446. FieldNum: CARDINAL; VAR FieldPtr: ScrnTypes.InputFieldPtr;
  447. VAR ImageRec: ScrnTypes.ImageElement ): BOOLEAN;
  448. BEGIN
  449. IF FieldNum > FieldListTotal(TheFrame) THEN
  450. RETURN FALSE;
  451. END;
  452. GetFieldPtr( TheFrame, FieldNum, FieldPtr );
  453. GetImageRec( TheFrame, FieldPtr^.ImageNum, ImageRec );
  454. RETURN TRUE;
  455. END FindFieldNum;
  456. PROCEDURE FirstMember( TheFrame: ScrnTypes.DisplayFrame;
  457. TheField: CARDINAL ): CARDINAL;
  458. (* Pass this routine any field number that's a GroupMember,
  459. and it returns the number of the first field in the group.
  460. To be called only for GroupMember fields. *)
  461. VAR
  462. TmpPtr: ScrnTypes.InputFieldPtr;
  463. FieldNum: CARDINAL;
  464. BEGIN
  465. FieldNum := TheField;
  466. GetFieldPtr( TheFrame, FieldNum, TmpPtr );
  467. WHILE TmpPtr^.GroupID > 1 DO
  468. DEC( FieldNum );
  469. GetFieldPtr( TheFrame, FieldNum, TmpPtr );
  470. END;
  471. RETURN FieldNum;
  472. END FirstMember;
  473. PROCEDURE GetCardField( TheFrame: ScrnTypes.DisplayFrame;
  474. TheField: CARDINAL; VAR TheCard: CARDINAL );
  475. VAR
  476. tmpstr: ARRAY [0..79] OF CHAR;
  477. BEGIN
  478. GetFieldText( TheFrame, TheField, tmpstr );
  479. IF NOT StrConv.StrToCardinal( tmpstr, 0, TheCard ) THEN
  480. TheCard := 0;
  481. END;
  482. END GetCardField;
  483. PROCEDURE GetEdField( FrameRec: ScrnTypes.DisplayFrame;
  484. FieldNum: CARDINAL; VAR TheList: GenLists.GenList );
  485. VAR
  486. TmpRec: ScrnTypes.InputFieldRecord;
  487. BEGIN
  488. GetFieldRec( FrameRec, FieldNum, TmpRec );
  489. IF TmpRec.typ = ScrnTypes.EditorCode THEN
  490. GenLists.GetChildList( FrameRec^.EdFieldList, TmpRec.EdFieldNum,
  491. TheList );
  492. ELSE
  493. ErrorNames.WarningName( 'BadFld' );
  494. END;
  495. END GetEdField;
  496. PROCEDURE GetEdRec( FrameRec: ScrnTypes.DisplayFrame; FieldNum:
  497. CARDINAL; VAR TheList: GenLists.GenList; VAR Rec:
  498. VEditor.AnEdControlRec );
  499. VAR
  500. FieldRec: ScrnTypes.InputFieldRecord;
  501. ImageRec: ScrnTypes.ImageElement;
  502. BEGIN
  503. GetFieldRec( FrameRec, FieldNum, FieldRec );
  504. GetFieldImageRec( FrameRec, FieldNum, ImageRec );
  505. IF FieldRec.typ # ScrnTypes.EditorCode THEN
  506. ErrorNames.WarningName( 'BadFld' );
  507. RETURN;
  508. END;
  509. GenLists.GetChildList( FrameRec^.EdFieldList, FieldRec.EdFieldNum,
  510. TheList );
  511. VEditor.InitEdRec( Rec );
  512. Rec.Col1 := ImageRec.col + FrameRec^.startcol - FrameRec^.ColsScrolled;
  513. Rec.Row1 := ImageRec.row + FrameRec^.startrow - FrameRec^.RowsScrolled;
  514. Rec.Col2 := FieldRec.Col2 + FrameRec^.startcol - FrameRec^.ColsScrolled;
  515. Rec.Row2 := FieldRec.Row2 + FrameRec^.startrow - FrameRec^.RowsScrolled;
  516. (*We adjust the col and row coordinates to absolute
  517. window coordinates.*)
  518. Rec.TextRow1 := FieldRec.TextRow1;
  519. Rec.CursorCol := FieldRec.CursorCol;
  520. Rec.CursorRow := FieldRec.CursorRow;
  521. Rec.MaxLines := FieldRec.MaxLines;
  522. Rec.ChangeMade := FieldRec.ChangeMade;
  523. Rec.ReadOnly := FieldRec.ReadOnly;
  524. Rec.FrameRec := FrameRec;
  525. WITH FrameRec^ DO
  526. (* set colors to pointer bar *)
  527. Rec.EntryForeColor := pbfor;
  528. Rec.EntryBackColor := pbbak;
  529. Rec.EntryAttrib := pbatrb;
  530. END;
  531. Rec.ExitForeColor := ImageRec.foreg;
  532. Rec.ExitBackColor := ImageRec.backg;
  533. Rec.ExitAttrib := ImageRec.atrb;
  534. Rec.EntryBox := 0;
  535. Rec.ExitBox := 0;
  536. Rec.DoCounting := FALSE;
  537. Rec.Col2 := FieldRec.Col2 +
  538. FrameRec^.startcol -FrameRec^.ColsScrolled;
  539. Rec.Row2 := FieldRec.Row2 + FrameRec^.startrow -
  540. FrameRec^.RowsScrolled
  541. END GetEdRec;
  542. PROCEDURE GetFrameLinks( FrameRec: ScrnTypes.DisplayFrame; VAR
  543. FrameAbove, FrameBelow, FrameLeft, FrameRight:
  544. ScrnTypes.AFrameName );
  545. VAR
  546. lngth : CARDINAL;
  547. BEGIN
  548. FrameAbove[0] := 0C;
  549. FrameBelow[0] := 0C;
  550. FrameLeft[0] := 0C;
  551. FrameRight[0] := 0C;
  552. IF NOT GenLists.Initialized( FrameRec^.LinkedFrames ) THEN
  553. RETURN;
  554. END;
  555. lngth := GenLists.ListLength( FrameRec^.LinkedFrames );
  556. IF lngth >= 1 THEN
  557. ListUtils.GetStr( FrameRec^.LinkedFrames, 1, FrameAbove );
  558. END;
  559. IF lngth >= 2 THEN
  560. ListUtils.GetStr( FrameRec^.LinkedFrames, 2, FrameBelow );
  561. END;
  562. IF lngth >= 3 THEN
  563. ListUtils.GetStr( FrameRec^.LinkedFrames, 3, FrameLeft );
  564. END;
  565. IF lngth >= 4 THEN
  566. ListUtils.GetStr( FrameRec^.LinkedFrames, 4, FrameRight );
  567. END;
  568. END GetFrameLinks;
  569. PROCEDURE GetFrameLists( VAR TheFrame: ScrnTypes.DisplayFrame );
  570. BEGIN
  571. GenLists.GetChildList( TheFrame^.self, 5, TheFrame^.DataList );
  572. GenLists.GetChildList( TheFrame^.self, 6, TheFrame^.PromptList );
  573. GenLists.GetChildList( TheFrame^.self, 7, TheFrame^.HelpList );
  574. GenLists.GetChildList( TheFrame^.self, 8, TheFrame^.EdFieldList );
  575. GenLists.GetChildList( TheFrame^.self, 9, TheFrame^.FieldList );
  576. GenLists.GetChildList( TheFrame^.self, 10, TheFrame^.ImageList );
  577. GenLists.GetChildList( TheFrame^.self, 11, TheFrame^.LinkedFrames );
  578. END GetFrameLists;
  579. PROCEDURE GetFieldDataList( TheFrame: ScrnTypes.DisplayFrame;
  580. TheField: CARDINAL; VAR FieldDataList: GenLists.GenList ): BOOLEAN;
  581. VAR
  582. FieldPtr: ScrnTypes.InputFieldPtr;
  583. TmpList: GenLists.GenList;
  584. cnt1, TypeCode : CARDINAL;
  585. FieldDataListFound : BOOLEAN;
  586. TmpName: ARRAY [0..79] OF CHAR;
  587. BEGIN
  588. GenLists.NilList( FieldDataList );
  589. IF NOT GenLists.Initialized( TheFrame^.DataList ) THEN
  590. RETURN FALSE;
  591. END;
  592. FieldDataListFound := FALSE;
  593. GetFieldPtr( TheFrame, TheField, FieldPtr );
  594. cnt1 := GenLists.ListLength( TheFrame^.DataList );
  595. WHILE (cnt1 > 1) AND (NOT FieldDataListFound) DO
  596. IF ListUtils.TypeCheck(TheFrame^.DataList,cnt1)=GenLists.ListCode THEN
  597. GenLists.GetElmt( TheFrame^.DataList, cnt1 - 1, TmpName, TypeCode );
  598. IF PosUtils.Equal( TmpName, FieldPtr^.fnam ) THEN
  599. GenLists.GetChildList( TheFrame^.DataList, cnt1, FieldDataList );
  600. FieldDataListFound := TRUE;
  601. DEC( cnt1 );
  602. (* skip over the field name *)
  603. END;
  604. END;
  605. DEC( cnt1 );
  606. END;
  607. RETURN FieldDataListFound;
  608. END GetFieldDataList;
  609. PROCEDURE GetFieldImagePtr( TheFrame: ScrnTypes.DisplayFrame;
  610. TheField: CARDINAL; VAR ImagePtr: ScrnTypes.ImageElmtPtr );
  611. VAR
  612. FieldPtr: ScrnTypes.InputFieldPtr;
  613. BEGIN
  614. GetFieldPtr( TheFrame, TheField, FieldPtr );
  615. GetImagePtr( TheFrame, FieldPtr^.ImageNum, ImagePtr );
  616. END GetFieldImagePtr;
  617. PROCEDURE GetFieldImageRec( TheFrame: ScrnTypes.DisplayFrame;
  618. TheField: CARDINAL; VAR ImageRec: ScrnTypes.ImageElement );
  619. VAR
  620. FieldPtr: ScrnTypes.InputFieldPtr;
  621. BEGIN
  622. GetFieldPtr( TheFrame, TheField, FieldPtr );
  623. GetImageRec( TheFrame, FieldPtr^.ImageNum, ImageRec );
  624. END GetFieldImageRec;
  625. PROCEDURE GetFieldPtr( TheFrame: ScrnTypes.DisplayFrame;
  626. TheField: CARDINAL; VAR FieldPtr: ScrnTypes.InputFieldPtr );
  627. VAR
  628. TmpSize, TypeCode: CARDINAL;
  629. BEGIN
  630. GenLists.GetElmtAdr( TheFrame^.FieldList, TheField,
  631. FieldPtr, TmpSize, TypeCode );
  632. END GetFieldPtr;
  633. PROCEDURE GetFieldRec( TheFrame: ScrnTypes.DisplayFrame;
  634. TheField: CARDINAL; VAR FieldRec:
  635. ScrnTypes.InputFieldRecord );
  636. VAR
  637. TypeCode: CARDINAL;
  638. BEGIN
  639. GenLists.GetElmt( TheFrame^.FieldList, TheField,
  640. FieldRec, TypeCode );
  641. END GetFieldRec;
  642. PROCEDURE GetFieldText( TheFrame: ScrnTypes.DisplayFrame;
  643. TheField: CARDINAL; VAR TheText: ARRAY OF CHAR );
  644. VAR
  645. ImagePtr: ScrnTypes.ImageElmtPtr;
  646. BEGIN
  647. GetFieldImagePtr( TheFrame, TheField, ImagePtr );
  648. M2Strings.Assign( ImagePtr^.text, TheText );
  649. END GetFieldText;
  650. PROCEDURE GetImagePtr( TheFrame: ScrnTypes.DisplayFrame;
  651. ImageNum: CARDINAL; VAR ImagePtr: ScrnTypes.ImageElmtPtr );
  652. VAR
  653. TmpSize, TypeCode: CARDINAL;
  654. BEGIN
  655. GenLists.GetElmtAdr( TheFrame^.ImageList, ImageNum,
  656. ImagePtr, TmpSize, TypeCode );
  657. END GetImagePtr;
  658. PROCEDURE GetImageRec( TheFrame: ScrnTypes.DisplayFrame;
  659. ImageNum: CARDINAL; VAR ImageRec: ScrnTypes.ImageElement );
  660. VAR
  661. TypeCode: CARDINAL;
  662. BEGIN
  663. GenLists.GetElmt( TheFrame^.ImageList, ImageNum,
  664. ImageRec, TypeCode );
  665. DecodeImageRec( ImageRec );
  666. END GetImageRec;
  667. PROCEDURE GetIntField( TheFrame: ScrnTypes.DisplayFrame;
  668. TheField: CARDINAL; VAR TheInt: INTEGER );
  669. VAR
  670. tmpstr: ARRAY [0..79] OF CHAR;
  671. BEGIN
  672. GetFieldText( TheFrame, TheField, tmpstr );
  673. IF NOT StrConv.StrToInteger( tmpstr, 0, TheInt ) THEN
  674. TheInt := 0;
  675. END;
  676. END GetIntField;
  677. PROCEDURE GetLongIntField( TheFrame: ScrnTypes.DisplayFrame;
  678. TheField: CARDINAL; VAR TheLongInt: LONGINT );
  679. VAR
  680. tmpstr: ARRAY [0..79] OF CHAR;
  681. BEGIN
  682. GetFieldText( TheFrame, TheField, tmpstr );
  683. IF NOT StrConv.StrToLongInteger( tmpstr, 0, TheLongInt ) THEN
  684. TheLongInt := NumTypes.L0;
  685. END;
  686. END GetLongIntField;
  687. PROCEDURE GetVisibleArea( TheFrame: ScrnTypes.DisplayFrame; VAR
  688. VisibleArea: Rectangles.ARectangle );
  689. (* Gets physical screen coordinates of visible part of frame. *)
  690. BEGIN
  691. Rectangles.DefineRectangle( VisibleArea,
  692. TheFrame^.startcol, TheFrame^.startrow,
  693. TheFrame^.endcol, TheFrame^.endrow );
  694. INC( VisibleArea.col1 );
  695. INC( VisibleArea.row1 );
  696. INC( VisibleArea.col2 );
  697. INC( VisibleArea.row2 );
  698. IF BoxInFrame( TheFrame ) THEN
  699. INC( VisibleArea.col1 );
  700. INC( VisibleArea.row1 );
  701. DEC( VisibleArea.col2 );
  702. DEC( VisibleArea.row2 );
  703. END;
  704. IF UserOps.DoPrompting AND ((INTEGER(UserOps.PromptRow) =
  705. VisibleArea.row2) OR (INTEGER(UserOps.PromptRow) =
  706. VisibleArea.row2 - 1)) THEN
  707. VisibleArea.row2 := UserOps.PromptRow - 1;
  708. END;
  709. END GetVisibleArea;
  710. PROCEDURE InputFieldsAbove( TheFrame: ScrnTypes.DisplayFrame;
  711. TheField: CARDINAL ): BOOLEAN;
  712. (*We use this to determine whether a scrolling window
  713. ought to be scrolled all the way to the top of the
  714. frame--it should if there are no input fields above
  715. it.*)
  716. VAR
  717. SavedRow: CARDINAL;
  718. BEGIN
  719. SavedRow := VirtualFieldRow( TheFrame, TheField );
  720. DEC( TheField );
  721. LOOP
  722. IF TheField = 0 THEN
  723. RETURN FALSE;
  724. ELSIF SavedRow > VirtualFieldRow( TheFrame, TheField ) THEN
  725. IF FieldType( TheFrame, TheField ) # ScrnTypes.DispCode THEN
  726. RETURN TRUE;
  727. END;
  728. END;
  729. DEC( TheField );
  730. END;
  731. END InputFieldsAbove;
  732. PROCEDURE InputFieldsBelow( TheFrame: ScrnTypes.DisplayFrame;
  733. TheField: CARDINAL ): BOOLEAN;
  734. VAR
  735. ListEnd, SavedRow : CARDINAL;
  736. BEGIN
  737. SavedRow := VirtualFieldRow( TheFrame, TheField );
  738. ListEnd := FieldListTotal( TheFrame );
  739. INC( TheField );
  740. LOOP
  741. IF TheField > ListEnd THEN
  742. RETURN FALSE;
  743. ELSIF SavedRow < VirtualFieldRow( TheFrame, TheField ) THEN
  744. IF FieldType( TheFrame, TheField ) # ScrnTypes.DispCode THEN
  745. RETURN TRUE;
  746. END;
  747. END;
  748. INC( TheField );
  749. END;
  750. END InputFieldsBelow;
  751. PROCEDURE InputFieldsToLeft( TheFrame: ScrnTypes.DisplayFrame;
  752. TheField: CARDINAL ): BOOLEAN;
  753. VAR
  754. SavedCol : CARDINAL;
  755. BEGIN
  756. SavedCol := VirtualFieldCol( TheFrame, TheField );
  757. DEC( TheField );
  758. LOOP
  759. IF TheField = 0 THEN
  760. RETURN FALSE;
  761. ELSIF SavedCol > VirtualFieldCol( TheFrame, TheField ) THEN
  762. IF FieldType( TheFrame, TheField ) # ScrnTypes.DispCode THEN
  763. RETURN TRUE;
  764. END;
  765. END;
  766. DEC( TheField );
  767. END;
  768. END InputFieldsToLeft;
  769. PROCEDURE InputFieldsToRight( TheFrame: ScrnTypes.DisplayFrame;
  770. TheField: CARDINAL ): BOOLEAN;
  771. VAR
  772. ListEnd, SavedCol : CARDINAL;
  773. BEGIN
  774. SavedCol := VirtualFieldCol( TheFrame, TheField );
  775. ListEnd := FieldListTotal( TheFrame );
  776. INC( TheField );
  777. LOOP
  778. IF TheField > ListEnd THEN
  779. RETURN FALSE;
  780. ELSIF SavedCol < VirtualFieldCol( TheFrame, TheField ) THEN
  781. IF FieldType( TheFrame, TheField ) # ScrnTypes.DispCode THEN
  782. RETURN TRUE;
  783. END;
  784. END;
  785. INC( TheField );
  786. END;
  787. END InputFieldsToRight;
  788. PROCEDURE ListFromEdField( TheFrame: ScrnTypes.DisplayFrame;
  789. TheField: CARDINAL; VAR TheList: GenLists.GenList ):
  790. BOOLEAN;
  791. VAR
  792. FieldRec: ScrnTypes.InputFieldRecord;
  793. BEGIN
  794. GetFieldRec( TheFrame, TheField, FieldRec );
  795. IF (FieldRec.typ = ScrnTypes.EditorCode) AND
  796. (FieldRec.EdFieldNum > 0) THEN
  797. GenLists.GetChildList( TheFrame^.EdFieldList, FieldRec.EdFieldNum,
  798. TheList );
  799. RETURN GenLists.Initialized( TheList);
  800. ELSE
  801. RETURN FALSE;
  802. END;
  803. END ListFromEdField;
  804. PROCEDURE ListToEdField( TheList: GenLists.GenList; TheFrame:
  805. ScrnTypes.DisplayFrame; TheField: CARDINAL ): BOOLEAN;
  806. VAR
  807. FieldRec: ScrnTypes.InputFieldRecord;
  808. BEGIN
  809. GetFieldRec( TheFrame, TheField, FieldRec );
  810. IF (FieldRec.typ = ScrnTypes.EditorCode) AND
  811. (FieldRec.EdFieldNum > 0) THEN
  812. GenLists.ListReplace( TheList, GenLists.ListCode,
  813. TheFrame^.EdFieldList, FieldRec.EdFieldNum );
  814. RETURN TRUE;
  815. ELSE
  816. RETURN FALSE;
  817. END;
  818. END ListToEdField;
  819. PROCEDURE MakeFieldDataList( TheFrame: ScrnTypes.DisplayFrame;
  820. TheField: CARDINAL; FieldDataList: GenLists.GenList );
  821. VAR
  822. TmpList: GenLists.GenList;
  823. FieldPtr: ScrnTypes.InputFieldPtr;
  824. BEGIN
  825. IF NOT GetFieldDataList( TheFrame, TheField, TmpList ) THEN
  826. GetFieldPtr( TheFrame, TheField, FieldPtr );
  827. GenLists.ListInsert( FieldPtr^.fnam, GenLists.StrCode,
  828. TheFrame^.DataList, AfterLastElmt );
  829. GenLists.ListInsert( FieldDataList, GenLists.ListCode,
  830. TheFrame^.DataList, AfterLastElmt );
  831. END;
  832. END MakeFieldDataList;
  833. PROCEDURE NumberOfChoices( TheFrame: ScrnTypes.DisplayFrame;
  834. TheField: CARDINAL ): CARDINAL;
  835. VAR
  836. FieldPtr: ScrnTypes.InputFieldPtr;
  837. BEGIN
  838. GetFieldPtr( TheFrame, TheField, FieldPtr );
  839. RETURN FieldPtr^.GroupSize;
  840. END NumberOfChoices;
  841. PROCEDURE NumberOfImages( TheFrame: ScrnTypes.DisplayFrame ):
  842. CARDINAL;
  843. BEGIN
  844. IF NOT GenLists.Initialized( TheFrame^.ImageList ) THEN
  845. RETURN 0;
  846. ELSE
  847. RETURN GenLists.ListLength( TheFrame^.ImageList );
  848. END;
  849. END NumberOfImages;
  850. PROCEDURE FieldNum( TheFrame: ScrnTypes.DisplayFrame; FieldName:
  851. ARRAY OF CHAR ): CARDINAL;
  852. (*Takes a field name and returns its number; 0 means name
  853. not found.*)
  854. VAR
  855. ListEnd, cnt : CARDINAL;
  856. msg: ARRAY [0..79] OF CHAR;
  857. TmpPtr: ScrnTypes.InputFieldPtr;
  858. BEGIN
  859. StrEdit.CAPstr(FieldName);
  860. (* make search case-insensitive *)
  861. StrEdit.DeleteChar( ' ', FieldName );
  862. (*Delete all blanks from FieldName--ScreenCompile deletes
  863. them from the actual field names.*)
  864. cnt := 1;
  865. ListEnd := FieldListTotal( TheFrame );
  866. WHILE cnt <= ListEnd DO
  867. GetFieldPtr( TheFrame, cnt, TmpPtr );
  868. IF PosUtils.Equal( FieldName, TmpPtr^.fnam ) THEN
  869. TheFrame^.CurrentField := cnt;
  870. RETURN cnt;
  871. ELSE
  872. INC( cnt );
  873. END;
  874. END;
  875. (*
  876. Commented out on 6 Dec 88.
  877. StrEdit.AssignStr( ' is not a field in frame ', msg );
  878. StrEdit.Append( msg, TheFrame^.ThisFrame );
  879. M2Strings.Insert( FieldName, msg, 0 );
  880. IF TheFrame^.FromFile # NIL THEN
  881. StrEdit.Append( msg, ' of file ' );
  882. StrEdit.Append( msg, TheFrame^.FromFile^.name );
  883. END;
  884. ErrorManager.WARN( msg );
  885. *)
  886. RETURN 0;
  887. END FieldNum;
  888. PROCEDURE PartOutside( FrameRec: ScrnTypes.DisplayFrame; VAR
  889. VisibleArea: Rectangles.ARectangle; direction:
  890. VWindows.Compass ): CARDINAL;
  891. VAR
  892. height, width, VHeight : CARDINAL;
  893. BEGIN
  894. height := (VisibleArea.row2 - VisibleArea.row1) + 1;
  895. width := (VisibleArea.col2 - VisibleArea.col1) + 1;
  896. CASE direction OF
  897. VWindows.South:
  898. WITH FrameRec^ DO
  899. IF NOT BoxInFrame(FrameRec) THEN
  900. VHeight := VirtualHeight - headline
  901. ELSIF headline = 0 THEN
  902. (* compensate for bottom line of box *)
  903. VHeight := VirtualHeight - 1;
  904. ELSE
  905. (* compensation for top and bottom lines of box cancel *)
  906. VHeight := VirtualHeight - headline;
  907. END (* if no box *);
  908. IF (VHeight - RowsScrolled) <= height THEN
  909. RETURN 0;
  910. ELSE
  911. RETURN (VHeight - height) - RowsScrolled;
  912. END;
  913. END (* with FrameRec^ *);
  914. | VWindows.North:
  915. RETURN FrameRec^.RowsScrolled;
  916. | VWindows.East:
  917. IF (FrameRec^.VirtualWidth - FrameRec^.ColsScrolled) <= width THEN
  918. RETURN 0;
  919. END;
  920. RETURN (FrameRec^.VirtualWidth - width) - FrameRec^.ColsScrolled;
  921. | VWindows.West:
  922. RETURN FrameRec^.ColsScrolled;
  923. END;
  924. RETURN 0;
  925. END PartOutside;
  926. PROCEDURE PutEdRec( FrameRec: ScrnTypes.DisplayFrame; FieldNum:
  927. CARDINAL; VAR TheList: GenLists.GenList; VAR Rec:
  928. VEditor.AnEdControlRec );
  929. (*Note that this does not update the column and row
  930. coordinates stored in the field list and image list.
  931. That's intentional. The EdControlRec has to have absolute
  932. window coordinates, not frame-relative coordinates.*)
  933. VAR
  934. FieldRec: ScrnTypes.InputFieldRecord;
  935. BEGIN
  936. GetFieldRec( FrameRec, FieldNum, FieldRec );
  937. IF FieldRec.typ # ScrnTypes.EditorCode THEN
  938. ErrorNames.WarningName( 'BadFld' );
  939. RETURN;
  940. END;
  941. GenLists.ListReplace( TheList, GenLists.ListCode,
  942. FrameRec^.EdFieldList, FieldRec.EdFieldNum );
  943. FieldRec.TextRow1 := Rec.TextRow1;
  944. FieldRec.CursorCol := Rec.CursorCol;
  945. FieldRec.CursorRow := Rec.CursorRow;
  946. FieldRec.MaxLines := Rec.MaxLines;
  947. FieldRec.ChangeMade := Rec.ChangeMade;
  948. FieldRec.ReadOnly := Rec.ReadOnly;
  949. PutFieldRec( FieldRec, FrameRec, FieldNum );
  950. END PutEdRec;
  951. PROCEDURE PutFieldImageRec( ImageRec:
  952. ScrnTypes.ImageElement; VAR TheFrame:
  953. ScrnTypes.DisplayFrame; TheField: CARDINAL );
  954. BEGIN
  955. EncodeImageRec( ImageRec );
  956. GenLists.ListReplace( ImageRec, GenLists.StrCode, TheFrame^.ImageList,
  957. FieldImageNum(TheFrame, TheField) );
  958. END PutFieldImageRec;
  959. PROCEDURE PutFieldRec( VAR FieldRec:
  960. ScrnTypes.InputFieldRecord; VAR TheFrame:
  961. ScrnTypes.DisplayFrame; TheField: CARDINAL );
  962. VAR
  963. cnt, ImageListEnd: CARDINAL;
  964. ImageRec: ScrnTypes.ImageElement;
  965. BEGIN
  966. IF NOT GenLists.Initialized( TheFrame^.FieldList ) THEN
  967. GenLists.NewList( TheFrame^.FieldList );
  968. PutFrameLists( TheFrame );
  969. (* Make sure the new FieldList gets inserted into
  970. TheFrame's .self list. *)
  971. END;
  972. IF TheField <= GenLists.ListLength( TheFrame^.FieldList ) THEN
  973. GenLists.ListReplace( FieldRec, ScrnTypes.FieldTypeCode,
  974. TheFrame^.FieldList, TheField );
  975. ELSE
  976. GenLists.ListInsert( FieldRec, ScrnTypes.FieldTypeCode,
  977. TheFrame^.FieldList, TheField );
  978. (* Now everything in the ImageList with a FieldNum
  979. greater than or equal to TheField has to have its
  980. field number incremented. *)
  981. ImageListEnd := NumberOfImages( TheFrame );
  982. FOR cnt := 1 TO ImageListEnd DO
  983. GetImageRec( TheFrame, cnt, ImageRec );
  984. IF ImageRec.field > TheField THEN
  985. INC( ImageRec.field );
  986. EncodeImageRec( ImageRec );
  987. GenLists.ListReplace( ImageRec, GenLists.StrCode,
  988. TheFrame^.ImageList, cnt );
  989. END;
  990. END;
  991. END;
  992. END PutFieldRec;
  993. PROCEDURE PutFrameLists( VAR TheFrame: ScrnTypes.DisplayFrame );
  994. BEGIN
  995. GenLists.ListReplace( TheFrame^.DataList,
  996. GenLists.ListCode, TheFrame^.self, 5 );
  997. GenLists.ListReplace( TheFrame^.PromptList,
  998. GenLists.ListCode, TheFrame^.self, 6 );
  999. GenLists.ListReplace( TheFrame^.HelpList,
  1000. GenLists.ListCode, TheFrame^.self, 7 );
  1001. GenLists.ListReplace( TheFrame^.EdFieldList,
  1002. GenLists.ListCode, TheFrame^.self, 8 );
  1003. GenLists.ListReplace( TheFrame^.FieldList,
  1004. GenLists.ListCode, TheFrame^.self, 9 );
  1005. GenLists.ListReplace( TheFrame^.ImageList,
  1006. GenLists.ListCode, TheFrame^.self, 10 );
  1007. GenLists.ListReplace( TheFrame^.LinkedFrames,
  1008. GenLists.ListCode, TheFrame^.self, 11 );
  1009. END PutFrameLists;
  1010. PROCEDURE RelativeFieldCol( TheFrame: ScrnTypes.DisplayFrame;
  1011. FieldNum: CARDINAL ): CARDINAL;
  1012. VAR
  1013. vcol : CARDINAL;
  1014. BEGIN
  1015. vcol := VirtualFieldCol( TheFrame, FieldNum );
  1016. (*
  1017. IF vcol < TheFrame^.ColsScrolled THEN
  1018. Diagnostics.diagC( 'Scrolling error. vcol', vcol );
  1019. END;
  1020. *)
  1021. RETURN vcol - TheFrame^.ColsScrolled;
  1022. END RelativeFieldCol;
  1023. PROCEDURE RelativeFieldRow( TheFrame: ScrnTypes.DisplayFrame;
  1024. FieldNum: CARDINAL ): CARDINAL;
  1025. VAR
  1026. vrow : CARDINAL;
  1027. BEGIN
  1028. vrow := VirtualFieldRow( TheFrame, FieldNum );
  1029. (*
  1030. IF vrow < TheFrame^.RowsScrolled THEN
  1031. Diagnostics.diagC( 'Scrolling error. RowsScrolled', TheFrame^.RowsScrolled );
  1032. Diagnostics.diagC( 'Scrolling error. vrow', vrow );
  1033. END;
  1034. *)
  1035. RETURN vrow - TheFrame^.RowsScrolled;
  1036. END RelativeFieldRow;
  1037. PROCEDURE ResetFieldPtr( VAR TheFrame: ScrnTypes.DisplayFrame);
  1038. VAR
  1039. dumptr: ScrnTypes.InputFieldPtr;
  1040. BEGIN
  1041. TheFrame^.CurrentField := 0;
  1042. GetFieldPtr( TheFrame, 1, dumptr );
  1043. END ResetFieldPtr;
  1044. PROCEDURE SelectedChar( TheFrame: ScrnTypes.DisplayFrame ):
  1045. CHAR;
  1046. VAR
  1047. FieldRec: ScrnTypes.InputFieldRecord;
  1048. BEGIN
  1049. GetFieldRec( TheFrame, TheFrame^.CurrentField, FieldRec );
  1050. IF FieldRec.typ = ScrnTypes.GotoCode THEN
  1051. IF FieldRec.MenuKey <= 255 THEN
  1052. RETURN CHR(FieldRec.MenuKey);
  1053. END;
  1054. ELSIF FieldRec.typ = ScrnTypes.GroupMember THEN
  1055. IF FieldRec.ChoiceKey <= 255 THEN
  1056. RETURN CHR(FieldRec.ChoiceKey);
  1057. END;
  1058. END;
  1059. RETURN 0C;
  1060. END SelectedChar;
  1061. PROCEDURE SetBorderColors( TheFrame: ScrnTypes.DisplayFrame );
  1062. BEGIN
  1063. VWindows.SetForeColor( TheFrame^.WindowHandle,
  1064. TheFrame^.bordfor );
  1065. VWindows.SetBackColor( TheFrame^.WindowHandle,
  1066. TheFrame^.bordbak );
  1067. VWindows.SetMonoAttr( TheFrame^.WindowHandle,
  1068. TheFrame^.bordatrb );
  1069. END SetBorderColors;
  1070. PROCEDURE SetCurrentField( VAR TheFrame: ScrnTypes.DisplayFrame;
  1071. FieldNum: CARDINAL );
  1072. VAR
  1073. ImagePtr: ScrnTypes.ImageElmtPtr;
  1074. BEGIN
  1075. IF (FieldNum < 1) OR (FieldNum > FieldListTotal(TheFrame)) THEN
  1076. RETURN;
  1077. END;
  1078. GetFieldImagePtr( TheFrame, FieldNum, ImagePtr );
  1079. (*Make sure the list pointers are correct.*)
  1080. TheFrame^.CurrentField := FieldNum;
  1081. END SetCurrentField;
  1082. PROCEDURE SetFieldColors( TheFrame: ScrnTypes.DisplayFrame;
  1083. FieldNum: CARDINAL );
  1084. VAR
  1085. ImageRec: ScrnTypes.ImageElement;
  1086. BEGIN
  1087. GetFieldImageRec( TheFrame, FieldNum, ImageRec );
  1088. VWindows.SetForeColor( TheFrame^.WindowHandle,
  1089. ImageRec.foreg );
  1090. VWindows.SetBackColor( TheFrame^.WindowHandle,
  1091. ImageRec.backg );
  1092. VWindows.SetMonoAttr( TheFrame^.WindowHandle,
  1093. ImageRec.atrb );
  1094. END SetFieldColors;
  1095. PROCEDURE SetMessageColors( TheFrame: ScrnTypes.DisplayFrame );
  1096. BEGIN
  1097. VWindows.SetForeColor( TheFrame^.WindowHandle,
  1098. TheFrame^.msgfor );
  1099. VWindows.SetBackColor( TheFrame^.WindowHandle,
  1100. TheFrame^.msgbak );
  1101. VWindows.SetMonoAttr( TheFrame^.WindowHandle,
  1102. TheFrame^.msgatrb );
  1103. END SetMessageColors;
  1104. PROCEDURE SetNormalColors( TheFrame: ScrnTypes.DisplayFrame );
  1105. BEGIN
  1106. VWindows.SetForeColor( TheFrame^.WindowHandle,
  1107. TheFrame^.normfor );
  1108. VWindows.SetBackColor( TheFrame^.WindowHandle,
  1109. TheFrame^.normbak );
  1110. VWindows.SetMonoAttr( TheFrame^.WindowHandle,
  1111. TheFrame^.normatrb );
  1112. END SetNormalColors;
  1113. PROCEDURE SetPointerBarColors( TheFrame: ScrnTypes.DisplayFrame
  1114. );
  1115. BEGIN
  1116. VWindows.SetForeColor( TheFrame^.WindowHandle,
  1117. TheFrame^.pbfor );
  1118. VWindows.SetBackColor( TheFrame^.WindowHandle,
  1119. TheFrame^.pbbak );
  1120. VWindows.SetMonoAttr( TheFrame^.WindowHandle,
  1121. TheFrame^.pbatrb );
  1122. END SetPointerBarColors;
  1123. PROCEDURE SetPromptColors( TheFrame: ScrnTypes.DisplayFrame );
  1124. BEGIN
  1125. VWindows.SetForeColor( TheFrame^.WindowHandle,
  1126. TheFrame^.promfor );
  1127. VWindows.SetBackColor( TheFrame^.WindowHandle,
  1128. TheFrame^.prombak );
  1129. VWindows.SetMonoAttr( TheFrame^.WindowHandle,
  1130. TheFrame^.promatrb );
  1131. END SetPromptColors;
  1132. PROCEDURE SetSelCharColors( TheFrame: ScrnTypes.DisplayFrame;
  1133. FieldNum: CARDINAL );
  1134. VAR
  1135. fore : MsColors.AColor;
  1136. attr : MsColors.AMonoAttribute;
  1137. ImageRec: ScrnTypes.ImageElement;
  1138. BEGIN
  1139. GetFieldImageRec( TheFrame, FieldNum, ImageRec );
  1140. CASE ORD(ImageRec.foreg) OF
  1141. 0, 3 :
  1142. fore := MsColors.red;
  1143. | 1, 2, 4..7 :
  1144. fore := MsColors.AColor( CHR(ORD(ImageRec.foreg) + 8) );
  1145. | 8..15:
  1146. fore := MsColors.AColor( CHR(ORD(ImageRec.foreg) - 1) );
  1147. END;
  1148. IF ImageRec.atrb # MsColors.bold THEN
  1149. attr := MsColors.bold;
  1150. ELSE
  1151. attr := MsColors.plain;
  1152. END;
  1153. IF fore = TheFrame^.pbbak THEN
  1154. IF fore <= 2C THEN
  1155. fore := CHR( ORD(fore) + 3 );
  1156. ELSE
  1157. fore := CHR( ORD(fore) - 3 );
  1158. END;
  1159. END;
  1160. VWindows.SetForeColor( TheFrame^.WindowHandle,
  1161. fore );
  1162. VWindows.SetBackColor( TheFrame^.WindowHandle,
  1163. ImageRec.backg );
  1164. VWindows.SetMonoAttr( TheFrame^.WindowHandle,
  1165. attr );
  1166. END SetSelCharColors;
  1167. PROCEDURE SetSelectionColors( TheFrame: ScrnTypes.DisplayFrame
  1168. );
  1169. BEGIN
  1170. VWindows.SetForeColor( TheFrame^.WindowHandle,
  1171. TheFrame^.selfor );
  1172. VWindows.SetBackColor( TheFrame^.WindowHandle,
  1173. TheFrame^.selbak );
  1174. VWindows.SetMonoAttr( TheFrame^.WindowHandle,
  1175. TheFrame^.selatrb );
  1176. END SetSelectionColors;
  1177. PROCEDURE VirtualFieldCol( TheFrame: ScrnTypes.DisplayFrame;
  1178. FieldNum: CARDINAL ): CARDINAL;
  1179. VAR
  1180. tmp: CARDINAL;
  1181. ImagePtr: ScrnTypes.ImageElmtPtr;
  1182. BEGIN
  1183. GetFieldImagePtr( TheFrame, FieldNum, ImagePtr );
  1184. tmp := ImagePtr^.col;
  1185. DecodeWord( tmp );
  1186. RETURN tmp;
  1187. END VirtualFieldCol;
  1188. PROCEDURE VirtualFieldRow( TheFrame: ScrnTypes.DisplayFrame;
  1189. FieldNum: CARDINAL ): CARDINAL;
  1190. VAR
  1191. tmp: CARDINAL;
  1192. ImagePtr: ScrnTypes.ImageElmtPtr;
  1193. BEGIN
  1194. GetFieldImagePtr( TheFrame, FieldNum, ImagePtr );
  1195. tmp := ImagePtr^.row;
  1196. DecodeWord( tmp );
  1197. RETURN tmp;
  1198. END VirtualFieldRow;
  1199. PROCEDURE VirtualImageCol( TheFrame: ScrnTypes.DisplayFrame;
  1200. ImageNum: CARDINAL ): CARDINAL;
  1201. VAR
  1202. tmp: CARDINAL;
  1203. ImagePtr: ScrnTypes.ImageElmtPtr;
  1204. BEGIN
  1205. GetImagePtr( TheFrame, ImageNum, ImagePtr );
  1206. tmp := ImagePtr^.col;
  1207. DecodeWord( tmp );
  1208. RETURN tmp;
  1209. END VirtualImageCol;
  1210. PROCEDURE VirtualImageRow( TheFrame: ScrnTypes.DisplayFrame;
  1211. ImageNum: CARDINAL ): CARDINAL;
  1212. VAR
  1213. tmp: CARDINAL;
  1214. ImagePtr: ScrnTypes.ImageElmtPtr;
  1215. BEGIN
  1216. GetImagePtr( TheFrame, ImageNum, ImagePtr );
  1217. tmp := ImagePtr^.row;
  1218. DecodeWord( tmp );
  1219. RETURN tmp;
  1220. END VirtualImageRow;
  1221. PROCEDURE WhichChoiceKey( TheFrame: ScrnTypes.DisplayFrame;
  1222. OneOfTheFields: CARDINAL ): CARDINAL;
  1223. VAR
  1224. TmpPtr: ScrnTypes.InputFieldPtr;
  1225. FieldNum: CARDINAL;
  1226. BEGIN
  1227. IF FieldType(TheFrame, OneOfTheFields) # ScrnTypes.GroupMember THEN
  1228. RETURN 0;
  1229. END;
  1230. FieldNum := FirstMember( TheFrame, OneOfTheFields );
  1231. REPEAT
  1232. GetFieldPtr( TheFrame, FieldNum, TmpPtr );
  1233. IF TmpPtr^.selected THEN
  1234. RETURN TmpPtr^.ChoiceKey;
  1235. ELSE
  1236. INC( FieldNum );
  1237. END;
  1238. UNTIL TmpPtr^.GroupID = TmpPtr^.GroupSize;
  1239. RETURN 0;
  1240. END WhichChoiceKey;
  1241. PROCEDURE WhichChoiceNum( TheFrame: ScrnTypes.DisplayFrame;
  1242. OneOfTheFields: CARDINAL ): CARDINAL;
  1243. VAR
  1244. TmpPtr: ScrnTypes.InputFieldPtr;
  1245. FieldNum: CARDINAL;
  1246. BEGIN
  1247. IF FieldType(TheFrame, OneOfTheFields) # ScrnTypes.GroupMember THEN
  1248. RETURN 0;
  1249. END;
  1250. FieldNum := FirstMember( TheFrame, OneOfTheFields );
  1251. REPEAT
  1252. GetFieldPtr( TheFrame, FieldNum, TmpPtr );
  1253. IF TmpPtr^.selected THEN
  1254. RETURN TmpPtr^.GroupID;
  1255. ELSE
  1256. INC( FieldNum );
  1257. END;
  1258. UNTIL TmpPtr^.GroupID = TmpPtr^.GroupSize;
  1259. RETURN FirstMember( TheFrame, OneOfTheFields );
  1260. END WhichChoiceNum;
  1261. PROCEDURE WriteBetween( TheWindow: VWindows.AWindowHandle;
  1262. TheStr: ARRAY OF CHAR; col1, row1, col2, row2: CARDINAL );
  1263. (*Used for writing centered captions on frame borders.*)
  1264. VAR
  1265. lngth, width: CARDINAL;
  1266. BEGIN
  1267. lngth := M2Strings.Length( TheStr );
  1268. width := (col2 - col1) - 1;
  1269. IF lngth > width THEN
  1270. StrEdit.SetLength( TheStr, width );
  1271. lngth := width;
  1272. END;
  1273. VWindows.DrawStr( TheWindow, col1 + ((width - lngth) DIV 2) + 1,
  1274. row1, SYSTEM.ADR(TheStr), lngth );
  1275. END WriteBetween;
  1276. PROCEDURE WriteScrollMarks( TheFrame: ScrnTypes.DisplayFrame );
  1277. BEGIN
  1278. WITH TheFrame^ DO
  1279. IF NOT BoxInFrame( TheFrame ) THEN
  1280. (*There's no box around the window, so we don't have
  1281. any place to put our scroll marks.*)
  1282. RETURN;
  1283. END;
  1284. IF (VirtualHeight > (endrow - startrow) + 1) THEN
  1285. VWindows.SetScrollRange( TheFrame^.WindowHandle,
  1286. VWindows.SbVert, TheFrame^.startrow + 1,
  1287. TheFrame^.endrow + 1 );
  1288. VWindows.SetScrollPos( TheFrame^.WindowHandle,
  1289. VWindows.SbVert, TheFrame^.RowsScrolled );
  1290. END;
  1291. IF (VirtualWidth > (endcol - startcol) + 1) THEN
  1292. VWindows.SetScrollRange( TheFrame^.WindowHandle,
  1293. VWindows.SbHorz, TheFrame^.startcol + 1,
  1294. TheFrame^.endcol + 1 );
  1295. VWindows.SetScrollPos( TheFrame^.WindowHandle,
  1296. VWindows.SbHorz, TheFrame^.ColsScrolled );
  1297. END;
  1298. (*If neither of the two preceding IF's were
  1299. executed, the frame fits entirely within the
  1300. window; no need to write scroll marks.*)
  1301. END;
  1302. END WriteScrollMarks;
  1303. BEGIN
  1304. Initialized := FALSE;
  1305. Init();
  1306. END ScrnUtl1.