''IFF ILBM display program
'' based partly on  Commodore example program.

DEFINT A-Z
'REM $INCLUDE Exec.bh
'REM $INCLUDE Graphics.bh
'REM $INCLUDE IFFParse.bh
'REM $INCLUDE DOS.bh
'REM $INCLUDE DataTypes/PictureClass.bc
'REM $INCLUDE Utility.bc
'REM $INCLUDE Intuition.bh

REM $INCLUDE Blib/IFFBufIO.bas
REM $INCLUDE BLib/BitMapSupport.bas


' unpackrow.bas  Convert data from "cmpByteRun1" run compression
' include the machine code routine. assembler source is UnPackRow.s
' to make Unpackrow.bas from UnPackRow.s use OtoTaglist UnPackRow.

'DECLARE SUB UnPackRow CDECL (BYVAL pSourceptr&,BYVAL pDestptr&,BYVAL  srcBytes&, BYVAL  dstBytes0&, BYVAL resultptr&)
REM $INCLUDE Unpackrow.bas
SUB UnPackRow (BYVAL pSourceptr&,BYVAL pDestptr&,BYVAL  srcBytes0&, BYVAL  dstBytes0&, BYVAL resultptr&)
SHARED unpackrow&(1)
 CALL LOC VARPTR(unpackrow&(0)),pSourceptr&,pDestptr&,srcBytes0&,dstBytes0&,resultptr&
END SUB


FUNCTION BytesPerRow&(BYVAL w)
BytesPerRow&= (w+15) >> 4 << 1
END FUNCTION

SUB readBODY(BYVAL iff&, BYVAL bm&, BYVAL bmhd&)
	STATIC w, h, nplanes, row, plane, pp&, numBytes, compression
	STATIC buf&, bufSize, used, bytesBetweenRows&, srcRowBytes
	STATIC junk, bufpos&, bytesread, oldbufpos&, oldpp&, bytestodo,unpackres
	
	w = PEEKW(bmhd& + bmh_Width)
	h = PEEKW(bmhd& + bmh_Height)
	nplanes = PEEKB(bmhd& + bmh_Depth)
	srcRowBytes = BytesPerRow&(w)

	bytesBetweenRows& =PEEKW(bm&+bytesperrow)
	compression = PEEKB(bmhd& + bmh_Compression)
	bufSize=8192
	buf& = AllocMem(bufSize, MEMF_ANY&)
	IF buf& THEN
		used = 0
		bufpos&=buf&
		numbytes=ReadChunkBytes&(iff&, bufpos&, BufSize)
		IF compression=cmpNone& THEN
			FOR row = 0 TO h - 1
				FOR plane = 0 TO nplanes - 1
					pp& = PEEKL(bm& + Planes + plane * 4)+ row*bytesBetweenRows&
					IF used+srcRowBytes>numbytes THEN
						IF numbytes<>used THEN	CopyMem bufpos&,pp&,numbytes-used
						pp&=pp&+numbytes-used
						bytestodo= srcRowBytes-(numbytes-used)
						numbytes=ReadChunkBytes&(iff&, buf&, BufSize)	
						bufpos&=buf&
						used=0
					ELSE
						bytestodo= srcRowBytes
					END IF
					CopyMem bufpos&,pp&, bytestodo
					bufpos&=bufpos&+bytestodo
					used=used+bytestodo
				NEXT plane
			NEXT row
		ELSE
			FOR row = 0 TO h - 1
				FOR plane = 0 TO nplanes - 1
					pp& = PEEKL(bm& + Planes + plane * 4)+ row*bytesBetweenRows&
					oldbufpos&=bufpos&: oldpp&=pp&
					CALL UnpackRow(VARPTR(bufpos&),VARPTR(pp&), numBytes ,srcRowBytes, VARPTR(unpackres))
					IF unpackres=0 THEN
						CopyMem oldbufpos&,buf&,numbytes
						bytesread=ReadChunkBytes&(iff&, buf&+Numbytes, bufSize-Numbytes)
						IF bytesread=0 THEN 
							PRINT "Source truncated": EXIT SUB
						END IF
						numbytes=numbytes + bytesread
						bufpos&=buf&: pp&=oldpp&: oldbufpos&=buf&
						CALL UnPackRow(VARPTR(bufpos&),VARPTR(pp&), numBytes ,srcRowBytes,VARPTR(unpackres))
						IF unpackres=0 THEN
							PRINT "buffer too small":EXIT SUB
						END IF
					END IF
					numbytes=numbytes-(bufpos&-oldbufpos&)
					
				NEXT plane
			NEXT row
		END IF
		FreeMem buf&,bufsize
	END IF
END SUB


