jort (empty) → 1.0.0

raw patch · 19 files changed

+976/−0 lines, 19 filesdep +arraydep +basedep +gtksetup-changed

Dependencies added: array, base, gtk

Files

• Anims.hs +48/−0
• Basics.hs +42/−0
• Bench.hs +15/−0
• Bitmaps.hs +65/−0
• Camera.hs +36/−0
• Colors.hs +69/−0
• Drawing.hs +86/−0
• Env.hs +31/−0
• LICENSE +56/−0
• Lights.hs +40/−0
• Objects.hs +115/−0
• Ray.hs +18/−0
• Scenes.hs +111/−0
• Setup.hs +4/−0
• Textures.hs +29/−0
• Trace.hs +74/−0
• Vectors.hs +98/−0
• World.hs +14/−0
• jort.cabal +25/−0

@@ -0,0 +1,48 @@++module Anims where++import Basics+import Objects+import Vectors+import Camera +import World +import Control.Applicative++sequ :: [Anim a] -> Anim [a]+sequ (x:xs) t = x t : sequ xs t+sequ [] t = []++type Anim a = Scal -> a+++aObject :: Anim Shape -> Texture -> Int -> Anim Object+aObject shape color id time = Object id (shape time) (color)+++aMeta l threshold t = Meta [f t | f <- l] (threshold t)++-- aMetaPoint = liftA2 MetaPoint++-- aPlane = liftA2 Plane++(|+|), (|-|), (|*|) :: Anim Scal -> Anim Scal -> Anim Scal+(|+|) = liftA2 (+)+(|-|) = liftA2 (-)+(|*|) = liftA2 (*)+++-- aRowProd = liftA2 rowProd++orbit :: Anim Vector -> -- axis+	 Anim Vector -> -- starting point+	 Anim Vector++orbit axis point time = rotateMatrix time (normalized (axis time)) `mulVec` (point time)+++liss :: Anim Vector -> Anim Vector -> Anim Vector -> Anim Vector+liss ampl freq phase time = ampl time `rowProd` liftV sin ((time `scale` freq time) + phase time)+++ask :: Anim Scal+ask time = time

@@ -0,0 +1,42 @@++module Basics+    (module Vectors,+     Camera(..),+     Light(..),+     Frame,+     Color(..),+     Material(..),+     Texture+    ) where++import Vectors+import Data.Array++data Camera = Camera {camLoc :: Vector, camN :: Vector, camU :: Vector, camV :: Vector}++data Light = +    DotLight !Vector !Color |+    AmbientLight !Color |+    DirLight  !Vector -- direction+		  !Color+    deriving Show++type Frame = Array (Int, Int) Color+++instance Show (a -> b) where+    show _ = "<function>"++data Color = Color {colR,colG,colB :: !Scal} deriving (Show, Eq)++type Texture = Vector -> Material++data Material = Material {+			  diffuse :: Color,+			  materialReflection :: Color,+			  materialRefraction :: Color,+			  materialRefrCoef :: Scal+			 }+	      deriving Show++	  

@@ -0,0 +1,15 @@+module Bench where++import Ray+import Data.Array+import Basics(Color(..))+import Foreign.C.Types+import Foreign.Marshal.Array+import Foreign.Marshal.Alloc+import Data.Word+import Vectors+import Data.IORef++main = print $  map result $ map fromIntegral $ [1..10]++result time = sum $ elems $ Ray.rt time

@@ -0,0 +1,65 @@+++module Bitmaps+    (Bitmap,+     module Data.Array,+     loadBitmap+    )+    where+    +import Basics+import Data.Array+import Graphics.UI.Gtk hiding (Color, Bitmap)+import Data.Array(Array, listArray)+import Data.Array.Base ( unsafeRead )+import Data.Array.MArray(newArray_, writeArray, unsafeFreeze)+import Data.Array.IO+import Data.Word+++type Bitmap = Array (Int, Int) Color++pixbufGetPixelData :: Pixbuf -> IO (Array (Int, Int) (Word8, Word8, Word8))+pixbufGetPixelData pb =+  do+     rowstride <- pixbufGetRowstride pb+     w <- pixbufGetWidth pb+     h <- pixbufGetHeight pb+     chan <- pixbufGetNChannels pb+--      putStr "rowstride = " +--      print rowstride+--      putStr "width = "+--      print w+--      putStr "height = "+--      print h  +     pixelData <- pixbufGetPixels pb :: IO (PixbufData Int Word8)+--      putStrLn "got pointer to pixels"+     pixels <- newArray_ ((0,0),(w,h))+     let pixels_type :: IOArray (Int,Int) (Word8, Word8, Word8)+	 pixels_type = pixels+         fetchPixel x y = do r <- unsafeRead pixelData (x*chan+y*rowstride+0)+                             g <- unsafeRead pixelData (x*chan+y*rowstride+1)+                             b <- unsafeRead pixelData (x*chan+y*rowstride+2)+			     writeArray pixels (x,y) $! +                                            (fromIntegral r, fromIntegral g, fromIntegral b)+     sequence_ [fetchPixel x y | x <- [0..w], y <- [0..h]]+     unsafeFreeze pixels+++loadBitmap fname = +    do +       putStrLn ("loading bitmap: " ++ fname)+       pb <- pixbufNewFromFile fname+       putStrLn "bitmap loaded; xlation..."+       pixels <- pixbufGetPixelData pb+       let result = fmap pixelToColor pixels+       return result+    where pixelToColor (r,g,b) = Color (f r/255) (f g/255) (f b/255)+	  f = fromIntegral++main =+     do+        initGUI+        bm <- loadBitmap "../rtrt/ciel.tif"+        print bm+       

