Aelve Codesearch

grep over package repositories
Please provide a string to search for.
3+ characters are required.
Index updated 4 hours ago

total matches: more than 1000

3dmodels-0.3.0
9 matches
Graphics/Model/DirectX.hs
reverseHand :: XOF -> XOF
reverseHand xof@XOF{_xofMesh=DxMesh{..}, ..} =
	xof { _xofMesh = (_xofMesh xof) {
		_dxVertices = fmap rhVtx _dxVertices,
		_dxFaces = fmap rhFace _dxFaces,
		_dxNormals = fmap rhVtx _dxNormals,
		_dxNormalIndexes = fmap rhFace _dxNormalIndexes
	}}
	where rhVtx (V3 x y z) = V3 x y (-z)
	      rhFace (Right (V3 a b c)) = Right $ V3 b a c
	      rhFace (Left (V4 a b c d)) = Left $ V4 a d c b


            
Graphics/Model/DirectX.hs
		<$> option [] meshTextureCoords <* skipSpace
		<*> option [] meshVertexColors <* skipSpace

meshFace = fmap Left meshFace4 <|> fmap Right meshFace3
meshFace4 = do
	char '4' >> semicolon
	sequenceA $ V4 (decimal <* comma) (decimal <* comma)
		(decimal <* comma) (decimal <* char ';')
meshFace3 = do

            
Graphics/Model/DirectX.hs
meshVertexColors = section "MeshVertexColors" $
	getIntField >>= getArray indexedColor

indexedColor = (,) <$> fmap fromIntegral getIntField <*> getVector


            
Graphics/Model/MikuMikuDance/Loader.hs
ltrTrans (V3 x y z) = V3 x y (-z)
ltrEular (V3 x y z) = V3 (-x) (-y) z
ltrQuat (V4 t i j k) = V4 (-t) i j k
getPos = fmap ltrTrans getV3
getEular = fmap ltrEular getV3
getQuat = fmap ltrQuat getV4


-- * PMX

loadMMD :: FilePath -> IO MMD 

            
Graphics/Model/MikuMikuDance/Loader.hs
		-- 0:Base, 1:Brow, 2: Eye, 3: Lip, 4:Other
		-- XXX 'base' should be ignored (0,0,0)???
		vMorph <- replicateM numVertices $
			VertexMorph <$> fmap fromIntegral getWord32LE <*> getPos
		return $ MMDMorph name "" facial vMorph
		
	faceListLen <- getWord8Int
	faceList <- replicateM faceListLen getMorphIndex


            
Graphics/Model/MikuMikuDance/Loader.hs
	let root = "R\NULo\NULo\NULt\NUL"
	let rootGroup = MMDGroup root root True [Left 0]
	let faceGroup = MMDGroup "h\136\197`" "E\NULx\NULp\NUL" True
			(map Right faceList)
	let groups = rootGroup : faceGroup :
		zipWith3 (\i j e ->
			MMDGroup j e False $
				map (Left . fst) $
					filter ((== i).snd) groupedBones
		) [1..] boneGroups bGsEn
		-- group 0 ('center') is reserved for the root bone
	
	-- toon texture list since MMD 4.03

            
Graphics/Model/MikuMikuDance/Types.hs
	, mSpecular :: V3 Float -- ^ RGB
	, mSpecularFactor :: Float
	, mAmbient :: V3 Float -- ^ RGB
	-- | 1:cullface=both, 2:drop shadow, 4:render to self shadow map,
	-- 8:render to self shadow, 16:draw edges,
	-- /Since 2.1/ => 32:vertex color, 64:As Points, 128:As Lines
	, mOptions :: Word8
	, mEdgeColor :: V4 Float -- ^ RGBA
	-- | /Since 2.1/ Point size (See mOptions)

            
Graphics/Model/Obj.hs
	normals <- many (parseVn <* comments)
	mtl2 <- optional parseUsemtl <* comments
	faces <- many (parseF <* comments)
	let mtl = fmap (path,) (maybe mtl2 Just mtl1)
	return $ ObjMesh group mtl vertices uvs normals faces

getString, parseMtllib, parseG, parseUsemtl :: Parser String
getString = many1 (satisfy (/= '\n'))
parseMtllib = string "mtllib " >> getString

            
Graphics/Model/Obj.hs
	diff <- string "Kd" >> float3 <* comments
	spec <- string "Ks" >> float3 <* comments
	shine <- string "Ns " >> float
	-- XXX map_Kd
	return $ ObjMaterial mtl amb diff spec shine


            
