Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 124 lines (106 sloc) 7.205 kb
cd8b3fc @clanehin Add some missing files and minor fixes.
authored
1 {-# LANGUAGE TypeFamilies, EmptyDataDecls, ScopedTypeVariables, PatternGuards, FlexibleContexts #-}
2
eb4b7b8 @clanehin Package move to Roguestar.Lib.
authored
3 module Roguestar.Lib.DetailedLocation
cd8b3fc @clanehin Add some missing files and minor fixes.
authored
4 (DetailedLocation,
5 PlaneLocation,
6 BuildingLocation,
7 ToolLocation,
8 CarriedLocation,
9 PlanarLocation,
10 filterLocations,
11 mapLocations,
12 asChildren,
13 identityDetail,
14 detail,
15 Planar(..),
16 LocationAssignmentTable)
17 where
18
eb4b7b8 @clanehin Package move to Roguestar.Lib.
authored
19 import Roguestar.Lib.DBData
20 import Roguestar.Lib.PlaneData
21 import Roguestar.Lib.BuildingData
22 import Roguestar.Lib.ToolData
23 import Roguestar.Lib.CreatureData
24 import Roguestar.Lib.Position
cd8b3fc @clanehin Add some missing files and minor fixes.
authored
25 import Data.Maybe
26 import Control.Monad
eb4b7b8 @clanehin Package move to Roguestar.Lib.
authored
27 import Roguestar.Lib.Reference
28 import Roguestar.Lib.Facing
cd8b3fc @clanehin Add some missing files and minor fixes.
authored
29
30 type PlaneLocation = DetailedLocation (Child Plane)
31 type BuildingLocation = DetailedLocation (Child Building)
32 type CreatureLocation = DetailedLocation (Child Creature)
33 type ToolLocation = DetailedLocation (Child Tool)
34 type CarriedLocation = DetailedLocation (Parent Creature)
35 type PlanarLocation = DetailedLocation Planar
36
37 data DetailedLocation a = DetailedLocation { dl_location :: Location }
38
39 instance LocationSource (DetailedLocation a) where
40 toLocation = dl_location
41
42 instance (LocationDetail a) => LocationDetail (DetailedLocation a) where
43 fromLocation source =
44 do (_ :: a) <- fromLocation source
45 return $ DetailedLocation source
46
47 filterLocations :: (LocationSource l, LocationDetail a) => (a -> Bool) -> [l] -> [DetailedLocation a]
48 filterLocations f = map DetailedLocation . filter (maybe False f . fromLocation) . map toLocation
49
50 mapLocations :: (LocationSource l, LocationDetail a) => [l] -> [a]
51 mapLocations = mapMaybe (fromLocation . toLocation)
52
53 identityDetail :: (LocationDetail a) => DetailedLocation a -> a
54 identityDetail = fromMaybe (error "identityDetail: impossible case: fromLocation call failed") . fromLocation . dl_location
55
56 detail :: (LocationDetail to,LocationAssignmentTable from to ~ Supported) => DetailedLocation from -> to
57 detail = fromMaybe (error "detail: impossible case: fromLocation call failed") . fromLocation . dl_location
58
59 asChildren :: (LocationSource l,LocationDetail (Child a)) => [l] -> [Reference a]
60 asChildren = map asChild . mapLocations
61
62 -- | A location with a parent plane and a multiposition.
63 -- That is, any physical object resting, walking, or constructed on a plane.
64 -- But not a Beneath or Subsequent plane.
65 data Planar = Planar {
66 planar_parent :: PlaneRef,
67 planar_position :: Position,
68 planar_multiposition :: MultiPosition }
69
70 instance LocationDetail Planar where
71 fromLocation l = liftM3 Planar (liftM (\(Parent x) -> x) $ fromLocation l) (fromLocation l) (fromLocation l)
72
73 instance LocationConstructor Planar where
74 type ReferenceTypeOf Planar = ()
75 constructLocation ref planar | Just creature_ref <- coerceReference ref =
76 constructLocation creature_ref $ Standing (planar_parent planar) (planar_position planar) Here
77 constructLocation ref planar | Just tool_ref <- coerceReference ref =
78 constructLocation tool_ref $ Dropped (planar_parent planar) (planar_position planar)
79 constructLocation ref planar | Just plane_ref <- coerceReference ref =
80 constructLocation plane_ref $ Beneath (planar_parent planar)
81 constructLocation ref planar | Just building_ref <- coerceReference ref =
82 constructLocation building_ref $ Constructed (planar_parent planar)
83 (planar_position planar)
84 (error "LocationConstructor Planar: constructLocation: indeterminate")
85
86 -- | Meaning that an assignment from one location type to another is guaranteed to succeed.
87 data Supported
88
89 -- | This is not remotely a complete table, but will need to be added to on an as-needed basis.
90 type family LocationAssignmentTable from to :: *
91 type instance LocationAssignmentTable a (DetailedLocation b) = LocationAssignmentTable a b
92 type instance LocationAssignmentTable a (Child ()) = Supported
93 type instance LocationAssignmentTable a (Parent ()) = Supported
94 type instance LocationAssignmentTable Planar (Parent Plane) = Supported
95 type instance LocationAssignmentTable Planar MultiPosition = Supported
96 type instance LocationAssignmentTable Planar Position = Supported
97 type instance LocationAssignmentTable Planar (Parent Plane, MultiPosition) = Supported
98 type instance LocationAssignmentTable Planar (Parent Plane, Position) = Supported
99 type instance LocationAssignmentTable (Child a) (Child a) = Supported
2a60c36 @clanehin Hopefully fixes crash issue when the DB monad itself experiences a call ...
authored
100 type instance LocationAssignmentTable (Child Creature) Standing = Supported
cd8b3fc @clanehin Add some missing files and minor fixes.
authored
101 type instance LocationAssignmentTable (Child Creature) (Parent Plane) = Supported
102 type instance LocationAssignmentTable (Child Creature) Position = Supported
103 type instance LocationAssignmentTable (Child Creature) MultiPosition = Supported
104 type instance LocationAssignmentTable (Child Creature) Planar = Supported
105 type instance LocationAssignmentTable (Child Creature) Facing = Supported
106 type instance LocationAssignmentTable (Child Creature) (Facing,Position) = Supported
107 type instance LocationAssignmentTable (Child Creature) (Position,Facing) = Supported
108 type instance LocationAssignmentTable (Child Building) (Parent Plane) = Supported
109 type instance LocationAssignmentTable (Child Building) Position = Supported
110 type instance LocationAssignmentTable (Child Building) MultiPosition = Supported
e0a63d5 @clanehin Maps and movement.
authored
111 type instance LocationAssignmentTable (Child Building) BuildingShape = Supported
cd8b3fc @clanehin Add some missing files and minor fixes.
authored
112 type instance LocationAssignmentTable Beneath (Child Plane) = Supported
113 type instance LocationAssignmentTable Subsequent (Child Plane) = Supported
114 type instance LocationAssignmentTable Standing Planar = Supported
115 type instance LocationAssignmentTable Standing (Child Creature) = Supported
116 type instance LocationAssignmentTable Standing (Parent Plane) = Supported
117 type instance LocationAssignmentTable Standing Position = Supported
118 type instance LocationAssignmentTable Standing MultiPosition = Supported
119 type instance LocationAssignmentTable Standing Facing = Supported
120 type instance LocationAssignmentTable Wielded (Child Tool) = Supported
121 type instance LocationAssignmentTable Dropped (Child Tool) = Supported
122 type instance LocationAssignmentTable Inventory (Child Tool) = Supported
123
Something went wrong with that request. Please try again.