Listing: 1 (* Release 3.10 *) 2 (*-------------------------------------------------------------------------* 3 * * 4 * GRAPH.MOD - Graphics functions * 5 * * 6 * COPYRIGHT (C) 1987..1992 Clarion Software Corporation. * 7 * All Rights Reserved * 8 * * 9 *--------------------------------------------------------------------------*) 10 11 (*# call(o_a_copy => off) *) 12 (*%T _fcall *) 13 (*# call(seg_name => GRAPHICS) *) 14 (*%E *) 15 (*# module(implementation=>off) *) 16 (*%F _fdata *) 17 (*# data(seg_name => null) *) 18 (*%E *) 19 (*# check(stack=>off, 20 index=>off, 21 range=>off, 22 overflow=>off, 23 nil_ptr=>off) *) 24 25 26 IMPLEMENTATION MODULE Graph; 27 28 IMPORT Str,Lib,SYSTEM,Storage; 29 (*%T _XTD *) 30 IMPORT IO,TSXLIB; 31 FROM TSXLIB IMPORT SEL_A000H,SEL_B000H,SEL_B800H; ***** ^ duplicate identifier 32 CONST _XTDDOS = TRUE; 33 (*%E*) 34 (*%F _XTD *) 35 (*%F _OS2 *) 36 IMPORT IO; 37 CONST _XTDDOS = TRUE; 38 (*%E *) 39 (*%T _OS2 *) 40 (*%F _fcall *) 41 IMPORT IO; 42 (*%E *) 43 IMPORT Dos,Vio,GraphI,CoreGraph,CoreSig; 44 FROM Storage IMPORT ALLOCATE,DEALLOCATE; 45 CONST _XTDDOS = FALSE; 46 (*%E _OS2 *) 47 (*%E _XTD *) 48 49 (*%T _XTDDOS *) 50 51 (*%F _XTD *) 52 CONST 53 SEL_A000H = 0A000H; 54 SEL_B000H = 0B000H; 55 SEL_B800H = 0B800H; 56 (*%E*) 57 58 (*****************************************************************************) 59 (* Constant Definitions. *) 60 (*****************************************************************************) 61 62 CONST 63 HEADER_SIZE = 4; 64 FILL_MASK_SIZE = 8; 65 GRAPHICS = 1; 66 TEXT = 0; 67 LEFT = -1; 68 RIGHT = 1; 69 UP = -1; 70 DOWN = 1; 71 MAXMODE = _MRES256COLOR; ***** ^ undeclared identifier 72 CGA320Width = 320; 73 CGA640Width = 640; 74 EGA640Width = 640; 75 EGA320Width = 320; 76 EGA200Depth = 200; 77 EGA350Depth = 350; 78 EGA480Depth = 480; 79 80 TYPE 81 ArcQuadrant = ARRAY [0..3] OF SHORTCARD; ***** ^ not supported yet ***** ^ not supported yet 82 83 CONST 84 _Q_CLEAR = 5; 85 _Q_1SEG = 4; (* one section in quadrant *) 86 _Q_2SEG = 3; (* two sections in quadrant *) 87 _Q_STEST = 2; (* start vector in quadrant *) 88 _Q_ETEST = 1; (* end vector in quadrant *) 89 _Q_NULL = 0; 90 91 (*****************************************************************************) 92 (* type and function definitions. *) 93 (*****************************************************************************) 94 TYPE 95 InterSect = RECORD 96 x,y : INTEGER; 97 END; (*InterSect*) ***** ^ not supported yet 98 99 FloodStart = RECORD 100 best_quad : INTEGER; 101 quad_type : INTEGER; 102 flag : INTEGER; 103 END; (*FloodStart*) ***** ^ not supported yet 104 tinyint = [0..7]; 105 bs = SET OF tinyint; ***** ^ not supported yet 106 bp = POINTER TO bs; ***** ^ not supported yet 107 (*# save,data(near_ptr=>off) *) 108 HercMapType = ARRAY[0..(HercDepth DIV 4)-1] OF ARRAY[0..(HercWidth DIV 8)-1] OF bs; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 109 CGAPointer = POINTER TO SHORTCARD; ***** ^ not supported yet 110 VGAPointer = POINTER TO SHORTCARD; ***** ^ not supported yet 111 (*# restore *) 112 113 VAR 114 (*# save,data(near_ptr=>off) *) 115 HercBitMap : ARRAY [0..1] OF ARRAY [0..3] OF POINTER TO HercMapType; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 116 (*# restore *) 117 StaticMode : CARDINAL; 118 (*****************************************************************************) 119 (* Data Definitions and Declarations. *) 120 (*****************************************************************************) 121 122 TYPE 123 ColTableType = ARRAY [0..15] OF LONGCARD; ***** ^ not supported yet ***** ^ undeclared identifier 124 EGATableType = ARRAY [0..15] OF CARDINAL; ***** ^ not supported yet ***** ^ not supported yet 125 CONST 126 ColTable = ColTableType( _BLACK, _BLUE, _GREEN, _CYAN, _RED, _MAGENTA, _BROWN, ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier 127 _WHITE, _GRAY, _LIGHTBLUE, _LIGHTGREEN, _LIGHTCYAN, ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier 128 _LIGHTRED, _LIGHTMAGENTA, _LIGHTYELLOW, _BRIGHTWHITE); ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier 129 130 131 VAR 132 EGATable: EGATableType; ***** ^ not supported yet 133 ModeChanged: BOOLEAN; 134 (*****************************************************************************) 135 (* Function definitions - low level plotting and drawing. *) 136 (*****************************************************************************) 137 138 (*# save *) 139 (*# call(near_call=>on) *) 140 141 142 PROCEDURE EllipsePlot(x, y: INTEGER); 143 144 BEGIN 145 IF ((x <= CoreGraph._clip_br.xcoord) AND (x >= CoreGraph._clip_tl.xcoord) ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 146 AND (y <= CoreGraph._clip_br.ycoord) AND (y >= CoreGraph._clip_tl.ycoord)) THEN ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 147 CoreGraph._plot(x, y, CoreGraph._fgcolor); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 148 END; 149 RETURN; 150 END EllipsePlot; ***** ^ not supported yet 151 152 PROCEDURE GetFillStart(VAR x, y: INTEGER; ox, oy, startx, starty, 153 endx, endy: INTEGER): BOOLEAN; 154 155 VAR 156 fx, fy: INTEGER; 157 BEGIN 158 IF CoreGraph._fstart.flag = 0 THEN ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 159 RETURN FALSE; 160 END; 161 IF((startx = endx) AND (starty = endy)) THEN 162 RETURN FALSE; 163 END; 164 IF CoreGraph._fstart.quad_type = _Q_CLEAR THEN ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 165 CASE CoreGraph._fstart.best_quad OF ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 166 | 0: 167 fx:=ox+1; 168 fy:=oy+1; 169 | 1: 170 fx:=ox+1; 171 fy:=oy-1; 172 | 2: 173 fx:=ox-1; 174 fy:=oy-1; 175 | 3: 176 fx:=ox-1; 177 fy:=oy+1; 178 END; 179 ELSIF (CoreGraph._fstart.quad_type = _Q_STEST) THEN ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 180 CASE CoreGraph._fstart.best_quad OF ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 181 | 0: 182 fx:=ox+(((startx-ox+1)>>1)+1); 183 fy:=oy+(((starty-oy)>>1)-1); 184 | 1: 185 fx:=ox+(((startx-ox)>>1)-1); 186 fy:=starty+(((oy-starty)>>1)-1); 187 | 2: 188 fx:=startx+(((ox-startx)>>1)-1); 189 fy:=starty+(((oy-starty+1)>>1)+1); 190 | 3: 191 fx:=startx+(((ox-startx+1)>>1)+1); 192 fy:=oy+(((starty-oy+1)>>1)+1); 193 END; 194 ELSE (* _Q_1SEG *) 195 CASE CoreGraph._fstart.best_quad OF ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 196 | 0: 197 fx:=startx+((endx-startx)>>1)-1; 198 fy:=endy+((starty-endy)>>1)-1; 199 | 1: 200 fx:=endx+((startx-endx)>>1)-1; 201 fy:=endy+((starty-endy)>>1)+1; 202 | 2: 203 fx:=endx+((startx-endx)>>1)+1; 204 fy:=starty+((endy-starty)>>1)+1; 205 | 3: 206 fx:=startx+((endx-startx)>>1)+1; 207 fy:=starty+((endy-starty)>>1)-1; 208 END; 209 END; 210 x:=fx; 211 y:=fy; 212 RETURN TRUE; 213 END GetFillStart; ***** ^ not supported yet 214 215 PROCEDURE SetFillStart(quadrant: ArcQuadrant); 216 217 VAR 218 q: INTEGER; 219 220 BEGIN 221 q:=0; 222 CoreGraph._fstart.flag:=1; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 223 WHILE q < 4 DO 224 CASE quadrant[q] OF ***** ^ not supported yet ***** ^ not supported yet 225 | _Q_CLEAR: ***** ^ not supported yet 226 CoreGraph._fstart.best_quad:=q; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 227 CoreGraph._fstart.quad_type:=_Q_CLEAR; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 228 RETURN; 229 | _Q_1SEG: ***** ^ not supported yet 230 CoreGraph._fstart.best_quad:=q; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 231 CoreGraph._fstart.quad_type:=_Q_1SEG; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 232 RETURN; 233 | _Q_STEST: ***** ^ not supported yet 234 CoreGraph._fstart.best_quad:=q; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 235 CoreGraph._fstart.quad_type:=_Q_STEST; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 236 237 END; 238 INC(q); ***** ^ undeclared identifier ***** ^ not supported yet 239 END; 240 RETURN; 241 END SetFillStart; ***** ^ not supported yet 242 243 244 PROCEDURE ArcPlot(quadrant: INTEGER; flag: SHORTCARD; noclip: BOOLEAN; xp, yp, startx, endx, starty, endy: INTEGER); 245 246 VAR 247 ok_to_plot: BOOLEAN; 248 BEGIN 249 IF flag = SHORTCARD(_Q_NULL) THEN ***** ^ not supported yet 250 RETURN ; 251 END; 252 ok_to_plot:=FALSE; 253 IF((noclip) OR (((xp <= CoreGraph._clip_br.xcoord) AND (xp >= CoreGraph._clip_tl.xcoord)) ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 254 AND((yp <= CoreGraph._clip_br.ycoord) AND (yp >= CoreGraph._clip_tl.ycoord)))) THEN ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 255 IF flag = SHORTCARD(_Q_CLEAR) THEN ***** ^ not supported yet 256 ok_to_plot:=TRUE; 257 ELSE 258 CASE quadrant OF 259 | 0: 260 CASE flag OF 261 | _Q_1SEG: ***** ^ not supported yet 262 IF((xp >= startx) AND (xp <= endx) 263 AND (yp <= starty) AND (yp >= endy)) THEN 264 ok_to_plot:=TRUE; 265 END; 266 | _Q_2SEG: ***** ^ not supported yet 267 IF(((xp >= startx) AND (yp <= starty)) 268 OR ((xp <= endx) AND (yp >= endy))) THEN 269 ok_to_plot:=TRUE; 270 END; 271 | _Q_ETEST: ***** ^ not supported yet 272 IF((xp <= endx) AND (yp >= endy)) THEN 273 ok_to_plot:=TRUE; 274 END; 275 ELSE 276 IF((xp >= startx) AND (yp <= starty)) THEN 277 ok_to_plot:=TRUE; 278 END; 279 END; 280 | 3: 281 CASE flag OF 282 | _Q_1SEG: ***** ^ not supported yet 283 IF((xp >= startx) AND (xp <= endx) 284 AND (yp >= starty) AND (yp <= endy)) THEN 285 ok_to_plot:=TRUE; 286 END; 287 | _Q_2SEG: ***** ^ not supported yet 288 IF(((xp >= startx) AND (yp >= starty)) 289 OR ((xp <= endx) AND (yp <= endy))) THEN 290 ok_to_plot:=TRUE; 291 END; 292 | _Q_ETEST: ***** ^ not supported yet 293 IF((xp <= endx) AND (yp <= endy)) THEN 294 ok_to_plot:=TRUE; 295 END; 296 ELSE 297 IF((xp >= startx) AND (yp >= starty)) THEN 298 ok_to_plot:=TRUE; 299 END; 300 END; 301 | 2: 302 CASE flag OF 303 | _Q_1SEG: ***** ^ not supported yet 304 IF((xp <= startx) AND (xp >= endx) 305 AND (yp >= starty) AND (yp <= endy)) THEN 306 ok_to_plot:=TRUE; 307 END; 308 | _Q_2SEG: ***** ^ not supported yet 309 IF(((xp <= startx) AND (yp >= starty)) 310 OR ((xp >= endx) AND (yp <= endy))) THEN 311 ok_to_plot:=TRUE; 312 END; 313 | _Q_ETEST: ***** ^ not supported yet 314 IF((xp >= endx) AND (yp <= endy)) THEN 315 ok_to_plot:=TRUE; 316 END; 317 ELSE 318 IF((xp <= startx) AND (yp >= starty)) THEN 319 ok_to_plot:=TRUE; 320 END; 321 END; 322 ELSE (* quadrant := 1 *) 323 CASE flag OF 324 | _Q_1SEG: ***** ^ not supported yet 325 IF((xp <= startx) AND (xp >= endx) 326 AND (yp <= starty) AND (yp >= endy)) THEN 327 ok_to_plot:=TRUE; 328 END; 329 | _Q_2SEG: ***** ^ not supported yet 330 IF(((xp <= startx) AND (yp <= starty)) 331 OR ((xp >= endx) AND (yp >= endy))) THEN 332 ok_to_plot:=TRUE; 333 END; 334 | _Q_ETEST: ***** ^ not supported yet 335 IF((xp >= endx) AND (yp >= endy)) THEN 336 ok_to_plot:=TRUE; 337 END; 338 ELSE 339 IF((xp <= startx) AND (yp <= starty)) THEN 340 ok_to_plot:=TRUE; 341 END; 342 END; 343 END; 344 END; 345 IF ok_to_plot THEN 346 CoreGraph._plot(xp, yp, CoreGraph._fgcolor); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 347 END; 348 END; 349 RETURN ; 350 END ArcPlot; ***** ^ not supported yet 351 352 PROCEDURE GetInRange(VAR a0, b0: INTEGER); 353 354 BEGIN 355 IF a0 > b0 THEN 356 IF a0 > 1023 THEN 357 b0 := INTEGER((LONGINT(b0)*1023) DIV LONGINT(a0)); ***** ^ not supported yet ***** ^ not supported yet 358 a0 := 1023; 359 END; 360 ELSE 361 IF b0 > 1023 THEN 362 a0 := INTEGER((LONGINT(a0)*1023) DIV LONGINT(b0)); ***** ^ not supported yet ***** ^ not supported yet 363 b0 := 1023; 364 END; 365 END; 366 END GetInRange; ***** ^ not supported yet 367 368 PROCEDURE DrawEllipse(x0, y0, a0, b0: INTEGER; Fill: BOOLEAN); 369 370 VAR 371 x, y, line, oldline: INTEGER; 372 a, b: LONGINT; 373 asq, asq2, bsq, bsq2: LONGINT; 374 d, dx, dy: LONGINT; 375 plotx, plotx2, ploty: INTEGER; 376 no_clip: BOOLEAN; 377 mask: CARDINAL; 378 379 BEGIN 380 GetInRange(a0, b0); ***** ^ not supported yet ***** ^ not supported yet 381 no_clip:=FALSE; 382 x := 0 ; 383 y := b0 ; 384 a := LONGINT(a0); ***** ^ not supported yet 385 b := LONGINT(b0); ***** ^ not supported yet 386 asq := a*a ; 387 asq2 := asq*2 ; 388 bsq := b*b ; 389 bsq2 := bsq*2 ; 390 d := bsq-(asq*b)+(asq>>2) ; 391 dx := 0 ; 392 dy := asq2*b ; 393 oldline := -(y0+y+1); 394 IF ((x0+a0 <= CoreGraph._clip_br.xcoord) AND (x0-a0 >= CoreGraph._clip_tl.xcoord)) ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 395 AND ((y0+b0 <= CoreGraph._clip_br.ycoord) AND (y0-b0 >= CoreGraph._clip_tl.ycoord)) THEN ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 396 no_clip:=TRUE; 397 END; 398 WHILE dx < dy DO 399 plotx:=x0+x; 400 ploty:=y0+y; 401 IF no_clip THEN 402 CoreGraph._plot(plotx, ploty, CoreGraph._fgcolor); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 403 ELSE 404 EllipsePlot(plotx, ploty); ***** ^ not supported yet ***** ^ not supported yet 405 END; 406 plotx:=x0-x; 407 ploty:=y0+y; 408 IF no_clip THEN 409 CoreGraph._plot(plotx, ploty, CoreGraph._fgcolor); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 410 ELSE 411 EllipsePlot(plotx, ploty); ***** ^ not supported yet ***** ^ not supported yet 412 END; 413 plotx:=x0+x; 414 ploty:=y0-y; 415 IF no_clip THEN 416 CoreGraph._plot(plotx, ploty, CoreGraph._fgcolor); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 417 ELSE 418 EllipsePlot(plotx, ploty); ***** ^ not supported yet ***** ^ not supported yet 419 END; 420 plotx:=x0-x; 421 ploty:=y0-y; 422 IF no_clip THEN 423 CoreGraph._plot(plotx, ploty, CoreGraph._fgcolor); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 424 ELSE 425 EllipsePlot(plotx, ploty); ***** ^ not supported yet ***** ^ not supported yet 426 END; 427 IF Fill = _GFILLINTERIOR THEN ***** ^ undeclared identifier 428 plotx:=x0-x+1; 429 plotx2:=x0+x-1; 430 IF plotx2 > plotx THEN 431 line:=y0+y; 432 IF line # oldline THEN 433 oldline := line; 434 mask:=CARDINAL(CoreGraph._fill_mask[CARDINAL(BITSET(line) * BITSET(7))]) ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 435 +CARDINAL(CoreGraph._fill_mask[CARDINAL(BITSET(line) * BITSET(7))])*100H; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 436 IF mask = MAX(CARDINAL) THEN ***** ^ undeclared identifier ***** ^ not supported yet 437 CoreGraph._hline(plotx, line, plotx2, CoreGraph._fgcolor); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 438 ELSE 439 CoreGraph._line(plotx, line, plotx2, line, mask); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 440 END; 441 line:=y0-y; 442 mask:=CARDINAL(CoreGraph._fill_mask[CARDINAL(BITSET(line) * BITSET(7))]) ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 443 +CARDINAL(CoreGraph._fill_mask[CARDINAL(BITSET(line) * BITSET(7))])*100H; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 444 IF mask = MAX(CARDINAL) THEN ***** ^ undeclared identifier ***** ^ not supported yet 445 CoreGraph._hline(plotx, line, plotx2, CoreGraph._fgcolor); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 446 ELSE 447 CoreGraph._line(plotx, line, plotx2, line, mask); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 448 END; 449 END; 450 END; 451 END; 452 IF d > 0 THEN 453 DEC(y); ***** ^ undeclared identifier ***** ^ not supported yet 454 DEC(dy, asq2); ***** ^ undeclared identifier ***** ^ not supported yet 455 DEC(d, dy); ***** ^ undeclared identifier ***** ^ not supported yet 456 END; 457 INC(x); ***** ^ undeclared identifier ***** ^ not supported yet 458 INC(dx, bsq2); ***** ^ undeclared identifier ***** ^ not supported yet 459 INC(d, bsq+dx); ***** ^ undeclared identifier ***** ^ not supported yet 460 END; 461 INC(d, (3*((asq-bsq)>>1)-((dx+dy)>>1))); ***** ^ undeclared identifier ***** ^ not supported yet 462 WHILE y >= 0 DO 463 plotx:=x0+x; 464 ploty:=y0+y; 465 IF no_clip THEN 466 CoreGraph._plot(plotx, ploty, CoreGraph._fgcolor); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 467 ELSE 468 EllipsePlot(plotx, ploty); ***** ^ not supported yet ***** ^ not supported yet 469 END; 470 plotx:=x0-x; 471 ploty:=y0+y; 472 IF no_clip THEN 473 CoreGraph._plot(plotx, ploty, CoreGraph._fgcolor); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 474 ELSE 475 EllipsePlot(plotx, ploty); ***** ^ not supported yet ***** ^ not supported yet 476 END; 477 plotx:=x0+x; 478 ploty:=y0-y; 479 IF no_clip THEN 480 CoreGraph._plot(plotx, ploty, CoreGraph._fgcolor); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 481 ELSE 482 EllipsePlot(plotx, ploty); ***** ^ not supported yet ***** ^ not supported yet 483 END; 484 plotx:=x0-x; 485 ploty:=y0-y; 486 IF no_clip THEN 487 CoreGraph._plot(plotx, ploty, CoreGraph._fgcolor); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 488 ELSE 489 EllipsePlot(plotx, ploty); ***** ^ not supported yet ***** ^ not supported yet 490 END; 491 IF Fill = _GFILLINTERIOR THEN ***** ^ undeclared identifier 492 plotx:=x0-x+1; 493 plotx2:=x0+x-1; 494 IF plotx2 > plotx THEN 495 line:=y0+y; 496 IF line # oldline THEN 497 oldline := line; 498 mask:=CARDINAL(CoreGraph._fill_mask[CARDINAL(BITSET(line) * BITSET(7))]) ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 499 +CARDINAL(CoreGraph._fill_mask[CARDINAL(BITSET(line) * BITSET(7))])*100H; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 500 IF mask = MAX(CARDINAL) THEN ***** ^ undeclared identifier ***** ^ not supported yet 501 CoreGraph._hline(plotx, line, plotx2, CoreGraph._fgcolor); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 502 ELSE 503 CoreGraph._line(plotx, line, plotx2, line, mask); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 504 END; 505 line:=y0-y; 506 mask:=CARDINAL(CoreGraph._fill_mask[CARDINAL(BITSET(line) * BITSET(7))]) ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 507 +CARDINAL(CoreGraph._fill_mask[CARDINAL(BITSET(line) * BITSET(7))])*100H; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 508 IF mask = MAX(CARDINAL) THEN ***** ^ undeclared identifier ***** ^ not supported yet 509 CoreGraph._hline(plotx, line, plotx2, CoreGraph._fgcolor); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 510 ELSE 511 CoreGraph._line(plotx, line, plotx2, line, mask); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 512 END; 513 END; 514 END; 515 END; 516 IF d < 0 THEN 517 INC(x); ***** ^ undeclared identifier ***** ^ not supported yet 518 INC(dx, bsq2); ***** ^ undeclared identifier ***** ^ not supported yet 519 INC(d, dx); ***** ^ undeclared identifier ***** ^ not supported yet 520 END; 521 DEC(y); ***** ^ undeclared identifier ***** ^ not supported yet 522 DEC(dy, asq2); ***** ^ undeclared identifier ***** ^ not supported yet 523 INC(d, asq-dy); ***** ^ undeclared identifier ***** ^ not supported yet 524 END; 525 RETURN; 526 END DrawEllipse; ***** ^ not supported yet 527 528 PROCEDURE GetArc(VAR quadrant: ArcQuadrant; x, y, sx, sy, ex, ey: INTEGER): BOOLEAN; 529 530 BEGIN 531 IF ((sx = ex) AND (sy = ey)) THEN 532 RETURN TRUE; 533 END; 534 DEC(sx, x); ***** ^ undeclared identifier ***** ^ not supported yet 535 DEC(ex, x); ***** ^ undeclared identifier ***** ^ not supported yet 536 DEC(sy, y); ***** ^ undeclared identifier ***** ^ not supported yet 537 DEC(ey, y); ***** ^ undeclared identifier ***** ^ not supported yet 538 IF((sx > 0) AND (sy > 0)) THEN (* start in quad 0 *) 539 quadrant[0]:=SHORTCARD(_Q_STEST); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 540 IF((ey <= 0) AND (ex > 0)) THEN 541 quadrant[1]:=SHORTCARD(_Q_ETEST); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 542 quadrant[2]:=SHORTCARD(_Q_NULL); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 543 quadrant[3]:=SHORTCARD(_Q_NULL); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 544 ELSIF((ey <= 0) AND (ex <= 0)) THEN 545 quadrant[1]:=SHORTCARD(_Q_CLEAR); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 546 quadrant[2]:=SHORTCARD(_Q_ETEST); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 547 quadrant[3]:=SHORTCARD(_Q_NULL); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 548 ELSIF((ey > 0) AND (ex <= 0)) THEN 549 quadrant[1]:=SHORTCARD(_Q_CLEAR); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 550 quadrant[2]:=SHORTCARD(_Q_CLEAR); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 551 quadrant[3]:=SHORTCARD(_Q_ETEST); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 552 ELSIF((ey > 0) AND (ex > 0)) THEN 553 IF(sx < ex) THEN 554 quadrant[0]:=SHORTCARD(_Q_1SEG); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 555 quadrant[1]:=SHORTCARD(_Q_NULL); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 556 quadrant[2]:=SHORTCARD(_Q_NULL); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 557 quadrant[3]:=SHORTCARD(_Q_NULL); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 558 ELSE 559 quadrant[0]:=SHORTCARD(_Q_2SEG); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 560 quadrant[1]:=SHORTCARD(_Q_CLEAR); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 561 quadrant[2]:=SHORTCARD(_Q_CLEAR); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 562 quadrant[3]:=SHORTCARD(_Q_CLEAR); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 563 END; 564 ELSE 565 RETURN FALSE; 566 END; 567 ELSIF((sx > 0) AND (sy <= 0)) THEN (* start in quad 1 *) 568 quadrant[1]:=_Q_STEST; ***** ^ not supported yet ***** ^ not supported yet 569 IF((ey <= 0) AND (ex <= 0)) THEN 570 quadrant[2]:=SHORTCARD(_Q_ETEST); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 571 quadrant[3]:=SHORTCARD(_Q_NULL); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 572 quadrant[0]:=SHORTCARD(_Q_NULL); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 573 ELSIF((ey > 0) AND (ex <= 0)) THEN 574 quadrant[2]:=SHORTCARD(_Q_CLEAR); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 575 quadrant[3]:=SHORTCARD(_Q_ETEST); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 576 quadrant[0]:=SHORTCARD(_Q_NULL); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 577 ELSIF((ey > 0) AND (ex > 0)) THEN 578 quadrant[2]:=SHORTCARD(_Q_CLEAR); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 579 quadrant[3]:=SHORTCARD(_Q_CLEAR); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 580 quadrant[0]:=SHORTCARD(_Q_ETEST); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 581 ELSIF((ey <= 0) AND (ex > 0)) THEN 582 IF(sx >= ex) THEN 583 quadrant[1]:=SHORTCARD(_Q_1SEG); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 584 quadrant[2]:=SHORTCARD(_Q_NULL); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 585 quadrant[3]:=SHORTCARD(_Q_NULL); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 586 quadrant[0]:=SHORTCARD(_Q_NULL); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 587 ELSE 588 quadrant[1]:=SHORTCARD(_Q_2SEG); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 589 quadrant[2]:=SHORTCARD(_Q_CLEAR); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 590 quadrant[3]:=SHORTCARD(_Q_CLEAR); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 591 quadrant[0]:=SHORTCARD(_Q_CLEAR); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 592 END; 593 ELSE 594 RETURN FALSE; 595 END; 596 ELSIF((sx <= 0) AND (sy <= 0)) THEN (* start in quad 2 *) 597 quadrant[2]:=SHORTCARD(_Q_STEST); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 598 IF((ey > 0) AND (ex <= 0)) THEN 599 quadrant[3]:=SHORTCARD(_Q_ETEST); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 600 quadrant[0]:=SHORTCARD(_Q_NULL); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 601 quadrant[1]:=SHORTCARD(_Q_NULL); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 602 ELSIF((ey > 0) AND (ex > 0)) THEN 603 quadrant[3]:=SHORTCARD(_Q_CLEAR); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 604 quadrant[0]:=SHORTCARD(_Q_ETEST); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 605 quadrant[1]:=SHORTCARD(_Q_NULL); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 606 ELSIF((ey <= 0) AND (ex > 0)) THEN 607 quadrant[3]:=SHORTCARD(_Q_CLEAR); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 608 quadrant[0]:=SHORTCARD(_Q_CLEAR); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 609 quadrant[1]:=SHORTCARD(_Q_ETEST); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 610 ELSIF((ey <= 0) AND (ex <= 0)) THEN 611 IF(sx >= ex) THEN 612 quadrant[2]:=SHORTCARD(_Q_1SEG); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 613 quadrant[3]:=SHORTCARD(_Q_NULL); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 614 quadrant[0]:=SHORTCARD(_Q_NULL); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 615 quadrant[1]:=SHORTCARD(_Q_NULL); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 616 ELSE 617 quadrant[2]:=SHORTCARD(_Q_2SEG); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 618 quadrant[3]:=SHORTCARD(_Q_CLEAR); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 619 quadrant[0]:=SHORTCARD(_Q_CLEAR); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 620 quadrant[1]:=SHORTCARD(_Q_CLEAR); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 621 END; 622 ELSE 623 RETURN FALSE; 624 END; 625 ELSIF((sx <= 0) AND (sy > 0)) THEN (* start in quad 3 *) 626 quadrant[3]:=SHORTCARD(_Q_STEST); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 627 IF((ey > 0) AND (ex > 0)) THEN 628 quadrant[0]:=SHORTCARD(_Q_ETEST); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 629 quadrant[1]:=SHORTCARD(_Q_NULL); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 630 quadrant[2]:=SHORTCARD(_Q_NULL); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 631 ELSIF((ey <= 0) AND (ex > 0)) THEN 632 quadrant[0]:=SHORTCARD(_Q_CLEAR); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 633 quadrant[1]:=SHORTCARD(_Q_ETEST); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 634 quadrant[2]:=SHORTCARD(_Q_NULL); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 635 ELSIF((ey <= 0) AND (ex <= 0)) THEN 636 quadrant[0]:=SHORTCARD(_Q_CLEAR); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 637 quadrant[1]:=SHORTCARD(_Q_CLEAR); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 638 quadrant[2]:=SHORTCARD(_Q_ETEST); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 639 ELSIF((ey > 0) AND (ex <= 0)) THEN 640 IF(sx < ex) THEN 641 quadrant[3]:=SHORTCARD(_Q_1SEG); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 642 quadrant[0]:=SHORTCARD(_Q_NULL); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 643 quadrant[1]:=SHORTCARD(_Q_NULL); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 644 quadrant[2]:=SHORTCARD(_Q_NULL); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 645 ELSE 646 quadrant[3]:=SHORTCARD(_Q_2SEG); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 647 quadrant[0]:=SHORTCARD(_Q_CLEAR); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 648 quadrant[1]:=SHORTCARD(_Q_CLEAR); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 649 quadrant[2]:=SHORTCARD(_Q_CLEAR); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 650 END; 651 ELSE 652 RETURN FALSE; 653 END; 654 ELSE 655 RETURN FALSE; 656 END; 657 RETURN TRUE; 658 END GetArc; ***** ^ not supported yet 659 660 661 PROCEDURE DrawArc(x0, y0, a0, b0, startx, starty, endx, endy: INTEGER): BOOLEAN; 662 663 VAR 664 x, y: INTEGER; 665 xp, yp: INTEGER; 666 a, b: LONGINT; 667 asq, asq2, bsq, bsq2: LONGINT; 668 d, dx, dy: LONGINT; 669 quadrant: ArcQuadrant; ***** ^ not supported yet 670 no_clip: BOOLEAN; 671 BEGIN 672 GetInRange(a0, b0); ***** ^ not supported yet ***** ^ not supported yet 673 no_clip:=FALSE; 674 quadrant:=ArcQuadrant(_Q_CLEAR,_Q_CLEAR,_Q_CLEAR,_Q_CLEAR); ***** ^ not supported yet ***** ^ not supported yet 675 CoreGraph._fstart.flag:=0; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 676 x := 0 ; 677 y := b0 ; 678 a := LONGINT(a0); ***** ^ not supported yet 679 b := LONGINT(b0); ***** ^ not supported yet 680 asq := a*a ; 681 asq2 := asq*2 ; 682 bsq := b*b ; 683 bsq2 := bsq*2 ; 684 d := bsq-(asq*b)+(asq>>2) ; 685 dx := 0 ; 686 dy := asq2*b ; 687 IF ~GetArc(quadrant, x0, y0, startx, starty, endx, endy) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 688 RETURN FALSE; 689 END; 690 SetFillStart(quadrant); ***** ^ not supported yet ***** ^ not supported yet 691 IF(((x0+a0 <= CoreGraph._clip_br.xcoord) AND (x0-a0 >= CoreGraph._clip_tl.xcoord)) ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 692 AND((y0+b0 <= CoreGraph._clip_br.ycoord) AND (y0-b0 >= CoreGraph._clip_tl.ycoord))) THEN ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 693 no_clip:=TRUE; 694 END; 695 WHILE dx < dy DO 696 xp:=x0+x; 697 yp:=y0+y; 698 ArcPlot(0, quadrant[0], no_clip, xp, yp, startx, endx, starty, endy); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 699 xp:=x0-x; 700 yp:=y0+y; 701 ArcPlot(3, quadrant[3], no_clip, xp, yp, startx, endx, starty, endy); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 702 xp:=x0+x; 703 yp:=y0-y; 704 ArcPlot(1, quadrant[1], no_clip, xp, yp, startx, endx, starty, endy); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 705 xp:=x0-x; 706 yp:=y0-y; 707 ArcPlot(2, quadrant[2], no_clip, xp, yp, startx, endx, starty, endy); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 708 IF d > 0 THEN 709 DEC(y); ***** ^ undeclared identifier ***** ^ not supported yet 710 DEC(dy, asq2); ***** ^ undeclared identifier ***** ^ not supported yet 711 DEC(d, dy); ***** ^ undeclared identifier ***** ^ not supported yet 712 END; 713 INC(x); ***** ^ undeclared identifier ***** ^ not supported yet 714 INC(dx, bsq2); ***** ^ undeclared identifier ***** ^ not supported yet 715 INC(d, bsq+dx); ***** ^ undeclared identifier ***** ^ not supported yet 716 END; 717 INC(d, (3*((asq-bsq)>>1)-((dx+dy)>>1))); ***** ^ undeclared identifier ***** ^ not supported yet 718 WHILE y >= 0 DO 719 xp:=x0+x; 720 yp:=y0+y; 721 ArcPlot(0, quadrant[0], no_clip, xp, yp, startx, endx, starty, endy); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 722 xp:=x0-x; 723 yp:=y0+y; 724 ArcPlot(3, quadrant[3], no_clip, xp, yp, startx, endx, starty, endy); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 725 xp:=x0+x; 726 yp:=y0-y; 727 ArcPlot(1, quadrant[1], no_clip, xp, yp, startx, endx, starty, endy); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 728 xp:=x0-x; 729 yp:=y0-y; 730 ArcPlot(2, quadrant[2], no_clip, xp, yp, startx, endx, starty, endy); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 731 IF d<0 THEN 732 INC(x); ***** ^ undeclared identifier ***** ^ not supported yet 733 INC(dx, bsq2); ***** ^ undeclared identifier ***** ^ not supported yet 734 INC(d, dx); ***** ^ undeclared identifier ***** ^ not supported yet 735 END; 736 DEC(y); ***** ^ undeclared identifier ***** ^ not supported yet 737 DEC(dy, asq2); ***** ^ undeclared identifier ***** ^ not supported yet 738 INC(d, asq-dy); ***** ^ undeclared identifier ***** ^ not supported yet 739 END; 740 RETURN TRUE; 741 END DrawArc; ***** ^ not supported yet 742 743 744 PROCEDURE GetVec(x0, y0, a0, b0, vx, vy: INTEGER): InterSect; 745 746 VAR 747 x, y: INTEGER; 748 a, b: LONGINT; 749 asq, asq2, bsq, bsq2: LONGINT; 750 d, dx, dy: LONGINT; 751 px, py, qx, qy: INTEGER; 752 Ret: InterSect; ***** ^ not supported yet 753 flag: INTEGER; 754 last_difference: LONGCARD; ***** ^ undeclared identifier 755 res: LONGINT; 756 757 BEGIN 758 Ret:=InterSect(0,0); ***** ^ not supported yet ***** ^ not supported yet 759 x := 0 ; 760 y := b0 ; 761 a := LONGINT(a0); ***** ^ not supported yet 762 b := LONGINT(b0); ***** ^ not supported yet 763 qx:=vx-x0; 764 qy:=vy-y0; 765 asq := a*a ; 766 asq2 := asq*2 ; 767 bsq := b*b ; 768 bsq2 := bsq*2 ; 769 d := bsq-(asq*b)+(asq>>2) ; 770 dx := 0 ; 771 dy := asq2*b ; 772 last_difference:=MAX(LONGCARD); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 773 WHILE dx < dy DO 774 IF((qx >= 0) AND (qy >= 0)) THEN 775 px:=x0+x; 776 py:=y0+y; 777 flag:=0; 778 ELSIF((qx < 0) AND (qy >= 0)) THEN 779 px:=x0-x; 780 py:=y0+y; 781 flag:=1; 782 ELSIF((qx >= 0) AND (qy < 0)) THEN 783 px:=x0+x; 784 py:=y0-y; 785 flag:=2; 786 ELSIF((qx < 0) AND (qy < 0)) THEN 787 px:=x0-x; 788 py:=y0-y; 789 flag:=3; 790 END; 791 res:=(LONGINT(px-x0)*LONGINT(qy)) - (LONGINT(py-y0)*LONGINT(qx)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 792 IF res < 0 THEN 793 res:=-res; 794 END; 795 IF LONGCARD(res) > last_difference THEN ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 796 RETURN Ret; ***** ^ not supported yet 797 END; 798 last_difference:=res; ***** ^ not supported yet 799 Ret.x:=px; ***** ^ not supported yet ***** ^ not supported yet 800 Ret.y:=py; ***** ^ not supported yet ***** ^ not supported yet 801 IF d > 0 THEN 802 DEC(y); ***** ^ undeclared identifier ***** ^ not supported yet 803 DEC(dy, asq2); ***** ^ undeclared identifier ***** ^ not supported yet 804 DEC(d, dy); ***** ^ undeclared identifier ***** ^ not supported yet 805 END; 806 INC(x); ***** ^ undeclared identifier ***** ^ not supported yet 807 INC(dx, bsq2); ***** ^ undeclared identifier ***** ^ not supported yet 808 INC(d, bsq+dx); ***** ^ undeclared identifier ***** ^ not supported yet 809 END; 810 INC(d, (3*((asq-bsq)>>1)-((dx+dy)>>1))); ***** ^ undeclared identifier ***** ^ not supported yet 811 last_difference:=MAX(LONGCARD); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 812 WHILE y >0 DO 813 IF flag = 0 THEN 814 px:=x0+x; 815 py:=y0+y; 816 ELSIF flag = 1 THEN 817 px:=x0-x; 818 py:=y0+y; 819 ELSIF flag = 2 THEN 820 px:=x0+x; 821 py:=y0-y; 822 ELSIF flag = 3 THEN 823 px:=x0-x; 824 py:=y0-y; 825 END; 826 res:=LONGINT(px-x0)*LONGINT(qy) - LONGINT(py-y0)*LONGINT(qx); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 827 IF res < 0 THEN 828 res:=-res; 829 END; 830 IF LONGCARD(res) > last_difference THEN ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 831 RETURN Ret; ***** ^ not supported yet 832 END; 833 last_difference:=res; ***** ^ not supported yet 834 Ret.x:=px; ***** ^ not supported yet ***** ^ not supported yet 835 Ret.y:=py; ***** ^ not supported yet ***** ^ not supported yet 836 IF d < 0 THEN 837 INC(x); ***** ^ undeclared identifier ***** ^ not supported yet 838 INC(dx, bsq2); ***** ^ undeclared identifier ***** ^ not supported yet 839 INC(d, dx); ***** ^ undeclared identifier ***** ^ not supported yet 840 END; 841 DEC(y); ***** ^ undeclared identifier ***** ^ not supported yet 842 DEC(dy, asq2); ***** ^ undeclared identifier ***** ^ not supported yet 843 INC(d, asq-dy); ***** ^ undeclared identifier ***** ^ not supported yet 844 END; 845 RETURN Ret; ***** ^ not supported yet 846 END GetVec; ***** ^ not supported yet 847 848 849 PROCEDURE HscanLine(VAR xlp, xrp: INTEGER; y, border: INTEGER); 850 851 VAR 852 mask: CARDINAL; 853 BEGIN 854 CoreGraph._hscan(xlp, xrp, y, border); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 855 mask:=CARDINAL(CoreGraph._fill_mask[CARDINAL(BITSET(y)*BITSET(7))]) ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 856 +CARDINAL(CoreGraph._fill_mask[CARDINAL(BITSET(y)*BITSET(7))])*100H; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 857 IF mask = MAX(CARDINAL) THEN ***** ^ undeclared identifier ***** ^ not supported yet 858 CoreGraph._hline(xlp, y, xrp, CoreGraph._fgcolor); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 859 ELSE 860 CoreGraph._line(xlp, y, xrp, y, mask); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 861 END; 862 END HscanLine; ***** ^ not supported yet 863 864 865 PROCEDURE LagFill(xl, xr, y, direction, llim, rlim, border: INTEGER); 866 867 LABEL 868 ReStart; ***** ^ not supported yet 869 VAR 870 x, xsl, v: INTEGER; 871 mask: CARDINAL; 872 BEGIN 873 ReStart: ***** ^ undeclared identifier 874 DEC(y, direction); 875 IF (CoreGraph._clip_tl.ycoord <= y) AND (y <= CoreGraph._clip_br.ycoord) THEN 876 mask:=CARDINAL(CoreGraph._fill_mask[CARDINAL(BITSET(y)*BITSET(7))]); 877 x:=xl; 878 WHILE x <= llim-1 DO 879 IF (BITSET(1<<(CARDINAL(BITSET(x)*BITSET(7)))) * BITSET(mask) # {}) THEN 880 v:=CoreGraph._point(x, y); 881 IF((v # border) AND (v # CoreGraph._fgcolor)) THEN 882 xsl := x; 883 HscanLine (xsl, x, y, border); 884 LagFill(xsl, x, y, -direction, xl, xr, border); 885 END; 886 END; 887 INC(x); 888 END; 889 x:=rlim+1; 890 WHILE x <= xr DO 891 IF (BITSET(1<<(CARDINAL(BITSET(x)*BITSET(7)))) * BITSET(mask) # {}) THEN 892 v:=CoreGraph._point(x, y); 893 IF((v # border) AND (v # CoreGraph._fgcolor)) THEN 894 xsl := x; 895 HscanLine(xsl, x, y, border); 896 LagFill(xsl, x, y, -direction, xl, xr, border); 897 END; 898 END; 899 INC(x); 900 END; 901 END; 902 INC(y, direction + direction); 903 IF ( y >= CoreGraph._clip_tl.ycoord) AND (y <= CoreGraph._clip_br.ycoord ) THEN 904 mask:=CARDINAL(CoreGraph._fill_mask[CARDINAL(BITSET(y)*BITSET(7))]); 905 x:=xl; 906 WHILE x <= xr DO 907 IF (BITSET(1<<(CARDINAL(BITSET(x)*BITSET(7)))) * BITSET(mask) # {}) THEN 908 v:=CoreGraph._point(x, y); 909 IF((v # CoreGraph._fgcolor) AND (v # border)) THEN 910 xsl := x; 911 HscanLine (xsl, x, y, border); 912 IF(x > xr-1) THEN 913 (* Do last one iteratively... *) 914 llim := xl; 915 rlim := xr; 916 xl := xsl; 917 xr := x; 918 GOTO ReStart; 919 ELSE 920 LagFill(xsl, x, y, direction, xl, xr, border); 921 END; 922 END; 923 END; 924 INC(x); 925 END; 926 END; 927 RETURN; 928 END LagFill; 929 (*# restore *) 930 (*****************************************************************************) 931 (* Function definitions - CGA specIFic *) 932 (*****************************************************************************) 933 934 (*# save *) 935 (*# call(reg_param => (ax,bx,cx,dx,st0,st6,st5,st4,st3), reg_saved=>(ds, di, si,st1,st2), c_conv=>off) *) 936 937 938 PROCEDURE _CGA320Plot(x, y, c: INTEGER); 939 940 VAR 941 ptr: CGAPointer; 942 ofs: CARDINAL; 943 BEGIN 944 ofs:=(CARDINAL(x)>>2)+((2000H-40)* CARDINAL( BITSET(y)*BITSET(1) ) )+ (40*CARDINAL(y)); 945 ptr := [SEL_B800H:ofs]; 946 x := 3 - INTEGER(BITSET(x)*BITSET(3)); 947 x := x << 1; 948 ptr^ := SHORTCARD((BITSET(ptr^) - BITSET(3<>3)+((2000H-40)* CARDINAL( BITSET(y)*BITSET(1) ) )+ (40*CARDINAL(y)); 960 ptr := [SEL_B800H:ofs]; 961 x:= INTEGER(BITSET(x) * BITSET(7)); 962 mask:=80H>>x; 963 IF(c # 0) THEN 964 c:=mask; 965 END; 966 ptr^ := SHORTCARD((BITSET(ptr^) - BITSET(mask)) + BITSET(c)); 967 RETURN; 968 END _CGA640Plot; 969 970 PROCEDURE _CGA320Point(x, y: INTEGER): INTEGER; 971 972 VAR 973 ptr: CGAPointer; 974 ofs: CARDINAL; 975 BEGIN 976 ofs:=(CARDINAL(x)>>2)+((2000H-40)* CARDINAL( BITSET(y)*BITSET(1) ) )+ (40*CARDINAL(y)); 977 ptr := [SEL_B800H:ofs]; 978 x := 3 - INTEGER(BITSET(x)*BITSET(3)); 979 x := (x<<1); 980 RETURN( CARDINAL(BITSET(ptr^) * BITSET(3<> CARDINAL(x)); 981 END _CGA320Point; 982 983 PROCEDURE _CGA640Point(x, y: INTEGER): INTEGER; 984 985 VAR 986 c: SHORTCARD; 987 ptr: CGAPointer; 988 ofs: CARDINAL; 989 BEGIN 990 ofs:=(CARDINAL(x)>>3)+((2000H-40)* CARDINAL( BITSET(y)*BITSET(1) ) )+ (40*CARDINAL(y)); 991 ptr := [SEL_B800H:ofs]; 992 x:=INTEGER(BITSET(x) * BITSET(7)); 993 c:=SHORTCARD(80H>>x); 994 IF(BITSET(ptr^)* BITSET(c) # {}) THEN 995 RETURN 1; 996 END; 997 RETURN 0; 998 END _CGA640Point; 999 1000 PROCEDURE _CGA320HScan(VAR xl, xr: INTEGER; y, border: INTEGER); 1001 1002 VAR 1003 row, left, right: INTEGER; 1004 BEGIN 1005 left:=xl; 1006 right:=xr; 1007 row:=((2000H-40)*INTEGER(BITSET(y) * BITSET(1)))+(40*y); 1008 xl:=CoreGraph._CGA320leftscan((left>>2)+row, border, CoreGraph._clip_tl.xcoord, left); 1009 xr:=CoreGraph._CGA320rightscan((right>>2)+row, border, CoreGraph._clip_br.xcoord, right); 1010 END _CGA320HScan; 1011 1012 PROCEDURE _CGA640HScan(VAR xl, xr: INTEGER; y, border: INTEGER); 1013 1014 VAR 1015 row, left, right: INTEGER; 1016 BEGIN 1017 left:=xl; 1018 right:=xr; 1019 IF border # 0 THEN 1020 border:=1; 1021 END; 1022 row:=((2000H-40)*INTEGER(BITSET(y)*BITSET(1)))+(40*y); 1023 xl:=CoreGraph._CGA640leftscan((left>>3)+row, border, CoreGraph._clip_tl.xcoord, left); 1024 xr:=CoreGraph._CGA640rightscan((right>>3)+row, border, CoreGraph._clip_br.xcoord, right); 1025 END _CGA640HScan; 1026 1027 (*****************************************************************************) 1028 (* Function definitions - VGA 256 color specIFic. *) 1029 (*****************************************************************************) 1030 1031 1032 PROCEDURE _VGAPlot(x, y, c: INTEGER); 1033 1034 VAR 1035 ptr: VGAPointer; 1036 BEGIN 1037 ptr := [SEL_A000H:y*(VGA256Width)+x]; 1038 ptr^:= SHORTCARD(c); 1039 END _VGAPlot; 1040 1041 PROCEDURE _VGAHScan(VAR xl, xr: INTEGER; y, border: INTEGER); 1042 1043 VAR 1044 left, right: INTEGER; 1045 ptr: CARDINAL; 1046 BEGIN 1047 left:=xl; 1048 right:=xr; 1049 y:=y*(VGA256Width); 1050 ptr:=y+left; 1051 xl:=CoreGraph._VGAleftscan(ptr, border, CoreGraph._clip_tl.xcoord, left); 1052 ptr:=y+right; 1053 xr:=CoreGraph._VGArightscan(ptr, border, CoreGraph._clip_br.xcoord, right); 1054 RETURN; 1055 END _VGAHScan; 1056 1057 (*****************************************************************************) 1058 (* Function definitions - VGA and EGA native mode specIFic. *) 1059 (*****************************************************************************) 1060 1061 PROCEDURE EGAHScan(VAR xl, xr: INTEGER; y, border: INTEGER); 1062 VAR 1063 left,right : INTEGER; 1064 p,pp : CARDINAL; 1065 ptr : FarADDRESS; 1066 BEGIN 1067 IF CoreGraph._EGAtranslate # 0 THEN 1068 border:=CoreGraph._EGAxlat(border); 1069 END; (*IF*) 1070 left := xl; 1071 right := xr; 1072 pp := (CARDINAL(y) * CoreGraph._width) + (CoreGraph._active_page*CoreGraph._page_size) << 4; 1073 p := CARDINAL(left>>3) + pp; 1074 ptr := [SEL_A000H:p]; 1075 xl := CoreGraph._EGAleftscan(ptr, border, CoreGraph._clip_tl.xcoord, left); 1076 p := CARDINAL(right>>3) + pp; 1077 ptr := [SEL_A000H:p]; 1078 xr := CoreGraph._EGArightscan(ptr, border, CoreGraph._clip_br.xcoord, right); 1079 END EGAHScan; 1080 1081 PROCEDURE GenericHScan(VAR xl, xr: INTEGER; y, border: INTEGER); 1082 1083 VAR 1084 v, left, right: INTEGER; 1085 BEGIN 1086 left:=xl; 1087 right:=xr; 1088 REPEAT 1089 DEC(left); 1090 v:=CoreGraph._point(left, y); 1091 UNTIL (v = border) OR (v = CoreGraph._fgcolor) OR (left < CoreGraph._clip_tl.xcoord); 1092 INC(left); 1093 REPEAT 1094 INC(right); 1095 v:=CoreGraph._point(right, y); 1096 UNTIL (v = border) OR (v = CoreGraph._fgcolor) OR (right > CoreGraph._clip_br.xcoord); 1097 DEC(right); 1098 xl:=left; 1099 xr:=right; 1100 END GenericHScan; 1101 1102 (*****************************************************************************) 1103 (* Function definitions - Hercules specIFic. *) 1104 (*****************************************************************************) 1105 1106 PROCEDURE HercPlot(x,y,c: INTEGER); 1107 1108 VAR 1109 Byte: bs; 1110 BEGIN 1111 IF (x > HercWidth) OR (y > HercDepth) THEN 1112 RETURN; 1113 END; 1114 Byte:=HercBitMap[CoreGraph._active_page][y MOD 4]^[y >> 2][x >> 3]; 1115 IF c = 0 THEN 1116 Byte:=Byte - bs{(7-(CARDINAL(x) MOD 8))}; 1117 ELSE 1118 Byte:=Byte + bs{(7-(CARDINAL(x) MOD 8))}; 1119 END; 1120 HercBitMap[CoreGraph._active_page][y MOD 4]^[y >> 2][x >> 3]:=Byte; 1121 END HercPlot; 1122 1123 PROCEDURE HercPoint(x,y: INTEGER) : INTEGER; 1124 BEGIN 1125 IF (x > HercWidth) OR (y > HercDepth) THEN RETURN MAX(CARDINAL); END; 1126 IF bs{7-(CARDINAL(x) MOD 8)} * HercBitMap[CoreGraph._active_page][y MOD 4]^[y >> 2][x >> 3] # bs(0) THEN 1127 RETURN 1; 1128 ELSE 1129 RETURN 0; 1130 END; 1131 END HercPoint; 1132 1133 (*# restore *) 1134 1135 PROCEDURE HercGraphMode; 1136 TYPE 1137 DataType = ARRAY[0..11] OF SHORTCARD ; 1138 CONST 1139 Data = DataType(35H,2DH,2EH,07H,5BH,02H,57H,57H,02H,03H,00H,00H); 1140 VAR 1141 I: CARDINAL; 1142 BEGIN 1143 SYSTEM.Out(3BFH,03H); (* Remove this if do NOT want to override 1144 the hercules text mode lock *) 1145 Lib.Delay(10); 1146 SYSTEM.Out(3B8H,02H); 1147 FOR I:= 0 TO 11 DO 1148 SYSTEM.Out(3B4H,SHORTCARD(I)); 1149 SYSTEM.Out(3B5H,Data[I]) 1150 END; 1151 Lib.FarWordFill([SEL_B000H:0],4000H,0); 1152 Lib.Delay(500); 1153 SYSTEM.Out(3B8H,0AH) 1154 END HercGraphMode; 1155 1156 PROCEDURE HercTextMode; 1157 TYPE 1158 DataType = ARRAY[0..11] OF SHORTCARD ; 1159 CONST 1160 Data = DataType(61H,50H,52H,0FH,19H,06H,19H,19H,02H,0DH,0BH,0CH); 1161 VAR 1162 I: CARDINAL; 1163 BEGIN 1164 SYSTEM.Out(3B8H,20H); 1165 FOR I:= 0 TO 11 DO 1166 SYSTEM.Out(3B4H,SHORTCARD(I)); 1167 SYSTEM.Out(3B5H,Data[I]) 1168 END; 1169 Lib.FarWordFill([SEL_B000H:0],2000,720H); 1170 Lib.Delay(500); 1171 SYSTEM.Out(3B8H,28H) 1172 END HercTextMode; 1173 1174 1175 PROCEDURE InternalInitCGA(mode: CARDINAL); 1176 1177 BEGIN 1178 IF((mode = 4) OR (mode = 5)) THEN 1179 CoreGraph._plot := _CGA320Plot; 1180 CoreGraph._point := _CGA320Point; 1181 CoreGraph._hline := CoreGraph._CGA320HLine; 1182 CoreGraph._line := CoreGraph._CGA320Line; 1183 CoreGraph._hscan := _CGA320HScan; 1184 CoreGraph._put := CoreGraph._CGA320Put; 1185 CoreGraph._get := CoreGraph._CGA320Get; 1186 CoreGraph._width := CGA320Width-1; 1187 ELSE 1188 CoreGraph._plot := _CGA640Plot ; 1189 CoreGraph._point := _CGA640Point ; 1190 CoreGraph._line := CoreGraph._CGA640Line ; 1191 CoreGraph._hline := CoreGraph._CGA640HLine ; 1192 CoreGraph._hscan := _CGA640HScan; 1193 CoreGraph._put := CoreGraph._CGA640Put; 1194 CoreGraph._get := CoreGraph._CGA640Get; 1195 CoreGraph._width := CGA640Width-1; 1196 END; 1197 CoreGraph._depth:=CGADepth-1; 1198 END InternalInitCGA; 1199 1200 PROCEDURE InternalInitEGA(mode: CARDINAL); 1201 1202 BEGIN 1203 IF mode = 13 THEN 1204 CoreGraph._width := 40; 1205 CoreGraph._depth := EGA200Depth-1; 1206 ELSIF mode = 14 THEN 1207 CoreGraph._width := 80; 1208 CoreGraph._depth := EGA200Depth-1; 1209 ELSIF mode <= 16 THEN 1210 CoreGraph._width := 80; 1211 CoreGraph._depth := EGA350Depth-1; 1212 ELSIF mode <= 18 THEN 1213 CoreGraph._width := 80; 1214 CoreGraph._depth := EGA480Depth-1; 1215 END; 1216 CoreGraph._EGAtranslate:=0; 1217 IF mode = 15 THEN 1218 CoreGraph._EGAStartPlane:=2; 1219 CoreGraph._EGAPlaneShift:=2; 1220 CoreGraph._EGAtranslate:=1; 1221 ELSIF mode = 17 THEN 1222 CoreGraph._EGAStartPlane:=0; 1223 CoreGraph._EGAPlaneShift:=1; 1224 ELSE 1225 CoreGraph._EGAStartPlane:=3; 1226 CoreGraph._EGAPlaneShift:=1; 1227 END; 1228 IF((CoreGraph._EGA64K = TRUE) AND ((mode = _ERESCOLOR) OR (mode = _ERESNOCOLOR))) THEN 1229 CoreGraph._EGAStartPlane:=2; 1230 CoreGraph._EGAPlaneShift:=2; 1231 CoreGraph._EGAtranslate:=1; 1232 CoreGraph._hscan:= GenericHScan; 1233 ELSE 1234 CoreGraph._hscan:= EGAHScan; 1235 END; 1236 CoreGraph._put := CoreGraph._EGAPut; 1237 CoreGraph._get := CoreGraph._EGAGet; 1238 IF mode = _VRES2COLOR THEN 1239 CoreGraph._line := CoreGraph._EGA2Line; 1240 CoreGraph._plot := CoreGraph._EGA2Plot; 1241 CoreGraph._point := CoreGraph._EGA2Point; 1242 CoreGraph._hline := CoreGraph._EGA2HLine; 1243 ELSE 1244 CoreGraph._line := CoreGraph._EGALine; 1245 CoreGraph._plot := CoreGraph._EGAPlot; 1246 CoreGraph._point := CoreGraph._EGAPoint; 1247 CoreGraph._hline := CoreGraph._EGAHLine; 1248 END; 1249 (* _resetEGA();*) 1250 END InternalInitEGA; 1251 1252 PROCEDURE InternalInitVGA256(); 1253 1254 BEGIN 1255 CoreGraph._width := VGA256Width; 1256 CoreGraph._depth := VGA256Depth-1; 1257 CoreGraph._plot := _VGAPlot; 1258 CoreGraph._point := CoreGraph._VGAPoint; 1259 CoreGraph._line := CoreGraph._VGALine; 1260 CoreGraph._hline := CoreGraph._VGAHLine; 1261 CoreGraph._hscan := _VGAHScan; 1262 CoreGraph._put := CoreGraph._VGAPut; 1263 CoreGraph._get := CoreGraph._VGAGet; 1264 END InternalInitVGA256; 1265 1266 PROCEDURE InternalInitHerc(); 1267 1268 BEGIN 1269 CoreGraph._depth := HercDepth-1; 1270 CoreGraph._width := HercWidth-1; 1271 CoreGraph._plot := HercPlot ; 1272 CoreGraph._point := HercPoint ; 1273 CoreGraph._line := CoreGraph._HercLine ; 1274 CoreGraph._hline := CoreGraph._HercHLine ; 1275 CoreGraph._hscan := GenericHScan ; 1276 CoreGraph._put := CoreGraph._HercPut; 1277 CoreGraph._get := CoreGraph._HercGet; 1278 HercBitMap[0][0]:= [SEL_B000H:0]; (* Initialise BitMap pointers *) 1279 HercBitMap[0][1]:= [SEL_B000H:02000H]; 1280 HercBitMap[0][2]:= [SEL_B000H:04000H]; 1281 HercBitMap[0][3]:= [SEL_B000H:06000H]; 1282 HercBitMap[1][0]:= [SEL_B800H:0]; (* 2nd Page *) 1283 HercBitMap[1][1]:= [SEL_B800H:02000H]; 1284 HercBitMap[1][2]:= [SEL_B800H:04000H]; 1285 HercBitMap[1][3]:= [SEL_B800H:06000H]; 1286 END InternalInitHerc; 1287 1288 (*****************************************************************************) 1289 (* Function definitions - Misc low level and initialisation. *) 1290 (*****************************************************************************) 1291 1292 CONST 1293 MDA = 1; 1294 CGA = 2; 1295 EGA = 3; 1296 MCGA = 4; 1297 VGA = 5; 1298 HGC = 80H; 1299 HGCPlus= 81H; 1300 InColor= 82H; 1301 1302 MDADisplay = 1; 1303 CGADisplay = 2; 1304 EGAColorDisplay = 3; 1305 PS2MonoDisplay = 4; 1306 PS2ColorDisplay = 5; 1307 1308 (*# save *) 1309 (*# call(near_call=>on) *) 1310 PROCEDURE SetLimits(VAR v: CoreGraph.VideoConfig); 1311 1312 BEGIN 1313 CASE v.mode OF 1314 | 0: 1315 v.numxpixels := 0; 1316 v.numypixels := 0; 1317 v.numtextcols := 40; 1318 v.numtextrows := 25; 1319 v.numcolors := 32; 1320 v.bitsperpixel := 0; 1321 v.numvideopages := 8; 1322 CoreGraph._txcolor := 15; 1323 CoreGraph._scr_attr := 7; 1324 | 1: 1325 v.numxpixels := 0; 1326 v.numypixels := 0; 1327 v.numtextcols := 40; 1328 v.numtextrows := 25; 1329 v.numcolors := 32; 1330 v.bitsperpixel := 0; 1331 v.numvideopages := 8; 1332 CoreGraph._txcolor := 15; 1333 CoreGraph._scr_attr := 7; 1334 | 2: 1335 v.numxpixels := 0; 1336 v.numypixels := 0; 1337 v.numtextcols := 80; 1338 v.numtextrows := 25; 1339 v.numcolors := 32; 1340 v.bitsperpixel := 0; 1341 v.numvideopages := 4; 1342 CoreGraph._txcolor := 15; 1343 CoreGraph._scr_attr := 7; 1344 | 3: 1345 v.numxpixels := 0; 1346 v.numypixels := 0; 1347 v.numtextcols := 80; 1348 v.numtextrows := 25; 1349 v.numcolors := 32; 1350 v.bitsperpixel := 0; 1351 v.numvideopages := 4; 1352 CoreGraph._txcolor := 15; 1353 CoreGraph._scr_attr := 7; 1354 | 4: 1355 v.numxpixels := 320; 1356 v.numypixels := 200; 1357 v.numtextcols := 40; 1358 v.numtextrows := 25; 1359 v.numcolors := 4; 1360 v.bitsperpixel := 2; 1361 v.numvideopages := 1; 1362 CoreGraph._fgcolor := 3; 1363 CoreGraph._scr_attr := 0; 1364 | 5: 1365 v.numxpixels := 320; 1366 v.numypixels := 200; 1367 v.numtextcols := 40; 1368 v.numtextrows := 25; 1369 v.numcolors := 4; 1370 v.bitsperpixel := 2; 1371 v.numvideopages := 1; 1372 CoreGraph._page_size:= 0; 1373 CoreGraph._scr_attr := 0; 1374 CoreGraph._fgcolor := 3; 1375 | 6: 1376 v.numxpixels := 640; 1377 v.numypixels := 200; 1378 v.numtextcols := 80; 1379 v.numtextrows := 25; 1380 v.numcolors := 2; 1381 v.bitsperpixel := 1; 1382 v.numvideopages := 1; 1383 CoreGraph._page_size:= 0; 1384 CoreGraph._scr_attr := 0; 1385 CoreGraph._fgcolor := 1; 1386 | 7: 1387 v.numxpixels := 0; 1388 v.numypixels := 0; 1389 v.numtextcols := 80; 1390 v.numtextrows := 25; 1391 v.numcolors := 2; 1392 v.bitsperpixel := 0; 1393 v.numvideopages := 4; 1394 CoreGraph._txcolor := 1; 1395 CoreGraph._scr_attr := 7; 1396 | 8: 1397 v.numxpixels := 720; 1398 v.numypixels := 348; 1399 v.numtextcols := 80; 1400 v.numtextrows := 25; 1401 v.numcolors := 2; 1402 v.bitsperpixel := 1; 1403 v.numvideopages := 2; 1404 CoreGraph._page_size:= 800H; 1405 CoreGraph._fgcolor := 1; 1406 CoreGraph._scr_attr := 0; 1407 | 13: 1408 v.numxpixels := 320; 1409 v.numypixels := 200; 1410 v.numtextcols := 40; 1411 v.numtextrows := 25; 1412 v.numcolors := 16; 1413 v.bitsperpixel := 4; 1414 v.numvideopages := CoreGraph._current_video.memory DIV 32; 1415 CoreGraph._page_size:= 200H; 1416 CoreGraph._fgcolor := 15; 1417 CoreGraph._scr_attr := 0; 1418 | 14: 1419 v.numxpixels := 640; 1420 v.numypixels := 200; 1421 v.numtextcols := 80; 1422 v.numtextrows := 25; 1423 v.numcolors := 16; 1424 v.bitsperpixel := 4; 1425 v.numvideopages := CoreGraph._current_video.memory DIV 64; 1426 CoreGraph._page_size:= 400H; 1427 CoreGraph._fgcolor := 15; 1428 CoreGraph._scr_attr := 0; 1429 | 15: 1430 v.numxpixels := 640; 1431 v.numypixels := 350; 1432 v.numtextcols := 80; 1433 v.numtextrows := 25; 1434 v.numcolors := 4; 1435 v.bitsperpixel := 2; 1436 v.numvideopages := 2; 1437 CoreGraph._page_size:= 800H; 1438 CoreGraph._fgcolor := 3; 1439 CoreGraph._scr_attr := 0; 1440 | 16: 1441 v.numxpixels := 640; 1442 v.numypixels := 350; 1443 v.numtextcols := 80; 1444 v.numtextrows := 25; 1445 v.numcolors := 16; 1446 v.bitsperpixel := 4; 1447 v.numvideopages := 2; 1448 CoreGraph._page_size:= 800H; 1449 CoreGraph._fgcolor := 15; 1450 CoreGraph._scr_attr := 0; 1451 | 17: 1452 v.numxpixels := 640; 1453 v.numypixels := 480; 1454 v.numtextcols := 80; 1455 v.numtextrows := 30; 1456 v.numcolors := 2; 1457 v.bitsperpixel := 1; 1458 v.numvideopages := 1; 1459 CoreGraph._page_size:= 0; 1460 CoreGraph._fgcolor := 1; 1461 CoreGraph._scr_attr := 0; 1462 | 18: 1463 v.numxpixels := 640; 1464 v.numypixels := 480; 1465 v.numtextcols := 80; 1466 v.numtextrows := 30; 1467 v.numcolors := 16; 1468 v.bitsperpixel := 4; 1469 v.numvideopages := 1; 1470 CoreGraph._fgcolor := 15; 1471 CoreGraph._page_size:= 0; 1472 CoreGraph._scr_attr := 0; 1473 | 19: 1474 v.numxpixels := 320; 1475 v.numypixels := 200; 1476 v.numtextcols := 40; 1477 v.numtextrows := 25; 1478 v.numcolors := 256; 1479 v.bitsperpixel := 8; 1480 v.numvideopages := 1; 1481 CoreGraph._fgcolor := 255; 1482 CoreGraph._page_size:= 0; 1483 CoreGraph._scr_attr := 0; 1484 END; 1485 CoreGraph._clip_tl.xcoord :=0; 1486 CoreGraph._clip_tl.ycoord :=0; 1487 CoreGraph._clip_br.xcoord :=v.numxpixels-1; 1488 CoreGraph._clip_br.ycoord :=v.numypixels-1; 1489 CoreGraph._text_tl.row :=0; 1490 CoreGraph._text_tl.col :=0; 1491 CoreGraph._text_br.row :=v.numtextrows-1; 1492 CoreGraph._text_br.col :=v.numtextcols-1; 1493 END SetLimits; 1494 1495 PROCEDURE GEnter(); 1496 1497 BEGIN 1498 IF CoreGraph._cursor_state = _GCURSORON THEN 1499 CoreGraph._gcur(0, CoreGraph._current_text.row, CoreGraph._current_text.col, CoreGraph._visual_page); 1500 INC(CoreGraph._cursor_lock); 1501 END; 1502 END GEnter; 1503 1504 PROCEDURE GExit(); 1505 1506 BEGIN 1507 IF(CoreGraph._cursor_state = _GCURSORON) THEN 1508 DEC(CoreGraph._cursor_lock); 1509 IF (CoreGraph._cursor_lock = 0) THEN 1510 CoreGraph._gcur(CoreGraph._txcolor, CoreGraph._current_text.row, CoreGraph._current_text.col, CoreGraph._visual_page); 1511 END; 1512 END; 1513 END GExit; 1514 1515 PROCEDURE EGAcolXlat(Color: LONGCARD): INTEGER; 1516 1517 TYPE 1518 LongSet = SET OF [0..31]; 1519 VAR 1520 ncol, blue, green, red: CARDINAL; 1521 BEGIN 1522 blue:= CARDINAL(LONGCARD(LongSet(Color)*LongSet(0FF0000H))>>16); 1523 green:= CARDINAL(LONGCARD(LongSet(Color)*LongSet(0FF00H))>>8); 1524 red:= CARDINAL(LongSet(Color)*LongSet(0FFH)); 1525 1526 IF red = 0 THEN 1527 ncol:=0; 1528 ELSIF red <= 015H THEN 1529 ncol:=32; 1530 ELSIF red <= 02AH THEN 1531 ncol:=4; 1532 ELSE 1533 ncol:=36; 1534 END; 1535 IF green # 0 THEN 1536 IF green <= 015H THEN 1537 INC(ncol, 16); 1538 ELSIF green <= 02AH THEN 1539 INC(ncol, 2); 1540 ELSE 1541 INC(ncol, 18); 1542 END; 1543 END; 1544 IF blue # 0 THEN 1545 IF blue <= 015H THEN 1546 INC(ncol, 8); 1547 ELSIF blue <= 02AH THEN 1548 INC(ncol, 1); 1549 ELSE 1550 INC(ncol, 9); 1551 END; 1552 END; 1553 RETURN ncol; 1554 END EGAcolXlat; 1555 1556 PROCEDURE ColXlat(Color: LONGCARD): INTEGER; 1557 1558 VAR 1559 n: INTEGER; 1560 BEGIN 1561 n:=0; 1562 LOOP 1563 IF n = 16 THEN EXIT END; 1564 IF ColTable[n] = Color THEN EXIT END; 1565 INC(n); 1566 END; 1567 RETURN n; 1568 END ColXlat; 1569 1570 PROCEDURE Scroll(); 1571 1572 VAR 1573 r: SYSTEM.Registers; 1574 BEGIN 1575 r.AX:=0601H; 1576 r.BH:=SHORTCARD(CoreGraph._scr_attr); 1577 r.CH:=SHORTCARD(CoreGraph._text_tl.row); 1578 r.CL:=SHORTCARD(CoreGraph._text_tl.col); 1579 r.DH:=SHORTCARD(CoreGraph._text_br.row); 1580 r.DL:=SHORTCARD(CoreGraph._text_br.col); 1581 Lib.Intr(r, 10H); 1582 END Scroll; 1583 1584 (*# restore *) 1585 1586 (*****************************************************************************) 1587 (* Public Function definitions. *) 1588 (*****************************************************************************) 1589 1590 PROCEDURE GetVideoConfig(VAR V: VideoConfig); 1591 1592 BEGIN 1593 IF CoreGraph._defaultmode = 0 THEN RETURN END; 1594 Lib.FastMove(ADR(CoreGraph._current_video), ADR(V), SIZE(VideoConfig)); 1595 END GetVideoConfig; 1596 1597 PROCEDURE SetClipRgn(x1, y1, x2, y2: CARDINAL); 1598 1599 PROCEDURE Max(A, B: CARDINAL): CARDINAL; 1600 1601 BEGIN 1602 IF A > B THEN 1603 RETURN A; 1604 ELSE 1605 RETURN B; 1606 END; 1607 END Max; 1608 1609 PROCEDURE Min(A, B: CARDINAL): CARDINAL; 1610 1611 BEGIN 1612 IF A < B THEN 1613 RETURN A; 1614 ELSE 1615 RETURN B; 1616 END; 1617 END Min; 1618 1619 BEGIN 1620 CoreGraph._clip_tl.xcoord:=Max(x1, 0); 1621 CoreGraph._clip_tl.ycoord:=Max(y1, 0); 1622 CoreGraph._clip_br.xcoord:=Min(x2, CoreGraph._current_video.numxpixels-1); 1623 CoreGraph._clip_br.ycoord:=Min(y2, CoreGraph._current_video.numypixels-1); 1624 END SetClipRgn; 1625 1626 PROCEDURE GetBkColor(): LONGCARD; 1627 1628 BEGIN 1629 RETURN CoreGraph._bkcolor; 1630 END GetBkColor; 1631 1632 PROCEDURE GetFillMask(VAR Mask: FillMaskType); 1633 1634 BEGIN 1635 Lib.FastMove(ADR(CoreGraph._fill_mask), ADR(Mask), SIZE(CoreGraph.FillMaskType)); 1636 END GetFillMask; 1637 1638 1639 1640 PROCEDURE GetLinestyle(): CARDINAL; 1641 1642 BEGIN 1643 RETURN CoreGraph._current_linestyle; 1644 END GetLinestyle; 1645 1646 PROCEDURE SetBkColor(Color: LONGCARD): LONGCARD; 1647 1648 VAR 1649 Ret: LONGCARD; 1650 r: SYSTEM.Registers; 1651 1652 BEGIN 1653 Ret:=CoreGraph._bkcolor; 1654 IF Ret = Color THEN 1655 RETURN Ret; 1656 END; 1657 IF (CoreGraph._current_video.mode = _MRES4COLOR) OR (CoreGraph._current_video.mode = _MRESNOCOLOR) THEN 1658 r.AH:= 0BH; 1659 r.BH:= 0; 1660 r.BL:= SHORTCARD(ColXlat(Color)); 1661 Lib.Intr(r, 10H); 1662 ELSIF CoreGraph._current_video.mode > _MRES16COLOR THEN 1663 SYSTEM.Eval(RemapPalette(0, Color)); 1664 END; 1665 CoreGraph._bkcolor:= Color; 1666 RETURN Ret; 1667 END SetBkColor; 1668 1669 PROCEDURE SetFillMask(Mask: CoreGraph.FillMaskType); 1670 1671 BEGIN 1672 CoreGraph._current_mask:= CoreGraph.FillMaskPtr(ADR(Mask)); 1673 Lib.FastMove(ADR(Mask), ADR(CoreGraph._fill_mask), SIZE(CoreGraph.FillMaskType)); 1674 END SetFillMask; 1675 1676 PROCEDURE SetLinestyle(Mask: CARDINAL); 1677 1678 BEGIN 1679 CoreGraph._current_linestyle:=Mask; 1680 END SetLinestyle; 1681 1682 PROCEDURE DisplayCursor(Toggle: BOOLEAN): BOOLEAN; 1683 1684 VAR 1685 Ret: BOOLEAN; 1686 BEGIN 1687 Ret:=CoreGraph._cursor_state; 1688 CoreGraph._cursor_state:=Toggle; 1689 RETURN Ret; 1690 END DisplayCursor; 1691 1692 1693 1694 PROCEDURE GetTextColor(): CARDINAL; 1695 1696 BEGIN 1697 RETURN CoreGraph._txcolor; 1698 END GetTextColor; 1699 1700 PROCEDURE GetTextPosition(): TextCoords; 1701 1702 VAR 1703 Ret: TextCoords; 1704 BEGIN 1705 Ret.row:=CoreGraph._current_text.row-CoreGraph._text_tl.row+1; 1706 Ret.col:=CoreGraph._current_text.col-CoreGraph._text_tl.col+1; 1707 RETURN Ret; 1708 END GetTextPosition; 1709 1710 1711 PROCEDURE SetTextColor(Color: CARDINAL): CARDINAL; 1712 1713 VAR 1714 Ret: CARDINAL; 1715 BEGIN 1716 Ret:=CoreGraph._txcolor; 1717 CoreGraph._txcolor:=Color; 1718 RETURN Ret; 1719 END SetTextColor; 1720 1721 PROCEDURE SetTextPosition(row, col: CARDINAL): TextCoords; 1722 1723 VAR 1724 Ret: TextCoords; 1725 BEGIN 1726 Ret:=CoreGraph._current_text; 1727 GEnter(); 1728 CoreGraph._current_text.row:=INTEGER(row)+CoreGraph._text_tl.row-1; 1729 CoreGraph._current_text.col:=INTEGER(col)+CoreGraph._text_tl.col-1; 1730 CoreGraph._setcur(CoreGraph._current_text.row, CoreGraph._current_text.col, CoreGraph._active_page); 1731 GExit(); 1732 RETURN Ret; 1733 END SetTextPosition; 1734 1735 PROCEDURE SetTextWindow(r1, c1, r2, c2: CARDINAL); 1736 1737 BEGIN 1738 CoreGraph._text_tl.row:=r1-1; 1739 CoreGraph._text_tl.col:=c1-1; 1740 CoreGraph._text_br.row:=r2-1; 1741 CoreGraph._text_br.col:=c2-1; 1742 SYSTEM.Eval(SetTextPosition(1, 1)); 1743 END SetTextWindow; 1744 1745 PROCEDURE Wrapon(Opt: BOOLEAN): BOOLEAN; 1746 1747 VAR 1748 Ret: BOOLEAN; 1749 1750 BEGIN 1751 Ret:=CoreGraph._wrap_state; 1752 1753 CoreGraph._wrap_state:=Opt; 1754 RETURN Ret; 1755 END Wrapon; 1756 1757 1758 PROCEDURE OutText(Text: ARRAY OF CHAR); 1759 1760 VAR 1761 c: CHAR; 1762 n, h: CARDINAL; 1763 BEGIN 1764 n:=0; 1765 h:=HIGH(Text); 1766 GEnter(); 1767 LOOP 1768 IF n > h THEN EXIT END; 1769 c:= Text[n]; 1770 INC(n); 1771 IF c = CHAR(0) THEN EXIT END; 1772 CoreGraph._setcur(CoreGraph._current_text.row, CoreGraph._current_text.col, CoreGraph._active_page); 1773 IF c = CHAR(0AH) THEN 1774 IF CoreGraph._current_text.row < CoreGraph._text_br.row THEN 1775 INC(CoreGraph._current_text.row); 1776 ELSE 1777 Scroll(); 1778 END; 1779 CoreGraph._current_text.col:=CoreGraph._text_tl.col; 1780 ELSIF c = CHAR(0DH) THEN 1781 CoreGraph._current_text.col:=CoreGraph._text_tl.col; 1782 ELSE 1783 CoreGraph._txt_out(INTEGER(c)); 1784 IF CoreGraph._current_text.col = CoreGraph._text_br.col THEN 1785 CoreGraph._current_text.col:=CoreGraph._text_tl.col; 1786 IF CoreGraph._current_text.row < CoreGraph._text_br.row THEN 1787 INC(CoreGraph._current_text.row); 1788 ELSE 1789 Scroll(); 1790 END; 1791 IF CoreGraph._wrap_state = _GWRAPOFF THEN EXIT END; 1792 ELSE 1793 INC(CoreGraph._current_text.col); 1794 END; 1795 END; 1796 END; 1797 CoreGraph._setcur(CoreGraph._current_text.row, CoreGraph._current_text.col, CoreGraph._active_page); 1798 GExit(); 1799 END OutText; 1800 1801 PROCEDURE g_charoutput(c: CARDINAL); 1802 1803 BEGIN 1804 GEnter(); 1805 CoreGraph._setcur(CoreGraph._current_text.row, CoreGraph._current_text.col, CoreGraph._active_page); 1806 IF c = 0AH THEN 1807 IF CoreGraph._current_text.row < CoreGraph._text_br.row THEN 1808 INC(CoreGraph._current_text.row); 1809 ELSE 1810 Scroll(); 1811 END; 1812 CoreGraph._current_text.col:=CoreGraph._text_tl.col; 1813 ELSIF c = 0DH THEN 1814 CoreGraph._current_text.col:=CoreGraph._text_tl.col; 1815 ELSIF c = 8 THEN 1816 IF CoreGraph._current_text.col = CoreGraph._text_tl.col THEN 1817 IF CoreGraph._current_text.row > CoreGraph._text_tl.row THEN 1818 DEC(CoreGraph._current_text.row); 1819 CoreGraph._current_text.col:=CoreGraph._text_br.col; 1820 END; 1821 ELSE 1822 DEC(CoreGraph._current_text.col); 1823 END; 1824 CoreGraph._setcur(CoreGraph._current_text.row, CoreGraph._current_text.col, CoreGraph._active_page); 1825 CoreGraph._txt_out(INTEGER('\ ')); 1826 ELSE 1827 CoreGraph._txt_out(INTEGER(c)); 1828 IF CoreGraph._current_text.col = CoreGraph._text_br.col THEN 1829 CoreGraph._current_text.col:=CoreGraph._text_tl.col; 1830 IF CoreGraph._current_text.row < CoreGraph._text_br.row THEN 1831 INC(CoreGraph._current_text.row); 1832 ELSE 1833 Scroll(); 1834 END; 1835 ELSE 1836 INC(CoreGraph._current_text.col); 1837 END; 1838 END; 1839 CoreGraph._setcur(CoreGraph._current_text.row, CoreGraph._current_text.col, CoreGraph._active_page); 1840 GExit(); 1841 END g_charoutput; 1842 1843 PROCEDURE g_strinput(String: ARRAY OF CHAR); 1844 1845 VAR 1846 c: CHAR; 1847 p, n: CARDINAL; 1848 BEGIN 1849 p:=2; 1850 n:=0; 1851 LOOP 1852 IF n = HIGH(String) THEN EXIT END; 1853 c:= IO.RdChar(); 1854 IF (c = CHAR(8)) OR (c = CHAR(127)) THEN 1855 IF n > 0 THEN 1856 DEC(p); 1857 DEC(n); 1858 g_charoutput(8); 1859 END; 1860 ELSIF ( c > CHAR(' ')) THEN 1861 g_charoutput(CARDINAL(c)); 1862 String[p]:=c; 1863 INC(p); 1864 INC(n); 1865 ELSIF c = CHAR(13) THEN 1866 g_charoutput(CARDINAL(0AH)); 1867 EXIT; 1868 END; 1869 END; 1870 String[p]:=CHAR(0); 1871 END g_strinput; 1872 1873 PROCEDURE SetVideoMode(Mode: CARDINAL): BOOLEAN; 1874 1875 TYPE 1876 PalRegType = ARRAY [0..16] OF SHORTCARD; 1877 PalColType = ARRAY [0..15] OF LONGCARD; 1878 CONST 1879 PalRegs = PalRegType(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 0); 1880 PalCols = PalColType(_BLACK, _BLUE, _GREEN, _CYAN, _RED, _MAGENTA, _BROWN, 1881 _WHITE, _GRAY, _LIGHTBLUE, _LIGHTGREEN, _LIGHTCYAN, 1882 _LIGHTRED, _LIGHTMAGENTA, _LIGHTYELLOW, _BRIGHTWHITE); 1883 VAR 1884 R: SYSTEM.Registers; 1885 n: CARDINAL; 1886 1887 PROCEDURE CheckMode(): BOOLEAN; 1888 1889 VAR 1890 Ret: BOOLEAN; 1891 BEGIN 1892 Ret:=TRUE; 1893 1894 IF Mode = _DEFAULTMODE THEN 1895 RETURN Ret; 1896 END; 1897 IF CoreGraph._current_video.adapter = _MDPA THEN 1898 IF Mode # _TEXTMONO THEN 1899 Ret:=FALSE; 1900 END; 1901 ELSIF CoreGraph._current_video.adapter = _HGC THEN 1902 IF (Mode # _TEXTMONO) AND (Mode # _HERCMONO) THEN 1903 Ret:=FALSE; 1904 END; 1905 ELSE 1906 CASE Mode OF 1907 | _TEXTBW40, _TEXTC40, _TEXTBW80, _TEXTC80, 1908 _MRES4COLOR, _MRESNOCOLOR, _HRESBW: 1909 Ret:=TRUE; 1910 | _TEXTMONO, _MRES16COLOR, _HRES16COLOR, 1911 _ERESNOCOLOR, _ERESCOLOR: 1912 IF (CoreGraph._current_video.adapter # _VGA) AND (CoreGraph._current_video.adapter # _EGA) THEN 1913 Ret:=FALSE; 1914 END; 1915 | _VRES2COLOR: 1916 IF (CoreGraph._current_video.adapter # _VGA) AND (CoreGraph._current_video.adapter # _MCGA) THEN 1917 Ret:=FALSE; 1918 END; 1919 | _VRES16COLOR, _HERCMONO: 1920 IF CoreGraph._current_video.adapter # _VGA THEN (* HGC already checked *) 1921 Ret:=FALSE; 1922 END; 1923 | _MRES256COLOR: 1924 IF (CoreGraph._current_video.adapter # _VGA) AND (CoreGraph._current_video.adapter # _MCGA) THEN 1925 Ret:=FALSE; 1926 END; 1927 ELSE 1928 Ret:=FALSE; 1929 END; 1930 END; 1931 RETURN Ret; 1932 END CheckMode; 1933 1934 BEGIN 1935 IF ~CheckMode() THEN 1936 RETURN FALSE; 1937 END; (*IF*) 1938 IF Mode = _DEFAULTMODE THEN 1939 Mode := CoreGraph._defaultmode; 1940 END; (*IF*) 1941 CoreGraph._display_state := ~(((Mode >= 0) & (Mode <= 3)) OR (Mode = 7)); 1942 IF (Mode >= 4) & (Mode <= 6) THEN 1943 InternalInitCGA(Mode); 1944 ELSIF Mode = 8 THEN 1945 InternalInitHerc; 1946 ELSIF (Mode >= 13) & (Mode < 19) THEN 1947 InternalInitEGA(Mode); 1948 ELSIF Mode = 19 THEN 1949 InternalInitVGA256; 1950 END; (*IF*) 1951 IF CoreGraph._lastmode = 8 THEN 1952 HercTextMode; 1953 END; (*IF*) 1954 IF Mode = 8 THEN 1955 HercGraphMode; 1956 ELSE 1957 CoreGraph._setbiosmode(Mode); 1958 IF (Mode >= 13) AND (Mode < 19) THEN 1959 R.AX := 1002H; 1960 R.ES := Seg(PalRegs); 1961 R.DX := Ofs(PalRegs); 1962 Lib.Intr(R,10H); 1963 FOR n := 0 TO 15 DO 1964 R.AX := 1010H; 1965 R.BH := SHORTCARD(n); (* Trial Fix 12/02/91 *) 1966 R.BL := SHORTCARD(n); 1967 R.DH := SHORTCARD(PalCols[n]); 1968 R.CH := SHORTCARD(PalCols[n] >> 8); 1969 R.CL := SHORTCARD(PalCols[n] >> 16); 1970 Lib.Intr(R,10H); 1971 END; (*FOR*) 1972 END; (*IF*) 1973 END; (*IF*) 1974 CoreGraph._current_video.mode := Mode; 1975 SetLimits(CoreGraph._current_video); 1976 CoreGraph._lastmode := Mode; 1977 ModeChanged := TRUE; 1978 RETURN TRUE; 1979 END SetVideoMode; 1980 1981 PROCEDURE SetActivePage(Page: CARDINAL): CARDINAL; 1982 1983 1984 VAR 1985 Ret: CARDINAL; 1986 BEGIN 1987 Ret:=CoreGraph._active_page; 1988 IF (Page < 0) OR (Page > CoreGraph._current_video.numvideopages-1) THEN 1989 RETURN MAX(CARDINAL); 1990 END; 1991 CoreGraph._active_page:=Page; 1992 RETURN Ret; 1993 END SetActivePage; 1994 1995 PROCEDURE SetVisualPage(Page:CARDINAL):CARDINAL; 1996 VAR 1997 r : SYSTEM.Registers; 1998 Ret : CARDINAL; 1999 BEGIN 2000 Ret := CoreGraph._visual_page; 2001 IF (Page < 0) OR (Page > CoreGraph._current_video.numvideopages-1) THEN 2002 RETURN MAX(CARDINAL); 2003 END; (*IF*) 2004 CoreGraph._visual_page := Page; 2005 IF CoreGraph._current_video.mode # _HERCMONO THEN 2006 r.AH:=5; 2007 r.AL:=SHORTCARD(Page); 2008 Lib.Intr(r,10H); 2009 ELSIF Page = 0 THEN 2010 SYSTEM.Out(3B8H,0AH); 2011 ELSE 2012 SYSTEM.Out(3B8H,08AH); 2013 END; (*IF*) 2014 RETURN Ret; 2015 END SetVisualPage; 2016 2017 PROCEDURE ClearScreen(Area: CARDINAL); 2018 2019 VAR 2020 r: SYSTEM.Registers; 2021 LineNum: INTEGER; 2022 BEGIN 2023 GEnter(); 2024 IF Area = _GWINDOW THEN 2025 r.AX:=0600H; 2026 IF CoreGraph._display_state = FALSE THEN 2027 r.BH:=SHORTCARD(7+(CoreGraph._bkcolor<<4)); 2028 ELSE 2029 r.BH:=0; 2030 END; 2031 r.CH:=SHORTCARD(CoreGraph._text_tl.row); 2032 r.CL:=SHORTCARD(CoreGraph._text_tl.col); 2033 r.DH:=SHORTCARD(CoreGraph._text_br.row); 2034 r.DL:=SHORTCARD(CoreGraph._text_br.col); 2035 Lib.Intr(r, 10H); 2036 SYSTEM.Eval(SetTextPosition(1, 1)); 2037 ELSIF Area = _GVIEWPORT THEN 2038 IF CoreGraph._display_state = TRUE THEN 2039 LineNum:=CoreGraph._clip_tl.ycoord; 2040 WHILE LineNum <= CoreGraph._clip_br.ycoord DO 2041 CoreGraph._hline(CoreGraph._clip_tl.xcoord, LineNum, CoreGraph._clip_br.xcoord, 0); 2042 INC(LineNum); 2043 END; 2044 END; 2045 ELSIF CoreGraph._current_video.mode = _HERCMONO THEN 2046 CoreGraph._clear_Herc(); 2047 SYSTEM.Eval(SetTextPosition(1, 1)); 2048 ELSE 2049 r.AX:=0600H; 2050 IF CoreGraph._display_state = FALSE THEN 2051 r.BH:=SHORTCARD(7+(CoreGraph._bkcolor<<4)); 2052 ELSE 2053 r.BH:=SHORTCARD(CoreGraph._bkcolor); 2054 END; 2055 r.CX:=0000H; 2056 r.DH:=SHORTCARD(CoreGraph._current_video.numtextrows-1); 2057 r.DL:=SHORTCARD(CoreGraph._current_video.numtextcols-1); 2058 Lib.Intr(r, 10H); 2059 SYSTEM.Eval(SetTextPosition(1, 1)); 2060 END; 2061 GExit(); 2062 END ClearScreen; 2063 2064 PROCEDURE Line(x1, y1, x2, y2: CARDINAL; Color: CARDINAL); 2065 2066 BEGIN 2067 GEnter(); 2068 CoreGraph._fgcolor:=Color; 2069 IF (y1 = y2) AND (CoreGraph._current_linestyle = MAX(CARDINAL)) THEN 2070 CoreGraph._hline(x1, y1, x2, Color); 2071 ELSE 2072 CoreGraph._line(x1, y1, x2, y2, CoreGraph._current_linestyle); 2073 END; 2074 GExit(); 2075 END Line; 2076 2077 PROCEDURE HLine(x1, y1, x2: CARDINAL; Color: CARDINAL); 2078 2079 BEGIN 2080 GEnter(); 2081 CoreGraph._hline(x1, y1, x2, Color); 2082 GExit(); 2083 END HLine; 2084 2085 PROCEDURE Rectangle(x1, y1, x2, y2: CARDINAL; Color: CARDINAL;Fill: BOOLEAN); 2086 2087 VAR 2088 Mask: CARDINAL; 2089 BEGIN 2090 GEnter(); 2091 CoreGraph._fgcolor:=Color; 2092 IF CoreGraph._current_linestyle = MAX(CARDINAL) THEN 2093 CoreGraph._hline(x1, y1, x2, Color); 2094 CoreGraph._line(x2, y1, x2, y2, CoreGraph._current_linestyle); 2095 CoreGraph._hline(x2, y2, x1, Color); 2096 CoreGraph._line(x1, y2, x1, y1, CoreGraph._current_linestyle); 2097 ELSE 2098 CoreGraph._line(x1, y1, x2, y1, CoreGraph._current_linestyle); 2099 CoreGraph._line(x2, y1, x2, y2, CoreGraph._current_linestyle); 2100 CoreGraph._line(x2, y2, x1, y2, CoreGraph._current_linestyle); 2101 CoreGraph._line(x1, y2, x1, y1, CoreGraph._current_linestyle); 2102 END; 2103 IF Fill = _GFILLINTERIOR THEN 2104 INC(x1); 2105 INC(y1); 2106 DEC(x2); 2107 DEC(y2); 2108 IF x1 = x2 THEN 2109 GExit(); 2110 RETURN; 2111 END; 2112 WHILE y1 <= y2 DO 2113 Mask:=CARDINAL(CoreGraph._fill_mask[y1 MOD 8]) 2114 +CARDINAL(CoreGraph._fill_mask[y1 MOD 8])*100H; 2115 IF Mask = MAX(CARDINAL) THEN 2116 CoreGraph._hline(x1, y1, x2, Color); 2117 ELSE 2118 CoreGraph._line(x1, y1, x2, y1, Mask); 2119 END; 2120 INC(y1); 2121 END; 2122 END; 2123 GExit(); 2124 END Rectangle; 2125 2126 PROCEDURE Ellipse(x0, y0, a0, b0: CARDINAL; Color: CARDINAL; Fill: BOOLEAN); 2127 2128 BEGIN 2129 GEnter(); 2130 CoreGraph._fgcolor:= Color; 2131 DrawEllipse(x0, y0, a0, b0, Fill); 2132 GExit(); 2133 END Ellipse; 2134 2135 PROCEDURE Disc(x0, y0, r: CARDINAL; Color: CARDINAL); 2136 2137 BEGIN 2138 Ellipse(x0, y0, r, r, Color, TRUE); 2139 END Disc; 2140 2141 PROCEDURE Circle(x0, y0, r: CARDINAL; Color: CARDINAL); 2142 2143 BEGIN 2144 Ellipse(x0, y0, r, r, Color, FALSE); 2145 END Circle; 2146 2147 PROCEDURE Arc(x1, y1, a, b, x3, y3, x4, y4: CARDINAL; Color: CARDINAL); 2148 2149 VAR 2150 start, end: InterSect; 2151 BEGIN 2152 GEnter(); 2153 CoreGraph._fgcolor:=Color; 2154 start:=GetVec(x1, y1, a, b, x3, y3); 2155 end:=GetVec(x1, y1, a, b, x4, y4); 2156 SYSTEM.Eval(DrawArc(x1, y1, a, b, start.x, start.y, end.x, end.y)); 2157 GExit(); 2158 END Arc; 2159 2160 PROCEDURE Pie(x1, y1, a, b, x3, y3, x4, y4: CARDINAL; Color: CARDINAL; Fill: BOOLEAN); 2161 2162 VAR 2163 Ret: BOOLEAN; 2164 fx, fy: INTEGER; 2165 start, end: InterSect; 2166 BEGIN 2167 GEnter(); 2168 CoreGraph._fgcolor:=Color; 2169 start:=GetVec(x1, y1, a, b, x3, y3); 2170 end:=GetVec(x1, y1, a, b, x4, y4); 2171 Ret:=DrawArc(x1, y1, a, b, start.x, start.y, end.x, end.y); 2172 IF Ret = FALSE THEN 2173 RETURN ; 2174 END; 2175 CoreGraph._line(x1, y1, start.x, start.y, CoreGraph._current_linestyle); 2176 CoreGraph._line(x1, y1, end.x, end.y, CoreGraph._current_linestyle); 2177 IF (Fill = _GFILLINTERIOR) AND (GetFillStart(fx, fy, x1, y1, start.x, start.y, 2178 end.x, end.y)) THEN 2179 FloodFill(fx, fy, CoreGraph._fgcolor, CoreGraph._fgcolor); 2180 END; 2181 GExit(); 2182 END Pie; 2183 2184 PROCEDURE Plot(x, y: CARDINAL; Color: CARDINAL); 2185 2186 BEGIN 2187 GEnter(); 2188 IF (INTEGER(x) > CoreGraph._clip_br.xcoord) OR (INTEGER(x) < CoreGraph._clip_tl.xcoord) 2189 OR (INTEGER(y) > CoreGraph._clip_br.ycoord) OR (INTEGER(y) < CoreGraph._clip_tl.ycoord) THEN 2190 RETURN; 2191 END; 2192 CoreGraph._plot(x, y, Color); 2193 GExit(); 2194 END Plot; 2195 2196 PROCEDURE Point(x, y: CARDINAL): CARDINAL; 2197 2198 BEGIN 2199 IF (INTEGER(x) > CoreGraph._clip_br.xcoord) OR (INTEGER(x) < CoreGraph._clip_tl.xcoord) 2200 OR (INTEGER(y) > CoreGraph._clip_br.ycoord) OR (INTEGER(y) < CoreGraph._clip_tl.ycoord) THEN 2201 RETURN MAX(CARDINAL); 2202 END; 2203 RETURN CoreGraph._point(x, y); 2204 END Point; 2205 2206 PROCEDURE FloodFill(x, y: CARDINAL; Color: CARDINAL; Boundary: CARDINAL); 2207 2208 VAR 2209 xl, xr, v, i, nx, ny: INTEGER; 2210 BEGIN 2211 CoreGraph._fgcolor:=Color; 2212 i:=0; 2213 WHILE ( i < FILL_MASK_SIZE) DO 2214 IF CoreGraph._fill_mask[i] = 0 THEN 2215 StackFill(x, y, Color, Boundary); 2216 RETURN; 2217 END; 2218 INC(i); 2219 END; 2220 GEnter(); 2221 nx := INTEGER(x); 2222 ny := INTEGER(y); 2223 IF Boundary >= CoreGraph._current_video.numcolors THEN 2224 Boundary:=CoreGraph._current_video.numcolors-1; 2225 END; 2226 IF (nx > CoreGraph._clip_br.xcoord) OR (nx < CoreGraph._clip_tl.xcoord) THEN 2227 RETURN; 2228 END; 2229 IF (ny > CoreGraph._clip_br.ycoord) OR (ny < CoreGraph._clip_tl.ycoord) THEN 2230 RETURN; 2231 END; 2232 v:=CoreGraph._point(x, y); 2233 IF v = INTEGER(Boundary) THEN 2234 RETURN; 2235 END; 2236 xr := x; 2237 xl := xr; 2238 HscanLine (xl, xr, y, Boundary); 2239 LagFill(xl, xr, y, UP, xl, xl-1, Boundary); 2240 GExit(); 2241 END FloodFill; 2242 2243 PROCEDURE StackFill(x, y: CARDINAL; Color: CARDINAL; Boundary: CARDINAL); 2244 2245 VAR 2246 xl, xr, xp, yp, nx, ny, direction: INTEGER; 2247 BEGIN 2248 nx := INTEGER(x); 2249 ny := INTEGER(y); 2250 GEnter(); 2251 CoreGraph._fgcolor:=Color; 2252 IF Boundary >= CoreGraph._current_video.numcolors THEN 2253 Boundary:=CoreGraph._current_video.numcolors-1; 2254 END; 2255 IF (nx > CoreGraph._clip_br.xcoord) OR (nx < CoreGraph._clip_tl.xcoord) THEN 2256 RETURN; 2257 END; 2258 IF (ny > CoreGraph._clip_br.ycoord) OR (ny < CoreGraph._clip_tl.ycoord) THEN 2259 RETURN; 2260 END; 2261 IF CoreGraph._point(x, y) = INTEGER(Boundary) THEN 2262 RETURN; 2263 END; 2264 xr := x; 2265 xl := xr; 2266 xp:=x; 2267 yp:=y; 2268 HscanLine ( xl, xr, y, Boundary ); 2269 2270 direction := +1; 2271 LOOP 2272 ny := yp; 2273 nx := xl; 2274 xp := xr; 2275 LOOP 2276 INC(ny, direction); 2277 IF (ny < CoreGraph._clip_tl.ycoord) OR (CoreGraph._clip_br.ycoord < ny) THEN 2278 EXIT; 2279 END; 2280 WHILE (nx <= xp) AND (CoreGraph._point ( nx, ny ) = INTEGER(Boundary)) DO 2281 INC(nx); 2282 END; 2283 IF nx > xp THEN 2284 EXIT; 2285 END; 2286 xp := nx; 2287 HscanLine (nx, xp, ny, INTEGER(Boundary)); 2288 END; 2289 IF direction < 0 THEN 2290 EXIT; 2291 END; 2292 direction := -1; 2293 END; 2294 GExit(); 2295 END StackFill; 2296 2297 PROCEDURE RemapPalette(Pixel: CARDINAL; Color: LONGCARD): LONGCARD; 2298 2299 TYPE 2300 LongSet = SET OF [0..31]; 2301 VAR 2302 r: SYSTEM.Registers; 2303 OldColor: LONGCARD; 2304 n: CARDINAL; 2305 ColSet: LongSet; 2306 BEGIN 2307 GEnter(); 2308 IF (CoreGraph._current_video.adapter = _VGA) OR (CoreGraph._current_video.adapter = _MCGA) THEN 2309 ColSet:=LongSet(Color); 2310 r.AX:=01015H; 2311 r.BX:=Pixel; 2312 Lib.Intr(r, 10H); 2313 OldColor:= LONGCARD(r.DH); 2314 OldColor:= OldColor+LONGCARD(r.CH)<<8; 2315 OldColor:= OldColor+LONGCARD(r.CL)<<16; 2316 r.AX:=01010H; 2317 r.BX:=Pixel; 2318 r.DH:=SHORTCARD(LONGCARD(ColSet)); 2319 r.CH:=SHORTCARD(LONGCARD(ColSet*LongSet(0FF00H))>>8); 2320 r.CL:=SHORTCARD(LONGCARD(ColSet*LongSet(0FF0000H))>>16); 2321 Lib.Intr(r, 10H); 2322 ELSIF (CoreGraph._current_video.adapter = _EGA) THEN 2323 n:=EGAcolXlat(Color); 2324 r.AX:=01000H; 2325 r.BL:=SHORTCARD(Pixel); 2326 r.BH:=SHORTCARD(n); 2327 Lib.Intr(r, 10H); 2328 OldColor:=ColTable[EGATable[Pixel]]; 2329 EGATable[Pixel]:=n; 2330 ELSE 2331 OldColor := MAX(LONGCARD); 2332 END; 2333 GExit(); 2334 RETURN OldColor; 2335 END RemapPalette; 2336 2337 PROCEDURE RemapAllPalette(Colarray: ARRAY OF LONGCARD): CARDINAL; 2338 2339 VAR 2340 num, Count: CARDINAL; 2341 Colors: ARRAY [0..256] OF ARRAY [0..2] OF SHORTCARD; 2342 ColRegs: ARRAY [0..16] OF CHAR; 2343 r: SYSTEM.Registers; 2344 2345 BEGIN 2346 num:=CoreGraph._current_video.numcolors; 2347 Count:=0; 2348 GEnter(); 2349 2350 IF (CoreGraph._current_video.adapter = _VGA) OR (CoreGraph._current_video.adapter = _MCGA) THEN 2351 WHILE Count < num DO 2352 Lib.Move(ADR(Colarray[Count]), ADR(Colors[Count]), 3); 2353 INC(Count); 2354 END; 2355 r.AX:=01012H; 2356 r.BX:=0; 2357 r.CX:=num; 2358 2359 r.DX:=Ofs(Colors); 2360 r.ES:=Seg(Colors); 2361 Lib.Intr(r, 10H); 2362 ELSIF (CoreGraph._current_video.adapter = _EGA) THEN 2363 Count:=0; 2364 WHILE Count < num DO 2365 ColRegs[Count]:=CHAR(EGAcolXlat(Colarray[Count])); 2366 INC(Count); 2367 END; 2368 ColRegs[16]:=CHAR(0); 2369 r.AX:=1002H; 2370 r.DX:=Ofs(ColRegs); 2371 r.ES:=Seg(ColRegs); 2372 Lib.Intr(r, 10H); 2373 Lib.Move(ADR(ColRegs), ADR(EGATable), 17); 2374 END; 2375 GExit(); 2376 RETURN Count; 2377 END RemapAllPalette; 2378 2379 VAR 2380 OldPalette: CARDINAL; 2381 2382 PROCEDURE SelectPalette(Palnum: CARDINAL): CARDINAL; 2383 2384 VAR 2385 r: SYSTEM.Registers; 2386 Ret: CARDINAL; 2387 BEGIN 2388 Ret:=OldPalette; 2389 IF (CoreGraph._current_video.mode # _MRES4COLOR) AND (CoreGraph._current_video.mode # _MRESNOCOLOR) THEN 2390 RETURN MAX(CARDINAL); 2391 END; 2392 GEnter(); 2393 OldPalette:=Palnum; 2394 r.AH:=0BH; 2395 r.BH:=1; 2396 r.BL:=SHORTCARD(Palnum); 2397 Lib.Intr(r, 10H); 2398 GExit(); 2399 RETURN Ret; 2400 END SelectPalette; 2401 2402 PROCEDURE GetImage(x1, y1, x2, y2: CARDINAL; Buffer: ADDRESS); 2403 2404 BEGIN 2405 GEnter(); 2406 CoreGraph._get(FarADR(Buffer^), x1, y1, x2, y2); 2407 GExit(); 2408 END GetImage; 2409 2410 PROCEDURE PutImage(x, y: CARDINAL; Buffer: ADDRESS; Action: CARDINAL); 2411 2412 BEGIN 2413 GEnter(); 2414 CoreGraph._put(x, y, FarADR(Buffer^), Action); 2415 GExit(); 2416 END PutImage; 2417 2418 PROCEDURE ImageSize(x1, y1, x2, y2: CARDINAL): LONGCARD; 2419 2420 VAR 2421 Size: LONGCARD; 2422 ywidth, xwidth: LONGCARD; 2423 BEGIN 2424 xwidth:=LONGCARD(ABS(INTEGER(x1)-INTEGER(x2))+1); 2425 ywidth:=LONGCARD(ABS(INTEGER(y1)-INTEGER(y2))+1); 2426 Size:=((xwidth DIV 8)+1) * ywidth * LONGCARD(CoreGraph._current_video.bitsperpixel); 2427 RETURN Size+HEADER_SIZE; 2428 END ImageSize; 2429 2430 PROCEDURE Cube(top: BOOLEAN; x1, y1, x2, y2, depth: CARDINAL; Color: CARDINAL; Fill: BOOLEAN); 2431 2432 VAR 2433 px, py: ARRAY [0..3] OF CARDINAL; 2434 height: CARDINAL; 2435 FillVal: BOOLEAN; 2436 BEGIN 2437 GEnter(); 2438 FillVal:=FillState; 2439 FillState:=Fill; 2440 CoreGraph._fgcolor:=Color; 2441 height:=y2-y1; 2442 px[0]:=x2; 2443 py[0]:=y2; 2444 px[1]:=x2+depth; 2445 py[1]:=y2-(depth>>1); 2446 px[2]:=px[1]; 2447 py[2]:=py[1]-height; 2448 px[3]:=px[0]; 2449 py[3]:=py[0]-height; 2450 Polygon(4, px, py, Color); 2451 IF top THEN 2452 px[0]:=x1; 2453 py[0]:=y1; 2454 px[1]:=x1+depth; 2455 py[1]:=y1-(depth>>1); 2456 DEC(px[2]); 2457 DEC(px[3]); 2458 Polygon(4, px, py, Color); 2459 END; 2460 Rectangle(x1, y1, x2, y2, Color, Fill); 2461 FillState:=FillVal; 2462 GExit(); 2463 END Cube; 2464 2465 CONST 2466 MaxPts = 20; 2467 VAR 2468 xord: ARRAY [0..MaxPts] OF CARDINAL; 2469 x: ARRAY [0..MaxPts] OF CARDINAL; 2470 2471 PROCEDURE QuickSort(l,r: INTEGER); 2472 VAR 2473 i,j,temp : INTEGER; 2474 key : CARDINAL; 2475 BEGIN 2476 WHILE ( l < r ) DO 2477 i := l; j := r; key := x[xord[j]]; 2478 REPEAT 2479 WHILE ( i < j ) AND ( x[xord[i]] <= key ) DO i := i + 1 END; 2480 WHILE ( i < j ) AND ( key <= x[xord[j]] ) DO j := j - 1 END; 2481 IF i < j THEN 2482 temp := xord[i]; xord[i] := xord[j]; xord[j] := temp; 2483 END; 2484 UNTIL ( i >= j ); 2485 temp := xord[i]; xord[i] := xord[r]; xord[r] := temp; 2486 IF (i-l < r-i) THEN 2487 QuickSort( l, i-1 ); l := i+1; 2488 ELSE 2489 QuickSort( i+1, r ); r := i-1; 2490 END; 2491 END; 2492 END QuickSort; 2493 2494 PROCEDURE Polygon(n: CARDINAL; px, py: ARRAY OF CARDINAL; Color: CARDINAL); 2495 2496 VAR 2497 y, miny, maxy, x0, y0, x1, y1: INTEGER; 2498 temp, i, edge, next_edge, active: INTEGER; 2499 e: ARRAY [0..MaxPts] OF INTEGER; 2500 plotl, plotr: INTEGER; 2501 Mask: CARDINAL; 2502 BEGIN 2503 IF n > MaxPts THEN RETURN END; 2504 GEnter(); 2505 CoreGraph._fgcolor:=Color; 2506 i:=0; 2507 WHILE i < INTEGER(n) DO 2508 IF i < INTEGER(n-1) THEN 2509 CoreGraph._line(px[i], py[i], px[i+1], py[i+1], CoreGraph._current_linestyle); 2510 ELSE 2511 CoreGraph._line(px[i], py[i], px[0], py[0], CoreGraph._current_linestyle); 2512 END; 2513 INC(i); 2514 END; 2515 IF FillState = _GBORDER THEN 2516 GExit(); 2517 RETURN; 2518 END; 2519 miny:=py[0]; (* find extremal y points *) 2520 maxy:=miny; 2521 i:=0; 2522 WHILE i < INTEGER(n) DO 2523 IF INTEGER(py[i]) < miny THEN 2524 miny:=py[i]; 2525 END; 2526 IF INTEGER(py[i]) > maxy THEN 2527 maxy:=py[i]; 2528 END; 2529 INC(i); 2530 END; 2531 y:=miny; 2532 WHILE y <= maxy DO 2533 active:=-1; 2534 edge:= 0; 2535 WHILE edge < INTEGER(n) DO 2536 IF edge = INTEGER(n-1) THEN 2537 next_edge:=0; 2538 ELSE 2539 next_edge:=edge+1; 2540 END; 2541 x0:=px[edge]; 2542 y0:=py[edge]; 2543 x1:=px[next_edge]; 2544 y1:=py[next_edge]; 2545 IF y0 > y1 THEN 2546 temp:=x0; 2547 x0:=x1; 2548 x1:=temp; 2549 temp:=y0; 2550 y0:=y1; 2551 y1:=temp; 2552 END; 2553 IF y = y0 THEN 2554 e[edge]:=0; 2555 x[edge]:=x0; 2556 ELSIF (y0 <= y) AND (y <= y1) THEN 2557 IF x1 >= x0 THEN (* x increases with y *) 2558 INC(e[edge], (2*(x1-x0))); 2559 WHILE e[edge] > (y1-y0) DO 2560 DEC(e[edge], (2*(y1-y0))); 2561 INC(x[edge]); 2562 END; 2563 ELSE (* x decreases with y *) 2564 INC(e[edge], (2*(x0-x1))); 2565 WHILE e[edge] > (y1-y0) DO 2566 DEC(e[edge], (2*(y1-y0))); 2567 DEC(x[edge]); 2568 END; 2569 END; 2570 INC(active); 2571 xord[active]:=edge; 2572 END; 2573 INC(edge); 2574 END; 2575 QuickSort(0, active); 2576 i:=0; 2577 WHILE i < active DO 2578 plotl:=x[xord[i]]+1; 2579 plotr:=x[xord[i+1]]-1; 2580 IF plotr >= plotl THEN 2581 CoreGraph._fgcolor:=Color; 2582 Mask:=CARDINAL(CoreGraph._fill_mask[y MOD 8]) 2583 +CARDINAL(CoreGraph._fill_mask[y MOD 8])*100H; 2584 IF Mask = MAX(CARDINAL) THEN 2585 CoreGraph._hline(plotl, y, plotr, Color); 2586 ELSE 2587 CoreGraph._line(plotl, y, plotr, y, Mask); 2588 END; 2589 END; 2590 INC(i, 2); 2591 END; 2592 INC(y); 2593 END; (* for y = .. *) 2594 GExit(); 2595 END Polygon; 2596 2597 2598 PROCEDURE GraphMode(); 2599 2600 BEGIN 2601 (*%T AutoDetect *) 2602 CASE CoreGraph._current_video.adapter OF 2603 | _HGC : 2604 Width:=HercWidth; 2605 Depth:=HercDepth; 2606 NumColor:=HercNumColor; 2607 IF SetVideoMode(_HERCMONO) THEN END; 2608 | _CGA, _MCGA: 2609 Width:=CGAWidth; 2610 Depth:=CGADepth; 2611 NumColor:=CGANumColor; 2612 IF SetVideoMode(_MRES4COLOR) THEN END; 2613 | _EGA, _VGA : 2614 Width:=EGAWidth; 2615 Depth:=EGADepth; 2616 NumColor:=EGANumColor; 2617 IF SetVideoMode(_ERESCOLOR) THEN END; 2618 ELSE 2619 RETURN; 2620 END; 2621 (*%E *) 2622 (*%F AutoDetect *) 2623 CoreGraph._display_state:=TRUE; 2624 IF StaticMode = _HERCMONO THEN 2625 HercGraphMode(); 2626 ELSE 2627 CoreGraph._setbiosmode(StaticMode); 2628 END; 2629 CoreGraph._current_video.mode:= StaticMode; 2630 SetLimits(CoreGraph._current_video); 2631 CoreGraph._lastmode:=StaticMode; 2632 (*%E *) 2633 END GraphMode; 2634 2635 PROCEDURE TextMode(); 2636 2637 BEGIN 2638 (*%T AutoDetect *) 2639 IF SetVideoMode(_DEFAULTMODE) THEN END; 2640 (*%E *) 2641 (*%F AutoDetect *) 2642 CoreGraph._display_state:=FALSE; 2643 IF StaticMode = _HERCMONO THEN 2644 HercTextMode(); 2645 ELSE 2646 CoreGraph._setbiosmode(CoreGraph._defaultmode); 2647 END; 2648 CoreGraph._current_video.mode:= CoreGraph._defaultmode; 2649 SetLimits(CoreGraph._current_video); 2650 CoreGraph._lastmode:=CoreGraph._defaultmode; 2651 (*%E *) 2652 END TextMode; 2653 2654 PROCEDURE InitCGA(); 2655 2656 BEGIN 2657 InternalInitCGA(_MRES4COLOR); 2658 CoreGraph._current_video.adapter := _CGA; 2659 StaticMode:=_MRES4COLOR; 2660 Width:=CGAWidth; 2661 Depth:=CGADepth; 2662 NumColor:=CGANumColor; 2663 END InitCGA; 2664 2665 PROCEDURE InitEGA(); 2666 2667 BEGIN 2668 InternalInitEGA(_ERESCOLOR); 2669 CoreGraph._current_video.adapter := _EGA; 2670 StaticMode:=_ERESCOLOR; 2671 Width:=EGAWidth; 2672 Depth:=EGADepth; 2673 NumColor:=EGANumColor; 2674 END InitEGA; 2675 2676 PROCEDURE InitVGA(); 2677 2678 BEGIN 2679 InternalInitVGA256(); 2680 CoreGraph._current_video.adapter := _VGA; 2681 StaticMode:=_MRES256COLOR; 2682 Width:=VGA256Width; 2683 Depth:=VGA256Depth; 2684 NumColor:=VGANumColor; 2685 END InitVGA; 2686 2687 PROCEDURE InitHerc(); 2688 2689 BEGIN 2690 InternalInitHerc(); 2691 CoreGraph._current_video.adapter := _HGC; 2692 StaticMode:=_HERCMONO; 2693 Width:=HercWidth; 2694 Depth:=HercDepth; 2695 NumColor:=HercNumColor; 2696 END InitHerc; 2697 2698 2699 PROCEDURE InitGraph(); 2700 VAR 2701 display : CoreGraph.VideoType; 2702 Disp : CARDINAL; 2703 BEGIN 2704 CoreGraph._defaultmode := CoreGraph._getvideomode(); 2705 CoreGraph._lastmode := CoreGraph._defaultmode; 2706 CoreGraph._current_video.mode := CoreGraph._defaultmode; 2707 SetLimits(CoreGraph._current_video); 2708 CoreGraph._getsystem(display); 2709 Disp := SetActivePage(0); 2710 Disp := SetVisualPage(0); 2711 CASE display.sys0 OF 2712 MDA : CoreGraph._current_video.adapter:=_MDPA; | 2713 CGA : CoreGraph._current_video.adapter:=_CGA; 2714 Width:=CGAWidth; 2715 Depth:=CGADepth; 2716 NumColor:=CGANumColor; | 2717 EGA : CoreGraph._current_video.adapter:=_EGA; 2718 CoreGraph._current_video.memory:=CoreGraph._getmemory(); 2719 IF (CoreGraph._current_video.memory = 64 )THEN 2720 CoreGraph._EGA64K:=TRUE; 2721 END; (*IF*) 2722 Width:=EGAWidth; 2723 Depth:=EGADepth; 2724 NumColor:=EGANumColor; | 2725 MCGA : CoreGraph._current_video.adapter:=_MCGA; 2726 CoreGraph._current_video.memory:=CoreGraph._getmemory(); 2727 Width:=CGAWidth; 2728 Depth:=CGADepth; 2729 NumColor:=CGANumColor; | 2730 VGA : CoreGraph._current_video.adapter:=_VGA; 2731 CoreGraph._current_video.memory:=CoreGraph._getmemory(); 2732 Width := VGAWidth; 2733 Depth := VGADepth; 2734 NumColor:=EGANumColor; | 2735 HGC : CoreGraph._current_video.adapter:=_HGC; 2736 CoreGraph._current_video.memory:=64; 2737 Width:=HercWidth; 2738 Depth:=HercDepth; 2739 NumColor:=HercNumColor; | 2740 HGCPlus, 2741 InColor : CoreGraph._current_video.adapter:=-1; | 2742 END; (*CASE*) 2743 CASE display.dis0 OF 2744 | MDADisplay: 2745 CoreGraph._current_video.monitor:=_MONO; 2746 | CGADisplay: 2747 CoreGraph._current_video.monitor:=_COLOR; 2748 | EGAColorDisplay: 2749 CoreGraph._current_video.monitor:=_ENHCOLOR; 2750 | PS2MonoDisplay: 2751 CoreGraph._current_video.monitor:=_MONO; 2752 | PS2ColorDisplay: 2753 CoreGraph._current_video.monitor:=_ANALOG; 2754 END; 2755 END InitGraph; 2756 2757 PROCEDURE TrueDisc(x0,y0,r: CARDINAL; c: CARDINAL); 2758 VAR b:CARDINAL; 2759 BEGIN 2760 IF CoreGraph._width=CGAWidth-1 THEN b := (r*5)DIV 6; 2761 ELSIF CoreGraph._depth=EGADepth-1 THEN b := (r*73)DIV 100; 2762 ELSE b := r; 2763 END; 2764 Ellipse (x0,y0,r,b,c,TRUE) ; 2765 END TrueDisc; 2766 2767 PROCEDURE TrueCircle(x0,y0,r: CARDINAL; c: CARDINAL); 2768 VAR b:CARDINAL; 2769 BEGIN 2770 IF CoreGraph._width=CGAWidth-1 THEN b := (r*5)DIV 6; 2771 ELSIF CoreGraph._depth=EGADepth-1 THEN b := (r*73)DIV 100; 2772 ELSE b := r; 2773 END; 2774 Ellipse (x0,y0,r,b,c,FALSE) ; 2775 END TrueCircle; 2776 2777 VAR 2778 C: PROC; 2779 2780 PROCEDURE GraphTerminate(); 2781 2782 BEGIN 2783 IF (CoreGraph._display_state = TRUE) AND (ModeChanged = TRUE) THEN 2784 IF SetVideoMode(_DEFAULTMODE) THEN END; 2785 END; 2786 C; 2787 END GraphTerminate; 2788 2789 (*%E _XTDDOS *) 2790 2791 (*%F _XTDDOS *) 2792 PROCEDURE GenericGraphMode; 2793 VAR r : CARDINAL; 2794 BitMap : CARDINAL; 2795 BEGIN 2796 WHILE GraphI.Virtual DO Lib.Delay(100) END; 2797 GraphI.CurMode.b := SIZE(GraphI.CurMode); 2798 GraphI.CurMode.col := 80; 2799 GraphI.CurMode.row := 25; 2800 GraphI.CurMode.hres := Width; 2801 GraphI.CurMode.vres := Depth; 2802 IF Width0 THEN 2952 DEC(y) ; 2953 DEC(dy,asq2) ; 2954 DEC(d,dy) ; 2955 END ; 2956 INC(x) ; 2957 INC(dx,bsq2) ; 2958 INC(d,bsq+dx) ; 2959 END ; 2960 INC(d,(3*(asq-bsq)DIV 2-(dx+dy))DIV 2) ; 2961 WHILE INTEGER(y)>=0 DO 2962 IF fill THEN 2963 HLine(x0-x,y0+y,x0+x,c); 2964 HLine(x0-x,y0-y,x0+x,c); 2965 ELSE 2966 Plot(x0+x,y0+y,c) ; 2967 Plot(x0-x,y0+y,c) ; 2968 Plot(x0+x,y0-y,c) ; 2969 Plot(x0-x,y0-y,c) ; 2970 END ; 2971 IF d<0 THEN 2972 INC(x) ; 2973 INC(dx,bsq2) ; 2974 INC(d,dx) ; 2975 END ; 2976 DEC(y) ; 2977 DEC(dy,asq2) ; 2978 INC(d,asq-dy) ; 2979 END ; 2980 END Ellipse ; 2981 2982 PROCEDURE Polygon(n: CARDINAL; px,py: ARRAY OF CARDINAL; c: CARDINAL); 2983 BEGIN 2984 GraphI.Polygon(n,px,py,c); 2985 END Polygon; 2986 2987 2988 VAR 2989 SwapStack : ARRAY [0..1023] OF BYTE; 2990 SwapThread : CARDINAL; 2991 2992 PROCEDURE SwapProcess; 2993 VAR r,action,svs : CARDINAL; 2994 BEGIN 2995 GraphI.Virtual := FALSE; 2996 Lib.OSFatalError('Dos.SetPrty', 2997 Dos.SetPrty(2,3,0,SwapThread)); 2998 LOOP 2999 Lib.OSFatalError('Vio.SavRedrawWait', 3000 Vio.SavRedrawWait(0,action,0)); 3001 IF GraphI.GraphM THEN 3002 IF (action=1)AND GraphI.Virtual THEN (* restore *) 3003 Dos.EnterCritSec; 3004 GraphI.VideoSel := svs; 3005 GraphI.Virtual := FALSE; 3006 GraphI.RestoreScreen; 3007 Dos.ExitCritSec; 3008 r := Vio.SetMode(GraphI.CurMode,0); 3009 ELSIF (action=0)AND NOT GraphI.Virtual THEN (* save *) 3010 Dos.EnterCritSec; 3011 svs := GraphI.VideoSel; 3012 GraphI.SaveScreen; 3013 GraphI.VideoSel := SYSTEM.Seg(GraphI.Buffer[0]^); 3014 GraphI.Virtual := TRUE; 3015 Dos.ExitCritSec; 3016 Lib.Delay(100); (* wait for pending operations to finish *) 3017 END; 3018 END; 3019 END; 3020 END SwapProcess; 3021 3022 3023 PROCEDURE GraphMode; 3024 3025 BEGIN 3026 GraphI.G_GraphMode; 3027 END GraphMode; 3028 3029 PROCEDURE TextMode; 3030 BEGIN 3031 GraphI.G_TextMode; 3032 END TextMode; 3033 3034 3035 PROCEDURE InitCGA ; 3036 VAR 3037 r : CARDINAL; 3038 sl : Vio.PHYSBUF; 3039 BEGIN 3040 sl.bufaddr := 0B8000H; 3041 sl.buflen := 004000H; 3042 r := Vio.GetPhysBuf(sl,0); 3043 GraphI.VideoSel := sl.sel[0]; 3044 Width := CGAWidth ; 3045 Depth := CGADepth ; 3046 NumColor := 4 ; 3047 GraphI.G_TextMode := CGATextMode ; 3048 GraphI.G_GraphMode := CGAGraphMode ; 3049 GraphI.G_Plot := CGAPlot ; 3050 GraphI.G_Point := CGAPoint ; 3051 GraphI.G_HLine := CGAHLine ; 3052 IF GraphI.Buffer[0]=FarNIL THEN 3053 Storage.FarAllocate(GraphI.Buffer[0], GraphI.BitMapSize); 3054 END; 3055 GraphI.IsCGA := TRUE; 3056 END InitCGA ; 3057 3058 3059 PROCEDURE InitEGA ; 3060 VAR 3061 BitMap : CARDINAL; 3062 r : CARDINAL; 3063 sl : Vio.PHYSBUF; 3064 BEGIN 3065 FOR BitMap := 0 TO GraphI.MaxBitMap DO 3066 IF GraphI.Buffer[BitMap]=FarNIL THEN 3067 Storage.FarAllocate(GraphI.Buffer[BitMap], GraphI.BitMapSize); 3068 END; 3069 END; 3070 sl.bufaddr := 0A0000H; 3071 sl.buflen := 010000H; 3072 r := Vio.GetPhysBuf(sl,0); 3073 GraphI.VideoSel := sl.sel[0]; 3074 Width := EGAWidth ; 3075 Depth := EGADepth ; 3076 Depth := EGADepth; 3077 NumColor := 16 ; 3078 GraphI.G_TextMode := CGATextMode ; 3079 GraphI.G_GraphMode := EGAGraphMode ; 3080 GraphI.G_Plot := EGAPlot ; 3081 GraphI.G_Point := EGAPoint ; 3082 GraphI.G_HLine := EGAHLine ; 3083 GraphI.IsCGA := FALSE; 3084 END InitEGA ; 3085 3086 3087 PROCEDURE Plot(x,y: CARDINAL; Color: CARDINAL); 3088 3089 BEGIN 3090 GraphI.G_Plot(x, y, Color); 3091 END Plot; 3092 3093 3094 PROCEDURE Point(x,y: CARDINAL) : CARDINAL; 3095 3096 BEGIN 3097 RETURN GraphI.G_Point(x, y); 3098 END Point; 3099 3100 3101 PROCEDURE HLine(x,y,x2: CARDINAL; FillColor: CARDINAL); 3102 3103 BEGIN 3104 GraphI.G_HLine(x, y, x2, FillColor); 3105 END HLine; 3106 3107 3108 PROCEDURE NotSupported(Func: ARRAY OF CHAR); 3109 3110 VAR 3111 Msg: ARRAY [0..79] OF CHAR; 3112 BEGIN 3113 Str.Concat(Msg, Func, ': Not Supported Under OS2.'); 3114 Lib.RunTimeError(CoreSig._FatalErrorPos(), 0D1H, Msg); 3115 END NotSupported; 3116 3117 PROCEDURE GetVideoConfig(VAR V: VideoConfig); 3118 3119 BEGIN 3120 NotSupported('GetVideoConfig'); 3121 END GetVideoConfig; 3122 3123 PROCEDURE SetClipRgn(x1, y1, x2, y2: CARDINAL); 3124 3125 BEGIN 3126 NotSupported('SetClipRgn'); 3127 END SetClipRgn; 3128 3129 PROCEDURE GetBkColor(): LONGCARD; 3130 3131 BEGIN 3132 NotSupported('GetBkColor'); 3133 RETURN 0; 3134 END GetBkColor; 3135 3136 PROCEDURE GetFillMask(VAR Mask: FillMaskType); 3137 3138 BEGIN 3139 NotSupported('GetFillMask'); 3140 END GetFillMask; 3141 3142 PROCEDURE GetLinestyle(): CARDINAL; 3143 3144 BEGIN 3145 NotSupported( 'GetLineStyle'); 3146 RETURN 0; 3147 END GetLinestyle; 3148 3149 PROCEDURE SetBkColor(Color: LONGCARD): LONGCARD; 3150 3151 BEGIN 3152 NotSupported( 'SetBkColor'); 3153 RETURN 0; 3154 END SetBkColor; 3155 3156 PROCEDURE SetFillMask(Mask: FillMaskType); 3157 3158 BEGIN 3159 NotSupported( 'SetFillMask'); 3160 END SetFillMask; 3161 3162 PROCEDURE SetLinestyle(Mask: CARDINAL); 3163 3164 BEGIN 3165 NotSupported( 'SetLinestyle'); 3166 END SetLinestyle; 3167 3168 PROCEDURE GetTextColor(): CARDINAL; 3169 3170 BEGIN 3171 NotSupported( 'GetTextColor'); 3172 RETURN 0; 3173 END GetTextColor; 3174 3175 PROCEDURE GetTextPosition(): TextCoords; 3176 3177 BEGIN 3178 NotSupported( 'GetTextPosition'); 3179 RETURN TextCoords(0,0); 3180 END GetTextPosition; 3181 3182 PROCEDURE DisplayCursor(Mode: BOOLEAN): BOOLEAN; 3183 3184 BEGIN 3185 NotSupported( 'DisplayCursor'); 3186 RETURN FALSE; 3187 END DisplayCursor; 3188 3189 PROCEDURE SetTextPosition(row, col: CARDINAL): TextCoords; 3190 3191 BEGIN 3192 NotSupported( 'SetTextPosition'); 3193 RETURN TextCoords(0,0); 3194 END SetTextPosition; 3195 3196 PROCEDURE SetTextWindow(r1, c1, r2, c2: CARDINAL); 3197 3198 BEGIN 3199 NotSupported( 'SetTextWindow'); 3200 END SetTextWindow; 3201 3202 PROCEDURE Wrapon(Opt: BOOLEAN): BOOLEAN; 3203 3204 BEGIN 3205 NotSupported( 'Wrapon'); 3206 RETURN FALSE; 3207 END Wrapon; 3208 3209 PROCEDURE OutText(Text: ARRAY OF CHAR); 3210 3211 BEGIN 3212 NotSupported( 'OutText'); 3213 END OutText; 3214 3215 PROCEDURE SetVideoMode(Mode: CARDINAL): BOOLEAN; 3216 3217 BEGIN 3218 NotSupported( 'SetVideoMode'); 3219 RETURN FALSE; 3220 END SetVideoMode; 3221 3222 PROCEDURE SetActivePage(Page: CARDINAL): CARDINAL; 3223 3224 BEGIN 3225 NotSupported('SetActivePage'); 3226 RETURN 0; 3227 END SetActivePage; 3228 3229 PROCEDURE SetVisualPage(Page: CARDINAL): CARDINAL; 3230 3231 BEGIN 3232 NotSupported( 'SetVisualPage'); 3233 RETURN 0; 3234 END SetVisualPage; 3235 3236 PROCEDURE ClearScreen(Area: CARDINAL); 3237 3238 BEGIN 3239 NotSupported( 'ClearScreen'); 3240 END ClearScreen; 3241 3242 PROCEDURE Rectangle(x1, y1, x2, y2: CARDINAL; Color: CARDINAL;Fill: BOOLEAN); 3243 3244 BEGIN 3245 NotSupported( 'Rectangle'); 3246 END Rectangle; 3247 3248 PROCEDURE Arc(x1, y1, x2, y2, x3, y3, x4, y4: CARDINAL; Color: CARDINAL); 3249 3250 BEGIN 3251 NotSupported( 'Arc'); 3252 END Arc; 3253 3254 PROCEDURE Pie(x1, y1, x2, y2, x3, y3, x4, y4: CARDINAL; Colr: CARDINAL; Fill: BOOLEAN); 3255 3256 BEGIN 3257 NotSupported( 'Pie'); 3258 END Pie; 3259 3260 PROCEDURE FloodFill(x, y: CARDINAL; Color: CARDINAL; Boundary: CARDINAL); 3261 3262 BEGIN 3263 NotSupported( 'FloodFill'); 3264 END FloodFill; 3265 3266 PROCEDURE StackFill(x, y: CARDINAL; Color: CARDINAL; Boundary: CARDINAL); 3267 3268 BEGIN 3269 NotSupported( 'StackFill'); 3270 END StackFill; 3271 3272 PROCEDURE RemapPalette(Pixel: CARDINAL; Color: LONGCARD): LONGCARD; 3273 3274 BEGIN 3275 NotSupported( 'RemapPalette'); 3276 RETURN 0; 3277 END RemapPalette; 3278 3279 PROCEDURE RemapAllPalette(Colarray: ARRAY OF LONGCARD): CARDINAL; 3280 3281 BEGIN 3282 NotSupported( 'RemapAllPalette'); 3283 RETURN 0; 3284 END RemapAllPalette; 3285 3286 PROCEDURE SelectPalette(Palnum: CARDINAL): CARDINAL; 3287 3288 BEGIN 3289 NotSupported( 'SelectPalette'); 3290 RETURN 0; 3291 END SelectPalette; 3292 3293 PROCEDURE GetImage(x1, y1, x2, y2: CARDINAL; Buffer: ADDRESS); 3294 3295 BEGIN 3296 NotSupported( 'GetImage'); 3297 END GetImage; 3298 3299 PROCEDURE PutImage(x, y: CARDINAL; Buffer: ADDRESS; Action: CARDINAL); 3300 3301 BEGIN 3302 NotSupported( 'PutImage'); 3303 END PutImage; 3304 3305 PROCEDURE ImageSize(x1, y1, x2, y2: CARDINAL): LONGCARD; 3306 3307 BEGIN 3308 NotSupported( 'ImageSize'); 3309 RETURN 0; 3310 END ImageSize; 3311 3312 PROCEDURE Cube(top: BOOLEAN; x1, y1, x2, y2, depth: CARDINAL; Color: CARDINAL; Fill: BOOLEAN); 3313 3314 BEGIN 3315 NotSupported( 'Cube'); 3316 END Cube; 3317 3318 PROCEDURE InitHerc(); 3319 3320 BEGIN 3321 NotSupported( 'InitHerc'); 3322 END InitHerc; 3323 3324 PROCEDURE InitGraph(); 3325 3326 BEGIN 3327 NotSupported( 'InitGraph'); 3328 END InitGraph; 3329 3330 PROCEDURE SetTextColor(Col: CARDINAL): CARDINAL; 3331 3332 BEGIN 3333 NotSupported( 'SetTextColor'); 3334 RETURN 0; 3335 END SetTextColor; 3336 3337 PROCEDURE Init; 3338 VAR 3339 i,r : CARDINAL; 3340 BEGIN 3341 GraphI.GraphM := FALSE; 3342 r := Dos.CreateThread(Dos.THREAD(SwapProcess),SwapThread,FarADR(SwapStack[HIGH(SwapStack)])); 3343 FOR i := 0 TO 4 DO 3344 GraphI.Buffer[i] := FarNIL; 3345 END; 3346 InitCGA; 3347 END Init; 3348 3349 (*%E _XTDDOS *) 3350 3351 BEGIN (*Initialization*) 3352 (*%T _XTDDOS *) 3353 (*%T _XTD *) 3354 TSXLIB.InitInt10; 3355 (*%E *) 3356 (*%T AutoDetect *) 3357 InitGraph(); 3358 (*%E *) 3359 (*%F AutoDetect *) 3360 InitCGA; 3361 (*%E *) 3362 Lib.Terminate(GraphTerminate, C); 3363 FillState:=_GFILLINTERIOR; 3364 ModeChanged := FALSE; 3365 EGATable := EGATableType( 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15); 3366 (*%E *) 3367 (*%F _XTDDOS *) 3368 (*%F _fcall *) 3369 IO.WrStr('OS/2 Graphics Not Supported In This Model.'); 3370 IO.WrLn; 3371 HALT; 3372 (*%E *) 3373 Init; 3374 (*%E _XTDDOS *) 3375 END Graph. 720 errors