' ------------------------------------------------------------------------
'                Identifying a graphic file and obtaining
'    some info needed about it via custom routine/OS datatypes system
'  Thanks to Oliver Roberts for to confirm me some PNG and JPEG details.
'                                ------------
'                   Identificación de un fichero gráfico
'        y  devolución de la información que necesitamos sobre él.
'      Mi agradecimiento a Oliver Roberts por confirmar mis sospechas
'        de cómo averiguar la profundidad de una imagen JPEG / PNG.
' ------------------------------------------------------------------------
' Arguments/Argumentos                                                v2.1
'
' fich$ = Nombre del fichero (formato AmigaDOS
'         como por ejemplo "SYS:Img/Ejemplo.png")
'
'         Filename (AmigaDOS format like "SYS:Img/Ejemplo.png")
'
' Returned/Devuelve...
'
'         O una cadena nula (problemas con el fichero) o una
'         cadena con el formato "<FORMATO> - <ancho> x <alto> x <planos>"
'
'         Or a null string (troubles with the file) OR an
'         string with the format "<FORMAT> - <width> x <height> x <depth>"
' ------------------------------------------------------------------------

' ----------------------------------------
' REM $include dos.bh
' REM $include exec.bh
' REM $include locale.bh
' REM $include datatypes.bh
' REM $include utility.bc
' REM $include datatypes/pictureclass.bc
' REM $include datatypes/datatypesclass.bc
' ----------------------------------------

FUNCTION InfoImgFile$(fich$)
SHARED en&,em$
LOCAL  mem&,lon&,ptr&
LOCAL  a%,d%
LOCAL  o&,b&,d&,tags&
LOCAL  char&,tmp$,ok&

	tmp$ = ""

	ok& = NULL&

	' - Variables de error -
	' ----- Error vars -----
	' ----------------------
	en&  = NULL&
	em$  = ""

	' - Punteros para la sección de tipos de datos -
	' ---------- Pointers for the DT section -------
	' ----------------------------------------------
	o& = NULL&
	b& = NULL&
	d& = NULL&

	' - Puntero al bloque de memoria y longitud del fichero -
	' ------ Pointer to memory block and file length --------
	' -------------------------------------------------------
	mem& = NULL&
	lon& = NULL&


	' ---- Trap against BREAK event ---
	' - Trampa contra el evento BREAK -
	' ---------------------------------
	ON BREAK GOTO IIF_Salida

	' ----- Carga del fichero en memoria ------
	' ------ Loading the file in memory -------
	' -----------------------------------------
	IF FEXISTS(fich$) AND (RIGHT$(fich$,1) <> ":" AND RIGHT$(fich$,1) <> "/") THEN

		OPEN fich$ FOR INPUT AS #1

			lon& = LOF(1)

			' ¿El fichero está vacío?
			'   The file isn empty?
			' -----------------------
			IF lon& <> NULL& THEN
				mem& = AllocMem&(lon&,MEMF_PUBLIC& OR MEMF_CLEAR& OR MEMF_ANY&)

				IF mem& <> NULL& THEN
					BLOAD #1,mem&,lon&
				ELSE
					' Fatal error
					' Error fatal
					' -----------
					em$ = liStr$(ERROR_NO_MEMORY&)
					GOTO IIF_Salida
				END IF
			ELSE
				' Fatal error
				' Error fatal
				' -----------
				em$ = liStr$(ERROR_FILE_EMPTY&)
				GOTO IIF_Salida
			END IF

		CLOSE #1

	ELSE

		' Fatal error
		' Error fatal
		' -----------
		em$ = liStr$(ERROR_FILE_NOT_FOUND&)
		GOTO IIF_Salida

	END IF

