'=========================================================================== ' Subject: SHOW .PCX FOR PB Date: 06-22-98 (14:04) ' Author: Don Schullian Code: PB ' Origin: d83@ath.forthnet.gr Packet: PB.ABC '=========================================================================== $if 0 fShowPCX% by Don Schullian d83@ath.forthnet.gr www.basicguru.com If you're not using PowerBASIC v3.5 and/or my VESA library then you'll need to do a bit of tweaking. There are 3 routines called from these two functions that are included in DAS-VS01.PBL: DACreadARR ( DAC?(), Colors% ) DACwriteARR ( DAC?(), Colors% ) VESAput ( X%, Y%, D%(), PutMode? ) The first two read and write the DAC registers from/into an array. VESAput is simply a graphics PUT routine and can be quickly replaced here by your own PUT routine or you can even stuff each pixel individually. '==================================================================== Each of these routines is called only once and I've put some BIG remark lines around them so they should be easy to spot. '==================================================================== fShowPCX% will display: 16 color 4 plane encoded files 256 color 1 plane encoded files and will display them at the original size whatever X or Y size and maintain the aspect ratio of the missing size compute/use both X and Y aspect ratios and can display more than one file on the screen at the same time as long as the combined number of unique colors does not exceed the number of open (0,0,0) DAC positions you will create got all that? Before you start using this function you'll need to 'create' some holes in the DAC for the new, incoming colors. DAC$ = fReadDAC$(0,48) ' or whatever DAC$ = DAC$ + STRING$(624,0) ' the 'holes' WriteDAC 0, 256 ' or whatever fStuffPalette% expects to find these holes starting with color #48 allowing you 48 'constant' colors for your code to use and 208 'holes' for use by the PCXs. You can, of course, get into the function and adjust these values. Existing colors are used as they are found so you can get quite a few files on the screen at the same time without too much hassle. Oh, the 'funny' stuff with the FileSpec$, FileNo%, and Offset& are all there in case you're using a RESource file to hold all the image files instead of having 832 graphics files all over the disk. (Can't stand that myself!) If fShowPCX% opens a file it will close it before exiting but if it finds it open ( FileSpec$ = "" and FileNo% > 0 ) then it will leave it open even if an error occurs. To test this routine I used Paint Shop Pro v4 to create the file types supported. If you've run into trouble with .PCXs from other programs, PLEASE send one to me so I can have a look at it. TIA Give me a shout if you run into trouble and/or have any comments. C'ya, d83 $endif ' -------------------------------------------------------------------- ' -------------- test code ------------------------------------ ' ------------- for DAS-VS01.PBL ----------------------------------- ' -------------------------------------------------------------------- $INCLUDE "DAS-VS01.INC" ON ERROR GOTO Oops RANDOMIZE TIMER TheMode?? = &h103 IF NOT fVESAprintSetup%( "VS-FNT16.850", 0 ) THEN BEEP : END IF fVESAsetup?( TheMode?? ) = 0 THEN BEEP : END DELAY 2 DIM DYNAMIC P?(2,255) DACreadARR P?(0,0), 48 DACwriteARR P?(0,0), 256 ERASE P? FileSpec$ = "YAK.PCX" t! = timer fShowBMP% 0, 0, 0, 0, FileSpec$, 0 t! = timer - t! VESAprint 0, 550, USING$( "##.###", T! ), 3, 14, 0 WHILE NOT INSTAT : WEND VESAend CLS END '.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø ' ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ' PURPOSE: Display 16 color/4 plane or 256 color PCX files ' PARAMS: Xstart%, Ystart% top left corner of image ' Xend% , Yend% bottom right corner of image ' if Xend% and Yend% are ZERO then ' the image size will be determined by ' image data ' if either is > ZERO then the other will ' maintain the aspect ratio ' if both are > ZERO then the image's aspect ' ratio will be altered to fit in the params ' FileSpec$ file name ' if not NULL then the file is opened/closed ' FileNo% file number to use ' if none given FREEFILE is used ' FileLen& length of file ' only required when using RESource files ' RETURNS: ZERO if image was displayed fully ' 1 if file does not conform to PCX format ' n PB error number '.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø ' ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø TYPE PCXheaderTYPE Mfg AS BYTE ' needs to be 10 decimal Version AS BYTE ' 2, 3 and 5 are supported Encoding AS BYTE ' 1 if data is encoded BitsPerPixel AS BYTE ' 1 or 8 SEE: Planes MinX AS INTEGER ' left most pixel position MinY AS INTEGER ' top most pixel position MaxX AS INTEGER ' right most pixel position MaxY AS INTEGER ' bottom most pixel position HRes AS INTEGER ' pixel's per inch X resolution VRes AS INTEGER ' pixel's per inch Y resolution PalData AS STRING * 48 ' RGB values if 16 colors (or less) Reserved AS BYTE ' ...... Planes AS BYTE ' 1 or 4 SEE BitsPerPixel BytesPerSLine AS INTEGER ' usually ( Xmax - Ymax + 1 ) PalInfo AS INTEGER ' 1 = Color or B/W 2 = Gray Scale Filler AS STRING * 58 ' ...... END TYPE ' [ 128 bytes ] FUNCTION fShowPCX ( BYVAL Xstart AS INTEGER, _ BYVAL Ystart AS INTEGER, _ BYVAL Xend AS INTEGER, _ BYVAL Yend AS INTEGER, _ BYVAL FileSpec AS STRING , _ BYVAL FileNo AS INTEGER, _ BYVAL FileLen AS LONG ) LOCAL PUBLIC AS INTEGER DIM Chunk AS LOCAL INTEGER 'max buffer size DIM Cidx AS LOCAL BYTE 'color index number DIM Close_File AS LOCAL INTEGER 'local file open flag DIM FileOff AS LOCAL LONG 'starting file offset DIM I AS LOCAL INTEGER 'loop counter & temp DIM J AS LOCAL INTEGER 'loop counter & temp DIM Ldata(MIN,1) AS LOCAL INTEGER '1 line of expanded data DIM Lidx AS LOCAL INTEGER ' pointer index for above DIM L_ptr AS LOCAL BYTE PTR ' byte pointer for above DIM tPCX AS LOCAL PCXheaderTYPE 'file header DIM Pbuild(MIN,1) AS LOCAL BYTE 'plane data DIM PCXerror AS LOCAL INTEGER 'local error number/flag DIM Pidx(255) AS LOCAL BYTE 'palette index DIM Plane AS LOCAL INTEGER 'plane loop counter DIM Repeat AS LOCAL INTEGER 'repeat color counter DIM Temp AS LOCAL STRING 'data buffer (et al) DIM Tidx AS LOCAL INTEGER ' pointer index for above DIM T_ptr AS LOCAL BYTE PTR ' byte pointer for above DIM Xcount AS LOCAL INTEGER 'width factor counter DIM Xfactor AS LOCAL INTEGER 'width factor per column DIM Ycount AS LOCAL INTEGER 'heigth factor counter DIM Yfactor AS LOCAL INTEGER 'heigth factor per row ' ON LOCAL ERROR GOTO ShowPCXoops 'enable local error trap ' IF LEN(FileSpec$) > 0 THEN 'if we open file locally IF LEN(DIR$(FileSpec$)) = 0 THEN ERROR 53 ' check if file exists IF FileNo% < 1 THEN FileNo% = FREEFILE ' if no assigned file # Close_File% = -1 ' set local open flag OPEN "B", #FileNo%, FileSpec$ ' open the file FileLen& = LOF(FileNo%) ' get actual length of file END IF ' ' FileOff& = SEEK( FileNo% ) 'get actual file offset GET #FileNo%, ,tPCX 'load PCX header IF tPCX.Mfg <> 10 THEN ERROR 1 'not a PCX file, for sure IF tPCX.Version = 0 THEN ERROR 1 'don't deal with these IF tPCX.Version = 1 THEN ERROR 1 ' version numbers IF tPCX.Version = 4 THEN ERROR 1 ' IF tPCX.Version <> 5 THEN ERROR 1 ' ' IF ( tPCX.BitsPerPixel = 8 ) AND _ '256 color image ( tPCX.Planes = 1 ) THEN ' SEEK #FileNo%, (FileOff& + FileLen& - 769) ' set pointer to RGB data GET #FileNo%, , Cidx? ' get RGB data flag IF Cidx? <> 12 THEN ERROR 1 ' oops!! not a PCX file! GET$ #FileNo%, 768, Temp$ ' load RGB data SEEK #FileNo%, ( FileOff& + 128 ) ' reset pointer to data I% = 256 ' color count ELSEif ( tPCX.BitsPerPixel = 1 ) AND _ '16 color image ( tPCX.Planes = 4 ) THEN ' Temp$ = tPCX.PalData ' use RGB data in header I% = 16 ' color count ELSE ' ERROR 1 'oops! not one we can do! END IF ' fStuffPalette I%, Temp$, Pidx?(), 0 'load DAC with new colors ' DECR tPCX.MaxX, tPCX.MinX : INCR tPCX.MaxX 'image width in pixels DECR tPCX.MaxY, tPCX.MinY : INCR tPCX.MaxY 'image height in rows ' IF ( Xend% = 0 ) AND ( Yend% = 0 ) THEN 'if original size requested Xfactor% = 1000 ' Yfactor% = 1000 ' ELSE ' IF ( Xend% > 0 ) THEN 'if requested width I% = ( Xend% - Xstart% + 1 ) ' screen width Xfactor% = (CLNG(I% * 1000) \ tPCX.MaxX) ' width factor IF Yend% = 0 THEN Yfactor% = Xfactor% ' maintain aspect ratio END IF ' IF Yend% > 0 THEN 'if requested height I% = (Yend% - Ystart% + 1) ' screen height Yfactor% = (CLNG(I% * 1000) \ tPCX.MaxY) ' height factor IF Xend% = 0 THEN Xfactor% = Yfactor% ' maintain aspect ratio END IF ' END IF ' I% = ( CLNG(tPCX.MaxX * Xfactor%) \ 1000 ) 'actual screen width J% = ( I% + 11 ) \ 2 'a few extra els for safty DIM Ldata%(J%) 'dim line buffer Ldata%(0) = I% 'set column width Ldata%(1) = 1 ' L_ptr = VARPTR32( Ldata%(2) ) ' Chunk% = FRE(-4) 'maximum string length Tidx% = Chunk% 'so we load the buffer DECR tPCX.MaxX 'zero based columns ' IF tPCX.BitsPerPixel = 8 THEN '256 color 1 plane image DO ' start processing data J% = 0 ' reset file col counter DO ' build one line GOSUB ShowPCXloadbyte ' load clr idx & counter INCR J%, Repeat% ' bump file col counter DO ' stuff Repeat% pixels INCR Xcount%, Xfactor% ' bump Xcounter WHILE Xcount% => 1000 ' if a whole pxl or more @L_ptr[Lidx%] = Pidx?(Cidx?) ' stuff one pixel DECR Xcount%, 1000 ' decr Xcounter by 1 pxl INCR Lidx% ' WEND ' DECR Repeat% ' decr rep counter LOOP UNTIL Repeat% = 0 ' LOOP UNTIL J% > tPCX.MaxX ' if at end of line Lidx% = 0 ' reset line buf index # Xcount% = 0 ' reset Xfactor counter GOSUB ShowPCXputline ' display the line LOOP UNTIL tPCX.MaxY = 0 ' ELSE '16 color 4 plane image DO ' REDIM Pbuild?(tPCX.MaxX) ' clear plane buffer Plane% = 1 ' set plane mask to 1 DO ' start working 1 row J% = 0 ' reset file col counter DO ' GOSUB ShowPCXloadByte ' load clr index & count IF Cidx? = 0 THEN ' if plane value = 0 INCR J%, ( Repeat% * 8 ) ' bump plane buffer ELSE ' DO ' once for each rep cntr FOR I% = 7 TO 0 STEP -1 ' once for each bit IF BIT(Cidx?,I%) > 0 THEN ' if bit is on INCR Pbuild?(J%), Plane% ' END IF ' INCR J% ' NEXT ' DECR Repeat% ' decr rep counter LOOP UNTIL Repeat% = 0 ' END IF ' LOOP UNTIL J% > tPCX.MaxX ' end of file line SHIFT LEFT Plane%, 1 ' next mask val (1,2,4,8) LOOP UNTIL Plane% = 16 ' all done here! Lidx% = 0 ' reset line buf index # Xcount% = 0 ' reset Xfactor counter FOR I% = 0 TO tPCX.MaxX ' transfer plane buffer INCR Xcount%, Xfactor% ' bump pixel counter WHILE Xcount% => 1000 ' if a whole pixel or more @L_ptr[Lidx%] = Pidx?(Pbuild?(I%)) ' stuf one to line buffer DECR Xcount%, 1000 ' decr pixel counter INCR Lidx% ' next line buffer byte WEND ' NEXT ' GOSUB ShowPCXputline ' display the line LOOP UNTIL tPCX.MaxY = 0 ' END IF ' ' ShowPCXexit: 'exit function from here IF Close_File% AND _ ' file was locally opened FILEATTR(FileNo%, 0) THEN CLOSE FileNo% ' and is actually open ' FUNCTION = PCXerror 'RETURN error number EXIT FUNCTION ' '------------------------------------------------------------------------- '----------------- LOCAL GOODIES --------------------------------------- '------------------------------------------------------------------------- ShowPCXloadbyte: 'load count & color index GOSUB ShowPCXloadB ' load next byte IF ( Cidx? > 191 ) THEN ' if a repeater Repeat% = ( Cidx? - 192 ) ' # of times to repeat GOSUB ShowPCXloadB ' load color index ELSE ' Repeat% = 1 ' only once for this one END IF ' RETURN ' ' ShowPCXloadB: 'load one byte from buffer IF Tidx% = Chunk% THEN ' if past end of buffer GET$ #FileNo%, Chunk%, Temp$ ' load next chunk T_ptr = STRPTR32( Temp$ ) ' set byte pointer Tidx% = 0 ' reset pointer index END IF ' Cidx? = @T_ptr[Tidx%] ' byte value INCR Tidx% ' bump index pointer RETURN ' ' ShowPCXputline: 'put line buffer to screen INCR Ycount%, Yfactor% ' bump Yfactor WHILE Ycount% => 1000 ' if a whole row or more '================================================='======================== VESAput Xstart%, Yend%, Ldata%(0), 3 ' put a line '================================================='======================== DECR Ycount%, 1000 ' decr Yfactor by one row INCR Ystart% ' next screen row WEND ' DECR tPCX.MaxY ' decr file row counter RETURN ' ' ShowPCXoops: 'local error trap PCXerror% = ERR ' set error number RESUME ShowPCXexit ' bail out! ' END FUNCTION ' '.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø ' ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ' PURPOSE: Put new colors into the Palette and provide an index to their ' position ' PARAMS: Colors% the number of color triplets being sent ' RGB$ the color triplets ' Pidx?(1) the array to hold the DAC index numbers ' RGBI% if = 0 then incoming palette is in RGB format ' if > 0 then incoming palette is in RGBI format and ' the Intensity byte is skipped ' if = 321 then the incoming palette is in BGRI format ' and bytes 3 and 1 are swapped to create an RGB ' NOTE: BMP palettes are in this format ' RETURNS: the number of NEW, unique colors '.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø ' ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø ø FUNCTION fStuffPalette ( BYVAL Colors AS INTEGER, _ SEG RGB AS STRING , _ SEG Pidx() AS BYTE , _ BYVAL RGBI AS INTEGER ) LOCAL PUBLIC AS INTEGER DIM Count AS LOCAL INTEGER ' new color counter DIM Pal(255) AS LOCAL STRING * 3 ' local RGB strings DIM P_ptr AS LOCAL DWORD ' pointer to RGB strings DIM P AS LOCAL STRING * 3 ' new RGB string DIM R_ptr AS LOCAL BYTE PTR ' pointer to new data DIM Ridx AS LOCAL INTEGER ' new data ptr index DIM X AS LOCAL INTEGER ' loop counter DIM Y AS LOCAL INTEGER ' loop counter & temp DIM Zero AS LOCAL STRING * 3 ' search $ for a 'hole' ' P_ptr = VARPTR32( Pal$(0) ) 'pointer to index arr R_ptr = STRPTR32( RGB$ ) 'pointer to pal string Zero$ = STRING$(3,0) 'clear string ' '==================================================='======================== DACreadARR BYVAL P_ptr, 256 'load current DAC info '==================================================='======================== FOR X% = 0 TO Colors% -1 'start processing pal FOR Y% = 1 TO 3 ' get triplets ASC(P$,Y%) = ( @R_ptr[Ridx%] \ 4 ) ' divide RGB value by 4 INCR Ridx% ' next incoming pal byte NEXT ' IF RGBI% <> 0 THEN ' if RGBI encoded INCR Ridx% ' skip 4th 'I' byte IF RGBI% = 321 THEN ' if BGR encoded Y% = ASC(P$,1) ' swap B and G ASC(P$,1) = ASC(P$,3) ' ASC(P$,3) = Y% ' END IF ' END IF ' ARRAY SCAN Pal$(0), = P$, TO Y% ' search for exising clr IF Y% > 0 THEN ' yep! found one DECR Y% ' drop back to 0 start ELSE ' nope, gotta new one ARRAY SCAN Pal$(48) FOR 207, = Zero$, TO Y% ' find an open hole IF Y% = 0 THEN EXIT FOR ' oops! full up INCR Y%, 47 ' set actual DAC posn END IF ' Pidx?(X%) = Y% ' set index value IF (Y% > 47) THEN ' if a unique color Pal$(Y%) = P$ ' stuff into pal data INCR Count% ' END IF ' NEXT ' '==================================================='======================== DACwriteARR BYVAL P_ptr, 256 'write new DAC info '==================================================='======================== ' FUNCTION = Count% ' RETURN new color count ' END FUNCTION '