From 88fcf9b4a360bb5799f039a4b026927c27b8aeb1 Mon Sep 17 00:00:00 2001 From: orion kindel Date: Mon, 23 Feb 2026 12:35:20 -0600 Subject: [PATCH] more --- spago.lock | 1 + spago.yaml | 1 + src/Mujoco.MJCF.Actuator.purs | 134 ++++++++++++++++++ src/Mujoco.MJCF.Asset.purs | 61 ++------ src/Mujoco.MJCF.Body.purs | 73 +++------- src/Mujoco.MJCF.Common.purs | 16 ++- src/Mujoco.MJCF.Geom.purs | 23 +-- src/Mujoco.MJCF.Keyword.purs | 256 ++++++++++++++++++++++++++++++++++ src/Mujoco.MJCF.Tendon.purs | 6 +- src/Mujoco.MJCF.purs | 121 ++++++---------- test/Mujoco.MJCF.purs | 66 ++++----- 11 files changed, 511 insertions(+), 247 deletions(-) create mode 100644 src/Mujoco.MJCF.Actuator.purs create mode 100644 src/Mujoco.MJCF.Keyword.purs diff --git a/spago.lock b/spago.lock index d832bf9..8dc83f2 100644 --- a/spago.lock +++ b/spago.lock @@ -6,6 +6,7 @@ "core": { "dependencies": [ "arrays", + "either", "elmish", "elmish-html", "foldable-traversable", diff --git a/spago.yaml b/spago.yaml index 6e71645..0ee6d60 100644 --- a/spago.yaml +++ b/spago.yaml @@ -21,6 +21,7 @@ package: - spec-node dependencies: - arrays + - either - elmish - elmish-html - foldable-traversable diff --git a/src/Mujoco.MJCF.Actuator.purs b/src/Mujoco.MJCF.Actuator.purs new file mode 100644 index 0000000..8d46b0f --- /dev/null +++ b/src/Mujoco.MJCF.Actuator.purs @@ -0,0 +1,134 @@ +module Mujoco.MJCF.Actuator where + +import Mujoco.Prelude +import Mujoco.MJCF.Keyword as Kw + +actuator = tag @() "actuator" :: Tag () + +type Interp = Kw.Zoh \/ Kw.Linear \/ Kw.Cubic +type DynType = Kw.None \/ Kw.Integrator \/ Kw.Filter \/ Kw.FilterExact \/ Kw.Muscle \/ Kw.User +type GainType = Kw.Fixed \/ Kw.Affine \/ Kw.Muscle \/ Kw.User +type BiasType = Kw.None \/ Kw.Affine \/ Kw.Muscle \/ Kw.User + +type CommonMin r = + ( class :: String + , group :: Int + , delay :: Real + , forcelimited :: Kw.Auto \/ Boolean + , ctrlrange :: Real /\ Real + , forcerange :: Real /\ Real + , user :: Array Real + , interp :: Interp + , nsample :: Int + | Named r + ) + +type Common r = + ( ctrllimited :: Kw.Auto \/ Boolean + , lengthrange :: Real /\ Real + , gear :: Array Real + , cranklength :: Real + , joint :: String + , jointinparent :: String + , tendon :: String + , cranksite :: String + , slidersite :: String + , site :: String + , refsite :: String + | CommonMin r + ) + +type Props_general = + ( actlimited :: Kw.Auto \/ Boolean + , actrange :: Real /\ Real + , actdim :: Int + , dyntype :: DynType + , gaintype :: GainType + , biastype :: BiasType + , dynprm :: Array Real + , gainprm :: Array Real + , biasprm :: Array Real + , actearly :: Boolean + , body :: String + | Common () + ) +general = tagNoContent @Props_general "general" :: TagNoContent Props_general + +type Props_adhesion = + ( body :: String + , gain :: Real + | CommonMin () + ) +adhesion = tagNoContent @Props_adhesion "adhesion" :: TagNoContent Props_adhesion + +type Props_plugin = + ( actlimited :: Kw.Auto \/ Boolean + , actdim :: Int + , dynprm :: Array Real + , actearly :: Boolean + , actrange :: Real /\ Real + , dyntype :: DynType + , instance :: String + , plugin :: String + | Common () + ) +plugin = tagNoContent @Props_plugin "plugin" :: TagNoContent Props_plugin + +type Props_motor = Common () +motor = tagNoContent @Props_motor "motor" :: TagNoContent Props_motor + +type Props_position = + ( kp :: Real + , kv :: Real + , dampratio :: Real + , timeconst :: Real + , inheritrange :: Real + | Common () + ) +position = tagNoContent @Props_position "position" :: TagNoContent Props_position + +type Props_velocity = + ( kv :: Real + | Common () + ) +velocity = tagNoContent @Props_velocity "velocity" :: TagNoContent Props_velocity + +type Props_intvelocity = + ( kp :: Real + , kv :: Real + , dampratio :: Real + , inheritrange :: Real + , actrange :: Real /\ Real + | Common () + ) +intvelocity = tagNoContent @Props_intvelocity "intvelocity" :: TagNoContent Props_intvelocity + +type Props_damper = + ( kv :: Real + | Common () + ) +damper = tagNoContent @Props_damper "damper" :: TagNoContent Props_damper + +type Props_cylinder = + ( timeconst :: Real + , area :: Real + , diameter :: Real + , bias :: Vec Real + | Common () + ) +cylinder = tagNoContent @Props_cylinder "cylinder" :: TagNoContent Props_cylinder + +type Props_muscle = + ( timeconst :: Real /\ Real + , tausmooth :: Real + , range :: Real /\ Real + , force :: Real + , scale :: Real + , lmin :: Real + , lmax :: Real + , vmax :: Real + , fpmax :: Real + , fvmax :: Real + | Common () + ) +muscle = tagNoContent @Props_muscle "muscle" :: TagNoContent Props_muscle diff --git a/src/Mujoco.MJCF.Asset.purs b/src/Mujoco.MJCF.Asset.purs index bb57c47..15f0162 100644 --- a/src/Mujoco.MJCF.Asset.purs +++ b/src/Mujoco.MJCF.Asset.purs @@ -2,14 +2,11 @@ module Mujoco.MJCF.Asset where import Mujoco.Prelude +import Mujoco.MJCF.Keyword as Kw + asset = tag @() "asset" :: Tag () -data MeshInertia = Convex | Exact | Legacy | Shell -instance Serialize MeshInertia where - serialize Convex = "convex" - serialize Exact = "exact" - serialize Legacy = "legacy" - serialize Shell = "shell" +type MeshInertia = Kw.Convex \/ Kw.Exact \/ Kw.Legacy \/ Kw.Shell type Props_mesh = ( name :: String @@ -43,31 +40,10 @@ type Props_hfield = ) hfield = tagNoContent @Props_hfield "hfield" :: TagNoContent Props_hfield -data TextureType = Texture2d | TextureCube | TextureSkybox -instance Serialize TextureType where - serialize Texture2d = "2d" - serialize TextureCube = "cube" - serialize TextureSkybox = "skybox" - -data TextureColorspace = ColorspaceAuto | ColorspaceLinear | ColorspaceSRGB -instance Serialize TextureColorspace where - serialize ColorspaceAuto = "auto" - serialize ColorspaceLinear = "linear" - serialize ColorspaceSRGB = "sRGB" - -data TextureBuiltin = BuiltinNone | BuiltinGradient | BuiltinChecker | BuiltinFlat -instance Serialize TextureBuiltin where - serialize BuiltinNone = "none" - serialize BuiltinGradient = "gradient" - serialize BuiltinChecker = "checker" - serialize BuiltinFlat = "flat" - -data TextureMark = MarkNone | MarkEdge | MarkCross | MarkRandom -instance Serialize TextureMark where - serialize MarkNone = "none" - serialize MarkEdge = "edge" - serialize MarkCross = "cross" - serialize MarkRandom = "random" +type TextureType = Kw.TwoD \/ Kw.Cube \/ Kw.Skybox +type TextureColorspace = Kw.Auto \/ Kw.Linear \/ Kw.SRGB +type TextureBuiltin = Kw.None \/ Kw.Gradient \/ Kw.Checker \/ Kw.Flat +type TextureMark = Kw.None \/ Kw.Edge \/ Kw.Cross \/ Kw.Random type Props_texture = ( name :: String @@ -113,27 +89,7 @@ type Props_material = ) material = tag @Props_material "material" :: Tag Props_material -data LayerRole - = RoleRgb - | RoleNormal - | RoleOcclusion - | RoleRoughness - | RoleMetallic - | RoleOpacity - | RoleEmissive - | RoleOrm - | RoleRgba - -instance Serialize LayerRole where - serialize RoleRgb = "rgb" - serialize RoleNormal = "normal" - serialize RoleOcclusion = "occlusion" - serialize RoleRoughness = "roughness" - serialize RoleMetallic = "metallic" - serialize RoleOpacity = "opacity" - serialize RoleEmissive = "emissive" - serialize RoleOrm = "orm" - serialize RoleRgba = "rgba" +type LayerRole = Kw.Rgb \/ Kw.Normal \/ Kw.Occlusion \/ Kw.Roughness \/ Kw.Metallic \/ Kw.Opacity \/ Kw.Emissive \/ Kw.Orm \/ Kw.Rgba type Props_layer = ( texture :: String @@ -147,4 +103,3 @@ type Props_model = , content_type :: String ) model = tagNoContent @Props_model "model" :: TagNoContent Props_model - diff --git a/src/Mujoco.MJCF.Body.purs b/src/Mujoco.MJCF.Body.purs index 043526d..529c360 100644 --- a/src/Mujoco.MJCF.Body.purs +++ b/src/Mujoco.MJCF.Body.purs @@ -1,9 +1,9 @@ module Mujoco.MJCF.Body - ( CameraMode(..) - , CameraOutput(..) - , JointType(..) - , LightType(..) - , Projection(..) + ( CameraMode + , CameraOutput + , JointType + , LightType + , Projection , Props_attach , Props_body , Props_camera @@ -13,8 +13,8 @@ module Mujoco.MJCF.Body , Props_joint , Props_light , Props_site - , SiteType(..) - , SleepPolicy(..) + , SiteType + , SleepPolicy , attach , body , camera @@ -32,13 +32,9 @@ module Mujoco.MJCF.Body import Mujoco.Prelude import Mujoco.MJCF.Geom (Props_geom, geom) as X +import Mujoco.MJCF.Keyword as Kw -data SleepPolicy = SleepAuto | SleepNever | SleepAllowed | SleepInit -instance Serialize SleepPolicy where - serialize SleepAuto = "auto" - serialize SleepNever = "never" - serialize SleepAllowed = "allowed" - serialize SleepInit = "init" +type SleepPolicy = Kw.Auto \/ Kw.Never \/ Kw.Allowed \/ Kw.Init type Props_body = ( name :: String @@ -70,12 +66,7 @@ type Props_inertial = ) inertial = tagNoContent @Props_inertial "inertial" :: TagNoContent Props_inertial -data JointType = Free | Ball | Slide | Hinge -instance Serialize JointType where - serialize Free = "free" - serialize Ball = "ball" - serialize Slide = "slide" - serialize Hinge = "hinge" +type JointType = Kw.Free \/ Kw.Ball \/ Kw.Slide \/ Kw.Hinge type Props_joint = ( name :: String @@ -91,9 +82,9 @@ type Props_joint = , solimpfriction :: Vec5 Real , stiffness :: Real , range :: Real /\ Real - , limited :: Auto \/ Boolean + , limited :: Kw.Auto \/ Boolean , actuatorfrcrange :: Real /\ Real - , actuatorfrclimited :: Auto \/ Boolean + , actuatorfrclimited :: Kw.Auto \/ Boolean , actuatorgravcomp :: Boolean , margin :: Real , ref :: Real @@ -108,17 +99,11 @@ joint = tagNoContent @Props_joint "joint" :: TagNoContent Props_joint type Props_freejoint = ( name :: String , group :: Int - , align :: Auto \/ Boolean + , align :: Kw.Auto \/ Boolean ) freejoint = tagNoContent @Props_freejoint "freejoint" :: TagNoContent Props_freejoint -data SiteType = SiteSphere | SiteCapsule | SiteEllipsoid | SiteCylinder | SiteBox -instance Serialize SiteType where - serialize SiteSphere = "sphere" - serialize SiteCapsule = "capsule" - serialize SiteEllipsoid = "ellipsoid" - serialize SiteCylinder = "cylinder" - serialize SiteBox = "box" +type SiteType = Kw.Sphere \/ Kw.Capsule \/ Kw.Ellipsoid \/ Kw.Cylinder \/ Kw.Box type Props_site = ( name :: String @@ -139,26 +124,9 @@ type Props_site = ) site = tagNoContent @Props_site "site" :: TagNoContent Props_site -data CameraMode = CamFixed | CamTrack | CamTrackcom | CamTargetbody | CamTargetbodycom -instance Serialize CameraMode where - serialize CamFixed = "fixed" - serialize CamTrack = "track" - serialize CamTrackcom = "trackcom" - serialize CamTargetbody = "targetbody" - serialize CamTargetbodycom = "targetbodycom" - -data Projection = Perspective | Orthographic -instance Serialize Projection where - serialize Perspective = "perspective" - serialize Orthographic = "orthographic" - -data CameraOutput = OutputRgb | OutputDepth | OutputDistance | OutputNormal | OutputSegmentation -instance Serialize CameraOutput where - serialize OutputRgb = "rgb" - serialize OutputDepth = "depth" - serialize OutputDistance = "distance" - serialize OutputNormal = "normal" - serialize OutputSegmentation = "segmentation" +type CameraMode = Kw.Fixed \/ Kw.Track \/ Kw.Trackcom \/ Kw.Targetbody \/ Kw.Targetbodycom +type Projection = Kw.Perspective \/ Kw.Orthographic +type CameraOutput = Kw.Rgb \/ Kw.Depth \/ Kw.Distance \/ Kw.Normal \/ Kw.Segmentation type Props_camera = ( name :: String @@ -185,12 +153,7 @@ type Props_camera = ) camera = tagNoContent @Props_camera "camera" :: TagNoContent Props_camera -data LightType = LightSpot | LightDirectional | LightPoint | LightImage -instance Serialize LightType where - serialize LightSpot = "spot" - serialize LightDirectional = "directional" - serialize LightPoint = "point" - serialize LightImage = "image" +type LightType = Kw.Spot \/ Kw.Directional \/ Kw.Point \/ Kw.Image type Props_light = ( name :: String diff --git a/src/Mujoco.MJCF.Common.purs b/src/Mujoco.MJCF.Common.purs index d53cc58..1492cd1 100644 --- a/src/Mujoco.MJCF.Common.purs +++ b/src/Mujoco.MJCF.Common.purs @@ -1,7 +1,15 @@ -module Mujoco.MJCF.Common where +module Mujoco.MJCF.Common + ( Named + , Oriented + , Pos + , Real + , Vec + , Vec4 + , Vec5 + ) + where import Data.Tuple.Nested (type (/\)) -import Mujoco.XML.Node.Prop (class Serialize) type Named r = (name :: String | r) type Pos r = (pos :: Vec Real | r) @@ -14,10 +22,6 @@ type Oriented r = | r ) -data Auto = Auto -instance Serialize Auto where - serialize Auto = "auto" - type Real = Number type Vec a = a /\ a /\ a type Vec4 a = a /\ a /\ a /\ a diff --git a/src/Mujoco.MJCF.Geom.purs b/src/Mujoco.MJCF.Geom.purs index 4dac72d..82221c1 100644 --- a/src/Mujoco.MJCF.Geom.purs +++ b/src/Mujoco.MJCF.Geom.purs @@ -1,24 +1,7 @@ module Mujoco.MJCF.Geom where import Mujoco.Prelude -import Prim hiding (Type) - -data FluidShape = FluidNone | FluidEllipsoid -instance Serialize FluidShape where - serialize FluidNone = "none" - serialize FluidEllipsoid = "ellipsoid" - -data Type = Plane | Hfield | Sphere | Capsule | Ellipsoid | Cylinder | Box | Mesh | Sdf -instance Serialize Type where - serialize Plane = "plane" - serialize Hfield = "hfield" - serialize Sphere = "sphere" - serialize Capsule = "capsule" - serialize Ellipsoid = "ellipsoid" - serialize Cylinder = "cylinder" - serialize Box = "box" - serialize Mesh = "mesh" - serialize Sdf = "sdf" +import Mujoco.MJCF.Keyword as Kw type Contact r = ( contype :: Int @@ -43,7 +26,7 @@ type Solver r = type Props_geom = ( class :: String - , type :: Type + , type :: Kw.Plane \/ Kw.Hfield \/ Kw.Sphere \/ Kw.Capsule \/ Kw.Ellipsoid \/ Kw.Cylinder \/ Kw.Box \/ Kw.Mesh \/ Kw.Sdf , group :: Int , size :: Array Real , material :: String @@ -56,7 +39,7 @@ type Props_geom = , hfield :: String , mesh :: String , fitscale :: Real - , fluidshape :: FluidShape + , fluidshape :: Kw.None \/ Kw.Ellipsoid , fluidcoef :: Vec5 Real , user :: Array Real | Named diff --git a/src/Mujoco.MJCF.Keyword.purs b/src/Mujoco.MJCF.Keyword.purs new file mode 100644 index 0000000..0746059 --- /dev/null +++ b/src/Mujoco.MJCF.Keyword.purs @@ -0,0 +1,256 @@ +module Mujoco.MJCF.Keyword where + +import Data.Either.Inject (class Inject, inj) +import Mujoco.XML.Node.Prop (class Serialize) + +kw :: forall kw sum. Inject kw sum => kw -> sum +kw = inj + +true_ :: forall sum. Inject Boolean sum => sum +true_ = inj true + +false_ :: forall sum. Inject Boolean sum => sum +false_ = inj false + +data None = None +instance Serialize None where serialize None = "none" + +data Integrator = Integrator +instance Serialize Integrator where serialize Integrator = "integrator" + +data Filter = Filter +instance Serialize Filter where serialize Filter = "filter" + +data FilterExact = FilterExact +instance Serialize FilterExact where serialize FilterExact = "filterexact" + +data Muscle = Muscle +instance Serialize Muscle where serialize Muscle = "muscle" + +data User = User +instance Serialize User where serialize User = "user" + +data Fixed = Fixed +instance Serialize Fixed where serialize Fixed = "fixed" + +data Affine = Affine +instance Serialize Affine where serialize Affine = "affine" + +data Zoh = Zoh +instance Serialize Zoh where serialize Zoh = "zoh" + +data Linear = Linear +instance Serialize Linear where serialize Linear = "linear" + +data Cubic = Cubic +instance Serialize Cubic where serialize Cubic = "cubic" + +data Convex = Convex +instance Serialize Convex where serialize Convex = "convex" + +data Exact = Exact +instance Serialize Exact where serialize Exact = "exact" + +data Legacy = Legacy +instance Serialize Legacy where serialize Legacy = "legacy" + +data Shell = Shell +instance Serialize Shell where serialize Shell = "shell" + +data TwoD = TwoD +instance Serialize TwoD where serialize TwoD = "2d" + +data Cube = Cube +instance Serialize Cube where serialize Cube = "cube" + +data Skybox = Skybox +instance Serialize Skybox where serialize Skybox = "skybox" + +data SRGB = SRGB +instance Serialize SRGB where serialize SRGB = "sRGB" + +data Gradient = Gradient +instance Serialize Gradient where serialize Gradient = "gradient" + +data Checker = Checker +instance Serialize Checker where serialize Checker = "checker" + +data Flat = Flat +instance Serialize Flat where serialize Flat = "flat" + +data Edge = Edge +instance Serialize Edge where serialize Edge = "edge" + +data Cross = Cross +instance Serialize Cross where serialize Cross = "cross" + +data Random = Random +instance Serialize Random where serialize Random = "random" + +data Rgb = Rgb +instance Serialize Rgb where serialize Rgb = "rgb" + +data Normal = Normal +instance Serialize Normal where serialize Normal = "normal" + +data Occlusion = Occlusion +instance Serialize Occlusion where serialize Occlusion = "occlusion" + +data Roughness = Roughness +instance Serialize Roughness where serialize Roughness = "roughness" + +data Metallic = Metallic +instance Serialize Metallic where serialize Metallic = "metallic" + +data Opacity = Opacity +instance Serialize Opacity where serialize Opacity = "opacity" + +data Emissive = Emissive +instance Serialize Emissive where serialize Emissive = "emissive" + +data Orm = Orm +instance Serialize Orm where serialize Orm = "orm" + +data Rgba = Rgba +instance Serialize Rgba where serialize Rgba = "rgba" + +data Auto = Auto +instance Serialize Auto where serialize Auto = "auto" + +data Never = Never +instance Serialize Never where serialize Never = "never" + +data Allowed = Allowed +instance Serialize Allowed where serialize Allowed = "allowed" + +data Init = Init +instance Serialize Init where serialize Init = "init" + +data Free = Free +instance Serialize Free where serialize Free = "free" + +data Ball = Ball +instance Serialize Ball where serialize Ball = "ball" + +data Slide = Slide +instance Serialize Slide where serialize Slide = "slide" + +data Hinge = Hinge +instance Serialize Hinge where serialize Hinge = "hinge" + +data Sphere = Sphere +instance Serialize Sphere where serialize Sphere = "sphere" + +data Capsule = Capsule +instance Serialize Capsule where serialize Capsule = "capsule" + +data Ellipsoid = Ellipsoid +instance Serialize Ellipsoid where serialize Ellipsoid = "ellipsoid" + +data Cylinder = Cylinder +instance Serialize Cylinder where serialize Cylinder = "cylinder" + +data Box = Box +instance Serialize Box where serialize Box = "box" + +data Track = Track +instance Serialize Track where serialize Track = "track" + +data Trackcom = Trackcom +instance Serialize Trackcom where serialize Trackcom = "trackcom" + +data Targetbody = Targetbody +instance Serialize Targetbody where serialize Targetbody = "targetbody" + +data Targetbodycom = Targetbodycom +instance Serialize Targetbodycom where serialize Targetbodycom = "targetbodycom" + +data Perspective = Perspective +instance Serialize Perspective where serialize Perspective = "perspective" + +data Orthographic = Orthographic +instance Serialize Orthographic where serialize Orthographic = "orthographic" + +data Depth = Depth +instance Serialize Depth where serialize Depth = "depth" + +data Distance = Distance +instance Serialize Distance where serialize Distance = "distance" + +data Segmentation = Segmentation +instance Serialize Segmentation where serialize Segmentation = "segmentation" + +data Spot = Spot +instance Serialize Spot where serialize Spot = "spot" + +data Directional = Directional +instance Serialize Directional where serialize Directional = "directional" + +data Point = Point +instance Serialize Point where serialize Point = "point" + +data Image = Image +instance Serialize Image where serialize Image = "image" + +data Plane = Plane +instance Serialize Plane where serialize Plane = "plane" + +data Hfield = Hfield +instance Serialize Hfield where serialize Hfield = "hfield" + +data Mesh = Mesh +instance Serialize Mesh where serialize Mesh = "mesh" + +data Sdf = Sdf +instance Serialize Sdf where serialize Sdf = "sdf" + +data Euler = Euler +instance Serialize Euler where serialize Euler = "Euler" + +data RK4 = RK4 +instance Serialize RK4 where serialize RK4 = "RK4" + +data Implicit = Implicit +instance Serialize Implicit where serialize Implicit = "implicit" + +data ImplicitFast = ImplicitFast +instance Serialize ImplicitFast where serialize ImplicitFast = "implicitfast" + +data Pyramidal = Pyramidal +instance Serialize Pyramidal where serialize Pyramidal = "pyramidal" + +data Elliptic = Elliptic +instance Serialize Elliptic where serialize Elliptic = "elliptic" + +data Dense = Dense +instance Serialize Dense where serialize Dense = "dense" + +data Sparse = Sparse +instance Serialize Sparse where serialize Sparse = "sparse" + +data PGS = PGS +instance Serialize PGS where serialize PGS = "PGS" + +data CG = CG +instance Serialize CG where serialize CG = "CG" + +data Newton = Newton +instance Serialize Newton where serialize Newton = "Newton" + +data Enable = Enable +instance Serialize Enable where serialize Enable = "enable" + +data Disable = Disable +instance Serialize Disable where serialize Disable = "disable" + +data Local = Local +instance Serialize Local where serialize Local = "local" + +data Global = Global +instance Serialize Global where serialize Global = "global" + +data Radian = Radian +instance Serialize Radian where serialize Radian = "radian" + +data Degree = Degree +instance Serialize Degree where serialize Degree = "degree" diff --git a/src/Mujoco.MJCF.Tendon.purs b/src/Mujoco.MJCF.Tendon.purs index 21f651c..15e641e 100644 --- a/src/Mujoco.MJCF.Tendon.purs +++ b/src/Mujoco.MJCF.Tendon.purs @@ -2,10 +2,12 @@ module Mujoco.MJCF.Tendon where import Mujoco.Prelude +import Mujoco.MJCF.Keyword as Kw + type Common r = ( class :: String , group :: Int - , limited :: Auto \/ Boolean + , limited :: Kw.Auto \/ Boolean , range :: Real /\ Real , solimplimit :: Vec5 Real , solimpfriction :: Vec5 Real @@ -22,7 +24,7 @@ type Common r = type Props_spatial = ( actuatorfrcrange :: Real /\ Real - , actuatorfrclimited :: Auto \/ Boolean + , actuatorfrclimited :: Kw.Auto \/ Boolean , width :: Real , material :: String , rgba :: Vec4 Real diff --git a/src/Mujoco.MJCF.purs b/src/Mujoco.MJCF.purs index 5dd0adb..601878f 100644 --- a/src/Mujoco.MJCF.purs +++ b/src/Mujoco.MJCF.purs @@ -1,11 +1,10 @@ module Mujoco.MJCF - ( Angle(..) - , Cone(..) - , Coordinate(..) - , Enable(..) - , InertiaFromGeom(..) - , Integrator(..) - , Jacobian(..) + ( Angle + , Cone + , Coordinate + , EnableDisable + , InertiaFromGeom + , Jacobian , Props_compiler , Props_flag , Props_option @@ -13,7 +12,7 @@ module Mujoco.MJCF , Props_mujoco , Props_statistic , Props_plugin - , Solver(..) + , Solver , plugin , compiler , flag @@ -27,58 +26,24 @@ module Mujoco.MJCF import Mujoco.Prelude +import Mujoco.MJCF.Keyword as Kw +import Mujoco.MJCF.Keyword as X import Mujoco.MJCF.Asset as X import Mujoco.MJCF.Body as X -import Mujoco.MJCF.Common (Auto(..)) as X +import Mujoco.MJCF.Common as X import Mujoco.MJCF.Contact as X import Mujoco.XML.Node (empty, text, fragment) as X type Props_mujoco = (model :: String) mujoco = tag @Props_mujoco "mujoco" :: Tag Props_mujoco -data Integrator = Euler | RK4 | Implicit | ImplicitFast -instance Serialize Integrator where - serialize Euler = "Euler" - serialize RK4 = "RK4" - serialize Implicit = "implicit" - serialize ImplicitFast = "implicitfast" - -data Cone = Pyramidal | Elliptic -instance Serialize Cone where - serialize Pyramidal = "pyramidal" - serialize Elliptic = "elliptic" - -data Jacobian = Dense | Sparse -instance Serialize Jacobian where - serialize Dense = "dense" - serialize Sparse = "sparse" - -data Solver = PGS | CG | Newton -instance Serialize Solver where - serialize PGS = "PGS" - serialize CG = "CG" - serialize Newton = "Newton" - -data Enable = Disable | Enable -instance Serialize Enable where - serialize Enable = "enable" - serialize Disable = "disable" - -data Coordinate = Local | Global -instance Serialize Coordinate where - serialize Local = "local" - serialize Global = "global" - -data Angle = Radian | Degree -instance Serialize Angle where - serialize Radian = "radian" - serialize Degree = "degree" - -data InertiaFromGeom = InertiaFromGeomFalse | InertiaFromGeomTrue | InertiaFromGeomAuto -instance Serialize InertiaFromGeom where - serialize InertiaFromGeomFalse = "false" - serialize InertiaFromGeomTrue = "true" - serialize InertiaFromGeomAuto = "auto" +type Cone = Kw.Pyramidal \/ Kw.Elliptic +type Jacobian = Kw.Dense \/ Kw.Sparse +type Solver = Kw.PGS \/ Kw.CG \/ Kw.Newton +type EnableDisable = Kw.Enable \/ Kw.Disable +type Coordinate = Kw.Local \/ Kw.Global +type Angle = Kw.Radian \/ Kw.Degree +type InertiaFromGeom = Kw.Auto \/ Boolean type Props_option = ( timestep :: Real @@ -91,7 +56,7 @@ type Props_option = , o_margin :: Real , o_solref :: Real /\ Real , o_solimp :: Vec5 Real - , integrator :: Integrator + , integrator :: Kw.Euler \/ Kw.RK4 \/ Kw.Implicit \/ Kw.ImplicitFast , cone :: Cone , jacobian :: Jacobian , iterations :: Int @@ -110,31 +75,31 @@ type Props_option = option = tag @Props_option "mjcf:option" :: Tag Props_option type Props_flag = - ( constraint :: Enable - , equality :: Enable - , frictionloss :: Enable - , limit :: Enable - , contact :: Enable - , spring :: Enable - , damper :: Enable - , gravity :: Enable - , clampctrl :: Enable - , warmstart :: Enable - , filterparent :: Enable - , actuation :: Enable - , refsafe :: Enable - , sensor :: Enable - , midphase :: Enable - , nativeccd :: Enable - , island :: Enable - , eulerdamp :: Enable - , autoreset :: Enable - , override :: Enable - , energy :: Enable - , fwdinv :: Enable - , invdiscrete :: Enable - , multiccd :: Enable - , sleep :: Enable + ( constraint :: EnableDisable + , equality :: EnableDisable + , frictionloss :: EnableDisable + , limit :: EnableDisable + , contact :: EnableDisable + , spring :: EnableDisable + , damper :: EnableDisable + , gravity :: EnableDisable + , clampctrl :: EnableDisable + , warmstart :: EnableDisable + , filterparent :: EnableDisable + , actuation :: EnableDisable + , refsafe :: EnableDisable + , sensor :: EnableDisable + , midphase :: EnableDisable + , nativeccd :: EnableDisable + , island :: EnableDisable + , eulerdamp :: EnableDisable + , autoreset :: EnableDisable + , override :: EnableDisable + , energy :: EnableDisable + , fwdinv :: EnableDisable + , invdiscrete :: EnableDisable + , multiccd :: EnableDisable + , sleep :: EnableDisable ) flag = tagNoContent @Props_flag "flag" :: TagNoContent Props_flag diff --git a/test/Mujoco.MJCF.purs b/test/Mujoco.MJCF.purs index fcb175a..38d4fa1 100644 --- a/test/Mujoco.MJCF.purs +++ b/test/Mujoco.MJCF.purs @@ -38,17 +38,17 @@ spec = ] it "angle=radian" $ ok $ X.mujoco {} - [ X.compiler { angle: X.Radian } + [ X.compiler { angle: X.kw X.Radian } , X.worldbody {} unit ] it "autolimits + coordinate" $ ok $ X.mujoco {} - [ X.compiler { autolimits: true, coordinate: X.Local } + [ X.compiler { autolimits: true, coordinate: X.kw X.Local } , X.worldbody {} unit ] it "inertiafromgeom=auto" $ ok $ X.mujoco {} - [ X.compiler { inertiafromgeom: X.InertiaFromGeomAuto } + [ X.compiler { inertiafromgeom: X.kw X.Auto } , X.worldbody {} unit ] @@ -75,12 +75,12 @@ spec = describe "option" do it "timestep + integrator" $ ok $ X.mujoco {} - [ X.option { timestep: 0.001, integrator: X.RK4 } unit + [ X.option { timestep: 0.001, integrator: X.kw X.RK4 } unit , X.worldbody {} unit ] it "gravity + solver" $ ok $ X.mujoco {} - [ X.option { gravity: 0.0 /\ 0.0 /\ (-9.81), solver: X.Newton } unit + [ X.option { gravity: 0.0 /\ 0.0 /\ (-9.81), solver: X.kw X.Newton } unit , X.worldbody {} unit ] @@ -110,8 +110,8 @@ spec = [ X.asset {} [ X.texture { name: "grid" - , type: X.Texture2d - , builtin: X.BuiltinChecker + , type: X.kw X.TwoD + , builtin: X.kw X.Checker , width: 512 , height: 512 , rgb1: 0.9 /\ 0.9 /\ 0.9 @@ -132,53 +132,53 @@ spec = describe "joint" do it "hinge" $ ok $ w $ X.body { name: "b1", pos: 0.0 /\ 0.0 /\ 0.5 } - [ X.joint { type: X.Hinge, axis: 1.0 /\ 0.0 /\ 0.0 } - , X.geom { type: X.G.Sphere, size: [0.1, 0.0, 0.0] } unit + [ X.joint { type: X.kw X.Hinge, axis: 1.0 /\ 0.0 /\ 0.0 } + , X.geom { type: X.kw X.Sphere, size: [0.1, 0.0, 0.0] } unit ] it "slide with range" $ ok $ w $ X.body { name: "slider", pos: 0.0 /\ 0.0 /\ 1.0 } - [ X.joint { type: X.Slide, axis: 0.0 /\ 0.0 /\ 1.0, range: (-1.0) /\ 1.0, limited: X.AutoBoolTrue } - , X.geom { type: X.G.Box, size: [0.1, 0.1, 0.1] } unit + [ X.joint { type: X.kw X.Slide, axis: 0.0 /\ 0.0 /\ 1.0, range: (-1.0) /\ 1.0, limited: X.true_ } + , X.geom { type: X.kw X.Box, size: [0.1, 0.1, 0.1] } unit ] it "stiffness + damping" $ ok $ w $ X.body { pos: 0.0 /\ 0.0 /\ 0.0 } - [ X.joint { type: X.Hinge, stiffness: 100.0, damping: 10.0, armature: 0.1 } - , X.geom { type: X.G.Sphere, size: [0.05, 0.0, 0.0] } unit + [ X.joint { type: X.kw X.Hinge, stiffness: 100.0, damping: 10.0, armature: 0.1 } + , X.geom { type: X.kw X.Sphere, size: [0.05, 0.0, 0.0] } unit ] describe "freejoint" do it "basic" $ ok $ w $ X.body { name: "free_body", pos: 0.0 /\ 0.0 /\ 1.0 } [ X.freejoint { name: "fj" } - , X.geom { type: X.G.Sphere, size: [0.1, 0.0, 0.0] } unit + , X.geom { type: X.kw X.Sphere, size: [0.1, 0.0, 0.0] } unit ] describe "geom" do it "sphere" $ ok $ w $ - X.geom { type: X.G.Sphere, size: [1.0, 0.0, 0.0] } unit + X.geom { type: X.kw X.Sphere, size: [1.0, 0.0, 0.0] } unit it "capsule fromto" $ ok $ w $ - X.geom { type: X.G.Capsule, fromto: [0.0, 0.0, 0.0, 0.0, 0.0, 1.0], size: [0.05, 0.0, 0.0] } unit + X.geom { type: X.kw X.Capsule, fromto: [0.0, 0.0, 0.0, 0.0, 0.0, 1.0], size: [0.05, 0.0, 0.0] } unit it "box with material" $ ok $ X.mujoco {} [ X.asset {} [ X.material { name: "red", rgba: 1.0 /\ 0.0 /\ 0.0 /\ 1.0 } unit ] , X.worldbody {} $ - X.geom { type: X.G.Box, size: [0.5, 0.5, 0.5], material: "red" } unit + X.geom { type: X.kw X.Box, size: [0.5, 0.5, 0.5], material: "red" } unit ] it "plane" $ ok $ w $ - X.geom { type: X.G.Plane, size: [5.0, 5.0, 0.1] } unit + X.geom { type: X.kw X.Plane, size: [5.0, 5.0, 0.1] } unit it "friction + density" $ ok $ w $ - X.geom { type: X.G.Sphere, size: [0.1, 0.0, 0.0], friction: 0.5 /\ 0.005 /\ 0.0001, density: 500.0 } unit + X.geom { type: X.kw X.Sphere, size: [0.1, 0.0, 0.0], friction: 0.5 /\ 0.005 /\ 0.0001, density: 500.0 } unit describe "site" do it "basic" $ ok $ w $ X.body { pos: 0.0 /\ 0.0 /\ 0.0 } - [ X.geom { type: X.G.Sphere, size: [0.1, 0.0, 0.0] } unit + [ X.geom { type: X.kw X.Sphere, size: [0.1, 0.0, 0.0] } unit , X.site { name: "s1", pos: 0.0 /\ 0.0 /\ 0.1, size: 0.01 /\ 0.01 /\ 0.01 } ] @@ -188,8 +188,8 @@ spec = it "tracking" $ ok $ w $ X.body { name: "target_body", pos: 0.0 /\ 0.0 /\ 0.5 } - [ X.geom { type: X.G.Sphere, size: [0.1, 0.0, 0.0] } unit - , X.camera { name: "tracker", mode: X.CamTargetbody, target: "target_body", pos: 1.0 /\ 0.0 /\ 0.5 } + [ X.geom { type: X.kw X.Sphere, size: [0.1, 0.0, 0.0] } unit + , X.camera { name: "tracker", mode: X.kw X.Targetbody, target: "target_body", pos: 1.0 /\ 0.0 /\ 0.5 } ] describe "light" do @@ -197,32 +197,32 @@ spec = X.light { name: "spot1", pos: 0.0 /\ 0.0 /\ 3.0, dir: 0.0 /\ 0.0 /\ (-1.0), diffuse: 1.0 /\ 1.0 /\ 1.0 } it "directional" $ ok $ w $ - X.light { name: "sun", type: X.LightDirectional, dir: 0.0 /\ (-1.0) /\ (-1.0), castshadow: true } + X.light { name: "sun", type: X.kw X.Directional, dir: 0.0 /\ (-1.0) /\ (-1.0), castshadow: true } describe "inertial" do it "explicit mass + diaginertia" $ ok $ w $ X.body { pos: 0.0 /\ 0.0 /\ 0.0 } [ X.inertial { pos: 0.0 /\ 0.0 /\ 0.0, mass: 1.0, diaginertia: 0.01 /\ 0.01 /\ 0.01 } - , X.geom { type: X.G.Sphere, size: [0.1, 0.0, 0.0] } unit + , X.geom { type: X.kw X.Sphere, size: [0.1, 0.0, 0.0] } unit ] describe "composite" do it "full model" $ ok $ X.mujoco { model: "test" } - [ X.compiler { angle: X.Radian, inertiafromgeom: X.InertiaFromGeomTrue } + [ X.compiler { angle: X.kw X.Radian, inertiafromgeom: X.true_ } , X.option { timestep: 0.002, gravity: 0.0 /\ 0.0 /\ (-9.81) } - [ X.flag { contact: X.Enable } ] + [ X.flag { contact: X.kw X.Enable } ] , X.asset {} - [ X.texture { name: "grid", type: X.Texture2d, builtin: X.BuiltinChecker, width: 256, height: 256, rgb1: 0.9 /\ 0.9 /\ 0.9, rgb2: 0.1 /\ 0.1 /\ 0.1 } + [ X.texture { name: "grid", type: X.kw X.TwoD, builtin: X.kw X.Checker, width: 256, height: 256, rgb1: 0.9 /\ 0.9 /\ 0.9, rgb2: 0.1 /\ 0.1 /\ 0.1 } , X.material { name: "floor_mat", texture: "grid", texrepeat: 5.0 /\ 5.0 } unit ] , X.worldbody {} - [ X.geom { type: X.G.Plane, size: [5.0, 5.0, 0.1], material: "floor_mat" } unit + [ X.geom { type: X.kw X.Plane, size: [5.0, 5.0, 0.1], material: "floor_mat" } unit , X.light { name: "top", pos: 0.0 /\ 0.0 /\ 3.0, dir: 0.0 /\ 0.0 /\ (-1.0) } , X.body { name: "ball", pos: 0.0 /\ 0.0 /\ 1.0 } [ X.freejoint {} - , X.geom { type: X.G.Sphere, size: [0.1, 0.0, 0.0], rgba: 1.0 /\ 0.0 /\ 0.0 /\ 1.0 } unit + , X.geom { type: X.kw X.Sphere, size: [0.1, 0.0, 0.0], rgba: 1.0 /\ 0.0 /\ 0.0 /\ 1.0 } unit ] ] ] @@ -232,19 +232,19 @@ spec = , X.body {} [ X.joint { name: "v0_rx", damping: 1.0, stiffness: 10.0, axis: 1.0 /\ 0.0 /\ 0.0, pos: 0.0 /\ 0.0 /\ (-0.5) } , X.joint { name: "v0_ry", damping: 1.0, stiffness: 10.0, axis: 0.0 /\ 1.0 /\ 0.0, pos: 0.0 /\ 0.0 /\ (-0.5) } - , X.geom { type: X.G.Cylinder, size: [1.0, 0.05] } unit + , X.geom { type: X.kw X.Cylinder, size: [1.0, 0.05] } unit , X.body { pos: zero /\ zero /\ 0.51 } [ X.joint { name: "b0a_rx", damping: 1.0, stiffness: 10.0, axis: 1.0 /\ 0.0 /\ 0.0, pos: 0.0 /\ 0.0 /\ (-0.5) } , X.joint { name: "b0a_ry", damping: 1.0, stiffness: 10.0, axis: 0.0 /\ 1.0 /\ 0.0, pos: 0.0 /\ 0.0 /\ (-0.5) } - , X.geom { type: X.G.Cylinder, size: [0.05, 0.5] } unit + , X.geom { type: X.kw X.Cylinder, size: [0.05, 0.5] } unit , X.body { pos: zero /\ zero /\ one } [ X.joint { name: "b0b_rx", damping: 1.0, stiffness: 10.0, axis: 1.0 /\ 0.0 /\ 0.0, pos: 0.0 /\ 0.0 /\ (-0.5) } , X.joint { name: "b0b_ry", damping: 1.0, stiffness: 10.0, axis: 0.0 /\ 1.0 /\ 0.0, pos: 0.0 /\ 0.0 /\ (-0.5) } - , X.geom { type: X.G.Cylinder, size: [0.05, 0.5] } unit + , X.geom { type: X.kw X.Cylinder, size: [0.05, 0.5] } unit , X.body { pos: zero /\ zero /\ 0.5 } [ X.joint { name: "v1_rx", damping: 1.0, stiffness: 10.0, axis: 1.0 /\ 0.0 /\ 0.0, pos: 0.0 /\ 0.0 /\ (-0.5) } , X.joint { name: "v1_ry", damping: 1.0, stiffness: 10.0, axis: 0.0 /\ 1.0 /\ 0.0, pos: 0.0 /\ 0.0 /\ (-0.5) } - , X.geom { type: X.G.Cylinder, size: [1.0, 0.05] } unit + , X.geom { type: X.kw X.Cylinder, size: [1.0, 0.05] } unit ] ] ]