@@ -0,0 +1,36 @@+module Camera where++import Basics+import Vectors+import Objects+import Data.Array +import Trace+import World++cameraLooks vertical from to = Camera from n u v+    where n = normalized (to-from)+	  u = normalized vertical * n+	  v = u * n+++render :: World -> Camera -> Scal -> Scal -> Int -> Int -> Frame++render world (Camera from n u v)+       fovx fovy+       width height =+       bitmap+    where bitmap = array ((0,0), (height-1, width-1)) $ +		   do y <- [0..height-1]+		      x <- [0..width-1]+		      let fx = fromIntegral x+			  fy = fromIntegral y+		      let psi = fovx * (fx / floatWidth - 0.5) +			  phi = fovy * (fy / floatHeight - 0.5)+			  h = rotateMatrix psi v `mulVec` n+			  direction = cos phi `scale` h + sin phi `scale` v+		      return ((y, x), traceRay 0 world from (normalized direction) [] 1)+	  floatWidth = fromIntegral width +	  floatHeight = fromIntegral height+    +    +	  

@@ -0,0 +1,69 @@+module Colors where++import Basics ++liftColor2 op (Color r1 g1 b1) (Color r2 g2 b2) = Color (op r1 r2) (op g1 g2) (op b1 b2)+liftColor1 op (Color r1 g1 b1) = Color (op r1) (op g1) (op b1)++instance Num Color where+    (+) = liftColor2 (+)+    (-) = liftColor2 (-)+    (*) = liftColor2 (*)+    negate = liftColor1 negate+    abs = liftColor1 abs+    fromInteger i = grayTint $ fromInteger i+    signum = error "signum not defined for colors"++grayTint frac = Color frac frac frac++f `weight` Color r g b = Color (f*r) (f*g) (f*b)+++rgb = Color++-- Hue: The trigonometric method.+-- hue :: Scal -> Color+-- hue h = Color r g b -- hue in rad+--     where r = f h+-- 	  g = f (h+2*pi/3)+-- 	  b = f (h-2*pi/3)+-- 	  f h' = (1+cos h')/2++--Hue: The linear method.+hsi h s i = result+    where h1 = h*3/pi -- h1 cycle length is 6+	  h2 = floor h1+	  h3 = fromIntegral h2+	  p = i * (1 - s)+	  q = i * (1 - s * (h1-h3))+	  t = i * (1 - s * (1-h1+h3))+	  result = case h2 `mod` 6 of+	     0 -> Color i t p+	     1 -> Color q i p+	     2 -> Color p i t+	     3 -> Color p q i+	     4 -> Color t p i+	     5 -> Color i p q++hue h = hsi h 1 1	   ++-- For future reference:+-- (1) from RGB to HIS+-- I = Max. (R,G,B)+-- 1) I = 0 ; S = 0, H= indeterminate++-- S = (I-i)/I , where i = min. {R, G, B}+-- Let r = (I-R) / (I-i), g = (I-G) / (I-i), b = (I-B) / (I-i), then+-- if R = I H = (b-g) / 3+-- if G = I H = (2+r-b) / 3+-- if B = I H = (4+g-r) / 3+++normalizeAngle a = a - fromIntegral cycleOffset * 2 * pi+    where cycleOffset = round (a / (2*pi))+    ++blackColor = grayTint 0+whiteColor = grayTint 1++intensity (Color r g b) = max r $ max g $ b

@@ -0,0 +1,86 @@+import Graphics.UI.Gtk hiding (eventRegion)+import Graphics.UI.Gtk.Gdk.Events+import Graphics.UI.Gtk.Gdk.GC++import Ray+import Data.Array+import Basics(Color(..))+import Foreign.C.Types+import Foreign.Marshal.Array+import Foreign.Marshal.Alloc+import Foreign(Ptr)+import Data.Word+import Vectors+import Data.IORef+import Bitmaps+import System.IO.Unsafe+import Scenes+import Data.Array.MArray+import Data.Array.Base ( unsafeWrite ) ++main = do+  timeRef <- newIORef (0 :: Scal) +  initGUI+  putStrLn "GTK inited"+  print $ sum $ elems $ skyBitmap+  dia <- dialogNew+  dialogAddButton dia stockOk ResponseOk+  contain <- dialogGetUpper dia+  canvas <- drawingAreaNew+  canvas `onSizeRequest` return (Requisition 400 200)+  pb <- pixbufNew ColorspaceRgb False 8 400 200+  pbData <- (pixbufGetPixels pb :: IO (PixbufData Int Word8))+  row <- pixbufGetRowstride pb+  chan <- pixbufGetNChannels pb+  bits <- pixbufGetBitsPerSample pb+  putStrLn ("bytes per row: "++show row++", channels per pixel: "++show chan+++	    ", bits per sample: "++show bits)++  let updateFrame = do+        time <- updateTime timeRef+        putStrLn $ "updateCanvas @" ++ show time+        let frame = Ray.rt time+        sequence_ [unsafeWrite pbData (0+x*chan+y*row) (mkCol $ colR $ frame!(y,x)) >>+	           unsafeWrite pbData (1+x*chan+y*row) (mkCol $ colG $ frame!(y,x)) >>+	           unsafeWrite pbData (2+x*chan+y*row) (mkCol $ colB $ frame!(y,x))+	           | x <- [0..399], y <- [0..199] ]+        widgetQueueDraw canvas       +        return True+  canvas `widgetCreateLayout` "Hello World."+  idleAdd updateFrame priorityLow+  canvas `onExpose` updateCanvas canvas pb+  boxPackStartDefaults contain canvas+  widgetShow canvas+  dialogRun dia+  return ()++  +++updateCanvas :: DrawingArea -> Pixbuf -> Event -> IO Bool+updateCanvas canvas pb Expose { eventRegion = region } = do+  win <- widgetGetDrawWindow canvas+  gc <- gcNew win+  (width,height) <- widgetGetSize canvas+  rects <- regionGetRectangles region+  (flip mapM_) rects $ \(Rectangle x y w h) -> do+    drawPixbuf win gc pb x y x y (-1) (-1) RgbDitherNone 0 0+  return True++++updateTime :: IORef(Scal) ->  IO (Scal)+updateTime timeRef =+    do t <- readIORef timeRef+       writeIORef timeRef (t + 0.2)+       return t+++++mkCol x = clamp $ round $ (255 * x)+    where clamp x | x < 0 = 0+ 	          | x > 255 = 255+ 	          | otherwise = x++

