home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 June / SIMTEL_0692.cdr / msdos / basic / spllib.arc / IPICDUMP.SP < prev    next >
Encoding:
Text File  |  1987-07-21  |  6.8 KB  |  203 lines
  1. BEGIN
  2.  
  3.    {                 IMPORTANT
  4.  
  5.      The BASIC program that results from this SPL program
  6.      must be compiled using your BASIC compiler that
  7.      supports either EGA screen mode 9 for IBM compatibility
  8.      or has a builtin high resolution mode. If you are using
  9.      a computer with a builtin high resolution mode then
  10.      remove the SCREEN 9 statement in this program. Your
  11.      computer must have an EGA or high resolution mode
  12.      that will allow colors to be displayed as shades of
  13.      grey. Such EGA cards are the ATI Small wonder or
  14.      the Thompson EGA ultra card. You can also do this with
  15.      a Zenith 1470 monochrome monitor which will work with
  16.      any EGA card. You may have to change this program's
  17.      color pixel array that assigns attribute numbers to
  18.      correspond to grey scale values read from the picture
  19.      file. This program can be used to display picture files
  20.      generated by CHORUS DATA SYSTEMS digitizing hardware.
  21.      To display my picture enter 320 for row length, 2 for
  22.      scale factor, and PICTURE for the picture file that
  23.      contains my picture. If you have any questions call me
  24.      at 516 694 5872 from 10am - 6:30pm NY time.              }
  25.  
  26.    { This program dumps a picture file to the screen. It is
  27.      in a format created by hardware by Chorus Data Systems
  28.      6 Continental Boulevard in Merrimack,New Hampshire.    }
  29.  
  30.    INTEGER POINTER, { This variable points into row of video data. }
  31.            Picture, { This variable holds the file number of data file. }
  32.            Row_length, {Usually 320 or 112 bytes,two pixels per byte. }
  33.            SCALE; { Scale factor of data being plotted. }
  34.  
  35.    INTEGER ARRAY Colors(8); { This array holds the real pixel
  36.                               values in brightness order.
  37.                               This is the array you may have to
  38.                               change to work with your computer. }
  39.  
  40.  
  41.    STRING ROW; { This variable holds a row of pixel intensities. }  
  42.  
  43.    PROCEDURE Advance_file_pointer;
  44.    BEGIN
  45.  
  46.           
  47.  
  48.  
  49.       { This procedure reads 256 bytes which places the file
  50.         pointer at the beginning of the data for the picture. }
  51.  
  52.       ROW := INPUT$(255,#Picture); { Read 255 characters not used. }
  53.       ROW := INPUT$(1,#Picture); {Read one more character. }
  54.  
  55.    END
  56.  
  57.    PROCEDURE Get_row_of_data;
  58.    BEGIN
  59.  
  60.       { This procedure gets a row of data and puts it into the
  61.         STRING ROW.                                            }
  62.       IF Row_length<=255 THEN ROW := INPUT$(Row_length,#Picture);
  63.       ELSE
  64.       BEGIN
  65.          ROW := INPUT$(255,#Picture)
  66.                 + INPUT$(Row_length-255,#Picture);
  67.       END
  68.  
  69.       POINTER := 1; { Read the pixels and set pointer to one. }
  70.  
  71.    END
  72.  
  73.    INTEGER Pixel_value; { Result of PROCEDURE Get_pixel_value. }
  74.  
  75.    PROCEDURE Get_pixel_value;
  76.    BEGIN
  77.  
  78.       { This PROCEDURE will extract a 4 bit pixel intensity and
  79.         scale it.                                               }
  80.  
  81.       Pixel_value := ASC(MID$(ROW,INT((POINTER-1)/2+1),1));
  82.  
  83.       IF ( POINTER AND 1 )=0 THEN
  84.       BEGIN
  85.          Pixel_value := INT((Pixel_value AND 15)/SCALE);
  86.          RETURN;
  87.       END
  88.       ELSE
  89.       BEGIN
  90.          Pixel_value := INT((Pixel_value \ 16)/SCALE);
  91.          RETURN;
  92.       END
  93.  
  94.    END
  95.  
  96.    PROCEDURE Setscreen;
  97.    BEGIN
  98.  
  99.       { This PROCEDURE sets the screen from the file of data. }
  100.  
  101.       INTEGER X, { Loop variable X }
  102.               Y, { Loop variable Y }
  103.               PIXEL; { Pixel value to be plotted. }
  104.  
  105.       { Below is SCREEN 9 statement for IBM EGA screen 9. You can
  106.         substitute your SCREEN statment here or remove it as
  107.         you see fit in order to set up high resolution of at
  108.         least 640x225 with 8 colors that should produce shades of
  109.         grey. }
  110.  
  111.       SCREEN 9; { Set screen 9 High resolution EGA mode 640x350 }
  112.  
  113.       FOR Y := 0 STEP 1 UNTIL 199 DO
  114.       BEGIN
  115.          Get_row_of_data;
  116.          FOR X := 0 STEP 1 UNTIL (Row_length*2.)-1 DO
  117.          BEGIN
  118.             Get_pixel_value; PIXEL := Pixel_value;
  119.             { Make sure pixel value is between 0 and 7. }
  120.             IF PIXEL>7 THEN PIXEL := 7; IF PIXEL<0 THEN PIXEL := 0;
  121.             PSET(X,Y),Colors(PIXEL+1); POINTER := POINTER+1;
  122.          END
  123.       END
  124.  
  125.    END
  126.  
  127.    { This is the main program. }
  128.  
  129.    STRING Key; { Holds key value. }
  130.    STRING Picture_filename; { Picture file name. }
  131.    Picture := 1; {Set picture file number. }
  132.  
  133.    { Set the proper brightness levels. }
  134.  
  135. {  Proper color set up for Zenith Z-100 with color ram.
  136.    Remove braces to use this set of grey scale assignments. }
  137.  
  138. {  Colors(1) := 0; Colors(2) := 1; Colors(3) := 4; Colors(4) := 5;
  139.    Colors(5) := 2; Colors(6) := 3; Colors(7) := 6; Colors(8) := 7; }
  140.  
  141. {  Proper color set up for IBM EGA screen 9. This may work for
  142.    other computers. Test it for yourself.  }
  143.  
  144.   Colors(1) := 0; Colors(2) := 1; Colors(3) := 2; Colors(4) := 3;
  145.   Colors(5) := 4; Colors(6) := 5; Colors(7) := 6; Colors(8) := 7; 
  146.  
  147.    Start:
  148.    ONERRGOTO Error_in_row_length;
  149.  
  150.    Get_row_length:INPUT( 'Enter row length in bytes 320,111 or 112:',
  151.                           Row_length );
  152.  
  153.    IF Row_length<>320 AND Row_length<>112 AND Row_length<>111 
  154.    THEN GO Get_row_length;
  155.  
  156.    ONERRGOTO Error_in_scale_factor;
  157.  
  158.    Get_scale_factor:INPUT( 'Enter Scale factor 1-16:',SCALE );
  159.  
  160.    IF SCALE<1 OR SCALE>16 THEN GO Get_scale_factor;
  161.  
  162.    ONERRGOTO Error_in_filename;
  163.  
  164.    Get_filename:
  165.    LINEIN( 'Enter picture file name:',Picture_filename);
  166.    OPEN( 'I',Picture,Picture_filename); { Open the picture file. }
  167.  
  168.    ONERRGOTO Final_error;
  169.  
  170.    Advance_file_pointer; {Point to 257th character. }
  171.    HOME; Setscreen; { Set the video from the data file. }
  172.    CLOSE(Picture); {Close the picture file. }
  173.    Wait_here:Key:=INKEY$; IF Key='' THEN GO Wait_here;
  174.    IF Key='D' THEN
  175.    BEGIN
  176.  
  177.      { These statements allow you to dump the screen to disk using BSAVE
  178.        for a Zenith Z-100. Consult your BASIC manuals or EGA card
  179.        manuals for BSAVE values for your EGA card or screen. }
  180.  
  181.       DEFSEG:=57344; BSAVE('PICT.G',0,45000);
  182.       DEFSEG:=49152; BSAVE('PICT.B',0,45000);
  183.       DEFSEG:=53248; BSAVE('PICT.R',0,45000);
  184.       GO Start;
  185.  
  186.    END
  187.    ELSE GO Start;
  188.  
  189.    Error_in_row_length:
  190.    OUTPUT( 'ERROR,Reenter row length' ); OUTPUT(); RESUME Get_row_length;
  191.  
  192.    Error_in_scale_factor:
  193.    OUTPUT( 'ERROR,Reenter scale factor' ); OUTPUT(); RESUME Get_scale_factor;
  194.  
  195.    Error_in_filename:
  196.    OUTPUT( 'ERROR,Reenter filename' ); OUTPUT(); RESUME Get_filename;
  197.  
  198.    Final_error:OUTPUT(); OUTPUT('Error:' @ ERR @ 'in line:' @ERL);
  199.    RESUME Finish;
  200.  
  201.    Finish:
  202. END
  203.