FUNCTION getcmap (BYVAL iff&, BYVAL screenptr&)
STATIC sp&
STATIC n		' number of colours
STATIC rgb&		' pointer to cmap
STATIC dest&	' pointer to table being generated
STATIC shifted	' flag set to duplicate top 4 bits of color for old CMAPs
STATIC i	 	' loop variable
STATIC c		' current color gun bits
STATIC table(1)	' table for LoadRGB data

	sp& = FindProp& (iff&, ID_ILBM&, ID_CMAP&)
	IF sp&=0 THEN
		getcmap=0
		EXIT FUNCTION
	END IF
	rgb& =PEEKL(sp&+sp_Data)
	n	= PEEKL(sp&+sp_Size) \ ColorRegister_sizeof
	' n is the number of colors in the CMAP
	IF PEEKW(LIBRARY("graphics.library")+lib_version)>=39 THEN
		shifted = -1
		FOR i=0 TO n*3-1
			IF 	PEEKB(rgb&+i) AND &h0F THEN
				shifted=0
				EXIT FOR
			END IF
		NEXT i
		REDIM table(n*6+2)	' 6 words per colour and 2 extras for header,1 at end
		table(0)=n			'set n colours
		table(1)=0			' starting at 0
		dest&=VARPTR(table(2))
		FOR i=0 TO n*3-1			' do this for each R,G,B of the N colors
			c=PEEKB(rgb&) : INCR rgb&
			IF shifted THEN	c=c OR (c>>4)
			POKEB dest&,c	: INCR dest&		
			POKEB dest&,c	: INCR dest&		
			POKEB dest&,c	: INCR dest&		
			POKEB dest&,c	: INCR dest&		
		NEXT i
		POKEW dest&,0		'a list of 0
				
		LoadRGB32 screenptr&+screenViewPort,VARPTR(table(0))

	ELSE
	
		REDIM table(n-1)
		FOR i=0 TO n-1
			table(i)=((PEEKB(rgb&)<<4) AND &hF00)+(PEEKB(rgb&+1) AND &H0F0)+ ((PEEKB(rgb&+2)>>4) AND &H0FFF)
			rgb&=rgb&+3
		NEXT i
		LoadRGB4 screenptr&+screenViewPort,VARPTR(table(0)),n
	END IF
	getcmap=-1
END FUNCTION


DIM SHARED textrect%(rectangle_sizeof\2), stdrect%(rectangle_sizeof\2),tags&(40)

FUNCTION dclip&(BYVAL mode&,BYVAL  w, BYVAL h)
STATIC i&
	
	dclip& = OSCAN_TEXT&

	IF QueryOverscan&(mode&,VARPTR(textrect(0)), OSCAN_TEXT&) THEN
	    IF QueryOverscan&(mode&, VARPTR(stdrect(0)), OSCAN_STANDARD&) THEN
		    IF	(w > textrect(RectangleMaxX\2) - textrect(RectangleMinX\2) + 1) OR _
				(h > textrect(RectangleMaxY\2) - textrect(RectangleMinY\2) + 1) THEN
					dclip& = OSCAN_STANDARD&
			END IF
		END IF
	END IF
	
END FUNCTION


FUNCTION  OpenIdScreen&(BYVAL mode&, BYVAL w, BYVAL h, BYVAL  depth%)
STATIC penarray,ns(1)
	IF PEEKW(LIBRARY("graphics.library")+lib_version)>= 36 THEN
		IF ModeNotAvailable (mode&) THEN
			mode&= mode& AND NOT(EXTENDED_MODE& OR SPRITES& OR GENLOCK_AUDIO& OR _
							   GENLOCK_VIDEO& OR VP_HIDE&)
			IF ModeNotAvailable (mode&) THEN
			      IF((mode& AND  &hFFFF0000)<> 0) AND ((mode& AND &h00001000)=0) THEN
					' bad CAMG present; use computed modes.
					mode& = 0
            		IF w >= 640 THEN  mode& = HIRES&
              		IF h >= 400 THEN  mode&= mode& OR LACE&
					IF depth=6 THEN
' This 6 planes == HAM or HALFBRITE is not
' necessarily true anymore, but hopefully all new  programs are writing a proper CAMG chunk!!
						PRINT "panic! EHB or HAM"
						OpenIdScreen&=0
						EXIT FUNCTION
					END IF
				END IF
			END IF
		END IF
		penarray%=&hff00
		PRINT "Using mode"; HEX$(mode&)
		TAGLIST VARPTR(tags&(0)),SA_DisplayID&,	mode&, _
				SA_Width&,		w, _
				SA_Height&,		h, _
				SA_Depth&,		depth, _
				SA_Overscan&,	dclip&(mode&, w, h), _
				SA_SysFont&,		1, _
				SA_Pens&,		VARPTR(penarray), _
				SA_Behind&,		TRUE&, _
				SA_AutoScroll&,	TRUE&, _
				SA_Interleaved&,	TRUE&, _
				TAG_DONE&
		OpenIdScreen&=OpenScreenTagList& (0, VARPTR(tags&(0)))
	ELSE
		REDIM ns(NewScreen_sizeof)
		ns(NewScreenWidth\2)		= w
		ns(NewScreenHeight\2)		= h
		ns(NewScreenDepth\2)		= depth
		ns(NewScreenViewModes\2)	= mode&
		ns(NewScreenBlockPen\2)		= 1
		ns(NewScreenType\2)			= CUSTOMSCREEN& OR SCREENBEHIND&

		OpenIdScreen&= OpenScreen&(VARPTR(ns(0)))
	END IF
