$sysprog, ucsd$

PROGRAM DUMP_LARGE_GRAPHICS ( INPUT,OUTPUT,LISTING);


import dgl_types,
       dgl_lib,
       dgl_vars,
       dgl_gen,
       gle_types,
       gle_gen,
       gle_ras_out,
       sysglobals,
       asm;

type
  graphics_screen = packed array [1..maxint] of char;

var
  graphics_base ['GRAPHICSBASE'] : anyptr;
  gscreen : ^graphics_screen;
  error_return : integer;
  gscreen_width : integer;
  gscreen_height : integer;
  justify_bytes  : integer;
  marked_screen : anyptr;
  old_graphics_base : ^gle_shortint;
  old_gle_gcb : ^graphics_control_block;
  old_gcb     : ^graphics_control_block1;
  old_raster_gcb,
  tmp_raster_gcb: raster_device_rec_ptr;
  
function make_anyptr( p : anyptr ) : anyptr;
{    This function converts a pointer of any type into an ANYPTR.  It is     }
{  for assigning values to variables of type ANYPTR.                         }

begin
  make_anyptr := p;
end;

procedure memory_clear(agcb : graphics_control_block_ptr);
{    This is a screen-clear routine which knows how to clear the simulated   }
{  "screen" in mainframe RAM.  The routine is needed because when you first  }
{  do DISPLAY_INIT in the program, a screen clear for your physical display  }
{  is attached to the GLE_GCB hook for "clear".   For some configurations,   }
{  this routine would also serve to clear the simulated screen, but for      }
{  other than Model 236A-equivalent displays, the procedure installed at     }
{  "clear" may not clear the simulated screen properly.                      }

var
 i,j  : gle_shortint;
 row  : integer;
begin
 for i := 0 to gscreen_height-1 do
  begin
   row := i * gscreen_width;
   for j:= 1 to gscreen_width do
    gscreen^[row + j] := #0;
  end;
end;

procedure take_graphics ( screen_width_dots, screen_height_dots,
                          justify_dots : integer);
{    This procedure puts the currently active display temporarily on hold,   }
{  allocates enough memory to simulate a frame buffer of the size specified  }
{  by SCREEN_WIDTH_DOTS and SCREEN_HEIGHT_DOTS, and redirects plotting       }
{  operations to that memory.                                                }

var
  index : integer;
  raster_gcb : raster_device_rec_ptr;
  
