Tablet.hs

{-# OPTIONS_GHC -Wall #-}
----------------------------------------------------------------------
-- |
-- Module      :  Tablet
-- Copyright   :  (c) Conal Elliott and Andy J Gill 2008
-- License     :  BSD3
-- 
-- Maintainer  :  conal@conal.net, andygill@ku.edu
-- Stability   :  experimental
-- 
-- Tablet shape with rounded corners
----------------------------------------------------------------------

module Tablet where

import Data.Monoid

import Graphics.FieldTrip.Misc
import Graphics.FieldTrip.Vector3
import Graphics.FieldTrip.Transform
import Graphics.FieldTrip.Transform2
import Graphics.FieldTrip.Geometry2
import Graphics.FieldTrip.Geometry3

--import Graphics.FieldTrip.QParamSurf as Q

-- 2D rectangle with rounded corners, having given width, height, and
-- rounding radius.
roundedRect :: R -> R -> R -> Geometry2
roundedRect width height radius = right `sandwich2` center
  -- Build out of left, center, right.
  -- The sides sandwich the center to make the whole; and
  -- the quarter-disks sandwich the edge strip to make the right side.
 where
   -- Trimmed dimensions
   width'  = width-2*radius
   height' = height-2*radius
   center = box2 width' height
   -- Quarter-disk at origin, angle ranges from 0 to pi/2 (3pm to noon)
   qdisk = uscale2 radius *% diskWedge (1/4)
   ne = move2Y (height'/2) qdisk
   se = move2Y (-height'/2) (rotate2 (-pi/2::Float) *% qdisk)
   right = move2X (width'/2) $
           ne `mappend` move2X (radius/2) (box2 radius height') `mappend` se

-- Sandwich @inside@ between @outside@ and a flipped version of @outside@
sandwich2 :: Geometry2 -> Filter2
outside `sandwich2` inside = andFlip2 outside `mappend` inside



-- 3D tablet shape, with flat top & bottom, using roundedRect.
-- Cylinders for the four corners.

tablet1 :: R -> R -> R -> R -> Geometry3
tablet1 width height depth radius = top `sandwichY` edging
 where
   width'  = width-2*radius
   height' = height-2*radius
   top = move3Z (depth/2) $ flatG (roundedRect width height radius)
   edging  = andFlip3 (zVector3::Vector3 Float) ell
   ell = capped height' (width'/2) `mappend`
         pivot3Z (capped width' (height'/2))
   capped len dx = ( move3X (dx+radius) $
                     pivot3Y $
                     flatG (box2 depth len) )
                   `mappend`
                   ( move3 dx (len/2) 0 $
                     cylinder radius depth )

-- Or with more rounding.
-- 3D tablet with half-cylinders for sides and quarter-sphere corners,
-- having given width, height, and depth.  Rounding radius is depth/2.
tablet2 :: R -> R -> R -> Geometry3
tablet2 width height depth = ell `sandwichZ` center
  -- Build out of two ell shapes sandwiching a center box.  Each ell has
  -- two cylinders and two spheres.  I can't yet make partial spheres or
  -- cylinders, so I'll make full ones, which will be partly hidden (half
  -- of each cylinder and 3/4 of each sphere).  Later, make the partial
  -- versions, to reduce computing and rendering.
 where
   radius   = depth/2
   width'   = width-2*radius
   height'  = height-2*radius
   center   = box3 width' height' depth
   right    = move3X (width'/2) $
              move3Y (height'/2) (sphere radius) `sandwichX` rightCyl
   ell      = move3Y (height'/2) topCyl `mappend` right
   rightCyl = cyl xVector3 height'
   topCyl   = cyl yVector3 width'
   cyl :: Vector3 Float -> R -> Geometry3
   cyl axis len = pivot3 axis $ cylinder radius len


---- utilities

-- Sandwich @inside@ between @outside@ and a flipped version of @outside@
sandwich3 :: Vector3 Float -> Geometry3 -> Filter3
sandwich3 axis outside inside = andFlip3 axis outside `mappend` inside

-- Specializations
sandwichX, sandwichY, sandwichZ :: Geometry3 -> Filter3
sandwichX = sandwich3 xVector3
sandwichY = sandwich3 yVector3
sandwichZ = sandwich3 zVector3