END FUNCTION

'
'The main program
'
SUB main (filename$)
	STATIC iff&, stream&, junk&, sp&, bmhd&, camg&, bm&, screenptr&, w, h, depth

	iff& = AllocIFF&
	IF iff& THEN
		stream& = xOpen&(SADD(filename$ + CHR$(0)), MODE_OLDFILE&)
		IF stream& THEN
			POKEL iff& + iff_Stream, stream&		'connect the DOS stream

			IF PEEKW(LIBRARY("dos.library") + lib_Version) >= 36 THEN
			'for WB2 and above, use the buffered DOS I/O calls
				junk& = SetVBuf&(stream&, NULL&, BUF_FULL&, 8192)
				initIFFasBufferedDOS iff&
			ELSE
			'fall back for 1.3 (if you have 1.3 iffparse.library)
				InitIFFasDos iff&
			END IF

			IF OpenIFF&(iff&, IFFF_READ&) = 0 THEN
				IF PropChunk&(iff&, ID_ILBM&, ID_BMHD&) = 0 AND _
				  PropChunk&(iff&, ID_ILBM&, ID_CAMG&) = 0 AND _
				  PropChunk&(iff&, ID_ILBM&, ID_CMAP&) = 0 AND _
				  StopChunk&(iff&, ID_ILBM&, ID_BODY&) = 0 AND _
				  ParseIFF(iff&, IFFPARSE_SCAN&) = 0

					'look for a BMHD stored property
					sp& = FindProp&(iff&, ID_ILBM&, ID_BMHD&)
					bmhd& = 0
					IF sp& <>0 THEN
						bmhd& = PEEKL(sp& + sp_Data)
						PRINT "BMHD info:"
						w= PEEKW(bmhd& + bmh_Width)
						PRINT "bmh_Width = "; w
						h= PEEKW(bmhd& + bmh_Height)
						PRINT "bmh_Height = "; h
						PRINT "bmh_Left = "; PEEKW(bmhd& + bmh_Left)
						PRINT "bmh_Top = "; PEEKW(bmhd& + bmh_Top)
						depth= PEEKB(bmhd& + bmh_Depth)
						PRINT "bmh_Depth = "; depth
						PRINT "bmh_Masking = "; PEEKB(bmhd& + bmh_Masking)
						PRINT "bmh_Compression = "; PEEKB(bmhd& + bmh_Compression)
						PRINT "bmh_Pad = "; PEEKB(bmhd& + bmh_Pad)
						PRINT "bmh_Transparent = "; PEEKW(bmhd& + bmh_Transparent)
						PRINT "bmh_XAspect = "; PEEKB(bmhd& + bmh_XAspect)
						PRINT "bmh_YAspect = "; PEEKB(bmhd& + bmh_YAspect)
						PRINT "bmh_PageWidth = "; PEEKW(bmhd& + bmh_PageWidth)
						PRINT "bmh_PageHeight = "; PEEKW(bmhd& + bmh_PageHeight)
					END IF

					'look for a CAMG stored property
					sp& = FindProp&(iff&, ID_ILBM&, ID_CAMG&)
					IF sp& <>0 THEN
						camg& = PEEKL(PEEKL(sp& + sp_Data))
						PRINT "CAMG = "; HEX$(camg&)
					END IF
					IF bmhd& THEN
						bm& = SafeAllocBitMap&(w,h,depth, BMF_CLEAR& OR BMF_DISPLAYABLE&, NULL&)
						ReadBody iff&, bm&,bmhd&
						screenptr&=OpenIdScreen&(camg&,w, h, depth)
						IF screenptr& THEN
							IF GetCMAP(iff&,screenptr&)=0 THEN PRINT "No color map"
							ScreenToFront& screenptr&
							junk&=BltBitMapRastPort(bm&, 0, 0,screenptr&+RastPort, 0, 0, w, h, &h0c0)
							DO
							LOOP UNTIL LEN(INKEY$)
							junk&=CloseScreen&(screenptr&)
						ELSE
							PRINT "Can't open screen"
						END IF
						SafeFreeBitMap bm&
					
					END IF
				END IF
				CloseIFF iff&
				junk& = xClose(PEEKL(iff& + iff_Stream))
				FreeIFF iff&
			END IF
		ELSE
			PRINT filename$;" not found"
		END IF
	END IF
END SUB

'
' Start the main program
'
LIBRARY OPEN "dos.library"
LIBRARY OPEN "graphics.library"
LIBRARY OPEN "iffparse.library"
LIBRARY OPEN "exec.library"
LIBRARY OPEN "intuition.library"
main LTRIM$(RTRIM$(COMMAND$))