Commit deeceec2 authored by daniel.is.fischer's avatar daniel.is.fischer
Browse files

Trailing Whitespace

parent b3364629
......@@ -7,7 +7,7 @@ module Data where
import Array
import CSG
import CSG
import Geometry
import Illumination
import Primitives
......@@ -47,14 +47,14 @@ instance Show GMLToken where
showsPrec p (TReal d) = shows d
showsPrec p (TString s) = shows s
showsPrec p (TBody code) = shows code
showsPrec p (TArray code) = showString "[ "
. foldr (\ a b -> a . showChar ' ' . b) id (map shows code)
showsPrec p (TArray code) = showString "[ "
. foldr (\ a b -> a . showChar ' ' . b) id (map shows code)
. showString "]"
showsPrec p (TApply) = showString "apply"
showsPrec p (TIf) = showString "if"
showsPrec p (TApply) = showString "apply"
showsPrec p (TIf) = showString "if"
showList code = showString "{ "
. foldr (\ a b -> a . showChar ' ' . b) id (map shows code)
showList code = showString "{ "
. foldr (\ a b -> a . showChar ' ' . b) id (map shows code)
. showString "}"
......@@ -71,12 +71,12 @@ data GMLValue
| VArray (Array Int GMLValue) -- FIXME: Haskell array
-- uses the interpreter version of point
| VPoint { xPoint :: !Double
, yPoint :: !Double
, zPoint :: !Double
}
, yPoint :: !Double
, zPoint :: !Double
}
-- these are abstract to the interpreter
| VObject Object
| VLight Light
| VLight Light
-- This is an abstract object, used by the abstract interpreter
| VAbsObj AbsObj
......@@ -84,9 +84,9 @@ data GMLValue
-- There are only *3* basic abstract values,
-- and the combinators also.
data AbsObj
= AbsFACE
| AbsU
data AbsObj
= AbsFACE
| AbsU
| AbsV
deriving (Show)
......@@ -99,9 +99,9 @@ showStkEle (VInt i) = show i ++ " :: Int"
showStkEle (VReal r) = show r ++ " :: Real"
showStkEle (VString s) = show s ++ " :: String"
showStkEle (VClosure {}) = "<closure> :: Closure"
showStkEle (VArray arr)
showStkEle (VArray arr)
= "<array (" ++ show (succ (snd (bounds arr))) ++ " elements)> :: Array"
showStkEle (VPoint x y z) = "(" ++ show x
showStkEle (VPoint x y z) = "(" ++ show x
++ "," ++ show y
++ "," ++ show z
++ ") :: Point"
......@@ -123,7 +123,7 @@ lookupEnv :: Env -> Name -> Maybe GMLValue
lookupEnv (Env e) n = lookup n e
-- All primitive operators
--
--
-- There is no Op_apply, Op_false, Op_true and Op_if
-- (because they appear explcitly in the rules).
......@@ -199,7 +199,7 @@ opTable :: [(Name,GMLToken)]
opTable = [ (kwd,op) | (kwd,op,_) <- opcodes ]
opNameTable :: Array GMLOp Name
opNameTable = array (minBound,maxBound)
opNameTable = array (minBound,maxBound)
[ (op,name) | (name,TOp op,_) <- opcodes ]
undef = error "undefined function"
......@@ -253,7 +253,7 @@ opcodes =
, ("real", Op_real, Int_Real fromIntegral)
, ("render", Op_render, Render $ render eye)
, ("rotatex", Op_rotatex, Obj_Real_Obj (\ o d -> rotateX (deg2rad d) o))
, ("rotatey", Op_rotatey, Obj_Real_Obj (\ o d -> rotateY (deg2rad d) o))
, ("rotatey", Op_rotatey, Obj_Real_Obj (\ o d -> rotateY (deg2rad d) o))
, ("rotatez", Op_rotatez, Obj_Real_Obj (\ o d -> rotateZ (deg2rad d) o))
, ("scale", Op_scale, Obj_Real_Real_Real_Obj (\ o x y z -> scale (x,y,z) o))
, ("sin", Op_sin, Real_Real (sin . deg2rad))
......@@ -275,7 +275,7 @@ opcodes =
data PrimOp
-- 1 argument
-- 1 argument
= Int_Int (Int -> Int)
| Real_Real (Double -> Double)
| Point_Real (Double -> Double -> Double -> Double)
......@@ -284,7 +284,7 @@ data PrimOp
| Int_Real (Int -> Double)
| Arr_Int (Array Int GMLValue -> Int)
-- 2 arguments
-- 2 arguments
| Int_Int_Int (Int -> Int -> Int)
| Int_Int_Bool (Int -> Int -> Bool)
| Real_Real_Real (Double -> Double -> Double)
......@@ -300,26 +300,26 @@ data PrimOp
| Obj_Real_Real_Real_Obj (Object -> Double -> Double -> Double -> Object)
| Value_String_Value (GMLValue -> String -> GMLValue)
| Point_Point_Color_Real_Real_Light
| Point_Point_Color_Real_Real_Light
(Coords -> Coords -> Color -> Radian -> Radian -> Light)
-- And finally render
| Render (Color -> [Light] -> Object -> Int -> Double -> Int -> Int -> String -> IO ())
data Type
= TyBool
| TyInt
| TyReal
| TyString
| TyCode
| TyArray
| TyPoint
| TyObject
data Type
= TyBool
| TyInt
| TyReal
| TyString
| TyCode
| TyArray
| TyPoint
| TyObject
| TyLight
| TyAlpha
| TyAbsObj
deriving (Eq,Ord,Ix,Bounded)
typeTable =
typeTable =
[ ( TyBool, "Bool")
, ( TyInt, "Int")
, ( TyReal, "Real")
......@@ -357,7 +357,7 @@ getPrimOpType (Real_Real_Real_Point _) = [TyReal,TyReal,TyReal]
getPrimOpType (Obj_Real_Obj _) = [TyObject,TyReal]
getPrimOpType (Obj_Real_Real_Real_Obj _) = [TyObject,TyReal,TyReal,TyReal]
getPrimOpType (Value_String_Value _) = [TyAlpha,TyString]
getPrimOpType (Point_Point_Color_Real_Real_Light _)
getPrimOpType (Point_Point_Color_Real_Real_Light _)
= [TyPoint,TyPoint,TyPoint,TyReal,TyReal]
getPrimOpType (Render _) = [TyPoint,
TyLight,
......@@ -377,9 +377,9 @@ mytrace v s = trace (s ++" : "++ show v ++ "\n") v
ixGet :: Array Int GMLValue -> Int -> GMLValue
ixGet arr i
| inRange (bounds arr) i = arr ! i
| otherwise = error ("failed access with index value "
++ show i
++ " (should be between 0 and "
| otherwise = error ("failed access with index value "
++ show i
++ " (should be between 0 and "
++ show (snd (bounds arr)) ++ ")")
ourQuot :: Int -> Int -> Int
......
......@@ -28,7 +28,7 @@ instance Monad Pure where
fail s = error s
instance MonadEval Pure where
doOp = doPureOp
doOp = doPureOp
err s = error s
instance MonadEval IO where
......@@ -62,7 +62,7 @@ eval st =
}
else return (stack st)
}
moreCode :: State -> Bool
moreCode (State {code = []}) = False
moreCode _ = True
......@@ -73,13 +73,13 @@ moreCode _ = True
step :: MonadEval m => State -> m State
-- Rule 1: Pushing BaseValues
step st@(State{ stack = stack, code = (TBool b):cs })
step st@(State{ stack = stack, code = (TBool b):cs })
= return (st { stack = (VBool b):stack, code = cs })
step st@(State{ stack = stack, code = (TInt i):cs })
step st@(State{ stack = stack, code = (TInt i):cs })
= return (st { stack = (VInt i):stack, code = cs })
step st@(State{ stack = stack, code = (TReal r):cs })
step st@(State{ stack = stack, code = (TReal r):cs })
= return (st { stack = (VReal r):stack, code = cs })
step st@(State{ stack = stack, code = (TString s):cs })
step st@(State{ stack = stack, code = (TString s):cs })
= return (st { stack = (VString s):stack, code = cs })
-- Rule 2: Name binding
......@@ -142,14 +142,14 @@ step _ = err "Tripped on sidewalk while stepping."
-- Operator code
opFnTable :: Array GMLOp PrimOp
opFnTable = array (minBound,maxBound)
opFnTable = array (minBound,maxBound)
[ (op,prim) | (_,TOp op,prim) <- opcodes ]
doPureOp :: (MonadEval m) => PrimOp -> GMLOp -> Stack -> m Stack
doPureOp _ Op_render _ =
doPureOp _ Op_render _ =
err ("\nAttempting to call render from inside a purely functional callback.")
doPureOp primOp op stk = doPrimOp primOp op stk -- call the purely functional operators
......@@ -171,21 +171,21 @@ doPrimOp (Point_Real fn) _ (VPoint x y z:stk)
-- This is where the callbacks happen from...
doPrimOp (Surface_Obj fn) _ (VClosure env code:stk)
= case absapply env code [VAbsObj AbsFACE,VAbsObj AbsU,VAbsObj AbsV] of
Just [VReal r3,VReal r2,VReal r1,VPoint c1 c2 c3] ->
Just [VReal r3,VReal r2,VReal r1,VPoint c1 c2 c3] ->
let
res = prop (color c1 c2 c3) r1 r2 r3
in
return ((VObject (fn (SConst res))) : stk)
_ -> return ((VObject (fn (SFun call))) : stk)
where
where
-- The most general case
call i r1 r2 =
case callback env code [VReal r2,VReal r1,VInt i] of
[VReal r3,VReal r2,VReal r1,VPoint c1 c2 c3]
[VReal r3,VReal r2,VReal r1,VPoint c1 c2 c3]
-> prop (color c1 c2 c3) r1 r2 r3
stk -> error ("callback failed: incorrectly typed return arguments"
++ show stk)
doPrimOp (Real_Int fn) _ (VReal r1:stk)
= return ((VInt (fn r1)) : stk)
doPrimOp (Int_Real fn) _ (VInt r1:stk)
......@@ -213,7 +213,7 @@ doPrimOp (Obj_Obj_Obj fn) _ (VObject o2:VObject o1:stk)
= return ((VObject (fn o1 o2)) : stk)
doPrimOp (Point_Color_Light fn) _ (VPoint r g b:VPoint x y z : stk)
= return (VLight (fn (x,y,z) (color r g b)) : stk)
doPrimOp (Point_Point_Color_Real_Real_Light fn) _
doPrimOp (Point_Point_Color_Real_Real_Light fn) _
(VReal r2:VReal r1:VPoint r g b:VPoint x2 y2 z2:VPoint x1 y1 z1 : stk)
= return (VLight (fn (x1,y1,z1) (x2,y2,z2) (color r g b) r1 r2) : stk)
doPrimOp (Real_Real_Real_Point fn) _ (VReal r3:VReal r2:VReal r1:stk)
......@@ -229,15 +229,15 @@ doPrimOp (Value_String_Value fn) _ (VString s:o:stk)
where
res = fn o s
doPrimOp primOp op args
doPrimOp primOp op args
= err ("\n\ntype error when attempting to execute builtin primitive \"" ++
show op ++ "\"\n\n| " ++
show op ++ " takes " ++ show (length types) ++ " argument" ++ s
++ " with" ++ the ++ " type" ++ s ++ "\n|\n|" ++
" " ++ unwords [ show ty | ty <- types ] ++ "\n|\n|" ++
" currently, the relevent argument" ++ s ++ " on the stack " ++
are ++ "\n|\n| " ++
unwords [ "(" ++ show arg ++ ")"
" " ++ unwords [ show ty | ty <- types ] ++ "\n|\n|" ++
" currently, the relevent argument" ++ s ++ " on the stack " ++
are ++ "\n|\n| " ++
unwords [ "(" ++ show arg ++ ")"
| arg <- reverse (take (length types) args) ] ++ "\n|\n| "
++ " (top of stack is on the right hand side)\n\n")
where
......@@ -268,7 +268,7 @@ doAllOp primOp op stk = doPrimOp primOp op stk -- call the purely functional ope
{-
- Abstract evaluation.
-
- The idea is you check for constant code that
- The idea is you check for constant code that
- (1) does not look at its arguments
- (2) gives a fixed result
-
......@@ -277,7 +277,7 @@ doAllOp primOp op stk = doPrimOp primOp op stk -- call the purely functional ope
-}
absapply :: Env -> Code -> Stack -> Maybe Stack
absapply env code stk =
absapply env code stk =
case runAbs (eval (State env stk code)) 100 of
AbsState stk _ -> Just stk
AbsFail m -> Nothing
......@@ -301,7 +301,7 @@ instance MonadEval Abs where
else AbsState () (n-1))
doAbsOp :: PrimOp -> GMLOp -> Stack -> Abs Stack
doAbsOp _ Op_point (VReal r3:VReal r2:VReal r1:stk)
doAbsOp _ Op_point (VReal r3:VReal r2:VReal r1:stk)
= return ((VPoint r1 r2 r3) : stk)
-- here, you could have an (AbsPoint :: AbsObj) which you put on the
-- stack, with any object in the three fields.
......@@ -311,12 +311,12 @@ doAbsOp _ op _ = err ("operator not understood (" ++ show op ++ ")")
-- Driver
mainEval :: Code -> IO ()
mainEval prog = do { stk <- eval (State emptyEnv [] prog)
mainEval prog = do { stk <- eval (State emptyEnv [] prog)
; return ()
}
{-
{-
* Oops, one of the example actually has something
* on the stack at the end.
* on the stack at the end.
* Oh well...
; if null stk
then return ()
......@@ -338,13 +338,13 @@ testF is = do prog <- rayParseF is
eval (State emptyEnv [] prog)
testA :: String -> Either String (Stack,Int)
testA is = case runAbs (eval (State emptyEnv
testA is = case runAbs (eval (State emptyEnv
[VAbsObj AbsFACE,VAbsObj AbsU,VAbsObj AbsV]
(rayParse is))) 100 of
AbsState a n -> Right (a,n)
AbsFail m -> Left m
abstest1 = "1.0 0.0 0.0 point /red { /v /u /face red 1.0 0.0 1.0 } apply"
abstest1 = "1.0 0.0 0.0 point /red { /v /u /face red 1.0 0.0 1.0 } apply"
-- should be [3:: Int]
et1 = test "1 /x { x } /f 2 /x f apply x addi"
......
......@@ -61,7 +61,7 @@ module Geometry
, clampf
) where
import List
import List
type Coords = (Double,Double,Double)
......@@ -131,7 +131,7 @@ point_to_vector :: Point -> Vector
point_to_vector (P x y z) = V x y z
vector_to_point :: Vector -> Point
vector_to_point (V x y z) = P x y z
vector_to_point (V x y z) = P x y z
{-# INLINE vector_to_quad #-}
vector_to_quad :: Vector -> Quad
......@@ -169,23 +169,23 @@ dot4 :: Quad -> Quad -> Double
dot4 (Q x1 y1 z1 w1) (Q x2 y2 z2 w2) = x1 * x2 + y1 * y2 + z1 * z2 + w1 * w2
addVV :: Vector -> Vector -> Vector
addVV (V x1 y1 z1) (V x2 y2 z2)
addVV (V x1 y1 z1) (V x2 y2 z2)
= V (x1 + x2) (y1 + y2) (z1 + z2)
addPV :: Point -> Vector -> Point
addPV (P x1 y1 z1) (V x2 y2 z2)
addPV (P x1 y1 z1) (V x2 y2 z2)
= P (x1 + x2) (y1 + y2) (z1 + z2)
subVV :: Vector -> Vector -> Vector
subVV (V x1 y1 z1) (V x2 y2 z2)
subVV (V x1 y1 z1) (V x2 y2 z2)
= V (x1 - x2) (y1 - y2) (z1 - z2)
negV :: Vector -> Vector
negV (V x1 y1 z1)
negV (V x1 y1 z1)
= V (-x1) (-y1) (-z1)
subPP :: Point -> Point -> Vector
subPP (P x1 y1 z1) (P x2 y2 z2)
subPP (P x1 y1 z1) (P x2 y2 z2)
= V (x1 - x2) (y1 - y2) (z1 - z2)
--{-# INLINE norm #-}
......@@ -208,7 +208,7 @@ dist2 us vs = sq x + sq y + sq z
{-# INLINE sq #-}
sq :: Double -> Double
sq d = d * d
sq d = d * d
{-# INLINE distFrom0Sq #-}
distFrom0Sq :: Point -> Double -- Distance of point from origin.
......@@ -232,7 +232,7 @@ multMM m1@(M q1 q2 q3 q4) m2
where
m2' = transposeM m2
{-# INLINE transposeM #-}
{-# INLINE transposeM #-}
transposeM :: Matrix -> Matrix
transposeM (M (Q e11 e12 e13 e14)
(Q e21 e22 e23 e24)
......@@ -300,7 +300,7 @@ epsilon = 1.0e-10
inf = 1.0e20
nonZero :: Double -> Double -- Use before a division. It makes definitions
nonZero x | x > epsilon = x -- more complete and I bet the errors that get
nonZero x | x > epsilon = x -- more complete and I bet the errors that get
| x < -epsilon = x -- introduced will be undetectable if epsilon
| otherwise = epsilon -- is small enough
......
......@@ -65,7 +65,7 @@ render (m,m') amb ls obj dep fov wid ht file
superSample (y, x) col = avg $ col:
[ illumination cxt (start, pixel (fromIntegral x - 0.5 + xd) (fromIntegral y - 0.5 + yd))
| (xd, yd) <- [(-0.333, 0.0), (0.333, 0.0), (0.0, -0.333), (0.0, 0.333)]
]
]
avg cs = divN (fromIntegral (length cs)) (uncolor (sumCC cs))
where divN n (r,g,b) = color (r / n) (g / n) (b / n)
......@@ -121,7 +121,7 @@ showBitmapA wid ht arr
showBitmap :: Int -> Int ->[[Color]] -> String
showBitmap wid ht pss
-- type of assert | length pss == ht && all (\ ps -> length ps == wid) pss
= header ++ concat [[scalePixel r,scalePixel g,scalePixel b]
= header ++ concat [[scalePixel r,scalePixel g,scalePixel b]
| ps <- pss, (r,g,b) <- map uncolor ps]
where
header = "P6\n#Galois\n" ++ show wid ++ " " ++ show ht ++ "\n255\n"
......@@ -147,7 +147,7 @@ scalePixel' p = show (floor (clampf p * 255))
-- Lights
data Light = Light Vector Color
| PointLight Point Color
| PointLight Point Color
| SpotLight Point Point Color Radian Double
deriving Show
......@@ -187,7 +187,7 @@ unobscure org obj normV (SpotLight pos at color cutoff exp)
vec' = pos `subPP` at
angle = acos (normalize vec `dot` (normalize vec'))
asp = normalize (at `subPP` pos)
asp = normalize (at `subPP` pos)
qsp = normalize (org `subPP` pos)
is = attenuate vec (((asp `dot` qsp) ** exp) `multSC` color)
......
......@@ -3,7 +3,7 @@
-- free software under the license in the file "LICENSE",
-- which is included in the distribution.
module Intersections
module Intersections
( intersectRayWithObject,
quadratic
) where
......@@ -370,7 +370,7 @@ quadratic a b c =
-- Bounding boxes
-------------------
data MaybeInterval = Interval !Double !Double
data MaybeInterval = Interval !Double !Double
| NoInterval
isInterval (Interval _ _) = True
......@@ -397,7 +397,7 @@ intersectRayWithSlab :: Double -> Double -> (Double,Double) -> MaybeInterval
intersectRayWithSlab xCoord alpha (x1, x2)
| alpha == 0 = if xCoord < x1 || xCoord > x2 then NoInterval else infInterval
| alpha > 0 = Interval a b
| otherwise = Interval b a
| otherwise = Interval b a
where a = (x1 - xCoord) / alpha
b = (x2 - xCoord) / alpha
......
......@@ -24,7 +24,7 @@ tokenList = many token <?> "list of tokens"
token :: Parser GMLToken
token =
do { ts <- braces tokenList ; return (TBody ts) }
do { ts <- braces tokenList ; return (TBody ts) }
<|> do { ts <- brackets tokenList ; return (TArray ts) }
<|> (do { s <- gmlString ; return (TString s) } <?> "string")
<|> (do { t <- pident False ; return t } <?> "identifier")
......@@ -57,7 +57,7 @@ test_number = "1234 -1234 1 -0 0" ++
" -1234.5678e12 -1234.5678E-12 -1234.5678E12" ++
" 1234e11 1234E33 -1234e33 1234e-33" ++
" 123e 123.4e 123ee 123.4ee 123E 123.4E 123EE 123.4EE"
-- Always int or real
number :: Parser GMLToken
......@@ -100,7 +100,7 @@ symbol name = lexeme (string name)
lexeme p = do{ x <- p; whiteSpace; return x }
whiteSpace = skipMany (simpleSpace <|> oneLineComment <?> "")
where simpleSpace = skipMany1 (oneOf " \t\n\r\v")
where simpleSpace = skipMany1 (oneOf " \t\n\r\v")
oneLineComment =
do{ string "%"
; skipMany (noneOf "\n\r\v")
......
......@@ -48,7 +48,7 @@ number
whiteSpace
= skipMany (simpleSpace <|> oneLineComment <?> "")
where simpleSpace = skipMany1 (oneOf " \t\n\r\v")
where simpleSpace = skipMany1 (oneOf " \t\n\r\v")
oneLineComment =
do char '#'
skipMany (noneOf "\n\r\v")
......
......@@ -70,7 +70,7 @@
i 63 eqi { 62 } { i } if % return max(2, i)
} /toIntCoord
galois u toIntCoord apply get % val = texture[u][v]
v toIntCoord apply get
v toIntCoord apply get
real 100.0 divf /gal
gal gal gal point % b/w galois
1.0 % kd = 1.0
......@@ -80,19 +80,19 @@
galoisface cube
-0.5 -0.5 -0.5 translate % center
-0.5 -0.5 -0.5 translate % center
2.5 uscale % make it bigger
-25.0 rotatex -25.0 rotatey % rotate
0.0 -1.0 7.0 translate % move to final position
%galoisface cylinder
%-0.5 -0.5 -0.5 translate % center
%-0.5 -0.5 -0.5 translate % center
%1.5 uscale % make it bigger
%0.0 rotatex 90.0 rotatey % rotate
%0.0 0.0 5.0 translate % move to final position
%galoisface sphere
%-0.5 -0.5 -0.5 translate % center
%-0.5 -0.5 -0.5 translate % center
%1.5 uscale % make it bigger
%-25.0 rotatex 25.0 rotatey % rotate
%-3.0 0.0 5.0 translate % move to final position
......@@ -102,14 +102,14 @@ galoisface cube
{ /v /u /face
v 5.0 divf /v
u 5.0 divf /u
v floor 2 modi 0 eqi
v floor 2 modi 0 eqi
{ 1.0 }
{ 0.8 }
if /r
u floor 2 modi 0 eqi
if /r
u floor 2 modi 0 eqi
{ 1.0 }
{ 0.8 }
if /g
if /g
v frac /v
u frac /u
v 0.0 lessf { v 1.0 addf } { v } if /v
......@@ -119,7 +119,7 @@ galoisface cube
i 63 eqi { 62 } { i } if % return max(2, i)
} /toIntCoord
galois u toIntCoord apply get % val = texture[u][v]
v toIntCoord apply get
v toIntCoord apply get
real 100.0 divf /gal
r gal mulf g gal mulf gal point % b/w galois
0.0 % kd = 1.0
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment