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<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<= 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; 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 dx0 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