Code Library
Home Submit Free Hosting Link To Us Contacts

Pascal Graphics2

Pascal Graphics2 Pascal Pascal Graphics2 Download (.zip)



{Fill is unstable for circles with radii greater than 49? Wierd rounding???}

{$A+}
{$G+}
{$N+,E-}
unit Graphics;
interface
        type
                {Some memory for a screen}
                MCGAScreenType = array[0..63900] of byte;

                {The main data structure for a page}
                PageType = record
                        Page:^MCGAScreenType;
                        Segment,Offset:word;
                end; {record}

        const
                {the color constants}
                Black = 0;
                Blue = 1;
        Green = 2;
                Cyan = 3;
                Red = 4;
                Magenta = 5;
        Brown = 6;
        LightGray = 7;
        DarkGray = 8;
        LightBlue = 9;
                LightGreen = 10;
        LightCyan = 11;
        LightRed = 12;
                LightMagenta = 13;
        Yellow = 14;
        White = 15;

                {We only have one screen mode, so these can be constants}
                MinX = 0; MinY = 0;
                MaxX = 319; MaxY = 199;

                {Constants used in paging and movies to determine whether to draw
                 the palette}
                PaletteEnabled = TRUE;
                PaletteDisabled = FALSE;

                {An unusual name (most likely not used as an hot-area indentifier)
                 used in the PollHotAreas function}
                Nothing = 'FooF';        {An unusual name}

                {A constant that points to the video buffer}
                TheScreen:PageType = (Page:ptr($a000,0000);Segment:$a000;Offset:0000);
        type

                {Records the elements of a color}
                ColorType = record
                        Red,Green,Blue:byte;
                end; {record}

                {Used to store the sin and cos lookup tables}
                TableType = array[0..45,0..300] of integer;

                {SubRange for the speed of a FadeDown}
                SpeedRangeType = 0..10;

                {Used to store an image}
                ImageType = record
                        deltaX,deltaY:integer;
                        vSegment,vOffset:word;
                        Image:pointer;
                end; {record}

                {Font size... useless because I don't want to do anything}
                SizeSubRange = 1..10;

                {Which direction to play a movie in}
                DirectionType = (Foreward,Backward);

                {Which font type... useless because there is only regular}
                FontEnumeratedType = (Regular);

                {Useless stuff about a font}
                FontType = record
                        Size:SizeSubRange;
                end; {record}

                {Variables that determine the characteristics of a fire}
                FireType = record
                        c,last:word;
                        x1,y1,x2,y2:word;
                        PalBegin,PalEnd,PalLen:byte;
                end; {record}

                {Defines a point in the gradated palette}
                ColorRecordType = record
                        Color:ColorType;
                        IsAPoint:Boolean;
                        Location:byte;
                end; {record}

                {Defines a coordinate}
                CordType = record
                        x,y:word;
                end; {record}

                MapNodePtr = ^MapNodeType;

                {Defines one node (area) of an image map}
                MapNodeType = record
                        next:MapNodePtr;
                        name:string;
                        number:integer;
                        b1,e1,b2,e2:CordType;
                end; {record}

                {The large map-type definition}
                MapType = record
                        Render:PageType;
                        Rendered:boolean;
                        First,Last:MapNodePtr;
                        NumItems:word;
                end; {record}

                {A palette}
                PaletteType = array[0..255] of ColorType;

                PaletteTypePtr = ^PaletteType;

                MovieNodePtr = ^MovieNode;

                {Defines one node (frame) of a movie}
                MovieNode = record
                        Picture:ImageType;
                        Palette:PaletteTypePtr;
                        prev,next:MovieNodePtr;
                end; {record}

                {Defines a movie}
                MovieType = record
                        Front,Last:MovieNodePtr;
                        NumFrames:word;
                end; {record}

                {Defines a gradated palette; max 256 colors}
                GradatedPalType = array[0..255] of ColorRecordType;

                GradatedPaletteType = ^GradatedPalType;

                {The palette for a picture}
                SomePaletteType = array[0..255] of ColorType;

                {A Picture!!! I love my TGAs and PCXes}
                PictureType = record
                        picture:ImageType;
                        Palette:^SomePaletteType;
                end; {record}

        procedure InitGraph;
        procedure CloseGraph;

        procedure SetColor(AColor:byte);
        function GetColor:byte;

        procedure PutPixel(x,y:word);
        function GetPixel(x,y:word):byte;

        procedure SetPalette(ColorNumber:byte;AColor:ColorType);
        procedure GetPalette(ColorNumber:byte;var TheColor:ColorType);
        procedure FadeScreen(Speed:SpeedRangeType);
        procedure RotatePalette(Start,Finish:byte);
        procedure SavePalette(FileName:string);
        procedure LoadPalette(FileName:string);

        procedure InitGradatedPalette(var SomePalette:GradatedPaletteType);
        procedure AddKeyPoint(var SomePalette:GradatedPaletteType;Location:byte;Color:ColorType);
        procedure GeneratePalette(SomePalette:GradatedPaletteType);
        procedure KillGradatedPalette(var SomePalette:GradatedPaletteType);

        procedure ClearScreen;
        procedure Circle(x,y,Radius:word);
        procedure Line(x1,y1,x2,y2:word);
        procedure Bar(BeginX,BeginY,EndX,EndY:word);
        procedure Rectangle(BeginX,BeginY,EndX,EndY:word);
        procedure Fill(x,y:word;FillColor,Border:byte);
        procedure InitFire(var SomeFire:FireType;x1,y1,x2,y2:word;BeginPal,EndPal:byte);
        procedure DoFire(SomeFire:FireType);

        procedure GetImage(var Image:ImageType;x1,y1,x2,y2:word);
        procedure PutImage(Image:ImageType;x1,y1:word);
        procedure KillImage(var Image:ImageType);

        procedure PutChar(Font:FontEnumeratedType;xc,yc:word;AChar:char);
        procedure WriteStringXY(Font:FontEnumeratedType;xc,yc:word;Thing:string);
        procedure WriteString(Font:FontEnumeratedType;Thing:string);

        procedure LoadPCX(var Image:PictureType;FileName:string);
        procedure LoadTGA(var Image:PictureType;FileName:string);
        procedure DrawPicture(x1,y1:word;Image:PictureType;BeginPart,EndPart:byte);
        procedure KillPicture(var Image:PictureType);

        procedure InitPage(var SomePage:PageType);
        procedure SetActivePage(SomePage:PageType);
        procedure CopyPage(Source:PageType;var Destination:PageType);
        procedure CopyPageToVGA(SomePage:PageType);
        procedure CopyVGAToPage(var SomePage:PageType);
        procedure KillPage(SomePage:PageType);

        procedure InitMap(var SomeMap:MapType);
        procedure AddHotArea(var SomeMap:MapType;Name:string;bx1,by1,ex1,ey1,bx2,by2,ex2,ey2:word);
        procedure RenderHotAreas(var SomeMap:MapType);
        function PollHotAreas(SomeMap:MapType):string;
        procedure KillMap(var SomeMap:MapType);

        procedure FlipImage(var SomeImage:ImageType);
        procedure MirrorImage(var SomeImage:ImageType);

        procedure InitMovie(var SomeMovie:MovieType);
        procedure AddSomeFrame(var SomeMovie:MovieType;x1,y1,x2,y2:word);
        procedure PlayMovie(SomeMovie:MovieType;pX,pY:word;UsePalette:boolean;Direction:DirectionType);
        procedure KillMovie(var SomeMovie:MovieType);

implementation
        uses CRT,Mouse,Memory;

        const
        PI = 3.1415926;
        VGA:Word = $a000;
                IOOk = 0;

        type
                ByteBitType = array[1..8] of boolean;

                PaletteFileType = file of ColorType;

        YAsmLookUpType = array[0..300] of word;

        var
                {Hold the sin and cos tables}
                SinRadiusTable,CosRadiusTable:TableType;
                {The current drawing color used in practically every procedure}
                CurrentDrawingColor:byte;
                {Determines if InitGraph has been called}
                HasBeenInitialized:boolean;
                {Point to the location of the invisible cursor (WriteString)}
                CurrentTextX,CurrentTextY:word;
                {A lookup table for the y cords. (y-1)*320}
                AsmLookUp:YAsmLookUpType;
                {The current page}
                ActivePage:PageType;
                {The segment and offset of the current page}
                CurSeg,CurOfs:word;

        {Converts degrees to radians}
        function DegreesToRadians(Degrees:real):real;
        begin
                DegreesToRadians:=PI*Degrees/180;
        end; {DegreeesToRadians}

        {Converts radians to degrees}
        function RadiansToDegrees(Radians:real):real;
        begin
                RadiansToDegrees:=180*Radians/PI;
        end; {RadiansToDegrees}

        {If you don't call InitGraph, feel the wrath!}
        procedure AnnoyingErrorMessage;
        begin
        if not HasBeenInitialized then begin
                        writeln('Error #666: The screen has not be initialized. Please call InitGraph;');
                        halt;
        end; {if}
    end; {AnnoyingErrorMessage}

        {Goes into 320x200x256 mode}
        procedure SetMCGA;
        begin
                asm
                        mov        ax,0013h
                        int        10h
                end; {asm}
        end; {SetMCGA}

        {Sets MCGA mode and does some lookup tables}
        procedure InitGraph;
    var
            x,Radius:integer;
                Constant:real;
        ymov,tymov:word;
        begin
                HasBeenInitialized:=TRUE;
        Constant:=PI/180;
        writeln('Computing y lookup table...');
        for x:=0 to 200 do begin
                ymov:=x shl 6;
                    tymov:=ymov;
            ymov:=ymov shl 2;
                        ymov:=ymov+tymov;
            AsmLookUp[x]:=ymov;
                end; {for}
        writeln('Computing sine and cosine lookup tables...');
        for Radius:=0 to 300 do
                    for x:=0 to 45 do begin
                                SinRadiusTable[x,Radius]:=trunc(sin(x*Constant)*Radius);
                    CosRadiusTable[x,Radius]:=trunc(cos(x*Constant)*Radius);
                    end; {for}
        CurrentTextX:=0; CurrentTextY:=0;
                SetMCGA;
            SetColor(15);
        ActivePage:=TheScreen;
                CurSeg:=$a000;
        CurOfs:=0000;
        TheScreen.Segment:=$a000;
        TheScreen.Offset:=$0000;
        TheScreen.Page:=ptr($a000,0000);
          end; {InitGraph}

        {Returns to text mode}
        procedure CloseGraph;
        begin
                asm
                        mov        ax,0003h
                        int        10h
                end; {asm}
                writeln('This program uses Mark Rosen''s graphics library.');
                writeln('Send E-Mail to mrosen@peganet.com for more information');
        end; {CloseGraph}

        {Sets the current color}
        procedure SetColor(AColor:byte);
        begin
                AnnoyingErrorMessage;
                CurrentDrawingColor:=AColor;
        end; {SetColor}

        {Returns the current color}
        function GetColor:byte;
        begin
                AnnoyingErrorMessage;
                GetColor:=CurrentDrawingColor;
        end; {GetColor}

        {Draws a pixel at (x,y)}
        procedure PutPixel(x,y:word);
        var
                t:word;
        begin
                t:=AsmLookUp[y];
                asm
                        mov es,[CurSeg]
                        mov di,[t]
                        add di,[CurOfs]
                        add di,[X]
                        mov al,[CurrentDrawingColor]
                        mov es:[di],al
                end; {asm}
        end; {PutPixel}

        {Returns the color at (x,y)}
        function GetPixel(x,y:word):byte;
        var
                TempColor:byte;
                t:word;
        begin
                AnnoyingErrorMessage;
                t:=AsmLookUp[y mod 320];
                x:=x mod 320;
                asm
                        mov es,[CurSeg]
                        mov di,[t]
                        add di,[CurOfs]
                        add di,[x]
                        mov al,es:[di]
                        mov [TempColor],al
                end; {asm}
                GetPixel:=TempColor;
        end; {GetPixel}

        {Sets a color register to a color}
        procedure SetPalette(ColorNumber:byte;AColor:ColorType);
        begin
                AnnoyingErrorMessage;
                asm
                        mov dx,3c8h
                        mov al,[ColorNumber]
                        out dx,al
                        inc dx
                        mov al,[AColor.Red]
                        out dx,al
                        mov al,[AColor.Green]
                        out dx,al
                        mov al,[AColor.Blue]
                        out dx,al
                end; {asm}
        end; {SetAPaletteEntry}

        {Returns the contents of a color register}
        procedure GetPalette(ColorNumber:byte;var TheColor:ColorType);
        var
                Rt,Gt,Bt:byte;
        begin
                AnnoyingErrorMessage;
                Rt:=TheColor.Red; Gt:=TheColor.Green; Bt:=TheColor.Blue;
                asm
                        mov   dx, 3c7h
                        mov   al, [ColorNumber]
                        out   dx, al
                        inc   dx
                        inc   dx
                        in    al, dx
                        mov   [Rt],al
                        in    al, dx
                        mov   [Gt],al
                        in    al, dx
                        mov   [Bt],al
                end; {asm}
                TheColor.Red:=Rt; TheColor.Green:=Gt; TheColor.Blue:=Bt;
        end; {GetAPaletteEntry}

        {Fades the screen to black, destroying the palette}
        procedure FadeScreen(Speed:SpeedRangeType);
           var
                HaveChangedSomething:boolean;
              CurrentColor:ColorType;
                x,Counter:integer;
        begin
        AnnoyingErrorMessage;
                HaveChangedSomething:=TRUE;
                while HaveChangedSomething do begin
                        Delay(5*(10-Speed));
                        HaveChangedSomething:=FALSE;
                        for x:=0 to 255 do begin
                                GetPalette(x,CurrentColor);
                    if CurrentColor.Red<>0 then begin
                        dec(CurrentColor.Red);
                                        HaveChangedSomething:=TRUE;
                end; {if}
                    if CurrentColor.Green<>0 then begin
                                        dec(CurrentColor.Green);
                                        HaveChangedSomething:=TRUE;
                end; {if}
                    if CurrentColor.Blue<>0 then begin
                                        dec(CurrentColor.Blue);
                                        HaveChangedSomething:=TRUE;
                                end; {if}
                SetPalette(x,CurrentColor);
            end; {for}
            end; {while}
        end; {FadeScreen}

        {Rotates all colors from Start to Finish}
        procedure RotatePalette(Start,Finish:byte);
        var
                x:byte;
                Holding,Temp:ColorType;
        begin
                AnnoyingErrorMessage;
                GetPalette(Start,Holding);
                for x:=Start+1 to Finish do begin
                        GetPalette(x,Temp);
                        SetPalette(x-1,Temp);
                end; {for}
        SetPalette(Finish,Holding);
    end; {RotatePalette}

        {Stores the contents of a file into FileName}
        procedure SavePalette(FileName:string);
        var
                Food:PaletteFileType;
                TempColor:ColorType;
                x:byte;
        begin
        AnnoyingErrorMessage;
        assign(Food,FileName);
        rewrite(Food);
        for x:=0 to 255 do begin
                GetPalette(x,TempColor);
                 write(Food,TempColor);
        end; {for}
                close(Food);
    end; {SavePalette}

        {Loads a palette from disk; must be valid}
        procedure LoadPalette(FileName:string);
        var
                Food:PaletteFileType;
                TempColor:ColorType;
                x:byte;
        begin
        AnnoyingErrorMessage;
                assign(Food,FileName);
        {$I-}
        Reset(Food);
        {$I+}
                if IOResult=IOOk then begin
                for x:=0 to 255 do begin
                                Read(Food,TempColor);
                SetPalette(x,TempColor);
            end; {for}
                        Close(Food);
        end; {if}
        end; {LoadPalette}

        {Draws a circle on the screen; a bit irregular because of rounding errors}
        procedure Circle(x,y,Radius:word);
        var
            Angle,RealX,RealY,
                XPlusRealX,XMinusRealX,XPlusRealY,XMinusRealY,
        YPlusRealY,YMinusRealY,YPlusRealX,YMinusRealX:word;
    begin
                for Angle:=0 to 45 do begin
                RealX:=CosRadiusTable[Angle,Radius];
            RealY:=SinRadiusTable[Angle,Radius];

            XPlusRealX:=x+RealX; XPlusRealY:=x+RealY;
            XMinusRealX:=x-RealX; XMinusRealY:=x-RealY;

                        YPlusRealY:=y+RealY; YPlusRealX:=y+RealX;
            YMinusRealY:=y-RealY; YMinusRealX:=y-RealX;

            putpixel(XPlusRealX,YPlusRealY);
            putpixel(XPlusRealX,YMinusRealY);
            putpixel(XMinusRealX,YPlusRealY);
                        putpixel(XMinusRealX,YMinusRealY);

                        putpixel(XPlusRealY,YPlusRealX);
                        putpixel(XPlusRealY,YMinusRealX);
                        putpixel(XMinusRealY,YPlusRealX);
                        putpixel(XMinusRealY,YMinusRealX);
                end; {for}
        end; {Circle}

        procedure SwapW(var a,b:word);
        var
                Temp:word;
        begin
                Temp:=a;
        a:=b;
                b:=Temp;
        end; {SwapW}

    procedure SwapB(var a,b:byte);
    var
                Temp:word;
    begin
        Temp:=a;
        a:=b;
        b:=Temp;
        end; {SwapB}

        {Draws a vertical line on the screen}
        procedure VerticalLine(BeginX,BeginY,EndY:word);
        var
                y:word;
        begin
        if BeginY>EndY then swapW(BeginY,EndY);
               for y:=BeginY to EndY do
                        putpixel(BeginX,y);
        end; {VerticalLine}

        {Draws a horizontal line on the screen really quickly}
        procedure HorizontalLine(BeginX,EndX,BeginY:word);
        var
                t,size:word;
        begin
                t:=AsmLookUp[BeginY mod 200];
                size:=abs(EndX-BeginX);
                asm
                   mov es,[CurSeg]
                   mov di,[t]
                   add di,[BeginX]
                   add di,[CurOfs]
                   mov al,[CurrentDrawingColor]
                   mov cx,[size]
                   rep stosb
                end; {asm}
        end; {HorizontalLine}

        {Draws a line from (x1,y1) to (x2,y2) using Bresenham's algorithm}
        procedure Line(x1, y1, x2, y2 : word);
        var i,DeltaX,DeltaY,numpixels,
                d,dinc1,dinc2,
                x,xinc1,xinc2,
                y,yinc1,yinc2:integer;
        begin
                DeltaX:=abs(x2-x1);
                DeltaY:=abs(y2-y1);
                if x1=x2 then
                        VerticalLine(x1,y2,y2)
                else if y1=y2 then
                        HorizontalLine(x1,x2,y1)
                else begin
                        if DeltaX>=deltay then begin
                                numpixels:=DeltaX+1;
                                d:= (2*deltay)-DeltaX;
                                dinc1:=deltay shl 1;
                                dinc2:=(deltay-DeltaX) shl 1;
                                xinc1:=1;
                                xinc2:=1;
                                yinc1:=0;
                                yinc2:=1;
                        end {if}
                        else begin
                                numpixels:=deltay+1;
                                d:=(2*DeltaX)-deltay;
                                dinc1:=DeltaX shl 1;
                                dinc2:=(DeltaX-deltay) shl 1;
                                xinc1:= 0;
                                xinc2:= 1;
                                yinc1:=1;
                                yinc2:=1;
                        end; {else}
                        if x1 > x2 then begin
                                xinc1:=-xinc1;
                                xinc2:=-xinc2;
                        end; {if}
                        if y1>y2 then begin
                                yinc1:=-yinc1;
                                yinc2:=-yinc2;
                        end; {if}
                        x:=x1;
                        y:=y1;
                        for i := 1 to numpixels do begin
                                PutPixel(x,y);
                                if d < 0 then begin
                                        d:= d+dinc1;
                                        x:= x+xinc1;
                                        y:= y+yinc1;
                                end {f}
                                else begin
                                        d:= d+dinc2;
                                        x:= x+xinc2;
                                        y:= y+yinc2;
                                end; {else}
                        end; {for}
                end; {else}
        end; {Line}

        {Draws a filled box on the screen}
        procedure Bar(BeginX,BeginY,EndX,EndY:word);
        var
                y,t,x:word;
                size:word;
        begin
                AnnoyingErrorMessage;
                size:=abs(EndX-BeginX);
                for y:=BeginY to EndY do begin
                        t:=AsmLookUp[y];
                        asm
                                mov cx,[size]
                                mov al,[CurrentDrawingColor]
                                mov es,[CurSeg]
                                mov di,[t]
                                add di,[CurOfs]
                                add di,[BeginX]
                                rep stosb


                                mov di,[t]
                                add di,[CurOfs]
                                add di,[size]
                                add di,[BeginX]
                                stosb
                        end; {asm}
                end; {for}
        end; {Box}

        {Draws a rectangle on the screen}
        procedure Rectangle(BeginX,BeginY,EndX,EndY:word);
        begin
                AnnoyingErrorMessage;
                HorizontalLine(BeginX,EndX,BeginY);
                HorizontalLine(BeginX,EndX,EndY);
                VerticalLine(BeginX,BeginY,EndY);
                VerticalLine(EndX,BeginY,EndY);
        end; {Rectangle}

        {Allocates some memory and stores parts of the screen into it}
        procedure GetImage(var Image:ImageType;x1,y1,x2,y2:word);
        var
                yImg,yShl,x,y,size,vSeg,vOfs:word;
        begin
                Image.DeltaX:=abs(x1-x2); Image.DeltaY:=abs(y1-y2);
                GetMem(Image.Image,(Image.DeltaX+1)*(Image.DeltaY+1));
                Image.vSegment:=seg(Image.Image^); vSeg:=Image.vSegment;
                Image.vOffset:=ofs(Image.Image^); vOfs:=Image.vOffset;

                size:=Image.DeltaX+1;
                yImg:=0;
                for y:=0 to Image.DeltaY do begin
                        YShl:=AsmLookUp[y+y1];
                        asm
                                mov cx,[size]
                                @1:
                                        mov es,[CurSeg]
                                        mov di,[CurOfs]
                                        add di,[YShl]
                                        add di,cx
                                        add di,[x1]
                                        dec di
                                        mov al,es:[di]

                                        mov es,[vSeg]
                                        mov di,[vOfs]
                                        add di,[YImg]
                                        add di,cx
                                        dec di
                                        mov es:[di],al
                                        dec cx
                                jnz @1
                        end; {asm}
                        yImg:=yImg+Image.DeltaX+1;
                end; {for}
        end; {GetImage}

        {Transfers a stored image from memory to the screen}
        procedure PutImage(Image:ImageType;x1,y1:word);
        var
                yImg,yShl:word;
                x,y:word;
        begin
                yImg:=0;
           for y:=0 to Image.DeltaY do begin
                   yShl:=AsmLookUp[y+y1];
                   asm
                           mov cx,[Image.DeltaX]
                           inc cx
                           @1:
                                   mov es,[Image.vSegment]
                                   mov di,[Image.vOffset]
                                   add di,[yImg]
                                   add di,cx
                                   dec di
                                   mov al,es:[di]

                                   mov es,[CurSeg]
                                   mov di,[CurOfs]
                                   add di,[yShl]
                                   add di,[x1]
                                   add di,cx
                                   dec di
                                   mov es:[di],al
                                   dec cx
                           jnz @1
                 end; {asm}
                   yImg:=yImg+Image.DeltaX+1;
           end; {for}
        end; {PutImage}

        {Deallocates the memory used by the image}
        procedure KillImage(var Image:ImageType);
        begin
                AnnoyingErrorMessage;
                FreeMem(Image.Image,(Image.DeltaX+1)*(Image.DeltaY+1));
        end; {KillImage}

        {I can't remember the exp(ln) thing}
        function Exp(base,exponent:word):word;
        var
                Temp,x:word;
        begin
                Temp:=1;
                for x:=1 to exponent do
                        Temp:=Temp*base;
                Exp:=Temp;
        end; {Exp}

        {Converts a byte to binary notation (array of booleans)}
        procedure ConvertDecimalToBinary(Something:byte;var Bin:ByteBitType);
        var
                x:byte;
                temp:word;
        begin
                for x:=1 to 8 do
                        Bin[x]:=FALSE;
                for x:=7 downto 0 do begin
                        temp:=trunc(Something div Exp(2,x));
                        if temp>0 then Something:=Something-Exp(2,x);
                        if temp=1 then
                                Bin[x+1]:=TRUE;
                end; {for}
        end; {ConvertDecimalToBinary}

        {Draws a character on the screen from ROM}
        procedure PutChar(Font:FontEnumeratedType;xc,yc:word;AChar:char);
        var
                x,y:word;
                Line:byte;
                Temp:ByteBitType;
        begin
                AnnoyingErrorMessage;
                for y:=0 to 7 do begin
                        Line:=Mem[$F000:$FA6E+(ord(AChar)*8)+y];
                        ConvertDecimalToBinary(Line,Temp);
                        for x:=1 to 8 do
                                if Temp[x] then putpixel((9-x)+xc,y+yc);
                end;
        end; {PutChar}

        {Draws a string at (x,y), looping at the end of the screen}
        procedure WriteStringXY(Font:FontEnumeratedType;xc,yc:word;Thing:string);
        var
                TempX,TempY:word;
                x:byte;
        begin
                AnnoyingErrorMessage;
                TempX:=xc; TempY:=yc;
                for x:=1 to ord(Thing[0]) do begin
                        PutChar(Font,TempX,TempY,Thing[x]);
                        TempX:=TempX+8;
                        if TempX>311 then begin
                                TempX:=1;
                                TempY:=TempY+8;
                        end; {if}
                end; {for}
        end; {WriteStringXY}

        {Draws a string at the current text location, wrapping at the end}
        procedure WriteString(Font:FontEnumeratedType;Thing:string);
        var
                TempX,TempY:word;
                x:byte;
        begin
                AnnoyingErrorMessage;
                TempX:=CurrentTextX; TempY:=CurrentTextY;
                for x:=1 to ord(Thing[0]) do begin
                        PutChar(Font,TempX,TempY,Thing[x]);
                        TempX:=TempX+8;
                        if TempX>311 then begin
                                TempX:=1;
                                TempY:=TempY+8;
                        end; {if}
                end; {for}
                CurrentTextX:=CurrentTextX+TempX;
                CurrentTextY:=CurrentTextY+TempY;
        end; {WriteString}

        {Flips an image from left-right}
        procedure FlipImage(var SomeImage:ImageType);
        var
                ey,by,HalfY,x,y:word;
                p1seg,p1ofs,p2seg,p2ofs:word;
                DeltaXPlus,DeltaYPlus:word;
                Temp:byte;
        begin
                DeltaXPlus:=SomeImage.DeltaX+1; DeltaYPlus:=SomeImage.DeltaY+1;
                HalfY:=((DeltaYPlus) div 2)-1;
                by:=SomeImage.vOffset; ey:=SomeImage.vOffset+(DeltaXPlus*DeltaYPlus);
                p1seg:=SomeImage.vSegment; p2seg:=SomeImage.vSegment;
                for y:=0 to HalfY do begin
                        ey:=ey-DeltaXPlus;
                        for x:=0 to SomeImage.DeltaX do begin
                                Temp:=Mem[p1seg:by];
                                Mem[p1seg:by]:=Mem[p2seg:ey];
                                Mem[p2seg:ey]:=Temp;
                                inc(ey);
                                inc(by);
                        end; {for}
                        ey:=ey-DeltaXPlus;
                end; {for}
        end; {FlipImage}

        {Loads a valid PCX file onto the screen}
        procedure LoadPCX(var Image:PictureType;FileName:string);
        var
                fp:file;
                numbytes,index,pSeg,pOfs,vSeg,vOfs:word;
                count,imgSize,fpcnt,x,size:word;
                dataval:byte;
                ImagePtr:pointer;
                TempColor:ColorType;
        begin
                assign(fp, FileName);
                {$I-}
                reset(fp,1);
                {$I+}
                if IOResult<>IOOk then begin
                        CloseGraph;
                        writeln('Error 111: You specified an invalid file name when calling LoadPCX');
                        halt;
                end; {if}
                size:=filesize(fp);
                GetMem(ImagePtr,size);
                blockread(fp,ImagePtr^,size);
                vSeg:=seg(ImagePtr^); vOfs:=ofs(ImagePtr^);
                new(Image.palette);

                Image.Picture.DeltaX:=Mem[vSeg:vOfs+8] + (Mem[vSeg:vOfs+9] shl 8);
                Image.Picture.DeltaY:=Mem[vSeg:vOfs+10] + (Mem[vSeg:vOfs+11] shl 8);
                imgSize:=(Image.Picture.DeltaX+1)*(Image.Picture.DeltaY+1);
                GetMem(image.picture.image,imgSize);
                pSeg:=seg(Image.Picture.Image^); pOfs:=ofs(Image.Picture.Image^);
                Image.Picture.vSegment:=pSeg; Image.Picture.vOffset:=pOfs;
                count:=0;
                fpcnt:=128;
                while count<imgSize do begin
                        dataval:=Mem[vSeg:vOfs+fpcnt];
                        inc(fpcnt);
                        if (dataval>=192) and (dataval<=255) then begin
                                numbytes:=dataval-192;
                                dataval:=Mem[vSeg:vOfs+fpcnt];
                                inc(fpcnt);
                                asm
                                        mov cx,[numbytes]
                                        mov es,[pSeg]
                                        mov di,[pOfs]
                                        add di,[count]
                                        mov al,[dataval]
                                        rep stosb
                                end; {Asm}
                                count:=count+numbytes;
                        end {if}
                        else begin
                                asm
                                        mov es,[pSeg]
                                        mov di,[pOfs]
                                        add di,[count]
                                        mov al,[dataval]
                                        mov es:[di],al
                                end; {asm}
                                count:=count+1;
                        end; {else}
                end; {for}

                fpcnt:=size-768;
                for x:=0 to 255 do begin
                        index:=3*x;
                        TempColor.Red:=Mem[vSeg:vOfs+index+fpcnt] shr 2;
                        TempColor.Green:=Mem[vSeg:vOfs+index+1+fpcnt] shr 2;
                        TempColor.Blue:=Mem[vSeg:vOfs+index+2+fpcnt] shr 2;
                        image.palette^[x]:=TempColor;
                end; {for}
                FreeMem(ImagePtr,size);
                close(fp);
        end; {LoadPCX}

        {Loads a valid TGA onto the screen}
        procedure LoadTGA(var Image:PictureType;FileName:string);
        var
                fp:file;
                TempPalAndHeadPtr:pointer;
                TempImage:ImageType;
                vSeg,vOfs,x:word;
                TempColor:ColorType;
        begin
                assign(fp,FileName);
                reset(fp,1);                                {no error checking as of yet}

                GetMem(TempPalAndHeadPtr,786);
                new(Image.Palette);

                BlockRead(fp,TempPalAndHeadPtr^,786);
                vSeg:=seg(TempPalAndHeadPtr^); vOfs:=ofs(TempPalAndHeadPtr^);
                Image.Picture.DeltaX:=(Mem[vSeg:vOfs+13] shl 8)+Mem[vSeg:vOfs+12]-1;
                Image.Picture.DeltaY:=(Mem[vSeg:vOfs+15] shl 8)+Mem[vSeg:vOfs+14]-1;
                vOfs:=vOfs+18;
                for x:=0 to 255 do begin
                        TempColor.Blue:=Mem[vSeg:vOfs] shr 2;
                        vOfs:=vOfs+1;
                        TempColor.Green:=Mem[vSeg:vOfs] shr 2;
                        vOfs:=vOfs+1;
                        TempColor.Red:=Mem[vSeg:vOfs] shr 2;
                        vOfs:=vOfs+1;
                        Image.Palette^[x]:=TempColor;
                end; {for}

                GetMem(Image.Picture.Image,(Image.Picture.DeltaX+1)*(Image.Picture.DeltaY+1));
                Image.Picture.vSegment:=seg(Image.Picture.Image^);
                Image.Picture.vOffset:=ofs(Image.Picture.Image^);

                seek(fp,786);
                BlockRead(fp,Image.Picture.Image^,(Image.Picture.DeltaX+1)*(Image.Picture.DeltaY+1));
                FreeMem(TempPalAndHeadPtr,786);

                FlipImage(Image.Picture);
                close(fp);
        end; {LoadTGA}

        {Draws a picture and a specifed part of the palette}
        procedure DrawPicture(x1,y1:word;Image:PictureType;BeginPart,EndPart:byte);
        var
                x,vSeg,vOfs:word;
                Color:byte;
        begin
                for x:=BeginPart to EndPart do
                        setpalette(x,Image.Palette^[x]);
                PutImage(Image.Picture,x1,y1);
        end; {DrawPicture}

        {Deallocates the memory used by a picture}
        procedure KillPicture(var Image:PictureType);
    begin
                KillImage(Image.Picture);
        dispose(Image.Palette);
        end; {KillPicture}

        {Initializes the array structure for a gradated palette}
        procedure InitGradatedPalette(var SomePalette:GradatedPaletteType);
        var
                Black:ColorType;
                x:byte;
        begin
                AnnoyingErrorMessage;
                new(SomePalette);
                Black.Red:=0; Black.Green:=0; Black.Blue:=0;
                for x:=0 to 255 do begin
                        SomePalette^[x].Color:=Black;
                        SomePalette^[x].IsAPoint:=FALSE;
                end; {for}
        end; {InitGradatedPalette}

        {Adds a key point to the gradated palette}
        procedure AddKeyPoint(var SomePalette:GradatedPaletteType;Location:byte;
                                                  Color:ColorType);
    begin
        AnnoyingErrorMessage;
        SomePalette^[Location].Color:=Color;
        SomePalette^[Location].IsAPoint:=TRUE;
        SomePalette^[Location].Location:=Location;
        end; {AddKeyPoint}

        {Generates a palette based on the current key points}
        procedure GeneratePalette(SomePalette:GradatedPaletteType);
        var
                TempColor:ColorType;
                Temp1,Temp2:ColorRecordType;
                Location1,Location2:byte;
                x,y:byte;
                Number:byte;
                Temp:array[0..255] of ColorRecordType;
                RealRed,RealGreen,RealBlue,
                IncRed,IncGreen,IncBlue:real;
                DeltaLoc:word;
    begin
        AnnoyingErrorMessage;
            Number:=0;
        {Condense the palette into only hot points}
            for x:=0 to 255 do begin
                        if SomePalette^[x].IsAPoint then begin
                                Temp[Number]:=SomePalette^[x];
                Number:=Number+1;
                        end; {if}
        end; {for}
        {actually gradate the palette}
        for x:=0 to Number-1 do begin
            Location1:=Temp[x].Location;
            Location2:=Temp[x+1].Location;
            DeltaLoc:=abs(Location2-Location1);
            RealRed:=Temp[x].Color.Red; RealGreen:=Temp[x].Color.Green;
                        RealBlue:=Temp[x].Color.Blue;
                        IncRed:=(Temp[x+1].Color.Red-Temp[x].Color.Red)/DeltaLoc;
            IncGreen:=(Temp[x+1].Color.Green-Temp[x].Color.Green)/DeltaLoc;
            IncBlue:=(Temp[x+1].Color.Blue-Temp[x].Color.Blue)/DeltaLoc;
                        for y:=Location1 to Location2 do begin
                    TempColor.Red:=trunc(RealRed); TempColor.Green:=trunc(RealGreen);
                TempColor.Blue:=trunc(RealBlue);
                                setpalette(y,TempColor);
                RealRed:=RealRed+IncRed;
                RealGreen:=RealGreen+IncGreen;
                                RealBlue:=RealBlue+IncBlue;
                        end; {for}
                end; {for}
        end; {GeneratePalette}

        {Deallocates the memory used by a gradated palette}
        procedure KillGradatedPalette(var SomePalette:GradatedPaletteType);
        begin
                AnnoyingErrorMessage;
                dispose(SomePalette);
        end; {KillGradatedPalette}

        {Initalizes the characteristics of a fire}
        procedure InitFire(var SomeFire:FireType;x1,y1,x2,y2:word;BeginPal,EndPal:byte);
        var
                Test:GradatedPaletteType;
                Temp:ColorType;
                x:byte;
                ymov,tymov:word;
    begin
                InitGradatedPalette(Test);
        Temp.Red:=63; Temp.Green:=63; Temp.Blue:=0;
        AddKeyPoint(Test,EndPal,Temp);
        Temp.Red:=63; Temp.Green:=0; Temp.Blue:=0;
                AddKeyPoint(Test,(BeginPal+EndPal) div 2,Temp);
        Temp.Red:=0; Temp.Green:=0; Temp.Blue:=0;
        AddKeyPoint(Test,BeginPal,Temp);
        GeneratePalette(Test);
            SomeFire.c:=y1+abs(y2-y1) div 2;
        SomeFire.last:=AsmLookUp[y2];
        SomeFire.x1:=x1; SomeFire.y1:=y1;
                SomeFire.x2:=x2; SomeFire.y2:=y2;
                SomeFire.PalBegin:=BeginPal;
                SomeFire.PalEnd:=EndPal;
                SomeFire.PalLen:=abs(BeginPal-EndPal);
        end; {InitFire}

        {Actually draws one iteration of the fire onto the screen}
        procedure DoFire(SomeFire:FireType);
    var
                x,y,cury,curyn:word;
        t1,t2,t:byte;
    begin
        cury:=somefire.last;
        for x:=SomeFire.x1 to SomeFire.x2 do begin
                t:=random(SomeFire.PalLen)+SomeFire.PalBegin;
            asm
                mov es,[CurSeg]
                mov di,[Cury]
                add di,[CurOfs]
                add di,[X]
                                mov al,[t]
                mov es:[di],al
            end; {asm}
        end; {for}
               for y:=SomeFire.y2-1 downto SomeFire.y1+1 do begin
            cury:=AsmLookUp[y];
                        curyn:=AsmLookUp[y+1];
                for x:=SomeFire.x1+1 to SomeFire.x2-1 do begin
                asm
                                        mov es,[CurSeg]
                                        mov di,[curyn]
                    add di,[X]
                    add di,[CurOfs]
                    mov al,es:[di-1]
                    mov [t1],al
                    mov al,es:[di+1]
                    mov [t2],al
                end;
                t:=(t1+t2) shr 1;
                if (t>0) and (y<SomeFire.c) then t:=t-1;
                                if t<SomeFire.PalBegin then t:=SomeFire.PalBegin;
                asm
                    mov es,[CurSeg]
                    mov di,[cury]
                    add di,[CurOfs]
                    add di,[X]
                                        mov al,[t]
                    mov es:[di],al
                end; {asm}
                        end; {for}
            end; {for}
    end; {DoFire}

        {Clears the screen really quickly}
        procedure ClearScreen;
        begin
                CurrentTextX:=0;
                CurrentTextY:=0;
                asm
                        mov ax,0
                        mov es,[CurSeg]
                        mov di,[CurOfs]
                        {A word is two bytes}
                        mov cx,32000
                        rep stosw
                end; {asm}
        end; {ClearScreen}

        {Initaizlizes the dynamic music used by a page}
        procedure InitPage(var SomePage:PageType);
        var
                vseg,vofs:word;
        begin
                new(SomePage.page);
                SomePage.Segment:=seg(SomePage.Page^);
                SomePage.Offset:=ofs(SomePage.Page^);
                vseg:=SomePage.Segment;
                vofs:=SomePage.Offset;
                asm
                        mov ax,0
                        mov es,[vseg]
                        mov di,[vofs]

                        mov cx,32000
            rep stosw
                end; {asm}
        end; {InitPage}

        {Sets the active page}
        procedure SetActivePage(SomePage:PageType);
        begin
                ActivePage:=SomePage;
                CurSeg:=SomePage.Segment;
                CurOfs:=SomePage.Offset;
        end; {SetActivePage}

        {Copies the contents of a page into another page}
        procedure CopyPage(Source:PageType;var Destination:PageType);
    var
            v1seg,v1ofs,v2seg,v2ofs:word;
        begin
        v1Seg:=Source.Segment; v1ofs:=Source.Offset;
                v2Seg:=Destination.segment; v2ofs:=Destination.offset;
        asm
            mov cx,64000
            mov bx,[v1ofs]
            mov dx,[v2ofs]
            @1:
                mov es,[v1seg]
                                mov di,cx
                add di,bx
                            mov al,es:[di]

                mov es,[v2seg]
                mov di,cx
                add di,dx
                                mov es:[di],al
                                dec cx
                        jnz @1
                end; {asm}
        end; {CopyPage}

        {Optimized for copying the contents of a page into the VGA memory}
        procedure CopyPageToVGA(SomePage:PageType);
        var
            vaddr:word;
    begin
            vaddr:=SomePage.segment;
            asm
                        mov cx,64000
            mov bx,OFFSET [SomePage]
            @1:
                mov es,[vaddr]
                mov di,cx
                add di,bx
                            mov al,es:[di]

                mov es,[VGA]
                mov es:[di],al
                dec cx
                        jnz @1
        end; {asm}
        end; {CopyPageToVGA}

        {Copies the contents of the Video buffer into a page}
        procedure CopyVGAToPage(var SomePage:PageType);
    var
            vaddr:word;
    begin
                vaddr:=SomePage.Segment;
            asm
            mov cx,64000
            mov bx,OFFSET [SomePage]
            @1:
                mov es,[VGA]
                mov al,es:[di]

                mov es,[vaddr]
                mov di,cx
                add di,bx
                                mov es:[di],al
                dec cx
            jnz @1
        end; {asm}

        end; {CopyPageToVGA}

        {Disposes the dynamic memory used by the paging procedures}
        procedure KillPage(SomePage:PageType);
        begin
                dispose(SomePage.Page);
        end; {KillPage}

        {Initializes the linked-list structure used by the maps}
        procedure InitMap(var SomeMap:MapType);
        begin
                SomeMap.First:=nil;
                SomeMap.Last:=nil;
                SomeMap.NumItems:=0;
                InitPage(SomeMap.Render);
                SomeMap.Rendered:=FALSE;
        end; {InitMap}

        {Adds a hot area, defined by four coordinates, to the linked list}
        procedure AddHotArea(var SomeMap:MapType;Name:string;bx1,by1,ex1,ey1,bx2,by2,ex2,ey2:word);
        var
                Temp:MapNodePtr;
                TempCord:CordType;
        begin
                new(Temp);
                {nothing in the list}
        if SomeMap.First=nil then begin
                SomeMap.First:=Temp;
            SomeMap.Last:=Temp;
        end {if}
        else
                SomeMap.Last^.next:=Temp;
        SomeMap.Last:=Temp;
        Temp^.next:=nil;
        Temp^.Name:=Name;

        TempCord.x:=bx1; TempCord.y:=by1;
                Temp^.b1:=TempCord;

        TempCord.x:=ex1; TempCord.y:=ey1;
        Temp^.e1:=TempCord;

        TempCord.x:=bx2; TempCord.y:=by2;
        Temp^.b2:=TempCord;

        TempCord.x:=ex2; TempCord.y:=ey2;
        Temp^.e2:=TempCord;
        SomeMap.NumItems:=SomeMap.NumItems+1;
        Temp^.number:=SomeMap.NumItems;
    end; {AddHotArea}

        {Checks and sees if the mouse is inside some area}
        function CheckIfMouseInside(CurrentNode:MapNodeType):boolean;
        begin
                CheckIfMouseInside:=(GetPixel(GetMouseX,GetMouseY)=CurrentNode.Number) and ButtonDown;
        end; {CheckIfMouseInside}


        {For efficency, the image mapping procedures use a page that denotes
         the pre-rendered locations of each hot-area}
        procedure RenderHotAreas(var SomeMap:MapType);
        var
                Temp:MapNodePtr;
                OldPage:PageType;
                OldSeg,OldOfs:word;
                OldColor:byte;
        begin
                OldColor:=GetColor;
                OldSeg:=CurSeg; OldOfs:=CurOfs;
                OldPage:=ActivePage;
                SetActivePage(SomeMap.Render);
                Temp:=SomeMap.First;
                {There are only 256 colors in the display, so you will get some
                 errors if you try to add more than 256 hot-areas}
                while (Temp<>nil) do begin
                        setcolor(Temp^.number);
                        line(Temp^.b1.x,Temp^.b1.y,Temp^.e1.x,Temp^.e1.y);
                        line(Temp^.e1.x,Temp^.e1.y,Temp^.b2.x,Temp^.b2.y);
                        line(Temp^.b2.x,Temp^.b2.y,Temp^.e2.x,Temp^.e2.y);
                        line(Temp^.e2.x,Temp^.e2.y,Temp^.b1.x,Temp^.b1.y);
                        Fill((Temp^.b1.x+Temp^.e1.x) div 2,(Temp^.b1.y+Temp^.b2.y) div 2,Temp^.number,Temp^.number);
                        Temp:=Temp^.next;
                end; {while}
                ActivePage:=OldPage;
                CurSeg:=OldSeg;
                CurOfs:=OldOfs;
                SetColor(OldColor);
        end; {RenderHotAreas}

        {Sees if the user has clicked on a hot area}
        function PollHotAreas(SomeMap:MapType):string;
        var
                Temp:MapNodePtr;
                OldPage:PageType;
                OldSeg,OldOfs:word;
        begin
                OldSeg:=CurSeg; OldOfs:=CurOfs;
                OldPage:=ActivePage;
                SetActivePage(SomeMap.Render);
            Temp:=SomeMap.First;
                while (Temp<>nil) and not CheckIfMouseInside(Temp^) do
                        Temp:=Temp^.next;
        if Temp=nil then
                        PollHotAreas:=Nothing
                else
                PollHotAreas:=Temp^.name;
                ActivePage:=OldPage;
        CurSeg:=OldSeg; CurOfs:=OldOfs;
        end; {PollHotAreas}

        {Deallocates the dynamic memory used in the mapping procedures}
        procedure KillMap(var SomeMap:MapType);
        var
                TempPtr,NextPtr:MapNodePtr;
        begin
                TempPtr:=SomeMap.First;
                while (TempPtr<>nil) do begin
                        NextPtr:=TempPtr^.next;
                        dispose(TempPtr);
                        TempPtr:=NextPtr;
                end; {while}
                KillPage(SomeMap.Render);
        end; {KillMap}

        {Mirrors an image from top-bottom}
        procedure MirrorImage(var SomeImage:ImageType);
        var
                TempImage:ImageType;
                p1Seg,p1Ofs,p2Seg,p2Ofs,HalfX,x,y:word;
                DeltaXPlus,DeltaYPlus:word;
                Temp:byte;
        begin
                DeltaXPlus:=SomeImage.DeltaX+1; DeltaYPlus:=SomeImage.DeltaY+1;
                HalfX:=((DeltaXPlus) div 2)-1;
                for x:=0 to HalfX do begin
                        for y:=0 to SomeImage.DeltaY do begin
                                p1seg:=SomeImage.vSegment;
                                p1ofs:=SomeImage.vOffset+(y*(DeltaXPlus))+x;
                                p2seg:=SomeImage.vSegment;
                                p2ofs:=SomeImage.vOffset+(y*(DeltaXPlus))+abs(SomeImage.DeltaX-x);
                                Temp:=Mem[p1seg:p1ofs];
                                Mem[p1seg:p1ofs]:=Mem[p2seg:p2ofs];
                                Mem[p2seg:p2ofs]:=Temp;
                        end; {for}
                end; {for}
        end; {MirrorImage}

        {Initializes the movie doubly linked-list structure}
        procedure InitMovie(var SomeMovie:MovieType);
        begin
                SomeMovie.Front:=nil;
                SomeMovie.Last:=nil;
                SomeMovie.NumFrames:=0;
        end; {InitMovie}

        {Adds a frame to the end of the movie linked list}
        procedure AddSomeFrame(var SomeMovie:MovieType;x1,y1,x2,y2:word);
        var
                TempPtr:MovieNodePtr;
                TempColor:ColorType;
                x:word;
        begin
                new(TempPtr);
                new(TempPtr^.Palette);
                GetImage(TempPtr^.Picture,x1,y1,x2,y2);
                for x:=0 to 255 do
                        getpalette(x,TempPtr^.Palette^[x]);
                TempPtr^.next:=nil;
                {No items in the list}
                if (SomeMovie.Front=nil) then begin
                        SomeMovie.Front:=TempPtr;
                        TempPtr^.Prev:=nil;
                end {if}
                {Otherwise, do stuff}
                else begin
                        SomeMovie.Last^.next:=TempPtr;
                        TempPtr^.Prev:=SomeMovie.Last;
                end; {else}
                SomeMovie.Last:=TempPtr;
                SomeMovie.NumFrames:=SomeMovie.NumFrames+1;
        end; {AddSomeFrame}

        {Waits until the video card has completed the vertical retrace}
        procedure WaitRetrace; assembler;
        label l1, l2;
        asm
                mov dx,3DAh
                l1:
                        in al,dx
                        and al,08h
                jnz l1
                l2:
                        in al,dx
                        and al,08h
                jz  l2
        end; {WaitRetrace}

        {Draws a frame on the screen}
        procedure DrawSomething(SomeFrame:MovieNodePtr;pX,pY:word;UsePalette:boolean);
        var
                x:byte;
        begin
                WaitRetrace;
                PutImage(SomeFrame^.Picture,pX,pY);
                if UsePalette then begin
                        for x:=0 to 255 do begin
                                SetPalette(x,SomeFrame ^.Palette^[x]);
                        end; {for}
                end; {if}
        end; {DrawSomething}

        {Plays a movie in the specified direction}
        procedure PlayMovie(SomeMovie:MovieType;pX,pY:word;UsePalette:boolean;Direction:DirectionType);
        var
                x:integer;
                TempPtr:MovieNodePtr;
        begin
                if Direction=Foreward then begin
                        TempPtr:=SomeMovie.Front;
                        for x:=1 to SomeMovie.NumFrames do begin
                                DrawSomething(TempPtr,pX,pY,UsePalette);
                                TempPtr:=TempPtr^.next;
                        end; {for}
                end {if}
                else if Direction=Backward then begin
                        TempPtr:=SomeMovie.Last;
                        for x:=1 to SomeMovie.NumFrames do begin
                                DrawSomething(TempPtr,pX,pY,UsePalette);
                                TempPtr:=TempPtr^.prev;
                        end; {for}
                end; {if}
        end; {PlayMovie}

        {Disposes the dynamic memory used by the movie procedures}
        procedure KillMovie(var SomeMovie:MovieType);
        var
                TempPtr,NextPtr:MovieNodePtr;
        begin
            TempPtr:=SomeMovie.Front;
        while (TempPtr<>nil) do begin
                        NextPtr:=TempPtr^.next;
                        dispose(TempPtr);
                        TempPtr:=NextPtr;
                end; {while}
                SomeMovie.Front:=nil;
                SomeMovie.Last:=nil;
                SomeMovie.NumFrames:=0;
        end; {KillMovie}

        {Draws a pixel at the current position at at all the other surreounding
         positions}
        procedure RecursiveFill(x,y:word;FillColor,Border:byte);
        var
                Direction:byte;
        begin
                if (GetPixel(x,y)<>FillColor) and (GetPixel(x,y)<>Border) then begin
            putpixel(x,y);
                    for Direction:=1 to 4 do begin
                                if (Direction=1) and (y>0) then
                            RecursiveFill(x,y-1,FillColor,Border)
                else if (Direction=2) and (x<319) then
                        RecursiveFill(x+1,y,FillColor,Border)
                                else if (Direction=3) and (y<199) then
                        RecursiveFill(x,y+1,FillColor,Border)
                                else if (Direction=4) and (x>0) then
                        RecursiveFill(x-1,y,FillColor,Border);
                end; {for}
            end; {if}
    end; {RecursiveFill}

        {The main procedures the initiates the recursive filling}
        procedure Fill(x,y:word;FillColor,Border:byte);
        var
                OldColor:byte;
        begin
                OldColor:=GetColor;
                setcolor(FillColor);
                RecursiveFill(x,y,FillColor,Border);
                SetColor(OldColor);
        end; {Fill}

begin
        {The default is no initialization}
        HasBeenInitialized:=FALSE;
end. {Graphics}




  • PascalGraphics2


Tatet