SAMPLE03.LST 9.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243
  1. Listing:
  2. 1 (******************************************************************************)
  3. 2 (* SAMPLE03.MOD *)
  4. 3 (* *)
  5. 4 (* SetFont Example *)
  6. 5 (* Taken from SAMPLE03.PAS - Metagraphics Software Corporation (c) 1987-1989 *)
  7. 6 (* *)
  8. 7 (* PSW 10/31/90 08:20pm *)
  9. 8 (******************************************************************************)
  10. 9
  11. 10 MODULE Sample03;
  12. 11 (*
  13. 12 * Graphix
  14. 13 * Release 3.7
  15. 14 * (c) Copyright 1986-1992 PMI
  16. 15 * Green Bay, Wisconsin
  17. 16 * (414) 468-6040
  18. 17 * All rights reserved
  19. 18 *
  20. 19 *)
  21. 20
  22. 21 IMPORT GrQry;
  23. 22 IMPORT GrConst;
  24. 23 IMPORT GrFonts;
  25. 24 IMPORT GrPorts;
  26. 25 IMPORT Meta;
  27. 26 IMPORT IO;
  28. 27
  29. 28 (* standard memory allocation procedures *)
  30. 29 FROM Storage IMPORT ALLOCATE, DEALLOCATE, Available;
  31. 30
  32. 31 VAR
  33. 32 GrafixCard,
  34. 33 CommPort: INTEGER;
  35. 34 i, loadErr: INTEGER;
  36. 35 font1Ptr,
  37. 36 font2Ptr,
  38. 37 font3Ptr,
  39. 38 original: GrFonts.adsFont;
  40. ***** ^ not supported yet
  41. 39 filename: ARRAY[0..128] OF CHAR;
  42. ***** ^ not supported yet
  43. ***** ^ not supported yet
  44. 40 scrnR: GrConst.rect;
  45. ***** ^ not supported yet
  46. 41 ch: CHAR;
  47. 42 scrnPort: GrPorts.adsPort;
  48. ***** ^ not supported yet
  49. 43
  50. 44
  51. 45 BEGIN
  52. 46 (* init the system *)
  53. 47
  54. 48 GrQry.GrInit(GrafixCard, CommPort);
  55. ***** ^ not supported yet
  56. ***** ^ not supported yet
  57. ***** ^ not supported yet
  58. 49
  59. 50 i := Meta.InitGrafix(-GrafixCard);
  60. ***** ^ not supported yet
  61. ***** ^ not supported yet
  62. ***** ^ not supported yet
  63. 51
  64. 52 IF (i # 0) THEN
  65. 53 (* Display reason for no go *)
  66. 54 GrQry.GrInitErr(GrafixCard, CommPort, i);
  67. ***** ^ not supported yet
  68. ***** ^ not supported yet
  69. ***** ^ not supported yet
  70. 55 END;
  71. 56
  72. 57 (* get original fonts buffer pointer *)
  73. 58 Meta.GetPort(scrnPort);
  74. ***** ^ not supported yet
  75. ***** ^ not supported yet
  76. ***** ^ not supported yet
  77. 59 original := scrnPort^.txFont;
  78. ***** ^ not supported yet
  79. ***** ^ not supported yet
  80. ***** ^ not supported yet
  81. 60
  82. 61 ALLOCATE(ADDRESS(font1Ptr), 3000);
  83. ***** ^ not supported yet
  84. ***** ^ undeclared identifier
  85. ***** ^ not supported yet
  86. ***** ^ not supported yet
  87. 62 loadErr := Meta.FileLoad('SYSTEM08.FNT', ADDRESS(font1Ptr), 3000);
  88. ***** ^ not supported yet
  89. ***** ^ not supported yet
  90. ***** ^ not supported yet
  91. ***** ^ undeclared identifier
  92. ***** ^ not supported yet
  93. ***** ^ not supported yet
  94. 63 IF (loadErr < 0) THEN
  95. 64 GrQry.GrQuit('FileLoad(SYSTEM08.FNT) Error.', 1);
  96. ***** ^ not supported yet
  97. ***** ^ not supported yet
  98. ***** ^ not supported yet
  99. ***** ^ not supported yet
  100. 65 END;
  101. 66
  102. 67 ALLOCATE(ADDRESS(font2Ptr), 3000);
  103. ***** ^ not supported yet
  104. ***** ^ undeclared identifier
  105. ***** ^ not supported yet
  106. ***** ^ not supported yet
  107. 68 loadErr := Meta.FileLoad('SYSTEM16.FNT', ADDRESS(font2Ptr), 3000);
  108. ***** ^ not supported yet
  109. ***** ^ not supported yet
  110. ***** ^ not supported yet
  111. ***** ^ undeclared identifier
  112. ***** ^ not supported yet
  113. ***** ^ not supported yet
  114. 69 IF (loadErr < 0) THEN
  115. 70 GrQry.GrQuit('FileLoad(SYSTEM16.FNT) Error.', 1);
  116. ***** ^ not supported yet
  117. ***** ^ not supported yet
  118. ***** ^ not supported yet
  119. ***** ^ not supported yet
  120. 71 END;
  121. 72
  122. 73 ALLOCATE(ADDRESS(font3Ptr), 4000);
  123. ***** ^ not supported yet
  124. ***** ^ undeclared identifier
  125. ***** ^ not supported yet
  126. ***** ^ not supported yet
  127. 74 loadErr := Meta.FileLoad('ROMANSIM.FNT', ADDRESS(font3Ptr), 4000);
  128. ***** ^ not supported yet
  129. ***** ^ not supported yet
  130. ***** ^ not supported yet
  131. ***** ^ undeclared identifier
  132. ***** ^ not supported yet
  133. ***** ^ not supported yet
  134. 75 IF (loadErr < 0) THEN
  135. 76 GrQry.GrQuit('FileLoad(ROMANSIM.FNT) Error.', 1);
  136. ***** ^ not supported yet
  137. ***** ^ not supported yet
  138. ***** ^ not supported yet
  139. ***** ^ not supported yet
  140. 77 END;
  141. 78
  142. 79 Meta.ScreenRect(scrnR);
  143. ***** ^ not supported yet
  144. ***** ^ not supported yet
  145. ***** ^ not supported yet
  146. 80 Meta.SetDisplay(GrConst.GrafPg0);
  147. ***** ^ not supported yet
  148. ***** ^ not supported yet
  149. ***** ^ not supported yet
  150. ***** ^ not supported yet
  151. 81 Meta.EraseRect(scrnR);
  152. ***** ^ not supported yet
  153. ***** ^ not supported yet
  154. ***** ^ not supported yet
  155. 82 Meta.TextSize(14, 14); (* Set text size for stroked font, ROMANSIM.FNT *)
  156. ***** ^ not supported yet
  157. ***** ^ not supported yet
  158. ***** ^ not supported yet
  159. 83 Meta.TextFace(GrConst.cProportional);
  160. ***** ^ not supported yet
  161. ***** ^ not supported yet
  162. ***** ^ not supported yet
  163. ***** ^ not supported yet
  164. 84
  165. 85 Meta.SetFont(ADDRESS(font1Ptr)); (* Set font 1 active *)
  166. ***** ^ not supported yet
  167. ***** ^ not supported yet
  168. ***** ^ undeclared identifier
  169. ***** ^ not supported yet
  170. 86 Meta.MoveTo(10, 130);
  171. ***** ^ not supported yet
  172. ***** ^ not supported yet
  173. ***** ^ not supported yet
  174. 87 Meta.DrawString('Text output using SYSTEM08.FNT');
  175. ***** ^ not supported yet
  176. ***** ^ not supported yet
  177. ***** ^ not supported yet
  178. 88
  179. 89 Meta.SetFont(ADDRESS(font2Ptr)); (* Set font 2 active *)
  180. ***** ^ not supported yet
  181. ***** ^ not supported yet
  182. ***** ^ undeclared identifier
  183. ***** ^ not supported yet
  184. 90 Meta.MoveTo(10, 150);
  185. ***** ^ not supported yet
  186. ***** ^ not supported yet
  187. ***** ^ not supported yet
  188. 91 Meta.DrawString('Text output using SYSTEM16.FNT');
  189. ***** ^ not supported yet
  190. ***** ^ not supported yet
  191. ***** ^ not supported yet
  192. 92
  193. 93 Meta.SetFont(ADDRESS(font3Ptr)); (* Set font 3 active *)
  194. ***** ^ not supported yet
  195. ***** ^ not supported yet
  196. ***** ^ undeclared identifier
  197. ***** ^ not supported yet
  198. 94 Meta.MoveTo(10, 170);
  199. ***** ^ not supported yet
  200. ***** ^ not supported yet
  201. ***** ^ not supported yet
  202. 95 Meta.DrawString('Text output using ROMANSIM.FNT');
  203. ***** ^ not supported yet
  204. ***** ^ not supported yet
  205. ***** ^ not supported yet
  206. 96
  207. 97 Meta.SetFont(ADDRESS(original)); (* Set original font active *)
  208. ***** ^ not supported yet
  209. ***** ^ not supported yet
  210. ***** ^ undeclared identifier
  211. ***** ^ not supported yet
  212. 98 Meta.MoveTo(10, 190);
  213. ***** ^ not supported yet
  214. ***** ^ not supported yet
  215. ***** ^ not supported yet
  216. 99 Meta.DrawString('Text output using original system font');
  217. ***** ^ not supported yet
  218. ***** ^ not supported yet
  219. ***** ^ not supported yet
  220. 100
  221. 101 Meta.MoveTo(10, 20);
  222. ***** ^ not supported yet
  223. ***** ^ not supported yet
  224. ***** ^ not supported yet
  225. 102 Meta.DrawString('Press return to terminate');
  226. ***** ^ not supported yet
  227. ***** ^ not supported yet
  228. ***** ^ not supported yet
  229. 103 ch := IO.RdChar(); (* Wait for a keypress *)
  230. ***** ^ not supported yet
  231. ***** ^ not supported yet
  232. ***** ^ not supported yet
  233. 104
  234. 105 GrQry.GrQuit('', 0);
  235. ***** ^ not supported yet
  236. ***** ^ not supported yet
  237. ***** ^ not supported yet
  238. 106 END Sample03.
  239. 131 errors