From 5103e8ae3dde3314443d5d0531d222db5d81ceeb Mon Sep 17 00:00:00 2001 From: Sophie Pichler Date: Thu, 12 Mar 2026 17:53:21 +0100 Subject: [PATCH 1/4] Read mbi file to collect images --- src/PRo3D.ImageMapping/App.fs | 11 +- src/PRo3D.ImageMapping/Image.fs | 48 ++++--- src/PRo3D.ImageMapping/Model.fs | 2 + .../InstrumentMetadata.fs | 129 +++++++++--------- 4 files changed, 103 insertions(+), 87 deletions(-) diff --git a/src/PRo3D.ImageMapping/App.fs b/src/PRo3D.ImageMapping/App.fs index ced88c8..e2a60c5 100644 --- a/src/PRo3D.ImageMapping/App.fs +++ b/src/PRo3D.ImageMapping/App.fs @@ -36,16 +36,17 @@ module App = | SetPitch r -> { m with boresightAdjustment = { m.boresightAdjustment with pitch = Numeric.update m.boresightAdjustment.pitch r } } | SetYaw r -> { m with boresightAdjustment = { m.boresightAdjustment with yaw = Numeric.update m.boresightAdjustment.yaw r } } | LoadImagesDir directory -> - let imageExts = [".tif";".tiff";".jpg";".exr"] + let mbiExt = ".mbi.json" let images' = Directory.EnumerateFiles(directory) |> Seq.filter (fun p -> - let e = Path.GetExtension p - List.contains e imageExts + p.EndsWith(mbiExt) ) |> Seq.map (fun path -> - Image.loadFile(path) - ) |> IndexList.ofSeq + Image.mbiFileToImageObjs(path) + ) + |> Seq.collect id + |> IndexList.ofSeq let firstIndex = if IndexList.isEmpty images' then None diff --git a/src/PRo3D.ImageMapping/Image.fs b/src/PRo3D.ImageMapping/Image.fs index 5546095..d2b6e91 100644 --- a/src/PRo3D.ImageMapping/Image.fs +++ b/src/PRo3D.ImageMapping/Image.fs @@ -18,6 +18,8 @@ open PRo3D.InstrumentVisualization open PRo3D.Core open PRo3D.SPICE +open PRo3D.Core.InstrumentMetadata + module Shaders = open FShade @@ -99,13 +101,11 @@ module Image = texture = initialPath; distance = 0; time = new DateTime(); + instrument = ""; + mbi = ""; } - let loadFile (texturePath : string) = - // this could be a fallback - let ifUsefulThisIsHowToExtractInfos = MultiBandReader.tryGetChannels texturePath - - let (tiffMbiJson, tiffJson) = InstrumentMetadata.tryParseMetadataForImagePath texturePath + let loadFile (texturePath, ((tiffMbiJson : Option), (tiffJson : Option)), mbiPath : string) = let channels = match tiffJson with @@ -156,6 +156,11 @@ module Image = | Some mbi -> mbi.obs_date | None -> System.DateTime.MinValue // which default time? + let instrument = + match tiffMbiJson with + | Some mbi -> mbi.instrument + | None -> "" + { initial with texture = Path.GetFullPath(texturePath); defaultMinValues = defaultMinValues; @@ -167,8 +172,21 @@ module Image = dataType = dataType; distance = distance; time = time; + instrument = instrument; + mbi = mbiPath; } + + let mbiFileToImageObjs (mbiPath : string) = + // this could be a fallback + //let ifUsefulThisIsHowToExtractInfos = MultiBandReader.tryGetChannels mbiPath + let parsed_files = InstrumentMetadata.parseDataForMbiPath mbiPath + parsed_files + |> Array.map (fun (texturePath, (tiffMbiJson, tiffJson)) -> + loadFile (texturePath, (tiffMbiJson, tiffJson), mbiPath) + ) + + let update (m : Image) (msg : ImageMessage) = match msg with | SetDataTypeAndRange (dataType, min, max) -> @@ -339,10 +357,13 @@ module Image = let referenceFrame = cval "IAU_MARS" let currentProjectedImage = - m.texture - |> AVal.map (fun path -> - if File.Exists path then - Some (path, InstrumentMetadata.tryParseMetadataForImagePath path) + (m.mbi, m.texture) + ||> AVal.map2 (fun mbiPath texturePath -> + if File.Exists mbiPath then + let imageWithMetaData = + parseDataForMbiPath mbiPath + |> Array.find (fun (texturePath, ((tiffMbiJson : Option), (tiffJson : Option))) -> texturePath = texturePath) + Some imageWithMetaData else None ) @@ -390,15 +411,8 @@ module Image = let projectImage = Visualization.creatProjectionFunction observer time referenceFrame currentProjectedImage projection let projectedTexture = Visualization.createProjectedTexture currentProjectedImage m.selectedChannel - let projectionEnabled = - currentProjectedImage - |> AVal.map (function - | Some (_, (Some _, _)) -> true - | _ -> false - ) - let scene = - Visualization.createSceneGraph imageSettings referenceFrame supportBody observer time projectImage projectedTexture projectionEnabled + Visualization.createSceneGraph imageSettings referenceFrame supportBody observer time projectImage projectedTexture (AVal.constant true) |> Sg.noEvents scene diff --git a/src/PRo3D.ImageMapping/Model.fs b/src/PRo3D.ImageMapping/Model.fs index bb630a8..ff9a516 100644 --- a/src/PRo3D.ImageMapping/Model.fs +++ b/src/PRo3D.ImageMapping/Model.fs @@ -48,6 +48,8 @@ type Image = texture : string distance: float time: System.DateTime + instrument: string + mbi : string } [] diff --git a/src/PRo3D.InstrumentData/InstrumentMetadata.fs b/src/PRo3D.InstrumentData/InstrumentMetadata.fs index c333873..04d5b77 100644 --- a/src/PRo3D.InstrumentData/InstrumentMetadata.fs +++ b/src/PRo3D.InstrumentData/InstrumentMetadata.fs @@ -100,9 +100,13 @@ module Tiff_Mbi_Json = open System.Globalization type Mbi = { - obs_date : DateTime; sunPos : V3d; earthPos : V3d; - sc_quat : QuaternionD; targetPos : V3d + obs_date : DateTime; + sunPos : V3d; + earthPos : V3d; + sc_quat : QuaternionD; + targetPos : V3d instrument : string + imagePath : string } let tryGetFitsHeader (headerName : string) (mbi : JsonValue) (m : JsonValue -> Option<'a>): Option<'a> = @@ -119,6 +123,17 @@ module Tiff_Mbi_Json = | _ -> None + let tryGetImagePaths (mbi : JsonValue) (rootDirectory : string) : string array = + match mbi?bands with + | JsonValue.Array arr -> + arr + |> Array.map (fun band -> + let filename = band?file_path.AsString() + Log.line "%s" (Path.Combine(rootDirectory, filename)) + Path.Combine(rootDirectory, filename) + ) + | _ -> + [] |> List.toArray let parseDate (s : JsonValue) : Option = match s with @@ -154,12 +169,12 @@ module Tiff_Mbi_Json = let tryExtractSC_quat (mbi : JsonValue) = match tryGetFitsHeader "SC_QUAT0" mbi parseFloat, tryGetFitsHeader "SC_QUAT1" mbi parseFloat, tryGetFitsHeader "SC_QUAT2" mbi parseFloat, tryGetFitsHeader "SC_QUAT3" mbi parseFloat with | Some q0, Some q1, Some q2, Some q3 -> - QuaternionD(q0, q1, q2, q3) |> Result.Ok + Some (QuaternionD(q0, q1, q2, q3)) | _ -> - Result.Error "could not extract SC_QUAT from mbi json" + None - let tryParseJson (content : string) = + let tryParseJson (content : string) (rootDirectory : string) = match JsonValue.TryParse(content) with | Some mbi -> try @@ -167,15 +182,24 @@ module Tiff_Mbi_Json = let earthPos = tryExtractXyz "EARTPOSX" "EARTPOSY" "EARTPOSZ" mbi let targetPos = tryExtractXyz "TRG_POSX" "TRG_POSY" "TRG_POSZ" mbi let instrument = tryGetFitsHeader "INSTRUME" mbi (function JsonValue.String s -> Some s | _ -> None) - match tryExtractDateObsFromMbi mbi, sunPos, earthPos, tryExtractSC_quat mbi, targetPos, instrument with - | Some d, Some sunPos, Some earthPos, Result.Ok quat, Some targetPos, Some instrument -> - { - obs_date = d; sunPos = sunPos; - earthPos = earthPos - sc_quat = quat - targetPos = targetPos - instrument = instrument - } |> Result.Ok + let (imagePaths : string array) = tryGetImagePaths mbi rootDirectory + let date = tryExtractDateObsFromMbi mbi + let quat = tryExtractSC_quat mbi + match date with + | Some d -> + imagePaths + |> Array.map (fun image -> + // TBD: default values! + { + obs_date = d; + sunPos = match sunPos with | Some sunPos -> sunPos | None -> V3d.Zero + earthPos = match earthPos with | Some earthPos -> earthPos | None -> V3d.Zero + sc_quat = match quat with | Some quat -> quat | None -> QuaternionD(0,0,0,0) + targetPos = match targetPos with | Some targetPos -> targetPos | None -> V3d.Zero + instrument = match instrument with | Some instrument -> instrument | None -> "" + imagePath = image + } + ) |> Result.Ok | _ -> Result.Error (System.Exception("could not find DATE-OBS in mbi json")) with e -> Result.Error e @@ -184,57 +208,32 @@ module Tiff_Mbi_Json = type ParsedMetadata = Option * Option -let tryParseMetadataForImagePath (imagePath : string) : ParsedMetadata = - let getJsonMbiInfoPath (imagePath : string) (suffix : string) : string = - let killPhrases = ["_Stacked"; "_AFC1"; "_AFC2"; "_HSH"] - let fi = Path.Combine(Path.GetDirectoryName(imagePath), Path.GetFileNameWithoutExtension(imagePath) + suffix) - // metadata file naming does not follow a strict pattern, therefore we cover some variations of naming conventions we observed: - if File.Exists fi then - fi - else - List.fold (fun (path : string) kill -> path.Replace(kill, "")) fi killPhrases - - let getJsonInfoPath (imagePath : string) (suffix : string) : string = - let killPhrases = ["_Stacked"; "_AFC1"; "_AFC2"; "_HSH"] - let fi = Path.Combine(Path.GetDirectoryName(imagePath), Path.GetFileName(imagePath) + suffix) - // metadata file naming does not follow a strict pattern, therefore we cover some variations of naming conventions we observed: - if File.Exists fi then - fi - else - let fiv1 = List.fold (fun (path : string) kill -> path.Replace(kill, "")) fi killPhrases - if File.Exists fiv1 then - fiv1 - else - let fiv2 = fiv1.Replace(".exr", ".tif") - let fiv3 = fi.Replace(".exr", ".tif") - if Path.Exists fiv2 then - fiv2 - else - fiv3 - - let mbi_json = getJsonMbiInfoPath imagePath ".mbi.json" - let json = getJsonInfoPath imagePath ".json" - match File.Exists(mbi_json), File.Exists(json) with - | true, true -> - try - let mbi_json = File.ReadAllText(mbi_json) - let jimMetadata = File.ReadAllText(json) - match Tiff_Mbi_Json.tryParseJson mbi_json, Tiff_Json.tryParseJson jimMetadata with - | Result.Ok mbi_json, Result.Ok tif_json -> Some mbi_json, Some tif_json - | _, Result.Ok jimMetadata -> None, Some jimMetadata - | Result.Ok mbi_json, _ -> Some mbi_json, None - | _ -> None, None - with e -> - printfn $"could not parse json metadtata for {imagePath}: {e}" - None, None - | f, e -> - printfn "%s, %A" mbi_json (f,e) - None, None +let parseDataForMbiPath (mbiPath : string) : (string * ParsedMetadata) array = + try + let mbi_json_files= File.ReadAllText(mbiPath) + match Tiff_Mbi_Json.tryParseJson mbi_json_files (Path.GetDirectoryName(mbiPath)) with + | Result.Ok mbi_json_files -> + mbi_json_files + |> Array.map (fun mbi_json -> + let imagePath = mbi_json.imagePath + let jimMetadata = imagePath + ".json" + let test = Path.Exists(jimMetadata) + match Tiff_Json.tryParseJson jimMetadata with + | Result.Ok jimMetadata -> + imagePath, (Some mbi_json, Some jimMetadata) + | _ -> + imagePath, (Some mbi_json, None) + ) + | _ -> + [] |> List.toArray + with e -> + printfn $"could not parse json metadtata for {mbiPath}: {e}" + [] |> List.toArray let discoverInstrumentFolder (dir : string) : seq = - let tifs = Directory.EnumerateFiles(dir, "*.tif", SearchOption.TopDirectoryOnly) - tifs - |> Seq.map (fun tifFilename -> - let metaData = tryParseMetadataForImagePath tifFilename - tifFilename, metaData + let mbiFiles = Directory.EnumerateFiles(dir, "*.mbi.json", SearchOption.TopDirectoryOnly) + mbiFiles + |> Seq.map (fun mbiPath -> + parseDataForMbiPath mbiPath ) + |> Seq.collect id From 80008bc573482307af012b8d8ac9d027308eb7bd Mon Sep 17 00:00:00 2001 From: Sophie Pichler Date: Tue, 17 Mar 2026 10:58:55 +0100 Subject: [PATCH 2/4] Fix path comparison --- src/PRo3D.ImageMapping/Image.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/PRo3D.ImageMapping/Image.fs b/src/PRo3D.ImageMapping/Image.fs index d2b6e91..6e65864 100644 --- a/src/PRo3D.ImageMapping/Image.fs +++ b/src/PRo3D.ImageMapping/Image.fs @@ -362,7 +362,7 @@ module Image = if File.Exists mbiPath then let imageWithMetaData = parseDataForMbiPath mbiPath - |> Array.find (fun (texturePath, ((tiffMbiJson : Option), (tiffJson : Option))) -> texturePath = texturePath) + |> Array.find (fun (texturePath_, ((tiffMbiJson : Option), (tiffJson : Option))) -> texturePath_ = texturePath) Some imageWithMetaData else None From 2a548f4a043e2f9ea9db9fb532764e92bd6e1220 Mon Sep 17 00:00:00 2001 From: Sophie Pichler Date: Tue, 17 Mar 2026 11:07:18 +0100 Subject: [PATCH 3/4] Fix jimData reading --- src/PRo3D.InstrumentData/InstrumentMetadata.fs | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/PRo3D.InstrumentData/InstrumentMetadata.fs b/src/PRo3D.InstrumentData/InstrumentMetadata.fs index 04d5b77..84b1684 100644 --- a/src/PRo3D.InstrumentData/InstrumentMetadata.fs +++ b/src/PRo3D.InstrumentData/InstrumentMetadata.fs @@ -210,17 +210,17 @@ type ParsedMetadata = Option * Option mbi_json_files |> Array.map (fun mbi_json -> let imagePath = mbi_json.imagePath - let jimMetadata = imagePath + ".json" - let test = Path.Exists(jimMetadata) - match Tiff_Json.tryParseJson jimMetadata with - | Result.Ok jimMetadata -> - imagePath, (Some mbi_json, Some jimMetadata) + let jimPath = imagePath + ".json" + let jimData = File.ReadAllText(jimPath) + match Tiff_Json.tryParseJson jimData with + | Result.Ok jimData -> + imagePath, (Some mbi_json, Some jimData) | _ -> imagePath, (Some mbi_json, None) ) From 3d5321739ee4deafe3ea84159f6a620e22d27561 Mon Sep 17 00:00:00 2001 From: Sophie Pichler Date: Tue, 17 Mar 2026 14:24:04 +0100 Subject: [PATCH 4/4] Remove reloading of metadata --- src/PRo3D.ImageMapping/Image.fs | 45 ++++++----------- src/PRo3D.InstrumentProjection/Program.fs | 13 ++++- .../Visualization.fs | 49 +++++++------------ 3 files changed, 44 insertions(+), 63 deletions(-) diff --git a/src/PRo3D.ImageMapping/Image.fs b/src/PRo3D.ImageMapping/Image.fs index 6e65864..21c15fd 100644 --- a/src/PRo3D.ImageMapping/Image.fs +++ b/src/PRo3D.ImageMapping/Image.fs @@ -356,18 +356,6 @@ module Image = let referenceFrame = cval "ECLIPJ2000" let referenceFrame = cval "IAU_MARS" - let currentProjectedImage = - (m.mbi, m.texture) - ||> AVal.map2 (fun mbiPath texturePath -> - if File.Exists mbiPath then - let imageWithMetaData = - parseDataForMbiPath mbiPath - |> Array.find (fun (texturePath_, ((tiffMbiJson : Option), (tiffJson : Option))) -> texturePath_ = texturePath) - Some imageWithMetaData - else - None - ) - let imageSettings = { VisualizationProperties.empty with @@ -386,30 +374,25 @@ module Image = time = DateTime.Now boresightAdjustment = None } - (currentProjectedImage, boresightAdjustment) ||> AVal.map2 (fun currentProjectedImage boresight -> - match currentProjectedImage with - | Some (f, (Some mbi,_)) -> - let p = - { p with - time = mbi.obs_date - instrumentName = - match InstrumentProjection.instrument2SpiceName mbi.instrument with - | None -> failwith "no spice name for the given instrument." - | Some i -> i - instrumentReferenceFrame = "J2000" - boresightAdjustment = boresight - } - p, mbi.obs_date - | _ -> - let defaultTime = "2025-03-12 11:50:30.000Z" - p, DateTime.Parse(defaultTime) + boresightAdjustment |> AVal.map (fun boresight -> + let p = + { p with + time = m.time |> AVal.force + instrumentName = + match InstrumentProjection.instrument2SpiceName (m.instrument |> AVal.force) with + | None -> failwith "no spice name for the given instrument." + | Some i -> i + instrumentReferenceFrame = "J2000" + boresightAdjustment = boresight + } + p, p.time ) let projection = projectionSetup |> AVal.map fst let time = projectionSetup |> AVal.map snd - let projectImage = Visualization.creatProjectionFunction observer time referenceFrame currentProjectedImage projection - let projectedTexture = Visualization.createProjectedTexture currentProjectedImage m.selectedChannel + let projectImage = Visualization.creatProjectionFunction observer time referenceFrame projection + let projectedTexture = Visualization.createProjectedTexture (m.texture |> AVal.force) m.selectedChannel let scene = Visualization.createSceneGraph imageSettings referenceFrame supportBody observer time projectImage projectedTexture (AVal.constant true) diff --git a/src/PRo3D.InstrumentProjection/Program.fs b/src/PRo3D.InstrumentProjection/Program.fs index 9fea850..f25e254 100644 --- a/src/PRo3D.InstrumentProjection/Program.fs +++ b/src/PRo3D.InstrumentProjection/Program.fs @@ -174,6 +174,15 @@ module InstrumentProjectionViewer = Range1d.Unit ) + let texture = + currentProjectedImage |> AVal.map (fun img -> + match img with + | Some (texture, (_, Some imgMeta) : ParsedMetadata) -> + texture + | _ -> + "" + ) + let projectionOpacity = cval 1.0 @@ -190,8 +199,8 @@ module InstrumentProjectionViewer = colorMapping = colorMap } - let projectImage = Visualization.creatProjectionFunction observer time referenceFrame currentProjectedImage (AVal.constant projection) - let projectedTexture = Visualization.createProjectedTexture currentProjectedImage (AVal.constant { idx = 0; name = None}) + let projectImage = Visualization.creatProjectionFunction observer time referenceFrame (AVal.constant projection) + let projectedTexture = Visualization.createProjectedTexture (texture |> AVal.force) (AVal.constant { idx = 0; name = None}) let opc = let molaOpcs = diff --git a/src/PRo3D.InstrumentProjection/Visualization.fs b/src/PRo3D.InstrumentProjection/Visualization.fs index 6a7fdec..54cb829 100644 --- a/src/PRo3D.InstrumentProjection/Visualization.fs +++ b/src/PRo3D.InstrumentProjection/Visualization.fs @@ -24,8 +24,6 @@ open PRo3D.Core.InstrumentMetadata open Aardvark.PixImage.LibTiff open PRo3D.InstrumentData open PRo3D.InstrumentVisualization -//open PRo3D.ImageMapping.Model - type Self = Self @@ -55,20 +53,16 @@ module Visualization = Log.warn "could not load texture" DefaultTextures.checkerboard - let createProjectedTexture (currentProjectedImage : aval>) (channel: aval) : aval = - AVal.bind2 (fun img c -> - match img with - | Some (img : string, (Some mbi, _)) -> - match Path.GetExtension(img).ToLower() with - | ".tiff" | ".tif" -> createProjectedTiffTexture img c.idx - | ".exr" -> createProjectedExrTexture img c.idx - | _ -> DefaultTextures.checkerboard - | _ -> - DefaultTextures.checkerboard - ) currentProjectedImage channel + let createProjectedTexture (texture : string) (channel: aval) : aval = + AVal.bind (fun c -> + match Path.GetExtension(texture).ToLower() with + | ".tiff" | ".tif" -> createProjectedTiffTexture texture c.idx + | ".exr" -> createProjectedExrTexture texture c.idx + | _ -> DefaultTextures.checkerboard + ) channel let creatProjectionFunction (observer : aval) (time : aval) (referenceFrame : aval) - (currentProjectedImage : aval>) (projection : aval) = + (projection : aval) = let farPlaneMars = 30101626.50 * 1000.0 @@ -85,22 +79,17 @@ module Visualization = let projectImage (targetPlanet : string) = AVal.custom (fun t -> - let img = currentProjectedImage.GetValue t - match img with - | Some (_, (Some mbi,_)) -> - let observer = observer.GetValue t - let time = time.GetValue t - let referenceFrame = referenceFrame.GetValue t - let projection = projection.GetValue t - let p = { - projection with - time = time - } - let t = InstrumentProjection.projectOntoQuat referenceFrame observer instruments p (-mbi.targetPos * 1000.0) mbi.sc_quat - let spice = InstrumentProjection.projectOnto referenceFrame observer instruments p - spice - | _ -> - None + let observer = observer.GetValue t + let time = time.GetValue t + let referenceFrame = referenceFrame.GetValue t + let projection = projection.GetValue t + let p = { + projection with + time = time + } + //let t = InstrumentProjection.projectOntoQuat referenceFrame observer instruments p (-image.targetPos * 1000.0) image.sc_quat + let spice = InstrumentProjection.projectOnto referenceFrame observer instruments p + spice ) projectImage