AC-PPM-1.1.1
4 matches
Codec/PPM/Binary.hs
-}
stringPPM :: (Integer,Integer) -> [(Word8,Word8,Word8)] -> BIN.ByteString
stringPPM (sx,sy) ps =
  BIN.pack (map (fromIntegral . fromEnum) $ "P6\n" ++ show sx ++ " " ++ show sy ++ "\n255\n") `BIN.append`
  BIN.concat (map (\(r,g,b) -> BIN.pack [r,g,b]) ps)

{-|
  Convenience function: Generate PPM data and write it to the
  specified 'Handle'. The handle is not closed or flushed afterwards.
  This allows writing PPM data to network streams, etc. This function

            
Codec/PPM/Binary.hs
  other PPM functions.
-}
fn_list :: ((Integer,Integer) -> (Word8,Word8,Word8)) -> (Integer, Integer) -> [(Word8,Word8,Word8)]
fn_list fn (sx, sy) = map fn [ (x,y) | y <- [0..sy-1], x <- [0..sx-1] ]

            
Codec/PPM/Text.hs
stringPPM :: (Integer,Integer) -> [(Word8,Word8,Word8)] -> TXT.ByteString
stringPPM (sx,sy) ps =
  TXT.pack ("P3\n" ++ show sx ++ " " ++ show sy ++ "\n255\n") `TXT.append`
  TXT.unlines (map (\(r,g,b) -> TXT.pack $ unwords [show r, show g,show b]) ps)

{-|
  Convenience function: Generate PPM data and write it to the
  specified 'Handle'. The handle is not closed or flushed afterwards.
  This allows writing PPM data to network streams, etc. This function

            
Codec/PPM/Text.hs
  other PPM functions.
-}
fn_list :: ((Integer,Integer) -> (Word8,Word8,Word8)) -> (Integer, Integer) -> [(Word8,Word8,Word8)]
fn_list fn (sx, sy) = map fn [ (x,y) | y <- [0..sy-1], x <- [0..sx-1] ]

            
AES-0.2.9
2 matches
Codec/Crypto/AES/Monad.hs
    return crypted

instance Cryptable BL.ByteString where
  crypt (BL.toChunks -> chunks) = snd <$> listen (mapM_ crypt chunks)

            
Codec/Crypto/AES/Random.hs
  where gen = unsafeInterleaveIO $ do
          bytes <- prandBytes 64
          let chunks = unfoldr (\b -> if B.null b then Nothing else Just (B.splitAt intSizeInBinary b)) bytes
              ints = map ((\(Right i) -> i) . decode) chunks
          moreInts <- gen
          return (ints ++ moreInts)

            
AMI-0.1
1 matches
Network/AMI.hs
    formatParams $ [("Action", name), ("ActionID", packID i)] ++ ps

formatParams :: Parameters -> B.ByteString
formatParams pairs = B.intercalate "\r\n" $ map one pairs
  where
    one (k,v) = k `B.append` ": " `B.append` v


            
Advise-me-0.1
14 matches
app/AdviseMeAdmin.hs
   query = queryString req

   param :: B.ByteString -> Maybe String
   param = fmap (safeString . maybe "" B.unpack) . flip lookup query

   paramFlag :: B.ByteString -> Bool
   paramFlag = maybe False (const True) . flip lookup query

   paramString :: B.ByteString -> String

            
app/AdviseMeAdmin.hs
table :: Bool -> [[HTMLBuilder]] -> HTMLBuilder
table hasHeader = tableAll . mconcat . zipWith f (hasHeader : repeat False)
 where
   f header = tag "tr" . mconcat . map make
    where
      make | header    = tag "th"
           | otherwise = tag "td"

pageNavBar :: Int -> Env -> (Int -> PageType) -> Int -> HTMLBuilder

            
app/AdviseMeAdmin.hs
pageNavBar :: Int -> Env -> (Int -> PageType) -> Int -> HTMLBuilder
pageNavBar nr env pageFor lastPage = fontSize Small $ mconcat $
   [ pageLinkWith 1 False (string "previous")] ++
   map pageLink [start .. end] ++
   [pageLinkWith lastPage False (string "next")]
 where
   start = (nr-5) `max` 1
   end   = (start+10) `min` lastPage


            
app/AdviseMeAdmin.hs
      = spanClass "strategies"
      . mconcat
      . intersperse br
      . map (string . uncurry (state2label taskNetwork))
      . filter (("Strat" `isSuffixOf`) . fst)
      . hardEvidence


-- ** HTML pages

            
app/AdviseMeAdmin.hs
reportPage showEvidence env = do
   allEntries <- allRecords (connection env)
   humanAssessments <- allHumanAssessments (connection env)
   return . HTMLFile . mconcat . intersperse hr . flip map (grouped allEntries) $
      \(sID, entries) ->
         h2 sID <> (mconcat . intersperse br . map (htmlEntry env humanAssessments showEvidence) $ entries)

   where
   grouped = orderBy ((! "studentid") :: SqlRecord -> String)



            