' ------------------------------------------------------------------------

	' -- Comprobando si se trata de un fichero JPEG (JFIF/EXIF/...) -
	' --------- (http://www.wotsit.org/filezdir/jpeg.zip) -----------
	' ------------ (http://www.faqs.org/faqs/jpeg-faq/) -------------
	' - (http://www.pima.net/standards/it10/PIMA15740/Exif_2-1.PDF) -
	'                              -------
	' ------ Checking if this is a a JPEG (JFIF/EXIF/...) file ------
	' -------- (http://www.wotsit.org/filezdir/jpeg.zip) ------------
	' ----------- (http://www.faqs.org/faqs/jpeg-faq/) --------------
	' - (http://www.pima.net/standards/it10/PIMA15740/Exif_2-1.PDF) -
	' ---------------------------------------------------------------

	IF PEEKW(mem&) = &HFFD8 AND PEEKW(mem&+lon&-2&) = &HFFD9 AND lon& >= 32 THEN

		tmp$ = "JPEG -"

		ptr& = 2&

		' Buscando el bloque SOFx (x = 0 - 3)
		' Searching the SOFx block (x = 0 - 3)
		' ------------------------------------
		DO

			IF PEEK(mem&+ptr&) = &HFF THEN

				' Encontrado el bloque SOS
				'   Found the SOS marker
				' ------------------------
				IF PEEK(mem&+ptr&+1&) = &HDA THEN EXIT LOOP


				' Encontrado un bloque SOFx
				'    Found a SOFx marker
				' -------------------------
				IF PEEK(mem&+ptr&+1&) >= &HC0 AND PEEK(mem&+ptr&+1&) <= &HC3 THEN

					tmp$ = tmp$ + STR$(PEEKW(mem&+ptr&+7&))
					tmp$ = tmp$ + " x"
					tmp$ = tmp$ + STR$(PEEKW(mem&+ptr&+5&))
					tmp$ = tmp$ + " x"
					tmp$ = tmp$ + STR$(PEEK(mem&+ptr&+4&)*PEEK(mem&+ptr&+9&))

					ok& = TRUE&

					EXIT LOOP

				ELSE

					' Los marcadores &FF00 y &FFFF no son válidos como tales
					'      The &HFF00 and &FFFF aren't valid as markers
					' ------------------------------------------------------
					IF PEEK(mem&+ptr&+1&) = &H00& OR PEEK(mem&+ptr&+1&) = &HFF& THEN

							' Incrementando el puntero (para evitar octetos de relleno o basura)
							'     Increasing the pointer (to avoid pad bytes or data garbage)
							' ------------------------------------------------------------------
							ptr& = ptr& + 1&

					ELSE

						' Saltando al siguiente bloque ;)
						'  Skipping to the next block ;)
						' -------------------------------
						ptr& = ptr& + 2& + PEEKW(mem&+ptr&+2&)

					END IF

				END IF

			ELSE 
			
				' Incrementando el puntero (para evitar octetos de relleno o basura)
				'     Increasing the pointer (to avoid pad bytes or data garbage)
				' ------------------------------------------------------------------
				ptr& = ptr& + 1&

			END IF

			IF ptr& >= lon& THEN

				' Alcanzado el final del fichero
				'    Reaching the END OF FILE
				' ------------------------------
				EXIT LOOP

			END IF	

		LOOP

	END IF