begin
  
  mark(marked_screen);   
  
  { save screen size information in global variables }
  gscreen_width := screen_width_dots div 8;   
  gscreen_height := screen_height_dots;
  justify_bytes := justify_dots div 8;
  
  { redirect graphics library variables to point to new memory, }
  { save old values                                             }
  
  { allocate memory for screen image }
  newwords(gscreen,(gscreen_height*gscreen_width) div 2 + 1);
  
  new(old_gle_gcb);
  old_gle_gcb^ := gle_gcb^;
  
  new(old_gcb);
  old_gcb^ := gcb^;
  
  new(old_raster_gcb);
  tmp_raster_gcb := gle_gcb^.dev_dep_stuff;
  old_raster_gcb^ := tmp_raster_gcb^; 
  
  old_graphics_base := make_anyptr(graphics_base);
  graphics_base := make_anyptr(gscreen);
  
  raster_gcb := gle_gcb^.dev_dep_stuff;
  with gle_gcb^,raster_gcb^ do
    begin
                                      { \  Take over the screen-clearing hook }
      clear := memory_clear;          {  > to ensure that the "screen" in     }
                                      { /  memory can be cleared correctly.   }
      
      display_name := 'MEMORY';       { Plotting device is now memory.        }
      display_name_char_count := 6;   { Number of characters in 'MEMORY'.     }
      
                                      { \   Simulate a display whose          }
      display_res_x := 3.0000;        {  \  resolution is 3 pixels/mm.  This  }
      display_res_y := 3.0000;        {  /  is in the ball park for printers  }
                                      { /   which can dump graphics images.   }
      
      display_min_x := 0;
      display_max_x := ((gscreen_width) * 8 - 1); 
      display_min_y := 0;
      display_max_y := (gscreen_height-1);
      
      color_map_support := 0;  { none }
      
      redef_background := 0;   { no }
      
      pallette     := 1;
      gamut        := 1;
      
      devicetype     := 1;  { simulate 9836A only. Other values are
                  0 = 16/26, 1 = 36, 2 = 98627A, 3 = 36C, 4 = 9837 }
      
      deviceaddress := 0;   { unused }
      
      plane1_addr := addr(graphics_base);
      plane1_offset := 0;
      plane2_offset := 0;
      plane3_offset := 0;
      
      n_glines := display_max_y+1;
      
                               { \   This specifies the spacing (memory-wise) }
                               {  \  of bytes which affect the frame buffer.  }
      gspacing     := 1;       {   > The Models 16 and 26 used only odd bytes }
                               {  /  so the spacing is every two; all others  }
                               { /   use a spacing of one.                    }
  
      bytesperline := gscreen_width;   
  
      hard_xmax := display_max_x;
      hard_ymax := display_max_y;
  
      with gcb^ do
        begin
          max_disp_lim.xmin := display_min_x;
          max_disp_lim.xmax := display_max_x;
          max_disp_lim.ymin := display_min_y;
          max_disp_lim.ymax := display_max_y;
        
          gle_get_p1p2 ( gle_gcb );
      
          def_disp_lim.xmin := info1;
          def_disp_lim.xmax := info2;
          def_disp_lim.ymin := info3;
          def_disp_lim.ymax := info4;
          
          disp_init := true;
          disp_eq_loc :=  ((disp_dev_adr = loc_dev_adr) or
                          ((disp_dev_adr = internal_display) and
                           (loc_dev_adr = internal_locator)));
          
          { set up display limits }
                                    
                                    { \  Is the virtual display coordinate   }
          disp_just := lowerleft;   {  > system centered within the display  }
                                    { /  limits or in the lower left corner? }
          with def_disp_lim do
            display_limits(xmin,xmax,ymin,ymax);
               
          { set up default text size and rotation attributes }
          
          dgl_char_width := init_char_width_factor * 
            abs (window_lim.xmax - window_lim.xmin);
          dgl_char_height := init_char_height_factor * 
            abs (window_lim.ymax - window_lim.ymin);
          set_char_size ( dgl_char_width, dgl_char_height );
          
          char_rot_w := init_char_rot_w;
          char_rot_h := init_char_rot_h;
          
          set_text_rot ( char_rot_w, char_rot_h );
          
          { set up all attributes here        }
          
          dgl_current_polygon_edge := true;
          dgl_current_polygon_crosshatch := false;
          dgl_current_polygon_linestyle := init_linestyle;
          dgl_current_polygon_style := 1;
          dgl_current_polygon_color := init_color;
          dgl_polygon_color_current := false;  { color not set in gle }
          dgl_current_polygon_density := 0;
          dgl_current_polygon_angle := 0;
          set_timing ( dgl_current_timming_mode );
          set_color(init_color);
          set_line_style(init_linestyle);
          set_line_width(init_linewidth);
           
          cpx := init_cpx;      { \   Set the current pen position to the  }
          cpy := init_cpy;      {  >  initial current pen position.  The   }
                                { /   units are device units.              }
          
          marker_size_x := trunc(display_res_x * 2.5 + 0.5); { 2.5 mm in size }
          marker_size_y := marker_size_x;
          info1 := marker_size_x;
          info2 := marker_size_y;
          gle_marker_size ( gle_gcb );
        end;
    end;
    clear_display;
end; { setup_display }