app/AdviseMeAdmin.hs
         <> pageNavBar i env (ModelPage studentid) n <>
         tag "div" (right $ string (formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" time))) <>
      h3 ("Inputs for " ++ tID) <>
      mconcat (map (uncurry inputBox) (inputHTMLs inputXML)) <>
      bold (string "Evidence: ") <> text ev <> br <>
      h3 ("Report for " ++ sID) <>
      htmlReport report <>
      h3 ("User model for " ++ sID) <>
      networkToSVG Just l1 (sm `trans` nw1) <>

            
app/AdviseMeAdmin.hs
-- | Create a table representing the student report.
htmlReport :: StudentReport -> HTMLBuilder
htmlReport report = W3.tableAll . mconcat $
      ( tag "tr" . mconcat . map (tag "th") $ [string "Competence", string "Value", string "Visualisation"] ) : 
      [ htmlCompetence 0 c | c <- competences report ]

   where 

   htmlCompetence :: Int -> Competence -> HTMLBuilder

            
app/AdviseMeAdmin.hs

   htmlCompetence :: Int -> Competence -> HTMLBuilder
   htmlCompetence i c = mconcat $ 
      ( tag "tr" . mconcat . map (tag "td") $
            [ spacer i <> (translationLabel $ skillText c), maybe (string "?") htmlPercentage $ skillValue c, skillBar $ (maybe 0.5 id (skillValue c) - 0.5) * 2]
      ) :
      [ htmlCompetence (i+1) c' | c' <- subskills c ]

   spacer :: Int -> HTMLBuilder

            
app/AdviseMeAdmin.hs

-- | Extract the inputIDs and input texts from an entry's XML.
inputHTMLs :: XML.XML -> [(InputID, HTMLBuilder)]
inputHTMLs = map (fmap $ XML.tag "pre"
                       . mconcat
                       . (("style" XML..=. "white-space: pre-wrap"):)
                       . map (either XML.string XML.builder)
                       . content
                       )
           . fromMaybe []
           . collectInputs


            
app/AdviseMeAdmin.hs
   bold (string $ record ! "taskid") <> 
   string (" (request: " ++ findWithDefault "unknown" "original" record ++ ")") <> br <>
   (if showEvidence then tag "div" $ small (bold (string "evidence") <> string ": " <> text (record ! "evidence" :: Evidence) <> mistakesHTML) else mempty) <>
   mconcat (map (uncurry inputBox) (inputHTMLs $ record ! "input")) <>
   button
      (urlFor env {pageType = SingleRequest (record ! "rowid")})
      (rounded XL . border . W3.background W3.Blue $ string "download XML") <> br
   
   where

            
app/AdviseMeAdmin.hs

   mistakesHTML = maybe
      (tag "div" $ string "(no human assessment)")
      (tag "div" . mconcat . intersperse (string ", ") . map mistaketoHTML)
      mistakes

   mistaketoHTML (nID, Just x, Nothing) = tag "span" $ textColor Blue (string nID <> string " should be " <> string x)
   mistaketoHTML (nID, x, _) = tag "span" $ textColor Red (string nID <> string " should be " <> maybe (string "empty") string x)


            
app/AdviseMeAdmin.hs
   inputBoxes :: M.Map InputID [(StudentID, XMLBuilder)] -> HTMLBuilder
   inputBoxes = flip M.foldrWithKey mempty $ \inputID list accumulator ->
      h3 ("Inputs for " ++ inputID) <>
      mconcat (map (uncurry inputBox) list) <>
      accumulator

   perc :: (Show a, Show b, Real a, Real b) => a -> b -> String
   perc x y = show x ++ " of " ++ show y ++ " (" ++ percentage 1 (x // y) ++ ")"


            
app/AdviseMeAdmin.hs
   perc x y = show x ++ " of " ++ show y ++ " (" ++ percentage 1 (x // y) ++ ")"

   makeTable :: Priors -> Table String String String
   makeTable (Priors mapping)
      = fromList
      . concatMap (\(nID, Prior p) -> [ ((nID, maybe "Undecided" id lbl), show count) | (lbl, count) <- M.toList p])
      . M.toList
      . M.mapKeysWith mappend snd
      $ mapping


studentsPage :: Env -> IO Resource
studentsPage env
   = HTMLFile

            
app/AdviseMeAdmin.hs
   . panel
   . htmlTable (htmlStudentID env) (const $ htmlLabel "Number of entries") text
   . fromList
   . map (\(x,y) -> ((x,()),y))
   <$> countStudentEntries (connection env)



studentModelsPage :: FileType -> Env -> IO Resource