@@ -0,0 +1,31 @@+++module Env where+    +import Bitmaps+import Vectors+import Colors+import Basics++type Env = (Vector -> Color) -- vector must be normalized++-- instance Show Env where+--     show _ = "<Env>"++skyBitmapEnv :: Bitmap -> Env++skyBitmapEnv bitmap (Vector x y z) = bitmap ! (x0, y0)+    where (width, height) = snd $ bounds $ bitmap+	  y0 = inrange 0 height $ (1.0 - y) * (fromIntegral height)+	  a = atan2 x z -- a in [-pi, pi]+	  x0 = floor $ (a+pi) / (2.0*pi) * (fromIntegral width)+	  inrange l h x = max (min (floor x) (h-1)) l+	  +	  ++rainbowEnv :: Env+rainbowEnv (Vector x y z) = hsi h s i+    where +	  h = atan2 x z+	  s = 1 - (abs y)+	  i = 0.75

@@ -0,0 +1,56 @@+THE WORK (AS DEFINED BELOW) IS PROVIDED UNDER THE TERMS OF THIS CREATIVE COMMONS PUBLIC LICENSE ("CCPL" OR "LICENSE"). THE WORK IS PROTECTED BY COPYRIGHT AND/OR OTHER APPLICABLE LAW. ANY USE OF THE WORK OTHER THAN AS AUTHORIZED UNDER THIS LICENSE OR COPYRIGHT LAW IS PROHIBITED.++BY EXERCISING ANY RIGHTS TO THE WORK PROVIDED HERE, YOU ACCEPT AND AGREE TO BE BOUND BY THE TERMS OF THIS LICENSE. TO THE EXTENT THIS LICENSE MAY BE CONSIDERED TO BE A CONTRACT, THE LICENSOR GRANTS YOU THE RIGHTS CONTAINED HERE IN CONSIDERATION OF YOUR ACCEPTANCE OF SUCH TERMS AND CONDITIONS.++1. Definitions++"Adaptation" means a work based upon the Work, or upon the Work and other pre-existing works, such as a translation, adaptation, derivative work, arrangement of music or other alterations of a literary or artistic work, or phonogram or performance and includes cinematographic adaptations or any other form in which the Work may be recast, transformed, or adapted including in any form recognizably derived from the original, except that a work that constitutes a Collection will not be considered an Adaptation for the purpose of this License. For the avoidance of doubt, where the Work is a musical work, performance or phonogram, the synchronization of the Work in timed-relation with a moving image ("synching") will be considered an Adaptation for the purpose of this License.+"Collection" means a collection of literary or artistic works, such as encyclopedias and anthologies, or performances, phonograms or broadcasts, or other works or subject matter other than works listed in Section 1(f) below, which, by reason of the selection and arrangement of their contents, constitute intellectual creations, in which the Work is included in its entirety in unmodified form along with one or more other contributions, each constituting separate and independent works in themselves, which together are assembled into a collective whole. A work that constitutes a Collection will not be considered an Adaptation (as defined below) for the purposes of this License.+"Creative Commons Compatible License" means a license that is listed at http://creativecommons.org/compatiblelicenses that has been approved by Creative Commons as being essentially equivalent to this License, including, at a minimum, because that license: (i) contains terms that have the same purpose, meaning and effect as the License Elements of this License; and, (ii) explicitly permits the relicensing of adaptations of works made available under that license under this License or a Creative Commons jurisdiction license with the same License Elements as this License.+"Distribute" means to make available to the public the original and copies of the Work or Adaptation, as appropriate, through sale or other transfer of ownership.+"License Elements" means the following high-level license attributes as selected by Licensor and indicated in the title of this License: Attribution, ShareAlike.+"Licensor" means the individual, individuals, entity or entities that offer(s) the Work under the terms of this License.+"Original Author" means, in the case of a literary or artistic work, the individual, individuals, entity or entities who created the Work or if no individual or entity can be identified, the publisher; and in addition (i) in the case of a performance the actors, singers, musicians, dancers, and other persons who act, sing, deliver, declaim, play in, interpret or otherwise perform literary or artistic works or expressions of folklore; (ii) in the case of a phonogram the producer being the person or legal entity who first fixes the sounds of a performance or other sounds; and, (iii) in the case of broadcasts, the organization that transmits the broadcast.+"Work" means the literary and/or artistic work offered under the terms of this License including without limitation any production in the literary, scientific and artistic domain, whatever may be the mode or form of its expression including digital form, such as a book, pamphlet and other writing; a lecture, address, sermon or other work of the same nature; a dramatic or dramatico-musical work; a choreographic work or entertainment in dumb show; a musical composition with or without words; a cinematographic work to which are assimilated works expressed by a process analogous to cinematography; a work of drawing, painting, architecture, sculpture, engraving or lithography; a photographic work to which are assimilated works expressed by a process analogous to photography; a work of applied art; an illustration, map, plan, sketch or three-dimensional work relative to geography, topography, architecture or science; a performance; a broadcast; a phonogram; a compilation of data to the extent it is protected as a copyrightable work; or a work performed by a variety or circus performer to the extent it is not otherwise considered a literary or artistic work.+"You" means an individual or entity exercising rights under this License who has not previously violated the terms of this License with respect to the Work, or who has received express permission from the Licensor to exercise rights under this License despite a previous violation.+"Publicly Perform" means to perform public recitations of the Work and to communicate to the public those public recitations, by any means or process, including by wire or wireless means or public digital performances; to make available to the public Works in such a way that members of the public may access these Works from a place and at a place individually chosen by them; to perform the Work to the public by any means or process and the communication to the public of the performances of the Work, including by public digital performance; to broadcast and rebroadcast the Work by any means including signs, sounds or images.+"Reproduce" means to make copies of the Work by any means including without limitation by sound or visual recordings and the right of fixation and reproducing fixations of the Work, including storage of a protected performance or phonogram in digital form or other electronic medium.+2. Fair Dealing Rights. Nothing in this License is intended to reduce, limit, or restrict any uses free from copyright or rights arising from limitations or exceptions that are provided for in connection with the copyright protection under copyright law or other applicable laws.++3. License Grant. Subject to the terms and conditions of this License, Licensor hereby grants You a worldwide, royalty-free, non-exclusive, perpetual (for the duration of the applicable copyright) license to exercise the rights in the Work as stated below:++to Reproduce the Work, to incorporate the Work into one or more Collections, and to Reproduce the Work as incorporated in the Collections;+to create and Reproduce Adaptations provided that any such Adaptation, including any translation in any medium, takes reasonable steps to clearly label, demarcate or otherwise identify that changes were made to the original Work. For example, a translation could be marked "The original work was translated from English to Spanish," or a modification could indicate "The original work has been modified.";+to Distribute and Publicly Perform the Work including as incorporated in Collections; and,+to Distribute and Publicly Perform Adaptations.+For the avoidance of doubt:++Non-waivable Compulsory License Schemes. In those jurisdictions in which the right to collect royalties through any statutory or compulsory licensing scheme cannot be waived, the Licensor reserves the exclusive right to collect such royalties for any exercise by You of the rights granted under this License;+Waivable Compulsory License Schemes. In those jurisdictions in which the right to collect royalties through any statutory or compulsory licensing scheme can be waived, the Licensor waives the exclusive right to collect such royalties for any exercise by You of the rights granted under this License; and,+Voluntary License Schemes. The Licensor waives the right to collect royalties, whether individually or, in the event that the Licensor is a member of a collecting society that administers voluntary licensing schemes, via that society, from any exercise by You of the rights granted under this License.+The above rights may be exercised in all media and formats whether now known or hereafter devised. The above rights include the right to make such modifications as are technically necessary to exercise the rights in other media and formats. Subject to Section 8(f), all rights not expressly granted by Licensor are hereby reserved.++4. Restrictions. The license granted in Section 3 above is expressly made subject to and limited by the following restrictions:++You may Distribute or Publicly Perform the Work only under the terms of this License. You must include a copy of, or the Uniform Resource Identifier (URI) for, this License with every copy of the Work You Distribute or Publicly Perform. You may not offer or impose any terms on the Work that restrict the terms of this License or the ability of the recipient of the Work to exercise the rights granted to that recipient under the terms of the License. You may not sublicense the Work. You must keep intact all notices that refer to this License and to the disclaimer of warranties with every copy of the Work You Distribute or Publicly Perform. When You Distribute or Publicly Perform the Work, You may not impose any effective technological measures on the Work that restrict the ability of a recipient of the Work from You to exercise the rights granted to that recipient under the terms of the License. This Section 4(a) applies to the Work as incorporated in a Collection, but this does not require the Collection apart from the Work itself to be made subject to the terms of this License. If You create a Collection, upon notice from any Licensor You must, to the extent practicable, remove from the Collection any credit as required by Section 4(c), as requested. If You create an Adaptation, upon notice from any Licensor You must, to the extent practicable, remove from the Adaptation any credit as required by Section 4(c), as requested.+You may Distribute or Publicly Perform an Adaptation only under the terms of: (i) this License; (ii) a later version of this License with the same License Elements as this License; (iii) a Creative Commons jurisdiction license (either this or a later license version) that contains the same License Elements as this License (e.g., Attribution-ShareAlike 3.0 US)); (iv) a Creative Commons Compatible License. If you license the Adaptation under one of the licenses mentioned in (iv), you must comply with the terms of that license. If you license the Adaptation under the terms of any of the licenses mentioned in (i), (ii) or (iii) (the "Applicable License"), you must comply with the terms of the Applicable License generally and the following provisions: (I) You must include a copy of, or the URI for, the Applicable License with every copy of each Adaptation You Distribute or Publicly Perform; (II) You may not offer or impose any terms on the Adaptation that restrict the terms of the Applicable License or the ability of the recipient of the Adaptation to exercise the rights granted to that recipient under the terms of the Applicable License; (III) You must keep intact all notices that refer to the Applicable License and to the disclaimer of warranties with every copy of the Work as included in the Adaptation You Distribute or Publicly Perform; (IV) when You Distribute or Publicly Perform the Adaptation, You may not impose any effective technological measures on the Adaptation that restrict the ability of a recipient of the Adaptation from You to exercise the rights granted to that recipient under the terms of the Applicable License. This Section 4(b) applies to the Adaptation as incorporated in a Collection, but this does not require the Collection apart from the Adaptation itself to be made subject to the terms of the Applicable License.+If You Distribute, or Publicly Perform the Work or any Adaptations or Collections, You must, unless a request has been made pursuant to Section 4(a), keep intact all copyright notices for the Work and provide, reasonable to the medium or means You are utilizing: (i) the name of the Original Author (or pseudonym, if applicable) if supplied, and/or if the Original Author and/or Licensor designate another party or parties (e.g., a sponsor institute, publishing entity, journal) for attribution ("Attribution Parties") in Licensor's copyright notice, terms of service or by other reasonable means, the name of such party or parties; (ii) the title of the Work if supplied; (iii) to the extent reasonably practicable, the URI, if any, that Licensor specifies to be associated with the Work, unless such URI does not refer to the copyright notice or licensing information for the Work; and (iv) , consistent with Ssection 3(b), in the case of an Adaptation, a credit identifying the use of the Work in the Adaptation (e.g., "French translation of the Work by Original Author," or "Screenplay based on original Work by Original Author"). The credit required by this Section 4(c) may be implemented in any reasonable manner; provided, however, that in the case of a Adaptation or Collection, at a minimum such credit will appear, if a credit for all contributing authors of the Adaptation or Collection appears, then as part of these credits and in a manner at least as prominent as the credits for the other contributing authors. For the avoidance of doubt, You may only use the credit required by this Section for the purpose of attribution in the manner set out above and, by exercising Your rights under this License, You may not implicitly or explicitly assert or imply any connection with, sponsorship or endorsement by the Original Author, Licensor and/or Attribution Parties, as appropriate, of You or Your use of the Work, without the separate, express prior written permission of the Original Author, Licensor and/or Attribution Parties.+Except as otherwise agreed in writing by the Licensor or as may be otherwise permitted by applicable law, if You Reproduce, Distribute or Publicly Perform the Work either by itself or as part of any Adaptations or Collections, You must not distort, mutilate, modify or take other derogatory action in relation to the Work which would be prejudicial to the Original Author's honor or reputation. Licensor agrees that in those jurisdictions (e.g. Japan), in which any exercise of the right granted in Section 3(b) of this License (the right to make Adaptations) would be deemed to be a distortion, mutilation, modification or other derogatory action prejudicial to the Original Author's honor and reputation, the Licensor will waive or not assert, as appropriate, this Section, to the fullest extent permitted by the applicable national law, to enable You to reasonably exercise Your right under Section 3(b) of this License (right to make Adaptations) but not otherwise.+5. Representations, Warranties and Disclaimer++UNLESS OTHERWISE MUTUALLY AGREED TO BY THE PARTIES IN WRITING, LICENSOR OFFERS THE WORK AS-IS AND MAKES NO REPRESENTATIONS OR WARRANTIES OF ANY KIND CONCERNING THE WORK, EXPRESS, IMPLIED, STATUTORY OR OTHERWISE, INCLUDING, WITHOUT LIMITATION, WARRANTIES OF TITLE, MERCHANTIBILITY, FITNESS FOR A PARTICULAR PURPOSE, NONINFRINGEMENT, OR THE ABSENCE OF LATENT OR OTHER DEFECTS, ACCURACY, OR THE PRESENCE OF ABSENCE OF ERRORS, WHETHER OR NOT DISCOVERABLE. SOME JURISDICTIONS DO NOT ALLOW THE EXCLUSION OF IMPLIED WARRANTIES, SO SUCH EXCLUSION MAY NOT APPLY TO YOU.++6. Limitation on Liability. EXCEPT TO THE EXTENT REQUIRED BY APPLICABLE LAW, IN NO EVENT WILL LICENSOR BE LIABLE TO YOU ON ANY LEGAL THEORY FOR ANY SPECIAL, INCIDENTAL, CONSEQUENTIAL, PUNITIVE OR EXEMPLARY DAMAGES ARISING OUT OF THIS LICENSE OR THE USE OF THE WORK, EVEN IF LICENSOR HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.++7. Termination++This License and the rights granted hereunder will terminate automatically upon any breach by You of the terms of this License. Individuals or entities who have received Adaptations or Collections from You under this License, however, will not have their licenses terminated provided such individuals or entities remain in full compliance with those licenses. Sections 1, 2, 5, 6, 7, and 8 will survive any termination of this License.+Subject to the above terms and conditions, the license granted here is perpetual (for the duration of the applicable copyright in the Work). Notwithstanding the above, Licensor reserves the right to release the Work under different license terms or to stop distributing the Work at any time; provided, however that any such election will not serve to withdraw this License (or any other license that has been, or is required to be, granted under the terms of this License), and this License will continue in full force and effect unless terminated as stated above.+8. Miscellaneous++Each time You Distribute or Publicly Perform the Work or a Collection, the Licensor offers to the recipient a license to the Work on the same terms and conditions as the license granted to You under this License.+Each time You Distribute or Publicly Perform an Adaptation, Licensor offers to the recipient a license to the original Work on the same terms and conditions as the license granted to You under this License.+If any provision of this License is invalid or unenforceable under applicable law, it shall not affect the validity or enforceability of the remainder of the terms of this License, and without further action by the parties to this agreement, such provision shall be reformed to the minimum extent necessary to make such provision valid and enforceable.+No term or provision of this License shall be deemed waived and no breach consented to unless such waiver or consent shall be in writing and signed by the party to be charged with such waiver or consent.+This License constitutes the entire agreement between the parties with respect to the Work licensed here. There are no understandings, agreements or representations with respect to the Work not specified here. Licensor shall not be bound by any additional provisions that may appear in any communication from You. This License may not be modified without the mutual written agreement of the Licensor and You.+The rights granted under, and the subject matter referenced, in this License were drafted utilizing the terminology of the Berne Convention for the Protection of Literary and Artistic Works (as amended on September 28, 1979), the Rome Convention of 1961, the WIPO Copyright Treaty of 1996, the WIPO Performances and Phonograms Treaty of 1996 and the Universal Copyright Convention (as revised on July 24, 1971). These rights and subject matter take effect in the relevant jurisdiction in which the License terms are sought to be enforced according to the corresponding provisions of the implementation of those treaty provisions in the applicable national law. If the standard suite of rights granted under applicable copyright law includes additional rights not granted under this License, such additional rights are deemed to be included in the License; this License is not intended to restrict the license of any rights under applicable law.

