1unit Graph; 2 3{ ********************************************************************* 4 5 Info: 6 7 This units mimics some parts of borland's graph unit for 8 Amiga. 9 10 You have to use crt for readln, readkey and stuff like 11 that for your programs. When the show is over you should 12 just press a key or hit return to close everything down. 13 14 If that doesn't work just flip the screens with left-Amiga n 15 and activate the shell you started from. 16 17 I have compiled and run mandel.pp without any problems. 18 19 This version requires Free Pascal 0.99.5c or higher. 20 21 It will also use some amigaunits, when the unit gets 22 better we can remove those units. 23 24 Large parts have not yet been implemented or tested. 25 26 nils.sjoholm@mailbox.swipnet.se (Nils Sjoholm) 27 28 History: 29 30 Date Version Who Comments 31 ---------- -------- ------- ------------------------------------- 32 27-Nov-98 0.1 nsjoholm Initial version. 33 34 License Conditions: 35 36 This library is free software; you can redistribute it and/or 37 modify it under the terms of the GNU Library General Public 38 License as published by the Free Software Foundation; either 39 version 2 of the License, or (at your option) any later version. 40 41 This library is distributed in the hope that it will be useful, 42 but WITHOUT ANY WARRANTY; without even the implied warranty of 43 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 44 Library General Public License for more details. 45 46 You should have received a copy of the GNU Library General Public 47 License along with this library; if not, write to the Free 48 Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 49 50 51 *********************************************************************} 52 53 54interface 55 56uses Exec, Intuition, Graphics, Utility; 57 58{ --------------------------------------------------------------------- 59 Constants 60 61 ---------------------------------------------------------------------} 62 63const 64 NormalPut = 0; 65 CopyPut = 0; 66 XORPut = 1; 67 ORPut = 2; 68 ANDPut = 3; 69 NotPut = 4; 70 BackPut = 8; 71 72 Black = 0; 73 Blue = 1; 74 Green = 2; 75 Cyan = 3; 76 Red = 4; 77 Magenta = 5; 78 Brown = 6; 79 LightGray = 7; 80 DarkGray = 8; 81 LightBlue = 9; 82 LightGreen = 10; 83 LightCyan = 11; 84 LightRed = 12; 85 LightMagenta = 13; 86 Yellow = 14; 87 White = 15; 88 Border = 16; 89 90 SolidLn = 0; 91 DottedLn = 1; 92 CenterLn = 2; 93 DashedLn = 3; 94 UserBitLn = 4; 95 96 EmptyFill = 0; 97 SolidFill = 1; 98 LineFill = 2; 99 LtSlashFill = 3; 100 SlashFill = 4; 101 BkSlashFill = 5; 102 LtBkSlashFill = 6; 103 HatchFill = 7; 104 XHatchFill = 8; 105 InterleaveFill = 9; 106 WideDotFill = 10; 107 CloseDotFill = 11; 108 UserFill = 12; 109 110 NormWidth = 1; 111 ThickWidth = 3; 112 113const 114 LeftText = 0; 115 CenterText = 1; 116 RightText = 2; 117 BottomText = 0; 118 TopText = 2; 119 BaseLine = 3; 120 LeadLine = 4; 121 122const 123 { Error codes } 124 grOK = 0; 125 grNoInitGraph = -1; 126 grNotDetected = -2; 127 grFileNotFound = -3; 128 grInvalidDriver = -4; 129 grNoLOadMem = -5; 130 grNoScanMem = -6; 131 grNoFloodMem = -7; 132 grFontNotFound = -8; 133 grNoFontMem = -9; 134 grInvalidmode = -10; 135 grError = -11; 136 grIOerror = -12; 137 grInvalidFont = -13; 138 grInvalidFontNum = -14; 139 140Type 141 FillPatternType = array[1..8] of byte; 142 143 ArcCoordsType = record 144 x,y : integer; 145 xstart,ystart : integer; 146 xend,yend : integer; 147 end; 148 149 RGBColor = record 150 r,g,b,i : byte; 151 end; 152 153 154 PaletteType = record 155 Size : integer; 156 Colors : array[0..767]of Byte; 157 end; 158 159 160 LineSettingsType = record 161 linestyle : word; 162 pattern : word; 163 thickness : word; 164 end; 165 166 TextSettingsType = record 167 font : word; 168 direction : word; 169 charsize : word; 170 horiz : word; 171 vert : word; 172 end; 173 174 FillSettingsType = record 175 pattern : word; 176 color : longint; 177 end; 178 179 PointType = record 180 x,y : integer; 181 end; 182 183 ViewPortType = record 184 x1,y1,x2,y2 : integer; 185 Clip : boolean; 186 end; 187 188 const 189 fillpattern : array[0..12] of FillPatternType = ( 190 ($00,$00,$00,$00,$00,$00,$00,$00), { Hintergrundfarbe } 191 ($ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff), { Vordergrundfarbe } 192 ($ff,$ff,$00,$00,$ff,$ff,$00,$00), { === } 193 ($01,$02,$04,$08,$10,$20,$40,$80), { /// } 194 ($07,$0e,$1c,$38,$70,$e0,$c1,$83), { /// als dicke Linien } 195 ($07,$83,$c1,$e0,$70,$38,$1c,$0e), { \\\ als dicke Linien } 196 ($5a,$2d,$96,$4b,$a5,$d2,$69,$b4), { \ \\ \ } 197 ($ff,$88,$88,$88,$ff,$88,$88,$88), { K�stchen } 198 ($18,$24,$42,$81,$81,$42,$24,$18), { Rauten } 199 ($cc,$33,$cc,$33,$cc,$33,$cc,$33), { "Mauermuster" } 200 ($80,$00,$08,$00,$80,$00,$08,$00), { weit auseinanderliegende Punkte } 201 ($88,$00,$22,$00,$88,$00,$22,$00), { dichte Punkte} 202 (0,0,0,0,0,0,0,0) { benutzerdefiniert } 203 ); 204 205 206 207 208 209{ --------------------------------------------------------------------- 210 Function Declarations 211 212 ---------------------------------------------------------------------} 213 214{ Retrieving coordinates } 215function GetX: Integer; 216function GetY: Integer; 217 218{ Pixel-oriented routines } 219procedure PutPixel(X, Y: Integer; Pixel: Word); 220function GetPixel(X, Y: Integer): Integer; 221 222{ Line-oriented primitives } 223procedure LineTo(X, Y: Integer); 224procedure LineRel(Dx, Dy: Integer); 225procedure MoveTo(X, Y: Integer); 226procedure MoveRel(Dx, Dy: Integer); 227procedure Line(x1, y1, x2, y2: Integer); 228 229{ Linearly bounded primitives } 230procedure Rectangle(x1, y1, x2, y2: Integer); 231procedure Bar(x1, y1, x2, y2: Integer); 232procedure Bar3D(x1, y1, x2, y2: Integer; Depth: Word; Top: Boolean); 233procedure FloodFill(X, Y: Integer; Border: Word); 234 235{ Nonlinearly bounded primitives } 236 237procedure Arc(X, Y: Integer; StAngle, EndAngle, Radius: Word); 238procedure GetArcCoords(var ArcCoords: ArcCoordsType); 239procedure Circle(X, Y: Integer; Radius: Word); 240procedure Ellipse(X, Y: Integer; StAngle, EndAngle: Word; XRadius, YRadius : Word); 241procedure FillEllipse(X, Y: Integer; XRadius, YRadius : Word); 242procedure SetAspectRatio(Xasp, Yasp: Word); 243procedure PieSlice(X, Y: Integer; StAngle, EndAngle, Radius: Word); 244procedure Sector(X, Y: Integer; StAngle, EndAngle, XRadius, YRadius: Word); 245 246{ Color routines } 247procedure SetBkColor(ColorNum: Word); 248procedure SetColor(Color: Word); 249Function GetBkColor : Word; 250Function GetColor : Word; 251function GetMaxColor : Word; 252 253function GetMaxX : Integer; 254function GetMAxY : Integer; 255function GetAspect: Real; 256procedure GetAspectRatio(var x,y : Word); 257 258{ Graph clipping method } 259Procedure ClearViewPort; 260 261function GraphResult: Integer; 262 263{ For compatibility } 264Procedure InitGraph (Var Driver,Mode : Integer;DriverPath : String); 265Procedure CloseGraph; 266 267const 268 NoGraphics: Boolean = false; 269 270 { VGA modes } 271 GTEXT = 0; { Compatible with VGAlib v1.2 } 272 G320x200x16 = 1; 273 G640x200x16 = 2; 274 G640x350x16 = 3; 275 G640x480x16 = 4; 276 G320x200x256 = 5; 277 G320x240x256 = 6; 278 G320x400x256 = 7; 279 G360x480x256 = 8; 280 G640x480x2 = 9; 281 282 G640x480x256 = 10; 283 G800x600x256 = 11; 284 G1024x768x256 = 12; 285 286 G1280x1024x256 = 13; { Additional modes. } 287 288 G320x200x32K = 14; 289 G320x200x64K = 15; 290 G320x200x16M = 16; 291 G640x480x32K = 17; 292 G640x480x64K = 18; 293 G640x480x16M = 19; 294 G800x600x32K = 20; 295 G800x600x64K = 21; 296 G800x600x16M = 22; 297 G1024x768x32K = 23; 298 G1024x768x64K = 24; 299 G1024x768x16M = 25; 300 G1280x1024x32K = 26; 301 G1280x1024x64K = 27; 302 G1280x1024x16M = 28; 303 304 G800x600x16 = 29; 305 G1024x768x16 = 30; 306 G1280x1024x16 = 31; 307 308 G720x348x2 = 32; { Hercules emulation mode } 309 310 G320x200x16M32 = 33; { 32-bit per pixel modes. } 311 G640x480x16M32 = 34; 312 G800x600x16M32 = 35; 313 G1024x768x16M32 = 36; 314 G1280x1024x16M32 = 37; 315 316 { additional resolutions } 317 G1152x864x16 = 38; 318 G1152x864x256 = 39; 319 G1152x864x32K = 40; 320 G1152x864x64K = 41; 321 G1152x864x16M = 42; 322 G1152x864x16M32 = 43; 323 324 G1600x1200x16 = 44; 325 G1600x1200x256 = 45; 326 G1600x1200x32K = 46; 327 G1600x1200x64K = 47; 328 G1600x1200x16M = 48; 329 G1600x1200x16M32 = 49; 330 331 GLASTMODE = 49; 332 333 334implementation 335 336{$I tagutils.inc} 337 338{ --------------------------------------------------------------------- 339 Types, constants and variables 340 341 ---------------------------------------------------------------------} 342VAR GraphScr :pScreen; 343 GraphWin :pWindow; 344 CurrentRastPort : pRastPort; 345 TheAspect : Real; 346 GraphResultCode : Integer; 347 348 Msg :pIntuiMessage; 349 Ende :Boolean; 350 351var 352 DrawDelta: TPoint; 353 CurX, CurY: Integer; 354 TheColor, TheFillColor: LongInt; 355 IsVirtual: Boolean; 356 ColorTable: array[0..15] of LongInt; 357 TheFillPattern : FillPatternType; 358 TheLineSettings : LineSettingsType; 359 ThePalette : PaletteType; 360 TheTextSettings : TextSettingsType; 361 TheFillSettings : FillSettingsType; 362 363const 364 BgiColors: array[0..15] of LongInt 365 = ($000000, $000080, $008000, $008080, 366 $800000, $800080, $808000, $C0C0C0, 367 $808080, $0000FF, $00FF00, $00FFFF, 368 $FF0000, $FF00FF, $FFFF00, $FFFFFF); 369 370const 371 DoUseMarker: Boolean = true; 372 TheMarker: Char = '~'; 373 TextColor: LongInt = 15; 374 MarkColor: LongInt = 15; 375 BackColor: LongInt = 0; 376 FontWidth: Integer = 8; 377 FontHeight: Integer = 8; 378 379var 380 sHoriz, sVert: Word; 381 382{ initialisierte Variablen } 383const 384 SourcePage: Word = 0; 385 DestPage: Word = 0; 386 387{ Retrieves the capabilities for the current mode } 388const 389 vmcImage = 1; 390 vmcCopy = 2; 391 vmcSaveRestore = 4; 392 vmcBuffer = 8; 393 vmcBackPut = 16; 394 395{ --------------------------------------------------------------------- 396 Graphics Vision Layer 397 ---------------------------------------------------------------------} 398 399 400{ Types and constants } 401var 402 SizeX, SizeY: Word; 403 404{ Font attributes } 405const 406 ftNormal = 0; 407 ftBold = 1; 408 ftThin = 2; 409 ftItalic = 4; 410 411var 412 sFont, sColor:Word; 413 sCharSpace: Integer; 414{ Not used 415 sMarker: Char; 416 sAttr: Word; } 417 418{ Bitmap utilities } 419type 420 PBitmap = ^TBitmap; 421 TBitmap = record 422 Width, Height: Integer; 423 Data: record end; 424 end; 425 426 427const 428 pbNone = 0; 429 pbCopy = 1; 430 pbClear = 2; 431 432procedure SetColors; 433begin 434 SetRGB4(@GraphScr^.ViewPort, Black , 0,0,0); 435 SetRGB4(@GraphScr^.ViewPort, Blue , 0,0,15); 436 SetRGB4(@GraphScr^.ViewPort, Green , 0,15,0); 437 SetRGB4(@GraphScr^.ViewPort, Cyan , 0,15,15); 438 SetRGB4(@GraphScr^.ViewPort, Red , 15,0,0); 439 SetRGB4(@GraphScr^.ViewPort, Magenta , 15,0,15); 440 SetRGB4(@GraphScr^.ViewPort, Brown , 6,2,0); 441 SetRGB4(@GraphScr^.ViewPort, LightGray, 13,13,13); 442 SetRGB4(@GraphScr^.ViewPort, DarkGray , 4,4,4); 443 SetRGB4(@GraphScr^.ViewPort, LightBlue, 5,5,5); 444 SetRGB4(@GraphScr^.ViewPort, LightGreen ,9,15,1); 445 SetRGB4(@GraphScr^.ViewPort, LightRed ,14,5,0); 446 SetRGB4(@GraphScr^.ViewPort, LightMagenta ,0,15,8); 447 SetRGB4(@GraphScr^.ViewPort, Yellow ,15,15,0); 448 SetRGB4(@GraphScr^.ViewPort, White ,15,15,15); 449end; 450 451 452{ --------------------------------------------------------------------- 453 Real graph implementation 454 ---------------------------------------------------------------------} 455 456function GraphResult: Integer; 457begin 458 GraphResult := GraphResultCode; 459end; 460 461Procedure ClearViewPort; 462begin 463 SetRast(CurrentRastPort,Black); 464end; 465 466function GetX: Integer; 467begin 468 GetX := CurX; 469end; 470 471function GetY: Integer; 472begin 473 GetY := CurY; 474end; 475 476function GetAspect: Real; 477begin 478 GetAspect := GetMaxY/GetMaxX; 479end; 480 481procedure GetAspectRatio(var x,y : Word); 482begin 483 x := GetMaxX; 484 y := GetMaxY; 485end; 486 487{ Pixel-oriented routines } 488procedure PutPixel(x,y : Integer; Pixel : Word); 489begin 490 SetAPen(CurrentRastPort,Pixel); 491 WritePixel(CurrentRastPort,x,y); 492 CurX := x; 493 CurY := y; 494end; 495 496function GetPixel(X, Y: Integer): Integer; 497begin 498 GetPixel := ReadPixel(CurrentRastPort,X,Y); 499end; 500 501{ Line-oriented primitives } 502 503procedure LineTo(X, Y: Integer); 504begin 505 Draw(CurrentRastPort,X,Y); 506 CurX := X; 507 CurY := Y; 508end; 509 510procedure LineRel(Dx, Dy: Integer); 511begin 512 CurX := CurX + Dx; 513 CurY := CurY + Dy; 514 Draw(CurrentRastPort, Curx, CurY); 515end; 516 517procedure MoveTo(X, Y: Integer); 518begin 519 Move(CurrentRastPort, X , Y); 520 CurX := X; 521 CurY := Y; 522end; 523 524procedure MoveRel(Dx, Dy: Integer); 525begin 526 CurX := CurX + Dx; 527 CurY := CurY + Dy; 528 Move(CurrentRastPort, Curx, CurY); 529end; 530 531procedure Line(x1,y1,x2,y2: Integer); 532begin 533 Move(CurrentRastPort,x1,y1); 534 Draw(CurrentRastPort,x2,y2); 535 Move(CurrentRastPort,CurX, CurY); 536end; 537 538procedure Rectangle(x1, y1, x2, y2: Integer); 539begin 540 Move(CurrentRastPort, x1, y1); 541 Draw(CurrentRastPort, x2, y1); 542 Draw(CurrentRastPort, x2, y2); 543 Draw(CurrentRastPort, x1, y2); 544 Draw(CurrentRastPort, x1, y1); 545 CurX := x1; 546 CurY := y1; 547end; 548 549procedure Bar(x1, y1, x2, y2: Integer); 550begin 551 RectFill(CurrentRastPort, x1, y1, x2, y2); 552 CurX := x1; 553 CurY := y1; 554end; 555 556procedure Bar3D(x1, y1, x2, y2: Integer; Depth: Word; Top: Boolean); 557begin 558 Bar(x1,y1,x2,y2); 559 Rectangle(x1,y1,x2,y2); 560 if top then begin 561 Moveto(x1,y1); 562 Lineto(x1+depth,y1-depth); 563 Lineto(x2+depth,y1-depth); 564 Lineto(x2,y1); 565 end; 566 Moveto(x2+depth,y1-depth); 567 Lineto(x2+depth,y2-depth); 568 Lineto(x2,y2); 569 570end; 571 572procedure FloodFill(X, Y: Integer; Border: Word); 573begin 574 575end; 576 577Var LastArcCoords : ArcCoordsType; 578 579 580procedure SetArcCoords (X,y,xradius,yradius,Stangle,endangle : integer); 581 582begin 583 LastArcCoords.X:=X; 584 LastArccOords.y:=y; 585 Lastarccoords.xstart:=x+round(xradius*cos(stangle*pi/180)); 586 Lastarccoords.ystart:=y-round(yradius*sin(stangle*pi/180)); 587 LastArccoords.xend:=x+round(xradius*cos(endangle*pi/180)); 588 LastArccoords.yend:=y-round(yradius*sin(endangle*pi/180)); 589end; 590 591 592procedure GetArcCoords(var ArcCoords: ArcCoordsType); 593 594begin 595 ArcCoords:=LastArcCoords; 596end; 597 598procedure Arc(X, Y: Integer; StAngle, EndAngle, Radius: Word); 599 600begin 601 Ellipse (X,y,stangle,endangle,Radius,radius); 602end; 603 604procedure Circle(X, Y: Integer; Radius: Word); 605begin 606 DrawEllipse(CurrentRastPort, x, y, Round(Radius * TheAspect), Radius); 607end; 608 609procedure Ellipse(X, Y: Integer; 610 StAngle, EndAngle: Word; XRadius, YRadius : Word); 611 612Var I : longint; 613 tmpang : real; 614 615begin 616 SetArcCoords (X,Y,xradius,yradius,Stangle,EndAngle); 617 For i:= StAngle To EndAngle Do 618 Begin 619 tmpAng:= i*Pi/180; 620 curX:= X + Round (xRadius*Cos (tmpAng)); 621 curY:= Y - Round (YRadius*Sin (tmpAng)); 622 PutPixel (curX, curY, TheColor); 623 End; 624end; 625 626procedure FillEllipse(X, Y: Integer; XRadius, YRadius : Word); 627 628Var I,tmpcolor : longint; 629 tmpang : real; 630 tmpx,tmpy : Integer; 631 632begin 633 tmpcolor:=Thecolor; 634 SetColor(TheFillColor); 635 For i:= 0 to 180 Do 636 Begin 637 tmpAng:= i*Pi/180; 638 curX:= Round (xRadius*Cos (tmpAng)); 639 curY:= Round (YRadius*Sin (tmpAng)); 640 tmpX:= X - curx; 641 tmpy:= Y + cury; 642 curx:=x+curx; 643 cury:=y-cury; 644 Line (curX, curY,tmpx,tmpy); 645 PutPixel (curx,cury,tmpcolor); 646 PutPixel (tmpx,tmpy,tmpcolor); 647 End; 648 SetColor(tmpcolor); 649end; 650 651procedure SetAspectRatio(Xasp, Yasp: Word); 652begin 653 //!! Needs implementing. 654end; 655 656procedure PieSlice(X, Y: Integer; StAngle, EndAngle, Radius: Word); 657 658Begin 659 sector (x,y,stangle,endangle,radius,radius); 660end; 661 662procedure Sector(X, Y: Integer; 663 StAngle, EndAngle, XRadius, YRadius: Word); 664 665Var I,tmpcolor : longint; 666 tmpang : real; 667 ac : arccoordstype; 668 669begin 670 tmpcolor:=Thecolor; 671 SetColor(TheFillColor); 672 For i:= stangle to endangle Do 673 Begin 674 tmpAng:= i*Pi/180; 675 curX:= x+Round (xRadius*Cos (tmpAng)); 676 curY:= y-Round (YRadius*Sin (tmpAng)); 677 Line (x,y,curX, curY); 678 PutPixel (curx,cury,tmpcolor); 679 End; 680 SetColor(tmpcolor); 681 getarccoords(ac); 682 Line (x,y,ac.xstart,ac.ystart); 683 Line (x,y,ac.xend,ac.yend); 684end; 685 686{ Color routines 687} 688 689procedure SetBkColor(ColorNum: Word); 690begin 691 SetBPen(CurrentRastPort, ColorNum); 692 BackColor := ColorNum; 693end; 694 695Function GetBkColor : Word; 696 697begin 698 GetBkColor:=BackColor; 699end; 700 701Function GetColor : Word; 702 703begin 704 GetColor:=TheColor; 705end; 706 707procedure SetColor(color : Word); 708begin 709 SetAPen(CurrentRastPort,color); 710 TheColor := color; 711end; 712 713function GetMaxColor: word; 714begin 715 GetMaxColor := 15; 716end; 717 718function GetMaxX: Integer; 719begin 720 GetMaxX := GraphWin^.Width; 721end; 722 723function GetMaxY: Integer; 724begin 725 GetMaxY := GraphWin^.Height; 726end; 727 728Procedure InitGraph (Var Driver,Mode : Integer;DriverPath : String); 729var 730 thetags : array[0..3] of tTagItem; 731 732BEGIN 733 GraphResultCode := grOK; 734 GfxBase := OpenLibrary(GRAPHICSNAME,0); 735 if GfxBase = nil then begin 736 GraphResultCode := grNoInitGraph; 737 Exit; 738 end; 739 740 GraphScr:=Nil; GraphWin:=Nil; 741 742 { Will open an hires interlace screen, if you 743 want just an hires screen change HIRESLACE_KEY 744 to HIRES_KEY 745 } 746 thetags[0] := TagItem(SA_Depth, 4); 747 thetags[1] := TagItem(SA_DisplayID, HIRESLACE_KEY); 748 thetags[2].ti_Tag := TAG_END; 749 750 GraphScr := OpenScreenTagList(NIL,@thetags); 751 If GraphScr=Nil Then begin 752 GraphResultCode := grNoInitGraph; 753 Exit; 754 end; 755 756 thetags[0] := TagItem(WA_Flags, WFLG_BORDERLESS); 757 thetags[1] := TagItem(WA_IDCMP, IDCMP_MOUSEBUTTONS); 758 thetags[2] := TagItem(WA_CustomScreen, Longint(GraphScr)); 759 thetags[3].ti_Tag := TAG_DONE; 760 761 GraphWin:=OpenWindowTagList(Nil, @thetags); 762 If GraphWin=Nil Then CloseGraph; 763 764 CurrentRastPort := GraphWin^.RPort; 765 766 SetColors; 767 TheAspect := GetAspect; 768END; 769 770PROCEDURE CloseGraph; 771BEGIN 772 { Ende:=false; 773 Repeat 774 Msg:=pIntuiMessage(GetMsg(GraphWin^.UserPort)); 775 If Msg<>Nil Then Begin 776 ReplyMsg(Pointer(Msg)); 777 Ende:=true; 778 End; 779 Until Ende;} 780 If GraphWin<>Nil Then 781 CloseWindow(GraphWin); 782 If (GraphScr<>Nil) then CloseScreen(GraphScr); 783 if GfxBase <> nil then CloseLibrary(GfxBase); 784 Halt; 785END; 786 787begin 788 789 CurX := 0; 790 CurY := 0; 791end. 792