ftp.barnyard.co.uk/2015.02.ftp.barnyard.co.uk.tar/ftp.barnyard.co.uk/cpm/walnut-creek-CDROM/MBUG/MBUG099.ARC/HIRES2.I

Text File | 1979-12-31 | 6KB | 210 lines

{Collection of routines for implementing HIRES2 Graphics in Turbo Pascal
 by Simon Carter Copyright 3/7/1988

 HIRES2 procedures : Hires2      - Sets up screen ready for HIRES2
                     Text        - Masks text onto graphics
                     Dot         - Sets, inverts or resets dot
                     Point       - Tests condition of point
                     Plot        - Plots line with Dot
                     Circle      - Draws circles
                     Arc         - Draws arcs
                     PlotBox     - Plots boxes
                     Fill        - Fills shapes
                     ScreenDump  - Hires2 screendump
                     Normal      - Sets up 80x24, de-allocates screen}

{$I Inverse.I}
{$U-,C-,I-,V-}


type
  Operation = (ResDot,SetDot,InvDot);
  Script = String[255];
  FileSpec = String[80];

var
  PCGRAM : Byte absolute $F800;


Procedure HIRES2;
{This routine : 1. Sets up the screen in 64x16 mode
                2. Sets up bank allocation in the attribute RAM
                3. Clears the PCGs in all banks
                4. Fills the screen with PCGs ready to use}

var
  Bank, Character : Byte;


Procedure Set64_16;

Begin
  Inline ($21/*+36/    {          LD      HL,DATA }
          $C5/         {          PUSH    BC      }
          $E5/         {          PUSH    HL      }
          6/$10/       {          LD      B,16    }
          $78/         { LOOP     LD      A,B     }
          $3D/         {          DEC     A       }
          $D3/$0C/     {          OUT     (0C),A  }
          $7E/         {          LD      A,(HL)  }
          $D3/$0D/     {          OUT     (0D),A  }
          $2B/         {          DEC     HL      }
          $10/$F6/     {          DJNZ    LOOP    }
          6/$4B/       {          LD      B,75    }
          $E1/         {          POP     HL      }
          $C1/         {          POP     BC      }
          $C9/         {          RET             }

          $6B/         {          DB      $6B     }
          $40/         {          DB      $40     }
          $51/         {          DB      $51     }
          $37/         {          DB      $37     }
          $12/         {          DB      $12     }
          9/           {          DB      9       }
          $10/         {          DB      16      }
          $11/         {          DB      17      }
          $48/         {          DB      $48     }
          $0F/         {          DB      15      }
          $2F/         {          DB      $2F     }
          $0F/         {          DB      15      }
          0/           {          DB      0       }
          0/           {          DB      0       }
          0/           {          DB      0       }
          0);          { DATA     DB      0       }
End;



Begin
  ClrScr;
  Set64_16;

  Port[28] := 144;
  for Bank := 0 to 7 do
    for Character := 0 to 127 do
      Mem[$F000 + (Bank * 128) + Character] := Bank;

  for Bank := 7 downto 0 do
    begin
    Port[28] := 128 + Bank;
    FillChar(PCGRAM,2048,0);
    end;

  for Bank := 0 to 7 do
    for Character := 0 to 127 do
      Mem[$F000 + (Bank * 128) + Character] := Character + 128;
End;


{$I Dot.I}
{$I Text.I}
{$I Point.I}
{$I GrDsk.I}
{$I Plot.I}
{$I Circle.I}
{$I Arc.I}
{$I Box.I}
{$I Fill.I}
{$I HiDump.I}


Procedure Normal;
{This procedure 1. Puts screen back in 80x24 mode
                2. Resets bank allocation in attribute RAM
                3. Inverts all bank's PCGs}

var
  Count : Byte;
  Screen : Integer;

Procedure Set80_24;

Begin
  Inline ($21/*+36/    {          LD      HL,DATA }
          $C5/         {          PUSH    BC      }
          $E5/         {          PUSH    HL      }
          6/$10/       {          LD      B,16    }
          $78/         { LOOP     LD      A,B     }
          $3D/         {          DEC     A       }
          $D3/$0C/     {          OUT     (0C),A  }
          $7E/         {          LD      A,(HL)  }
          $D3/$0D/     {          OUT     (0D),A  }
          $2B/         {          DEC     HL      }
          $10/$F6/     {          DJNZ    LOOP    }
          6/$4B/       {          LD      B,75    }
          $E1/         {          POP     HL      }
          $C1/         {          POP     BC      }
          $C9/         {          RET             }

          $6B/         {          DB      $6B     }
          $50/         {          DB      $50     }
          $58/         {          DB      $58     }
          $37/         {          DB      $37     }
          $1B/         {          DB      $1B     }
          5/           {          DB      5       }
          $18/         {          DB      $18     }
          $19/         {          DB      $19     }
          $48/         {          DB      $48     }
          10/          {          DB      10      }
          $2A/         {          DB      $2A     }
          10/          {          DB      10      }
          $20/         {          DB      $20     }
          0/           {          DB      0       }
          0/           {          DB      0       }
          0);          { DATA     DB      0       }
End;


Begin
  ClrScr;
  Set80_24;

  Port[28] := 144;
    for Screen := 0 to 1920 do
      Mem[$F000 + Screen] := 0;

  for Count := 135 downto 128 do
    begin
    Port[28] := Count;
    Inverse;
    end;
End;




{Main Program}
Begin
  Hires2;
  PlotBox(0,0,511,255,SetDot);
  Circle(255,128,200,160,SetDot);
  Arc(383,128,40,64,90,270,SetDot);
  Arc(128,128,40,64,270,90,SetDot);
  Plot(383,192,128,192,SetDot);
  Plot(128,64,383,64,SetDot);

  Circle(255,168,50,10,SetDot);
  Arc(255,88,50,10,180,360,SetDot);
  Plot(205,168,205,88,SetDot);
  Plot(305,88,305,168,SetDot);

  Text(17,3,'Simon Carter wrote ALL of this!!',SetDot);

  Plot(250,123,260,123,SetDot);
  Plot(260,123,255,133,SetDot);
  Plot(255,133,250,123,SetDot);
  Fill(255,128);

  repeat until KeyPressed;

  GRSave('M:TEST.GRA');
  Delay(1000);
  Hires2;
  GRLoad('M:TEST.GRA');

  repeat until KeyPressed;

  ScreenDump;
  Normal;
End.