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

Text File | 1979-12-31 | 5KB | 201 lines

                               TURBO HIRES2

                              By Simon Carter

Thi≤ montΦ wσ presen⌠ procedure≤ t∩ dump¼ savσ anΣ loaΣ Hires▓ screens¼ áa≤ ì
wel∞ a≤ ß fil∞ procedure« (oµ sorts!⌐

╔ áfounΣ átha⌠ áwheε áusinτ Online'≤ Pasca∞ áscreendum≡ ároutine¼ áthσ áRO═ ì
character≤ áprinteΣ áa≤ garbage«  Herσ i≤ ß procedurσ t∩ ádum≡ áthσ áHires▓ ì
screeε usinτ BDO╙ call≤ t∩ ß paralle∞ printer.

Procedure ScreenDump;

const
  ScreenRam = $F000;

var
  Column, Row, Bank   : Byte;
  Store, Location   : Integer;


Procedure Lprint;

Begin
InLine($2A/Store/        {       LD      HL,(STORE) }
       $11/$0F/$F0/      {       LD      DE,0F00FH  }
       $29/              {       ADD     HL,HL      }
       $29/              {       ADD     HL,HL      }
       $29/              {       ADD     HL,HL      }
       $29/              {       ADD     HL,HL      }
       $19/              {       ADD     HL,DE      }
       $06/$10/          {       LD      B,16       }
       $5E/              {READ   LD      E,(HL)     }
       $C5/              {       PUSH    BC         }
       $E5/              {       PUSH    HL         }
       $F5/              {       PUSH    AF         }
       $0E/$05/          {       LD      C,5        }
       $CD/$05/$00/      {       CALL    0005       }
       $F1/              {       POP     AF         }
       $0E/$05/          {       LD      C,5        }
       $CD/$05/$00/      {       CALL    0005       }
       $E1/              {       POP     HL         }
       $C1/              {       POP     BC         }
       $2B/              {       DEC     HL         }
       $10/$EC);         {       DJNZ    READ       }
End;



Begin
Write(LST,#27'A'#8);
for Column := 0 to 63 do
  begin
  Write(LST,#27'K'#0#2);
  for Row := 15 downto 0 do
    begin
     Location := ScreenRam + Column + Row * 64;
     Store := Mem[Location];
     Port[28] := 144;è     Bank := Mem[Location];
     Port[28] := Bank + 128;
     Lprint;
     Port[28] := 128;
    end;
    WriteLn(LST);
  end;
Write(LST,#27'A'#9);
End;



GRSave procedure
  Thi≤ áprocedurσ save≤ thσ curren⌠ Hires▓ screeε t∩ disk¼ b∙ blocδ ámovinτ ì
thσ á╕ ábank≤ oµ PCG≤ sequentiall∙ int∩ ß buffer¼ anΣ theε t∩ ß áfile« á T∩ ì
cal∞ áit¼ givσ ß filenamσ a≤ ß parameter¼ bu⌠ notσ tha⌠ iµ thσ filσ áexist≤ ì
i⌠ wil∞ bσ ERASED¼ iµ no⌠ i⌠ wil∞ bσ created.


Procedure GRSave(FileName : FileSpec);

var
  I : Byte;
  Buffer : array [0..$7FF] of byte;
  Outfile : file;

Begin
  Assign(Outfile,FileName);
  Rewrite(Outfile);

  for I := 128 to 135 do
    begin
    Port[28] := I;
    Move(PCGRAM,Buffer,$800);
    BlockWrite(Outfile,Buffer,16);
    end;
  Close(Outfile);
  Port[28] := 128;
End;


GRLoad procedure
  Thi≤ áprocedurσ load≤ iε thσ ╕ bank≤ oµ PC╟ datß int∩ ß buffe≥ áanΣ átheε ì
int∩ áPC╟ áRAM« á N∩ check≤ arσ madσ t∩ seσ iµ thσ disδ filσ ápasseΣ áa≤ áß ì
paramete≥ áexists« á(Bu⌠ ß routinσ t∩ checδ ß file'≤ existencσ i≤ áiε áyou≥ ì
USER'╙ MANUALí Yo⌡ kno≈ ¡ tha⌠ booδ yo⌡ go⌠ wheε yo⌡ bough⌠ Pascal?)


Procedure GRLoad(FileName : FileSpec);

var
  I : Byte;
  Buffer : array [0..$7FF] of byte;
  Infile : file;

Begin
  Assign(Infile,FileName);
  Reset(Infile);
è  for I := 128 to 135 do
    begin
    Port[28] := I;
    BlockRead(Infile,Buffer,16);
    Move(Buffer,PCGRAM,$800);
    end;
  Close(Infile);
  Port[28] := 128;
End;




FILL procedure
  Thi≤ ái≤ áß árecursivσ procedurσ tha⌠ wil∞ fil∞ SMAL╠ áobjects« á Iµ áyo⌡ ì
attemp⌠ át∩ fil∞ LARG┼ object≤ yo⌡ wil∞ ge⌠ ß ruε-timσ erro≥ messagσ áF╞ á¡ ì
Insufficien⌠ freσ memor∙ available«  A⌠ presen⌠ ╔ haven'⌠ seeε ß wa∙ arounΣ ì
this¼ bu⌠ yo⌡ migh⌠ ¡ s∩ le⌠ thσ res⌠ oµ u≤ know!


{$A-}
Procedure Fill(X,Y : Integer);
Begin
    Dot(X,Y,SetDot);
      if Point(X,Y + 1) = 0 then Fill(X, Y + 1);
      if Point(X + 1,Y) = 0 then Fill(X + 1, Y);
      if Point(X,Y - 1) = 0 then Fill(X, Y - 1);
      if Point(X - 1,Y) = 0 then Fill(X - 1, Y);
End;
{$A+}


And finally, a demo for the whole lot of them :


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,'This masks text onto the screen',SetDot);

  PlotBox(250,160,255,170,SetDot);
  PlotBox(255,160,260,170,SetDot);
  Dot(255,165,ResDot);
  Fill(255,168);

  repeat until KeyPressed;

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

  repeat until KeyPressed;

  ScreenDump;
  Normal;
End.


That'≤ áití á ╔ hopσ you'vσ founΣ somσ oµ thi≤ usefull«  Remember¼ áiµ áyo⌡ ì
thinδ u≡ an∙ routines¼ senΣ theφ iε t∩ thσ Catcher.



No time to type them in?
Send $5, a stamped, self - addressed envelope and 5.25" disk to
              Simon Carter,
            14 Canterbury Rd,
            Heathmont, 3135.
anΣ ╔ wil∞ fil∞ you≥ disδ witΦ Hires▓ routine≤ anΣ anythinτ elsσ tha⌠ come≤ ì
t∩ mind....