SAMPLE20.MOD 3.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127
  1. (******************************************************************************)
  2. (* SAMPLE20.MOD *)
  3. (* *)
  4. (* PopUps Example *)
  5. (* Taken from SAMPLE20.PAS - Metagraphics Software Corporation (c) 1987-1989 *)
  6. (* *)
  7. (* PSW 10/31/90 11:39pm *)
  8. (******************************************************************************)
  9. MODULE Sample20;
  10. (*
  11. * Graphix
  12. * Release 3.7
  13. * (c) Copyright 1986-1992 PMI
  14. * Green Bay, Wisconsin
  15. * (414) 468-6040
  16. * All rights reserved
  17. *
  18. *)
  19. IMPORT GrQry;
  20. IMPORT GrConst;
  21. IMPORT GrPorts;
  22. IMPORT GrFonts;
  23. IMPORT Meta;
  24. IMPORT IO;
  25. IMPORT Lib;
  26. FROM GrConst IMPORT rect;
  27. FROM GrPorts IMPORT adsPort;
  28. FROM GrFonts IMPORT adsFont;
  29. (* standard memory allocation procedures *)
  30. FROM Storage IMPORT ALLOCATE, DEALLOCATE, Available;
  31. VAR
  32. GrafixCard,
  33. CommPort: INTEGER;
  34. ch: CHAR;
  35. scrnR,tR: GrConst.rect;
  36. imagePtr: GrConst.adsImage;
  37. i,j: INTEGER;
  38. imBytes: CARDINAL;
  39. memBytes: WORD;
  40. menuTitle: ARRAY [0..128] OF CHAR;
  41. PROCEDURE OpenWindow(VAR R: rect; TITLE: ARRAY OF CHAR);
  42. VAR
  43. tR:rect;
  44. tsize: INTEGER;
  45. tdescent: INTEGER;
  46. scrnPort: adsPort;
  47. txftptr: adsFont;
  48. BEGIN
  49. imBytes := VAL(CARDINAL, Meta.ImageSize(R));
  50. IF NOT(Available(imBytes)) THEN
  51. GrQry.GrQuit('Insufficient memory', 1);
  52. END;
  53. ALLOCATE(ADDRESS(imagePtr), imBytes );
  54. Meta.ReadImage(R,imagePtr); (* Save the window area *)
  55. Meta.FillRect(R,1); (* Clear the window *)
  56. Meta.PenMode(GrConst.zXORz); (* Outline the window *)
  57. Meta.FrameRect(R);
  58. Meta.GetPort( scrnPort ); (* get address of current port *)
  59. (* assign address of the current port's font record *)
  60. txftptr := scrnPort^.txFont;
  61. (* get values of some font fields *)
  62. tdescent := txftptr^.descent;
  63. tsize := txftptr^.lnSpacing;
  64. (* Display title block *)
  65. Meta.SetRect(tR, R.Xmin,R.Ymin,R.Xmax,R.Ymin+tsize);
  66. Meta.FillRect(tR,0);
  67. Meta.MoveTo (tR.Xmin+5, tR.Ymax - tdescent );
  68. Meta.DrawString(TITLE)
  69. END OpenWindow;
  70. PROCEDURE CloseWindow(VAR R:rect);
  71. BEGIN
  72. Meta.RasterOp (GrConst.zREPz);
  73. Meta.WriteImage (R, imagePtr); (* Restore the window area *)
  74. DEALLOCATE(imagePtr, imBytes);
  75. END CloseWindow;
  76. BEGIN
  77. (* init the system *)
  78. GrQry.GrInit(GrafixCard, CommPort);
  79. i := Meta.InitGrafix(-GrafixCard);
  80. IF (i # 0) THEN
  81. GrQry.GrInitErr(GrafixCard, CommPort, i)
  82. END;
  83. Meta.SetDisplay(GrConst.GrafPg0);
  84. Meta.ScreenRect(scrnR);
  85. Meta.FillRect(scrnR, 3);
  86. Meta.SetRect(tR, 75, 75, 250, 150);
  87. FOR j := 1 TO 3 DO
  88. Meta.MoveTo(10,20);
  89. Meta.DrawString('Press a key to show menu ');
  90. ch := IO.RdKey(); (* Wait for a keypress *)
  91. menuTitle := 'Menu Title';
  92. OpenWindow (tR, menuTitle);
  93. Meta.MoveTo(10,20);
  94. Meta.DrawString('Press a key to remove menu');
  95. ch := IO.RdKey(); (* Wait for a keypress *)
  96. CloseWindow(tR);
  97. Meta.OffsetRect(tR, 150,20)
  98. END;
  99. Meta.MoveTo(10,20);
  100. Meta.DrawString('Press Return to terminate ');
  101. ch := IO.RdKey(); (* Wait for a keypress *)
  102. GrQry.GrQuit('', 0);
  103. END Sample20.