Tweet
Has anyone written procedures for reading or writing FITS (Flexible Image Transport Sustem) files using PowerBasic? FITS files are commonly used in astronomy.
-
-
might wanna check with my mate Kerry Farmer from New Zealand, i think he was working on a sustem ...
- -
Never mind-- figured it out myself.Comment
-
No example for future explorers to examine?Originally posted by Stephen Maas View Post
Anybody searching the database will come up with this thread.
This would be an ideal place to put some tested example code.The world is strange and wonderful.*
I reserve the right to be horrifically wrong.
Please maintain a safe following distance.
*wonderful sold separately.Comment
-
And it has happened. A "future explorer" linked here today and asked for because there is no example is posted.
Cheers,
DaleComment
-
In case someone comes looking again for FITS file creation, here are some snippets from my work in progress. This uses the ASCOM standard to connect to an astrophotography camera, take an exposure and write a FITS file. All the parameters in the primary header are not mandatory but I have included what is needed if you want to plate solve on the image. I hope this helps someone in the future get started. Also, the image data is usually an integer array but for some reason in Powerbasic it is received as a long integer array so needs to be converted. Thanks to Stuart McLachlan for his assistance with that and a couple other items.
Code:GLOBAL CameraASCOMName AS WSTRING GLOBAL myCamera AS IDISPATCH GLOBAL gCamera as CameraProperties TYPE CameraProperties MaxBinX AS LONG MaxBinY AS LONG CameraXSize AS LONG CameraYSize AS LONG GainMin AS LONG GainMax AS LONG ExposureMin AS DOUBLE ExposureMax AS DOUBLE PixelSizeX AS DOUBLE PixelSizeY AS DOUBLE OffsetMin AS LONG OffsetMax AS LONG END TYPE FUNCTION CameraConnect AS LONG LOCAL temp AS STRING LOCAL isConnected, t, MaxBin AS LONG LOCAL lOutput, lOutput2 AS INTEGER LOCAL cTimeOut AS LONG, connectStart, vDouble AS DOUBLE LOCAL sInput AS WSTRING setcursor hWaitCursor CONTROL GET TEXT hCameraTab,%txtCameraASCOMName TO CameraASCOMName IF CameraConnected=0 THEN sInput=CameraASCOMName LET myCamera=NOTHING myCamera=ANYCOM sInput IF ISOBJECT(myCamera)=0 THEN MSGBOX " Error creating Camera ASCOM object"+STR$(ISOBJECT(myMount)),%MB_TASKMODAL OR %MB_ICONERROR,"ASCOM Error" writeaudit 1, " Error creating Camera ASCOM object"+STR$(ISOBJECT(myMount)) wStatus 2, "Error creating ASCOM object" GOTO ConnectError ELSE OBJECT GET myCamera.Connected TO lOutPut writeaudit 1,"Status before connecting camera="+STR$(lOutput) lOutput = -1 OBJECT LET MyCamera.Connected = lOutput writeaudit 1,"Status after connecting camera= "+OBJRESULT$+" code:"+HEX$(IDISPINFO.CODE) t=0 isConnected=0 lOutPut=0 ConnectStart=getJD CONTROL GET TEXT hGlobalSetupTab,%cmbASCOMConnectTime TO temp cTimeOut=VAL(temp) IF cTimeOut<5 THEN cTimeOut=5 WHILE isConnected=0 OBJECT GET myCamera.Connected TO lOutPut writeaudit 1,"Is Camera Connected? "+STR$(lOUtput) isConnected=lOutput INCR t SLEEP ConnectWait IF (getjd-ConnectStart)*24*60*60 > cTimeOut THEN EXIT LOOP WEND IF isConnected=0 THEN wStatus 2,"Error connecting to camera" MSGBOX "Error connecting to Camera.",%MB_TASKMODAL OR %MB_ICONERROR,"ASCOM Error" GOTO ConnectError ELSE CONTROL SET TEXT hCameraTab,%bnCameraConnect, "Disconnect Camera" CameraConnected=1 wstatus 1,"Camera connected" writeaudit 1,"Camera connected - "+CameraASCOMName OBJECT GET myCamera.MaxBinX TO lOutput gCamera.MaxBinX = lOutput OBJECT GET myCamera.MaxBinY TO lOutput gCamera.MaxBinY = lOutput IF gCamera.MaxBinX<>gCamera.MaxBinY THEN IF gCamera.MaxBinX<gCamera.MaxBinY THEN gCamera.MaxBinY=gCamera.MaxBinX ELSE gCamera.MaxBinX=gCamera.MaxBinY END IF OBJECT GET myCamera.CameraXSize TO lOutPut gCamera.CameraXSize = lOutput OBJECT GET myCamera.CameraYSize TO lOutPut gCamera.CameraYSize = lOutput OBJECT GET myCamera.GainMin TO lOutPut gCamera.GainMin = lOutput OBJECT GET myCamera.GainMax TO lOutPut gCamera.GainMax = lOutput OBJECT GET myCamera.ExposureMin TO vDouble gCamera.ExposureMin = vDouble OBJECT GET myCamera.ExposureMax TO vDouble gCamera.ExposureMax = vDouble OBJECT GET myCamera.PixelSizeX TO vDouble gCamera.PixelSizeX = vDouble OBJECT GET myCamera.PixelSizeY TO vDouble gCamera.PixelSizeY = vDouble writeaudit 1,"Maximum Binning X ="+STR$(gCamera.MaxBinX) writeaudit 1,"Maximum Binning Y ="+STR$(gCamera.MaxBinY) writeaudit 1,"Maximum Pixels X ="+STR$(gCamera.CameraXSize) writeaudit 1,"Maximum Pixels Y ="+STR$(gCamera.CameraYSize) writeaudit 1,"Minimum Gain ="+STR$(gCamera.GainMin) writeaudit 1,"Maximum Gain ="+STR$(gCamera.GainMax) writeaudit 1,"Minimum Exposure ="+STR$(gCamera.ExposureMin)+" s" writeaudit 1,"Maximum Exposure ="+STR$(gCamera.ExposureMax)+" s" writeaudit 1,"Pixel Size X ="+STR$(gCamera.PixelSizeX) writeaudit 1,"Pixel Size Y ="+STR$(gCamera.PixelSizeY) CONTROL SET TEXT hCameraTab, %lblCameraExposureRange,"("+STR$(gCamera.ExposureMin)+"-"+STR$(gCamera.ExposureMax)+" )" CONTROL SET TEXT hCameraTab, %lblCameraGainRange,"("+STR$(gCamera.GainMin)+"-"+STR$(gCamera.GainMax)+" )" CONTROL ENABLE hCameraTab,%bnCameraTest CONTROL SET TEXT hCameraTab, %lblExposing,"" CONTROL GET TEXT hCameraTab,%txtCameraGain TO cGain IF TRIM$(cGain)="" THEN OBJECT GET myCamera.gain TO lOutput CONTROL SET TEXT hCameraTab,%txtCameraGain,TRIM$(STR$(lOutput)) END IF END IF END IF ELSE IF gCameraExposing=1 THEN writeaudit 1,"Aborting Exposure" OBJECT CALL myCamera.AbortExposure gCameraExposing=0 SLEEP 200 ' wait for camera to abort END IF lOutput = 0 OBJECT LET MyCamera.Connected = lOutput LET myCamera=NOTHING CONTROL SET TEXT hCameraTab,%bnCameraConnect, "Connect Camera" CameraConnected=0 CONTROL DISABLE hCameraTab,%bnCameraTest CONTROL SET TEXT hCameraTab, %lblExposing,"" CONTROL SET TEXT hCameraTab, %lblCameraExposureRange,"" CONTROL SET TEXT hCameraTab, %lblCameraGainRange,"" wstatus 1,"Camera disconnected" writeaudit 1,"Camera disconnected - "+CameraASCOMName END IF setcursor hNormalCursor EXIT FUNCTION ConnectError: LET myCamera=NOTHING CameraConnected=0 CONTROL SET TEXT hCameraTab,%bnCameraConnect, "Connect Camera" setcursor hNormalCursor wStatus 2, "Error connecting to Camera" END FUNCTION FUNCTION CameraExpose(BYVAL dummy AS LONG ) AS LONG LOCAL Exposure AS DOUBLE, light, lOutPut, lOutPut2 AS INTEGER, vImageData AS VARIANT, sImageData AS STRING LOCAL nDims, nLbound1,nUBound1, nLbound2,nUBound2,nLbound3,nUBound3, hFile AS LONG LOCAL pv AS tagVARIANT PTR, systime AS systemtime, sYear AS STRING LOCAL lngArraySize AS LONG, sHeaderData, sTemp AS STRING LOCAL pa AS IPOWERARRAY, x, y, z, lastBlockCnt, exitcode, iReturn AS LONG, tStatus AS LONG LOCAL ExposureStart AS DOUBLE, ArrayType, dataBit, ans, binningX, BinningY AS LONG LOCAL ExposureTime AS DOUBLE, ExposureLapsed, JDAdjust, vDouble AS DOUBLE JDAdjust=(site(CurrentSite).sUTCOffset)*1/24 CONTROL GET TEXT hCameraTab,%txtCameraExposure TO sTemp ExposureTime=VAL(sTemp) IF ExposureTime <gCamera.ExposureMin THEN ExposureTime=gCamera.ExposureMin CONTROL SET TEXT hCameraTab,%txtCameraExposure,TRIM$(STR$(ExposureTime)) ELSE IF ExposureTime > gCamera.ExposureMax THEN ExposureTime=gCamera.ExposureMax CONTROL SET TEXT hCameraTab,%txtCameraExposure,TRIM$(STR$(ExposureTime)) END IF END IF IF CameraConnected<>1 THEN CONTROL SET TEXT hCameraTab, %lblExposing,"Camera not connected" CONTROL REDRAW hCameraTab, %lblExposing FUNCTION=-2 EXIT FUNCTION END IF gCameraExposing=1 ON ERROR GOTO CameraExposureError 'Set Binning COMBOBOX GET SELECT hCameraTab, %cmbCameraBinning TO binning IF Binning>gCamera.MaxBinX THEN Binning=gCamera.MaxBinX COMBOBOX SELECT hCameraTab, %cmbCameraBinning, Binning END IF 'Set Gain CONTROL GET TEXT hCameraTab,%txtCameraGain TO cGain IF VAL(cGain)>gCamera.GainMax THEN cGain=TRIM$(STR$(gCamera.GainMax)) CONTROL SET TEXT hCameraTab,%txtCameraGain,cGain ELSE IF VAL(cGain)<gCamera.GainMin THEN cGain=TRIM$(STR$(gCamera.GainMin)) CONTROL SET TEXT hCameraTab,%txtCameraGain,cGain END IF END IF CONTROL GET TEXT hCameraTab,%txtCameraGain TO cGain writeaudit 2,"Setting gain to "+cGain IF TRIM$(cGain)<>"" THEN lOutPut=VAL(cGain) OBJECT LET MyCamera.Gain =lOutPut END IF writeaudit 2,"Setting binning to"+STR$(binning) lOutPut=binning OBJECT LET MyCamera.BinX=lOutPut OBJECT LET MyCamera.BinY=lOutPut 'Set NumX/NumY lOutput=INT(gCamera.CameraXSize/Binning) OBJECT LET MyCamera.NumX=lOutPut lOutPut=INT(gCamera.CameraYSize/Binning) OBJECT LET MyCamera.NumY=lOutPut light=1:exposure=ExposureTime writeaudit 2,"Starting Exposure" OBJECT CALL MyCamera.StartExposure(Exposure, light) ExposureStart=getjd getlocaltime systime writeaudit 2,"Now wait for image ready" lOutput=0 DO SLEEP 150 OBJECT GET MyCamera.ImageReady TO lOutput writeaudit 2,"ImageReady="+STR$(lOutPut) IF gCameraExposing=0 THEN exitcode=2 EXIT LOOP END IF ExposureLapsed=(GetJD-ExposureStart)*24*60*60 IF ExposureLapsed> ExposureTime+10 THEN exitcode=1 EXIT LOOP END IF IF ExposureLapsed> ExposureTime THEN CONTROL SET TEXT hCameraTab, %lblExposing,"Waiting for image "+FORMAT$(ExposureLapsed-ExposureTime,"#")+"s" ELSE CONTROL SET TEXT hCameraTab, %lblExposing,"Exposing "+FORMAT$(ExposureLapsed,"#")+" of "+FORMAT$(ExposureTime,"#")+" s" END IF CONTROL REDRAW hCameraTab, %lblExposing LOOP WHILE lOutPut=0 IF Exitcode=1 THEN 'timed out waiting for .ImageReady writeaudit 1,"Timed out waiting for image" END IF IF Exitcode=2 THEN 'Exposure was aborted CONTROL SET TEXT hCameraTab, %lblExposing,"Exposure aborted" FUNCTION=-3 EXIT FUNCTION END IF CONTROL SET TEXT hCameraTab, %lblExposing,"Downloading Image..." CONTROL REDRAW hCameraTab, %lblExposing OBJECT GET MyCamera.ImageArray TO vImageData ArrayType=VARIANTVT(vImageData) IF ArrAyType<8192 THEN writeaudit 1,"Camera error - invalid image array - variant type is"+STR$(ArrayType)+")" GOTO CameraExposureError ELSE SELECT CASE ArrayType CASE 8195 DataBit=4 CASE 8194 DataBit=2 'Not sure this ever happens with Powerbasic COM interface CASE ELSE writeaudit 1,"Unexpected data size - variant type is"+STR$(ArrayType)+")" GOTO CameraExposureError END SELECT END IF pv = VARPTR(vImageData) IF @pv.parray THEN nDims = SafeArrayGetDim(@pv.parray) writeaudit 1,"Acquiring image. Dimensions="+STR$(nDims)+" Variant="+STR$(ArrayType) IF nDims<2 OR nDims >3 THEN writeaudit 1,"Camera error - was expecting image array with 2 or 3 dimensions and was"+STR$(nDims)+" dimension(s)" GOTO CameraExposureError END IF ' Retrieve the number of elements of the array IF nDims>1 THEN SafeArrayGetLBound(@pv.parray, 1, nLBound1) SafeArrayGetUBound(@pv.parray, 1, nUBound1) SafeArrayGetLBound(@pv.parray, 2, nLBound2) SafeArrayGetUBound(@pv.parray, 2, nUBound2) END IF IF nDims>2 THEN SafeArrayGetLBound(@pv.parray, 3, nLBound3) SafeArrayGetUBound(@pv.parray, 3, nUBound3) END IF x=nUBound1-nLBound1+1 y=nUBound2-nLBound2+1 IF nDims=3 THEN ' Calculate the number of bytes to read z=nUBound3-nLBound3+1 lngArraySize = DataBit *x * y * z ELSE lngArraySize = DataBit *x * y END IF pa = CLASS "PowerArray" pa.MOVEFROMVARIANT vImageData 'Start building primary header sHeaderData=FITLineFormat("SIMPLE","T","PowerBasic FITS") sTemp= FItLineFormat("BITPIX","16","") sHeaderData=sHeaderData+sTemp sTemp=FitLineFormat("NAXIS",TRIM$(STR$(nDims)),"Dimensionality") sHeaderData=sHeaderData+sTemp sTemp=FitLineFormat("NAXIS1",TRIM$(STR$(x)),"") sHeaderData=sHeaderData+sTemp sTemp=FitLineFormat("NAXIS2",TRIM$(STR$(y)),"") sHeaderData=sHeaderData+sTemp IF nDims=3 THEN sTemp=FitLineFormat("NAXIS3",TRIM$(STR$(z)),"") sHeaderData=sHeaderData+sTemp END IF sTemp=FitLineFormat("BZERO","32768","BZERO") sHeaderData=sHeaderData+sTemp sTemp=FitLineFormat("ROWORDER","'TOP-DOWN'","Image Orientation") sHeaderData=sHeaderData+sTemp 'Get Binning OBJECT GET MyCamera.BinX TO binningx sTemp=FitLineFormat("XBINNING",TRIM$(STR$(binningx)),"X axis binning factor") sHeaderData=sHeaderData+sTemp OBJECT GET MyCamera.BinY TO binningy sTemp=FitLineFormat("YBINNING",TRIM$(STR$(binningy)),"Y axis binning factor") sHeaderData=sHeaderData+sTemp OBJECT GET MyCamera.PixelSizeX TO vDouble sTemp=FitLineFormat("XPIXSZ",FORMAT$(vDouble*binningx,"#.00"),"[um] Pixel X axis size") sHeaderData=sHeaderData+sTemp OBJECT GET MyCamera.PixelSizeY TO vDouble sTemp=FitLineFormat("YPIXSZ",FORMAT$(vDouble*binningy,"#.00"),"[um] Pixel Y axis size") sHeaderData=sHeaderData+sTemp sTemp=FitLineFormat("EXPOSURE",FORMAT$(ExposureTime,"#.000") ,"[s] Exposure duration") sHeaderData=sHeaderData+sTemp OBJECT GET myCamera.Gain TO lOutPut sTemp=FitLineFormat("GAIN",FORMAT$(lOutput,"#") ,"") sHeaderData=sHeaderData+sTemp OBJECT GET myCamera.Offset TO lOutPut sTemp=FitLineFormat("OFFSET",FORMAT$(lOutput,"#") ,"") sHeaderData=sHeaderData+sTemp sTemp=FitLineFormat("RA",FORMAT$(15*j2000RA(CurrentMountRa,CurrentMountDec),"#.00000"),"") sHeaderData=sHeaderData+sTemp sTemp=FitLineFormat("DEC",FORMAT$(j2000Dec(CurrentMountRA,CurrentMountDec),"#.00000"),"") sHeaderData=sHeaderData+sTemp CONTROL GET TEXT hCameraTab,%txtScopeFL TO ScopeFL IF TRIM$(ScopeFL)<>"" THEN sTemp=FitLineFormat("FOCALLEN",TRIM$(ScopeFL),"Telescope Focal Length") sHeaderData=sHeaderData+sTemp END IF sTemp=FitLineFormat("EXTEND","T","") sHeaderData=sHeaderData+sTemp sTemp=FitLineFormat("SITEELEV",STR$(site(CurrentSite).sElevation),"[m] Observation site elevation") sHeaderData=sHeaderData+sTemp sTemp=FitLineFormat("SITELAT", FORMAT$(site(CurrentSite).sLatitude,"#.0000000"),"[deg] Observation site latitude") sHeaderData=sHeaderData+sTemp sTemp=FitLineFormat("SITELONG",FORMAT$(site(CurrentSite).sLongitude,"#.0000000"),"[deg] Observation site longitude") sHeaderData=sHeaderData+sTemp sYear=CalculateDate(ExposureStart-JDAdjust) sTemp="DATE-OBS= '"+MID$(sYear,1,4)+"-"+MID$(sYear,5,2)+"-"+MID$(sYear,7,2)+"T"+TimeofDay(ExposureStart-JDAdjust,1,0)+"."+FORMAT$(systime.wmilliseconds,"000")+"' / Time of observation (UTC)" sHeaderData=sHeaderData+sTemp+SPACE$(80-LEN(sTemp)) sYear=CalculateDate(ExposureStart) sTemp="DATE-LOC= '"+MID$(sYear,1,4)+"-"+MID$(sYear,5,2)+"-"+MID$(sYear,7,2)+"T"+TimeofDay(ExposureStart,1,0)+"."+FORMAT$(systime.wmilliseconds,"000")+"' / Time of observation (local)" sHeaderData=sHeaderData+sTemp+SPACE$(80-LEN(sTemp)) sTemp=FitLineFormat("EQUINOX","2000.0","Equinox of celestial coordinate system") sHeaderData=sHeaderData+sTemp sTemp=FitLineFormat("SWCREATE","'SkyTrack "+$Version+"'","Software that created this file") sHeaderData=sHeaderData+sTemp sTemp="END" sHeaderData=sHeaderData+sTemp+SPACE$(80-LEN(sTemp)) LastBlockCnt= LEN(sHeaderData)MOD 2880 'primary header must be 2880 blocks IF LastBlockCnt<>0 THEN sHeaderData=sHeaderData+STRING$(2880-LastBlockCnt," ") 'add space character to make 2880 END IF writeaudit 2,"About to convert variant to string" sImageData = PEEK$(pa.arraybase,lngArraySize) writeaudit 2,"Now convert long array to integer array" sImageData = ImageArrayConvert(sImageData, DataBit) IF sImageData="" THEN GOTO CameraExposureError writeaudit 2,"Now make 2880 block" 'image data must be in 2880 byte blocks LastBlockCnt= LEN(sImageData)MOD 2880 IF LastBlockCnt<>0 THEN sImageData=sImageData+STRING$(2880-LastBlockCnt,CHR$(0)) ' add NULL characters to make 2880 bytes END IF IF ISFILE(gFitsPath+gFitsName)<>0 THEN KILL gFitsPath+gFitsName writeaudit 1,"Write results to file" hFile=FREEFILE OPEN gFitsPath+gFitsName FOR BINARY AS # hFile PUT #hfile,, sHeaderData PUT #hfile,, sImageData sImageData= "" CLOSE hfile writeaudit 1,"Finsihed creating FITS file" gCameraExposing=0 FUNCTION=-1 CONTROL SET TEXT hCameraTab, %lblExposing,"Image saved" CONTROL REDRAW hCameraTab, %lblExposing END IF LET vImageData = EMPTY 'to prevent memory leak EXIT FUNCTION CameraExposureError: LET vImageData = EMPTY 'to prevent memory leak FUNCTION=-2 IF ERR<>0 THEN writeaudit 1,"Err="+STR$(ERR) IF ERR=99 THEN writeaudit 1,"Object Error "+OBJRESULT$+" : "+HEX$(IDISPINFO.CODE)+" : "+IDISPINFO.DESC$ END IF END IF gCameraExposing=0 writeaudit 1,"Exposure attempt yielded no image" CONTROL SET TEXT hCameraTab, %lblExposing,"Error acquiring image" CONTROL REDRAW hCameraTab, %lblExposing END FUNCTION FUNCTION FITLineFormat(Parameter AS STRING, pValue AS STRING, desc AS STRING) AS STRING LOCAL temp AS STRING temp=LEFT$(parameter+SPACE$(8),8)+"= " 'Paramter name is 8 digits and "=" needs to be in position 9 temp=temp+SPACE$(30-(LEN(temp)+LEN(pValue)))+pValue+" / "+LEFT$(desc+SPACE$(47),47) 'total line must be 80 char FUNCTION=temp END FUNCTION FUNCTION ImageArrayConvert(sData AS STRING, DataBit AS LONG) AS STRING LOCAL sTemp, sTemp2 AS STRING LOCAL t, cnt, pixelvalue AS LONG LOCAL psData AS LONG PTR LOCAL psTemp2 AS INTEGER PTR LOCAL b1,b2 AS BYTE IF LEN(sData) MOD DataBit <>0 THEN 'verify that data string is complete writeaudit 1,"Problem with data length of "+STR$(LEN(sData)) FUNCTION="" EXIT FUNCTION END IF cnt=LEN(sData)/DataBit 'number of pixels writeaudit 1,"len(sData)="+STR$(LEN(sData))+" databit="+STR$(databit)+" cnt="+STR$(cnt) sTemp2=STRING$(cnt*2," ") psData = STRPTR(sData) psTemp2 = STRPTR(STemp2) FOR t=1 TO cnt b1 = PEEK(BYTE,psData + 1) 'converts long to integer b2 = PEEK(BYTE,psData ) POKE BYTE,psTemp2,b1,b2 'poke bytes in reverse order into Integers INCR psData INCR psTemp2 NEXT t FUNCTION = sTemp2 END FUNCTIONComment
-
Do you know about EXIF? EXIF can read it.
https://exiftool.org/forum/index.php?topic=9941.0
i call EXIF from PB all the time. Ask if you want more info...Comment
-
Thanks David. All I need is FITS as my application is Astronomy specific and have accomplished that now. Looks like a great tool!Comment
Comment