@@ -0,0 +1,40 @@++++module Lights(lighten) where++import Basics+import Vectors+import Data.List(minimumBy)+import Objects+import World+import Colors++lighten world material pos normal light = +    if doesLighten world normal pos light+       then lighten' world material pos normal light+       else blackColor++lighten' world Material{diffuse=diffuse}+       pos normal light@(DotLight lightPos lightColor) = result+    where dist2 = sqnorm (lightPos - pos)+	  coef = (lightPos - pos) `dotProd` normal / dist2 * 10+	  result = abs coef `weight` (diffuse * lightColor)++lighten' world Material{diffuse=diffuse} pos normal light@(DirLight lightDir lightColor) = result+    where coef = lightDir `dotProd` normal+	  result = abs coef `weight` (diffuse * lightColor)++	 +lighten' _ Material{diffuse=diffuse} pos normal (AmbientLight color) = color * diffuse++doesLighten world normal pos light@(DotLight lightPos lightColor) = +    all notHiding $ map (distance lightPos (normalized (pos-lightPos))) $ worldObjects world +    where notHiding x = x > norm (pos-lightPos) - eps++doesLighten world normal pos (AmbientLight _) = True+doesLighten world normal pos (DirLight dir _) = +    (rayDir `dotProd` normal) > 0 -- otherwise the surface is oriented to the light+     &&+    (all (== infinite) $ map (distance (pos + 0.1 `scale` rayDir) rayDir) $ worldObjects world)+    where rayDir = negate dir

