X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FCardinal.hs;h=3bff38f206c5983cb29ac9f80ef99275f6a88e4c;hb=ecb77f944fcba8c8cfe60ca782bc5d9c8ab68cf9;hp=c6f7e8f72a9bc112f81d052339971f4b027eaf01;hpb=c88ec8e43960514d27a6368d864a68e07eb18e50;p=spline3.git diff --git a/src/Cardinal.hs b/src/Cardinal.hs index c6f7e8f..3bff38f 100644 --- a/src/Cardinal.hs +++ b/src/Cardinal.hs @@ -1,56 +1,115 @@ +-- | The Cardinal module contains the Cardinal data type, representing +-- a cardinal direction (one of the 26 directions surrounding the +-- center of a cube. In addition to those 26 directions, we also +-- include the interior point and a number of composite types that +-- allow us to perform arithmetic on directions. module Cardinal where +import Control.Monad (liftM, liftM2) import Prelude hiding (LT) +import Test.QuickCheck (Arbitrary(..), oneof) -data Cardinal = F - | B - | L - | R - | D - | T - | FL - | FR - | FD - | FT - | BL - | BR - | BD - | BT - | LD - | LT - | RD - | RT - | FLD - | FLT - | FRD - | FRT - | BLD - | BLT - | BRD - | BRT - | I - | Scalar Double - | Sum Cardinal Cardinal +data Cardinal = F -- ^ Front + | B -- ^ Back + | L -- ^ Left + | R -- ^ Right + | D -- ^ Down + | T -- ^ Top + | FL -- ^ Front Left + | FR -- ^ Front Right + | FD -- ^ Front Down + | FT -- ^ Front Top + | BL -- ^ Back Left + | BR -- ^ Back Right + | BD -- ^ Back Down + | BT -- ^ Back Top + | LD -- ^ Left Down + | LT -- ^ Left Top + | RD -- ^ Right Down + | RT -- ^ Right Top + | FLD -- ^ Front Left Down + | FLT -- ^ Front Left Top + | FRD -- ^ Front Right Down + | FRT -- ^ Front Right Top + | BLD -- ^ Back Left Down + | BLT -- ^ Back Left Top + | BRD -- ^ Back Right Down + | BRT -- ^ Back Right Top + | I -- ^ Interior + | Scalar Double -- ^ A wrapper around a scalar value. + | Sum Cardinal Cardinal -- ^ The sum of two directions. | Difference Cardinal Cardinal - | Product Cardinal Cardinal + -- ^ The difference of two directions, the first minus the second. + | Product Cardinal Cardinal -- ^ The product of two directions. | Quotient Cardinal Cardinal + -- ^ The quotient of two directions, the first divided by the + -- second. deriving (Show, Eq) + +-- | By making Cardinal an instance of 'Num', we gain the ability to +-- add, subtract, and multiply directions. The results of these +-- operations are never actually calculated; the types just keep +-- track of which operations were performed in which order. instance Num Cardinal where x + y = Sum x y x - y = Difference x y x * y = Product x y - negate x = Product (Scalar (-1)) x + negate = Product (Scalar (-1)) abs x = x signum x = x fromInteger x = Scalar (fromIntegral x) + +-- | Like the Num instance, the 'Fractional' instance allows us to +-- take quotients of directions. instance Fractional Cardinal where x / y = Quotient x y - recip x = Quotient (Scalar 1) x + recip = Quotient (Scalar 1) fromRational x = Scalar (fromRational x) + + +instance Arbitrary Cardinal where + arbitrary = oneof [f,b,l,r,d,t,fl,fr,fd,ft,bl,br,bd,bt,ld,lt, + rd,rt,fld,flt,frd,frt,bld,blt,brd,brt,i, + scalar,csum,cdiff,cprod,cquot] + where + f = return F + b = return B + l = return L + r = return R + d = return D + t = return T + fl = return FL + fr = return FR + fd = return FD + ft = return FT + bl = return BL + br = return BR + bd = return BD + bt = return BT + ld = return LD + lt = return LT + rd = return RD + rt = return RT + fld = return FLD + flt = return FLT + frd = return FRD + frt = return FRT + bld = return BLD + blt = return BLT + brd = return BRD + brt = return BRT + i = return I + scalar = liftM Scalar arbitrary + csum = liftM2 Sum arbitrary arbitrary + cdiff = liftM2 Difference arbitrary arbitrary + cprod = liftM2 Product arbitrary arbitrary + cquot = liftM2 Quotient arbitrary arbitrary + + -- | Rotate a cardinal direction counter-clockwise about the x-axis. ccwx :: Cardinal -> Cardinal ccwx F = F @@ -89,3 +148,83 @@ ccwx (Quotient c0 c1) = Quotient (ccwx c0) (ccwx c1) -- | Rotate a cardinal direction clockwise about the x-axis. cwx :: Cardinal -> Cardinal cwx = ccwx . ccwx . ccwx + + +-- | Rotate a cardinal direction counter-clockwise about the y-axis. +ccwy :: Cardinal -> Cardinal +ccwy F = D +ccwy B = T +ccwy L = L +ccwy R = R +ccwy D = B +ccwy T = F +ccwy FL = LD +ccwy FR = RD +ccwy FD = BD +ccwy FT = FD +ccwy BL = LT +ccwy BR = RT +ccwy BD = BT +ccwy BT = FT +ccwy LD = BL +ccwy LT = FL +ccwy RD = BR +ccwy RT = FR +ccwy FLD = BLD +ccwy FLT = FLD +ccwy FRD = BRD +ccwy FRT = FRD +ccwy BLD = BLT +ccwy BLT = FLT +ccwy BRD = BRT +ccwy BRT = FRT +ccwy I = I +ccwy (Scalar s) = (Scalar s) +ccwy (Sum c0 c1) = Sum (ccwy c0) (ccwy c1) +ccwy (Difference c0 c1) = Difference (ccwy c0) (ccwy c1) +ccwy (Product c0 c1) = Product (ccwy c0) (ccwy c1) +ccwy (Quotient c0 c1) = Quotient (ccwy c0) (ccwy c1) + +-- | Rotate a cardinal direction clockwise about the y-axis. +cwy :: Cardinal -> Cardinal +cwy = ccwy . ccwy . ccwy + + +-- | Rotate a cardinal direction counter-clockwise about the z-axis. +ccwz :: Cardinal -> Cardinal +ccwz F = R +ccwz B = L +ccwz L = F +ccwz R = B +ccwz D = D +ccwz T = T +ccwz FL = FR +ccwz FR = BR +ccwz FD = RD +ccwz FT = RT +ccwz BL = FL +ccwz BR = BL +ccwz BD = LD +ccwz BT = LT +ccwz LD = FD +ccwz LT = FT +ccwz RD = BD +ccwz RT = BT +ccwz FLD = FRD +ccwz FLT = FRT +ccwz FRD = BRD +ccwz FRT = BRT +ccwz BLD = FLD +ccwz BLT = FLT +ccwz BRD = BLD +ccwz BRT = BLT +ccwz I = I +ccwz (Scalar s) = (Scalar s) +ccwz (Sum c0 c1) = Sum (ccwz c0) (ccwz c1) +ccwz (Difference c0 c1) = Difference (ccwz c0) (ccwz c1) +ccwz (Product c0 c1) = Product (ccwz c0) (ccwz c1) +ccwz (Quotient c0 c1) = Quotient (ccwz c0) (ccwz c1) + +-- | Rotate a cardinal direction clockwise about the z-axis. +cwz :: Cardinal -> Cardinal +cwz = ccwz . ccwz . ccwz