Halaman utama Jelajahi Bantuan
Masuk
eric
/
Topspeed_JPI
1
0
Fork 0
Berkas Masalah 0 Permintaan Tarik 0 Wiki
Cabang: master
Ranting Tag
Topspeed_JPI
/
TS-V3
/
GRAPHIX
/
TESTTRAK.LST

TESTTRAK.LST 39 KB
Permalink Riwayat Mentahan

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992 
  1. Listing:
    2. 

  2. 

  3.     1  (******************************************************************************)
    4. 

  4.     2  (*                              TESTTRAK.MOD                                  *)
    5. 

  5.     3  (*                                                                            *)
    6. 

  6.     4  (*                    MetaWINDOW graphics test program                        *)
    7. 

  7.     5  (* Transcribed from TESTTRAK.C METAGRAPHICS SOFTWARE CORPORATION (c) 1987-1989*)
    8. 

  8.     6  (*                                                                            *)
    9. 

  9.     7  (*  PSW 10/31/90 02:44am                                                      *)
    10. 

  10.     8  (******************************************************************************)
    11. 

  11.     9  
    12. 

  12.    10  MODULE Testtrak;
    13. 

  13.    11  (*
    14. 

  14.    12   *  Graphix
    15. 

  15.    13   *  Release 3.7
    16. 

  16.    14   *  (c) Copyright 1986-1992 PMI
    17. 

  17.    15   *  Green Bay, Wisconsin
    18. 

  18.    16   *  (414) 468-6040
    19. 

  19.    17   *  All rights reserved
    20. 

  20.    18   *
    21. 

  21.    19   *)
    22. 

  22.    20  
    23. 

  23.    21    IMPORT GrQry;
    24. 

  24.    22    IMPORT GrConst;
    25. 

  25.    23    IMPORT GrPorts;
    26. 

  26.    24    IMPORT Meta;
    27. 

  27.    25    IMPORT Str;
    28. 

  28.    26    IMPORT Lib;
    29. 

  29.    27    IMPORT IO;
    30. 

  30.    28  
    31. 

  31.    29    FROM Storage IMPORT ALLOCATE, DEALLOCATE;
    32. 

  32.    30  
    33. 

  33.    31    FROM GrConst IMPORT rect, point, event, cursor, dirRec, mapArray;
    34. 

  34. *****         ^ duplicate identifier
    35. 

  35.    32    FROM GrPorts IMPORT adsPort;
    36. 

  36. *****         ^ duplicate identifier
    37. 

  37.    33    FROM GrFonts IMPORT adsFont;
    38. 

  38.    34  
    39. 

  39.    35  
    40. 

  40.    36    CONST
    41. 

  41.    37      sec       = 18;
    42. 

  42.    38      COLOR     = 11;
    43. 

  43.    39  
    44. 

  44.    40    VAR
    45. 

  45.    41      GrafixCard,
    46. 

  46.    42      CommPort:   INTEGER;
    47. 

  47.    43      buf, buf1,
    48. 

  48.    44      Msg1, Msg2: ARRAY [0..79] OF CHAR;
    49. 

  49. *****                            ^ not supported yet
    50. 

  50. *****                                   ^ not supported yet
    51. 

  51.    45      x, y,
    52. 

  52.    46      ox, oy,
    53. 

  53.    47      i, j,
    54. 

  54.    48      evCnt,
    55. 

  55.    49      max_clr,
    56. 

  56.    50      clr,
    57. 

  57.    51      px, py,
    58. 

  58.    52      maxgig:     INTEGER;
    59. 

  59.    53      a, b:       ARRAY [0..15] OF INTEGER;
    60. 

  60. *****                            ^ not supported yet
    61. 

  61. *****                                   ^ not supported yet
    62. 

  62.    54      bol, bol1:  BOOLEAN;
    63. 

  63.    55      evnt:       event;
    64. 

  64.    56      R1, sR:     rect;
    65. 

  65.    57      pt:         point;
    66. 

  66.    58      scrMask,
    67. 

  67.    59      csrMask:    cursor;
    68. 

  68.    60      OK:         BOOLEAN;
    69. 

  69.    61      thePort:    adsPort;   (* pointer to default MetaWINDOW port     *)
    70. 

  70.    62      bm:         mapArray;
    71. 

  71.    63  
    72. 

  72.    64  
    73. 

  73.    65  (*
    74. 

  74.    66  ** assumes event queing is enabled. call with # of
    75. 

  75.    67  ** "ticks" to wait; ie appx 18 ticks per second
    76. 

  76.    68  ** occur. Also use for "time outs".
    77. 

  77.    69  *)
    78. 

  78.    70  
    79. 

  79.    71    PROCEDURE mwDelay(time: INTEGER);
    80. 

  80.    72      VAR
    81. 

  81.    73        b:    BOOLEAN;
    82. 

  82.    74        i:    INTEGER;
    83. 

  83.    75        evnt: event;
    84. 

  84.    76    BEGIN
    85. 

  85.    77      b := Meta.PeekEvent(0, evnt);
    86. 

  86. *****           ^ not supported yet
    87. 

  87. *****                ^ not supported yet
    88. 

  88. *****                             ^ not supported yet
    89. 

  89.    78      i := evnt.Time;
    90. 

  90. *****           ^ not supported yet
    91. 

  91. *****                ^ not supported yet
    92. 

  92.    79  
    93. 

  93.    80      REPEAT
    94. 

  94.    81        b := Meta.PeekEvent(0, evnt)
    95. 

  95. *****             ^ not supported yet
    96. 

  96. *****                  ^ not supported yet
    97. 

  97. *****                               ^ not supported yet
    98. 

  98.    82      UNTIL (evnt.Time - i >= time);
    99. 

  99. *****             ^ not supported yet
    100. 

  100. *****                  ^ not supported yet
    101. 

  101.    83    END mwDelay;
    102. 

  102. *****        ^ not supported yet
    103. 

  103.    84  
    104. 

  104.    85  (*** Display the active keys ***)
    105. 

  105.    86  
    106. 

  106.    87    PROCEDURE DispOpt();
    107. 

  107.    88    BEGIN
    108. 

  108.    89      Meta.RasterOp(GrConst.zXORz);
    109. 

  109. *****      ^ not supported yet
    110. 

  110. *****           ^ not supported yet
    111. 

  111. *****                    ^ not supported yet
    112. 

  112. *****                            ^ not supported yet
    113. 

  113.    90      Meta.MoveTo(px*2, py*22);
    114. 

  114. *****      ^ not supported yet
    115. 

  115. *****           ^ not supported yet
    116. 

  116. *****                             ^ not supported yet
    117. 

  117.    91      Meta.DrawString('- Active keys - [w]hirl-a-gig, [c]lear screen');
    118. 

  118. *****      ^ not supported yet
    119. 

  119. *****           ^ not supported yet
    120. 

  120. *****                      ^ not supported yet
    121. 

  121.    92      Meta.MoveTo(px*2, py*23);
    122. 

  122. *****      ^ not supported yet
    123. 

  123. *****           ^ not supported yet
    124. 

  124. *****                             ^ not supported yet
    125. 

  125.    93      Meta.DrawString('[f]lip origin, [t]racking on/off.');
    126. 

  126. *****      ^ not supported yet
    127. 

  127. *****           ^ not supported yet
    128. 

  128. *****                      ^ not supported yet
    129. 

  129.    94      Meta.MoveTo(px*2, py*24);
    130. 

  130. *****      ^ not supported yet
    131. 

  131. *****           ^ not supported yet
    132. 

  132. *****                             ^ not supported yet
    133. 

  133.    95      Meta.DrawString('mouse: lft=draw, rt=plot');
    134. 

  134. *****      ^ not supported yet
    135. 

  135. *****           ^ not supported yet
    136. 

  136. *****                      ^ not supported yet
    137. 

  137.    96      Meta.RasterOp(GrConst.zREPz);
    138. 

  138. *****      ^ not supported yet
    139. 

  139. *****           ^ not supported yet
    140. 

  140. *****                    ^ not supported yet
    141. 

  141. *****                            ^ not supported yet
    142. 

  142.    97    END DispOpt;
    143. 

  143. *****        ^ not supported yet
    144. 

  144.    98  
    145. 

  145.    99  (*** do some keen patterns ***)
    146. 

  146.   100  
    147. 

  147.   101    PROCEDURE DispPatt();
    148. 

  148.   102      VAR
    149. 

  149.   103        i: INTEGER;
    150. 

  150.   104    BEGIN
    151. 

  151.   105      Meta.SetRect(R1, 0, 0, sR.Xmax, sR.Ymax);
    152. 

  152. *****      ^ not supported yet
    153. 

  153. *****           ^ not supported yet
    154. 

  154. *****                   ^ not supported yet
    155. 

  155. *****                             ^ not supported yet
    156. 

  156. *****                                ^ not supported yet
    157. 

  157. *****                                      ^ not supported yet
    158. 

  158. *****                                         ^ not supported yet
    159. 

  159.   106      x := R1.Xmax DIV 32; y := R1.Ymax DIV 32;
    160. 

  160. *****           ^ not supported yet
    161. 

  161. *****              ^ not supported yet
    162. 

  162. *****                                ^ not supported yet
    163. 

  163. *****                                   ^ not supported yet
    164. 

  164.   107  
    165. 

  165.   108      FOR i := 0 TO 15 DO
    166. 

  166.   109        Meta.PenColor(i);
    167. 

  167. *****        ^ not supported yet
    168. 

  168. *****             ^ not supported yet
    169. 

  169. *****                       ^ not supported yet
    170. 

  170.   110        Meta.BackColor(15-i);
    171. 

  171. *****        ^ not supported yet
    172. 

  172. *****             ^ not supported yet
    173. 

  173. *****                           ^ not supported yet
    174. 

  174.   111        Meta.FillRect(R1, i+16);
    175. 

  175. *****        ^ not supported yet
    176. 

  176. *****             ^ not supported yet
    177. 

  177. *****                      ^ not supported yet
    178. 

  178. *****                              ^ not supported yet
    179. 

  179.   112        Meta.FrameRect(R1);
    180. 

  180. *****        ^ not supported yet
    181. 

  181. *****             ^ not supported yet
    182. 

  182. *****                       ^ not supported yet
    183. 

  183.   113        Meta.InsetRect(R1, x, y);
    184. 

  184. *****        ^ not supported yet
    185. 

  185. *****             ^ not supported yet
    186. 

  186. *****                       ^ not supported yet
    187. 

  187. *****                               ^ not supported yet
    188. 

  188.   114      END;
    189. 

  189.   115    END DispPatt;
    190. 

  190. *****        ^ not supported yet
    191. 

  191.   116  
    192. 

  192.   117  (*** Load the specified font. ***)
    193. 

  193.   118  
    194. 

  194.   119    PROCEDURE LoadFont(VAR fontName: ARRAY OF CHAR);
    195. 

  195. *****                                              ^ not supported yet
    196. 

  196.   120      VAR
    197. 

  197.   121        Dir:      dirRec;
    198. 

  198.   122        qErr,
    199. 

  199.   123        loadErr:  INTEGER;
    200. 

  200.   124        path:     ARRAY[0..80] OF CHAR;
    201. 

  201. *****                           ^ not supported yet
    202. 

  202. *****                                  ^ not supported yet
    203. 

  203.   125        fontBuf:  adsFont;
    204. 

  204.   126    BEGIN
    205. 

  205.   127      Str.Copy(path, fontName);
    206. 

  206. *****      ^ not supported yet
    207. 

  207. *****          ^ not supported yet
    208. 

  208. *****               ^ not supported yet
    209. 

  209. *****                     ^ not supported yet
    210. 

  210.   128      loadErr := -1;                             (* Preempt Error *)
    211. 

  211.   129      qErr    := Meta.FileQuery(path, Dir, 1);
    212. 

  212. *****                 ^ not supported yet
    213. 

  213. *****                      ^ not supported yet
    214. 

  214. *****                                ^ not supported yet
    215. 

  215. *****                                      ^ not supported yet
    216. 

  216. *****                                            ^ not supported yet
    217. 

  217.   130  
    218. 

  218.   131      IF (qErr # 1) THEN
    219. 

  219.   132        (* No font file in default dir, try environment variable *)
    220. 

  220.   133        Lib.EnvironmentFind("METAPATH", path);
    221. 

  221. *****        ^ not supported yet
    222. 

  222. *****            ^ not supported yet
    223. 

  223. *****                            ^ not supported yet
    224. 

  224. *****                                        ^ not supported yet
    225. 

  225.   134  
    226. 

  226.   135        IF (path[0] # CHR(0)) THEN
    227. 

  227. *****            ^ not supported yet
    228. 

  228. *****                  ^ not supported yet
    229. 

  229. *****                      ^ undeclared identifier
    230. 

  230. *****                           ^ not supported yet
    231. 

  231.   136          (* found the env parm, try using the path listed there *)
    232. 

  232.   137  
    233. 

  233.   138          IF (path[Str.Length(path)] # '\') THEN
    234. 

  234. *****              ^ not supported yet
    235. 

  235. *****                   ^ not supported yet
    236. 

  236. *****                       ^ not supported yet
    237. 

  237. *****                              ^ not supported yet
    238. 

  238.   139            (* If no trailing slash, add one *)
    239. 

  239.   140            Str.Append(path, '\');
    240. 

  240. *****            ^ not supported yet
    241. 

  241. *****                ^ not supported yet
    242. 

  242. *****                       ^ not supported yet
    243. 

  243. *****                                ^ not supported yet
    244. 

  244.   141          END;
    245. 

  245.   142  
    246. 

  246.   143          Str.Append(path, fontName);
    247. 

  247. *****          ^ not supported yet
    248. 

  248. *****              ^ not supported yet
    249. 

  249. *****                     ^ not supported yet
    250. 

  250. *****                           ^ not supported yet
    251. 

  251.   144          qErr := Meta.FileQuery(path, Dir, 1);
    252. 

  252. *****                  ^ not supported yet
    253. 

  253. *****                       ^ not supported yet
    254. 

  254. *****                                 ^ not supported yet
    255. 

  255. *****                                       ^ not supported yet
    256. 

  256. *****                                             ^ not supported yet
    257. 

  257.   145        END;
    258. 

  258.   146      END;
    259. 

  259.   147  
    260. 

  260.   148      IF (qErr = 1) THEN
    261. 

  261.   149        (* we got our file *)
    262. 

  262.   150        ALLOCATE(ADDRESS(fontBuf), VAL(CARDINAL, Dir.fileSize + 1));
    263. 

  263. *****        ^ not supported yet
    264. 

  264. *****                 ^ undeclared identifier
    265. 

  265. *****                         ^ not supported yet
    266. 

  266. *****                                   ^ undeclared identifier
    267. 

  267. *****                                                 ^ not supported yet
    268. 

  268. *****                                                     ^ not supported yet
    269. 

  269. *****                                                                 ^ not supported yet
    270. 

  270.   151  
    271. 

  271.   152        IF (fontBuf # NIL) THEN
    272. 

  272. *****            ^ not supported yet
    273. 

  273.   153          (* We got our memory *)
    274. 

  274.   154          loadErr := Meta.FileLoad(path, ADDRESS(fontBuf), VAL(CARDINAL, Dir.fileSize+1));
    275. 

  275. *****                     ^ not supported yet
    276. 

  276. *****                          ^ not supported yet
    277. 

  277. *****                                   ^ not supported yet
    278. 

  278. *****                                         ^ undeclared identifier
    279. 

  279. *****                                                 ^ not supported yet
    280. 

  280. *****                                                           ^ undeclared identifier
    281. 

  281. *****                                                                         ^ not supported yet
    282. 

  282. *****                                                                             ^ not supported yet
    283. 

  283. *****                                                                                       ^ not supported yet
    284. 

  284.   155          IF loadErr <= 0 THEN
    285. 

  285.   156            DEALLOCATE(ADDRESS(fontBuf), VAL(CARDINAL, Dir.fileSize + 1));
    286. 

  286. *****            ^ not supported yet
    287. 

  287. *****                       ^ undeclared identifier
    288. 

  288. *****                               ^ not supported yet
    289. 

  289. *****                                         ^ undeclared identifier
    290. 

  290. *****                                                       ^ not supported yet
    291. 

  291. *****                                                           ^ not supported yet
    292. 

  292. *****                                                                       ^ not supported yet
    293. 

  293.   157          END;
    294. 

  294.   158          Meta.SetFont(ADDRESS(fontBuf));
    295. 

  295. *****          ^ not supported yet
    296. 

  296. *****               ^ not supported yet
    297. 

  297. *****                       ^ undeclared identifier
    298. 

  298. *****                               ^ not supported yet
    299. 

  299.   159        END;
    300. 

  300.   160      END;
    301. 

  301.   161  
    302. 

  302.   162      IF (loadErr > 0) THEN
    303. 

  303.   163        (* clear out system load error *)
    304. 

  304.   164        qErr := Meta.QueryError();
    305. 

  305. *****                ^ not supported yet
    306. 

  306. *****                     ^ not supported yet
    307. 

  307. *****                                ^ not supported yet
    308. 

  308.   165      ELSE
    309. 

  309.   166        (* beep if font load probs *)
    310. 

  310.   167        IO.WrChar(CHR(7));
    311. 

  311. *****        ^ not supported yet
    312. 

  312. *****           ^ not supported yet
    313. 

  313. *****                  ^ undeclared identifier
    314. 

  314. *****                       ^ not supported yet
    315. 

  315.   168        Str.Copy(fontName, 'Using internal SYSTEM08.FNT');
    316. 

  316. *****        ^ not supported yet
    317. 

  317. *****            ^ not supported yet
    318. 

  318. *****                 ^ not supported yet
    319. 

  319. *****                           ^ not supported yet
    320. 

  320.   169      END;
    321. 

  321.   170    END LoadFont;
    322. 

  322. *****        ^ not supported yet
    323. 

  323.   171  
    324. 

  324.   172  
    325. 

  325.   173    PROCEDURE Insert(VAR S1: ARRAY OF CHAR; S2: ARRAY OF CHAR; Pos, Width: CARDINAL);
    326. 

  326. *****                                      ^ not supported yet
    327. 

  327. *****                                                         ^ not supported yet
    328. 

  328.   174      VAR
    329. 

  329.   175        L1, L2, i: CARDINAL;
    330. 

  330.   176    BEGIN
    331. 

  331.   177      L1 := Str.Length(S1);
    332. 

  332. *****            ^ not supported yet
    333. 

  333. *****                ^ not supported yet
    334. 

  334. *****                       ^ not supported yet
    335. 

  335.   178      L2 := Str.Length(S2);
    336. 

  336. *****            ^ not supported yet
    337. 

  337. *****                ^ not supported yet
    338. 

  338. *****                       ^ not supported yet
    339. 

  339.   179  
    340. 

  340.   180      IF (Pos + Width) > L1 THEN
    341. 

  341.   181        RETURN
    342. 

  342.   182      END;
    343. 

  343.   183  
    344. 

  344.   184      IF L2 > Width THEN
    345. 

  345.   185        RETURN
    346. 

  346.   186      END;
    347. 

  347.   187  
    348. 

  348.   188      FOR i := 0 TO L2 DO
    349. 

  349.   189        S1[Pos + i] := S2[i];
    350. 

  350. *****        ^ not supported yet
    351. 

  351. *****                  ^ not supported yet
    352. 

  352. *****                       ^ not supported yet
    353. 

  353. *****                           ^ not supported yet
    354. 

  354.   190      END;
    355. 

  355.   191  
    356. 

  356.   192      FOR i := Pos + L2 TO Pos + Width DO
    357. 

  357.   193        S1[i] := ' ';
    358. 

  358. *****        ^ not supported yet
    359. 

  359. *****            ^ not supported yet
    360. 

  360.   194      END;
    361. 

  361.   195    END Insert;
    362. 

  362. *****        ^ not supported yet
    363. 

  363.   196  
    364. 

  364.   197  
    365. 

  365.   198  BEGIN
    366. 

  366.   199    (* init the system *)
    367. 

  367.   200  
    368. 

  368.   201    GrQry.GrQuery(GrafixCard, CommPort);
    369. 

  369. *****    ^ not supported yet
    370. 

  370. *****          ^ not supported yet
    371. 

  371. *****                                      ^ not supported yet
    372. 

  372.   202  
    373. 

  373.   203    i := Meta.InitGrafix(-GrafixCard);
    374. 

  374. *****         ^ not supported yet
    375. 

  375. *****              ^ not supported yet
    376. 

  376. *****                                    ^ not supported yet
    377. 

  377.   204  
    378. 

  378.   205    IF (i # 0) THEN
    379. 

  379.   206      (* Display reason for no go *)
    380. 

  380.   207      GrQry.GrInitErr(GrafixCard, CommPort, i);
    381. 

  381. *****      ^ not supported yet
    382. 

  382. *****            ^ not supported yet
    383. 

  383. *****                                             ^ not supported yet
    384. 

  384.   208    END;
    385. 

  385.   209  
    386. 

  386.   210    Meta.ScreenRect(sR);
    387. 

  387. *****    ^ not supported yet
    388. 

  388. *****         ^ not supported yet
    389. 

  389. *****                    ^ not supported yet
    390. 

  390.   211    Meta.SetDisplay(GrConst.GrafPg0);
    391. 

  391. *****    ^ not supported yet
    392. 

  392. *****         ^ not supported yet
    393. 

  393. *****                    ^ not supported yet
    394. 

  394. *****                            ^ not supported yet
    395. 

  395.   212    max_clr := Meta.QueryColors();
    396. 

  396. *****               ^ not supported yet
    397. 

  397. *****                    ^ not supported yet
    398. 

  398. *****                                ^ not supported yet
    399. 

  399.   213    px := sR.Xmax DIV 80;
    400. 

  400. *****          ^ not supported yet
    401. 

  401. *****             ^ not supported yet
    402. 

  402.   214    py := sR.Ymax DIV 25;
    403. 

  403. *****          ^ not supported yet
    404. 

  404. *****             ^ not supported yet
    405. 

  405.   215    Meta.SetRect(R1, px*60, py*18, px*70, py*22);
    406. 

  406. *****    ^ not supported yet
    407. 

  407. *****         ^ not supported yet
    408. 

  408. *****                 ^ not supported yet
    409. 

  409. *****                                               ^ not supported yet
    410. 

  410.   216    Meta.PenColor(COLOR);
    411. 

  411. *****    ^ not supported yet
    412. 

  412. *****         ^ not supported yet
    413. 

  413. *****                       ^ not supported yet
    414. 

  414.   217    Meta.FillRect(sR, 1);
    415. 

  415. *****    ^ not supported yet
    416. 

  416. *****         ^ not supported yet
    417. 

  417. *****                  ^ not supported yet
    418. 

  418. *****                       ^ not supported yet
    419. 

  419.   218    Meta.PenColor(GrConst.White);
    420. 

  420. *****    ^ not supported yet
    421. 

  421. *****         ^ not supported yet
    422. 

  422. *****                  ^ not supported yet
    423. 

  423. *****                          ^ not supported yet
    424. 

  424.   219  
    425. 

  425.   220    Meta.GetPort(thePort);
    426. 

  426. *****    ^ not supported yet
    427. 

  427. *****         ^ not supported yet
    428. 

  428. *****                 ^ not supported yet
    429. 

  429.   221    i := thePort^.portBMap^.devClass;
    430. 

  430. *****         ^ not supported yet
    431. 

  431. *****                  ^ not supported yet
    432. 

  432. *****                            ^ not supported yet
    433. 

  433.   222  
    434. 

  434.   223    IF (thePort^.portBMap^.pixPlanes > 1) THEN
    435. 

  435. *****        ^ not supported yet
    436. 

  436. *****                 ^ not supported yet
    437. 

  437. *****                           ^ not supported yet
    438. 

  438.   224      i := INTEGER(BITSET(i) * BITSET(0FFF8H))
    439. 

  439. *****                   ^ undeclared identifier
    440. 

  440. *****                           ^ not supported yet
    441. 

  441. *****                               ^ undeclared identifier
    442. 

  442. *****                                            ^ not supported yet
    443. 

  443.   225    END;
    444. 

  444.   226  
    445. 

  445.   227    Str.Copy(buf1, 'SYSTEM');
    446. 

  446. *****    ^ not supported yet
    447. 

  447. *****        ^ not supported yet
    448. 

  448. *****             ^ not supported yet
    449. 

  449. *****                   ^ not supported yet
    450. 

  450.   228    Str.IntToStr(LONGINT(i), buf, 10, OK);
    451. 

  451. *****    ^ not supported yet
    452. 

  452. *****        ^ not supported yet
    453. 

  453. *****                          ^ not supported yet
    454. 

  454. *****                             ^ not supported yet
    455. 

  455. *****                                        ^ not supported yet
    456. 

  456.   229    Str.Append(buf1, buf);
    457. 

  457. *****    ^ not supported yet
    458. 

  458. *****        ^ not supported yet
    459. 

  459. *****               ^ not supported yet
    460. 

  460. *****                     ^ not supported yet
    461. 

  461.   230    Str.Append(buf1, '.FNT');
    462. 

  462. *****    ^ not supported yet
    463. 

  463. *****        ^ not supported yet
    464. 

  464. *****               ^ not supported yet
    465. 

  465. *****                     ^ not supported yet
    466. 

  466.   231  
    467. 

  467.   232    LoadFont(buf1);
    468. 

  468. *****    ^ not supported yet
    469. 

  469. *****             ^ not supported yet
    470. 

  470.   233  
    471. 

  471.   234    Meta.MoveTo(px, py);
    472. 

  472. *****    ^ not supported yet
    473. 

  473. *****         ^ not supported yet
    474. 

  474. *****                      ^ not supported yet
    475. 

  475.   235    Meta.DrawString(buf1);
    476. 

  476. *****    ^ not supported yet
    477. 

  477. *****         ^ not supported yet
    478. 

  478. *****                    ^ not supported yet
    479. 

  479.   236  
    480. 

  480.   237  (* Init the whirlagig *)
    481. 

  481.   238    Meta.PenSize(1, 1);
    482. 

  482. *****    ^ not supported yet
    483. 

  483. *****         ^ not supported yet
    484. 

  484. *****                     ^ not supported yet
    485. 

  485.   239    maxgig := 39;
    486. 

  486.   240  
    487. 

  487.   241    x := px * 10;
    488. 

  488.   242    y := py * 8;
    489. 

  489.   243    j := py;
    490. 

  490.   244  
    491. 

  491.   245    FOR i := 0 TO 15 DO
    492. 

  492.   246      a[i] := x - px * 5;
    493. 

  493. *****      ^ not supported yet
    494. 

  494. *****         ^ not supported yet
    495. 

  495.   247      b[i] := j;
    496. 

  496. *****      ^ not supported yet
    497. 

  497. *****         ^ not supported yet
    498. 

  498.   248      j    := j + py;
    499. 

  499.   249    END;
    500. 

  500.   250  
    501. 

  501.   251  (* Create a user-defined cursor to be a triangle *)
    502. 

  502.   252  
    503. 

  503.   253    scrMask.curWidth    := 16;    scrMask.curHeight   := 16;
    504. 

  504. *****    ^ not supported yet
    505. 

  505. *****            ^ not supported yet
    506. 

  506. *****                                  ^ not supported yet
    507. 

  507. *****                                          ^ not supported yet
    508. 

  508.   254    scrMask.curAlign    := 0;     scrMask.curRowBytes := 2;
    509. 

  509. *****    ^ not supported yet
    510. 

  510. *****            ^ not supported yet
    511. 

  511. *****                                  ^ not supported yet
    512. 

  512. *****                                          ^ not supported yet
    513. 

  513.   255    scrMask.curBits     := 1;     scrMask.curPlanes   := 1;
    514. 

  514. *****    ^ not supported yet
    515. 

  515. *****            ^ not supported yet
    516. 

  516. *****                                  ^ not supported yet
    517. 

  517. *****                                          ^ not supported yet
    518. 

  518.   256    scrMask.curData[0]  := 000H;  scrMask.curData[1]  := 000H;
    519. 

  519. *****    ^ not supported yet
    520. 

  520. *****            ^ not supported yet
    521. 

  521. *****                     ^ not supported yet
    522. 

  522. *****                                  ^ not supported yet
    523. 

  523. *****                                          ^ not supported yet
    524. 

  524. *****                                                   ^ not supported yet
    525. 

  525.   257    scrMask.curData[2]  := 000H;  scrMask.curData[3]  := 000H;
    526. 

  526. *****    ^ not supported yet
    527. 

  527. *****            ^ not supported yet
    528. 

  528. *****                     ^ not supported yet
    529. 

  529. *****                                  ^ not supported yet
    530. 

  530. *****                                          ^ not supported yet
    531. 

  531. *****                                                   ^ not supported yet
    532. 

  532.   258    scrMask.curData[4]  := 000H;  scrMask.curData[5]  := 000H;
    533. 

  533. *****    ^ not supported yet
    534. 

  534. *****            ^ not supported yet
    535. 

  535. *****                     ^ not supported yet
    536. 

  536. *****                                  ^ not supported yet
    537. 

  537. *****                                          ^ not supported yet
    538. 

  538. *****                                                   ^ not supported yet
    539. 

  539.   259    scrMask.curData[6]  := 000H;  scrMask.curData[7]  := 000H;
    540. 

  540. *****    ^ not supported yet
    541. 

  541. *****            ^ not supported yet
    542. 

  542. *****                     ^ not supported yet
    543. 

  543. *****                                  ^ not supported yet
    544. 

  544. *****                                          ^ not supported yet
    545. 

  545. *****                                                   ^ not supported yet
    546. 

  546.   260    scrMask.curData[8]  := 000H;  scrMask.curData[9]  := 000H;
    547. 

  547. *****    ^ not supported yet
    548. 

  548. *****            ^ not supported yet
    549. 

  549. *****                     ^ not supported yet
    550. 

  550. *****                                  ^ not supported yet
    551. 

  551. *****                                          ^ not supported yet
    552. 

  552. *****                                                   ^ not supported yet
    553. 

  553.   261    scrMask.curData[10] := 000H;  scrMask.curData[11] := 000H;
    554. 

  554. *****    ^ not supported yet
    555. 

  555. *****            ^ not supported yet
    556. 

  556. *****                      ^ not supported yet
    557. 

  557. *****                                  ^ not supported yet
    558. 

  558. *****                                          ^ not supported yet
    559. 

  559. *****                                                    ^ not supported yet
    560. 

  560.   262    scrMask.curData[12] := 000H;  scrMask.curData[13] := 000H;
    561. 

  561. *****    ^ not supported yet
    562. 

  562. *****            ^ not supported yet
    563. 

  563. *****                      ^ not supported yet
    564. 

  564. *****                                  ^ not supported yet
    565. 

  565. *****                                          ^ not supported yet
    566. 

  566. *****                                                    ^ not supported yet
    567. 

  567.   263    scrMask.curData[14] := 001H;  scrMask.curData[15] := 000H;
    568. 

  568. *****    ^ not supported yet
    569. 

  569. *****            ^ not supported yet
    570. 

  570. *****                      ^ not supported yet
    571. 

  571. *****                                  ^ not supported yet
    572. 

  572. *****                                          ^ not supported yet
    573. 

  573. *****                                                    ^ not supported yet
    574. 

  574.   264    scrMask.curData[16] := 003H;  scrMask.curData[17] := 080H;
    575. 

  575. *****    ^ not supported yet
    576. 

  576. *****            ^ not supported yet
    577. 

  577. *****                      ^ not supported yet
    578. 

  578. *****                                  ^ not supported yet
    579. 

  579. *****                                          ^ not supported yet
    580. 

  580. *****                                                    ^ not supported yet
    581. 

  581.   265    scrMask.curData[18] := 007H;  scrMask.curData[19] := 0C0H;
    582. 

  582. *****    ^ not supported yet
    583. 

  583. *****            ^ not supported yet
    584. 

  584. *****                      ^ not supported yet
    585. 

  585. *****                                  ^ not supported yet
    586. 

  586. *****                                          ^ not supported yet
    587. 

  587. *****                                                    ^ not supported yet
    588. 

  588.   266    scrMask.curData[20] := 00FH;  scrMask.curData[21] := 0E0H;
    589. 

  589. *****    ^ not supported yet
    590. 

  590. *****            ^ not supported yet
    591. 

  591. *****                      ^ not supported yet
    592. 

  592. *****                                  ^ not supported yet
    593. 

  593. *****                                          ^ not supported yet
    594. 

  594. *****                                                    ^ not supported yet
    595. 

  595.   267    scrMask.curData[22] := 01FH;  scrMask.curData[23] := 0F0H;
    596. 

  596. *****    ^ not supported yet
    597. 

  597. *****            ^ not supported yet
    598. 

  598. *****                      ^ not supported yet
    599. 

  599. *****                                  ^ not supported yet
    600. 

  600. *****                                          ^ not supported yet
    601. 

  601. *****                                                    ^ not supported yet
    602. 

  602.   268    scrMask.curData[24] := 03FH;  scrMask.curData[25] := 0F8H;
    603. 

  603. *****    ^ not supported yet
    604. 

  604. *****            ^ not supported yet
    605. 

  605. *****                      ^ not supported yet
    606. 

  606. *****                                  ^ not supported yet
    607. 

  607. *****                                          ^ not supported yet
    608. 

  608. *****                                                    ^ not supported yet
    609. 

  609.   269    scrMask.curData[26] := 07FH;  scrMask.curData[27] := 0FCH;
    610. 

  610. *****    ^ not supported yet
    611. 

  611. *****            ^ not supported yet
    612. 

  612. *****                      ^ not supported yet
    613. 

  613. *****                                  ^ not supported yet
    614. 

  614. *****                                          ^ not supported yet
    615. 

  615. *****                                                    ^ not supported yet
    616. 

  616.   270    scrMask.curData[28] := 000H;  scrMask.curData[29] := 000H;
    617. 

  617. *****    ^ not supported yet
    618. 

  618. *****            ^ not supported yet
    619. 

  619. *****                      ^ not supported yet
    620. 

  620. *****                                  ^ not supported yet
    621. 

  621. *****                                          ^ not supported yet
    622. 

  622. *****                                                    ^ not supported yet
    623. 

  623.   271    scrMask.curData[30] := 000H;  scrMask.curData[31] := 000H;
    624. 

  624. *****    ^ not supported yet
    625. 

  625. *****            ^ not supported yet
    626. 

  626. *****                      ^ not supported yet
    627. 

  627. *****                                  ^ not supported yet
    628. 

  628. *****                                          ^ not supported yet
    629. 

  629. *****                                                    ^ not supported yet
    630. 

  630.   272  
    631. 

  631.   273    csrMask.curWidth    := 16;    csrMask.curHeight   := 16;
    632. 

  632. *****    ^ not supported yet
    633. 

  633. *****            ^ not supported yet
    634. 

  634. *****                                  ^ not supported yet
    635. 

  635. *****                                          ^ not supported yet
    636. 

  636.   274    csrMask.curAlign    := 0;     csrMask.curRowBytes := 2;
    637. 

  637. *****    ^ not supported yet
    638. 

  638. *****            ^ not supported yet
    639. 

  639. *****                                  ^ not supported yet
    640. 

  640. *****                                          ^ not supported yet
    641. 

  641.   275    csrMask.curBits     := 1;     csrMask.curPlanes   := 1;
    642. 

  642. *****    ^ not supported yet
    643. 

  643. *****            ^ not supported yet
    644. 

  644. *****                                  ^ not supported yet
    645. 

  645. *****                                          ^ not supported yet
    646. 

  646.   276    csrMask.curData[0]  := 000H;  csrMask.curData[1]  := 000H;
    647. 

  647. *****    ^ not supported yet
    648. 

  648. *****            ^ not supported yet
    649. 

  649. *****                     ^ not supported yet
    650. 

  650. *****                                  ^ not supported yet
    651. 

  651. *****                                          ^ not supported yet
    652. 

  652. *****                                                   ^ not supported yet
    653. 

  653.   277    csrMask.curData[2]  := 000H;  csrMask.curData[3]  := 000H;
    654. 

  654. *****    ^ not supported yet
    655. 

  655. *****            ^ not supported yet
    656. 

  656. *****                     ^ not supported yet
    657. 

  657. *****                                  ^ not supported yet
    658. 

  658. *****                                          ^ not supported yet
    659. 

  659. *****                                                   ^ not supported yet
    660. 

  660.   278    csrMask.curData[4]  := 000H;  csrMask.curData[5]  := 000H;
    661. 

  661. *****    ^ not supported yet
    662. 

  662. *****            ^ not supported yet
    663. 

  663. *****                     ^ not supported yet
    664. 

  664. *****                                  ^ not supported yet
    665. 

  665. *****                                          ^ not supported yet
    666. 

  666. *****                                                   ^ not supported yet
    667. 

  667.   279    csrMask.curData[6]  := 000H;  csrMask.curData[7]  := 000H;
    668. 

  668. *****    ^ not supported yet
    669. 

  669. *****            ^ not supported yet
    670. 

  670. *****                     ^ not supported yet
    671. 

  671. *****                                  ^ not supported yet
    672. 

  672. *****                                          ^ not supported yet
    673. 

  673. *****                                                   ^ not supported yet
    674. 

  674.   280    csrMask.curData[8]  := 000H;  csrMask.curData[9]  := 000H;
    675. 

  675. *****    ^ not supported yet
    676. 

  676. *****            ^ not supported yet
    677. 

  677. *****                     ^ not supported yet
    678. 

  678. *****                                  ^ not supported yet
    679. 

  679. *****                                          ^ not supported yet
    680. 

  680. *****                                                   ^ not supported yet
    681. 

  681.   281    csrMask.curData[10] := 000H;  csrMask.curData[11] := 000H;
    682. 

  682. *****    ^ not supported yet
    683. 

  683. *****            ^ not supported yet
    684. 

  684. *****                      ^ not supported yet
    685. 

  685. *****                                  ^ not supported yet
    686. 

  686. *****                                          ^ not supported yet
    687. 

  687. *****                                                    ^ not supported yet
    688. 

  688.   282    csrMask.curData[12] := 001H;  csrMask.curData[13] := 000H;
    689. 

  689. *****    ^ not supported yet
    690. 

  690. *****            ^ not supported yet
    691. 

  691. *****                      ^ not supported yet
    692. 

  692. *****                                  ^ not supported yet
    693. 

  693. *****                                          ^ not supported yet
    694. 

  694. *****                                                    ^ not supported yet
    695. 

  695.   283    csrMask.curData[14] := 002H;  csrMask.curData[15] := 080H;
    696. 

  696. *****    ^ not supported yet
    697. 

  697. *****            ^ not supported yet
    698. 

  698. *****                      ^ not supported yet
    699. 

  699. *****                                  ^ not supported yet
    700. 

  700. *****                                          ^ not supported yet
    701. 

  701. *****                                                    ^ not supported yet
    702. 

  702.   284    csrMask.curData[16] := 004H;  csrMask.curData[17] := 040H;
    703. 

  703. *****    ^ not supported yet
    704. 

  704. *****            ^ not supported yet
    705. 

  705. *****                      ^ not supported yet
    706. 

  706. *****                                  ^ not supported yet
    707. 

  707. *****                                          ^ not supported yet
    708. 

  708. *****                                                    ^ not supported yet
    709. 

  709.   285    csrMask.curData[18] := 008H;  csrMask.curData[19] := 020H;
    710. 

  710. *****    ^ not supported yet
    711. 

  711. *****            ^ not supported yet
    712. 

  712. *****                      ^ not supported yet
    713. 

  713. *****                                  ^ not supported yet
    714. 

  714. *****                                          ^ not supported yet
    715. 

  715. *****                                                    ^ not supported yet
    716. 

  716.   286    csrMask.curData[20] := 010H;  csrMask.curData[21] := 010H;
    717. 

  717. *****    ^ not supported yet
    718. 

  718. *****            ^ not supported yet
    719. 

  719. *****                      ^ not supported yet
    720. 

  720. *****                                  ^ not supported yet
    721. 

  721. *****                                          ^ not supported yet
    722. 

  722. *****                                                    ^ not supported yet
    723. 

  723.   287    csrMask.curData[22] := 020H;  csrMask.curData[23] := 008H;
    724. 

  724. *****    ^ not supported yet
    725. 

  725. *****            ^ not supported yet
    726. 

  726. *****                      ^ not supported yet
    727. 

  727. *****                                  ^ not supported yet
    728. 

  728. *****                                          ^ not supported yet
    729. 

  729. *****                                                    ^ not supported yet
    730. 

  730.   288    csrMask.curData[24] := 040H;  csrMask.curData[25] := 004H;
    731. 

  731. *****    ^ not supported yet
    732. 

  732. *****            ^ not supported yet
    733. 

  733. *****                      ^ not supported yet
    734. 

  734. *****                                  ^ not supported yet
    735. 

  735. *****                                          ^ not supported yet
    736. 

  736. *****                                                    ^ not supported yet
    737. 

  737.   289    csrMask.curData[26] := 080H;  csrMask.curData[27] := 002H;
    738. 

  738. *****    ^ not supported yet
    739. 

  739. *****            ^ not supported yet
    740. 

  740. *****                      ^ not supported yet
    741. 

  741. *****                                  ^ not supported yet
    742. 

  742. *****                                          ^ not supported yet
    743. 

  743. *****                                                    ^ not supported yet
    744. 

  744.   290    csrMask.curData[28] := 0FFH;  csrMask.curData[29] := 0FEH;
    745. 

  745. *****    ^ not supported yet
    746. 

  746. *****            ^ not supported yet
    747. 

  747. *****                      ^ not supported yet
    748. 

  748. *****                                  ^ not supported yet
    749. 

  749. *****                                          ^ not supported yet
    750. 

  750. *****                                                    ^ not supported yet
    751. 

  751.   291    csrMask.curData[30] := 000H;  csrMask.curData[31] := 000H;
    752. 

  752. *****    ^ not supported yet
    753. 

  753. *****            ^ not supported yet
    754. 

  754. *****                      ^ not supported yet
    755. 

  755. *****                                  ^ not supported yet
    756. 

  756. *****                                          ^ not supported yet
    757. 

  757. *****                                                    ^ not supported yet
    758. 

  758.   292  
    759. 

  759.   293    Meta.DefineCursor(2, 8, 8, scrMask, csrMask);
    760. 

  760. *****    ^ not supported yet
    761. 

  761. *****         ^ not supported yet
    762. 

  762. *****                               ^ not supported yet
    763. 

  763. *****                                        ^ not supported yet
    764. 

  764.   294  
    765. 

  765.   295  
    766. 

  766.   296  (* Now turn on mouse and event queue stuff *)
    767. 

  767.   297    Meta.InitMouse(CommPort);
    768. 

  768. *****    ^ not supported yet
    769. 

  769. *****         ^ not supported yet
    770. 

  770. *****                           ^ not supported yet
    771. 

  771.   298  
    772. 

  772.   299    Meta.ScaleMouse (sR.Xmax DIV 40, sR.Ymax DIV 40);
    773. 

  773. *****    ^ not supported yet
    774. 

  774. *****         ^ not supported yet
    775. 

  775. *****                     ^ not supported yet
    776. 

  776. *****                        ^ not supported yet
    777. 

  777. *****                                     ^ not supported yet
    778. 

  778. *****                                        ^ not supported yet
    779. 

  779. *****                                                   ^ not supported yet
    780. 

  780.   300  
    781. 

  781.   301    ox := 100;
    782. 

  782.   302    x  := 100;
    783. 

  783.   303    oy := 100;
    784. 

  784.   304    y  := 100;
    785. 

  785.   305  
    786. 

  786.   306    Meta.MoveCursor(x, y);
    787. 

  787. *****    ^ not supported yet
    788. 

  788. *****         ^ not supported yet
    789. 

  789. *****                        ^ not supported yet
    790. 

  790.   307  
    791. 

  791.   308    FOR i := 0 TO 7 DO
    792. 

  792.   309       bm[i] := i;
    793. 

  793. *****       ^ not supported yet
    794. 

  794. *****           ^ not supported yet
    795. 

  795.   310    END;
    796. 

  796.   311  
    797. 

  797.   312    bm[4] := 0;   (* arrow *)
    798. 

  798. *****    ^ not supported yet
    799. 

  799. *****        ^ not supported yet
    800. 

  800.   313    bm[5] := 2;   (* new pointy thing *)
    801. 

  801. *****    ^ not supported yet
    802. 

  802. *****        ^ not supported yet
    803. 

  803.   314    Meta.CursorMap(bm);
    804. 

  804. *****    ^ not supported yet
    805. 

  805. *****         ^ not supported yet
    806. 

  806. *****                   ^ not supported yet
    807. 

  807.   315    bol  := TRUE;
    808. 

  808.   316    bol1 := TRUE;
    809. 

  809.   317  
    810. 

  810.   318  (* Enable mouse autotracking & event queue*)
    811. 

  811.   319  
    812. 

  812.   320    Meta.TrackCursor(bol);
    813. 

  813. *****    ^ not supported yet
    814. 

  814. *****         ^ not supported yet
    815. 

  815. *****                        ^ not supported yet
    816. 

  816.   321    Meta.ShowCursor();
    817. 

  817. *****    ^ not supported yet
    818. 

  818. *****         ^ not supported yet
    819. 

  819. *****                    ^ not supported yet
    820. 

  820.   322    Meta.EventQueue(TRUE);
    821. 

  821. *****    ^ not supported yet
    822. 

  822. *****         ^ not supported yet
    823. 

  823. *****                        ^ not supported yet
    824. 

  824.   323  
    825. 

  825.   324  (* flush event queue *)
    826. 

  826.   325    WHILE Meta.KeyEvent(FALSE, evnt) DO
    827. 

  827. *****          ^ not supported yet
    828. 

  828. *****               ^ not supported yet
    829. 

  829. *****                               ^ not supported yet
    830. 

  830.   326      ;
    831. 

  831.   327    END;
    832. 

  832. *****       ^ ident expected
    833. 

  833.   328  
    834. 

  834.   329    DispOpt();
    835. 

  835.   330    Meta.LimitMouse(sR.Xmin-20, sR.Ymin-20, sR.Xmax+20, sR.Ymax+20);
    836. 

  836.   331    clr   := 0;
    837. 

  837.   332    evCnt := 0;
    838. 

  838.   333  
    839. 

  839.   334    Meta.RasterOp(GrConst.zREPz);
    840. 

  840.   335  
    841. 

  841.   336  (* Init messages *)
    842. 

  842.   337    Str.Copy(Msg1, 'event=    ascii=    scan=    state=      x=     y=     time=      ');
    843. 

  843.   338    Str.Copy(Msg2, 'x=     y=     sw=    time=       ');
    844. 

  844.   339  
    845. 

  845.   340  
    846. 

  846.   341    REPEAT
    847. 

  847.   342      Meta.QueryCursor(pt.X, pt.Y, i, j);
    848. 

  848.   343  
    849. 

  849.   344      IF Meta.KeyEvent(FALSE, evnt) THEN
    850. 

  850.   345        CASE evnt.ASCII OF
    851. 

  851.   346        | 't':  (* t will flip tracking on/off *)
    852. 

  852.   347          bol := NOT(bol);
    853. 

  853.   348          Meta.TrackCursor(bol);
    854. 

  854.   349        | 'c':    (* clears screen *)
    855. 

  855.   350          Meta.HideCursor();
    856. 

  856.   351          Meta.PenColor(COLOR);
    857. 

  857.   352          Meta.FillRect(sR, 1);
    858. 

  858.   353          Meta.PenColor(GrConst.White);
    859. 

  859.   354          DispOpt();
    860. 

  860.   355          Meta.ShowCursor();
    861. 

  861.   356        | 'f':   (* f will flip port origin *)
    862. 

  862.   357            Meta.HideCursor();
    863. 

  863.   358            bol1 := NOT(bol1);
    864. 

  864.   359            Meta.PortOrigin(bol1);
    865. 

  865.   360            Meta.PenColor(COLOR);
    866. 

  866.   361            Meta.FillRect(sR, 1);
    867. 

  867.   362            Meta.PenColor(GrConst.White);
    868. 

  868.   363            DispOpt();
    869. 

  869.   364            Meta.ShowCursor();
    870. 

  870.   365         | 'w':   (* w for the whilagig *)
    871. 

  871.   366            Meta.HideCursor();
    872. 

  872.   367            Meta.RasterOp (GrConst.zXORz);
    873. 

  873.   368            FOR i := 0 TO maxgig DO
    874. 

  874.   369              FOR j := 0 TO 15 DO
    875. 

  875.   370                Meta.MoveTo (pt.X, pt.Y);
    876. 

  876.   371                Meta.LineTo (a[j], b[j]);
    877. 

  877.   372              END
    878. 

  878.   373            END;
    879. 

  879.   374            Meta.RasterOp(GrConst.zREPz);
    880. 

  880.   375            Meta.ShowCursor();
    881. 

  881.   376        END;
    882. 

  882.   377  
    883. 

  883.   378        INC(evCnt);
    884. 

  884.   379        Str.IntToStr(LONGINT(evCnt), buf, 10, OK);
    885. 

  885.   380        Insert(Msg1, buf, 6, 2);
    886. 

  886.   381        Str.IntToStr(LONGINT(evnt.ASCII), buf, 16, OK);
    887. 

  887.   382        Insert(Msg1, buf, 16, 2);
    888. 

  888.   383        Str.IntToStr(LONGINT(evnt.ScanCode), buf, 16, OK);
    889. 

  889.   384        Insert(Msg1, buf, 25, 2);
    890. 

  890.   385        Str.IntToStr(LONGINT(evnt.State), buf, 16, OK);
    891. 

  891.   386        Insert(Msg1, buf, 35, 4);
    892. 

  892.   387        Str.IntToStr(LONGINT(evnt.CursorX), buf, 10, OK);
    893. 

  893.   388        Insert(Msg1, buf, 43, 3);
    894. 

  894.   389        Str.IntToStr(LONGINT(evnt.CursorY), buf, 10, OK);
    895. 

  895.   390        Insert(Msg1, buf, 50, 3);
    896. 

  896.   391        Str.IntToStr(LONGINT(evnt.Time), buf, 10, OK);
    897. 

  897.   392        Insert(Msg1, buf, 60, 5);
    898. 

  898.   393        Meta.MoveTo(px*6, py*2);
    899. 

  899.   394        Meta.DrawString(Msg1);
    900. 

  900.   395  
    901. 

  901.   396      ELSIF (evnt.Time MOD 8) = 0  THEN
    902. 

  902.   397        Meta.ProtectRect(R1);
    903. 

  903.   398        Meta.PenColor(clr);
    904. 

  904.   399        Meta.FillRect(R1, 1);
    905. 

  905.   400        Meta.ProtectOff();
    906. 

  906.   401        INC(clr);
    907. 

  907.   402  
    908. 

  908.   403        IF (clr > max_clr) THEN
    909. 

  909.   404          clr := 0
    910. 

  910.   405        END;
    911. 

  911.   406      END;
    912. 

  912.   407  
    913. 

  913.   408  (*** etch-a-sketch ***)
    914. 

  914.   409  
    915. 

  915.   410      IF j = (GrConst.swRight + GrConst.swLeft) THEN
    916. 

  916.   411        Meta.PenColor(GrConst.Black);
    917. 

  917.   412        Meta.HideCursor();
    918. 

  918.   413        Meta.MoveTo(ox, oy);
    919. 

  919.   414        Meta.LineTo(pt.X, pt.Y);
    920. 

  920.   415        Meta.ShowCursor();
    921. 

  921.   416      ELSE
    922. 

  922.   417        IF INTEGER(BITSET(j) * BITSET(GrConst.swLeft)) # 0 THEN
    923. 

  923.   418          Meta.PenColor(GrConst.Black);
    924. 

  924.   419          Meta.HideCursor();
    925. 

  925.   420          Meta.MoveTo(ox, oy);
    926. 

  926.   421          Meta.LineTo(pt.X, pt.Y);
    927. 

  927.   422          Meta.ShowCursor();
    928. 

  928.   423        END;
    929. 

  929.   424        ox := pt.X;
    930. 

  930.   425        oy := pt.Y;
    931. 

  931.   426      END;
    932. 

  932.   427  
    933. 

  933.   428      Meta.PenColor(GrConst.White);
    934. 

  934.   429  
    935. 

  935.   430  
    936. 

  936.   431      Str.IntToStr(LONGINT(evnt.CursorX), buf, 10, OK);
    937. 

  937.   432      Insert(Msg2, buf, 2, 3);
    938. 

  938.   433      Str.IntToStr(LONGINT(evnt.CursorY), buf, 10, OK);
    939. 

  939.   434      Insert(Msg2, buf, 9, 3);
    940. 

  940.   435      Str.IntToStr(LONGINT(j), buf, 10, OK);
    941. 

  941.   436      Insert(Msg2, buf, 17, 2);
    942. 

  942.   437      Str.IntToStr(LONGINT(evnt.Time), buf, 10, OK);
    943. 

  943.   438      Insert(Msg2, buf, 26, 6);
    944. 

  944.   439      Meta.MoveTo(px*6, py*4);
    945. 

  945.   440      Meta.DrawString(Msg2);
    946. 

  946.   441  
    947. 

  947.   442      IF  Meta.PtInRect(pt, R1) THEN
    948. 

  948.   443         Meta.DrawString(" pt IS in rect  ");
    949. 

  949.   444      ELSE
    950. 

  950.   445         Meta.DrawString(" pt NOT in rect ");
    951. 

  951.   446      END;
    952. 

  952.   447  
    953. 

  953.   448      Meta.RasterOp(GrConst.zXORz);
    954. 

  954.   449      Meta.MoveTo(px*79, py*4);
    955. 

  955.   450      Meta.LineTo(px*79, py*20);
    956. 

  956.   451      Meta.RasterOp(GrConst.zREPz);
    957. 

  957.   452    UNTIL ((pt.X <= -20) AND ((evnt.ASCII # CHR(3)) AND (evnt.ScanCode # BYTE(02EH))));
    958. 

  958.   453  
    959. 

  959.   454    Meta.TrackCursor(FALSE);
    960. 

  960.   455    Meta.HideCursor();
    961. 

  961.   456  
    962. 

  962.   457    Meta.BackColor(COLOR);
    963. 

  963.   458  
    964. 

  964.   459  (* Scroll a rectangle into screen *)
    965. 

  965.   460  
    966. 

  966.   461    Meta.RasterOp(GrConst.zXORz);
    967. 

  967.   462    Meta.FrameRect(R1);
    968. 

  968.   463    Meta.RasterOp(GrConst.zREPz);
    969. 

  969.   464  
    970. 

  970.   465    FOR i := 0 TO 30 DO
    971. 

  971.   466      Meta.ScrollRect(R1, 0, -4);
    972. 

  972.   467      Meta.OffsetRect(R1, 0, -4);
    973. 

  973.   468    END;
    974. 

  974.   469  
    975. 

  975.   470    FOR i := 0 TO 40 DO
    976. 

  976.   471      Meta.ScrollRect(R1, 8, 0);
    977. 

  977.   472      Meta.OffsetRect(R1, 8, 0);
    978. 

  978.   473    END;
    979. 

  979.   474  
    980. 

  980.   475    mwDelay(sec);
    981. 

  981.   476  
    982. 

  982.   477  (* pretty patterns to end with *)
    983. 

  983.   478    DispPatt();
    984. 

  984.   479    mwDelay(sec*3);
    985. 

  985.   480  
    986. 

  986.   481    GrQry.GrQuit('', 0);
    987. 

  987.   482  
    988. 

  988.   483  END Testtrak.
    989. 

  989. 

  990.   503 errors
    991. 

  991. 

  992.