procedure return_graphics;
{    This procedure performs the inverse function of TAKE_GRAPHICS.  It     }
{  redirects plotting operations back to the display and away from the      }
{  pseudo-display in memory.  It also destroys the pseudo-display           }
{  information and releases the pseudo-frame buffer from the heap.          }

var
  error : integer;
  
begin
  graphics_base := make_anyptr(old_graphics_base);
  
  gle_gcb^ := old_gle_gcb^;
  gcb^     := old_gcb^;
  tmp_raster_gcb := gle_gcb^.dev_dep_stuff;
  tmp_raster_gcb^ := old_raster_gcb^;
  
  release(marked_screen);
  
  with gcb^.def_disp_lim do
   display_limits(xmin, xmax, ymin, ymax);
   
end;

procedure dump_graphics;
{    This procedure dumps the graphics image in the memory to a printer which }
{  can do a graphics dump.  The printer must conform to the HP Raster         }
{  Interface Standard in order to work with this procedure.                   }
{    The memory-display must be less than 132 chararacters (1056 pixels)      }
{  wide.                                                                      }

label 1;

var
  gbuffer : string[138 { 132 + 6 }];
  i,j,pindex : integer;
  busy : boolean;
  row : integer;
  cnt : integer;
  
begin
1:
  { escape sequence for graphics }
  gbuffer := '';
  strwrite(gbuffer,1,cnt,chr(27),'*b',gscreen_width:0,'W');
  cnt := cnt - 1;
  setstrlen(gbuffer,gscreen_width+cnt+justify_bytes);
  
  try
    for i := 1 to justify_bytes do
      gbuffer[cnt+i] := chr(0);
      
    for i := 1 to gscreen_height do
      begin
        row := (i - 1) * gscreen_width;
        for j := 1 to gscreen_width do 
          begin
            gbuffer[j+cnt+justify_bytes] := gscreen^[row+j];
          end;
          WRITE(LISTING,GBUFFER:GSCREEN_WIDTH+6);
      end;
  recover ;
  
  gbuffer[1] := chr(27); { terminate graphics sequence }
  gbuffer[2] := '*';
  gbuffer[3] := 'r';
  gbuffer[4] := 'B';
  WRITE(LISTING,GBUFFER:4);
      
end;
procedure pattern(xmin,xmax,ymin,ymax: real);
{    This merely draw a pattern on the display (or pseudo-display) to prove  }
{  that the hooks needed for plotting have been correctly assigned.          }

const
  convert_deg_to_rad = 0.01745329252;
  
var
  dx,dy : real;
  deg   : integer;
  cnt   : integer;
  s : string[20];

begin
  dx := xmax-xmin;
  dy := ymax-ymin;
  set_window(xmin,xmax,ymin,ymax);
  set_aspect(dx,dy);
  move(xmin,ymin);
  line(xmin,ymax);
  line(xmax,ymax);
  line(xmax,ymin);
  line(xmin,ymin);
  set_char_size(dx/25,dy/25);
  deg := 0;
  repeat
    move(dx/2,dy/2);
    set_text_rot(cos(deg*convert_deg_to_rad),sin(deg*convert_deg_to_rad));
    s := '   ---- ';
    strwrite(s,7,cnt,deg:1);
    gtext(s);
    deg := deg + 25;
  until deg > 340;
end;


begin
  graphics_init;
  display_init ( 3,0,error_return);
  if error_return <> 0 then escape(-27);
  pattern(0,1,0,1);
  set_line_style(3);            {set a non-default line style so if something }
                                {goes wrong, it will be obvious.              }
  take_graphics(560,720,0);
  pattern(0,0.5,0,0.5);
{ dump_graphics;                {un-comment this if you have a printer }
                                {which can dump graphics.              }
  return_graphics;
  
  move(0.25,0.25);      {draw a line in line style 3 on the CRT.  If it }
  line(0.75,0.75);      {is not a dashed line, something went wrong.    }
  
  graphics_term;
  
end.
