| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678 |
- Listing:
- 1 (* Release 3.10 *)
- 2 (*-------------------------------------------------------------------------*
- 3 * *
- 4 * GRAPHI.MOD - OS/2 graphics functions requiring IOPL *
- 5 * *
- 6 * COPYRIGHT (C) 1987..1992 Clarion Software Corporation. *
- 7 * All Rights Reserved *
- 8 * *
- 9 *--------------------------------------------------------------------------*)
- 10
- 11 (*# call(o_a_copy=>off) *)
- 12 (*# module(implementation=>off) *)
- 13 (*%F _fdata *)
- 14 (*# data(seg_name => null) *)
- 15 (*%E *)
- 16 (*# check(stack=>off,
- 17 index=>off,
- 18 range=>off,
- 19 overflow=>off,
- 20 nil_ptr=>off) *)
- 21
- 22 IMPLEMENTATION MODULE GraphI;
- 23
- 24 (*# call(near_call=>off,
- 25 seg_name=>GRAPH_IOPL,
- 26 iopl=>on) *)
- 27
- 28 IMPORT Graph, Dos;
- 29
- 30 CONST
- 31 CGAWidth = 320 ;
- 32 CGADepth = 200 ;
- 33 CGANumColor = 4 ;
- 34 EGAWidth = 640 ;
- 35 EGADepth = 350 ;
- 36 VGAWidth = 640 ;
- 37 VGADepth = 350 ;
- 38 EGANumColor = 16 ;
- 39 VGA256Width = 320 ;
- 40 VGA256Depth = 200 ;
- 41 VGANumColor = 16 ;
- 42
- 43 CONST
- 44 HercWidth = 720 ;
- 45 HercDepth = 348 ;
- 46 HercNumColor = 2 ;
- 47 ATTWidth = 640 ;
- 48 ATTDepth = 400 ;
- 49 ATTNumColor = 2 ;
- 50
- 51
- 52 PROCEDURE SaveScreen;
- 53 VAR
- 54 BitMap : CARDINAL;
- 55 bp : CGABuffPtr;
- ***** ^ undeclared identifier
- 56 BEGIN
- 57 IF IsCGA THEN
- ***** ^ undeclared identifier
- 58 bp := FarADR(CBuffer);
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- 59 GRCopy(bp, [VideoSel:0 CGABuffPtr], 4000H);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 60 ELSE
- 61 FOR BitMap := 0 TO MaxBitMap DO
- ***** ^ undeclared identifier
- 62 Out(3CEH,4);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 63 Out(3CFH,SHORTCARD(BitMap));
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 64 GRCopy(Buffer[BitMap], [VideoSel:0 BMP], BitMapSize);
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- 65 END;
- 66 END;
- 67 END SaveScreen;
- ***** ^ not supported yet
- 68
- 69
- 70 PROCEDURE RestoreScreen();
- 71 VAR
- 72 BitMap : CARDINAL;
- 73 BEGIN
- 74 IF IsCGA THEN
- ***** ^ undeclared identifier
- 75 GRCopy([VideoSel:0 CGABuffPtr], FarADR(CBuffer), 4000H);
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 76 ELSE
- 77 FOR BitMap := 0 TO MaxBitMap DO
- ***** ^ undeclared identifier
- 78 Out( 3C4H,2);Out( 3C5H,SHORTCARD(1<<BitMap));
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 79 GRCopy([VideoSel:0 BMP], Buffer[BitMap], BitMapSize);
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- 80 END;
- 81 END ;
- 82 END RestoreScreen;
- ***** ^ not supported yet
- 83
- 84
- 85 PROCEDURE EGAPlot( x,y,c : CARDINAL); (* Also VGA *)
- 86 VAR
- 87 (*# save, data(volatile=>on) *)
- 88 t:BS;
- ***** ^ undeclared identifier
- 89 (*# restore *)
- 90 p,b,s,i,bi:CARDINAL;
- 91 BEGIN
- 92 IF (x < EGAWidth) AND (y < Graph.Depth) THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- 93 bi := (7-(x MOD 8));
- 94 p := y*80+(x DIV 8);
- 95 IF Virtual THEN
- ***** ^ undeclared identifier
- 96 FOR i := 0 TO 3 DO
- 97 IF i IN BS(c) THEN
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 98 INCL(BS(Buffer[i]^[p]),bi)
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 99 ELSE
- 100 EXCL(BS(Buffer[i]^[p]),bi);
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 101 END;
- 102 END;
- 103 ELSE
- 104 b := 1 << bi;
- 105
- 106 Out( 3CEH,8);Out( 3CFH,SHORTCARD(b));
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 107 Out( 3C4H,2);Out( 3C5H,0FH);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 108 s := VideoSel;
- ***** ^ undeclared identifier
- 109 t := [s:p BP]^;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 110 [s:p BP]^ := BS{};
- 111 Out( 3C4H,2);Out( 3C5H,SHORTCARD(c));
- 112 [s:p BP]^ := BS{0..7};
- 113 Out( 3CEH,8);Out( 3CFH,0FFH);
- 114 Out( 3C4H,2);Out( 3C5H,0FH);
- 115
- 116 END;
- 117 END;
- 118 END EGAPlot;
- 119
- 120 PROCEDURE EGAPoint(x,y:CARDINAL) : CARDINAL; (* Also VGA *)
- 121 VAR
- 122 t:BS;
- 123 p,b,s,i:CARDINAL;
- 124 c:CARDINAL;
- 125 BEGIN
- 126 c := 0;
- 127 IF (x < EGAWidth) AND (y < Graph.Depth) THEN
- 128 b := 1 << (7-(x MOD 8));
- 129 p := y*80+(x DIV 8 );
- 130
- 131 IF Virtual THEN
- 132 FOR i := 3 TO 0 BY -1 DO
- 133 t := BS(Buffer[i]^[p])*BS(b);
- 134 c := c * 2 + CARDINAL( SHORTCARD(t) );
- 135 END;
- 136 ELSE
- 137 s := VideoSel;
- 138
- 139 Out( 3CEH, 4 ); (* read map sel *)
- 140
- 141 Out( 3CFH, 3 );
- 142 t := [s:p BP]^;
- 143 t := t * BS(b);
- 144 c := CARDINAL( SHORTCARD(t) );
- 145
- 146 Out( 3CFH, 2 );
- 147 t := [s:p BP]^;
- 148 t := t * BS(b);
- 149 c := c * 2 + CARDINAL( SHORTCARD(t) );
- 150
- 151 Out( 3CFH, 1 );
- 152 t := [s:p BP]^;
- 153 t := t * BS(b);
- 154 c := c * 2 + CARDINAL( SHORTCARD(t) );
- 155
- 156 Out( 3CFH, 0 );
- 157 t := [s:p BP]^;
- 158 t := t * BS(b);
- 159 c := c * 2 + CARDINAL( SHORTCARD(t) );
- 160
- 161 END;
- 162 c := c >> ( 7 - ( x MOD 8 ) );
- 163 END;
- 164 RETURN c;
- 165 END EGAPoint;
- 166
- 167 PROCEDURE EGAHLine ( x,y,x2 : CARDINAL; c:CARDINAL ); (* Also VGA *)
- 168 VAR c1,c2,i : CARDINAL;
- 169 BEGIN
- 170 IF y >= Graph.Depth THEN RETURN END;
- 171 IF INTEGER(x) >= INTEGER(EGAWidth) THEN RETURN END;
- 172 IF INTEGER(x) < 0 THEN x := 0; END;
- 173 IF x2 >= EGAWidth THEN x2 := EGAWidth-1 END;
- 174 WHILE (x MOD 8 # 0) AND (x <= x2) DO
- 175 EGAPlot( x , y , c ); INC( x );
- 176 END;
- 177 WHILE (x2 MOD 8 # 7) AND (x <= x2) DO
- 178 EGAPlot( x2 , y , c ); DEC( x2 );
- 179 END;
- 180 IF INTEGER(x) > INTEGER(x2) THEN RETURN; END;
- 181 y := y*80;
- 182 x := x DIV 8;
- 183 x2 := x2 DIV 8;
- 184 IF Virtual THEN
- 185 INC(y,x);
- 186 WHILE x <= x2 DO
- 187 FOR i := 0 TO 3 DO
- 188 IF i IN BS(c) THEN
- 189 Buffer[i]^[y] := BS{0..7};
- 190 ELSE
- 191 Buffer[i]^[y] := BS{};
- 192 END;
- 193 END;
- 194 INC( x );
- 195 INC( y );
- 196 END;
- 197 ELSE
- 198 Out( 3CEH,8);Out( 3CFH,0FFH);
- 199 Out( 3C4H,2);Out( 3C5H,0FH);
- 200 Out( 3CEH,5);Out( 3CFH,2);
- 201 WHILE x <= x2 DO
- 202 [VideoSel:y+x BP]^ := BS(c);
- 203 INC( x );
- 204 END;
- 205 END ;
- 206 Out( 3CEH,5);Out( 3CFH,0);
- 207 END EGAHLine;
- 208
- 209 (* -- CGA routines -- *)
- 210
- 211 PROCEDURE SaveCGAScreen;
- 212 BEGIN
- 213 GRCopy([VideoSel:0 CGABuffPtr], FarADR(CBuffer), 4000H);
- 214 END SaveCGAScreen;
- 215
- 216
- 217 PROCEDURE RestoreCGAScreen();
- 218 VAR
- 219 bp : CGABuffPtr;
- 220 BEGIN
- 221 bp := FarADR(CBuffer);
- 222 GRCopy(bp, [VideoSel:0 CGABuffPtr], 4000H);
- 223 END RestoreCGAScreen;
- 224
- 225
- 226 PROCEDURE CGAPlot(x,y:CARDINAL;c:CARDINAL);
- 227 VAR
- 228 off : CARDINAL;
- 229 seg : CARDINAL;
- 230 tmp : CARDINAL;
- 231 BEGIN
- 232 IF (x >= CGAWidth) OR (y >= CGADepth) THEN RETURN END;
- 233 off := x >> 2;
- 234 IF ODD(y) THEN INC( off, 2000H - 40 ) END;
- 235 INC( y, y << 2 );
- 236 INC( off, y << 3 );
- 237 x := 3 - CARDINAL( BITSET(x) * BITSET(3) );
- 238 x := x << 1;
- 239 seg := VideoSel;
- 240 [seg:off BP]^ := ( [seg:off BP]^ - BS(3<<x) ) + BS(c<<x);
- 241 END CGAPlot;
- 242
- 243 PROCEDURE CGAPoint(x,y:CARDINAL) : CARDINAL;
- 244 VAR
- 245 off : CARDINAL;
- 246 seg : CARDINAL;
- 247 tmp : CARDINAL;
- 248 BEGIN
- 249 IF (x >= CGAWidth) OR (y >= CGADepth) THEN RETURN MAX(CARDINAL) END;
- 250 off := x >> 2;
- 251 IF ODD(y) THEN INC( off, 2000H - 40 ) END;
- 252 INC( y, y << 2 );
- 253 INC( off, y << 3 );
- 254 x := 3 - CARDINAL( BITSET(x) * BITSET(3) );
- 255 x := x << 1;
- 256 seg := VideoSel;
- 257 RETURN CARDINAL( [seg:off BP]^ * BS(3<<x) ) >> x;
- 258 END CGAPoint;
- 259
- 260 PROCEDURE CGAHLine ( x,y,x2 : CARDINAL; c:CARDINAL );
- 261 VAR
- 262 off : CARDINAL;
- 263 seg : CARDINAL;
- 264 tmp : CARDINAL;
- 265 n,i : CARDINAL;
- 266 w : BS;
- 267 mask : BS;
- 268 fillc: SHORTCARD;
- 269 BEGIN
- 270 IF y > CGADepth-1 THEN RETURN END;
- 271 IF INTEGER(x) >= INTEGER(CGAWidth) THEN RETURN END;
- 272 IF INTEGER(x) < 0 THEN x := 0; END;
- 273 IF x2 >= CGAWidth THEN x2 := CGAWidth-1 END;
- 274
- 275 n := ( x2 - x ) + 1;
- 276 off := x >> 2;
- 277 IF ODD(y) THEN
- 278 INC( off, 2000H - 40 );
- 279 c := ( c >> 2 + c << 2 ) MOD 16;
- 280 END;
- 281 c := c + c * 16;
- 282 INC( y, y << 2 );
- 283 INC( off, y << 3 );
- 284 x := 3 - CARDINAL( BITSET(x) * BITSET(3) );
- 285 x := x << 1;
- 286 seg := VideoSel;
- 287
- 288 w := [seg:off BP]^;
- 289 REPEAT
- 290 mask := BS(3 << x);
- 291 w := ( w - mask ) + BS(c)*mask;
- 292 DEC(n);
- 293 DEC(x,2);
- 294 UNTIL (n=0) OR (x=CARDINAL(-2));
- 295 [seg:off BP]^ := w;
- 296
- 297 INC(off);
- 298 FOR i := 1 TO (n>>2) DO
- 299 [seg:off BP]^ := BS(c);
- 300 INC(off);
- 301 END;
- 302 n := n MOD 4;
- 303 x := 6;
- 304 w := [seg:off BP]^;
- 305 WHILE n <> 0 DO
- 306 mask := BS(3 << x);
- 307 w := ( w - mask ) + BS(c)*mask;
- 308 DEC(n);
- 309 DEC(x,2);
- 310 END;
- 311 [seg:off BP]^ := w;
- 312 END CGAHLine;
- 313
- 314 PROCEDURE Plot( x,y,c : CARDINAL); (* CGA/EGA/VGA *)
- 315 BEGIN
- 316 IF IsCGA THEN
- 317 CGAPlot(x,y,c);
- 318 ELSE
- 319 EGAPlot(x,y,c);
- 320 END;
- 321 END Plot;
- 322
- 323
- 324 PROCEDURE HLine ( x,y,x2 : CARDINAL; c:CARDINAL ); (* CGA/EGA/VGA *)
- 325 BEGIN
- 326 IF IsCGA THEN
- 327 CGAHLine(x,y,x2,c);
- 328 ELSE
- 329 EGAHLine(x,y,x2,c);
- 330 END;
- 331 END HLine;
- 332
- 333
- 334 PROCEDURE Line(x1,y1,x2,y2: CARDINAL; c: CARDINAL);
- 335 VAR
- 336 dx,dy,e,tmp : INTEGER;
- 337 BEGIN
- 338 IF x1 > x2 THEN (* ensure that x2 >= x1 *)
- 339 tmp := x1; x1 := x2; x2 := tmp;
- 340 tmp := y1; y1 := y2; y2 := tmp;
- 341 END;
- 342
- 343 dx := x2-x1;
- 344 e := 0;
- 345 IF y1 <= y2 THEN (* case where y increases *)
- 346 dy := (y2-y1);
- 347 IF dx >= dy THEN
- 348 LOOP
- 349 Plot( x1,y1,c );
- 350 IF x1 = x2 THEN EXIT END;
- 351 INC(x1);
- 352 INC(e,dy);
- 353 INC(e,dy);
- 354 IF e > dx THEN
- 355 DEC(e,dx);
- 356 DEC(e,dx);
- 357 INC(y1);
- 358 END;
- 359 END;
- 360 ELSE
- 361 LOOP
- 362 Plot( x1,y1,c );
- 363 IF y1 = y2 THEN EXIT END;
- 364 INC(y1);
- 365 INC(e,dx);
- 366 INC(e,dx);
- 367 IF e > dy THEN
- 368 DEC(e,dy);
- 369 DEC(e,dy);
- 370 INC(x1);
- 371 END;
- 372 END;
- 373 END;
- 374 ELSE
- 375 (* case where y decreases *)
- 376 dy := (y1-y2);
- 377 IF dx >= dy THEN
- 378 LOOP
- 379 Plot( x1,y1,c );
- 380 IF x1 = x2 THEN EXIT END;
- 381 INC(x1);
- 382 INC(e,dy);
- 383 INC(e,dy);
- 384 IF e > dx THEN
- 385 DEC(e,dx);
- 386 DEC(e,dx);
- 387 DEC(y1);
- 388 END;
- 389 END;
- 390 ELSE
- 391 LOOP
- 392 Plot( x1,y1,c );
- 393 IF y1 = y2 THEN EXIT END;
- 394 DEC(y1);
- 395 INC(e,dx);
- 396 INC(e,dx);
- 397 IF e > dy THEN
- 398 DEC(e,dy);
- 399 DEC(e,dy);
- 400 INC(x1);
- 401 END;
- 402 END;
- 403 END;
- 404 END;
- 405 END Line;
- 406
- 407
- 408 CONST
- 409 dx = 2;
- 410 dy = 2;
- 411
- 412 PROCEDURE Disc(x0,y0,r: CARDINAL; c: CARDINAL);
- 413 VAR
- 414 e : INTEGER;
- 415 x,y : CARDINAL;
- 416 BEGIN
- 417 x := r; y := 0; e := 0;
- 418 WHILE INTEGER(y) <= INTEGER(x) DO
- 419 HLine(x0-x,y0+y,x0+x,c);
- 420 HLine(x0-x,y0-y,x0+x,c);
- 421 INC(y);
- 422 INC(e,y*dy-1);
- 423 IF e > INTEGER(x) THEN
- 424 DEC(x);
- 425 DEC(e,x*dx+1);
- 426 HLine(x0-y,y0+x,x0+y,c);
- 427 HLine(x0-y,y0-x,x0+y,c);
- 428 END;
- 429 END;
- 430 END Disc;
- 431
- 432 PROCEDURE Circle(x0,y0,r: CARDINAL; c: CARDINAL);
- 433 VAR
- 434 e : INTEGER;
- 435 x,y : CARDINAL;
- 436 BEGIN
- 437 x := r; y := 0; e := 0;
- 438 WHILE INTEGER(y) <= INTEGER(x) DO
- 439 Plot(x0+x,y0+y,c);
- 440 Plot(x0-x,y0+y,c);
- 441 Plot(x0+x,y0-y,c);
- 442 Plot(x0-x,y0-y,c);
- 443 Plot(x0+y,y0+x,c);
- 444 Plot(x0-y,y0+x,c);
- 445 Plot(x0+y,y0-x,c);
- 446 Plot(x0-y,y0-x,c);
- 447 INC(y);
- 448 INC(e,y*dy-1);
- 449 IF e > INTEGER(x) THEN
- 450 DEC(x);
- 451 DEC(e,x*dx+1);
- 452 END;
- 453 END;
- 454 END Circle;
- 455
- 456 PROCEDURE Ellipse ( x0,y0 : CARDINAL ; (* center *)
- 457 a0,b0 : CARDINAL ; (* semi-axes *)
- 458 c : CARDINAL ; (* color *)
- 459 fill : BOOLEAN ) ; (* wether filled *)
- 460 VAR
- 461 x,y : CARDINAL ;
- 462 a,b : LONGINT ;
- 463 asq,asq2,bsq,bsq2 : LONGINT ;
- 464 d,dx,dy : LONGINT ;
- 465 BEGIN
- 466 x := 0 ;
- 467 y := b0 ;
- 468 a := LONGINT(a0) ;
- 469 b := LONGINT(b0) ;
- 470 asq := a*a ;
- 471 asq2 := asq*2 ;
- 472 bsq := b*b ;
- 473 bsq2 := bsq*2 ;
- 474 d := bsq-(asq*b)+(asq DIV 4) ;
- 475 dx := 0 ;
- 476 dy := asq2*b ;
- 477 WHILE dx<dy DO
- 478 IF fill THEN
- 479 HLine(x0-x,y0+y,x0+x,c);
- 480 HLine(x0-x,y0-y,x0+x,c);
- 481 ELSE
- 482 Plot(x0+x,y0+y,c) ;
- 483 Plot(x0-x,y0+y,c) ;
- 484 Plot(x0+x,y0-y,c) ;
- 485 Plot(x0-x,y0-y,c) ;
- 486 END ;
- 487 IF d>0 THEN
- 488 DEC(y) ;
- 489 DEC(dy,asq2) ;
- 490 DEC(d,dy) ;
- 491 END ;
- 492 INC(x) ;
- 493 INC(dx,bsq2) ;
- 494 INC(d,bsq+dx) ;
- 495 END ;
- 496 INC(d,(3*(asq-bsq)DIV 2-(dx+dy))DIV 2) ;
- 497 WHILE INTEGER(y)>=0 DO
- 498 IF fill THEN
- 499 HLine(x0-x,y0+y,x0+x,c);
- 500 HLine(x0-x,y0-y,x0+x,c);
- 501 ELSE
- 502 Plot(x0+x,y0+y,c) ;
- 503 Plot(x0-x,y0+y,c) ;
- 504 Plot(x0+x,y0-y,c) ;
- 505 Plot(x0-x,y0-y,c) ;
- 506 END ;
- 507 IF d<0 THEN
- 508 INC(x) ;
- 509 INC(dx,bsq2) ;
- 510 INC(d,dx) ;
- 511 END ;
- 512 DEC(y) ;
- 513 DEC(dy,asq2) ;
- 514 INC(d,asq-dy) ;
- 515 END ;
- 516 END Ellipse ;
- 517
- 518
- 519 PROCEDURE Polygon(n: CARDINAL; px,py: ARRAY OF CARDINAL; c: CARDINAL);
- 520 CONST
- 521 MaxPts = 20;
- 522 VAR
- 523 y,miny,maxy,x0,y0,x1,y1,temp,i,edge,next_edge,active : INTEGER;
- 524 xord : ARRAY [0..MaxPts] OF INTEGER;
- 525 x : ARRAY [0..MaxPts] OF CARDINAL;
- 526 e : ARRAY [0..MaxPts] OF INTEGER;
- 527
- 528 (*# save *)
- 529 (*# call(reg_saved=>(ax,bx,cx,ds,si,di,st1,st2)) *)
- 530 PROCEDURE quicksort(l,r: INTEGER);
- 531 VAR
- 532 i,j,temp : INTEGER;
- 533 key : CARDINAL;
- 534 BEGIN
- 535 WHILE ( l < r ) DO
- 536 i := l; j := r; key := x[xord[j]];
- 537 REPEAT
- 538 WHILE ( i < j ) AND ( x[xord[i]] <= key ) DO i := i + 1 END;
- 539 WHILE ( i < j ) AND ( key <= x[xord[j]] ) DO j := j - 1 END;
- 540 IF i < j THEN
- 541 temp := xord[i]; xord[i] := xord[j]; xord[j] := temp;
- 542 END;
- 543 UNTIL ( i >= j );
- 544 temp := xord[i]; xord[i] := xord[r]; xord[r] := temp;
- 545 IF (i-l < r-i) THEN
- 546 quicksort( l, i-1 ); l := i+1;
- 547 ELSE
- 548 quicksort( i+1, r ); r := i-1;
- 549 END;
- 550 END;
- 551 END quicksort;
- 552 (*# restore *)
- 553
- 554 BEGIN
- 555 IF n > MaxPts THEN n := MaxPts END;
- 556
- 557 (* find extremal y points *)
- 558 miny := py[0]; maxy := miny;
- 559 FOR i := 0 TO n-1 DO
- 560 IF INTEGER(py[i]) < miny THEN miny := py[i]; END;
- 561 IF INTEGER(py[i]) > maxy THEN maxy := py[i]; END;
- 562 END;
- 563
- 564 FOR y := miny TO maxy DO
- 565 active := -1;
- 566 FOR edge := 0 TO n-1 DO
- 567 IF edge = INTEGER(n-1) THEN next_edge := 0 ELSE next_edge := edge + 1; END;
- 568 x0 := px[edge]; y0 := py[edge];
- 569 x1 := px[next_edge]; y1 := py[next_edge];
- 570 IF y0 > y1 THEN temp := x0; x0 := x1; x1 := temp;
- 571 temp := y0; y0 := y1; y1 := temp END;
- 572 IF y = y0 THEN e[edge] := 0; x[edge] := x0
- 573 ELSIF ( y0 <= y ) AND ( y <= y1 ) THEN
- 574 IF x1 >= x0 THEN (* x increases with y *)
- 575 INC( e[edge], 2*(x1-x0) );
- 576 WHILE e[edge] > INTEGER(y1-y0) DO
- 577 DEC( e[edge], 2*(y1-y0) ); INC(x[edge]);
- 578 END;
- 579 ELSE (* x decreases with y *)
- 580 INC( e[edge], 2*(x0-x1) );
- 581 WHILE e[edge] > INTEGER(y1-y0) DO
- 582 DEC( e[edge], 2*(y1-y0) ); DEC(x[edge]);
- 583 END;
- 584 END;
- 585 active := active + 1;
- 586 xord[active] := edge;
- 587 END;
- 588 END;
- 589 quicksort(0,active);
- 590 i := 0;
- 591 WHILE i < active DO
- 592 HLine( x[xord[i]], y, x[xord[i+1]], c );
- 593 i := i + 2;
- 594 END;
- 595 END; (* for y := .. *)
- 596 END Polygon;
- 597
- 598 BEGIN
- 599 Dos.PortAccess(0, 0, 3C4H, 3C5H);
- 600 Dos.PortAccess(0, 0, 3CEH, 3CFH);
- 601 END GraphI.
- 71 errors
|