{An include file with a lot of interesting graphical functions}

const
     AndPut=1;
     NormalPut=2;
     XORPut=3;
     ORPut=4;
     NoDistort=5;
       {These constants listed above are ways to put down an images which
        has been saved by GetImage.  AndPut ANDs the current pixel value with
        the bitmap value, Xor Xors it, Or Ors it, NormalPut just lays down
        the bitmap, while NoDistort doesn't distort the background}

type PalInfoType=array[0..15] of byte;
     MousePtr=^MouseRec;
     MouseRec=record
        x,y,
        oldx,oldy:integer;
        cursor:pointer;
     end;

     page2type=array[0..64000] of byte;

var Blend:PalInfoType;
    curx,cury:integer;
    minfo:mouseptr;
    msback:pointer;

    page2:^page2type;
{----------------------------------------------------------------------}

procedure Pal(col,r,g,b:byte);
{Change the red, green, and blue intensities of a given color COL}
assembler;
asm
        mov     al,[col]
        mov     dx,03C8h
        out     dx,al
        inc     dx
        mov     al,[r]
        out     dx,al
        mov     al,[g]
        out     dx,al
        mov     al,[b]
        out     dx,al
end;

{----------------------------------------------------------------------}

procedure GetPal(col:byte; var r,g,b:byte);
{Gets the red, green, and blue attributes of color COL}
var rr,gg,bb:byte;
begin
     asm
        mov     dx,03C7h
        mov     al,col
        out     dx,al
        add     dx,2
        in      al,dx
        mov     [rr],al
        in      al,dx
        mov     [gg],al
        in      al,dx
        mov     [bb],al
     end;
     r:=rr;  g:=gg;  b:=bb;
end;

{-----------------------------------------------------------------------}

procedure PutPixel(x,y:integer;  col:byte);
{This puts down a pixel at (X,Y) in color COL}
assembler;
asm
   push         0a000h          {ES = $A000}
   pop          es
   mov          ax,[y]          {AX = Y}
   mov          bx,ax           {BX = Y  (faster than MOV   bx,[y])}
   shl          ax,6            {AX = AX * 64  (Y*64)}
   shl          bx,8            {BX = BX * 128 (Y*256)}
   add          ax,bx           {AX = AX + BX  (Y*64 + Y*256 = Y*320}
   add          ax,[x]          {AX = AX + X  (Y*320 + X)}
   mov          di,ax           {DI (offset) = AX}
   mov          al,[col]        {AL = color}
   stosb                        {ES:DI = Col  (mem[$a000:y*320+x]:=col;)}
end;

{----------------------------------------------------------------------}

procedure SetColor(col,pos:byte);
{This is a unique way to draw a colored line.  A process that Jeremey
uses (he is a genius!).  Anyway, there is an array of max 16 colors (0..15).
You can store color values in as many slots in the array Blend as you want.
Then, when you draw a line, it draws the line in the colors that you specify}
assembler;
asm
   push         bx       {Save AX & BX}
   push         ax
   mov          si,offset Blend    {Set SI to Blend offset}
   xor          bx,bx              {BX = 0}
   mov          al,[col]           {AL = Col(or)}
   mov          bl,[pos]           {BL (BX) = Pos(ition)}
   cmp          bl,15              {If Pos > 15, then get outta here!}
   ja           @Quit
   mov          [si+bx],al         {Blend[BX]:=Col}

@Quit:
   pop          ax
   pop          bx      {Restore AX & BX}
end;

{----------------------------------------------------------------------}

procedure SaveScreen(filename:string);
{Saves the entire screen!}
var f:file;  dummy:word;
    p:pointer;
begin
     assign(f,filename);
     rewrite(f,1);
     p:=ptr($a000,0);           {P = pointer to beginning of video mem}
     blockwrite(f,p^,64000,dummy);
     close(f);
end;

{----------------------------------------------------------------------}

procedure LoadScreen(filename:string);
{Loads an entire screen-saved image}
var f:file;   dummy:word;
    p:pointer;
begin
     assign(f,filename);
     {$I-}
        reset(f,1);
     {$I+}
     if IOResult<>0 then exit;

     p:=ptr($a000,0);
     blockread(f,p^,64000,dummy);
     close(f);
end;

{----------------------------------------------------------------------}

procedure SaveImage(bitmap:pointer; filename:string; where:word);
{This will save an image stored in a bitmap to the hard drive under the file
name you pass.  Each file can contain a max of 65535 different images in it.
Where is the variable which tells the record location for the current image
you are saving...  For example, if you could do:

    saveimage(bitmap,'test.pic',1);

then

    loadimage(bitmap,'test.pic',1);
    putimage(10,10,bitmap,NormalPut);
}
var buf,dummy,tempcount,
    x,y,l1:word;
    f:file;
begin
     buf:=0;  tempcount:=0;
     if where=0 then exit;      {If file location = 0, we've errored!  :(  }
     assign(f,filename);
     if where=1 then
          rewrite(f,1)          {If first record, rewrite file}
     else begin
        {$I-}
          reset(f,1);
        {$I+}
        if IOResult<>0 then exit;
        if where=$ffff then seek(f,filesize(f)) else    {If file location}
     repeat                                             {65353, then go to}
           seek(f,filepos(f)+buf);                      {end of file}
           blockread(f,x,2,dummy);
           blockread(f,y,2,dummy);
           buf:=(x+1)*(y+1);        {Finds the linear length of each}
           inc(tempcount);          {previous bitmap}
     until tempcount=where;
     end;

     x:=memw[seg(bitmap^):ofs(bitmap^)];
     y:=memw[seg(bitmap^):ofs(bitmap^)+2];

     blockwrite(f,x,2,dummy);
     blockwrite(f,y,2,dummy);

     l1:=(y+1)*(x+1);        {Calculates linear length of current bitmap}
     blockwrite(f,bitmap^,l1+2,dummy);
     close(f);
end;

{----------------------------------------------------------------------}

procedure LoadImage(var bitmap:pointer; filename:string; where:word);
var xdiff,ydiff,l1,dummy,
    tempcount,buf:word;
    f:file;
begin
     buf:=0;   tempcount:=0;
     assign(f,filename);
     {$I-}
       reset(f,1);
     {$I+}
     if IOResult<>0 then begin
        close(f);
        exit;
     end;

     repeat
           seek(f,filepos(f)+buf);
           blockread(f,xdiff,2,dummy);
           blockread(f,ydiff,2,dummy);
           buf:=(xdiff+1)*(ydiff+1);
           inc(tempcount);
     until tempcount=where;

     getmem(bitmap,(xdiff+1)*(ydiff+1));

     memw[seg(bitmap^):ofs(bitmap^)]:=xdiff;
     memw[seg(bitmap^):ofs(bitmap^)+2]:=ydiff;

     l1:=(ydiff+1)*(xdiff+1);
     blockread(f,bitmap^,l1,dummy);
     close(f);
end;

{----------------------------------------------------------------------}

procedure wait;   {Clears the keyboard buffer, and waits for a keypress}
var r:char;
begin
  MEM[$0040:$001A]:=MEM[$0040:$001C];  {Clears keyboard buffer}
  r:=readkey;
end;

{----------------------------------------------------------------------}

procedure GetImageASM(x1,y1,x2,y2:integer; bitmap:pointer);
var xorig:integer;
begin
     getmem(bitmap,(x2-x1+1)*(y2-y1+1)+4);
     asm
        push    ds

        les     di,[bitmap]

        mov     ax,[x1]
        mov     [xorig],ax

        mov     ax,[x2]
        mov     cx,ax
        sub     ax,[x1]
        inc     ax
        stosw

        mov     ax,[y2]
        mov     dx,ax
        sub     ax,[y1]
        inc     ax
        stosw

        mov     ax,0A000h
        mov     ds,ax

     @RepeatX:
        mov     ax,[y1]
        mov     bx,ax
        shl     ax,6
        shl     bx,8
        add     ax,bx
        mov     si,ax
        add     si,[x1]

        inc     [x1]
        cmp     cx,[x1]
        jne     @RepeatX

        inc     [y1]
        cmp     dx,[y1]
        mov     ax,[xorig]
        mov     [x1],ax
        jne     @RepeatX

        pop     ds
     end;
end;

{----------------------------------------------------------------------}

procedure ClearPalette;
{Initializes the Blend Array}
assembler;
asm
   mov      si,offset Blend   {Prepare to clear out blend palette array}
   xor      bx,bx
   xor      ax,ax               {AX = BX = 0}
   mov      cx,16               {Slots in array}
   @ClearArray:
      mov      [si+bx],al
      inc      bx               {BX = BX + 1}
      loop     @ClearArray
end;

{----------------------------------------------------------------------}

procedure GetImage(x1,y1,x2,y2:integer; var bitmap:pointer; needmem:boolean);
{This simply stores the box designated by (x1,y1)-(x2,y2) into the pointer
   NeedMem is a boolean.  If true, then this procedure gets the necessary
   memory for the pointer.  Else, it relies on the programmer getting the mem
   in his procs. (if NeedMem is false)}
var l1,l2,factor:word;
begin
     factor:=3;
     if needmem then
        getmem(bitmap,(x2-x1+1)*(y2-y1+1)+4);
     memw[seg(bitmap^):ofs(bitmap^)]:=(x2-x1);
     memw[seg(bitmap^):ofs(bitmap^)+2]:=(y2-y1);
     for l1:=y1 to y2 do
         for l2:=x1 to x2 do begin
             inc(factor);
             mem[seg(bitmap^):ofs(bitmap^)+factor]:=mem[$A000:(l1*320)+l2];
         end;
end;

{----------------------------------------------------------------------}

procedure PutImage(x,y:integer; bitmap:pointer; mode:byte);
var l1,l2,factor,xdiff,ydiff:word;
{This simply puts the image stored in a pointer back onto the screen.  It can
 XorPut it, AndPut it, NOrmal Put it, NoDistort (doesn't distort background,
 or ORPut it...}
begin
     factor:=3;
     xdiff:=memw[seg(bitmap^):ofs(bitmap^)];
     ydiff:=memw[seg(bitmap^):ofs(bitmap^)+2];
     for l1:=y to (y+ydiff) do
         for l2:=x to (x+xdiff) do begin
             inc(factor);
             case mode of
               NormalPut:mem[$a000:(320*l1)+l2]:=
                                 mem[seg(bitmap^):ofs(bitmap^)+factor];
               AndPut:mem[$a000:(320*l1)+l2]:=mem[$A000:(320*l1)+l2] and
                                 mem[seg(bitmap^):ofs(bitmap^)+factor];
               XORPut:mem[$a000:(320*l1)+l2]:=mem[$A000:(320*l1)+l2] xor
                                 mem[seg(bitmap^):ofs(bitmap^)+factor];
               ORPut:mem[$a000:(320*l1)+l2]:=mem[$A000:(320*l1)+l2] or
                                 mem[seg(bitmap^):ofs(bitmap^)+factor];
               NoDistort:if mem[seg(bitmap^):ofs(bitmap^)+factor]<>0 then
                                mem[$a000:(320*l1)+l2]:=
                                   mem[seg(bitmap^):ofs(bitmap^)+factor];
             end;
         end;
end;

{----------------------------------------------------------------------}

procedure initgraph(mode:byte);
{Initializes the graphics card.  If mode = 1  --> 320x200x256...
                                 If mode = 0  -->  Text mode (80x25)}
assembler;
asm
   push     ax          {Save AX & BX}
   pop      bx
   xor      ax,ax       {AX=0}
   mov      bh,[mode]   {AH=Mode}
   cmp      bh,0        {Does Mode=0}
   ja       @ModeX      {If Mode<>0 then set ModeX}
   mov      ax,3        {AX = 3  (Set text mode)}
   int      10h         {Initialize graphics (call interrupt 10h)}
   jmp      @AllDone    {Let's get the hell outta here}

 @ModeX:                {Initialize 320x200x256}
   mov      ax,13h      {AX=13h  (320x200x256 (Mode-X))}
   int      10h
   mov      si,offset Blend   {Prepare to clear out blend palette array}
   xor      bx,bx
   xor      ax,ax               {AX = BX = 0}
   mov      cx,16               {Slots in array}
   @ClearArray:
      mov      [si+bx],al
      inc      bx               {BX = BX + 1}
      loop     @ClearArray

 @AllDone:
   pop      bx
   pop      ax          {Restore AX & BX}
end;

{----------------------------------------------------------------}

procedure line(xa,y1,xb,y2:integer; pos:byte);
{Draws a line from (xa,y1) to (xb,y2) in color COL...

       This procedure was created by some smart graphics guy who worked at
       IBM.  ANyway, what this does, instead of using real tricky math (no
       pun intended) by using the quadratic, this procedure closes in
       horizontally on the center of the line.  If this is our line, and the
       period represents the center, then we just execute a loop which
       plots points at XA,Y1 and XB,Y2.

               (xa,y1)
                    \
                     \
                      \
                       .
                        \
                         \
                          \
                         (xb,y2)

       We then increase XA by one and decrease XB by one.  We then have a
       rather simple equation that determines if our y value will change.  If
       the equation is positive, that means, "Hey, change the Y value by one."
       If it is negative, do nothing.  So, if it is positive, we increment Y1
       by one and decrement Y2 by one.  We repeat this until XA=XB.  Simple &
       Fast....  :)  (About 5 times faster than using real math!)}

var var1,dummy,var2,deltax,deltay,d:integer;
    ncol:byte;
    xahi,y1hi,done:boolean;

    {************************************************************}

       procedure HLine(x1,x2,y:integer; col:byte);
       {Draws a horizontal line}
       var ncol:byte;
           dummy:integer;
       begin
            if x1>x2 then begin dummy:=x1;  x1:=x2;  x2:=dummy; end;
            {Checks to see if x vars need to be switched}
            repeat
                  ncol:=blend[random(pos+1)];
                  putpixel(x1,y,ncol);
                  putpixel(x2,y,ncol);
                  inc(x1);   dec(x2);   {Closes in horizontally}
            until x1>x2;
       end;

    {************************************************************+}

       procedure VLine(x,y1,y2:integer; col:byte);
       {Draws a verticle line}
       var ncol:byte;
           dummy:integer;
       begin
            if y1>y2 then begin dummy:=y1; y1:=y2; y2:=dummy; end;
            {Checks to see if y vars need to be switched}
            repeat
                  ncol:=blend[random(pos+1)];
                  putpixel(x,y1,ncol);  putpixel(x,y2,ncol);

                  inc(y1);  dec(y2);   {Closes in vertically}
            until y1>y2;
       end;

    {************************************************************+}

begin
     xahi:=false;  y1hi:=false;   done:=false;
     ncol:=blend[random(pos+1)];

     if (y1=y2) and (xa=xb) then begin
        putpixel(xa,y1,ncol);
        exit;
     end;

     if xa>xb then xahi:=true;   {Notifies proc. if xa > xb or y1>y2}
     if y1>y2 then y1hi:=true;

  {@@@@@@@@@@@@@@@@@@@@@@@@@@@ HOR/VOR CHECK @@@@@@@@@@@@@@@@@@@@@@@@@@@@}

     if y1=y2 then begin      {Checks to see if it should draw a horizontal}
        HLine(xa,xb,y1,pos);  {line or not...}
        exit;
     end;

     if xa=xb then begin
        VLine(xa,y1,y2,pos);  {Checks to see if it should draw a verticle}
        exit;                 {line or not...}
     end;

  {@@@@@@@@@@@@@@@@@@@@@@@@@@@ HOR/VOR CHECK @@@@@@@@@@@@@@@@@@@@@@@@@@@}

     deltay:=abs(y2-y1);  deltax:=abs(xa-xb);{\      }
     d:=(deltay shl 1) - deltax;            {   \    }
     var1:=deltay shl 1;                    {    Set in stone variables}
     var2:=(deltay - deltax) shl 1;          {  /    }

   repeat
     ncol:=blend[random(pos+1)];

     putpixel(xa, y1, ncol);  { Draw a pixel at upper-left tracer }
     putpixel(xb, y2, ncol);  { Draw a pixel at the lower-right tracer }

     if d<0 then        {If d = - then no y change}
        d:=d+var1       {Add VAR1 to d}
     else begin
         d:=d+var2;     {Add VAR2 to d}
         if not(y1hi) then begin
             inc(y1); dec(y2);
             {Since d = +, bring down YA (y1) and shove YB up}
         end else begin
             dec(y1); inc(y2);
         end;
     end;
     if not(xahi) then begin
           inc(xa); dec(xb); {Close in horizontally}
           if xa>xb then done:=true;
     end else begin
           dec(xa);  inc(xb);
           if xb>xa then done:=true;  {See if completed drawing line}
     end;
   until xa>xb
end;

{----------------------------------------------------------------------}

procedure Cls(col:byte);
{Clears the screen in color COL}
assembler;
asm
   mov  cx,64000
   push 0A000h
   pop  es
   xor  di,di
   mov  al,[col]
   rep  stosb
end;

{---------------------------------------------------------------------}

procedure FadeASM(delay:word);
{This fades out the colors evenly.  The speed of the fade is determined by
 the delay value passed}
assembler;
var redl,greenl,bluel:byte;
   asm
        mov     [redl],63
        mov     [greenl],63     {Set Level Vars to MAX}
        mov     [bluel],63
        {-----------------------------------------------}

            {This block decrements the shade by one, 64 times:}


     @MainLoop:

        mov    dx,100
        @delaylooptop:
            mov    cx,[delay]
        @delayloop:                             {The delay loop}
                   loop   @delayloop
                   dec    dx
                   cmp    dx,0
                   ja     @delaylooptop

        xor        ax,ax          {Sets AH & AL to 0}

        @DecrementShade:
           {----------------------------------------------}
              {Makes PORT Calls and stores Red,Green,& Blue

                 Registers Destroyed:
                           DX     BH
                           AL     CL
                           BL     AH   }
             mov     dx,03C7h        {Write to Port $3c7}
             mov     al,ah           {set AL = to AH (AL = COlor Value)}
             out     dx,al           {Send color to port $3c7}
             add     dx,2            {Write to Port $3c9}
             in      al,dx           {Get port value}
             mov     bl,al           {BL = red}
             in      al,dx           {Get port value}
             mov     bh,al           {BH = green}
             in      al,dx           {Get port value}
             mov     cl,al           {CL = blue}
             mov     al,ah           {Reset AL to color value (AH)}

             {------------------------------------------}
                {Checks to see if levels need to be decremented

                   Registers Destroyed =
                          BL    BH
                          CL   }
             cmp      bl,[redl]       {Does Red = RedL(evel)?}
             jna      @skipred

                dec      bl

             @skipred:
              cmp     bh,[greenl]               {If the color's value is}
              jna     @skipgreen                {greater than greenl, then
                                                 decrement by one}
                dec      bh

             @skipgreen:
              cmp     cl,[bluel]
              jna     @skipblue

                 dec    cl

             @skipblue:
             {--------------------------------------}
                 {Sends to Port to confirm palette changes}
        mov     dx,03C8h
        out     dx,al
        inc     dx
        mov     al,bl    {Move RED into AL}
        out     dx,al    {Send to port}
        mov     al,bh    {Move GREEN into AL}
        out     dx,al
        mov     al,cl   {Move Blue (CL) into AL}
        out     dx,al

        {---------------------------------------------}

              inc     ah     {Increment COLOR NUMBER}

              cmp     ah,255
              jne     @DecrementShade    {Are we at color 255 yet?  If not
                                          goto decrementshade}
              dec     [redl]
              dec     [greenl]    {Decrement necessary color values}
              dec     [bluel]

              cmp     [redl],0    {Have we looped trough MainLoop 64 times?}
              je      @QuitLoop   {If so, Quit}
              jmp     @MainLoop     {ELSE goto MainLoop}

     @QuitLoop:
end;

{----------------------------------------------------------------------}

procedure Clear(x1,y1,x2,y2:integer; pos:byte);
{This draws a filled rectangle from (x1,y1) to (x2,y2)}
var loop,l2:word;
begin
     for loop:=y1 to y2 do
         for l2:=x1 to x2 do
             PutPixel(l2,loop,blend[random(pos+1)]);
end;

{----------------------------------------------------------------------}

procedure rect(x1,y1,x2,y2:integer; pos:byte);
{Draws a hollow rectangle from (x1,y1) to (x2,y2)}
begin
     line(x1,y1,x2,y1,pos);
     line(x2,y1,x2,y2,pos);
     line(x2,y2,x1,y2,pos);
     line(x1,y1,x1,y2,pos);
end;

{----------------------------------------------------------------------}

--=====================_837406168==_--