@@ -0,0 +1,115 @@+++module Objects where++import Vectors+import Basics+import Data.List(sort)+import Debug.Trace++newtype ProtoObject = ProtoObject { fromProto :: Int -> Object }+data Object = Object !Int !Shape !Texture deriving Show++object sh tex = ProtoObject (\ id -> Object id sh tex)++--objectTexture (Object _ _ material) = material++data Shape +    = Sphere !Vector !Scal -- center, radius+    | Plane !Vector !Scal  -- normal, distance to origin+    | Quadric !Vector !Vector !Scal  -- center, director, const++{- Equation of (Quadric c d k) is (norm (x-c) == abs ( d `dotProd` (x-c)) + k)+let e = norm d, then+e = 0 => sphere+0 < e < 1 => ellipsoid+e = 1 => cylinder+e > 1 => hyperboloid (or cone, when k = 0)++-}+    | Meta ![MetaPoint] !Scal -- points, threshold+  deriving Show++data MetaPoint = MetaPoint !Vector !Scal -- center, strength+  deriving Show+++++eps :: Scal+eps = (1.0e-3)++distance src ray (Object id sh m) = distance' src ray sh+getNormal (Object id sh m) = getNormal' sh++distance' source ray (Sphere center rad) = solution+  -- we solve sq t - 2*b*t + * c = 0 (w.r.t. t)+    where b = ray `dotProd` (center - source)+	  c = sqnorm (center - source) - sq rad+	  d = b * b - c+	  solution+	      | d < 0.0 = infinite+	      | sol1 > 0 = sol1+	      | sol2 > 0 = sol2+	      | otherwise = infinite+	  sol1 = b - sqrt d+	  sol2 = b + sqrt d++distance' source ray (Plane norm dist) = solution+ where solution = if abs v1 > eps && ((v > 0.0) == (v1 > 0.0)) then v / v1 else infinite+       v1 = norm `dotProd` ray+       v = dist - norm `dotProd` source+++distance' source ray (Quadric center dir sqk0) = solution+    where +	  a = 1 - sq (ray .* dir)+	  b = ray .* ((c0 .* dir) `scale` dir - c0)+	  c = sqnorm c0 - sqk0 - sq (c0 .* dir)+	  d = b * b - a * c+	  sol1 = (b - sqrt d)/a+	  sol2 = (b + sqrt d)/a+	  sol = if a > 0 then sol1 else sol2+	  -- the good solution depends on the concavity/convexy of the curve+	  solution = if d >= 0 && sol > 0 then sol else infinite+  	  c0 = source - center++distance' source ray (Meta points threshold) = --trace ("Maxs = " ++ show maximums) $ +					       --trace ("Dens = " ++ show (map density maximums)) $ +                                               if ubound > 0 then solution else infinite+    where ubound = sum [(strength/(c-b*b)) | (b, c, strength) <- pointInfo] - threshold+	  pointInfo = [(ray .* (center - source),+			sqnorm (center - source) + 0.001,+			strength) |+		       MetaPoint center strength <- points]+	  +	  maximums = [b | (b, _, _) <- pointInfo, b > 0]+	  +	  density x = sum [(strength/(x*x-2*b*x+c)) | (b, c, strength) <- pointInfo] - threshold+	  forwardFindSolution (x0:x1:xs)+	      | density x1 > 0 = dichoFindSolution x0 x1+	      | otherwise = forwardFindSolution (x1:xs)+	  forwardFindSolution (x0:[]) = infinite+	  dichoFindSolution x0 x1 +	      | x1 - x0 < eps = mid+	      | density mid >  0 = dichoFindSolution x0  mid+	      | density mid <= 0 = dichoFindSolution mid x1+	      where mid = (x1 + x0) / 2+	  solution = forwardFindSolution (0:sort maximums)+	      +++sq x = x * x++getNormal' (Sphere center rad) hit = (1.0/rad) `scale` (hit - center)+getNormal' (Plane norm dist) hit = norm++getNormal' (Quadric center dir k) hit = normalized $ +      v - (c `scale` dir)+    where v = hit - center+	  c = dir `dotProd` v ++getNormal' (Meta points threshold) hit = +    normalized $ sum [ (strength / sq (sqnorm (hit-center))) `scale` +			(hit-center)+			| MetaPoint center strength <- points ]