' ------------------------------------------------------------------------

	' - Comprobando si se trata de un fichero PNG -
	' --- (http://www.w3.org/TR/REC-png.txt.gz) ---

	' ----- Checking if this is a a PNG file ------
	' --- (http://www.w3.org/TR/REC-png.txt.gz) ---
	' ---------------------------------------------

	IF ok& = NULL& THEN

		' ------- I verify what the 8 first bytes are equal ---------
		' --- to PNG signature and the IDHR chunk is the first. -----

		' --- Se comprueba que los 8 primeros octetos coinciden -----
		' ----- con la firma que identifica a los ficheros PNG ------
		' - y que el bloque IHDR está donde debe (en primer lugar). -
		' -----------------------------------------------------------

		IF PEEKL(mem&) = &H89504E47 AND PEEKL(mem&+4&) = &H0D0A1A0A AND PEEKL(mem&+12&) = &H49484452 AND lon& > 25& THEN

			tmp$ = "PNG -"

			' ------ Obtaining the image width and height... -----
			' - Obtención de la anchura y altura de la imagen... -
			' ----------------------------------------------------

			FOR a% = 16% TO 20% STEP 4%

				char& = 0&

				FOR d% = 0% TO 3%
					char& = char& + PEEK(mem&+a%+d%) * 256 ^ (3-d%)
				NEXT d%

				tmp$ = tmp$ + STR$(char&) + " x"

			NEXT a%

			' --------------- Obtaining the color depth... ---------------
			' - Obtención del número de planos (profundidad) de color... -
			' ------------------------------------------------------------

			IF PEEK(mem&+25&) = 0& OR PEEK(mem&+25&) = 4& THEN

				ok& = TRUE&
				tmp$ = tmp$ + STR$(PEEK(mem&+24&))

			ELSE

				IF PEEK(mem&+25&) = 2& OR PEEK(mem&+25&) = 6& THEN

					ok& = TRUE&
					tmp$ = tmp$ + STR$(PEEK(mem&+24&)*3&)

				ELSE

					IF PEEK(mem&+25&) = 3& THEN
					
						ptr& = PEEKL(mem&+8&)

						' Buscando el bloque PLTE
						' Searching the PLTE block
						' ------------------------
						DO

							IF PEEKL(mem&+ptr&) = &H504C5445 THEN
	
								tmp$ = tmp$ + STR$(CINT(LOG(PEEKL(mem&+ptr&-4&)/3&)/LOG(2)))
								EXIT LOOP
	
							END IF

							IF ptr& < lon& THEN
	
								ok& = TRUE&
								ptr& = ptr& + 1&

							ELSE

								' ---------- A bizarre/complex file... the job ---------
								' ------------ will be do by the DT system ;) ----------
								' - Un fichero extraño o complejo...   el trabajo será -
								' ------ hecho por los tipos de datos del S.O. ;) ------
								' ------------------------------------------------------
								EXIT LOOP

							END IF

						LOOP
					
					END IF

				END IF

			END IF

		END IF

	END IF

