Listing: 1 (******************************************************************************) 2 (* TESTTRAK.MOD *) 3 (* *) 4 (* MetaWINDOW graphics test program *) 5 (* Transcribed from TESTTRAK.C METAGRAPHICS SOFTWARE CORPORATION (c) 1987-1989*) 6 (* *) 7 (* PSW 10/31/90 02:44am *) 8 (******************************************************************************) 9 10 MODULE Testtrak; 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 GrConst; 23 IMPORT GrPorts; 24 IMPORT Meta; 25 IMPORT Str; 26 IMPORT Lib; 27 IMPORT IO; 28 29 FROM Storage IMPORT ALLOCATE, DEALLOCATE; 30 31 FROM GrConst IMPORT rect, point, event, cursor, dirRec, mapArray; ***** ^ duplicate identifier 32 FROM GrPorts IMPORT adsPort; ***** ^ duplicate identifier 33 FROM GrFonts IMPORT adsFont; 34 35 36 CONST 37 sec = 18; 38 COLOR = 11; 39 40 VAR 41 GrafixCard, 42 CommPort: INTEGER; 43 buf, buf1, 44 Msg1, Msg2: ARRAY [0..79] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 45 x, y, 46 ox, oy, 47 i, j, 48 evCnt, 49 max_clr, 50 clr, 51 px, py, 52 maxgig: INTEGER; 53 a, b: ARRAY [0..15] OF INTEGER; ***** ^ not supported yet ***** ^ not supported yet 54 bol, bol1: BOOLEAN; 55 evnt: event; 56 R1, sR: rect; 57 pt: point; 58 scrMask, 59 csrMask: cursor; 60 OK: BOOLEAN; 61 thePort: adsPort; (* pointer to default MetaWINDOW port *) 62 bm: mapArray; 63 64 65 (* 66 ** assumes event queing is enabled. call with # of 67 ** "ticks" to wait; ie appx 18 ticks per second 68 ** occur. Also use for "time outs". 69 *) 70 71 PROCEDURE mwDelay(time: INTEGER); 72 VAR 73 b: BOOLEAN; 74 i: INTEGER; 75 evnt: event; 76 BEGIN 77 b := Meta.PeekEvent(0, evnt); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 78 i := evnt.Time; ***** ^ not supported yet ***** ^ not supported yet 79 80 REPEAT 81 b := Meta.PeekEvent(0, evnt) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 82 UNTIL (evnt.Time - i >= time); ***** ^ not supported yet ***** ^ not supported yet 83 END mwDelay; ***** ^ not supported yet 84 85 (*** Display the active keys ***) 86 87 PROCEDURE DispOpt(); 88 BEGIN 89 Meta.RasterOp(GrConst.zXORz); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 90 Meta.MoveTo(px*2, py*22); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 91 Meta.DrawString('- Active keys - [w]hirl-a-gig, [c]lear screen'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 92 Meta.MoveTo(px*2, py*23); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 93 Meta.DrawString('[f]lip origin, [t]racking on/off.'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 94 Meta.MoveTo(px*2, py*24); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 95 Meta.DrawString('mouse: lft=draw, rt=plot'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 96 Meta.RasterOp(GrConst.zREPz); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 97 END DispOpt; ***** ^ not supported yet 98 99 (*** do some keen patterns ***) 100 101 PROCEDURE DispPatt(); 102 VAR 103 i: INTEGER; 104 BEGIN 105 Meta.SetRect(R1, 0, 0, sR.Xmax, sR.Ymax); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 106 x := R1.Xmax DIV 32; y := R1.Ymax DIV 32; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 107 108 FOR i := 0 TO 15 DO 109 Meta.PenColor(i); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 110 Meta.BackColor(15-i); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 111 Meta.FillRect(R1, i+16); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 112 Meta.FrameRect(R1); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 113 Meta.InsetRect(R1, x, y); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 114 END; 115 END DispPatt; ***** ^ not supported yet 116 117 (*** Load the specified font. ***) 118 119 PROCEDURE LoadFont(VAR fontName: ARRAY OF CHAR); ***** ^ not supported yet 120 VAR 121 Dir: dirRec; 122 qErr, 123 loadErr: INTEGER; 124 path: ARRAY[0..80] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 125 fontBuf: adsFont; 126 BEGIN 127 Str.Copy(path, fontName); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 128 loadErr := -1; (* Preempt Error *) 129 qErr := Meta.FileQuery(path, Dir, 1); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 130 131 IF (qErr # 1) THEN 132 (* No font file in default dir, try environment variable *) 133 Lib.EnvironmentFind("METAPATH", path); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 134 135 IF (path[0] # CHR(0)) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 136 (* found the env parm, try using the path listed there *) 137 138 IF (path[Str.Length(path)] # '\') THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 139 (* If no trailing slash, add one *) 140 Str.Append(path, '\'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 141 END; 142 143 Str.Append(path, fontName); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 144 qErr := Meta.FileQuery(path, Dir, 1); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 145 END; 146 END; 147 148 IF (qErr = 1) THEN 149 (* we got our file *) 150 ALLOCATE(ADDRESS(fontBuf), VAL(CARDINAL, Dir.fileSize + 1)); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 151 152 IF (fontBuf # NIL) THEN ***** ^ not supported yet 153 (* We got our memory *) 154 loadErr := Meta.FileLoad(path, ADDRESS(fontBuf), VAL(CARDINAL, Dir.fileSize+1)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 155 IF loadErr <= 0 THEN 156 DEALLOCATE(ADDRESS(fontBuf), VAL(CARDINAL, Dir.fileSize + 1)); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 157 END; 158 Meta.SetFont(ADDRESS(fontBuf)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 159 END; 160 END; 161 162 IF (loadErr > 0) THEN 163 (* clear out system load error *) 164 qErr := Meta.QueryError(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 165 ELSE 166 (* beep if font load probs *) 167 IO.WrChar(CHR(7)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 168 Str.Copy(fontName, 'Using internal SYSTEM08.FNT'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 169 END; 170 END LoadFont; ***** ^ not supported yet 171 172 173 PROCEDURE Insert(VAR S1: ARRAY OF CHAR; S2: ARRAY OF CHAR; Pos, Width: CARDINAL); ***** ^ not supported yet ***** ^ not supported yet 174 VAR 175 L1, L2, i: CARDINAL; 176 BEGIN 177 L1 := Str.Length(S1); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 178 L2 := Str.Length(S2); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 179 180 IF (Pos + Width) > L1 THEN 181 RETURN 182 END; 183 184 IF L2 > Width THEN 185 RETURN 186 END; 187 188 FOR i := 0 TO L2 DO 189 S1[Pos + i] := S2[i]; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 190 END; 191 192 FOR i := Pos + L2 TO Pos + Width DO 193 S1[i] := ' '; ***** ^ not supported yet ***** ^ not supported yet 194 END; 195 END Insert; ***** ^ not supported yet 196 197 198 BEGIN 199 (* init the system *) 200 201 GrQry.GrQuery(GrafixCard, CommPort); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 202 203 i := Meta.InitGrafix(-GrafixCard); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 204 205 IF (i # 0) THEN 206 (* Display reason for no go *) 207 GrQry.GrInitErr(GrafixCard, CommPort, i); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 208 END; 209 210 Meta.ScreenRect(sR); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 211 Meta.SetDisplay(GrConst.GrafPg0); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 212 max_clr := Meta.QueryColors(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 213 px := sR.Xmax DIV 80; ***** ^ not supported yet ***** ^ not supported yet 214 py := sR.Ymax DIV 25; ***** ^ not supported yet ***** ^ not supported yet 215 Meta.SetRect(R1, px*60, py*18, px*70, py*22); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 216 Meta.PenColor(COLOR); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 217 Meta.FillRect(sR, 1); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 218 Meta.PenColor(GrConst.White); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 219 220 Meta.GetPort(thePort); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 221 i := thePort^.portBMap^.devClass; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 222 223 IF (thePort^.portBMap^.pixPlanes > 1) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 224 i := INTEGER(BITSET(i) * BITSET(0FFF8H)) ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 225 END; 226 227 Str.Copy(buf1, 'SYSTEM'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 228 Str.IntToStr(LONGINT(i), buf, 10, OK); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 229 Str.Append(buf1, buf); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 230 Str.Append(buf1, '.FNT'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 231 232 LoadFont(buf1); ***** ^ not supported yet ***** ^ not supported yet 233 234 Meta.MoveTo(px, py); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 235 Meta.DrawString(buf1); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 236 237 (* Init the whirlagig *) 238 Meta.PenSize(1, 1); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 239 maxgig := 39; 240 241 x := px * 10; 242 y := py * 8; 243 j := py; 244 245 FOR i := 0 TO 15 DO 246 a[i] := x - px * 5; ***** ^ not supported yet ***** ^ not supported yet 247 b[i] := j; ***** ^ not supported yet ***** ^ not supported yet 248 j := j + py; 249 END; 250 251 (* Create a user-defined cursor to be a triangle *) 252 253 scrMask.curWidth := 16; scrMask.curHeight := 16; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 254 scrMask.curAlign := 0; scrMask.curRowBytes := 2; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 255 scrMask.curBits := 1; scrMask.curPlanes := 1; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 256 scrMask.curData[0] := 000H; scrMask.curData[1] := 000H; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 257 scrMask.curData[2] := 000H; scrMask.curData[3] := 000H; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 258 scrMask.curData[4] := 000H; scrMask.curData[5] := 000H; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 259 scrMask.curData[6] := 000H; scrMask.curData[7] := 000H; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 260 scrMask.curData[8] := 000H; scrMask.curData[9] := 000H; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 261 scrMask.curData[10] := 000H; scrMask.curData[11] := 000H; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 262 scrMask.curData[12] := 000H; scrMask.curData[13] := 000H; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 263 scrMask.curData[14] := 001H; scrMask.curData[15] := 000H; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 264 scrMask.curData[16] := 003H; scrMask.curData[17] := 080H; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 265 scrMask.curData[18] := 007H; scrMask.curData[19] := 0C0H; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 266 scrMask.curData[20] := 00FH; scrMask.curData[21] := 0E0H; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 267 scrMask.curData[22] := 01FH; scrMask.curData[23] := 0F0H; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 268 scrMask.curData[24] := 03FH; scrMask.curData[25] := 0F8H; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 269 scrMask.curData[26] := 07FH; scrMask.curData[27] := 0FCH; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 270 scrMask.curData[28] := 000H; scrMask.curData[29] := 000H; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 271 scrMask.curData[30] := 000H; scrMask.curData[31] := 000H; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 272 273 csrMask.curWidth := 16; csrMask.curHeight := 16; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 274 csrMask.curAlign := 0; csrMask.curRowBytes := 2; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 275 csrMask.curBits := 1; csrMask.curPlanes := 1; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 276 csrMask.curData[0] := 000H; csrMask.curData[1] := 000H; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 277 csrMask.curData[2] := 000H; csrMask.curData[3] := 000H; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 278 csrMask.curData[4] := 000H; csrMask.curData[5] := 000H; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 279 csrMask.curData[6] := 000H; csrMask.curData[7] := 000H; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 280 csrMask.curData[8] := 000H; csrMask.curData[9] := 000H; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 281 csrMask.curData[10] := 000H; csrMask.curData[11] := 000H; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 282 csrMask.curData[12] := 001H; csrMask.curData[13] := 000H; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 283 csrMask.curData[14] := 002H; csrMask.curData[15] := 080H; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 284 csrMask.curData[16] := 004H; csrMask.curData[17] := 040H; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 285 csrMask.curData[18] := 008H; csrMask.curData[19] := 020H; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 286 csrMask.curData[20] := 010H; csrMask.curData[21] := 010H; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 287 csrMask.curData[22] := 020H; csrMask.curData[23] := 008H; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 288 csrMask.curData[24] := 040H; csrMask.curData[25] := 004H; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 289 csrMask.curData[26] := 080H; csrMask.curData[27] := 002H; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 290 csrMask.curData[28] := 0FFH; csrMask.curData[29] := 0FEH; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 291 csrMask.curData[30] := 000H; csrMask.curData[31] := 000H; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 292 293 Meta.DefineCursor(2, 8, 8, scrMask, csrMask); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 294 295 296 (* Now turn on mouse and event queue stuff *) 297 Meta.InitMouse(CommPort); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 298 299 Meta.ScaleMouse (sR.Xmax DIV 40, sR.Ymax DIV 40); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 300 301 ox := 100; 302 x := 100; 303 oy := 100; 304 y := 100; 305 306 Meta.MoveCursor(x, y); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 307 308 FOR i := 0 TO 7 DO 309 bm[i] := i; ***** ^ not supported yet ***** ^ not supported yet 310 END; 311 312 bm[4] := 0; (* arrow *) ***** ^ not supported yet ***** ^ not supported yet 313 bm[5] := 2; (* new pointy thing *) ***** ^ not supported yet ***** ^ not supported yet 314 Meta.CursorMap(bm); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 315 bol := TRUE; 316 bol1 := TRUE; 317 318 (* Enable mouse autotracking & event queue*) 319 320 Meta.TrackCursor(bol); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 321 Meta.ShowCursor(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 322 Meta.EventQueue(TRUE); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 323 324 (* flush event queue *) 325 WHILE Meta.KeyEvent(FALSE, evnt) DO ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 326 ; 327 END; ***** ^ ident expected 328 329 DispOpt(); 330 Meta.LimitMouse(sR.Xmin-20, sR.Ymin-20, sR.Xmax+20, sR.Ymax+20); 331 clr := 0; 332 evCnt := 0; 333 334 Meta.RasterOp(GrConst.zREPz); 335 336 (* Init messages *) 337 Str.Copy(Msg1, 'event= ascii= scan= state= x= y= time= '); 338 Str.Copy(Msg2, 'x= y= sw= time= '); 339 340 341 REPEAT 342 Meta.QueryCursor(pt.X, pt.Y, i, j); 343 344 IF Meta.KeyEvent(FALSE, evnt) THEN 345 CASE evnt.ASCII OF 346 | 't': (* t will flip tracking on/off *) 347 bol := NOT(bol); 348 Meta.TrackCursor(bol); 349 | 'c': (* clears screen *) 350 Meta.HideCursor(); 351 Meta.PenColor(COLOR); 352 Meta.FillRect(sR, 1); 353 Meta.PenColor(GrConst.White); 354 DispOpt(); 355 Meta.ShowCursor(); 356 | 'f': (* f will flip port origin *) 357 Meta.HideCursor(); 358 bol1 := NOT(bol1); 359 Meta.PortOrigin(bol1); 360 Meta.PenColor(COLOR); 361 Meta.FillRect(sR, 1); 362 Meta.PenColor(GrConst.White); 363 DispOpt(); 364 Meta.ShowCursor(); 365 | 'w': (* w for the whilagig *) 366 Meta.HideCursor(); 367 Meta.RasterOp (GrConst.zXORz); 368 FOR i := 0 TO maxgig DO 369 FOR j := 0 TO 15 DO 370 Meta.MoveTo (pt.X, pt.Y); 371 Meta.LineTo (a[j], b[j]); 372 END 373 END; 374 Meta.RasterOp(GrConst.zREPz); 375 Meta.ShowCursor(); 376 END; 377 378 INC(evCnt); 379 Str.IntToStr(LONGINT(evCnt), buf, 10, OK); 380 Insert(Msg1, buf, 6, 2); 381 Str.IntToStr(LONGINT(evnt.ASCII), buf, 16, OK); 382 Insert(Msg1, buf, 16, 2); 383 Str.IntToStr(LONGINT(evnt.ScanCode), buf, 16, OK); 384 Insert(Msg1, buf, 25, 2); 385 Str.IntToStr(LONGINT(evnt.State), buf, 16, OK); 386 Insert(Msg1, buf, 35, 4); 387 Str.IntToStr(LONGINT(evnt.CursorX), buf, 10, OK); 388 Insert(Msg1, buf, 43, 3); 389 Str.IntToStr(LONGINT(evnt.CursorY), buf, 10, OK); 390 Insert(Msg1, buf, 50, 3); 391 Str.IntToStr(LONGINT(evnt.Time), buf, 10, OK); 392 Insert(Msg1, buf, 60, 5); 393 Meta.MoveTo(px*6, py*2); 394 Meta.DrawString(Msg1); 395 396 ELSIF (evnt.Time MOD 8) = 0 THEN 397 Meta.ProtectRect(R1); 398 Meta.PenColor(clr); 399 Meta.FillRect(R1, 1); 400 Meta.ProtectOff(); 401 INC(clr); 402 403 IF (clr > max_clr) THEN 404 clr := 0 405 END; 406 END; 407 408 (*** etch-a-sketch ***) 409 410 IF j = (GrConst.swRight + GrConst.swLeft) THEN 411 Meta.PenColor(GrConst.Black); 412 Meta.HideCursor(); 413 Meta.MoveTo(ox, oy); 414 Meta.LineTo(pt.X, pt.Y); 415 Meta.ShowCursor(); 416 ELSE 417 IF INTEGER(BITSET(j) * BITSET(GrConst.swLeft)) # 0 THEN 418 Meta.PenColor(GrConst.Black); 419 Meta.HideCursor(); 420 Meta.MoveTo(ox, oy); 421 Meta.LineTo(pt.X, pt.Y); 422 Meta.ShowCursor(); 423 END; 424 ox := pt.X; 425 oy := pt.Y; 426 END; 427 428 Meta.PenColor(GrConst.White); 429 430 431 Str.IntToStr(LONGINT(evnt.CursorX), buf, 10, OK); 432 Insert(Msg2, buf, 2, 3); 433 Str.IntToStr(LONGINT(evnt.CursorY), buf, 10, OK); 434 Insert(Msg2, buf, 9, 3); 435 Str.IntToStr(LONGINT(j), buf, 10, OK); 436 Insert(Msg2, buf, 17, 2); 437 Str.IntToStr(LONGINT(evnt.Time), buf, 10, OK); 438 Insert(Msg2, buf, 26, 6); 439 Meta.MoveTo(px*6, py*4); 440 Meta.DrawString(Msg2); 441 442 IF Meta.PtInRect(pt, R1) THEN 443 Meta.DrawString(" pt IS in rect "); 444 ELSE 445 Meta.DrawString(" pt NOT in rect "); 446 END; 447 448 Meta.RasterOp(GrConst.zXORz); 449 Meta.MoveTo(px*79, py*4); 450 Meta.LineTo(px*79, py*20); 451 Meta.RasterOp(GrConst.zREPz); 452 UNTIL ((pt.X <= -20) AND ((evnt.ASCII # CHR(3)) AND (evnt.ScanCode # BYTE(02EH)))); 453 454 Meta.TrackCursor(FALSE); 455 Meta.HideCursor(); 456 457 Meta.BackColor(COLOR); 458 459 (* Scroll a rectangle into screen *) 460 461 Meta.RasterOp(GrConst.zXORz); 462 Meta.FrameRect(R1); 463 Meta.RasterOp(GrConst.zREPz); 464 465 FOR i := 0 TO 30 DO 466 Meta.ScrollRect(R1, 0, -4); 467 Meta.OffsetRect(R1, 0, -4); 468 END; 469 470 FOR i := 0 TO 40 DO 471 Meta.ScrollRect(R1, 8, 0); 472 Meta.OffsetRect(R1, 8, 0); 473 END; 474 475 mwDelay(sec); 476 477 (* pretty patterns to end with *) 478 DispPatt(); 479 mwDelay(sec*3); 480 481 GrQry.GrQuit('', 0); 482 483 END Testtrak. 503 errors