@@ -0,0 +1,18 @@+module Ray where++import Scenes+import Basics+import Camera+import Vectors+import Trace+import Debug.Trace++--rt time = render (sceneCone) cam1  (pi/2) (pi/4) 400 200++rt time = Debug.Trace.trace (show $ animScene time) $+	  render (animScene time) cam1  (pi/2) (pi/4) 400 200+++--main = print $ testRT++--testRT = traceRay Scenes.scene1 (pi * 0.5) (pi * 0.5) 1 1

@@ -0,0 +1,111 @@++module Scenes where++import Basics+import Objects+import Vectors+import Camera +import World +import Anims+import Bitmaps+import Env+import System.IO.Unsafe+import Textures+import Colors+import Control.Applicative++-------------------+-- Colors++white = grayTint 1.0+blue = hue (-2*pi/3)+violet = hue (-pi/2)+magenta = hue (-pi/3)+red = hue 0+orange = hue (pi/6)+yellow = hue (pi/3)+green = hue (2*pi/3)+cyan = hue pi+black = rgb 0 0 0++----------------------+-- Textures+	  +mirror = const Material +	 {diffuse = blackColor,+	  materialReflection = whiteColor,+	  materialRefraction = blackColor,+	  materialRefrCoef = 0+	 }+	     +glass = const Material +	{diffuse = blackColor,  -- FIXME+	 materialReflection = grayTint 0.0,+	 materialRefraction = grayTint 1,+	 materialRefrCoef = 1.33+	}+++ivoryChess = project stdVertical $+	     checkboard (vec 15 15 15) (matte white) (matte black)++joelChess = project stdVertical $+	    checkboard (vec 15 15 15) (matte blue) (matte yellow)+++---------------------+-- Vectors++stdVertical = vec 0 1 0++origin = constVec 0++camloc = (vec 0 10 (-40))+camLook = origin ++lightloc = negate (vec 12 12 12)++cam1 = cameraLooks stdVertical camloc camLook+++++ellipsoid = Quadric origin (vec 0.5 0.5 0.5) (sq 7)+-- hyperboloid = Quadric origin (vec 0 1.2 0) (sq 7) +-- hyperboloid' = Quadric origin (vec 0 1.2 0) (negate $ sq 7) +-- cylinder = Quadric origin (vec 0 1 0) (sq 7) +++aQuad :: Anim Shape+aQuad = pure $ Quadric (vec 0 0 0) (vec 1.2 0 0) (sq 7)+++aPoint1 = MetaPoint <$> (liss (pure (vec 10 10 10)) (pure (vec 1 2 3)) (pure (vec 0 0 0))) <*> pure 2+aPoint2 = MetaPoint <$> (liss (pure (vec 10 10 10)) (pure (vec 1 2 3)) (pure (vec 1 1 1))) <*> pure 2+aPoint3 = MetaPoint <$> (liss (pure (vec 10 10 10)) (pure (vec 1 2 3)) (pure (vec 2 2 2))) <*> pure 2+++aM = aMeta [aPoint1, aPoint2, aPoint3] (pure 0.1)++animScene :: Anim World+animScene = world <$>+            sequ [+	     -- object <$> (Sphere <$> (orbit (const stdVertical) (pure vec 5 10 0) ) <*> pure 7) <*> pure mirror,+             -- object <$> aM <*> pure (matte blue),+             object <$> (Quadric origin <$> (orbit (pure $ vec 0 1 0) (pure $ vec 0.5 0.5 0.5)) <*> pure (sq 7)) <*> pure glass,+             -- object <$> (Quadric origin <$> (vec <$> pure 0 <*> (subtract 2 <$> ask) <*> pure 0) <*> pure (sq 7)) <*> pure (matte green),+             object <$> (Plane <$> pure (vec 0 1 0) <*> pure (-15)) <*> pure ivoryChess+            ] +            <*> pure [DirLight (normalized (vec 0 (-3) 0)) (grayTint 0.8),+                      AmbientLight (grayTint 0.15)+                     ] +            <*> pure env+    where orb = orbit (const stdVertical) (pure vec 15 10 0)++env = rainbowEnv +--env = skyBitmapEnv skyBitmap++++skyBitmap = unsafePerformIO $ loadBitmap "ciel.tif"+