' ------------------------------------------------------------------------

	' -- Usando el sistema de tipos de datos --
	' ------ Using the datatypes system -------
	' -----------------------------------------

	' IoErr()
	LIBRARY OPEN "dos.library"

	' NewDTObjectA(), GetDTAttribsA(), DisposeDTObject()
	LIBRARY OPEN "datatypes.library",44&

	IF ok& = NULL& THEN

		' Taglist / Lista de atributos-propiedades para funciones del S.O.
		DIM tags&(8)

		' ------- Tags array for `NewDTObjectA()' -------
		' ------- will process only image files). -------
		' - Here I use some new tags (v44).  Add in the -
		' ----- `BH:datatypes/datatypesclass.bc'... -----

		' --- Lista de atributos para `NewDTObjectA()' --
		' --- Aquí uso algunas nuevas etiquetas (v44).---
		' Añádalas en `BH:datatypes/datatypesclass.bc'...
		' -----------------------------------------------
		'       CONST DTA_SourceAddress& =  &h80001027&
		'          CONST DTA_SourceSize& = &h80001028&
		'                CONST DTST_MEMORY& = 5&
		' -----------------------------------------------

		TAGLIST VARPTR(tags&(0)),_
			DTA_SourceType&, DTST_MEMORY&,_
			DTA_SourceAddress&, mem&, _
			DTA_SourceSize&, lon&, _
			DTA_GroupID&, GID_PICTURE&,_
			TAG_DONE&

		' ---- Creating empty structures as C style ----
		' - Creando estructuras vacías al estilo del C -
		' ----------------------------------------------
		d& = SADD(STRING$(Datatype_sizeof%,CHR$(0)))
		b& = SADD(STRING$(BitMapHeader_sizeof%,CHR$(0)))

		IF d& <> NULL& AND b& <> NULL& THEN

			' ----------- As the "structs" exist I ask my object ----------
			' ----------- (the graphic file) for work with this -----------

			' --- Puesto que las estructuras han sido creadas, solicito ---
			' ---- mi objeto (el fichero gráfico) para trabajar con él ----
			' -------------------------------------------------------------

			o& = NewDTObjectA&(SADD(fich$+CHR$(0)),VARPTR(tags&(0)))

			IF o& <> NULL& THEN

				' ------ As the "struct" exists I define a new taglist -------
				' --- for GetDTAttrsA& function (I want the image size and ---
				' --- depth saved in BitMapHeader struct and the image type --
				' ----------- accessible via the Datatype struct). -----------

				' ----- Puesto que la estructura ha sido creada, preparo -----
				' - la nueva lista de atributos para la función GetDTAttrsA& -
				' --- (necesito el tamaño de la imagen y su profundidad que --
				' ----- están guardados en la estructura BitMapHeader y ------
				' -------- el tipo de imagen accesible indirectamente --------
				' ------------ a través de la estructura Datatype). ----------
				' ------------------------------------------------------------

				TAGLIST VARPTR(tags&(0)),_
					PDTA_BitMapHeader&, VARPTR(b&),_
					DTA_Datatype&, VARPTR(d&),_
					TAG_DONE&


				' ----- I ask the info needed (the function must return ----
				' ------------ the number of attribs requested) ------------

				'  --------- Solicito la información que necesito ----------
				'  - (la función debe devolver el nº de atributos pedidos) -
				' ----------------------------------------------------------

				IF GetDTAttrsA&(o&,VARPTR(tags&(0))) = 2 THEN

					' ---------- Prints the info (the image type -----------
					' ------------ has four chars as maximum). --------------

					' -------- Se imprime la información (el tipo -----------
					' --- de imagen ocupa cuatro caracteres COMO MÁXIMO). ---
					' -------------------------------------------------------

					tmp$ = ""
					
					char& = PEEKL(d&+dtn_Header%)+dth_ID%

					FOR a% = 0% TO 3%
					IF UCASE$(CHR$(PEEK(char&+a%))) <> CHR$(0) THEN
						tmp$ = tmp$ + UCASE$(CHR$(PEEK(char&+a%)))
					ELSE
						EXIT FOR
					END IF
					NEXT a%

					tmp$ = tmp$+" -"

					tmp$ = tmp$ + STR$(PEEKW(b&+bmh_Width%))
					tmp$ = tmp$ + " x"
					tmp$ = tmp$ + STR$(PEEKW(b&+bmh_Height%))
					tmp$ = tmp$ + " x"
					tmp$ = tmp$ + STR$(PEEK(b&+bmh_Depth%))

				ELSE

					' ------------- Assign the IoErr&() result ------------
					' ---------- inmediatly or you will lost this. ---------

					' --- Asigne el resultado de IoErr&() inmediatamente ---
					' -------------- a una variable o lo perderá. ----------
					' ------------------------------------------------------
					en& = IoErr&()
					em$ = liStr$(ERROR_HAS_FAILED1&) + "GetDTAttrsA"
					em$ = em$ + liStr$(ERROR_HAS_FAILED2&)

				END IF

			ELSE

				en& = IoErr&()
				em$ = liStr$(ERROR_HAS_FAILED1&) + "NewDTObjectA"
				em$ = em$ + liStr$(ERROR_HAS_FAILED2&)

			END IF

		ELSE

			em$ = liStr$(ERROR_NO_MEMORY&)

		END IF

	END IF

' ------------------------------------------------------------------------

	IIF_Salida:
'	-----------

	BREAK STOP

	ON BREAK GOTO 0

	' - Liberando la memoria reservada para el fichero -
	' -- Releasing the memory allocated for the file ---
	' --------------------------------------------------
	IF o&   <> NULL& THEN DisposeDTObject&(o&)
	IF mem& <> NULL& THEN FreeMem mem&,lon&

	LIBRARY CLOSE "dos.library"
	LIBRARY CLOSE "datatypes.library"

	BREAK ON

	InfoImgFile$ = tmp$

END FUNCTION