TPATTERN.LST 13 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376
  1. Listing:
  2. 1 (******************************************************************************)
  3. 2 (* TPATTERN.MOD *)
  4. 3 (* *)
  5. 4 (* MetaWINDOW HOWTO: program series. Demonstrates patterns and shapes. *)
  6. 5 (* Transcribed from TPATTERN.C METAGRAPHICS SOFTWARE CORPORATION (c) 1987-1989*)
  7. 6 (* *)
  8. 7 (* PSW 10/31/90 02:44am *)
  9. 8 (******************************************************************************)
  10. 9
  11. 10 MODULE TPattern;
  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 GrConst;
  23. 22 IMPORT GrPorts;
  24. 23 IMPORT Meta;
  25. 24 IMPORT GrQry;
  26. 25 IMPORT IO;
  27. 26
  28. 27 FROM GrConst IMPORT rect, point, polyHead;
  29. ***** ^ duplicate identifier
  30. 28
  31. 29 VAR
  32. 30 GrafixCard,
  33. 31 CommPort: INTEGER;
  34. 32 sR,R: rect;
  35. 33 ScrnXmax,
  36. 34 ScrnYmax,
  37. 35 x,y,z,
  38. 36 dx,dy,
  39. 37 dxx,dyy,
  40. 38 h,i,j,k,
  41. 39 clr,pat,
  42. 40 object: INTEGER;
  43. 41 p_pts: ARRAY[0..6] OF point; (* The polygon point series *)
  44. ***** ^ not supported yet
  45. ***** ^ not supported yet
  46. 42 p_hdr: polyHead; (* the polygon header array *)
  47. 43
  48. 44
  49. 45 BEGIN
  50. 46 (* init the system *)
  51. 47
  52. 48 GrQry.GrQuery(GrafixCard, CommPort);
  53. ***** ^ not supported yet
  54. ***** ^ not supported yet
  55. ***** ^ not supported yet
  56. 49
  57. 50 i := Meta.InitGrafix(-GrafixCard);
  58. ***** ^ not supported yet
  59. ***** ^ not supported yet
  60. ***** ^ not supported yet
  61. 51
  62. 52 IF (i # 0) THEN
  63. 53 (* Display reason for no go *)
  64. 54 GrQry.GrInitErr(GrafixCard, CommPort, i);
  65. ***** ^ not supported yet
  66. ***** ^ not supported yet
  67. ***** ^ not supported yet
  68. 55 END;
  69. 56
  70. 57 IO.WrStr('TPATTERN - Color and pattern display');
  71. ***** ^ not supported yet
  72. ***** ^ not supported yet
  73. ***** ^ not supported yet
  74. 58 IO.WrLn; IO.WrLn;
  75. ***** ^ not supported yet
  76. ***** ^ not supported yet
  77. ***** ^ not supported yet
  78. ***** ^ not supported yet
  79. 59 IO.WrStr('What object to use ?');
  80. ***** ^ not supported yet
  81. ***** ^ not supported yet
  82. ***** ^ not supported yet
  83. 60 IO.WrLn;
  84. ***** ^ not supported yet
  85. ***** ^ not supported yet
  86. 61 IO.WrStr(' 1) Rectangles');
  87. ***** ^ not supported yet
  88. ***** ^ not supported yet
  89. ***** ^ not supported yet
  90. 62 IO.WrLn;
  91. ***** ^ not supported yet
  92. ***** ^ not supported yet
  93. 63 IO.WrStr(' 2) RoundRectangles');
  94. ***** ^ not supported yet
  95. ***** ^ not supported yet
  96. ***** ^ not supported yet
  97. 64 IO.WrLn;
  98. ***** ^ not supported yet
  99. ***** ^ not supported yet
  100. 65 IO.WrStr(' 3) Ovals');
  101. ***** ^ not supported yet
  102. ***** ^ not supported yet
  103. ***** ^ not supported yet
  104. 66 IO.WrLn;
  105. ***** ^ not supported yet
  106. ***** ^ not supported yet
  107. 67 IO.WrStr(' 4) Arcs');
  108. ***** ^ not supported yet
  109. ***** ^ not supported yet
  110. ***** ^ not supported yet
  111. 68 IO.WrLn;
  112. ***** ^ not supported yet
  113. ***** ^ not supported yet
  114. 69 IO.WrStr(' 5) Polygons [ ]');
  115. ***** ^ not supported yet
  116. ***** ^ not supported yet
  117. ***** ^ not supported yet
  118. 70 IO.WrChar(CHR(8));
  119. ***** ^ not supported yet
  120. ***** ^ not supported yet
  121. ***** ^ undeclared identifier
  122. ***** ^ not supported yet
  123. 71 IO.WrChar(CHR(8));
  124. ***** ^ not supported yet
  125. ***** ^ not supported yet
  126. ***** ^ undeclared identifier
  127. ***** ^ not supported yet
  128. 72
  129. 73 object := IO.RdInt();
  130. ***** ^ not supported yet
  131. ***** ^ not supported yet
  132. ***** ^ not supported yet
  133. 74
  134. 75 IF (object < 1) OR (object > 5) THEN
  135. 76 GrQry.GrQuit('Illegal object!', 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.SetDisplay(GrConst.GrafPg0);
  143. ***** ^ not supported yet
  144. ***** ^ not supported yet
  145. ***** ^ not supported yet
  146. ***** ^ not supported yet
  147. 80 Meta.ScreenRect(sR);
  148. ***** ^ not supported yet
  149. ***** ^ not supported yet
  150. ***** ^ not supported yet
  151. 81 Meta.EraseRect(sR);
  152. ***** ^ not supported yet
  153. ***** ^ not supported yet
  154. ***** ^ not supported yet
  155. 82 Meta.RasterOp(GrConst.zREPz);
  156. ***** ^ not supported yet
  157. ***** ^ not supported yet
  158. ***** ^ not supported yet
  159. ***** ^ not supported yet
  160. 83 ScrnXmax := sR.Xmax;
  161. ***** ^ not supported yet
  162. ***** ^ not supported yet
  163. 84 ScrnYmax := sR.Ymax;
  164. ***** ^ not supported yet
  165. ***** ^ not supported yet
  166. 85
  167. 86 (* set up the polygon header array *)
  168. 87 p_hdr.polyBgn := 0;
  169. ***** ^ not supported yet
  170. ***** ^ not supported yet
  171. 88 p_hdr.polyEnd := 6;
  172. ***** ^ not supported yet
  173. ***** ^ not supported yet
  174. 89 p_hdr.polyRect := sR;
  175. ***** ^ not supported yet
  176. ***** ^ not supported yet
  177. ***** ^ not supported yet
  178. 90
  179. 91 dx := (ScrnXmax+1) DIV 8;
  180. 92 dy := (ScrnYmax+1) DIV 4;
  181. 93 dxx := dx DIV 5;
  182. 94 dyy := dy DIV 6;
  183. 95
  184. 96 clr := Meta.QueryColors();
  185. ***** ^ not supported yet
  186. ***** ^ not supported yet
  187. ***** ^ not supported yet
  188. 97 k := clr - 1;
  189. 98
  190. 99 FOR h := 0 TO 15 DO
  191. 100 INC(k, 31);
  192. ***** ^ undeclared identifier
  193. ***** ^ not supported yet
  194. 101 pat := 0;
  195. 102 y := 0;
  196. 103
  197. 104 FOR i := 0 TO 3 DO (* 4 down *)
  198. 105 x := 0;
  199. 106 FOR j := 0 TO 7 DO (* 8 across *)
  200. 107 Meta.SetRect(R, x, y, x+(dx-dxx), y+(dy-dyy));
  201. ***** ^ not supported yet
  202. ***** ^ not supported yet
  203. ***** ^ not supported yet
  204. ***** ^ not supported yet
  205. 108 Meta.BackColor(k); Meta.PenColor(clr-k);
  206. ***** ^ not supported yet
  207. ***** ^ not supported yet
  208. ***** ^ not supported yet
  209. ***** ^ not supported yet
  210. ***** ^ not supported yet
  211. ***** ^ not supported yet
  212. 109
  213. 110 CASE object OF
  214. 111 | 1:
  215. 112 Meta.FillRect(R, pat);
  216. ***** ^ not supported yet
  217. ***** ^ not supported yet
  218. ***** ^ not supported yet
  219. ***** ^ not supported yet
  220. 113 Meta.FrameRect(R);
  221. ***** ^ not supported yet
  222. ***** ^ not supported yet
  223. ***** ^ not supported yet
  224. 114 | 2:
  225. 115 Meta.FillRoundRect(R, dxx, dyy, pat);
  226. ***** ^ not supported yet
  227. ***** ^ not supported yet
  228. ***** ^ not supported yet
  229. ***** ^ not supported yet
  230. 116 Meta.FrameRoundRect(R, dxx, dyy);
  231. ***** ^ not supported yet
  232. ***** ^ not supported yet
  233. ***** ^ not supported yet
  234. ***** ^ not supported yet
  235. 117 | 3:
  236. 118 Meta.FillOval(R, pat);
  237. ***** ^ not supported yet
  238. ***** ^ not supported yet
  239. ***** ^ not supported yet
  240. ***** ^ not supported yet
  241. 119 Meta.FrameOval(R);
  242. ***** ^ not supported yet
  243. ***** ^ not supported yet
  244. ***** ^ not supported yet
  245. 120 | 4:
  246. 121 Meta.FillArc(R, pat*80, 450, pat);
  247. ***** ^ not supported yet
  248. ***** ^ not supported yet
  249. ***** ^ not supported yet
  250. ***** ^ not supported yet
  251. 122 Meta.FrameArc(R, pat*80, 450);
  252. ***** ^ not supported yet
  253. ***** ^ not supported yet
  254. ***** ^ not supported yet
  255. ***** ^ not supported yet
  256. 123 | 5:
  257. 124 z := 0;
  258. 125
  259. 126 p_pts[z].X := x;
  260. ***** ^ not supported yet
  261. ***** ^ not supported yet
  262. ***** ^ not supported yet
  263. 127 p_pts[z].Y := y;
  264. ***** ^ not supported yet
  265. ***** ^ not supported yet
  266. ***** ^ not supported yet
  267. 128 INC(z);
  268. ***** ^ undeclared identifier
  269. ***** ^ not supported yet
  270. 129
  271. 130 p_pts[z].X := x + ((dx-dxx) DIV 2);
  272. ***** ^ not supported yet
  273. ***** ^ not supported yet
  274. ***** ^ not supported yet
  275. 131 p_pts[z].Y := y + (dy-dyy);
  276. ***** ^ not supported yet
  277. ***** ^ not supported yet
  278. ***** ^ not supported yet
  279. 132 INC(z);
  280. ***** ^ undeclared identifier
  281. ***** ^ not supported yet
  282. 133
  283. 134 p_pts[z].X := x + (dx-dxx);
  284. ***** ^ not supported yet
  285. ***** ^ not supported yet
  286. ***** ^ not supported yet
  287. 135 p_pts[z].Y := y;
  288. ***** ^ not supported yet
  289. ***** ^ not supported yet
  290. ***** ^ not supported yet
  291. 136 INC(z);
  292. ***** ^ undeclared identifier
  293. ***** ^ not supported yet
  294. 137
  295. 138 p_pts[z].X := x + (dx-dxx);
  296. ***** ^ not supported yet
  297. ***** ^ not supported yet
  298. ***** ^ not supported yet
  299. 139 p_pts[z].Y := y + (dy-dyy);
  300. ***** ^ not supported yet
  301. ***** ^ not supported yet
  302. ***** ^ not supported yet
  303. 140 INC(z);
  304. ***** ^ undeclared identifier
  305. ***** ^ not supported yet
  306. 141
  307. 142 p_pts[z].X := x + ((dx-dxx) DIV 2);
  308. ***** ^ not supported yet
  309. ***** ^ not supported yet
  310. ***** ^ not supported yet
  311. 143 p_pts[z].Y := y;
  312. ***** ^ not supported yet
  313. ***** ^ not supported yet
  314. ***** ^ not supported yet
  315. 144 INC(z);
  316. ***** ^ undeclared identifier
  317. ***** ^ not supported yet
  318. 145
  319. 146 p_pts[z].X := x;
  320. ***** ^ not supported yet
  321. ***** ^ not supported yet
  322. ***** ^ not supported yet
  323. 147 p_pts[z].Y := y + (dy-dyy);
  324. ***** ^ not supported yet
  325. ***** ^ not supported yet
  326. ***** ^ not supported yet
  327. 148 INC(z);
  328. ***** ^ undeclared identifier
  329. ***** ^ not supported yet
  330. 149
  331. 150 p_pts[z].X := x;
  332. ***** ^ not supported yet
  333. ***** ^ not supported yet
  334. ***** ^ not supported yet
  335. 151 p_pts[z].Y := y;
  336. ***** ^ not supported yet
  337. ***** ^ not supported yet
  338. ***** ^ not supported yet
  339. 152
  340. 153 Meta.FillPoly(1, ADR(p_hdr), ADR(p_pts), pat)
  341. ***** ^ not supported yet
  342. ***** ^ not supported yet
  343. ***** ^ undeclared identifier
  344. ***** ^ not supported yet
  345. ***** ^ undeclared identifier
  346. ***** ^ not supported yet
  347. ***** ^ not supported yet
  348. 154 END;
  349. 155
  350. 156 INC(x, dx);
  351. ***** ^ undeclared identifier
  352. ***** ^ not supported yet
  353. 157 INC(pat);
  354. ***** ^ undeclared identifier
  355. ***** ^ not supported yet
  356. 158 INC(k)
  357. ***** ^ undeclared identifier
  358. ***** ^ not supported yet
  359. 159 END;
  360. 160
  361. 161 INC(y, dy)
  362. ***** ^ undeclared identifier
  363. ***** ^ not supported yet
  364. 162 END
  365. 163 END;
  366. 164
  367. 165 GrQry.GrQuit('', 0)
  368. ***** ^ not supported yet
  369. ***** ^ not supported yet
  370. ***** ^ not supported yet
  371. 166 END TPattern.
  372. 204 errors