home *** CD-ROM | disk | FTP | other *** search
/ Between Heaven & Hell 2 / BetweenHeavenHell.cdr / 300 / 243 / ipicdump.sp < prev    next >
Text File  |  1986-07-09  |  5KB  |  152 lines
  1. BEGIN
  2.  
  3.    { This program dumps a picture file to the screen. It is
  4.      in a format created by hardware by Chorus Data Systems
  5.      6 Continental Boulevard in Merrimack,New Hampshire.    }
  6.  
  7.    INTEGER POINTER, { This variable points into row of video data. }
  8.            Picture, { This variable holds the file number of data file. }
  9.            Row_length, {Usually 320 or 112 bytes,two pixels per byte. }
  10.            SCALE; { Scale factor of data being plotted. }
  11.  
  12.    INTEGER ARRAY Colors(8); { This array holds the real pixel
  13.                               values in brightness order.     }
  14.  
  15.    STRING ROW; { This variable holds a row of pixel intensities. }  
  16.  
  17.    PROCEDURE Advance_file_pointer;
  18.    BEGIN
  19.  
  20.       { This procedure reads 256 bytes which places the file
  21.         pointer at the beginning of the data for the picture. }
  22.  
  23.       ROW := INPUT$(255,#Picture); { Read 255 characters not used. }
  24.       ROW := INPUT$(1,#Picture); {Read one more character. }
  25.  
  26.    END
  27.  
  28.    PROCEDURE Get_row_of_data;
  29.    BEGIN
  30.  
  31.       { This procedure gets a row of data and puts it into the
  32.         STRING ROW.                                            }
  33.       IF Row_length<=255 THEN ROW := INPUT$(Row_length,#Picture);
  34.       ELSE
  35.       BEGIN
  36.          ROW := INPUT$(255,#Picture)
  37.                 + INPUT$(Row_length-255,#Picture);
  38.       END
  39.  
  40.       POINTER := 1; { Read the pixels and set pointer to one. }
  41.  
  42.    END
  43.  
  44.    INTEGER Pixel_value; { Result of PROCEDURE Get_pixel_value. }
  45.  
  46.    PROCEDURE Get_pixel_value;
  47.    BEGIN
  48.  
  49.       { This PROCEDURE will extract a 4 bit pixel intensity and
  50.         scale it.                                               }
  51.  
  52.       Pixel_value := ASC(MID$(ROW,INT((POINTER-1)/2+1),1));
  53.  
  54.       IF ( POINTER AND 1 )=0 THEN
  55.       BEGIN
  56.          Pixel_value := INT((Pixel_value AND 15)/SCALE);
  57.          RETURN;
  58.       END
  59.       ELSE
  60.       BEGIN
  61.          Pixel_value := INT((Pixel_value \ 16)/SCALE);
  62.          RETURN;
  63.       END
  64.  
  65.    END
  66.  
  67.    PROCEDURE Setscreen;
  68.    BEGIN
  69.  
  70.       { This PROCEDURE sets the screen from the file of data. }
  71.  
  72.       INTEGER X, { Loop variable X }
  73.               Y, { Loop variable Y }
  74.               PIXEL; { Pixel value to be plotted. }
  75.  
  76.       SCREEN 9; { Set screen 9 High resolution EGA mode 640x350 }
  77.  
  78.       FOR Y := 0 STEP 1 UNTIL 199 DO
  79.       BEGIN
  80.          Get_row_of_data;
  81.          FOR X := 0 STEP 1 UNTIL (Row_length*2.)-1 DO
  82.          BEGIN
  83.             Get_pixel_value; PIXEL := Pixel_value;
  84.             { Make sure pixel value is between 0 and 7. }
  85.             IF PIXEL>7 THEN PIXEL := 7; IF PIXEL<0 THEN PIXEL := 0;
  86.             PSET(X,Y),Colors(PIXEL+1); POINTER := POINTER+1;
  87.          END
  88.       END
  89.  
  90.    END
  91.  
  92.    { This is the main program. }
  93.  
  94.    STRING Key; { Holds key value. }
  95.    STRING Picture_filename; { Picture file name. }
  96.    Picture := 1; {Set picture file number. }
  97.  
  98.    { Set the proper brightness levels. }
  99.    Colors(1) := 0; Colors(2) := 1; Colors(3) := 4; Colors(4) := 5;
  100.    Colors(5) := 2; Colors(6) := 3; Colors(7) := 6; Colors(8) := 7;
  101.  
  102.    Start:
  103.    ONERRGOTO Error_in_row_length;
  104.  
  105.    Get_row_length:INPUT( 'Enter row length in bytes 320,111 or 112:',
  106.                           Row_length );
  107.  
  108.    IF Row_length<>320 AND Row_length<>112 AND Row_length<>111 
  109.    THEN GO Get_row_length;
  110.  
  111.    ONERRGOTO Error_in_scale_factor;
  112.  
  113.    Get_scale_factor:INPUT( 'Enter Scale factor 1-16:',SCALE );
  114.  
  115.    IF SCALE<1 OR SCALE>16 THEN GO Get_scale_factor;
  116.  
  117.    ONERRGOTO Error_in_filename;
  118.  
  119.    Get_filename:
  120.    LINEIN( 'Enter picture file name:',Picture_filename);
  121.    OPEN( 'I',Picture,Picture_filename); { Open the picture file. }
  122.  
  123.    ONERRGOTO Final_error;
  124.  
  125.    Advance_file_pointer; {Point to 257th character. }
  126.    HOME; Setscreen; { Set the video from the data file. }
  127.    CLOSE(Picture); {Close the picture file. }
  128.    Wait_here:Key:=INKEY$; IF Key='' THEN GO Wait_here;
  129.    IF Key='D' THEN
  130.    BEGIN
  131.       DEFSEG:=57344; BSAVE('PICT.G',0,45000);
  132.       DEFSEG:=49152; BSAVE('PICT.B',0,45000);
  133.       DEFSEG:=53248; BSAVE('PICT.R',0,45000);
  134.       GO Start;
  135.    END
  136.    ELSE GO Start;
  137.  
  138.    Error_in_row_length:
  139.    OUTPUT( 'ERROR,Reenter row length' ); OUTPUT(); RESUME Get_row_length;
  140.  
  141.    Error_in_scale_factor:
  142.    OUTPUT( 'ERROR,Reenter scale factor' ); OUTPUT(); RESUME Get_scale_factor;
  143.  
  144.    Error_in_filename:
  145.    OUTPUT( 'ERROR,Reenter filename' ); OUTPUT(); RESUME Get_filename;
  146.  
  147.    Final_error:OUTPUT(); OUTPUT('Error:' @ ERR @ 'in line:' @ERL);
  148.    RESUME Finish;
  149.  
  150.    Finish:
  151. END
  152.