home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / C128 / TBOHIRES.PAS < prev    next >
Pascal/Delphi Source File  |  2000-06-30  |  6KB  |  191 lines
  1. program tbohires;   (* 80 col graphics for c128 cp/m *)
  2.                     (* integrated from various magazine articles and *)
  3.                     (* c128 prog ref guide *)
  4.                     (* leonard howie *)
  5.  const
  6.    vdcport=$d600; vdcplus1=$d601;    (* port addresses for 8563 chip *)
  7.  
  8.  type
  9.     mask_array = array[0..7] of byte;
  10.  
  11.  var
  12.    waitport,portreg,regbyte:byte;
  13.    x,y,lcol,lrow:integer;
  14.    ytemp:real;
  15.    m: mask_array;
  16.    ChrAry:Array[0..8192] of byte;
  17.  
  18.  (* ============= screen plotting routines - 8563 vdc chip =========== *)
  19.  
  20.   (* 8 mar 87-bitmapping the 8563 video display controller *)
  21.                    (* commodore 128 cp/m - turbo pascal *)
  22.  
  23.  Procedure RamAddr(z:integer);Forward;
  24.  
  25.  procedure readvdc;             (* this routine reads any 8563 register *)
  26.  begin
  27.    port[vdcport]:=portreg;               (* desired register number to port *)
  28.    repeat
  29.      waitport:=(port[vdcport]) and 128;  (* read address port value  *)
  30.    until waitport=128;                   (* until bit 7 is one *)
  31.    regbyte:=port[vdcplus1];              (* then read the data port *)
  32.  end;
  33.  
  34.  
  35.  procedure writevdc;             (* this routine writes to any 8563 register *)
  36.  begin
  37.    port[vdcport]:=portreg;               (* desired register number to port *)
  38.    repeat
  39.      waitport:=(port[vdcport]) and 128;  (* read address port value  *)
  40.    until waitport=128;                   (* until bit 7 is one *)
  41.    port[vdcplus1]:=regbyte;              (* then write to the data port *)
  42.  end;
  43.  
  44. (* Procedures Save_Char and Load_Char added 8/24/87 T. Dolan *)
  45.  
  46. Procedure Save_Char;
  47.  
  48. Begin
  49. WriteLn(^Z);
  50. WriteLn('Saving Character Ram to Memory');
  51. For Y := 8192 to 16384 Do                  (* Start of VDC Char Ram *)
  52.    Begin
  53.       RamAddr(Y);
  54.       Portreg := 31;                       (* Split 16 bit Value *)
  55.       ReadVdc;                             (* Read Value from VDC Ram *)
  56.       ChrAry[Y-8192] := RegByte;           (* Store it in an array *)
  57.    End;
  58. End;
  59.  
  60. (* Load_Char has the same basic syntax as Save_Char only it writes the saved
  61.    values back into the VDC Ram *)
  62.  
  63. Procedure Load_Char;
  64.  
  65. Begin
  66. For Y := 8192 to 16384 Do
  67.    Begin
  68.       RamAddr(Y);
  69.       PortReg := 31;
  70.       RegByte := ChrAry[Y-8192];
  71.       WriteVdc;
  72.    End;
  73. End;
  74.  
  75.  procedure zeroram;
  76.  begin
  77.    regbyte:=0;
  78.    portreg:=14;   writevdc;              (* all addresses at start of ram *)
  79.    portreg:=15;   writevdc;
  80.    portreg:=18;   writevdc;
  81.    portreg:=19;   writevdc;
  82.  end;
  83.  
  84.  
  85.  procedure setbitmap;                (* put a 1 in bit 7, reg 25 for bitmap *)
  86.  begin                               (* version 7a 8563 chip - value is 128 *)
  87.    portreg:=25;                      (* versions 8 & 9 chips - value is 135 *)
  88.    regbyte:=135;                     (* -otherwise horiz scroll is affected *)
  89.    writevdc;
  90.  end;
  91.  
  92.  procedure colormap;
  93.  begin
  94.    portreg:=26;
  95.    regbyte:=144;                     (* good value for monochrome *)
  96.    writevdc;                         (* go for self on color      *)
  97.  end;
  98.  
  99.  procedure fillmap(dumbyte:byte);
  100.  begin
  101.    zeroram;
  102.    portreg:=31;
  103.    regbyte:=dumbyte;
  104.    for lrow:=1 to 200 do begin
  105.      for lcol :=1 to 80 do writevdc;
  106.    end;
  107.  end;
  108.  
  109.  procedure setmask;                (* set correspondence between remainder *)
  110.  var l:integer;                    (* after (div 8) and position in byte   *)
  111.  begin
  112.    m[7]:=1;
  113.    for l:=6 downto 0 do
  114.      m[l]:=2*m[l+1];
  115.  end;
  116.  
  117.  
  118.  procedure ramaddr;
  119.                          (* set pointer to desired 8563 chip ram byte *)
  120.  var
  121.    hybyte,lobyte:byte;
  122.    hyval,loval:integer;
  123.  
  124.  begin
  125.    hyval:=hi(z);               (* get hi & lo bytes of 16 bit int  *)
  126.    loval:=lo(z);
  127.    hybyte:=ord(chr(hyval));    (* convert to byte *)
  128.    lobyte:=ord(chr(loval));
  129.    portreg:=18;                (* regs 18,19 pair is pointer to chip ram *)
  130.    regbyte:=hybyte;
  131.    writevdc;
  132.    portreg:=19;
  133.    regbyte:=lobyte;
  134.    writevdc;
  135.   end;
  136.  
  137.  
  138.  procedure plotvdc(mapcol,maprow:integer);
  139.  var                               (*   plot a dot in vdc memory   *)
  140.    bytenr,leftbit,lmask:integer;
  141.    savebyte:byte;
  142.  begin
  143.    bytenr:=maprow*80 + mapcol div 8;
  144.    leftbit := mapcol mod 8;
  145.    lmask := m[leftbit];
  146.    ramaddr(bytenr);
  147.    portreg := 31;
  148.    readvdc;
  149.    savebyte := regbyte or lmask;
  150.    ramaddr(bytenr);
  151.    portreg := 31;
  152.    regbyte := savebyte;
  153.    writevdc;
  154.   end;
  155.  
  156.  (* ===================  demo-plotting example ======================= *)
  157.  
  158.  begin
  159.   Save_Char;
  160.   writeln;
  161.   writeln('******** cp/m hires graphics example for the c-128 ********');
  162.   WriteLn('Hit Return to Continue');
  163.   readln(x);
  164.   setbitmap;                            (* put 8563 in the bitmap mode *)
  165.   colormap;                             (* set bitmap color *)
  166.   fillmap(0);                           (* clear the screen *)
  167.   setmask;                              (* compute pixel mask array m *)
  168.  
  169.                                         (* plot 1/2 of a parabola *)
  170.   for x := 0 to 639 do begin
  171.     ytemp := x*1.0;
  172.     ytemp := ytemp*ytemp*199.0/(639.0*639.0);
  173.     y := trunc(ytemp);
  174.     plotvdc(x,y);
  175.   end;
  176.  
  177.   Delay(500);                       (* hold the plot on screen *)
  178.   writeLn(^G);
  179.   PortReg := 25;
  180.   regbyte := 71;                    (*  Version 7a regbyte = 64   *)
  181.   writevdc;                         (* Version 8 & 9 regbyte = 71 *)
  182.   WriteLn(^Z);
  183.   WriteLn(^[^[^['12');
  184.   WriteLn('Please wait while the character set is reloaded into VDC ram');
  185.   WriteLn;
  186.   WriteLn('This will take a few seconds to do');
  187.   Load_Char;
  188.   WriteLn('All Done');
  189.  end.
  190.  
  191.