INPUTMAN.MOD 48 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328
  1. IMPLEMENTATION MODULE InputManager;
  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/inputman.mov 1.5 10 Mar 1991 15:28:34 coleb $
  12. *
  13. *)
  14. IMPORT BigSets;
  15. IMPORT ErrorManager;
  16. IMPORT ErrorNames;
  17. IMPORT FieldTypes;
  18. IMPORT FrameManager;
  19. IMPORT FramePainter;
  20. IMPORT GenLists;
  21. IMPORT KbdInput;
  22. IMPORT Key;
  23. IMPORT ListUtils;
  24. IMPORT M2Strings;
  25. IMPORT MsgBox2;
  26. IMPORT Numbers;
  27. IMPORT PosUtils;
  28. IMPORT Rectangles;
  29. IMPORT ScrnTypes;
  30. IMPORT ScrnUtl1;
  31. IMPORT StrConv;
  32. IMPORT StrEdit;
  33. IMPORT SYSTEM;
  34. IMPORT UserOps;
  35. IMPORT VWindows;
  36. VAR
  37. Initialized : BOOLEAN;
  38. PROCEDURE Init();
  39. BEGIN
  40. IF Initialized THEN
  41. RETURN;
  42. ELSE
  43. Initialized := TRUE;
  44. END;
  45. BigSets.Init();
  46. ErrorManager.Init();
  47. ErrorNames.Init();
  48. FieldTypes.Init();
  49. FrameManager.Init();
  50. FramePainter.Init();
  51. GenLists.Init();
  52. KbdInput.Init();
  53. Key.Init();
  54. ListUtils.Init();
  55. M2Strings.Init();
  56. MsgBox2.Init();
  57. Numbers.Init();
  58. PosUtils.Init();
  59. Rectangles.Init();
  60. ScrnTypes.Init();
  61. ScrnUtl1.Init();
  62. StrConv.Init();
  63. StrEdit.Init();
  64. UserOps.Init();
  65. VWindows.Init();
  66. END Init;
  67. CONST
  68. RequiredMessage = "This field must be filled in. Press Return to continue.";
  69. PROCEDURE GetScrollableArea(TheFrame : ScrnTypes.DisplayFrame;
  70. VAR ScrollRect : Rectangles.ARectangle);
  71. (*
  72. Returns a rectangle with the absolute field coordinates of
  73. the scrollable area in the frame
  74. *)
  75. BEGIN
  76. ScrnUtl1.GetVisibleArea(TheFrame, ScrollRect);
  77. (* Gets physical screen coordinates of visible part of frame. *)
  78. IF TheFrame^.headline > 0 THEN
  79. IF NOT ScrnUtl1.BoxInFrame(TheFrame) THEN
  80. INC(ScrollRect.row1, TheFrame^.headline)
  81. ELSE
  82. INC(ScrollRect.row1, TheFrame^.headline-1)
  83. END;
  84. END;
  85. END GetScrollableArea;
  86. PROCEDURE ClosestField( TheFrame: ScrnTypes.DisplayFrame;
  87. TheField, col, row: CARDINAL; direction: VWindows.Compass ): CARDINAL;
  88. (*Returns the number of the field closest to TheField in the
  89. direction specified. If you pass 0 to col and row, it
  90. figures out where TheField is automatically. If you pass 0
  91. to TheField, it assumes the cursor is presently outside of
  92. a field, and that col and row indicate where it is.*)
  93. VAR
  94. dist, FieldCount, BestGuess, BestDistance,
  95. ListStart, ListEnd, StartField, OldField: CARDINAL;
  96. p1, p2, BestPoint: Rectangles.APoint;
  97. PROCEDURE Candidate( TheFrame: ScrnTypes.DisplayFrame;
  98. TheField: CARDINAL; VAR Cursor, FieldSpot:
  99. Rectangles.APoint; direction: VWindows.Compass; VAR dist:
  100. CARDINAL ): BOOLEAN;
  101. VAR
  102. tmpcol, tmprow: CARDINAL;
  103. BEGIN
  104. tmpcol := ScrnUtl1.VirtualFieldCol( TheFrame, TheField );
  105. tmprow := ScrnUtl1.VirtualFieldRow( TheFrame, TheField );
  106. FieldSpot.col := INTEGER(tmpcol);
  107. FieldSpot.row := INTEGER(tmprow);
  108. CASE direction OF
  109. VWindows.North, VWindows.NE, VWindows.NW:
  110. IF (tmprow >= CARDINAL(Cursor.row)) THEN
  111. RETURN FALSE;
  112. END
  113. ELSE
  114. END;
  115. CASE direction OF
  116. VWindows.South, VWindows.SE, VWindows.SW:
  117. IF (tmprow <= CARDINAL(Cursor.row)) THEN
  118. RETURN FALSE;
  119. END;
  120. ELSE
  121. END;
  122. CASE direction OF
  123. VWindows.East, VWindows.SE, VWindows.NE:
  124. IF (tmpcol <= CARDINAL(Cursor.col)) THEN
  125. RETURN FALSE;
  126. END
  127. ELSE
  128. END;
  129. CASE direction OF
  130. VWindows.West, VWindows.NW, VWindows.SW:
  131. IF (tmpcol >= CARDINAL(Cursor.col)) THEN
  132. RETURN FALSE;
  133. END;
  134. ELSE
  135. END;
  136. dist := Rectangles.Distance( Cursor, p2 );
  137. RETURN TRUE;
  138. END Candidate;
  139. BEGIN (*ClosestField*)
  140. OldField := TheFrame^.CurrentField;
  141. IF TheField # 0 THEN
  142. col := ScrnUtl1.VirtualFieldCol( TheFrame, TheField );
  143. row := ScrnUtl1.VirtualFieldRow( TheFrame, TheField );
  144. ELSE
  145. TheFrame^.CurrentField := 0;
  146. END;
  147. p1.col := INTEGER(col);
  148. p1.row := INTEGER(row);
  149. BestGuess := 0;
  150. BestDistance := 65535;
  151. CASE direction OF
  152. VWindows.East, VWindows.SW, VWindows.South, VWindows.SE:
  153. ListEnd := LastInputField(TheFrame);
  154. FieldCount := NextInputField( TheFrame, 0 );
  155. BestPoint.col := 32767;
  156. BestPoint.row := 32767;
  157. LOOP
  158. IF TheFrame^.CurrentField = ListEnd THEN
  159. EXIT
  160. END;
  161. IF Candidate( TheFrame, FieldCount, p1, p2, direction, dist ) THEN
  162. IF (dist < BestDistance) THEN
  163. BestDistance := dist;
  164. BestPoint := p2;
  165. BestGuess := FieldCount;
  166. END;
  167. IF (direction = VWindows.South)
  168. AND (p2.row > BestPoint.row) THEN
  169. EXIT
  170. ELSIF (direction = VWindows.East) AND ((p2.col >
  171. BestPoint.col) OR (p2.row > BestPoint.row)) THEN
  172. EXIT
  173. END;
  174. END;
  175. TheFrame^.CurrentField := FieldCount;
  176. FieldCount := NextInputField( TheFrame, 0 );
  177. END;
  178. ELSE
  179. ListStart := FirstInputField(TheFrame);
  180. FieldCount := PrevInputField( TheFrame, 0 );
  181. BestPoint.col := 0;
  182. BestPoint.row := 0;
  183. LOOP
  184. IF TheFrame^.CurrentField = ListStart THEN
  185. EXIT
  186. END;
  187. IF Candidate( TheFrame, FieldCount, p1, p2, direction, dist ) THEN
  188. IF (dist < BestDistance) THEN
  189. BestDistance := dist;
  190. BestPoint := p2;
  191. BestGuess := FieldCount;
  192. END;
  193. IF (direction = VWindows.North)
  194. AND (p2.row < BestPoint.row) THEN
  195. EXIT
  196. ELSIF (direction = VWindows.West) AND ((p2.col <
  197. BestPoint.col) OR (p2.row < BestPoint.row)) THEN
  198. EXIT
  199. END;
  200. END;
  201. TheFrame^.CurrentField := FieldCount;
  202. FieldCount := PrevInputField( TheFrame, 0 );
  203. END;
  204. END;
  205. TheFrame^.CurrentField := OldField;
  206. (* Preserve current field *)
  207. IF BestGuess # 0 THEN
  208. RETURN BestGuess;
  209. ELSE
  210. RETURN TheField;
  211. END;
  212. END ClosestField;
  213. PROCEDURE InSameRow( TheFrame: ScrnTypes.DisplayFrame; Field1, Field2:
  214. CARDINAL ): BOOLEAN;
  215. BEGIN
  216. RETURN (ScrnUtl1.VirtualFieldRow(TheFrame, Field1) =
  217. ScrnUtl1.VirtualFieldRow(TheFrame, Field2) );
  218. END InSameRow;
  219. PROCEDURE InSameCol( TheFrame: ScrnTypes.DisplayFrame; Field1, Field2:
  220. CARDINAL ): BOOLEAN;
  221. BEGIN
  222. RETURN (ScrnUtl1.VirtualFieldCol(TheFrame, Field1) =
  223. ScrnUtl1.VirtualFieldCol(TheFrame, Field2) );
  224. END InSameCol;
  225. (*Probably ought to move following two procedures to MakeFrame and
  226. add Horizontal boolean to FieldRecType.*)
  227. PROCEDURE InHorizGroup( TheFrame: ScrnTypes.DisplayFrame; TheField:
  228. CARDINAL ): BOOLEAN;
  229. BEGIN
  230. IF ScrnUtl1.FieldType( TheFrame, TheField ) # ScrnTypes.GroupMember THEN
  231. RETURN FALSE;
  232. END;
  233. IF ScrnUtl1.ChoiceNumber( TheFrame, TheField ) <
  234. ScrnUtl1.NumberOfChoices( TheFrame, TheField ) THEN
  235. IF (NOT InSameRow( TheFrame, TheField, TheField + 1 )) THEN
  236. RETURN FALSE;
  237. END;
  238. END;
  239. IF ScrnUtl1.ChoiceNumber( TheFrame, TheField ) > 1 THEN
  240. IF (NOT InSameRow( TheFrame, TheField, TheField - 1 )) THEN
  241. RETURN FALSE;
  242. END;
  243. END;
  244. RETURN TRUE;
  245. END InHorizGroup;
  246. PROCEDURE InVerticalGroup( TheFrame: ScrnTypes.DisplayFrame; TheField:
  247. CARDINAL ): BOOLEAN;
  248. BEGIN
  249. IF ScrnUtl1.FieldType( TheFrame, TheField ) # ScrnTypes.GroupMember THEN
  250. RETURN FALSE;
  251. END;
  252. IF ScrnUtl1.ChoiceNumber( TheFrame, TheField ) <
  253. ScrnUtl1.NumberOfChoices( TheFrame, TheField ) THEN
  254. IF (NOT InSameCol( TheFrame, TheField, TheField + 1 )) THEN
  255. RETURN FALSE;
  256. END;
  257. END;
  258. IF ScrnUtl1.ChoiceNumber( TheFrame, TheField ) > 1 THEN
  259. IF (NOT InSameCol( TheFrame, TheField, TheField - 1 )) THEN
  260. RETURN FALSE;
  261. END;
  262. END;
  263. RETURN TRUE;
  264. END InVerticalGroup;
  265. PROCEDURE NextSelection( TheFrame: ScrnTypes.DisplayFrame; TheField:
  266. CARDINAL ): CARDINAL;
  267. VAR
  268. TmpPtr: ScrnTypes.InputFieldPtr;
  269. BEGIN
  270. ScrnUtl1.GetFieldPtr( TheFrame, TheField, TmpPtr );
  271. IF TmpPtr^.GroupID = TmpPtr^.GroupSize THEN
  272. RETURN ScrnUtl1.FirstMember( TheFrame, TheField );
  273. ELSE
  274. RETURN TheField + 1;
  275. END;
  276. END NextSelection;
  277. PROCEDURE PrevSelection( TheFrame: ScrnTypes.DisplayFrame; TheField:
  278. CARDINAL ): CARDINAL;
  279. VAR
  280. TmpPtr: ScrnTypes.InputFieldPtr;
  281. BEGIN
  282. ScrnUtl1.GetFieldPtr( TheFrame, TheField, TmpPtr );
  283. IF TmpPtr^.GroupID = 1 THEN
  284. RETURN ScrnUtl1.FirstMember( TheFrame, TheField )
  285. + TmpPtr^.GroupSize - 1;
  286. ELSE
  287. RETURN TheField - 1;
  288. END;
  289. END PrevSelection;
  290. PROCEDURE SelectionKeyMatch( TheFrame: ScrnTypes.DisplayFrame; KeyHit:
  291. CARDINAL; VAR SelectedFieldNum: CARDINAL ): BOOLEAN;
  292. VAR
  293. found: BOOLEAN;
  294. ListEnd, cnt: CARDINAL;
  295. FieldPtr: ScrnTypes.InputFieldPtr;
  296. BEGIN
  297. IF KeyHit = 0 THEN
  298. (*Jonathan March's 21 Jun 88 fix.*)
  299. RETURN FALSE;
  300. END;
  301. cnt := 0;
  302. found := FALSE;
  303. ListEnd := GenLists.ListLength( TheFrame^.FieldList );
  304. WHILE (NOT found) AND (cnt < ListEnd) DO
  305. INC( cnt );
  306. ScrnUtl1.GetFieldPtr( TheFrame, cnt, FieldPtr );
  307. IF FieldPtr^.typ = ScrnTypes.GotoCode THEN
  308. found := KbdInput.CAPkey(KeyHit) = KbdInput.CAPkey(FieldPtr^.MenuKey);
  309. ELSIF FieldPtr^.typ = ScrnTypes.GroupMember THEN
  310. found := KbdInput.CAPkey(KeyHit) = KbdInput.CAPkey(FieldPtr^.ChoiceKey);
  311. END;
  312. END;
  313. IF found THEN
  314. SelectedFieldNum := cnt;
  315. END;
  316. RETURN found;
  317. END SelectionKeyMatch;
  318. PROCEDURE InSameGroup( TheFrame: ScrnTypes.DisplayFrame; Field1, Field2:
  319. CARDINAL ): BOOLEAN;
  320. BEGIN
  321. IF (ScrnUtl1.FieldType(TheFrame, Field1) # ScrnTypes.GroupMember) OR
  322. (ScrnUtl1.FieldType(TheFrame, Field2) # ScrnTypes.GroupMember) THEN
  323. RETURN FALSE;
  324. END;
  325. RETURN ScrnUtl1.FirstMember( TheFrame, Field1 ) =
  326. ScrnUtl1.FirstMember( TheFrame, Field2 );
  327. END InSameGroup;
  328. PROCEDURE MoveToSelected( VAR TheFrame: ScrnTypes.DisplayFrame; VAR
  329. TheField: CARDINAL );
  330. (* Pass this routine any field number that's a GroupMember,
  331. and it moves TheFrame^.CurrentField to the selected member
  332. of the group (and also sets TheField to the field number
  333. of that member). We assume the caller has sense enough
  334. not to call this for fields that are not GroupMembers. *)
  335. VAR
  336. cnt, FieldNum: CARDINAL;
  337. TmpPtr: ScrnTypes.InputFieldPtr;
  338. BEGIN
  339. FieldNum := ScrnUtl1.FirstMember( TheFrame,
  340. TheField );
  341. TheField := FieldNum;
  342. (*Save the number of the first choice in TheField, in
  343. case we don't find one that's selected.*)
  344. cnt := 1;
  345. LOOP
  346. ScrnUtl1.GetFieldPtr( TheFrame, FieldNum, TmpPtr );
  347. IF (cnt = TmpPtr^.GroupSize) OR (TmpPtr^.selected) THEN
  348. EXIT;
  349. END;
  350. INC( FieldNum );
  351. INC( cnt );
  352. END;
  353. IF TmpPtr^.selected THEN
  354. TheFrame^.CurrentField := FieldNum;
  355. TheField := FieldNum;
  356. ELSE
  357. TheFrame^.CurrentField := TheField;
  358. ScrnUtl1.GetFieldPtr( TheFrame, TheField, TmpPtr );
  359. (* 28 Dec 88: added this to guarantee that we're
  360. setting the ^.selected field of the first choice
  361. field rather than the last one. Fix contributed by
  362. Ulrik Schmidt. *)
  363. TmpPtr^.selected := TRUE;
  364. END;
  365. END MoveToSelected;
  366. PROCEDURE RequiredFilled( FrameRec: ScrnTypes.DisplayFrame; VAR FieldNum:
  367. CARDINAL ): BOOLEAN;
  368. VAR
  369. LocalList : GenLists.GenList;
  370. TmpPtr: ScrnTypes.InputFieldPtr;
  371. ImagePtr: ScrnTypes.ImageElmtPtr;
  372. ListEnd : CARDINAL;
  373. BEGIN
  374. ListEnd := ScrnUtl1.FieldListTotal( FrameRec );
  375. FieldNum := 1;
  376. WHILE FieldNum <= ListEnd DO
  377. (* look at each required field, until one is not filled *)
  378. ScrnUtl1.GetFieldPtr( FrameRec, FieldNum, TmpPtr );
  379. IF (TmpPtr^.typ = ScrnTypes.EditorCode) AND TmpPtr^.req THEN
  380. (*We've got a required Editor field*)
  381. IF ScrnUtl1.ListFromEdField( FrameRec,
  382. FrameRec^.CurrentField, LocalList ) AND
  383. ListUtils.IsBlankList( LocalList ) THEN
  384. RETURN FALSE;
  385. END;
  386. ELSIF TmpPtr^.req THEN
  387. ScrnUtl1.GetFieldImagePtr( FrameRec, FieldNum, ImagePtr );
  388. (* if field is required and not filled, flag it and exit *)
  389. IF PosUtils.IsBlank( ImagePtr^.text ) THEN
  390. RETURN FALSE;
  391. END;
  392. END;
  393. INC( FieldNum );
  394. END;
  395. FieldNum := 0;
  396. RETURN TRUE;
  397. END RequiredFilled;
  398. PROCEDURE MakeLegalKeys( TheFrame: ScrnTypes.DisplayFrame; VAR
  399. NewLegalKeys: KbdInput.KeyNumSet );
  400. (* construct the sets of legal keys for the field types *)
  401. VAR
  402. tmpkey, ListEnd, cnt: CARDINAL;
  403. FieldPtr: ScrnTypes.InputFieldPtr;
  404. BEGIN
  405. BigSets.SetUnion( UserOps.ScreenKeySet,
  406. UserOps.FunctKeySet, NewLegalKeys );
  407. (*Add the FunctKeySet to the ScreenKeySet.*)
  408. ListEnd := ScrnUtl1.FieldListTotal( TheFrame );
  409. IF ListEnd = 0 THEN
  410. RETURN;
  411. END;
  412. FOR cnt := 1 TO ListEnd DO
  413. ScrnUtl1.GetFieldPtr( TheFrame, cnt, FieldPtr );
  414. CASE FieldPtr^.typ OF
  415. ScrnTypes.GotoCode, ScrnTypes.GroupMember:
  416. IF FieldPtr^.typ = ScrnTypes.GotoCode THEN
  417. tmpkey := FieldPtr^.MenuKey;
  418. ELSE
  419. tmpkey := FieldPtr^.ChoiceKey;
  420. END;
  421. IF (tmpkey >= ORD('a')) AND (tmpkey <= ORD('z')) THEN
  422. (*This stuff gives us case insensitivity in selection
  423. characters.*)
  424. BigSets.InclSet( NewLegalKeys, tmpkey );
  425. BigSets.InclSet( NewLegalKeys, KbdInput.CAPkey(tmpkey) );
  426. ELSIF (tmpkey >= ORD('A')) AND (tmpkey <= ORD('Z')) THEN
  427. BigSets.InclSet( NewLegalKeys, tmpkey );
  428. BigSets.InclSet( NewLegalKeys, tmpkey + 32 );
  429. ELSE
  430. BigSets.InclSet( NewLegalKeys, tmpkey );
  431. END;
  432. ELSE
  433. (* fall through *)
  434. END;
  435. END;
  436. END MakeLegalKeys;
  437. PROCEDURE MovePointerBar( FrameRec: ScrnTypes.DisplayFrame; NewField :
  438. CARDINAL );
  439. VAR
  440. TmpStr : ARRAY [0..80] OF CHAR;
  441. NewRowsScrolled, NewColsScrolled : CARDINAL;
  442. FirstFieldCol, FirstFieldRow, LastFieldCol, LastFieldRow : CARDINAL;
  443. FirstVisibleRow, FirstVisibleCol, LastVisibleRow,
  444. LastVisibleCol : CARDINAL;
  445. Vis : Rectangles.ARectangle;
  446. PROCEDURE ChangeSelection( TheFrame: ScrnTypes.DisplayFrame; NewField:
  447. CARDINAL );
  448. VAR
  449. FieldPtr: ScrnTypes.InputFieldPtr;
  450. BEGIN
  451. ScrnUtl1.GetFieldPtr( TheFrame, TheFrame^.CurrentField,
  452. FieldPtr );
  453. FieldPtr^.selected := FALSE;
  454. FramePainter.RedrawField( FrameRec, FrameRec^.CurrentField, FALSE );
  455. (* Takes the pointer bar off the old field. *)
  456. FramePainter.RedrawField( TheFrame, NewField, TRUE );
  457. TheFrame^.CurrentField := NewField;
  458. ScrnUtl1.GetFieldPtr( TheFrame, TheFrame^.CurrentField,
  459. FieldPtr );
  460. FieldPtr^.selected := TRUE;
  461. IF UserOps.DoPrompting THEN
  462. GetPromptStr( FrameRec, FrameRec^.CurrentField, TmpStr );
  463. ShowPrompt( FrameRec, TmpStr );
  464. END;
  465. END ChangeSelection;
  466. BEGIN (* MovePointerBar *)
  467. IF NewField < FirstInputField(FrameRec) THEN
  468. NewField := LastInputField(FrameRec);
  469. ELSIF NewField > LastInputField( FrameRec ) THEN
  470. NewField := FirstInputField(FrameRec);
  471. ELSIF (ScrnUtl1.FieldType(FrameRec, NewField) =
  472. ScrnTypes.DispCode) THEN
  473. NewField := NextInputField( FrameRec, 0 );
  474. END;
  475. IF NewField = FrameRec^.CurrentField THEN
  476. RETURN;
  477. ELSIF FrameRec^.CurrentField = 0 THEN
  478. FrameRec^.CurrentField := FirstInputField(FrameRec);
  479. ELSIF InSameGroup( FrameRec, FrameRec^.CurrentField,
  480. NewField) THEN
  481. ChangeSelection( FrameRec, NewField );
  482. RETURN;
  483. ELSE
  484. FramePainter.RedrawField( FrameRec, FrameRec^.CurrentField, FALSE );
  485. (* Takes the pointer bar off the old field. This is
  486. in the ELSE clause because, if CurrentField is 0,
  487. we're placing the first pointer bar, and we don't
  488. need to take it off any other field.*)
  489. END;
  490. IF ScrnUtl1.FieldType(FrameRec, NewField) = ScrnTypes.GroupMember THEN
  491. (* This doesn't actually redraw the new field with the
  492. pointer bar on it. It just sets the variables that
  493. will put us on the right field if we're moving into
  494. a group from somewhere outside it; notice that we RETURN
  495. above if we're moving inside the same group. *)
  496. MoveToSelected( FrameRec, NewField );
  497. END;
  498. FrameRec^.CurrentField := NewField;
  499. (* Now we've lost track of what the old field was. *)
  500. (* Check and see if scrolling is needed *)
  501. IF NOT ScrnUtl1.EntirelyVisible(FrameRec, NewField) THEN
  502. GetScrollableArea(FrameRec, Vis);
  503. FirstVisibleRow := CARDINAL(Vis.row1) + FrameRec^.RowsScrolled
  504. - FrameRec^.startrow;
  505. LastVisibleRow := CARDINAL(Vis.row2) + FrameRec^.RowsScrolled
  506. - FrameRec^.startrow;
  507. FirstVisibleCol := CARDINAL(Vis.col1) + FrameRec^.ColsScrolled
  508. - FrameRec^.startcol;
  509. LastVisibleCol := CARDINAL(Vis.col2) + FrameRec^.ColsScrolled
  510. - FrameRec^.startcol;
  511. FirstFieldRow := ScrnUtl1.VirtualFieldRow(FrameRec, NewField);
  512. FirstFieldCol := ScrnUtl1.VirtualFieldCol(FrameRec, NewField);
  513. LastFieldRow := FirstFieldRow +
  514. ScrnUtl1.FieldHeight(FrameRec, NewField) - 1;
  515. LastFieldCol := FirstFieldCol +
  516. ScrnUtl1.FieldWidth(FrameRec, NewField) - 1;
  517. (* Default to no scrolling *)
  518. NewRowsScrolled := FrameRec^.RowsScrolled;
  519. NewColsScrolled := FrameRec^.ColsScrolled;
  520. (* Vertical *)
  521. IF FirstFieldRow < FirstVisibleRow THEN
  522. IF ScrnUtl1.InputFieldsAbove(FrameRec, NewField) THEN
  523. DEC(NewRowsScrolled, FirstVisibleRow-FirstFieldRow);
  524. ELSE
  525. (* Make sure any text above first input field is
  526. visible. *)
  527. NewRowsScrolled := 0;
  528. END (* if *);
  529. ELSIF LastFieldRow > LastVisibleRow THEN
  530. IF ScrnUtl1.InputFieldsBelow(FrameRec, NewField) THEN
  531. INC(NewRowsScrolled, LastFieldRow-LastVisibleRow);
  532. ELSE
  533. (* Scroll to bottom of frame *)
  534. INC(NewRowsScrolled, ScrnUtl1.PartOutside(FrameRec, Vis,
  535. VWindows.South));
  536. END;
  537. END (* if *);
  538. (* Horizontal *)
  539. IF FirstFieldCol < FirstVisibleCol THEN
  540. IF ScrnUtl1.InputFieldsToLeft(FrameRec, NewField) THEN
  541. DEC(NewColsScrolled, FirstVisibleCol-FirstFieldCol);
  542. ELSE
  543. NewColsScrolled := 0;
  544. END;
  545. ELSIF LastFieldCol > LastVisibleCol THEN
  546. IF ScrnUtl1.InputFieldsToRight(FrameRec, NewField) THEN
  547. INC(NewColsScrolled, LastFieldCol-LastVisibleCol);
  548. ELSE
  549. INC(NewColsScrolled, ScrnUtl1.PartOutside(FrameRec, Vis,
  550. VWindows.East));
  551. END;
  552. END (* if *);
  553. SlideFrame(FrameRec, FrameRec^.ColsScrolled, NewColsScrolled,
  554. FrameRec^.RowsScrolled, NewRowsScrolled);
  555. END (* if not entirely visible *);
  556. IF ScrnUtl1.FieldType(FrameRec, NewField) # ScrnTypes.EditorCode THEN
  557. FramePainter.RedrawField(FrameRec, NewField, TRUE);
  558. (* Hightlight field *)
  559. END;
  560. IF UserOps.DoPrompting THEN
  561. GetPromptStr( FrameRec, FrameRec^.CurrentField, TmpStr );
  562. ShowPrompt( FrameRec, TmpStr );
  563. END;
  564. END MovePointerBar;
  565. PROCEDURE PageDown(TheFrame : ScrnTypes.DisplayFrame);
  566. (*
  567. Move to the field nearest to one scroll height below
  568. the current one.
  569. *)
  570. VAR
  571. Vis : Rectangles.ARectangle;
  572. NewField, ScrollHeight, NewRow, NewCol, Distance : CARDINAL;
  573. BEGIN
  574. IF ScrnUtl1.EntirelyVisible( TheFrame, LastInputField(TheFrame) ) THEN
  575. MovePointerBar( TheFrame, LastInputField(TheFrame) );
  576. RETURN;
  577. END;
  578. (*
  579. The next field isn't currently visible, need to
  580. repaint the entire frame
  581. *)
  582. GetScrollableArea(TheFrame, Vis);
  583. ScrollHeight := CARDINAL(Vis.row2-Vis.row1)+1;
  584. NewRow := ScrnUtl1.VirtualFieldRow(TheFrame, TheFrame^.CurrentField)
  585. + ScrollHeight;
  586. NewCol := ScrnUtl1.VirtualFieldCol(TheFrame, TheFrame^.CurrentField);
  587. NewField := ClosestField(TheFrame, 0, NewCol, NewRow+1,
  588. VWindows.North);
  589. MovePointerBar( TheFrame, NewField );
  590. END PageDown;
  591. PROCEDURE PageUp(TheFrame : ScrnTypes.DisplayFrame);
  592. (*
  593. Move to the field nearest to one scroll height above
  594. the current one.
  595. *)
  596. VAR
  597. Vis : Rectangles.ARectangle;
  598. NewField, vrow, ScrollHeight, NewRow, NewCol: CARDINAL;
  599. BEGIN
  600. GetScrollableArea(TheFrame, Vis);
  601. ScrollHeight := CARDINAL(Vis.row2-Vis.row1)+1;
  602. IF TheFrame^.RowsScrolled = 0 THEN
  603. MovePointerBar( TheFrame, FirstInputField(TheFrame) );
  604. ELSE
  605. vrow := ScrnUtl1.VirtualFieldRow(TheFrame, TheFrame^.CurrentField);
  606. NewRow := Numbers.IntMax( 1, INTEGER(vrow) - INTEGER(ScrollHeight) );
  607. NewCol := ScrnUtl1.VirtualFieldCol(TheFrame, TheFrame^.CurrentField);
  608. NewField := ClosestField(TheFrame, 0, NewCol, NewRow-1,
  609. VWindows.South);
  610. MovePointerBar( TheFrame, NewField );
  611. END;
  612. END PageUp;
  613. (*================== Exported Procedures ========================*)
  614. PROCEDURE FirstInputField(FrameRec : ScrnTypes.DisplayFrame) : CARDINAL;
  615. VAR
  616. LastField, NewField : CARDINAL;
  617. BEGIN
  618. LastField := ScrnUtl1.FieldListTotal(FrameRec);
  619. NewField := 1;
  620. WHILE (ScrnUtl1.FieldType(FrameRec, NewField) = ScrnTypes.DispCode) DO
  621. IF NewField < LastField THEN
  622. INC(NewField);
  623. ELSE
  624. RETURN 1;
  625. END;
  626. END (* while *);
  627. RETURN NewField;
  628. END FirstInputField;
  629. PROCEDURE LastInputField(FrameRec : ScrnTypes.DisplayFrame) : CARDINAL;
  630. VAR
  631. NewField : CARDINAL;
  632. BEGIN
  633. NewField := ScrnUtl1.FieldListTotal(FrameRec);
  634. WHILE (ScrnUtl1.FieldType(FrameRec, NewField) = ScrnTypes.DispCode) DO
  635. IF NewField > 1 THEN
  636. DEC(NewField);
  637. ELSE
  638. RETURN ScrnUtl1.FieldListTotal(FrameRec);
  639. END (* if *);
  640. END (* while *);
  641. RETURN NewField;
  642. END LastInputField;
  643. PROCEDURE NextInputField( FrameRec : ScrnTypes.DisplayFrame;
  644. skip: CARDINAL ): CARDINAL;
  645. VAR
  646. LastField, NewField : CARDINAL;
  647. BEGIN
  648. LastField := ScrnUtl1.FieldListTotal(FrameRec);
  649. IF FrameRec^.CurrentField < (LastField - skip) THEN
  650. NewField := FrameRec^.CurrentField + skip + 1;
  651. ELSE
  652. NewField := 1;
  653. END;
  654. WHILE (ScrnUtl1.FieldType(FrameRec, NewField) = ScrnTypes.DispCode)
  655. AND (NewField # FrameRec^.CurrentField) DO
  656. IF NewField < LastField THEN
  657. INC(NewField);
  658. ELSE
  659. NewField := 1;
  660. END;
  661. END (* while *);
  662. RETURN NewField;
  663. END NextInputField;
  664. PROCEDURE PrevInputField( VAR FrameRec : ScrnTypes.DisplayFrame;
  665. skip: CARDINAL ) : CARDINAL;
  666. VAR
  667. NewField : CARDINAL;
  668. BEGIN
  669. IF (FrameRec^.CurrentField + skip) > 1 THEN
  670. NewField := (FrameRec^.CurrentField - skip) - 1;
  671. ELSE
  672. NewField := ScrnUtl1.FieldListTotal(FrameRec);
  673. END;
  674. WHILE (ScrnUtl1.FieldType(FrameRec, NewField) = ScrnTypes.DispCode)
  675. AND (NewField # FrameRec^.CurrentField) DO
  676. IF NewField > 1 THEN
  677. DEC(NewField);
  678. ELSE
  679. NewField := ScrnUtl1.FieldListTotal(FrameRec);
  680. END;
  681. END (* while *);
  682. RETURN NewField;
  683. END PrevInputField;
  684. PROCEDURE HiLiteSelChars( TheFrame: ScrnTypes.DisplayFrame );
  685. VAR
  686. FieldListEnd, cnt: CARDINAL;
  687. TmpType : CHAR;
  688. BEGIN
  689. FieldListEnd := ScrnUtl1.FieldListTotal( TheFrame );
  690. FOR cnt := 1 TO FieldListEnd DO
  691. TmpType := ScrnUtl1.FieldType( TheFrame, cnt );
  692. IF (TmpType = ScrnTypes.GotoCode) OR
  693. (TmpType = ScrnTypes.GroupMember) THEN
  694. IF ScrnUtl1.EntirelyVisible( TheFrame, cnt ) THEN
  695. FramePainter.RedrawField( TheFrame, cnt, FALSE );
  696. END;
  697. END;
  698. END;
  699. END HiLiteSelChars;
  700. PROCEDURE LookAlive( TheFrame: ScrnTypes.DisplayFrame );
  701. VAR
  702. TmpStr: ARRAY [0..127] OF CHAR;
  703. fldtype : CHAR;
  704. BEGIN
  705. IF TheFrame^.action <= 'Z' THEN
  706. (* We are temporarily lowercasing the .action character
  707. to tell us whether the frame is under the control of
  708. ControlFrame. We use this to disable LookAlive when
  709. it is called in places where it probably shouldn't be.
  710. Not good. *)
  711. RETURN;
  712. END;
  713. HiLiteSelChars( TheFrame );
  714. IF (TheFrame^.CurrentField > 0) AND
  715. (TheFrame^.CurrentField <= ScrnUtl1.FieldListTotal(TheFrame)) THEN
  716. IF UserOps.DoPrompting THEN
  717. GetPromptStr( TheFrame, TheFrame^.CurrentField, TmpStr );
  718. ShowPrompt( TheFrame, TmpStr );
  719. END;
  720. fldtype := ScrnUtl1.FieldType( TheFrame, TheFrame^.CurrentField );
  721. IF ScrnUtl1.EntirelyVisible( TheFrame, TheFrame^.CurrentField ) THEN
  722. FramePainter.RedrawField( TheFrame, TheFrame^.CurrentField, TRUE );
  723. IF (fldtype # ScrnTypes.GotoCode) AND (fldtype #
  724. ScrnTypes.GroupMember) AND (fldtype #
  725. ScrnTypes.DispCode) THEN
  726. VWindows.SetCursorHeight( VWindows.CurrentWindow, 2 );
  727. END;
  728. END;
  729. END;
  730. END LookAlive;
  731. PROCEDURE ReconstructFrame( TheFrame: ScrnTypes.DisplayFrame );
  732. VAR
  733. TmpStr: ARRAY [0..127] OF CHAR;
  734. BEGIN
  735. FramePainter.ShowDisplayFrame( TheFrame, 0, 0, 0, 0 );
  736. LookAlive( TheFrame );
  737. END ReconstructFrame;
  738. PROCEDURE ShowPrompt( FrameRec: ScrnTypes.DisplayFrame;
  739. str : ARRAY OF CHAR );
  740. (*Display the prompt centered within the prompt line
  741. specified in UserOps.*)
  742. VAR
  743. tmp: ARRAY [0..127] OF CHAR;
  744. (*We use tmp because the caller may not have left enough
  745. room in str to pad it with blanks.*)
  746. BEGIN
  747. ScrnUtl1.SetPromptColors( FrameRec );
  748. M2Strings.Assign( str, tmp );
  749. StrEdit.Center( tmp, UserOps.PromptLength );
  750. VWindows.DrawStr( FrameRec^.WindowHandle, UserOps.PromptCol,
  751. UserOps.PromptRow, SYSTEM.ADR(tmp),
  752. UserOps.PromptLength );
  753. END ShowPrompt;
  754. PROCEDURE GetPromptStr( TheFrame: ScrnTypes.DisplayFrame; TheField:
  755. CARDINAL; VAR TheStr: ARRAY OF CHAR );
  756. VAR
  757. FieldRec: ScrnTypes.InputFieldRecord;
  758. TypeCode: CARDINAL;
  759. MaxStr, MinStr: ARRAY [0..31] OF CHAR;
  760. BEGIN
  761. ScrnUtl1.GetFieldRec( TheFrame, TheField, FieldRec );
  762. IF FieldRec.PromptNum # 0 THEN
  763. GenLists.GetElmt( TheFrame^.PromptList, FieldRec.PromptNum,
  764. TheStr, TypeCode );
  765. ELSE
  766. FieldTypes.GetDefaultPrompt( FieldRec.typ, TheStr );
  767. CASE FieldRec.typ OF
  768. ScrnTypes.IntCode :
  769. StrConv.LongIntegerToStr( FieldRec.iMax, 1, MaxStr );
  770. StrConv.LongIntegerToStr( FieldRec.iMin, 1, MinStr);
  771. | ScrnTypes.RealCode :
  772. StrConv.RealToStr( FieldRec.rMax, 1, 0, MaxStr );
  773. StrConv.RealToStr( FieldRec.rMin, 1, 0, MinStr);
  774. ELSE
  775. RETURN;
  776. END;
  777. StrEdit.ReplaceStr( 'MAX', MaxStr, TheStr );
  778. StrEdit.ReplaceStr( 'MIN', MinStr, TheStr );
  779. END;
  780. END GetPromptStr;
  781. PROCEDURE SlideFrame( FrameRec: ScrnTypes.DisplayFrame;
  782. OldColsScrolled, NewColsScrolled, OldRowsScrolled,
  783. NewRowsScrolled: CARDINAL );
  784. VAR
  785. Vis: Rectangles.ARectangle;
  786. vdist, ScrollableHeight : INTEGER;
  787. BEGIN
  788. FrameRec^.ColsScrolled := NewColsScrolled;
  789. FrameRec^.RowsScrolled := NewRowsScrolled;
  790. vdist := INTEGER(NewRowsScrolled) - INTEGER(OldRowsScrolled);
  791. IF (vdist = 0) AND (NewColsScrolled = OldColsScrolled) THEN
  792. RETURN;
  793. END;
  794. ScrnUtl1.SetNormalColors( FrameRec );
  795. GetScrollableArea( FrameRec, Vis );
  796. WITH Vis DO
  797. IF NewColsScrolled # OldColsScrolled THEN
  798. (*We repaint the whole window if we're going to have to
  799. scroll horizontally.*)
  800. VWindows.ClearPart( FrameRec^.WindowHandle, col1,
  801. row1, col2, row2 );
  802. FramePainter.RedrawArea( FrameRec, CARDINAL(col1),
  803. CARDINAL(row1), CARDINAL(col2), CARDINAL(row2) );
  804. RETURN;
  805. END;
  806. ScrollableHeight := CARDINAL(row2) - CARDINAL(row1) + 1;
  807. IF ABS(vdist) > ScrollableHeight THEN
  808. IF vdist > 0 THEN
  809. vdist := ScrollableHeight;
  810. ELSE
  811. vdist := -ScrollableHeight;
  812. END;
  813. END;
  814. IF NOT VWindows.ScrollVertically(FrameRec^.WindowHandle,
  815. col1, row1, col2, row2, vdist ) THEN
  816. (*tough luck if the window manager doesn't support scrolling*)
  817. END;
  818. IF vdist > 0 THEN
  819. (*Redraw the area at the bottom because we scrolled up.*)
  820. FramePainter.RedrawArea( FrameRec, CARDINAL(col1),
  821. (CARDINAL(row2) - CARDINAL(ABS(vdist))) + 1,
  822. CARDINAL(col2), CARDINAL(row2) );
  823. ELSE
  824. (*Redraw the area at the top because we scrolled down.*)
  825. FramePainter.RedrawArea( FrameRec, CARDINAL(col1),
  826. CARDINAL(row1),CARDINAL(col2),CARDINAL(row1+ABS(vdist)-1));
  827. END (* if *);
  828. END (* with Vis *);
  829. END SlideFrame;
  830. PROCEDURE ControlFrame(VAR FrameRec : ScrnTypes.DisplayFrame;
  831. LandingField : CARDINAL; message : ARRAY OF CHAR;
  832. RedrawFirst : BOOLEAN; VAR NextFrame: ScrnTypes.AFrameName );
  833. VAR
  834. MaxChoices, SavedFieldNum: CARDINAL;
  835. ReturnValue, FrameAbove, FrameBelow, FrameLeft,
  836. FrameRight : ScrnTypes.AFrameName;
  837. LastKey : CARDINAL;
  838. AbsFldCol, AbsFldRow: INTEGER;
  839. LocalMessage : ARRAY [0..79] OF CHAR;
  840. TmpScreenKeys: KbdInput.KeyNumSet;
  841. FieldRec: ScrnTypes.InputFieldRecord;
  842. PROCEDURE HitAnyKey( VAR NextFrame: ScrnTypes.AFrameName );
  843. (* prompt for any key to be hit and exit, returning
  844. either normal next or TheKeyHandler result (keep
  845. asking for input if user asks for help or time) *)
  846. VAR
  847. key : CARDINAL;
  848. tryagain : BOOLEAN;
  849. BEGIN
  850. IF UserOps.DoPrompting THEN
  851. ShowPrompt( FrameRec, 'Press Any Key To Continue.' );
  852. END;
  853. REPEAT
  854. key := KbdInput.KeyHit( KbdInput.AnyKeyNum );
  855. IF BigSets.InSet( UserOps.FunctKeySet, key ) THEN
  856. (* if in special key set, execute user program *)
  857. SavedFieldNum := FrameRec^.CurrentField;
  858. UserOps.TheKeyHandler( FrameRec, key, NextFrame );
  859. ScrnUtl1.SetCurrentField( FrameRec, SavedFieldNum );
  860. tryagain := PosUtils.Equal( NextFrame, ScrnTypes.ContinueInput );
  861. ELSE
  862. (* they hit a key not in the special key set, so
  863. return *)
  864. M2Strings.Assign( FrameRec^.normlnext, NextFrame );
  865. tryagain := FALSE;
  866. END;
  867. UNTIL NOT tryagain;
  868. END HitAnyKey;
  869. PROCEDURE ShowBadType( FrameRec: ScrnTypes.DisplayFrame );
  870. VAR
  871. ImageRec: ScrnTypes.ImageElement;
  872. dumstr: ARRAY [0..79] OF CHAR;
  873. BEGIN
  874. ScrnUtl1.GetFieldImageRec( FrameRec, FrameRec^.CurrentField,
  875. ImageRec );
  876. M2Strings.Concat("Bad type in ControlFrame. Text = ", ImageRec.text,
  877. dumstr );
  878. ErrorManager.WARN( dumstr );
  879. END ShowBadType;
  880. PROCEDURE NormalKeyResponse( VAR FrameRec:
  881. ScrnTypes.DisplayFrame; VAR TheFieldRec:
  882. ScrnTypes.InputFieldRecord; VAR LastKey: CARDINAL; VAR
  883. ReturnValue: ScrnTypes.AFrameName );
  884. VAR
  885. NewField: CARDINAL;
  886. BEGIN
  887. NewField := FrameRec^.CurrentField;
  888. (*Just in case we don't need to move it.*)
  889. IF LastKey = Key.Down THEN
  890. IF InVerticalGroup( FrameRec, FrameRec^.CurrentField ) THEN
  891. NewField := NextSelection( FrameRec, FrameRec^.CurrentField );
  892. ELSIF NOT ScrnUtl1.InputFieldsBelow( FrameRec,
  893. FrameRec^.CurrentField ) THEN
  894. IF FrameBelow[0] # 0C THEN
  895. M2Strings.Assign( FrameBelow, ReturnValue );
  896. ELSE
  897. NewField := FirstInputField(FrameRec);
  898. END;
  899. ELSE
  900. NewField := ClosestField( FrameRec,
  901. FrameRec^.CurrentField, 0, 0, VWindows.South );
  902. END;
  903. MovePointerBar( FrameRec, NewField );
  904. ELSIF LastKey = Key.Up THEN
  905. IF InVerticalGroup( FrameRec, FrameRec^.CurrentField ) THEN
  906. NewField := PrevSelection( FrameRec, FrameRec^.CurrentField );
  907. ELSIF NOT ScrnUtl1.InputFieldsAbove( FrameRec,
  908. FrameRec^.CurrentField ) THEN
  909. IF FrameAbove[0] # 0C THEN
  910. M2Strings.Assign( FrameAbove, ReturnValue );
  911. ELSE
  912. NewField := LastInputField( FrameRec );
  913. END;
  914. ELSE
  915. NewField := ClosestField( FrameRec,
  916. FrameRec^.CurrentField, 0, 0, VWindows.North );
  917. END;
  918. MovePointerBar( FrameRec, NewField );
  919. (* RST Change *)
  920. ELSIF LastKey = Key.CtrlPgUp THEN
  921. MovePointerBar( FrameRec, FirstInputField(FrameRec));
  922. ELSIF LastKey = Key.CtrlPgDn THEN
  923. MovePointerBar( FrameRec, LastInputField(FrameRec));
  924. ELSIF LastKey = Key.PgUp THEN
  925. PageUp(FrameRec);
  926. ELSIF LastKey = Key.PgDn THEN
  927. PageDown(FrameRec);
  928. ELSIF LastKey = Key.Right THEN
  929. IF InHorizGroup( FrameRec, FrameRec^.CurrentField ) THEN
  930. NewField := NextSelection( FrameRec, FrameRec^.CurrentField );
  931. ELSIF (NOT ScrnUtl1.InputFieldsToRight( FrameRec,
  932. FrameRec^.CurrentField )) AND (FrameRight[0] # 0C) THEN
  933. M2Strings.Assign( FrameRight, ReturnValue );
  934. ELSE
  935. NewField := NextInputField( FrameRec, 0 );
  936. END;
  937. MovePointerBar( FrameRec, NewField );
  938. ELSIF LastKey = Key.Left THEN
  939. IF InHorizGroup( FrameRec, FrameRec^.CurrentField ) THEN
  940. NewField := PrevSelection( FrameRec, FrameRec^.CurrentField );
  941. ELSIF (NOT ScrnUtl1.InputFieldsToLeft( FrameRec,
  942. FrameRec^.CurrentField )) AND (FrameLeft[0] # 0C) THEN
  943. M2Strings.Assign( FrameLeft, ReturnValue );
  944. ELSE
  945. NewField := PrevInputField( FrameRec, 0 );
  946. END;
  947. MovePointerBar( FrameRec, NewField );
  948. ELSIF LastKey = Key.Tab THEN
  949. MovePointerBar( FrameRec, NextInputField( FrameRec, 0 ));
  950. ELSIF LastKey = Key.BackTab THEN
  951. MovePointerBar( FrameRec, PrevInputField( FrameRec, 0 ));
  952. ELSIF LastKey = Key.Return THEN
  953. IF TheFieldRec.typ = ScrnTypes.GotoCode THEN
  954. (* force jump *)
  955. M2Strings.Assign( TheFieldRec.ReturnVal, ReturnValue );
  956. ELSIF (TheFieldRec.typ = ScrnTypes.GroupMember) THEN
  957. IF (MaxChoices = 1) THEN
  958. (* There are no other fields in the frame except
  959. this group. We know we have to leave, but first
  960. we have to choose a return value (for
  961. compatibility with 1.4.) *)
  962. IF M2Strings.Length(TheFieldRec.fnam) > 0 THEN
  963. (*This lets you store the return value in the
  964. field name of the choice. *)
  965. M2Strings.Assign( TheFieldRec.fnam, ReturnValue );
  966. ELSE
  967. M2Strings.Assign( FrameRec^.normlnext, ReturnValue );
  968. END;
  969. ELSE
  970. (* There are fields outside this group. Move to the
  971. first one following it.*)
  972. NewField := NextInputField( FrameRec, (TheFieldRec.GroupSize -
  973. TheFieldRec.GroupID) );
  974. MovePointerBar( FrameRec, NewField );
  975. END;
  976. ELSIF MaxChoices#1 THEN
  977. MovePointerBar( FrameRec, NextInputField( FrameRec, 0 ) );
  978. ELSE
  979. M2Strings.Assign( FrameRec^.normlnext, ReturnValue);
  980. (* only one field, and it's an input field; leave.*)
  981. END;
  982. ELSIF SelectionKeyMatch( FrameRec, LastKey, NewField ) THEN
  983. MovePointerBar( FrameRec, NewField );
  984. ScrnUtl1.GetFieldRec( FrameRec, NewField, TheFieldRec );
  985. IF (ScrnUtl1.AllFieldsThisType(FrameRec, ScrnTypes.GotoCode)) THEN
  986. (* If the user presses the selection character of a menu item
  987. and the frame contains a mixture of field types, we move the
  988. pointer bar to the goto field, but we don't submit the frame, as
  989. we do if the frame contains only goto fields. If you want to
  990. submit the frame in that case, change this IF to
  991. something like 'IF TheFieldRec.typ = ScrnTypes.GotoCode' *)
  992. M2Strings.Assign( TheFieldRec.ReturnVal, ReturnValue );
  993. END;
  994. IF (ScrnUtl1.AllFieldsThisType(FrameRec, ScrnTypes.GroupMember)) THEN
  995. M2Strings.Assign( TheFieldRec.fnam, ReturnValue );
  996. END;
  997. END;
  998. END NormalKeyResponse;
  999. PROCEDURE NoFieldsKeyResponse( VAR FrameRec: ScrnTypes.DisplayFrame;
  1000. VAR LastKey: CARDINAL; VAR ReturnValue: ScrnTypes.AFrameName );
  1001. VAR
  1002. VisibleArea: Rectangles.ARectangle;
  1003. nOutside, oldcs, oldrs, WindowHeight: CARDINAL;
  1004. BEGIN
  1005. ScrnUtl1.GetVisibleArea( FrameRec, VisibleArea );
  1006. WindowHeight := VisibleArea.row2 - VisibleArea.row1 + 1;
  1007. oldcs := FrameRec^.ColsScrolled;
  1008. oldrs := FrameRec^.RowsScrolled;
  1009. StrEdit.AssignStr( ScrnTypes.ContinueInput, ReturnValue );
  1010. IF LastKey = Key.Down THEN
  1011. IF ScrnUtl1.PartOutside( FrameRec, VisibleArea,
  1012. VWindows.South ) > 0 THEN
  1013. INC( FrameRec^.RowsScrolled );
  1014. END;
  1015. ELSIF LastKey = Key.Up THEN
  1016. IF ScrnUtl1.PartOutside( FrameRec, VisibleArea,
  1017. VWindows.North ) > 0 THEN
  1018. DEC( FrameRec^.RowsScrolled );
  1019. END;
  1020. ELSIF LastKey = Key.PgUp THEN
  1021. IF ScrnUtl1.PartOutside( FrameRec, VisibleArea,
  1022. VWindows.North ) > WindowHeight THEN
  1023. DEC( FrameRec^.RowsScrolled, WindowHeight );
  1024. ELSE
  1025. FrameRec^.RowsScrolled := 0;
  1026. END;
  1027. ELSIF LastKey = Key.PgDn THEN
  1028. IF ScrnUtl1.PartOutside( FrameRec, VisibleArea,
  1029. VWindows.South ) > WindowHeight THEN
  1030. INC( FrameRec^.RowsScrolled, WindowHeight );
  1031. ELSIF FrameRec^.VirtualHeight > WindowHeight THEN
  1032. FrameRec^.RowsScrolled := FrameRec^.VirtualHeight - WindowHeight;
  1033. ELSE
  1034. FrameRec^.RowsScrolled := 0;
  1035. END;
  1036. ELSIF LastKey = Key.Right THEN
  1037. IF ScrnUtl1.PartOutside( FrameRec, VisibleArea,
  1038. VWindows.East ) > 0 THEN
  1039. INC( FrameRec^.ColsScrolled );
  1040. END;
  1041. ELSIF LastKey = Key.Left THEN
  1042. IF ScrnUtl1.PartOutside( FrameRec, VisibleArea,
  1043. VWindows.West ) > 0 THEN
  1044. DEC( FrameRec^.ColsScrolled );
  1045. END;
  1046. ELSIF LastKey = Key.Tab THEN
  1047. nOutside := ScrnUtl1.PartOutside( FrameRec, VisibleArea, VWindows.East);
  1048. IF nOutside > 8 THEN
  1049. INC( FrameRec^.ColsScrolled, 8 );
  1050. ELSIF nOutside > 0 THEN
  1051. INC( FrameRec^.ColsScrolled, nOutside);
  1052. END;
  1053. ELSIF LastKey = Key.BackTab THEN
  1054. nOutside := ScrnUtl1.PartOutside( FrameRec, VisibleArea,VWindows.West);
  1055. IF nOutside > 8 THEN
  1056. DEC( FrameRec^.ColsScrolled, 8 );
  1057. ELSIF nOutside > 0 THEN
  1058. DEC( FrameRec^.ColsScrolled, nOutside);
  1059. END;
  1060. ELSIF LastKey = Key.Return THEN
  1061. M2Strings.Assign( FrameRec^.normlnext, ReturnValue);
  1062. RETURN;
  1063. END;
  1064. SlideFrame( FrameRec, oldcs, FrameRec^.ColsScrolled,
  1065. oldrs, FrameRec^.RowsScrolled );
  1066. END NoFieldsKeyResponse;
  1067. PROCEDURE RepaintVisibleArea();
  1068. VAR
  1069. FirstVisibleRow, FirstVisibleCol, LastVisibleRow,
  1070. LastVisibleCol : CARDINAL;
  1071. Vis : Rectangles.ARectangle;
  1072. BEGIN
  1073. ScrnUtl1.GetVisibleArea(FrameRec, Vis);
  1074. WITH Vis DO
  1075. FirstVisibleRow := CARDINAL(row1);
  1076. LastVisibleRow := CARDINAL(row2);
  1077. FirstVisibleCol := CARDINAL(col1);
  1078. LastVisibleCol := CARDINAL(col2);
  1079. (* 11 Oct 88: removed +RowsScrolled from each of
  1080. these lines at suggestion of Karta Khalsa and
  1081. Ulrik Schmidt. *)
  1082. END;
  1083. FramePainter.RedrawArea( FrameRec, FirstVisibleCol, FirstVisibleRow,
  1084. LastVisibleCol, LastVisibleRow);
  1085. END RepaintVisibleArea;
  1086. BEGIN
  1087. (*ControlFrame*)
  1088. VWindows.SetCursorHeight( FrameRec^.WindowHandle, 0 );
  1089. M2Strings.Assign(message, LocalMessage);
  1090. IF RedrawFirst THEN
  1091. RepaintVisibleArea();
  1092. END;
  1093. MaxChoices := ScrnUtl1.FieldGroupTotal( FrameRec );
  1094. (* Number of choices or fields in the frame, counting each
  1095. group of choice fields as a single choice. *)
  1096. M2Strings.Assign( FrameRec^.normlnext, NextFrame );
  1097. MakeLegalKeys( FrameRec, TmpScreenKeys );
  1098. StrEdit.LowerStr( FrameRec^.action );
  1099. (* Added 13 Nov 88. We lowercase the action char while
  1100. the frame is active and restore it to uppercase when it is
  1101. not so that we have a temporary way of determining
  1102. whether the frame is active. Don't rely on this. In
  1103. a future release we will add a boolean to the DisplayFrame
  1104. record and quit using this kludge. *)
  1105. IF CAP(FrameRec^.action) = ScrnTypes.DispCode THEN
  1106. (* Do not process user input. Note that we don't call
  1107. EraseFrame if the frame is both DisplayOnly and
  1108. ClearAfter, since this combination really doesn't make
  1109. sense -- latter is probably programmer's mistake. *)
  1110. RETURN;
  1111. END;
  1112. IF FrameRec^.EntryBox[0] # 0C THEN
  1113. (*Now we change the appearance of the border to let the
  1114. user know the frame is active.*)
  1115. ScrnUtl1.BoxFrame( FrameRec, TRUE );
  1116. END;
  1117. IF (CAP(FrameRec^.action) = 'W') THEN
  1118. (* wait for any user input, then exit *)
  1119. HitAnyKey( NextFrame );
  1120. IF FrameRec^.ExitBox[0] # 0C THEN
  1121. (*Now we change the appearance of the border to let the
  1122. user know the frame is no longer active.*)
  1123. ScrnUtl1.BoxFrame( FrameRec, FALSE );
  1124. END;
  1125. IF FrameRec^.ClearAfter THEN
  1126. FrameManager.EraseFrame( FrameRec );
  1127. END;
  1128. RETURN;
  1129. END;
  1130. HiLiteSelChars( FrameRec );
  1131. StrEdit.SetLength( ReturnValue, 0 );
  1132. ScrnUtl1.GetFrameLinks( FrameRec, FrameAbove, FrameBelow, FrameLeft,
  1133. FrameRight );
  1134. FrameRec^.CurrentField := 0;
  1135. (*Prevent MovePointerBar from exiting if CurrentField
  1136. happens to equal LandingField.*)
  1137. IF (LandingField=0) AND (MaxChoices > 0) THEN
  1138. MovePointerBar( FrameRec, FirstInputField(FrameRec));
  1139. (*highlights first choice*)
  1140. END;
  1141. REPEAT
  1142. IF (LandingField # 0) AND (MaxChoices > 0) THEN
  1143. (* LandingField is not 0, so highlight the specified
  1144. field. We do this at the top of each loop so that
  1145. ControlFrame can signal errors from within the loop. *)
  1146. MovePointerBar( FrameRec, LandingField );
  1147. LandingField := 0;
  1148. END;
  1149. IF M2Strings.Length( LocalMessage ) > 0 THEN
  1150. MsgBox2.StrMsgBox( FrameRec, VWindows.SE, LocalMessage );
  1151. StrEdit.SetLength( LocalMessage, 0 );
  1152. END;
  1153. IF (MaxChoices = 0) OR
  1154. (ScrnUtl1.AllFieldsThisType(FrameRec, ScrnTypes.DispCode)) THEN
  1155. LastKey := KbdInput.KeyHit( TmpScreenKeys );
  1156. UserOps.TheKeyHandler( FrameRec, LastKey, ReturnValue );
  1157. IF PosUtils.Equal( ReturnValue, ScrnTypes.ContinueInput ) THEN
  1158. NoFieldsKeyResponse( FrameRec, LastKey, ReturnValue );
  1159. END;
  1160. ELSE
  1161. ScrnUtl1.GetFieldRec( FrameRec, FrameRec^.CurrentField, FieldRec );
  1162. SavedFieldNum := FrameRec^.CurrentField;
  1163. CASE FieldRec.typ OF
  1164. ScrnTypes.GotoCode, ScrnTypes.GroupMember :
  1165. LastKey := KbdInput.KeyHit( TmpScreenKeys );
  1166. UserOps.TheKeyHandler( FrameRec, LastKey, ReturnValue );
  1167. ELSE
  1168. AbsFldRow := ScrnUtl1.AbsFieldRow(FrameRec,
  1169. FrameRec^.CurrentField);
  1170. AbsFldCol := ScrnUtl1.AbsFieldCol(FrameRec,
  1171. FrameRec^.CurrentField);
  1172. UserOps.TheFieldHandler( FrameRec,
  1173. AbsFldCol, AbsFldRow, LastKey, ReturnValue );
  1174. ScrnUtl1.GetFieldRec( FrameRec, FrameRec^.CurrentField,
  1175. FieldRec );
  1176. IF FieldRec.ChangeMade THEN
  1177. FrameRec^.FrameChanged := TRUE;
  1178. END;
  1179. END;
  1180. IF PosUtils.Equal( 'MovePointerBar', ReturnValue ) THEN
  1181. StrEdit.AssignStr( ScrnTypes.ContinueInput, ReturnValue );
  1182. MovePointerBar( FrameRec, FrameRec^.CurrentField );
  1183. ELSE
  1184. ScrnUtl1.SetCurrentField( FrameRec, SavedFieldNum );
  1185. IF PosUtils.Equal( ReturnValue, ScrnTypes.ContinueInput ) THEN
  1186. (* Now, process defined action keys *)
  1187. NormalKeyResponse( FrameRec, FieldRec, LastKey, ReturnValue );
  1188. END;
  1189. END;
  1190. IF (NOT PosUtils.Equal(ReturnValue, ScrnTypes.ContinueInput))
  1191. AND (LastKey # UserOps.BackupKey)
  1192. AND (LastKey # UserOps.ExitKey) THEN
  1193. (* Looks like they want to submit the screen. Let's
  1194. check to see if all required fields are full *)
  1195. IF PosUtils.Equal( ReturnValue, ScrnTypes.SubmitInput ) THEN
  1196. ReturnValue := FrameRec^.normlnext;
  1197. END;
  1198. IF PosUtils.Equal( ReturnValue, ScrnTypes.CancelInput ) THEN
  1199. ReturnValue := FrameRec^.parent;
  1200. ELSIF (NOT RequiredFilled( FrameRec, LandingField )) THEN
  1201. StrEdit.AssignStr( RequiredMessage, LocalMessage );
  1202. LastKey := 65535;
  1203. StrEdit.AssignStr( ScrnTypes.ContinueInput,
  1204. ReturnValue );
  1205. (*We do this to make sure we go back through the loop.*)
  1206. END;
  1207. END;
  1208. END;
  1209. UNTIL (NOT PosUtils.Equal(ReturnValue, ScrnTypes.ContinueInput));
  1210. M2Strings.Assign( ReturnValue, NextFrame );
  1211. (*
  1212. IF MaxChoices > 0 THEN
  1213. FramePainter.RedrawField( FrameRec, FrameRec^.CurrentField, FALSE );
  1214. END;
  1215. Taken care of by RepaintVisibleArea, below.
  1216. *)
  1217. FrameRec^.action := CAP( FrameRec^.action );
  1218. IF FrameRec^.ExitBox[0] # 0C THEN
  1219. (*Now we change the appearance of the border to let the
  1220. user know the frame is no longer active.*)
  1221. ScrnUtl1.BoxFrame( FrameRec, FALSE );
  1222. END;
  1223. IF FrameRec^.ClearAfter THEN
  1224. FrameManager.EraseFrame( FrameRec );
  1225. ELSE
  1226. RepaintVisibleArea();
  1227. (* Erases pointer bar and selection characters. We do
  1228. this mostly to avoid the problem of restoring things
  1229. like highlighted selection characters when things
  1230. pop up over inactive frames. *)
  1231. END;
  1232. END ControlFrame;
  1233. BEGIN
  1234. Initialized := FALSE;
  1235. Init();
  1236. END InputManager.