@@ -0,0 +1,4 @@+#!/usr/bin/env runhaskell+import Distribution.Simple+main :: IO ()+main = defaultMain

@@ -0,0 +1,29 @@++module Textures where++import Basics+import Data.Bits( (.&.), xor )+import Colors(blackColor)++matte :: Color -> Texture+matte col = const Material +	    {diffuse = col,+	     materialReflection = blackColor,+	     materialRefraction = blackColor,+	     materialRefrCoef = 0+	    }+  +checkboard :: Vector -> Texture -> Texture -> Texture+-- mix two texture in a chequer board fashion++checkboard unit m1 m2 v = if d .&. 1 == 0 then m1 v else m2 v+    where d = floor x `xor` floor y `xor` floor z +	  d :: Int+	  Vector x y z = v `rowProd` invUnit+	  invUnit = liftV (1/) unit+	 ++project :: Vector -> Texture -> Texture+-- project a given texture on a plane (axis .* x = 0)+project axis t x = t x0+    where x0 = x - (axis .* x) `scale` axis

@@ -0,0 +1,74 @@+module Trace where++import Basics+import Objects+import Lights+import Colors+import Data.List(delete, minimumBy)+import World+import Debug.Trace+import Env++maxLevel = 4++minIntensity = 0.01++switchInside objectId insideList =+    if objectId `elem` insideList+       then delete objectId insideList+       else objectId : insideList++traceRay level world from dir insideList refrCoef = color+    where (hitDist, hitObject) = +	      minimumBy compFst distances+	  distances = [(distance from dir obj, obj) | obj <- worldObjects world]+	  color = if hitDist == infinite +		    then envColor+		    else objectColor+	  envColor = worldEnv world $ dir+	  objectColor = diffuseColor +  +			if level < maxLevel+			   then reflectionCol + refractionCol+			   else blackColor++	  (objectRefl, objectRefr) = +	      if critic > 0+		 then (materialReflection hitMaterial, materialRefraction hitMaterial)+		 else (materialReflection hitMaterial + materialRefraction hitMaterial, 0)++          hitMaterial = hitTexture hit++          reflectionCol = objectRefl <*> traceRay (level+1) world+			  (hit+reflectionDir) reflectionDir insideList+                          refrCoef+	  refractionCol = objectRefr <*> traceRay (level+1) world+			  (hit+refractionDir) refractionDir (switchInside hitId insideList)+			  (materialRefrCoef hitMaterial)+  +          col1 <*> col2 = if intensity col1 > minIntensity+			    then col1 * col2+			    else blackColor++          ratio = refrCoef / (materialRefrCoef hitMaterial)++	  hit = hitDist `scale` dir + from+	  ci = normal .* dir+	  critic = 1 + sq ratio * (sq ci - 1) -- 1 / sq ratio + sq ci - 1++	  reflectionDir = dir - (2 * ci) `scale` normal +	  refractionDir = ratio `scale` dir - (ratio * ci - sqrt critic) `scale` normal+             	          -- ratio `scale` (dir - (ci - sqrt critic) `scale` normal)+	  normal' = getNormal hitObject hit++	  normal = if normal' `dotProd` dir < 0 then negate normal' else normal'++	  Object hitId hitShape hitTexture = hitObject++	  diffuseColor = sum $+			 map (lighten world hitMaterial hit normal') $+			 worldLights world +	  +	  ++    +compFst (x, _) (y, _) = compare x y

@@ -0,0 +1,98 @@+module Vectors where++infix 7 `scale`+infix 7 `mulVec`++infinite :: Scal +infinite = 1.0e20++type Scal = Float --Int++data Vector +    = Vector +      {-# UNPACK #-}!Scal +      {-# UNPACK #-}!Scal+      {-# UNPACK #-}!Scal deriving Eq++instance Show Vector where+  show (Vector x y z) = show (x,y,z)++data Matrix +    = Matrix +      {-# UNPACK #-}!Scal +      {-# UNPACK #-}!Scal+      {-# UNPACK #-}!Scal +      {-# UNPACK #-}!Scal+      {-# UNPACK #-}!Scal +      {-# UNPACK #-}!Scal+      {-# UNPACK #-}!Scal +      {-# UNPACK #-}!Scal+      {-# UNPACK #-}!Scal++norm = sqrt . sqnorm++sqnorm (Vector x y z) = x*x+y*y+z*z++normalized v = scale (1.0 / norm v) v++scale f (Vector x y z) = Vector (x*f) (y*f) (z*f)+++cross (Vector vx vy vz) (Vector ux uy uz) = +    Vector+    (vy * uz - vz * uy)+    (vz * ux - vx * uz)+    (vx * uy - vy * ux)++constVec c  = Vector c c c+liftV op (Vector vx vy vz) = Vector (op vx) (op vy) (op vz)+liftV2 op (Vector vx vy vz) (Vector ux uy uz) = Vector (vx`op`ux) (vy`op`uy) (vz`op`uz)++dotProd (Vector vx vy vz) (Vector ux uy uz) =+    vx*ux + vy*uy + vz*uz++(.*) = dotProd++rowProd = liftV2 (*)++instance Num Vector where+    (+) = liftV2 (+)+    (-) = liftV2 (-)+    (*) = cross+    fromInteger i = constVec $ fromInteger i+    signum = liftV signum+    negate = liftV negate+    abs = liftV abs++vec = Vector++rotateMatrix theta axis@(Vector a b c) = Matrix+-- rotates "th" radians around axis "ax"+-- !!! axis must be normalized !!!+					 +   (a*a*oct+ct)   (a*b*oct-c*st) (a*c*oct+b*st)+   (b*a*oct+c*st) (b*b*oct+ct)   (b*c*oct-a*st)+   (c*a*oct-b*st) (c*b*oct+a*st) (c*c*oct+ct)+      where ct = cos theta+ 	    st = sin theta+ 	    oct = 1.0 - ct+++transpose (Matrix+	   m11 m12 m13+	   m21 m22 m23+	   m31 m32 m33) = +	  (Matrix+	   m11 m21 m31+	   m21 m22 m32+	   m13 m23 m33)+++mulVec (Matrix+	   m11 m12 m13+	   m21 m22 m23+	   m31 m32 m33) (Vector x y z) =+  Vector +  (m11*x + m12*y + m13*z)+  (m21*x + m22*y + m23*z)+  (m31*x + m32*y + m33*z)

@@ -0,0 +1,14 @@++module World where++import Objects+import Basics+import Env++data World = World {worldObjects :: [Object],+		    worldLights :: [Light],+		    worldEnv :: Env} deriving Show+                       +                       +world :: [ProtoObject] -> [Light] -> Env -> World                                              +world os = World (zipWith ($) (map fromProto os) [1..]) 

@@ -0,0 +1,25 @@+name:           jort+version:        1.0.0+category:       Graphics+synopsis:       JP's own ray tracer+description:+  A real-time raytracer in Haskell. No kidding.+  (Vintage: my first Haskell project)+license:        OtherLicense+-- CC attribution share alike+license-file:   LICENSE+author:         Jean-Philippe Bernardy+maintainer:     jeanphilippe.bernardy@gmail.com+Cabal-Version:  >= 1.8+tested-with:    GHC==6.12.1+build-type:     Simple++executable jort+  extensions: FlexibleInstances+  main-is: Drawing.hs+  ghc-options: -O2 -fexcess-precision+  build-depends: base==4.*,+                 array==0.3.*,+                 gtk==0.11.*+  +  other-modules:  Basics Colors Textures Camera Lights Objects Ray Scenes Trace Vectors World Anims Env Bitmaps Drawing Bench