Listing: 1 (******************************************************************************) 2 (* HILBERT.MOD *) 3 (* *) 4 (* MetaWINDOW pretty graphics program *) 5 (* Transcribed from HILBERT.C METAGRAPHICS SOFTWARE CORPORATION (c) 1987-1989 *) 6 (* *) 7 (* PSW 06/28/91 08:30am *) 8 (******************************************************************************) 9 10 MODULE Hilbert; 11 (* 12 * Graphix 13 * Release 3.7 14 * (c) Copyright 1986-1992 PMI 15 * Green Bay, Wisconsin 16 * (414) 468-6040 17 * All rights reserved 18 * 19 *) 20 21 IMPORT GrQry; 22 IMPORT IO; 23 IMPORT Lib; 24 IMPORT GrConst; 25 IMPORT Meta; 26 27 VAR 28 GrafixCard, 29 CommPort, 30 xa, ya, 31 x, y, 32 ox, oy, 33 i, j, 34 h, h0, 35 penColr, 36 maxColr, 37 cnt: INTEGER; 38 vR, R1, R2: GrConst.rect; ***** ^ not supported yet 39 40 PROCEDURE a(i: INTEGER); FORWARD; 41 PROCEDURE b(i: INTEGER); FORWARD; 42 PROCEDURE c(i: INTEGER); FORWARD; 43 PROCEDURE d(i: INTEGER); FORWARD; 44 45 46 PROCEDURE IncPen(); 47 BEGIN 48 IF (maxColr > 1) THEN 49 penColr := penColr + 1; 50 IF (penColr > maxColr) THEN 51 penColr := 1; 52 END; 53 54 Meta.PenColor(penColr); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 55 END 56 END IncPen; ***** ^ not supported yet 57 58 PROCEDURE PlotRect(); 59 BEGIN 60 IncPen(); ***** ^ not supported yet ***** ^ not supported yet 61 Meta.PaintOval(R1); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 62 END PlotRect; ***** ^ not supported yet 63 64 PROCEDURE Plt(); 65 BEGIN 66 Meta.MoveTo(ox, oy); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 67 Meta.LineTo(x, y); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 68 IncPen(); ***** ^ not supported yet ***** ^ not supported yet 69 ox := x; 70 oy := y; 71 END Plt; ***** ^ not supported yet 72 73 PROCEDURE a(i: INTEGER); 74 BEGIN 75 IF (i > 0) THEN 76 d(i-1); x := x-h; Plt(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 77 a(i-1); y := y-h; Plt(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 78 a(i-1); x := x+h; Plt(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 79 b(i-1); ***** ^ not supported yet ***** ^ not supported yet 80 END 81 END a; ***** ^ not supported yet 82 83 PROCEDURE b(i: INTEGER); 84 BEGIN 85 IF (i > 0) THEN 86 c(i-1); y := y+h; Plt(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 87 b(i-1); x := x+h; Plt(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 88 b(i-1); y := y-h; Plt(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 89 a(i-1); ***** ^ not supported yet ***** ^ not supported yet 90 END 91 END b; ***** ^ not supported yet 92 93 94 PROCEDURE c(i: INTEGER); 95 BEGIN 96 IF (i > 0) THEN 97 b(i-1); x := x+h; Plt(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 98 c(i-1); y := y+h; Plt(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 99 c(i-1); x := x-h; Plt(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 100 d(i-1); ***** ^ not supported yet ***** ^ not supported yet 101 END; 102 END c; ***** ^ not supported yet 103 104 PROCEDURE d(i: INTEGER); 105 BEGIN 106 IF (i > 0) THEN 107 a(i-1); y := y-h; Plt(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 108 d(i-1); x := x-h; Plt(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 109 d(i-1); y := y+h; Plt(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 110 c(i-1); ***** ^ not supported yet ***** ^ not supported yet 111 END; 112 END d; ***** ^ not supported yet 113 114 BEGIN 115 (* init the system *) 116 GrQry.GrQuery(GrafixCard, CommPort); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 117 118 i := Meta.InitGrafix(-GrafixCard); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 119 120 IF (i # 0) THEN 121 (* Display reason for no go *) 122 GrQry.GrInitErr(GrafixCard, CommPort, i); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 123 END; 124 125 (* switch to graphics page *) 126 Meta.SetDisplay(GrConst.GrafPg0); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 127 128 (* find number of colors supported *) 129 maxColr := Meta.QueryColors(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 130 131 (* set virtual coordinate system *) 132 Meta.SetRect(vR, 0, 0, 256, 256); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 133 Meta.VirtualRect(vR); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 134 135 LOOP 136 IF (maxColr > 1) THEN 137 Meta.RasterOp(GrConst.zREPz) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 138 ELSE 139 Meta.RasterOp(GrConst.zXORz); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 140 Meta.PenColor(GrConst.White) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 141 END; 142 143 (* do that hilbert thing *) 144 Meta.EraseRect(vR); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 145 146 FOR cnt := 0 TO 4 DO 147 i := 0; 148 h0 := 256; 149 h := h0; 150 xa := h DIV 2; 151 ya := xa; 152 153 WHILE (h > 4) DO 154 i := i+1; 155 h := h DIV 2; 156 xa := xa + (h DIV 2); 157 ya := ya + (h DIV 2); 158 x := xa; 159 y := ya; 160 ox := xa; 161 oy := ya; 162 a(i) ***** ^ not supported yet ***** ^ not supported yet 163 END; 164 165 (* stop if key pressed *) 166 IF (IO.KeyPressed()) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 167 EXIT 168 END 169 END; 170 171 (* ye old bouncing box gizmo *) 172 Meta.RasterOp(GrConst.zREPz); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 173 174 FOR cnt := 4 TO 0 BY -1 DO 175 (* make a pseudorandom number *) 176 i := INTEGER(Lib.RANDOM(30)) + 12; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 177 178 IF (cnt MOD 2) # 0 THEN 179 xa := i DIV 2; 180 ya := i DIV 3 181 ELSE 182 xa := i DIV 3; 183 ya := i DIV 2 184 END; 185 186 Meta.SetRect(R1, 0, 0, i-6, i-6); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 187 188 FOR j := 256 TO 0 BY -1 DO 189 PlotRect(); ***** ^ not supported yet ***** ^ not supported yet 190 IF ((R1.Xmax > vR.Xmax) OR (R1.Xmin < vR.Xmin)) THEN (* flip x delta *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 191 xa := INTEGER(BITSET(xa) / BITSET(-1)) ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 192 END; 193 IF ((R1.Ymax > vR.Ymax) OR (R1.Ymin < vR.Ymin)) THEN (* flip y delta *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 194 ya := INTEGER(BITSET(ya) / BITSET(-1)) ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 195 END; 196 Meta.OffsetRect(R1,xa,ya); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 197 198 IF (IO.KeyPressed()) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 199 EXIT 200 END 201 END 202 END; 203 204 Meta.EraseRect(vR); (* tunnel thing *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 205 Meta.RasterOp(GrConst.zREPz); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 206 207 FOR cnt := 0 TO 16 DO 208 Meta.SetRect(R1, 124,124,132,132); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 209 Meta.SetRect(R2, 124,124,132,132); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 210 Meta.PenColor(GrConst.White); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 211 212 FOR i := 0 TO 32 DO 213 IncPen(); ***** ^ not supported yet ***** ^ not supported yet 214 Meta.FrameRect(R1); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 215 Meta.InsetRect(R1,-4,-4) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 216 END; 217 Meta.PenColor(GrConst.Black); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 218 219 FOR i := 0 TO 32 DO 220 Meta.FrameRect(R2); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 221 Meta.InsetRect(R2,-4,-4) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 222 END; 223 224 IF IO.KeyPressed() THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 225 EXIT 226 END 227 END; 228 229 Meta.PenColor(GrConst.White); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 230 IF (IO.KeyPressed()) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 231 EXIT 232 END 233 END; (* only exits from kbhit *) 234 235 GrQry.GrQuit('', 0); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 236 END Hilbert. 219 errors