UNIT portgraf; {written by Frank Riemenschneider Postfach 730309 3000 Hannover 71} {$M 5000,0,0} {$L a:portgraf.obj} INTERFACE PROCEDURE SetColor (Color : WORD); PROCEDURE CloseGraph; PROCEDURE InitGraph(VAR driver : integer; VAR mode : integer; path : string); PROCEDURE InitGraphic; PROCEDURE PutPixel (x, y : Integer; Color : word); PROCEDURE Line (x1, y1, x2, y2 : Integer); PROCEDURE Rectangle (x1, y1, x2, y2 : Integer); PROCEDURE Bar (x1, y1, x2, y2 : Integer); PROCEDURE Circle (xm, ym : Integer; Radius : WORD); PROCEDURE Ellipse (xm, ym : Integer; AnfWinkel, EndWinkel, XRadius, YRadius : WORD); PROCEDURE Arc (xm, ym : Integer; AnfWinkel, EndWinkel, Radius : WORD); PROCEDURE ClearDevice; PROCEDURE Plot (x, y : WORD); PROCEDURE Box (x1, y1, x2, y2 : WORD); PROCEDURE Curve (xm, ym, xr, yr, AnfWinkel, EndWinkel : WORD); PROCEDURE FloodFill (x,y : Integer; border : word); PROCEDURE FillEllipse (xm, ym : Integer; XRadius, YRadius : word); PROCEDURE SetFillStyle (muster,color : word); FUNCTION GetColor : word; FUNCTION GetPixel (x, y : Integer) : word; FUNCTION TestPixel (x,y : word) : word; PROCEDURE Slice (xm, ym, xr, yr, AnfWinkel, EndWinkel : WORD); PROCEDURE Sector (xm,ym: Integer; AnfWinkel, EndWinkel, XRadius, YRadius : word); PROCEDURE PieSlice (xm,ym: Integer; AnfWinkel, EndWinkel, Radius: word); PROCEDURE Text (x, y, TextSeg, TextOfs : WORD); PROCEDURE OutTextXY(x,y : Integer; TextString : STRING); PROCEDURE SetTextStyle (font,direction,Sizex,Sizey : word); PROCEDURE Bar3D(x1,y1,x2,y2:integer; depth:word; top:boolean); PROCEDURE DrawPoly(NumPoints : word; VAR PolyPoints); PROCEDURE FillPoly(NumPoints : word; VAR PolyPoints); PROCEDURE MoveRel(dx,dy : integer); PROCEDURE MoveTo(x,y : integer); PROCEDURE LineRel(dx,dy : integer); PROCEDURE LineTo(x,y : integer); PROCEDURE Fill(x,y: integer; border : word); TYPE PointType = record x,y : word; END; CONST { Tabelle der Cosinus-Werte } costab : ARRAY [0..395] OF BYTE = ( 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99, 100, 101, 102, 102, 103, 104, 105, 106, 107, 108, 109, 110, 111, 112, 113, 114, 114, 115, 116, 117, 118, 119, 120, 121, 122, 122, 123, 124, 125, 126, 127, 128, 129, 130, 130, 131, 132, 133, 134, 135, 136, 136, 137, 138, 139, 140, 141, 142, 142, 143, 144, 145, 146, 147, 147, 148, 149, 150, 151, 152, 152, 153, 154, 155, 156, 156, 157, 158, 159, 160, 160, 161, 162, 163, 163, 164, 165, 166, 167, 167, 168, 169, 170, 170, 171, 172, 173, 173, 174, 175, 176, 176, 177, 178, 179, 179, 180, 181, 181, 182, 183, 184, 184, 185, 186, 186, 187, 188, 188, 189, 190, 190, 191, 192, 192, 193, 194, 194, 195, 196, 196, 197, 198, 198, 199, 200, 200, 201, 201, 202, 203, 203, 204, 204, 205, 206, 206, 207, 207, 208, 209, 209, 210, 210, 211, 212, 212, 213, 213, 214, 214, 215, 215, 216, 216, 217, 218, 218, 219, 219, 220, 220, 221, 221, 222, 222, 223, 223, 224, 224, 225, 225, 226, 226, 227, 227, 227, 228, 228, 229, 229, 230, 230, 231, 231, 231, 232, 232, 233, 233, 234, 234, 234, 235, 235, 235, 236, 236, 237, 237, 237, 238, 238, 238, 239, 239, 240, 240, 240, 241, 241, 241, 242, 242, 242, 243, 243, 243, 243, 244, 244, 244, 245, 245, 245, 245, 246, 246, 246, 247, 247, 247, 247, 248, 248, 248, 248, 248, 249, 249, 249, 249, 250, 250, 250, 250, 250, 251, 251, 251, 251, 251, 251, 252, 252, 252, 252, 252, 252, 253, 253, 253, 253, 253, 253, 253, 253, 254, 254, 254, 254, 254, 254, 254, 254, 254, 254, 254, 254, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255 ); {Bit-Daten des Zeichensatzes} daten : array[0..767] of byte = {ASCII 0} (0,0,0,0,0,0, {ASCII 1} 62,85,81,85,62,0, {ASCII 2} 62,107,111,107,62,0, {ASCII 3} 30,62,124,62,30,0, {ASCII 4} 8,28,62,28,8,0, {ASCII 5} 28,95,103,95,28,0, {ASCII 6} 28,94,127,94,28,0, {ASCII 7} 0,0,24,24,0,0, {ASCII 8} 255,255,231,231,255,255, {ASCII 9} 0,24,36,36,24,0, {ASCII 10} 255,231,219,219,231,255, {ASCII 11} 48,72,77,75,55,0, {ASCII 12} 6,41,121,41,6,0, {ASCII 13} 96,96,63,5,7,0, {ASCII 14} 96,127,5,53,63,0, {ASCII 15} 42,28,119,28,42,0, {ASCII 16} 127,62,28,8,8,0, {ASCII 17} 8,8,28,62,127,0, {ASCII 18} 20,54,127,54,20,0, {ASCII 19} 0,95,0,95,0,0, {ASCII 20} 6,9,127,1,127,0, {ASCII 21} 0,74,85,85,41,0, {ASCII 22} 112,112,112,112,112,0, {ASCII 23} 84,118,127,118,84,0, {ASCII 24} 4,6,127,6,4,0, {ASCII 25} 16,48,127,48,16,0, {ASCII 26} 8,8,42,28,8,0, {ASCII 27} 8,28,42,8,8,0, {ASCII 28} 60,32,32,32,0,0, {ASCII 29} 8,28,8,28,8,0, {ASCII 30} 32,56,62,56,32,0, {ASCII 31} 2,14,62,14,2,0, {ASCII 32} 0,0,0,0,0,0, {ASCII 33} 0,0,95,0,0,0, {ASCII 34} 0,3,0,3,0,0, {ASCII 35} 20,127,20,127,20,0, {ASCII 36} 36,42,107,42,18,0, {ASCII 37} 35,19,8,100,98,0, {ASCII 38} 54,73,85,34,80,0, {ASCII 39} 0,0,5,3,0,0, {ASCII 40} 0,28,34,65,0,0, {ASCII 41} 0,65,34,28,0,0, {ASCII 42} 20,8,62,8,20,0, {ASCII 43} 8,8,62,8,8,0, {ASCII 44} 0,0,80,48,0,0, {ASCII 45} 8,8,8,8,8,0, {ASCII 46} 0,0,96,96,0,0, {ASCII 47} 32,16,8,4,2,0, {ASCII 48} 62,81,73,69,62,0, {ASCII 49} 0,66,127,64,0,0, {ASCII 50} 66,97,81,73,70,0, {ASCII 51} 33,65,69,75,49,0, {ASCII 52} 24,20,18,127,16,0, {ASCII 53} 39,69,69,69,57,0, {ASCII 54} 60,74,73,73,48,0, {ASCII 55} 1,1,121,5,3,0, {ASCII 56} 54,73,73,73,54,0, {ASCII 57} 6,73,73,41,30,0, {ASCII 58} 0,0,54,54,0,0, {ASCII 59} 0,0,86,54,0,0, {ASCII 60} 0,8,20,34,65,0, {ASCII 61} 20,20,20,20,20,0, {ASCII 62} 65,34,20,8,0,0, {ASCII 63} 2,1,81,9,6,0, {ASCII 64} 62,65,73,85,14,0, {ASCII 65} 126,17,17,17,126,0, {ASCII 66} 127,74,74,74,54,0, {ASCII 67} 62,65,65,65,34,0, {ASCII 68} 127,65,65,34,28,0, {ASCII 69} 127,73,73,73,65,0, {ASCII 70} 127,9,9,9,1,0, {ASCII 71} 62,65,81,81,114,0, {ASCII 72} 127,8,8,8,127,0, {ASCII 73} 0,65,127,65,0,0, {ASCII 74} 32,64,65,63,1,0, {ASCII 75} 127,8,20,34,65,0, {ASCII 76} 127,64,64,64,64,0, {ASCII 77} 127,2,12,2,127,0, {ASCII 78} 127,4,8,16,127,0, {ASCII 79} 62,65,65,65,62,0, {ASCII 80} 127,9,9,9,6,0, {ASCII 81} 62,65,81,33,94,0, {ASCII 82} 127,9,25,41,70,0, {ASCII 83} 38,73,73,73,50,0, {ASCII 84} 1,1,127,1,1,0, {ASCII 85} 63,64,64,64,63,0, {ASCII 86} 31,32,64,32,31,0, {ASCII 87} 127,32,24,32,127,0, {ASCII 88} 99,20,8,20,99,0, {ASCII 89} 7,8,120,8,7,0, {ASCII 90} 97,81,73,69,67,0, {ASCII 91} 0,127,65,65,0,0, {ASCII 92} 2,4,8,16,32,0, {ASCII 93} 0,65,65,127,0,0, {ASCII 94} 4,2,1,2,4,0, {ASCII 95} 128,128,128,128,128,128, {ASCII 96} 0,3,5,0,0,0, {ASCII 97} 32,84,84,84,120,0, {ASCII 98} 127,72,68,68,56,0, {ASCII 99} 56,68,68,68,32,0, {ASCII 100} 56,68,68,72,127,0, {ASCII 101} 56,84,84,84,88,0, {ASCII 102} 8,126,9,9,2,0, {ASCII 103} 8,84,84,84,60,0, {ASCII 104} 127,8,4,4,120,0, {ASCII 105} 0,68,125,64,0,0, {ASCII 106} 32,64,68,61,0,0, {ASCII 107} 127,32,16,40,68,0, {ASCII 108} 0,65,127,64,0,0, {ASCII 109} 124,4,24,4,120,0, {ASCII 110} 124,8,4,4,120,0, {ASCII 111} 56,68,68,68,56,0, {ASCII 112} 124,20,20,20,8,0, {ASCII 113} 8,20,20,20,124,0, {ASCII 114} 124,8,4,4,8,0, {ASCII 115} 72,84,84,84,36,0, {ASCII 116} 4,63,68,68,32,0, {ASCII 117} 60,64,64,32,120,0, {ASCII 118} 28,32,64,32,28,0, {ASCII 119} 60,64,48,64,60,0, {ASCII 120} 68,40,16,40,68,0, {ASCII 121} 76,80,80,80,60,0, {ASCII 122} 68,100,84,76,68,0, {ASCII 123} 0,8,62,65,65,0, {ASCII 124} 0,0,119,0,0,0, {ASCII 125} 65,65,62,8,0,0, {ASCII 126} 2,1,3,2,1,0, {ASCII 127} 96,80,72,80,96,0); {Tabelle mit Zeilenanf„ngen des Video-RAMs} adrtab : ARRAY [0..63] OF WORD = (0, 30, 60, 90, 120, 150, 180, 210, 240, 270, 300, 330, 360, 390, 420, 450, 480, 510, 540, 570, 600, 630, 660, 690, 720, 750, 780, 810, 840, 870, 900, 930, 960, 990, 1020, 1050, 1080, 1110, 1140, 1170, 1200, 1230, 1260, 1290, 1320, 1350, 1380, 1410, 1440, 1470, 1500, 1530, 1560, 1590, 1620, 1650, 1680, 1710, 1740, 1770, 1800, 1830, 1860, 1890); VAR i, Farbe,fillmuster,fillcolor,ArcStartX, ArcStartY, ArcEndX, ArcEndY : WORD; zu, zl, su, sl, zch, spt, xver, yver : integer; gcursorx, gcursory : integer; IMPLEMENTATION {$F+} { Die Assembler-Routinen mssen als FAR-Routinen eingebunden werden } PROCEDURE InitGraphic; EXTERNAL; PROCEDURE CloseGraph; EXTERNAL; PROCEDURE Plot; EXTERNAL; PROCEDURE Line; EXTERNAL; PROCEDURE Box; EXTERNAL; PROCEDURE Bar; EXTERNAL; PROCEDURE Curve; EXTERNAL; PROCEDURE Slice; EXTERNAL; PROCEDURE Text; EXTERNAL; PROCEDURE Fill; EXTERNAL; FUNCTION TestPixel; EXTERNAL; {$F-} {Initialisiert Grafikmodus und schreibt Zeichensatz ins Videoram} PROCEDURE InitGraph(VAR driver : integer; VAR mode : integer; path : string); VAR i : word; BEGIN InitGraphic; FOR i:= 0 to 767 DO BEGIN Mem[$B000:$07D0+i] := daten[i]; END; END; {Setzt einen Pixel in der angegebenen Farbe} PROCEDURE PutPixel (x, y : Integer; Color : word); BEGIN Farbe := Color; Plot(x, y); END; {Testet einen Pixel auf seine Farbe} FUNCTION GetPixel (x, y : Integer) : WORD; BEGIN GetPixel := TestPixel(x,y); END; {Setzt die Zeichenfarbe fr die weiteren Grafikbefehle, Erlaubte Werte sind 0 und 1} PROCEDURE SetColor (Color : word); BEGIN Farbe := Color; END; {Zeichnet nicht geflltes Rechteck} PROCEDURE Rectangle (x1, y1, x2, y2 : Integer); BEGIN Box (x1, y1, x2, y2); END; {Wandelt Winkel in Format der Original TP-Graph-Unit um} PROCEDURE winkel (VAR AnfWinkel:word; VAR EndWinkel : word); VAR aw,ew : integer; BEGIN EW := 90-AnfWinkel; AW := 90-EndWinkel; IF AW < 0 THEN AW := 360+AW; IF EW < 0 THEN EW := 360+EW; AnfWinkel := AW; EndWinkel := EW; END; {Zeichnet kompletten Kreis} PROCEDURE Circle (xm, ym : Integer; Radius : WORD); BEGIN Curve (xm, ym, Radius, Radius, 0, 360); END; {Fllt beliebige Fl„che mit Farbe aus} procedure FloodFill(x,y : integer; border : word); BEGIN Fill(x,y,border); END; {Setzt Fllmodus} PROCEDURE SetFillStyle (muster,color : word); BEGIN fillmuster := muster; fillcolor := color; END; {Zeichnet Ellipsen(ausschnitt)} PROCEDURE Ellipse (xm, ym : Integer; AnfWinkel, EndWinkel, XRadius, YRadius : word); BEGIN winkel(AnfWinkel,EndWinkel); Curve (xm, ym, XRadius, YRadius, AnfWinkel, EndWinkel); END; {Zeichnet ausgefllte Ellipse} PROCEDURE FillEllipse (xm, ym : Integer; XRadius, YRadius : word); BEGIN Curve (xm, ym, XRadius, YRadius, 0, 360); IF fillmuster <> 0 THEN Fill(xm,ym,farbe); END; {Zeichnet Kreisbogenausschnitt} PROCEDURE Arc (xm, ym : Integer; AnfWinkel, EndWinkel, Radius : WORD); BEGIN winkel(AnfWinkel,EndWinkel); Curve (xm, ym, Radius, Radius, AnfWinkel, EndWinkel); END; {Zeichnet ausgeflltes Tortenstck} PROCEDURE Sector (xm, ym : Integer; AnfWinkel, EndWinkel, XRadius, YRadius : WORD); VAR halbierende : real; BEGIN halbierende := ((Endwinkel+Anfwinkel)/2)*PI/180; winkel(AnfWinkel,EndWinkel); Slice (xm, ym, XRadius, YRadius, AnfWinkel, EndWinkel); IF fillmuster <> 0 THEN Fill(xm+Round(Xradius*cos(halbierENDe)/2), ym-Round(Yradius*sin(halbierende)/2),farbe); END; {Zeichnet nicht ausgeflltes Tortenstck} PROCEDURE PieSlice (xm, ym : Integer; AnfWinkel, EndWinkel, Radius : WORD); BEGIN Sector(xm, ym, AnfWinkel, EndWinkel, Radius, Radius); END; {L”scht Grafikbildschirm} PROCEDURE ClearDevice; BEGIN InitGraphic; END; {Holt aktuelle Zeichenfarbe} FUNCTION GetColor : word; BEGIN GetColor := Farbe; END; {Zeichnet dreidimensionale S„ule} PROCEDURE Bar3D(x1,y1,x2,y2:integer; depth:word; top:boolean); BEGIN bar(x1,y1,x2,y2); line(x2,y2,x2+depth,y2-depth); line(x2+depth,y2-depth,x2+depth,y1-depth); IF top THEN BEGIN line(x2,y1,x2+depth,y1-depth); line(x1,y1,x1+depth,y1-depth); line(x1+depth,y1-depth,x2+depth,y1-depth); END; END; {Zeichnet Polygon} PROCEDURE DrawPoly(NumPoints : word; VAR PolyPoints); TYPE wordes = array[1..20] of PointType; VAR i : byte; BEGIN FOR i:= 2 to NumPoints DO BEGIN line(wordes(PolyPoints)[i-1].x,wordes(PolyPoints)[i-1].y,wordes(PolyPoints)[i].x,wordes(PolyPoints)[i].y); END; END; {Zeichnet ausgeflltes Polygon} PROCEDURE FillPoly(NumPoints : word; VAR PolyPoints); TYPE wordes = array[1..20] of PointTYPE; VAR x,y : integer; BEGIN DrawPoly(NumPoints,PolyPoints); IF ((wordes(PolyPoints)[1].x <> wordes(PolyPoints)[NUmPoints].x) or (wordes(PolyPoints)[1].y <> wordes(PolyPoints)[NUmPoints].y)) THEN BEGIN line(wordes(PolyPoints)[1].x,wordes(PolyPoints)[1].y,wordes(PolyPoints)[NumPoints].x,wordes(PolyPoints)[NumPoints].y); inc(NUmPoints); wordes(PolyPoints)[NumPoints].x := wordes(PolyPoints)[1].x; wordes(PolyPoints)[NumPoints].y := wordes(PolyPoints)[1].y; END; x := wordes(PolyPoints)[1].x + Round((wordes(POlyPoints)[NumPoints-2].x-wordes(PolyPoints)[1].x)/2); y := wordes(PolyPoints)[1].y + Round((wordes(POlyPoints)[NumPoints-2].y-wordes(PolyPoints)[1].y)/2); x := x + Round((wordes(PolyPoints)[NumPoints-1].x-x)/2); y := y + Round((wordes(PolyPoints)[NumPoints-1].y-y)/2); IF ((fillmuster <>0) and (NumPoints>2)) THEN Fill(x,y,farbe); END; {Bewegt Grafikcursor relativ zur aktuellen Position} PROCEDURE MoveRel(dx,dy : integer); BEGIN gcursorx := gcursorx + dx; gcursory := gcursory + dy; END; {Bewegt Grafikcursor zu einer absoluten Position} PROCEDURE MoveTo(x,y : integer); BEGIN gcursorx := x; gcursory := y; END; {Zeichnet Linie zu einem relativen Punkt vom Grafikcursor ausgehend} PROCEDURE LineRel(dx,dy : integer); BEGIN Line(gcursorx,gcursory,gcursorx+dx,gcursory+dy); END; {Zeichnet Linie zu einem absoluten Punkt von Grafikcursor ausgehend} PROCEDURE LineTo(x,y : integer); BEGIN Line(gcursorx,gcursory,x,y); END; {Schreibt Text in Grafikbildschirm} PROCEDURE OutTextXY(x,y : Integer; TextString : STRING); BEGIN Text(x, y, Seg(TextString), Ofs(TextString)); END; {Setzt Text-Ausgabemodus} PROCEDURE SetTextStyle (font,direction,Sizex,Sizey : word); CONST zeiun : array[1..12] of integer = (1,1,1,-1,-1,-1,0,1,-1,0,-1,1); zeili : array[1..12] of integer = (0,-1,1,0,-1,1,-1,-1,-1,1,1,1); spaun : array[1..12] of integer = (0,0,0,0,0,0,1,1,1,-1,-1,-1); spali : array[1..12] of integer = (1,1,1,-1,-1,-1,0,0,0,0,0,0); zeiof : array[1..12] of integer = (6,6,6,-6,-6,-6,0,0,0,0,0,0); spaof : array[1..12] of integer = (0,0,0,0,0,0,6,6,6,-6,-6,-6); BEGIN IF ((direction >=1) and (direction <=12)) THEN BEGIN xver := Sizex; yver := Sizey; zu := zeiun[direction]; zl := zeili[direction]; su := spaun[direction]; sl := spali[direction]; zch := zeiof[direction]*xver; spt := spaof[direction]*xver; END; END; {Initialisierungsroutine} BEGIN zu := 1; {Textausrichtung normal} zl := 0; su := 0; sl := 1; xver := 1; {Verg”áerungsfaktor 1} yver := 1; zch := 6; spt := 0; farbe := 1; fillmuster := 1; fillcolor := 1; gcursorx := 0; gcursory := 0; {Grafikcursor} END.