HILBERT.LST 16 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461
  1. Listing:
  2. 1 (******************************************************************************)
  3. 2 (* HILBERT.MOD *)
  4. 3 (* *)
  5. 4 (* MetaWINDOW pretty graphics program *)
  6. 5 (* Transcribed from HILBERT.C METAGRAPHICS SOFTWARE CORPORATION (c) 1987-1989 *)
  7. 6 (* *)
  8. 7 (* PSW 06/28/91 08:30am *)
  9. 8 (******************************************************************************)
  10. 9
  11. 10 MODULE Hilbert;
  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 IO;
  24. 23 IMPORT Lib;
  25. 24 IMPORT GrConst;
  26. 25 IMPORT Meta;
  27. 26
  28. 27 VAR
  29. 28 GrafixCard,
  30. 29 CommPort,
  31. 30 xa, ya,
  32. 31 x, y,
  33. 32 ox, oy,
  34. 33 i, j,
  35. 34 h, h0,
  36. 35 penColr,
  37. 36 maxColr,
  38. 37 cnt: INTEGER;
  39. 38 vR, R1, R2: GrConst.rect;
  40. ***** ^ not supported yet
  41. 39
  42. 40 PROCEDURE a(i: INTEGER); FORWARD;
  43. 41 PROCEDURE b(i: INTEGER); FORWARD;
  44. 42 PROCEDURE c(i: INTEGER); FORWARD;
  45. 43 PROCEDURE d(i: INTEGER); FORWARD;
  46. 44
  47. 45
  48. 46 PROCEDURE IncPen();
  49. 47 BEGIN
  50. 48 IF (maxColr > 1) THEN
  51. 49 penColr := penColr + 1;
  52. 50 IF (penColr > maxColr) THEN
  53. 51 penColr := 1;
  54. 52 END;
  55. 53
  56. 54 Meta.PenColor(penColr);
  57. ***** ^ not supported yet
  58. ***** ^ not supported yet
  59. ***** ^ not supported yet
  60. 55 END
  61. 56 END IncPen;
  62. ***** ^ not supported yet
  63. 57
  64. 58 PROCEDURE PlotRect();
  65. 59 BEGIN
  66. 60 IncPen();
  67. ***** ^ not supported yet
  68. ***** ^ not supported yet
  69. 61 Meta.PaintOval(R1);
  70. ***** ^ not supported yet
  71. ***** ^ not supported yet
  72. ***** ^ not supported yet
  73. 62 END PlotRect;
  74. ***** ^ not supported yet
  75. 63
  76. 64 PROCEDURE Plt();
  77. 65 BEGIN
  78. 66 Meta.MoveTo(ox, oy);
  79. ***** ^ not supported yet
  80. ***** ^ not supported yet
  81. ***** ^ not supported yet
  82. 67 Meta.LineTo(x, y);
  83. ***** ^ not supported yet
  84. ***** ^ not supported yet
  85. ***** ^ not supported yet
  86. 68 IncPen();
  87. ***** ^ not supported yet
  88. ***** ^ not supported yet
  89. 69 ox := x;
  90. 70 oy := y;
  91. 71 END Plt;
  92. ***** ^ not supported yet
  93. 72
  94. 73 PROCEDURE a(i: INTEGER);
  95. 74 BEGIN
  96. 75 IF (i > 0) THEN
  97. 76 d(i-1); x := x-h; Plt();
  98. ***** ^ not supported yet
  99. ***** ^ not supported yet
  100. ***** ^ not supported yet
  101. ***** ^ not supported yet
  102. 77 a(i-1); y := y-h; Plt();
  103. ***** ^ not supported yet
  104. ***** ^ not supported yet
  105. ***** ^ not supported yet
  106. ***** ^ not supported yet
  107. 78 a(i-1); x := x+h; Plt();
  108. ***** ^ not supported yet
  109. ***** ^ not supported yet
  110. ***** ^ not supported yet
  111. ***** ^ not supported yet
  112. 79 b(i-1);
  113. ***** ^ not supported yet
  114. ***** ^ not supported yet
  115. 80 END
  116. 81 END a;
  117. ***** ^ not supported yet
  118. 82
  119. 83 PROCEDURE b(i: INTEGER);
  120. 84 BEGIN
  121. 85 IF (i > 0) THEN
  122. 86 c(i-1); y := y+h; Plt();
  123. ***** ^ not supported yet
  124. ***** ^ not supported yet
  125. ***** ^ not supported yet
  126. ***** ^ not supported yet
  127. 87 b(i-1); x := x+h; Plt();
  128. ***** ^ not supported yet
  129. ***** ^ not supported yet
  130. ***** ^ not supported yet
  131. ***** ^ not supported yet
  132. 88 b(i-1); y := y-h; Plt();
  133. ***** ^ not supported yet
  134. ***** ^ not supported yet
  135. ***** ^ not supported yet
  136. ***** ^ not supported yet
  137. 89 a(i-1);
  138. ***** ^ not supported yet
  139. ***** ^ not supported yet
  140. 90 END
  141. 91 END b;
  142. ***** ^ not supported yet
  143. 92
  144. 93
  145. 94 PROCEDURE c(i: INTEGER);
  146. 95 BEGIN
  147. 96 IF (i > 0) THEN
  148. 97 b(i-1); x := x+h; Plt();
  149. ***** ^ not supported yet
  150. ***** ^ not supported yet
  151. ***** ^ not supported yet
  152. ***** ^ not supported yet
  153. 98 c(i-1); y := y+h; Plt();
  154. ***** ^ not supported yet
  155. ***** ^ not supported yet
  156. ***** ^ not supported yet
  157. ***** ^ not supported yet
  158. 99 c(i-1); x := x-h; Plt();
  159. ***** ^ not supported yet
  160. ***** ^ not supported yet
  161. ***** ^ not supported yet
  162. ***** ^ not supported yet
  163. 100 d(i-1);
  164. ***** ^ not supported yet
  165. ***** ^ not supported yet
  166. 101 END;
  167. 102 END c;
  168. ***** ^ not supported yet
  169. 103
  170. 104 PROCEDURE d(i: INTEGER);
  171. 105 BEGIN
  172. 106 IF (i > 0) THEN
  173. 107 a(i-1); y := y-h; Plt();
  174. ***** ^ not supported yet
  175. ***** ^ not supported yet
  176. ***** ^ not supported yet
  177. ***** ^ not supported yet
  178. 108 d(i-1); x := x-h; Plt();
  179. ***** ^ not supported yet
  180. ***** ^ not supported yet
  181. ***** ^ not supported yet
  182. ***** ^ not supported yet
  183. 109 d(i-1); y := y+h; Plt();
  184. ***** ^ not supported yet
  185. ***** ^ not supported yet
  186. ***** ^ not supported yet
  187. ***** ^ not supported yet
  188. 110 c(i-1);
  189. ***** ^ not supported yet
  190. ***** ^ not supported yet
  191. 111 END;
  192. 112 END d;
  193. ***** ^ not supported yet
  194. 113
  195. 114 BEGIN
  196. 115 (* init the system *)
  197. 116 GrQry.GrQuery(GrafixCard, CommPort);
  198. ***** ^ not supported yet
  199. ***** ^ not supported yet
  200. ***** ^ not supported yet
  201. 117
  202. 118 i := Meta.InitGrafix(-GrafixCard);
  203. ***** ^ not supported yet
  204. ***** ^ not supported yet
  205. ***** ^ not supported yet
  206. 119
  207. 120 IF (i # 0) THEN
  208. 121 (* Display reason for no go *)
  209. 122 GrQry.GrInitErr(GrafixCard, CommPort, i);
  210. ***** ^ not supported yet
  211. ***** ^ not supported yet
  212. ***** ^ not supported yet
  213. 123 END;
  214. 124
  215. 125 (* switch to graphics page *)
  216. 126 Meta.SetDisplay(GrConst.GrafPg0);
  217. ***** ^ not supported yet
  218. ***** ^ not supported yet
  219. ***** ^ not supported yet
  220. ***** ^ not supported yet
  221. 127
  222. 128 (* find number of colors supported *)
  223. 129 maxColr := Meta.QueryColors();
  224. ***** ^ not supported yet
  225. ***** ^ not supported yet
  226. ***** ^ not supported yet
  227. 130
  228. 131 (* set virtual coordinate system *)
  229. 132 Meta.SetRect(vR, 0, 0, 256, 256);
  230. ***** ^ not supported yet
  231. ***** ^ not supported yet
  232. ***** ^ not supported yet
  233. ***** ^ not supported yet
  234. 133 Meta.VirtualRect(vR);
  235. ***** ^ not supported yet
  236. ***** ^ not supported yet
  237. ***** ^ not supported yet
  238. 134
  239. 135 LOOP
  240. 136 IF (maxColr > 1) THEN
  241. 137 Meta.RasterOp(GrConst.zREPz)
  242. ***** ^ not supported yet
  243. ***** ^ not supported yet
  244. ***** ^ not supported yet
  245. ***** ^ not supported yet
  246. 138 ELSE
  247. 139 Meta.RasterOp(GrConst.zXORz);
  248. ***** ^ not supported yet
  249. ***** ^ not supported yet
  250. ***** ^ not supported yet
  251. ***** ^ not supported yet
  252. 140 Meta.PenColor(GrConst.White)
  253. ***** ^ not supported yet
  254. ***** ^ not supported yet
  255. ***** ^ not supported yet
  256. ***** ^ not supported yet
  257. 141 END;
  258. 142
  259. 143 (* do that hilbert thing *)
  260. 144 Meta.EraseRect(vR);
  261. ***** ^ not supported yet
  262. ***** ^ not supported yet
  263. ***** ^ not supported yet
  264. 145
  265. 146 FOR cnt := 0 TO 4 DO
  266. 147 i := 0;
  267. 148 h0 := 256;
  268. 149 h := h0;
  269. 150 xa := h DIV 2;
  270. 151 ya := xa;
  271. 152
  272. 153 WHILE (h > 4) DO
  273. 154 i := i+1;
  274. 155 h := h DIV 2;
  275. 156 xa := xa + (h DIV 2);
  276. 157 ya := ya + (h DIV 2);
  277. 158 x := xa;
  278. 159 y := ya;
  279. 160 ox := xa;
  280. 161 oy := ya;
  281. 162 a(i)
  282. ***** ^ not supported yet
  283. ***** ^ not supported yet
  284. 163 END;
  285. 164
  286. 165 (* stop if key pressed *)
  287. 166 IF (IO.KeyPressed()) THEN
  288. ***** ^ not supported yet
  289. ***** ^ not supported yet
  290. ***** ^ not supported yet
  291. 167 EXIT
  292. 168 END
  293. 169 END;
  294. 170
  295. 171 (* ye old bouncing box gizmo *)
  296. 172 Meta.RasterOp(GrConst.zREPz);
  297. ***** ^ not supported yet
  298. ***** ^ not supported yet
  299. ***** ^ not supported yet
  300. ***** ^ not supported yet
  301. 173
  302. 174 FOR cnt := 4 TO 0 BY -1 DO
  303. 175 (* make a pseudorandom number *)
  304. 176 i := INTEGER(Lib.RANDOM(30)) + 12;
  305. ***** ^ not supported yet
  306. ***** ^ not supported yet
  307. ***** ^ not supported yet
  308. 177
  309. 178 IF (cnt MOD 2) # 0 THEN
  310. 179 xa := i DIV 2;
  311. 180 ya := i DIV 3
  312. 181 ELSE
  313. 182 xa := i DIV 3;
  314. 183 ya := i DIV 2
  315. 184 END;
  316. 185
  317. 186 Meta.SetRect(R1, 0, 0, i-6, i-6);
  318. ***** ^ not supported yet
  319. ***** ^ not supported yet
  320. ***** ^ not supported yet
  321. ***** ^ not supported yet
  322. 187
  323. 188 FOR j := 256 TO 0 BY -1 DO
  324. 189 PlotRect();
  325. ***** ^ not supported yet
  326. ***** ^ not supported yet
  327. 190 IF ((R1.Xmax > vR.Xmax) OR (R1.Xmin < vR.Xmin)) THEN (* flip x delta *)
  328. ***** ^ not supported yet
  329. ***** ^ not supported yet
  330. ***** ^ not supported yet
  331. ***** ^ not supported yet
  332. ***** ^ not supported yet
  333. ***** ^ not supported yet
  334. ***** ^ not supported yet
  335. ***** ^ not supported yet
  336. 191 xa := INTEGER(BITSET(xa) / BITSET(-1))
  337. ***** ^ undeclared identifier
  338. ***** ^ not supported yet
  339. ***** ^ undeclared identifier
  340. ***** ^ not supported yet
  341. 192 END;
  342. 193 IF ((R1.Ymax > vR.Ymax) OR (R1.Ymin < vR.Ymin)) THEN (* flip y delta *)
  343. ***** ^ not supported yet
  344. ***** ^ not supported yet
  345. ***** ^ not supported yet
  346. ***** ^ not supported yet
  347. ***** ^ not supported yet
  348. ***** ^ not supported yet
  349. ***** ^ not supported yet
  350. ***** ^ not supported yet
  351. 194 ya := INTEGER(BITSET(ya) / BITSET(-1))
  352. ***** ^ undeclared identifier
  353. ***** ^ not supported yet
  354. ***** ^ undeclared identifier
  355. ***** ^ not supported yet
  356. 195 END;
  357. 196 Meta.OffsetRect(R1,xa,ya);
  358. ***** ^ not supported yet
  359. ***** ^ not supported yet
  360. ***** ^ not supported yet
  361. ***** ^ not supported yet
  362. 197
  363. 198 IF (IO.KeyPressed()) THEN
  364. ***** ^ not supported yet
  365. ***** ^ not supported yet
  366. ***** ^ not supported yet
  367. 199 EXIT
  368. 200 END
  369. 201 END
  370. 202 END;
  371. 203
  372. 204 Meta.EraseRect(vR); (* tunnel thing *)
  373. ***** ^ not supported yet
  374. ***** ^ not supported yet
  375. ***** ^ not supported yet
  376. 205 Meta.RasterOp(GrConst.zREPz);
  377. ***** ^ not supported yet
  378. ***** ^ not supported yet
  379. ***** ^ not supported yet
  380. ***** ^ not supported yet
  381. 206
  382. 207 FOR cnt := 0 TO 16 DO
  383. 208 Meta.SetRect(R1, 124,124,132,132);
  384. ***** ^ not supported yet
  385. ***** ^ not supported yet
  386. ***** ^ not supported yet
  387. ***** ^ not supported yet
  388. 209 Meta.SetRect(R2, 124,124,132,132);
  389. ***** ^ not supported yet
  390. ***** ^ not supported yet
  391. ***** ^ not supported yet
  392. ***** ^ not supported yet
  393. 210 Meta.PenColor(GrConst.White);
  394. ***** ^ not supported yet
  395. ***** ^ not supported yet
  396. ***** ^ not supported yet
  397. ***** ^ not supported yet
  398. 211
  399. 212 FOR i := 0 TO 32 DO
  400. 213 IncPen();
  401. ***** ^ not supported yet
  402. ***** ^ not supported yet
  403. 214 Meta.FrameRect(R1);
  404. ***** ^ not supported yet
  405. ***** ^ not supported yet
  406. ***** ^ not supported yet
  407. 215 Meta.InsetRect(R1,-4,-4)
  408. ***** ^ not supported yet
  409. ***** ^ not supported yet
  410. ***** ^ not supported yet
  411. ***** ^ not supported yet
  412. 216 END;
  413. 217 Meta.PenColor(GrConst.Black);
  414. ***** ^ not supported yet
  415. ***** ^ not supported yet
  416. ***** ^ not supported yet
  417. ***** ^ not supported yet
  418. 218
  419. 219 FOR i := 0 TO 32 DO
  420. 220 Meta.FrameRect(R2);
  421. ***** ^ not supported yet
  422. ***** ^ not supported yet
  423. ***** ^ not supported yet
  424. 221 Meta.InsetRect(R2,-4,-4)
  425. ***** ^ not supported yet
  426. ***** ^ not supported yet
  427. ***** ^ not supported yet
  428. ***** ^ not supported yet
  429. 222 END;
  430. 223
  431. 224 IF IO.KeyPressed() THEN
  432. ***** ^ not supported yet
  433. ***** ^ not supported yet
  434. ***** ^ not supported yet
  435. 225 EXIT
  436. 226 END
  437. 227 END;
  438. 228
  439. 229 Meta.PenColor(GrConst.White);
  440. ***** ^ not supported yet
  441. ***** ^ not supported yet
  442. ***** ^ not supported yet
  443. ***** ^ not supported yet
  444. 230 IF (IO.KeyPressed()) THEN
  445. ***** ^ not supported yet
  446. ***** ^ not supported yet
  447. ***** ^ not supported yet
  448. 231 EXIT
  449. 232 END
  450. 233 END; (* only exits from kbhit *)
  451. 234
  452. 235 GrQry.GrQuit('', 0);
  453. ***** ^ not supported yet
  454. ***** ^ not supported yet
  455. ***** ^ not supported yet
  456. 236 END Hilbert.
  457. 219 errors