ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/MISC/NETWORK/PCPRL11.ZIP/DEVMAN.PLS

Text File | 1992-02-06 | 4.5 KB | 230 lines

program devman;

{$N+,E+,F+}

uses dos, crt, both,work, graph;

const
  num_colu = 2;
  num_proc = 1;

type
  complex = record
    realp,
    imag   : double;
  end;

  resu = array[1..200*num_colu] of integer;


var
  gap1,
  gap2             : double;
  bcorner          : complex;

  i,
  j,
  cur_col,
  num_col,
  pix_col,
  start_col,
  tot_col          : integer;
  results          : resu;

  graphdriver,
  graphmode        : integer;



procedure start_up;

begin

  exitsave := exitproc;
  exitproc := @myexit;

  master[1] := $00;
  master[2] := $00;
  master[3] := $C0;
  master[4] := $05;
  master[5] := $86;
  master[6] := $24;

  init_system;

end;


procedure adder;


type

  complex = record
    realp,
    imag   : double;
  end;

var
  gap1, gap2,
  a,b,c,
  size      : double;
  bcorner,
  ncomplex,
  original  : complex;
  cur_col,
  tot_col,
  num_col,
  pix_col,
  cc,
  row,
  r,
  indexc,
  result,
  start_col,
  end_col   : integer;
  results   : array[1..200*num_colu] of integer;
  finished  : boolean;

begin


  in ( 'stuff', gap1, gap2, bcorner );

  in ( 'screen', cur_col, tot_col, pix_col, num_col );
  if cur_col > tot_col then
    begin
      finished := true;
    end
  else
    begin
      finished := false;
      start_col := cur_col;
      end_col := cur_col + num_col - 1;
      cur_col := cur_col + num_col;
    end;
    out ( 'screen', &cur_col, &tot_col, &pix_col, &num_col );

  while not finished do
    begin
      indexc := 0;
      for cc := start_col to end_col do
        begin
          for r := 1 to pix_col do
            begin
              ncomplex.realp := cc * gap1 + bcorner.realp;
              ncomplex.imag  := r * gap2 + bcorner.imag;
              result := 0;
              size := 0.0;
              original.realp := 0.0;
              original.imag  := 0.0;
              while ( result <= 210 ) and ( size < 4.0 ) do
                begin
                  a := original.realp * original.realp;
                  b := original.realp * original.imag;
                  c := original.imag  * original.imag;
                  original.realp := a-c+ncomplex.realp;
                  original.imag  := b+b+ncomplex.imag;
                  size := original.realp*original.realp+original.imag*original.imag;
                  inc ( result );
                end;
              results[indexc+r] := result;
            end;
          indexc := indexc+pix_col;
        end;
      out ( 'col', &start_col, &results );

      in ( 'screen', cur_col, tot_col, pix_col, num_col );
      if cur_col > tot_col then
        begin
          finished := true;
        end
      else
        begin
          start_col := cur_col;
          end_col := cur_col + num_col-1;
          cur_col := cur_col + num_col;
        end;
      out ( 'screen', &cur_col, &tot_col, &pix_col, &num_col );
    end;

end;



procedure plot ( col : integer; results : resu );

var i,j   : integer;
    color : word;

begin


for j := 0 to num_col-1 do
  for i := 1 to 200 do
    begin
      if results[i+j*200] < 20 then color := 1;
      if results[i+j*200] > 20 then color := 9;
      if results[i+j*200] > 40 then color := 2;
      if results[i+j*200] > 60 then color := 10;
      if results[i+j*200] > 80 then color := 4;
      if results[i+j*200] > 100 then color := 12;
      if results[i+j*200] > 120 then color := 5;
      if results[i+j*200] > 140 then color := 13;
      if results[i+j*200] > 160 then color := 8;
      if results[i+j*200] > 180 then color := 7;
      if results[i+j*200] > 200 then color := 0;

      putpixel ( col+j , i, color );
    end;

end;





begin

  start_up;

  graphdriver := vga;
  graphmode   := vgahi;
  initgraph ( graphdriver, graphmode, 'a:' );


  gap1 :=  2.50 / 320;
  gap2 :=  2.50 / 200;
  bcorner.realp := -2.0;
  bcorner.imag  := -1.25;

  cur_col :=    1;
  tot_col :=  320;
  pix_col :=  200;
  num_col :=    num_colu;

  for i := 1 to num_proc do
    begin
      eval ( 'work', &adder );
      out ( 'stuff', &gap1, &gap2, &bcorner );
    end;

  out ( 'screen', &cur_col, &tot_col, &pix_col, &num_col );

  for i := 1 to tot_col div num_col do
    begin
      in ( 'col', start_col, results );
      plot ( start_col, results );
    end;

  in ('screen', cur_col, tot_col, pix_col, num_col );

  readln;


  { system_shutdown }
  close_system


end.