From f6efe98181b5691035f5b771160791c2d9c17e8b Mon Sep 17 00:00:00 2001
From: jgk <justin.g.kruger@gmail.com>
Date: Fri, 19 Feb 2021 12:41:46 +0100
Subject: [PATCH] Refactor vao preload

---
 app/Main.hs               |   7 +-
 package.yaml              |   1 +
 src/Dodge/Base.hs         |  14 ++-
 src/Dodge/Critters.hs     |   3 +-
 src/Dodge/Data.hs         |   1 +
 src/Dodge/LevelGen.hs     |   2 +-
 src/Dodge/Rendering.hs    |  42 ++++---
 src/Dodge/Update.hs       |  11 +-
 src/Dodge/Weapons.hs      | 135 ++++++++++----------
 src/Dodge/WorldActions.hs |  74 +++++------
 src/Loop.hs               |   4 +-
 src/Picture.hs            | 122 +++---------------
 src/Picture/Data.hs       |  81 +-----------
 src/Picture/Preload.hs    | 149 ++++++++++++++--------
 src/Picture/Render.hs     | 256 +++++++++++++++++++++-----------------
 src/Shaders.hs            |  24 ++++
 16 files changed, 441 insertions(+), 485 deletions(-)

diff --git a/app/Main.hs b/app/Main.hs
index 61c8d3a85..71226c776 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -15,6 +15,7 @@ import Dodge.LoadSound
 import Dodge.Update
 import Dodge.KeyEvents
 import Dodge.Rendering
+import Dodge.Menu
 
 import Picture
 import Picture.Render
@@ -50,8 +51,8 @@ main = do
         (initializeWorld $ generateFromTree lev1 $ initWorld)
         (-- \((bs:fs:ts:_),tes) w -> --do render setparams w egFade
          \preData w -> --do render setparams w egFade
-                      --renderPicture' preData (polygon [(0,0),(0,-0.5),(-0.5,-0.5),(-0.5,0.0)])
-                      renderPicture' preData (draw blank w)
+                      renderPicture' preData (_cameraZoom w) (_windowX w,_windowY w) (draw blank w)
+                      --renderPicture' preData (_windowX w,_windowY w) (Circle 5)
 --            renderPicture' preData 
 --                          (pictures [scale 0.5 0.9 $ polygon [(0,0),(0,-0.5),(-0.5,-0.5),(-0.5,0.0)]
 --                                    ,scale 0.5 0.9 $ polygon [(0,0),(0,-0.5),(-0.5,-0.5),(-0.5,0.0)]
@@ -59,6 +60,6 @@ main = do
 --                                    ]
 --                          )
         )
-        handleEvent
+        (flip $ menuEvents $ flip handleEvent)
         (\w -> Just $ update w)
     Mix.closeAudio
diff --git a/package.yaml b/package.yaml
index fda169021..301d34146 100644
--- a/package.yaml
+++ b/package.yaml
@@ -41,6 +41,7 @@ dependencies:
 - dlist
 - deepseq
 - transformers
+- foldl
 
 library:
   source-dirs: src
diff --git a/src/Dodge/Base.hs b/src/Dodge/Base.hs
index bbaf43959..b8a66b3cd 100644
--- a/src/Dodge/Base.hs
+++ b/src/Dodge/Base.hs
@@ -422,6 +422,18 @@ lineOfThickness t = pictures . f
           f _        = []
           n a b      = (t*0.5) *.* errorNormalizeV 42 (vNormal (a -.- b))
 
+lineGeom :: Float -> Point2 -> Point2 -> [Point2]
+lineGeom t x y
+    | x == y    = []
+    | otherwise = [x +.+ n x y, x -.- n x y, y +.+ n x y, y -.- n x y]
+    where n a b      = (t*0.5) *.* errorNormalizeV 4200 (vNormal (a -.- b))
+
+wedgeGeom :: Float -> Point2 -> Point2 -> [Point2]
+wedgeGeom t x y 
+    | x == y    = []
+    | otherwise = [x +.+ n x y, x -.- n x y, y]
+    where n a b      = (t*0.5) *.* errorNormalizeV 4200 (vNormal (a -.- b))
+
 wedgeOfThickness :: Float -> Point2 -> Point2 -> Picture
 wedgeOfThickness t x y 
     | x == y    = blank
@@ -701,7 +713,7 @@ onLayer l = setDepth (fromIntegral (levLayer l) / 100)
 --onLayer l p = [(p, [levLayer l])]
 
 onLayerL :: [Int] -> Picture -> Picture
-onLayerL is = setDepth (sum $ zipWith (/) (map fromIntegral is) $ map (\x->100**x) [1..])
+onLayerL is = setDepth ((sum $ zipWith (/) (map fromIntegral is) $ map (\x->100**x) [1..]))
 
 levLayer :: Layer -> Int
 levLayer BgLayer            = 20
diff --git a/src/Dodge/Critters.hs b/src/Dodge/Critters.hs
index 614c83a5c..36a6e2041 100644
--- a/src/Dodge/Critters.hs
+++ b/src/Dodge/Critters.hs
@@ -342,7 +342,7 @@ goalPict cr = let r = _crRad cr in case _crState cr of
                         (SubPathTo p i _:_) -> dGoals $ sizeColEnemy r blue
                         (Search i:_) -> dGoals $ sizeColEnemy r black
                         _ -> dGoals $ sizeColEnemy r magenta
-                    where dGoals p = pictures [p, rotate (radToDeg (_crDir cr)) $ scale 0.1 0.1 $ color white $ text $ show gls]
+                    where dGoals p = pictures [p, rotate (0 - _crDir cr) $ scale 0.1 0.1 $ color white $ text $ show gls]
     _                  -> sizeColEnemy r (light $ dim green)
 
 startCr :: Creature
@@ -395,5 +395,4 @@ basicCrPict col cr = pictures [ onLayer CrLayer naked , drawEquipment cr]
                 -- | crDam > _crHP cr && odd (crDam - _crHP cr)
                 --     = [color white $ circleSolid $ _crRad cr]
                 | otherwise        =  pictures [color col $ circleSolid $ _crRad cr, circLine $ _crRad cr]
---                                     , rotate (radToDeg $ _crDir cr) $ scale 0.2 0.2 $ color white $ text $ show $ _crPos cr
           pdam = _crPastDamage $ _crState cr
diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs
index f76886b62..950de7564 100644
--- a/src/Dodge/Data.hs
+++ b/src/Dodge/Data.hs
@@ -242,6 +242,7 @@ data MenuState
     | PauseMenu
     | GameOverMenu
     | InGame
+    deriving (Eq,Ord)
 
 data Sound = Sound { _soundTime :: Int
                    , _soundFadeTime :: Int
diff --git a/src/Dodge/LevelGen.hs b/src/Dodge/LevelGen.hs
index 602f8d7f0..090b731d8 100644
--- a/src/Dodge/LevelGen.hs
+++ b/src/Dodge/LevelGen.hs
@@ -750,7 +750,7 @@ placeLS ls dec p rot w = over lightSources addLS
                                 (ls {_lsPos = p,_lsDir = rot,_lsID = newKey lss}) 
                                 lss
           addDec decs = IM.insert (newKey decs) 
-                                  (uncurry translate p $ rotate (radToDeg rot) dec)
+                                  (uncurry translate p $ rotate (0 - rot) dec)
                                   decs
 
 
diff --git a/src/Dodge/Rendering.hs b/src/Dodge/Rendering.hs
index c5bd6d1cd..ee0e28afb 100644
--- a/src/Dodge/Rendering.hs
+++ b/src/Dodge/Rendering.hs
@@ -51,7 +51,7 @@ draw'' b w-- | (Char 'm') `S.member` _keys w
     = case _mapDisplay w of
          (True, z) -> (blank
                       ,pictures [color white $ circleSolid 3
-                                ,scale z z $ rotate (radToDeg (_cameraRot w))
+                                ,scale z z $ rotate (0 - (_cameraRot w))
                                     $ uncurry translate ((0,0) -.- _cameraCenter w) 
                                     $ pictures $ mapMaybe mapWall $ IM.elems $ _walls w]
                        ) 
@@ -68,7 +68,7 @@ draw'' b w-- | (Char 'm') `S.member` _keys w
                       x2 = (x''+1)
                       y1 = (y''-1)
                       y2 = (y''+1)
-          screenShift = scale zoom zoom . rotate (radToDeg (_cameraRot w) )
+          screenShift = scale zoom zoom . rotate (0 - (_cameraRot w) )
                                             . uncurry translate ((0,0) -.- _cameraPos w)
           zoom = _cameraZoom w
           pathsTest = map drawPair $ _pathGraph' w
@@ -100,7 +100,7 @@ collectDrawings w = pictures
              ]
 --                                <> [onLayer GloomLayer $ theLighting w]
     where
-          screenShift = scale zoom zoom . rotate (radToDeg (_cameraRot w) )
+          screenShift = scale zoom zoom . rotate (0 - (_cameraRot w) )
                                             . uncurry translate ((0,0) -.- _cameraPos w)
           zoom     = _cameraZoom w
           decPicts      = IM.elems $ _decorations w
@@ -127,12 +127,13 @@ collectDrawings w = pictures
           menuScreen = case _menuState w of
                         InGame -> blank 
                         LevelMenu x -> 
-                            pictures [color (withAlpha 0.5 black) $ polygon $ screenBox w
-                            ,tst (-100) 100 0.4 ("LEVEL "++show x)
+                            pictures [--color (withAlpha 0.5 black) $ polygon $ screenBox w
+                            tst (-100) 100 0.4 ("LEVEL "++show x)
                             ,controlsList
                             ]
-                        PauseMenu   -> pictures [color (withAlpha 0.5 black) $ polygon $ screenBox w
-                                    ,tst (-100) 100 0.4 "PAUSED"
+                        PauseMenu   -> pictures 
+                                    [--color (withAlpha 0.5 black) $ polygon $ screenBox w
+                                    tst (-100) 100 0.4 "PAUSED"
                                     ,tst (-100) 50 0.2 "n - new level"
                                     ,tst (-100) 0 0.2 "r - restart"
                                     , controlsList
@@ -157,11 +158,11 @@ hudDrawings w = (onLayer InvLayer)
     where itCol = fromMaybe (greyN 0.5) . (^? itInvColor)
 
 crDraw :: Creature -> Drawing
-crDraw c = uncurry translate (_crPos c) $ rotateRad (_crDir c) (_crPict c c)
+crDraw c = uncurry translate (_crPos c) $ rotate (_crDir c) (_crPict c c)
 ppDraw :: PressPlate -> Drawing
-ppDraw c = uncurry translate (_ppPos c) $ rotateRad (_ppRot c) (_ppPict c)
+ppDraw c = uncurry translate (_ppPos c) $ rotate (_ppRot c) (_ppPict c)
 btDraw :: Button -> Drawing
-btDraw c = uncurry translate (_btPos c) $ rotateRad (_btRot c) (_btPict c)
+btDraw c = uncurry translate (_btPos c) $ rotate (_btRot c) (_btPict c)
 
 clDraw :: Cloud -> Drawing
 clDraw c = uncurry translate (_clPos c) $ (_clPict c c)
@@ -171,6 +172,7 @@ drawCursor w = translate (105-halfWidth w)
                          (halfHeight w - (25* (fromIntegral iPos)) - 20
                          )
                 -- $ rectangleWire 200 25
+                 $ color white
                  $ line [(200,12.5),(-100,12.5),(-100,-12.5),(200,-12.5)]
     where iPos = _crInvSel $ _creatures w IM.! _yourID w
 
@@ -242,7 +244,7 @@ drawSmokeShadow w sm@(Smoke {_smPos = p, _smRad = r', _smColor = c, _smPs = ps,
         pb p' = p' -.- orth p'
         pao p' = pa p' +.+ l *.* safeNormalizeV (pa p' -.- _cameraCenter w)
         pbo p' = pb p' +.+ l *.* safeNormalizeV (pb p' -.- _cameraCenter w)
-        semiCirc p' = uncurry translate p' $ rotate (radToDeg (a p')) $ arcSolid 0 180 r
+        semiCirc p' = uncurry translate p' $ rotate (0 - (a p')) $ arcSolid 0 180 r
         a p' = pi - argV (orth p')
         trap p' = polygon [pa p', pb p', pbo p', pao p']
         f p' = [semiCirc p', trap p']
@@ -256,7 +258,7 @@ drawSmokeShadow w sm@(Smoke {_smPos = p, _smRad = r', _smColor = c, _smPs = ps,
         pao' p' = pa' p' +.+ l *.* safeNormalizeV (pa' p' -.- _cameraCenter w)
         pbo' p' = pb' p' +.+ l *.* safeNormalizeV (pb' p' -.- _cameraCenter w)
         trap' p' = line [pa' p', pb' p', pbo' p', pao' p',pa' p']
-        semiCirc' p' = uncurry translate p' $ rotate (radToDeg (a p')) $ arcSolid 0 180 r'
+        semiCirc' p' = uncurry translate p' $ rotate (0 - (a p')) $ arcSolid 0 180 r'
         
 
 drawWall :: Wall -> Drawing
@@ -283,7 +285,7 @@ printPoint p = color white $ uncurry translate p $ pictures [circle 3 ,scale 0.0
 
 printRotPoint :: Float -> Point2 -> Picture
 printRotPoint r p = color white $ uncurry translate p $ pictures [circle 3 
-                                                              , rotate r $ scale 0.1 0.1 $ text (show p)]
+                                                              , rotate (0 - r) $ scale 0.1 0.1 $ text (show p)]
 
 outsideScreenPolygon :: World -> [Point2]
 outsideScreenPolygon w = [tr,tl,bl,br]
@@ -390,42 +392,42 @@ drawButText :: World -> Button -> Picture
 drawButText w bt | magV (_crPos (you w) -.- _btPos bt) < 100
                         && hasLOS (_btPos bt) (_crPos (you w)) w
                         && _btState bt /= BtNoLabel
-                                = t $ rotate (radToDeg (-_cameraRot w))
+                                = t $ rotate (_cameraRot w)
                                     $ pictures $ [ scLine [(-8,10),(-15,10),(-15,-10),(-8,-10)]
                                                  , scLine [( 8,10),( 15,10),( 15,-10),( 8,-10)]
                                                  ,translate (-15) (-10*sqrt zoom - 5) $ dShadCol white 
                                                  $ scale 0.1 0.1 $ text $ _btText bt
                                                  ]
                  | otherwise = blank
-    where t = rotate (radToDeg (_cameraRot w)) . uncurry translate (zoom *.* (_btPos bt -.- _cameraPos w))
+    where t = rotate (0 - (_cameraRot w)) . uncurry translate (zoom *.* (_btPos bt -.- _cameraPos w))
           zoom = _cameraZoom w
           scLine = dShadCol white . line . fmap (sqrt zoom *.*)
 
 drawPPText :: World -> PressPlate -> Picture
 drawPPText w pp | magV (_crPos (you w) -.- _ppPos pp) < 100
                         && hasLOS (_ppPos pp) (_crPos (you w)) w
-                                = t $ rotate (radToDeg (-_cameraRot w))
+                                = t $ rotate (_cameraRot w)
                                     $ pictures $ [ scLine [(-8,10),(-15,10),(-15,-10),(-8,-10)]
                                                  , scLine [( 8,10),( 15,10),( 15,-10),( 8,-10)]
                                                  ,translate (-15) (-10*sqrt zoom - 5) $ dShadCol white 
                                                  $ scale 0.1 0.1 $ text $ _ppText pp
                                                  ]
                     | otherwise = blank
-    where t = rotate (radToDeg (_cameraRot w)) . uncurry translate (zoom *.* (_ppPos pp -.- _cameraPos w))
+    where t = rotate (0 - (_cameraRot w)) . uncurry translate (zoom *.* (_ppPos pp -.- _cameraPos w))
           zoom = _cameraZoom w
           scLine = dShadCol white . line . fmap (sqrt zoom *.*)
 
 drawItemName :: World -> FloorItem -> Picture
 drawItemName w flIt | magV (_crPos (you w) -.- _flItPos flIt) < 100
                         && hasLOS (_flItPos flIt) (_crPos (you w)) w
-                                = t $ rotate (radToDeg (-_cameraRot w))
+                                = t $ rotate (_cameraRot w)
                                     $ pictures $ [ scLine [(-8,10),(-15,10),(-15,-10),(-8,-10)]
                                                  , scLine [( 8,10),( 15,10),( 15,-10),( 8,-10)]
                                                  ,translate (-15) (-10*sqrt zoom - 5) $ dShadCol white 
                                                  $ scale 0.1 0.1 $ text $ nameOfItem
                                                  ]
                     | otherwise = blank
-    where t = rotate (radToDeg (_cameraRot w)) . uncurry translate (zoom *.* (_flItPos flIt -.- _cameraPos w))
+    where t = rotate (0 - (_cameraRot w)) . uncurry translate (zoom *.* (_flItPos flIt -.- _cameraPos w))
           nameOfItem = case flIt of FlIt {} -> _itName $ _flIt flIt
                                     FlAm {_flAm = PistolBullet} -> "Bullets"
                                     FlAm {_flAm = LiquidFuel} -> "Liquid Fuel"
@@ -472,7 +474,7 @@ drawFF (FF {_ffLine = l, _ffColor = col}) = pictures [color white $ line l, colo
 drawFFShadow :: World -> ForceField -> [Picture]
 drawFFShadow w ff
     | youOnFF   = []
-    | otherwise = map (rotate (radToDeg (- _cameraRot w)) . pane)
+    | otherwise = map (rotate ( _cameraRot w) . pane)
                       [0,0.05..0.25]
     where p = rotateV (-_cameraRot w) $ ypShift
           x = rotateV (-_cameraRot w) x'
diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs
index 88483c315..574c68266 100644
--- a/src/Dodge/Update.hs
+++ b/src/Dodge/Update.hs
@@ -22,7 +22,10 @@ import Control.Lens
 -- }}}
 
 update :: World -> World
-update w = let w1 = updateParticles' $ updateParticles 
+update w 
+    | _menuState w /= InGame = w
+    | otherwise = 
+            let w1 = updateParticles' $ updateParticles 
                      $ updateLightSources
                      $ zoneClouds
                      $ updateClouds
@@ -31,16 +34,16 @@ update w = let w1 = updateParticles' $ updateParticles
                      $ updateBlocks -- $ zoning 
                      $ updateSeenWalls 
                                                      w
-               w2 = -- updateWeaponCounters $
+                w2 = -- updateWeaponCounters $
                  simpleCrSprings 
                  $ zoneCreatures $ wallEvents
                  $ set worldEvents id $ _worldEvents w1
                                  w1
-               w3 = updateCamera
+                w3 = updateCamera
                            $ updateAfterParticles'
                            $ colCrsWalls 
                              w2
-           in  checkEndGame $ ppEvents w3
+            in  checkEndGame $ ppEvents w3
     where -- zoning w = set wallsZone (IM.foldr wallInZone IM.empty (_walls w))
           --               w
           -- wallInZone wl | dist (_wlLine wl !! 0) (_wlLine wl !! 1) <= 2*zoneSize 
diff --git a/src/Dodge/Weapons.hs b/src/Dodge/Weapons.hs
index faead2d37..c532ca69b 100644
--- a/src/Dodge/Weapons.hs
+++ b/src/Dodge/Weapons.hs
@@ -45,7 +45,7 @@ pistol,lasGun,tractorGun,launcher,autoGun
     ,longGun,flamer,blinkGun,forceFieldGun :: Item
 
 pistol = Weapon 
-    { _itName = "pistol"
+    { _itName = "PISTOL"
     , _itIdentity = Pistol
     , _wpMaxAmmo = 15
     , _wpLoadedAmmo = 15
@@ -101,7 +101,7 @@ autoEffectGun name eff = autoGun
     }
 
 autoGun = defaultGun 
-    { _itName = "autoGun .........."
+    { _itName = "AUTOGUN AUTO"
     , _itIdentity = AutoGun
     , _wpMaxAmmo = 30
     , _wpLoadedAmmo = 30
@@ -142,12 +142,12 @@ incMode :: Int -> World -> World
 incMode _ w 
     = case newMode of
         0 -> w & creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itMode .~ 0
-               & creatures . ix 0 . crInv . ix itRef . itName .~ "autoGun .........."
+               & creatures . ix 0 . crInv . ix itRef . itName .~ "AUTOGUN AUTO"
                & creatures . ix 0 . crInv . ix itRef . itHammer .~ NoHammer
                & creatures . ix 0 . crInv . ix itRef . itEffect .~ NoItEffect
                & creatures . ix 0 . crInv . ix itRef . wpFire .~ autoFireMode
         1 -> w & creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itMode .~ 1
-               & creatures . ix 0 . crInv . ix itRef . itName .~ "autoGun ."
+               & creatures . ix 0 . crInv . ix itRef . itName .~ "AUTOGUN SINGLE"
                & creatures . ix 0 . crInv . ix itRef . itHammer .~ HammerUp
                & creatures . ix 0 . crInv . ix itRef . itEffect .~ wpRecock
                & creatures . ix 0 . crInv . ix itRef . wpFire .~ singleFireMode
@@ -157,17 +157,17 @@ incMode _ w
           f x = mod (x+1) 2
 decMode :: Int -> World -> World
 decMode _ w = w & creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itMode %~ f
-                & creatures . ix 0 . crInv . ix itRef . itName .~ "autoGun" ++ g newMode
+                & creatures . ix 0 . crInv . ix itRef . itName .~ "AUTOGUN" ++ g newMode
     where itRef = fromMaybe (-2) $ w ^? creatures . ix 0 . crInvSel
           oldMode = w ^? creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itMode
           newMode = fromMaybe 1 $ fmap f oldMode
           f x = mod (x-1) 2
-          g 1 = " ."
-          g 2 = " ..."
-          g 0 = " .........."
+          g 1 = " SINGLE"
+          g 2 = " BURST"
+          g 0 = " AUTO"
 
 rezGun = defaultGun
-    { _itName = "reanimator"
+    { _itName = "REANIMATOR"
     , _wpMaxAmmo = 50
     , _wpLoadedAmmo = 50
     , _wpAmmoType = Battery
@@ -191,7 +191,7 @@ rezGun = defaultGun
                                             ]
     }
 teslaGun = autoGun 
-    { _itName = "teslaGun"
+    { _itName = "TESLAGUN"
     , _itIdentity = TeslaGun
     , _wpMaxAmmo = 200
     , _wpLoadedAmmo = 200
@@ -217,7 +217,7 @@ teslaGun = autoGun
                                             ]
     }
 lasGun = autoGun 
-    { _itName = "lasGun ////"
+    { _itName = "LASGUN ////"
     , _itIdentity = LasGun
     , _wpMaxAmmo = 200
     , _wpLoadedAmmo = 200
@@ -241,7 +241,7 @@ lasGun = autoGun
     }
 incPhaseV :: Int -> World -> World
 incPhaseV _ w = w & creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itPhaseV %~ f
-                  & creatures . ix 0 . crInv . ix itRef . itName .~ "lasGun" ++ g newPhaseV
+                  & creatures . ix 0 . crInv . ix itRef . itName .~ "LASGUN" ++ g newPhaseV
     where itRef = fromMaybe (-2) $ w ^? creatures . ix 0 . crInvSel
           oldPhaseV = w ^? creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itPhaseV
           newPhaseV = fromMaybe 1 $ fmap f oldPhaseV
@@ -257,7 +257,7 @@ incPhaseV _ w = w & creatures . ix 0 . crInv . ix itRef . itAttachment . _Just .
           g 5 = " \\\\//"
 decPhaseV :: Int -> World -> World
 decPhaseV _ w = w & creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itPhaseV %~ f
-                  & creatures . ix 0 . crInv . ix itRef . itName .~ "lasGun" ++ g newPhaseV
+                  & creatures . ix 0 . crInv . ix itRef . itName .~ "LASGUN" ++ g newPhaseV
     where itRef = fromMaybe (-2) $ w ^? creatures . ix 0 . crInvSel
           oldPhaseV = w ^? creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itPhaseV
           newPhaseV = fromMaybe 1 $ fmap f oldPhaseV
@@ -272,7 +272,7 @@ decPhaseV _ w = w & creatures . ix 0 . crInv . ix itRef . itAttachment . _Just .
           g 2 = " \\///"
           g 5 = " \\\\//"
 forceFieldGun = defaultGun 
-    { _itName = "forceField"
+    { _itName = "FORCEFIELD"
     , _itIdentity = ForceFieldGun
     , _wpMaxAmmo = 100
     , _wpLoadedAmmo = 100
@@ -311,7 +311,7 @@ forceFieldGun = defaultGun
 --     , _itAimingRange = 0.5
 --     }
 tractorGun = autoGun 
-    { _itName = "tractorGun"
+    { _itName = "TRACTORGUN"
     , _itIdentity = TractorGun
     , _wpMaxAmmo = 10000
     , _wpLoadedAmmo = 10000
@@ -331,7 +331,7 @@ tractorGun = autoGun
     , _itEquipPict = drawWeapon $ color blue $ pictures [polygon $ rectNESW 1.5 6 (-1.5) 0 ]
     }
 launcher = defaultGun 
-    { _itName = "launcher"
+    { _itName = "lAUNCHER"
     , _itIdentity = Launcher
     , _wpMaxAmmo = 30
     , _wpLoadedAmmo = 30
@@ -353,7 +353,7 @@ launcher = defaultGun
     , _itEffect = NoItEffect
     }
 remoteLauncher = defaultGun 
-    { _itName = "remoteLauncher"
+    { _itName = "REMOTELAUNCHER"
     , _itIdentity = RemoteLauncher
     , _wpMaxAmmo = 1
     , _wpLoadedAmmo = 1
@@ -374,7 +374,7 @@ remoteLauncher = defaultGun
     , _itAttachment = Just $ ItScope (0,0) 0 1 True
     }
 hvAutoGun = autoGun 
-    { _itName = "hvMachineGun"
+    { _itName = "HVMACHINEGUN"
     , _itIdentity = HvAutoGun
     , _wpMaxAmmo = 100
     , _wpLoadedAmmo = 100
@@ -401,7 +401,7 @@ hvAutoGun = autoGun
                                         hvBulHitCr' hvBulHitWall' bulHitFF'
                             
 ltAutoGun = autoGun 
-    { _itName = "autoPistol"
+    { _itName = "AUTOPISTOL"
     , _itIdentity = LtAutoGun
     , _wpMaxAmmo = 25
     , _wpLoadedAmmo = 25
@@ -426,7 +426,7 @@ ltAutoGun = autoGun
                                                          ]    
     }
 miniGun = autoGun 
-    { _itName = "miniGun"
+    { _itName = "MINIGUN"
     , _itIdentity = MiniGun
     , _wpMaxAmmo = 150
     , _wpLoadedAmmo = 150
@@ -447,7 +447,7 @@ miniGun = autoGun
     , _itEquipPict = drawWeapon $ color red $ polygon $ rectNESW 9 5 (-9) (-5)
     }
 spreadGun = defaultGun 
-    { _itName = "spreadgun"
+    { _itName = "SPREADGUN"
     , _itIdentity = SpreadGun
     , _wpMaxAmmo = 5
     , _wpLoadedAmmo = 5
@@ -491,7 +491,7 @@ spreadGun = defaultGun
 --     , _itAimingRange = 0.5
 --     }
 multGun = defaultGun 
-    { _itName = "multGun"
+    { _itName = "MULTGUN"
     , _itIdentity = MultGun
     , _wpMaxAmmo = 2
     , _wpLoadedAmmo = 2
@@ -522,7 +522,7 @@ multGun = defaultGun
                                            , polygon [(-1.5,12),(-2,12),(-2,-12),(-1.5,-12)]
                                            ]
 longGun = defaultGun 
-    { _itName = "elephantGun"
+    { _itName = "ELEPHANTGUN"
     , _itIdentity = LongGun
     , _wpMaxAmmo = 1
     , _wpLoadedAmmo = 1
@@ -563,7 +563,7 @@ startZoomOutLongGun  _ w = w & creatures . ix 0 . crInv . ix (_crInvSel (_creatu
 
 
 poisonSprayer = autoGun 
-    { _itName = "poisonSprayer"
+    { _itName = "POISONSPRAYER"
     , _itIdentity = PoisonSprayer
     , _wpMaxAmmo = 500
     , _wpLoadedAmmo = 500
@@ -585,7 +585,7 @@ poisonSprayer = autoGun
     }
 
 flamer = autoGun 
-    { _itName = "flamethrower"
+    { _itName = "FLAMETHROWER"
     , _itIdentity = Flamethrower
     , _wpMaxAmmo = 250
     , _wpLoadedAmmo = 250
@@ -609,7 +609,7 @@ flamer = autoGun
     , _itAttachment = Nothing
     }
 blinkGun = defaultGun 
-    { _itName = "blinker"
+    { _itName = "BLINKER"
     , _itIdentity = Blinker
     , _wpMaxAmmo = 100
     , _wpLoadedAmmo = 100
@@ -804,11 +804,11 @@ moveShell time i cid rot accel w
                                             (moveShell (time-1) i cid rot (rotateV rot accel))
                                   $ over (particles . ix i . ptVel) (\v -> accel +.+ frict *.* v)
                                   $ soundFrom (ShellSound i) (fromIntegral smokeTrailSound) (1) 250
-                                  $ smokeGen
                                   $ makeFlameletTimed oldPos 
                                         (0.5 *.* rotateV (pi+sparkD) accel) (levLayer UPtLayer) Nothing 3 20
                                   $ makeFlameletTimed (0.5 *.* (newPos +.+ oldPos)) 
                                         (0.5 *.* rotateV (pi+sparkD) accel) (levLayer UPtLayer) Nothing 3 20
+                                  $ smokeGen
                                     w
     | time > -200 = case thingHit of
                        Just p  -> shellExplosionAt oldPos 
@@ -829,9 +829,9 @@ moveShell time i cid rot accel w
               (frict,g)    = randomR (0.6,0.9) $ _randGen w
               (sparkD,_) = randomR (-0.5,0.5) $ _randGen w
               dir      = argV $ vel
-              pic      = onLayer PtLayer $ uncurry translate newPos $ rotate (-radToDeg (argV accel)) shellPic
+              pic      = onLayer PtLayer $ uncurry translate newPos $ rotate (argV accel) shellPic
               piclow   = onLayerL [levLayer CrLayer - 2] 
-                                  $ uncurry translate newPos $ rotate (-radToDeg (argV accel)) shellPic
+                                  $ uncurry translate newPos $ rotate (argV accel) shellPic
               hitCr    = fmap fst $ collideCircCrsPoint oldPos newPos 4 w
               hitWl    = fmap fst $ collideCircWalls' oldPos newPos 2 $ wallsNearPoint newPos w
               thingHit = hitCr <|> hitWl
@@ -1018,24 +1018,24 @@ moveFlame rotd w pt =
                 damcr cr p = over (creatures . ix (_crID cr) . crState . crDamage) 
                                   ((:) $ Flaming (div time 10) sp p ep)
                 hiteff = _btHitEffect' pt pt
-                thepic p' = pictures [ pic p' , piu p' , pi2 p' , glow p' ]
+                thepic p' = pictures $ reverse [ pic p' , piu p' , pi2 p' , glow p' ]
                 pic p' = onLayerL [levLayer UPtLayer,6] $ uncurry translate (prot3 p')
-                                              $ rotate (90 + (negate $ radToDeg $ argV rotd))
+                                              $ rotate (pi * 0.5 + argV rotd)
                                               $ scale scaleChange 1
                                              -- $ color white
                                              -- $ circleSolid 5
-                                              $ pictures [color white $ circleSolid 4
+                                              $ pictures $ reverse [color white $ circleSolid 4
                                                          ,color (withAlpha 0.5 white) $ circleSolid 5
                                                          ]
                                             --  $ rotate (radToDeg (fromIntegral time * 10))
                                             --  $ polygon [(-5,-2),(5,-2),(5,2),(-5,2)]
                 pi2 p' = onLayerL [levLayer UPtLayer,4] $ uncurry translate (prot p')
                             --    $ rotate ( (fromIntegral time * 5))
-                                              $ rotate (90 + (negate $ radToDeg $ argV rotd))
+                                              $ rotate (pi * 0.5 + argV rotd)
                                               -- $ color (mixColors 0.5 0.5 orange white)
                                               -- $ polygon [(-6,-6),(6,-6),(6,6),(-6,6)]
                                               $ scale (scaleChange + 0.5) 1.5
-                                              $ pictures [color orange $ circleSolid 4.5
+                                              $ pictures $ reverse [color orange $ circleSolid 4.5
                                                          ,color (withAlpha 0.5 orange) $ circleSolid 5
                                                          ]
                                               -- $ color orange
@@ -1044,10 +1044,10 @@ moveFlame rotd w pt =
                 prot2 p' = p' +.+ rotateV (negate $ fromIntegral time * 1) (0,1)
                 prot3 p' = p' +.+ rotateV (2 + fromIntegral time * 0.1) (0,2)
                 piu p' = onLayerL [levLayer UPtLayer,2] $ uncurry translate (prot2 p')
-                                              $ rotate (90 + (negate $ radToDeg $ argV rotd))
+                                              $ rotate (pi*0.5 + argV rotd)
                                             -- $ rotate ((fromIntegral time * (-10)))
                                               $ scale (scaleChange + 1) 2
-                                              $ pictures [color red $ circleSolid 4.5
+                                              $ pictures $ reverse [color red $ circleSolid 4.5
                                                          ,color (withAlpha 0.5 red) $ circleSolid 5
                                                          ]
                                              -- $ color (dark red)
@@ -1697,7 +1697,7 @@ grenadeLauncher = pistol
 
 grenade,remoteBomb :: Item
 grenade = Throwable
-    { _itName = "grenade " ++ show fuseTime
+    { _itName = "GRENADE " ++ show fuseTime
     , _itIdentity = Grenade
     , _itMaxStack = 8
     , _itAmount = 1
@@ -1724,7 +1724,7 @@ increaseFuse :: Int -> Int -> World -> World
 increaseFuse fuse i w = w & creatures . ix 0 . crInv . ix itRef . itScrollUp .~ decreaseFuse newTime
                           & creatures . ix 0 . crInv . ix itRef . itScrollDown .~ increaseFuse newTime
                           & creatures . ix 0 . crInv . ix itRef . twFire .~ throwGrenade newTime
-                          & creatures . ix 0 . crInv . ix itRef . itName .~ "grenade " ++ show newTime
+                          & creatures . ix 0 . crInv . ix itRef . itName .~ "GRENADE " ++ show newTime
                           & creatures . ix 0 . crInv . ix itRef . itAttachment .~ Just (ItFuse newTime)
                           & creatures . ix 0 . crInv . ix itRef . itZoom 
                                 .~ (basicItZoom {_itAimZoomMax = zm, _itAimZoomMin = zm})
@@ -1736,7 +1736,7 @@ decreaseFuse :: Int -> Int -> World -> World
 decreaseFuse fuse i w = w & creatures . ix 0 . crInv . ix itRef . itScrollUp .~ decreaseFuse newTime
                           & creatures . ix 0 . crInv . ix itRef . itScrollDown .~ increaseFuse newTime
                           & creatures . ix 0 . crInv . ix itRef . twFire .~ throwGrenade newTime
-                          & creatures . ix 0 . crInv . ix itRef . itName .~ "grenade " ++ show newTime
+                          & creatures . ix 0 . crInv . ix itRef . itName .~ "GRENADE " ++ show newTime
                           & creatures . ix 0 . crInv . ix itRef . itAttachment .~ Just (ItFuse newTime)
                           & creatures . ix 0 . crInv . ix itRef . itZoom 
                                 .~ (basicItZoom {_itAimZoomMax = zm, _itAimZoomMin = zm})
@@ -1746,7 +1746,7 @@ decreaseFuse fuse i w = w & creatures . ix 0 . crInv . ix itRef . itScrollUp .~
 
 defaultThrowable = grenade
 remoteBomb = defaultThrowable
-    { _itName = "remoteBomb"
+    { _itName = "REMOTEBOMB"
     , _itIdentity = RemoteBomb
     , _itMaxStack = 1
     , _itAmount = 1
@@ -1783,7 +1783,7 @@ throwGrenade fuseTime n w = setWp $ removePict $ over particles addG $ set randG
           p' = _crPos cr +.+ rotateV (_crDir cr) (_crRad cr,0)
           p | circOnSomeWall p' 4 w = _crPos cr +.+ rotateV (_crDir cr) (_crRad cr-4,0)
             | otherwise             = p'
-          dir = negate $ radToDeg $ argV $ v 
+          dir = argV v 
           setWp :: World -> World
           setWp w' = w' & creatures . ix n . crInv . ix j . itEffect .~ throwArmReset 20
           --maybewpid = w ^? creatures . ix n . crInv . ix j . itID . _Just
@@ -1814,7 +1814,7 @@ grenadePic x = pictures [ color (dark $ dark green) $ circleSolid 5
                                             ((179 * fromIntegral x / 50) - 180 ) 
                                             (180 - (179 * fromIntegral x / 50) ) 
                                             5
-                        , translate (-2) 2 $ rotate 90 
+                        , translate (-2) 2 $ rotate (pi*0.5) 
                             $ scale 0.05 0.05 $ color green $ text $ show $ 1 + quot x 20 
                         ]
 
@@ -1838,7 +1838,7 @@ fireRemoteLauncher cid w = setLocation $ resetFire $ resetName
         newitid = newKey $ _itemPositions w
         maybeitid = w ^? creatures . ix cid . crInv . ix j . itID . _Just
         resetFire = set (creatures . ix cid . crInv . ix j . wpFire) $ explodeRemoteRocket itid i
-        resetName = set (creatures . ix cid . crInv . ix j . itName) "remoteRocket"
+        resetName = set (creatures . ix cid . crInv . ix j . itName) "REMOTEROCKET"
         setLocation :: World -> World
         setLocation w' = case maybeitid of
                           Nothing -> w' & creatures . ix cid . crInv . ix j . itID .~ Just newitid
@@ -1910,9 +1910,9 @@ moveRemoteShell time i cid itid dir w
               (sparkD,_) = randomR (-0.5,0.5) $ _randGen w
               dir      = argV $ vel
               pic      = onLayer PtLayer $ uncurry translate newPos 
-                                         $ rotate (-radToDeg (argV accel)) $ remoteShellPic time
+                                         $ rotate (argV accel) $ remoteShellPic time
               piclow   = onLayerL [levLayer CrLayer - 2] 
-                                  $ uncurry translate newPos $ rotate (-radToDeg (argV accel)) 
+                                  $ uncurry translate newPos $ rotate (argV accel)
                                     $ remoteShellPic time
               hitCr    = fmap fst $ collideCircCrsPoint oldPos newPos 4 w
               hitWl    = fmap fst $ collideCircWalls' oldPos newPos 2 $ wallsNearPoint newPos w
@@ -1924,8 +1924,9 @@ moveRemoteShell time i cid itid dir w
               (s1:s2:s3:_) = map (\s -> fromIntegral s * 0.1 - 1) (t3:t2:t1:[])
               -- ((r1:r2:r3:_),_) = runState ((sequence . repeat . randInCirc)  10) $ _randGen w
               -- v1 = fst $ runState (randInCirc 0.5) $ _randGen w
-              smokeGen =  makeSmokeAt'' v1 s1 t1 (newPos +.+ r1)
-                                   . makeSmokeAt'' v2 s2 t2 (newPos +.+ r2)
+              smokeGen =  makeSmokeAt'' v2 s2 t2 (newPos +.+ r2)
+                          . makeSmokeAt'' v1 s1 t1 (newPos +.+ r1)
+                                   
                            --        . makeSmokeAt'' v3 s3 t3 (newPos +.+ r3)
               doExplosion = explodeRemoteRocket itid i cid
               setScope w' = case _itemPositions w' IM.! itid of
@@ -1943,7 +1944,7 @@ explodeRemoteRocket itid ptid n w
 --        $ resetScope
         $ makeExplosionAt (_ptPos (_particles w IM.! ptid)) w
         -- $ makeShrapnelBombAt (_ptPos (_particles w IM.! ptid)) w
-    where resetName = set (itPoint . itName) "remoteLauncher"
+    where resetName = set (itPoint . itName) "REMOTELAUNCHER"
 --          resetScope = creatures . ix n . crInv . ix j . itScope . _Just . scopePos .~ (0,0)
           itPoint = pointToItem $ _itemPositions w IM.! itid
 
@@ -1968,7 +1969,7 @@ throwRemoteBomb n w = setLocation $ removePict $ resetFire
           v | magV v' > 6 = 6 *.* normalizeV v'
           -- zoom = 1 / _cameraZoom w
           j = _crInvSel $ _creatures w IM.! n
-          resetName = set (creatures . ix n . crInv . ix j . itName) "remote"
+          resetName = set (creatures . ix n . crInv . ix j . itName) "REMOTE"
           removePict = set (creatures . ix n . crInv . ix j . itEquipPict) $ \ _ _ -> blank
           resetFire = set (creatures . ix n . crInv . ix j . twFire) $ explodeRemoteBomb itid i
           cr = _creatures w IM.! n
@@ -1995,19 +1996,19 @@ explodeRemoteBomb itid ptid n w
 --        $ resetScope
         $ makeExplosionAt (_ptPos (_particles w IM.! ptid)) w
         -- $ makeShrapnelBombAt (_ptPos (_particles w IM.! ptid)) w
-    where resetName = set (creatures . ix n . crInv . ix j . itName) "remoteBomb"
+    where resetName = set (creatures . ix n . crInv . ix j . itName) "REMOTEBOMB"
           resetPict = set (creatures . ix n . crInv . ix j . itEquipPict ) 
                           (drawWeapon $ remoteBombUnarmedPic)
 --          resetScope = creatures . ix n . crInv . ix j . itScope . _Just . scopePos .~ (0,0)
           j = _crInvSel $ _creatures w IM.! n
 remoteBombPic :: Int -> Picture
 remoteBombPic x = pictures [ color (dark $ dark orange) $ circleSolid 5
-                         , rotate (fromIntegral x * 10 + 45) $ color red $ arc  0 90 5
-                         , rotate (fromIntegral x * 10 + 45) $ color (withAlpha 0.05 red) 
+                         , rotate (0 - degToRad (fromIntegral x * 10 + 45)) $ color red $ arc  0 90 5
+                         , rotate (0 - degToRad (fromIntegral x * 10 + 45)) $ color (withAlpha 0.05 red) 
                                                              $ arcSolid 0 90 50
-                         , rotate (fromIntegral x * 10 + 20) $ color (withAlpha 0.05 red) 
+                         , rotate (0 - degToRad (fromIntegral x * 10 + 20)) $ color (withAlpha 0.05 red) 
                                                              $ arcSolid 0 40 40
-                         , rotate (fromIntegral x * 10 + 10) $ color (withAlpha 0.05 red) 
+                         , rotate (0 - degToRad (fromIntegral x * 10 + 10)) $ color (withAlpha 0.05 red) 
                                                              $ arcSolid 0 20 20
                          ]
 remoteBombUnarmedPic :: Picture
@@ -2027,7 +2028,7 @@ drawWeapon p cr posInInv
 medkit :: Int -> Item
 medkit i = basicConsumable
     { _itIdentity = Medkit25
-    , _itName = "medkit" ++ show i
+    , _itName = "MEDKIT" ++ show i
     , _itMaxStack = 9
     , _itAmount = 1
     , _cnEffect = heal i
@@ -2328,7 +2329,7 @@ autogunSpread = 0.07
 medkit25,pipe,magShield :: Item
 medkit25 = basicConsumable
     { _itIdentity = Medkit25
-    , _itName = "medkit25"
+    , _itName = "MEDKIT25"
     , _itMaxStack = 3
     , _itAmount = 2
     , _cnEffect = heal25
@@ -2337,7 +2338,7 @@ medkit25 = basicConsumable
     }
 pipe = Craftable
     { _itIdentity = Generic
-    , _itName = "pipe"
+    , _itName = "PIPE"
     , _itMaxStack = 3
     , _itAmount = 3
     , _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)]
@@ -2348,7 +2349,7 @@ pipe = Craftable
     }
 magShield = basicEquipment
     { _itIdentity = MagShield
-    , _itName = "magshield"
+    , _itName = "MAGSHIELD"
     , _itMaxStack = 1
     , _itAmount = 1
     , _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)]
@@ -2357,7 +2358,7 @@ magShield = basicEquipment
     }
 flameShield = basicEquipment
     { _itIdentity = FlameShield
-    , _itName = "flameShield"
+    , _itName = "FLAMESHIELD"
     , _itMaxStack = 1
     , _itAmount = 1
     , _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)]
@@ -2368,7 +2369,7 @@ flameShield = basicEquipment
     }
 frontArmour = basicEquipment
     { _itIdentity = FrontArmour
-    , _itName = "frontArmour"
+    , _itName = "FRONTARMOUR"
     , _itMaxStack = 1
     , _itAmount = 1
     , _itFloorPict = onLayer FlItLayer $ translate 0 (-5) $ pictures [color (greyN 0.1) $ thickArc 0 90 10 5
@@ -2384,7 +2385,7 @@ frontArmour = basicEquipment
     }
 jetPack = basicEquipment
     { _itIdentity = JetPack
-    , _itName = "JetPack"
+    , _itName = "JETPACK"
     , _itMaxStack = 1
     , _itAmount = 1
     , _itFloorPict = onLayer FlItLayer $ color yellow $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)]
@@ -2399,11 +2400,11 @@ jetPack = basicEquipment
 latchkey :: Int -> Item
 latchkey n = basicEquipment
     { _itIdentity = Generic
-    , _itName = "key "++show n
+    , _itName = "KEY "++show n
     , _itMaxStack = 1
     , _itAmount = 1
     , _itFloorPict = onLayer FlItLayer $ latchkeyPic
-    , _itEquipPict = \cr _ -> onLayer PtLayer $ translate (-5) (-5) $ rotate 50 latchkeyPic
+    , _itEquipPict = \cr _ -> onLayer PtLayer $ translate (-5) (-5) $ rotate (pi/2.5) latchkeyPic
     , _itEffect = NoItEffect
     , _itHammer = HammerUp
     , _itID = Nothing
@@ -2549,7 +2550,7 @@ shakeCr cID amount w =
 
 
 radar = defaultGun 
-    { _itName = "radar"
+    { _itName = "RADAR"
     , _itIdentity = Generic
     , _wpMaxAmmo = 100
     , _wpLoadedAmmo = 100
@@ -2571,7 +2572,7 @@ radar = defaultGun
     }
 
 sonar = defaultGun 
-    { _itName = "sonar"
+    { _itName = "SONAR"
     , _itIdentity = Generic
     , _wpMaxAmmo = 100
     , _wpLoadedAmmo = 100
@@ -2678,7 +2679,7 @@ mvRadar x p w pt = (putBlips w, Just $ pt {_ptPict' = pic
 
 autoSonar = basicEquipment
     { _itIdentity = Generic
-    , _itName = "autoSonar"
+    , _itName = "AUTOSONAR"
     , _itMaxStack = 1
     , _itAmount = 1
     , _itFloorPict = onLayer FlItLayer $ color yellow $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)]
@@ -2691,7 +2692,7 @@ autoSonar = basicEquipment
     }
 autoRadar = basicEquipment
     { _itIdentity = Generic
-    , _itName = "autoRadar"
+    , _itName = "AUTORADAR"
     , _itMaxStack = 1
     , _itAmount = 1
     , _itFloorPict = onLayer FlItLayer $ color yellow $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)]
diff --git a/src/Dodge/WorldActions.hs b/src/Dodge/WorldActions.hs
index 7ad2145f1..405219baf 100644
--- a/src/Dodge/WorldActions.hs
+++ b/src/Dodge/WorldActions.hs
@@ -482,10 +482,9 @@ crGlareWidth wdth col alphay p cr =
                                 )
         }
     where l x = uncurry translate x
-                $ rotate (90 - (radToDeg $ argV (p -.- x)))
+                $ rotate (pi*0.5 + argV (p -.- x))
                 $ color (withAlpha alphay col) 
                 $ thickArc 0 180 (_crRad cr) wdth
---    where l = rotate (radToDeg $ argV (cp -.- p)) $ uncurry translate cp $ color (withAlpha 0.5 white) $ thickArc 0 25 (_crRad cr) 5
           cp = _crPos cr
           cid = _crID cr
           upp cid' w' = case w' ^? creatures . ix cid . crPos of
@@ -597,38 +596,37 @@ mvGenBullet' w bt
         t       = _btTimer' bt
 
 bulLine :: Color -> Float -> [Point2] -> Drawing
-bulLine col width (a:b:[]) 
+bulLine _ _ [] = blank
+bulLine _ _ (x:[]) = blank
+bulLine col width (a:b:[]) -- (a:b:[]) 
     = onLayer HPtLayer $ pictures 
-        [color (withAlpha 0.5 col) $ lineOfThickness (width+1.5) [a,b]
-        ,color white $ wedgeOfThickness width a b
---        ,color white $ lineOfThickness width [a,b]
---        ,color (withAlpha 0.3 white) $ lineOfThickness width [a3,b]
---        ,color (withAlpha 0.7 white) $ lineOfThickness width [a2,a3]
+        [polygonCol $ zip (wedgeGeom width b a) $ [white,withAlpha 0 white,withAlpha 0 white]
+        ,polygonCol $ zip (lineGeom (width+1.5) a b) $ [col,col,withAlpha 0 col,withAlpha 0 col]
         ]
---    where a2 = (0.7 *.* a) +.+ (0.3 *.* b)
---          a3 = (0.3 *.* a) +.+ (0.7 *.* b)
-bulLine col width (a:b:c:_) 
+bulLine col width (a:b:c:[]) -- (a:b:[]) 
     = onLayer HPtLayer $ pictures 
-        [color (withAlpha 0.5 col) $ lineOfThickness (width+1.5) [a,c]
-        ,color white $ wedgeOfThickness width a c
---        ,color white $ lineOfThickness width [a,b]
---        ,color (withAlpha 0.3 white) $ lineOfThickness (width-1) [a3,c]
---        ,color (withAlpha 0.7 white) $ lineOfThickness width [a2,a3]
---        ,color white                 $ lineOfThickness width [a,a2]
+        [polygonCol $ zip (wedgeGeom width b a) $ repeat white
+        ,polygonCol $ zip (wedgeGeom width b c) $ [white,white,withAlpha 0 white]
+        ,polygonCol $ zip (lineGeom (width+1.5) a c) $ [col,col,withAlpha 0 col,withAlpha 0 col]
         ]
---    where a2 = b
---          a3 = (0.5 *.* b) +.+ (0.5 *.* c)
---    where a2 = (0.7 *.* a) +.+ (0.3 *.* b)
---          a3 = (0.3 *.* a) +.+ (0.7 *.* b)
---bulLine col width (a:b:c:d:_) 
+bulLine col width (a:b:_:c:[]) -- (a:b:[]) 
+    = onLayer HPtLayer $ pictures 
+        [polygonCol $ zip (wedgeGeom width b a) $ repeat white
+        ,polygonCol $ zip (wedgeGeom width b c) $ [white,white,withAlpha 0 white]
+        ,polygonCol $ zip (lineGeom (width+1.5) a c) $ [col,col,withAlpha 0 col,withAlpha 0 col]
+        ]
+bulLine col width (a:b:_:_:c:_) -- (a:b:[]) 
+    = onLayer HPtLayer $ pictures 
+        [polygonCol $ zip (wedgeGeom width b a) $ repeat white
+        ,polygonCol $ zip (wedgeGeom width b c) $ [white,white,withAlpha 0 white]
+        ,polygonCol $ zip (lineGeom (width+1.5) a c) $ [col,col,withAlpha 0 col,withAlpha 0 col]
+        ]
+--        [color (withAlpha 0.5 col) $ lineOfThickness (width+1.5) [a,b]
+--        ,color white $ wedgeOfThickness width a b
+--bulLine col width (a:b:c:_) 
 --    = onLayer HPtLayer $ pictures 
---                [color (withAlpha 0.5 col) $ lineOfThickness (width+1) [a,c]
---        ,color (withAlpha 0.3 white) $ lineOfThickness width [a3,b]
---        ,color (withAlpha 0.7 white) $ lineOfThickness width [a2,a3]
---        ,color white                 $ lineOfThickness width [a,a2]
---        ]
---    where a2 = (0.7 *.* a) +.+ (0.3 *.* b)
---          a3 = (0.3 *.* a) +.+ (0.7 *.* b)
+--        [color (withAlpha 0.5 col) $ lineOfThickness (width+1.5) [a,c]
+--        ,color white $ wedgeOfThickness width a c
 
 thingsHitExceptCr :: Maybe Int -> Point2 -> Point2 -> World 
                         -> [(Point2, (Either3 Creature Wall ForceField))]
@@ -735,11 +733,11 @@ moveFlamelet levelInt rot w pt =
                               $ color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time) 
                                                  white                           (dark red)
                                       )
-                              $ rotate (radToDeg ( 0.1 * fromIntegral time + rot))
+                              $ rotate (0 - ( 0.1 * fromIntegral time + rot))
                               $ scale sc sc
                               $ polygon [(-size,-size),(size,-size),(size,size),(-size,size)]
                 piu = onLayerL [levelInt,1] $  uncurry translate ep 
-                           $ color (dark red) $ rotate (radToDeg (rot - 0.1 * fromIntegral time))
+                           $ color (dark red) $ rotate (0 - (rot - 0.1 * fromIntegral time))
                            $ scale s1 s1
                            $ polygon $ rectNSWE (siz2) (-siz2) (-siz2) (siz2)
                 glow = onLayerL [levelInt,0] $ uncurry translate ep
@@ -753,7 +751,7 @@ moveFlamelet levelInt rot w pt =
                            $ color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time) 
                                               orange                          (dark red)
                                       )
-                           $ rotate (radToDeg $ rot + 0.2 * fromIntegral time)
+                           $ rotate (0 - (rot + 0.2 * fromIntegral time))
                            $ scale s2 s2
                            $ polygon $ rectNSWE (siz2) (-siz2) (-siz2) (siz2)
                 
@@ -822,7 +820,8 @@ moveSmoke' scal p time i
 makeSmokeAt'' :: Point2 -> Float -> Int -> Point2 -> World -> World
 makeSmokeAt'' vel scal time p w = over particles' ((:) smokeP) w
     where smokeP = Particle'
-                     { _ptPict' = onLayerL [levLayer PtLayer - 1] $ uncurry translate p $ color black $ circleSolid 1
+                     --{ _ptPict' = onLayerL [levLayer PtLayer - 1] $ uncurry translate p $ color black $ circleSolid 1
+                     { _ptPict' = onLayerL [levLayer PtLayer ] $ uncurry translate p $ color black $ circleSolid 1
                      , _ptUpdate' = moveSmoke'' scal time p vel
                      }
 
@@ -836,15 +835,18 @@ moveSmoke'' scal time p vel w pt
                                  })
     | otherwise  = (w, Nothing)
     where pNew = p +.+ vel
-          pic = onLayerL [levLayer PtLayer - 1] 
+          pic = onLayerL [levLayer PtLayer] 
+          --pic = onLayerL [levLayer PtLayer - 1] 
                     $ uncurry translate pNew 
                     $ color (greyN 0.5) $ circleSolid $ (21 - fromIntegral time) * scal
-          pi1 = pictures 
+          pi1 = pictures $ reverse
                   [(onLayerL [levLayer PtLayer]
                     $ uncurry translate pNew 
                     $ color (withAlpha (0.3 * (1 + fromIntegral time /50)) (greyN 0.5)) 
                     $ circleSolid $ 21 * scal)
-                  , (onLayerL [levLayer BgLayer+1]
+                    , 
+                    --(onLayerL [levLayer BgLayer+1]
+                    (onLayerL [levLayer PtLayer]
                     $ uncurry translate pNew 
                     $ color (withAlpha (1 + fromIntegral time /50) (greyN 0.5)) 
                     $ circleSolid $ 21 * scal)
diff --git a/src/Loop.hs b/src/Loop.hs
index c5dc64f5c..6c2a4186d 100644
--- a/src/Loop.hs
+++ b/src/Loop.hs
@@ -41,9 +41,11 @@ setupLoop wName xSize ySize
                  (\_ -> bracket customInit initCleanup $ \setup -> do --  setup <- customInit
 --                            swapInterval $= ImmediateUpdates
                             GL.blend $= GL.Enabled
+                            GL.depthMask $= GL.Enabled
                             GL.blendEquation $= GL.FuncAdd
                             GL.blendFunc $= (GL.SrcAlpha,GL.OneMinusSrcAlpha)
-                            GL.clearColor $= GL.Color4 0 0.5 0 0
+                            GL.clearColor $= GL.Color4 0 0.5 0 1
+                            GL.clearDepth $= (200)
                             doLoop setup window startWorld
                                    sideEffects eventFn worldFn
                  )
diff --git a/src/Picture.hs b/src/Picture.hs
index d320661c2..043a94ce0 100644
--- a/src/Picture.hs
+++ b/src/Picture.hs
@@ -3,6 +3,7 @@
 module Picture
     ( module Picture.Data
     , polygon
+    , polygonCol
     , arc
     , arcSolid
     , thickArc
@@ -14,7 +15,6 @@ module Picture
     , pictures
     , translate
     , rotate
-    , rotateRad
     , scale
     , color
     , withAlpha
@@ -71,6 +71,10 @@ polygon :: [Point2] -> Picture
 {-# INLINE polygon #-}
 polygon = Polygon
 
+polygonCol :: [(Point2,RGBA)] -> Picture
+{-# INLINE polygonCol #-}
+polygonCol = PolygonCol
+
 --polygon :: [Point2] -> Picture
 --{-# INLINE polygon #-}
 --polygon (a:b:c:ps) = NLeaf $ emptyScene
@@ -81,40 +85,18 @@ polygon = Polygon
 --          tris = toVC $ concatMap (\(x,y)-> [a,x,y]) twoPs
 --polygon _ = blank
 
-color' :: RGBA -> Scene -> Scene
-{-# INLINE color' #-}
-color' c pic@(Scene {_scColTri = colTri,_scColChar= colChar}) =
-    pic {_scColTri  = mapVC (const c) colTri
-        ,_scColChar = mapVC (const c) colChar
-        }
 color :: RGBA -> Picture -> Picture
 {-# INLINE color #-}
 color c pic = Color c pic
 
-overPos :: (Point3 -> Point3) -> Scene -> Scene
-{-# INLINE overPos #-}
-overPos f pic@(Scene {_scPosTri = posTri,_scPosChar= posChar}) =
-    pic {_scPosTri  = mapVC f posTri
-        ,_scPosChar = mapVC f posChar
-        }
-
 translate3 :: Float -> Float -> Point3 -> Point3
 {-# INLINE translate3 #-}
 translate3 a b (x,y,z) = (x+a,y+b,z)
 
-translate' :: Float -> Float -> Scene -> Scene
-{-# INLINE translate' #-}
---translate x y = over scPosTri (mapVC $ translate3 x y) . over scPosChar (mapVC $ translate3 x y)
-translate' x y = overPos $ translate3 x y
-
 translate :: Float -> Float -> Picture -> Picture
 {-# INLINE translate #-}
 translate x y pic = Translate x y pic
 
-setDepth' :: Float -> Scene -> Scene
-{-# INLINE setDepth' #-}
-setDepth' d = overPos $ \(x,y,z) -> (x,y,d)
-
 setDepth :: Float -> Picture -> Picture
 {-# INLINE setDepth #-}
 setDepth d pic = SetDepth d pic
@@ -123,11 +105,6 @@ scale3 :: Float -> Float -> Point3 -> Point3
 {-# INLINE scale3 #-}
 scale3 a b (x,y,z) = (x*a,y*b,z)
 
-scale' :: Float -> Float -> Scene -> Scene
-{-# INLINE scale' #-}
---scale x y = over scPosTri (mapVC $ scale3 x y) . over scPosChar (mapVC $ scale3 x y)
-scale' x y pic = overPos (scale3 x y) $ over scTexChar (fmap (second (*x))) pic
-
 scale :: Float -> Float -> Picture -> Picture
 {-# INLINE scale #-}
 scale x y pic = Scale x y pic
@@ -137,28 +114,11 @@ rotate3 :: Float -> Point3 -> Point3
 rotate3 a (x,y,z) = (x',y',z)
     where (x',y') = rotateV a (x,y)
 
-rotate' :: Float -> Scene -> Scene
-{-# INLINE rotate' #-}
-rotate' a = overPos $ rotate3 $ 0 - degToRad a
-
---rotate :: Float -> Picture -> Picture
---{-# INLINE rotate #-}
---rotate a pic = NBranch (rotate' a) pic
---
-----  -- this rotation uses radians, and is anticlockwise
---rotateRad' :: Float -> Scene -> Scene
---{-# INLINE rotateRad' #-}
---rotateRad' a = overPos $ rotate3 a
---
---rotateRad :: Float -> Picture -> Picture
---{-# INLINE rotateRad #-}
---rotateRad a pic = NBranch (rotateRad' a) pic
-
-rotate a = rotateRad (0 - degToRad a)
+rotate = Rotate
 {-# INLINE rotate #-}
 
-rotateRad a = Rotate a
-{-# INLINE rotateRad #-}
+--rotateRad a = Rotate a
+--{-# INLINE rotateRad #-}
 
 pictures :: [Picture] -> Picture
 {-# INLINE pictures #-}
@@ -171,72 +131,32 @@ makeArc rad (a,b) = zipWith rotateV as $ repeat (0,rad)
     where as = [a,a+step.. b]
           step = pi * 0.2
 
---circleSolidD :: Float -> Float -> Picture
---circleSolidD d r = polygonD d $ makeArc r (0,2*pi)
-
 circleSolid :: Float -> Picture
 {-# INLINE circleSolid #-}
-circleSolid rad = polygon $ makeArc rad (0,2*pi)
+--circleSolid rad = polygon $ makeArc rad (0,2*pi)
+circleSolid = Circle
 
 circle :: Float -> Picture
 {-# INLINE circle #-}
 circle rad = line $ makeArc rad (0,2*pi)
 
---text :: String -> Picture
---text s = zipWith (\x -> overVs $ first $ translate3 x 0) 
---                 [0,0.25..]
---                 $ map charToShape s
-
 text :: String -> Picture
 {-# INLINE text #-}
 text = Text
 
-----text :: String -> Picture
-----{-# INLINE text #-}
-----text s = pictures $  zipWith (\x -> translate x (0-dimText)) 
-----                           [0,0.9*dimText..] 
-----                           (map charToScene s)
-----
-----charToScene :: Char -> Picture
-----charToScene c = NLeaf $ Scene
-----    {_scPosTri = mempty
-----    ,_scColTri = mempty
-----    ,_scPosChar = toVC [(0.0,0.0,0)]
-----    ,_scColChar = toVC [white]
-----    ,_scTexChar = toVC [(offset,100)]
-----    }
-----    where x = 1/128
-----          s = offset * x
-----          offset = fromIntegral (fromEnum c) - 32
---charToScene :: Char -> Picture
---charToScene c = Scene
---    {_scPosTri = mempty
---    ,_scColTri = mempty
---    ,_scPosChar = toVC [(0.0    ,0.0      ,0)        
---                  ,(dimText,0.0      ,0)    
---                  ,(dimText,dimText*2,0)
---                  ,(0.0    ,0.0      ,0)        
---                  ,(dimText,dimText*2,0)
---                  ,(0.0    ,dimText*2,0)    
---                  ]
---    ,_scColChar = toVC $ take 6 $ repeat white
---    ,_scTexChar = toVC $ [(s,1) ,(e,1) ,(e,0) ,(s,1) ,(e,0) ,(s,0)]
---    }
---    where x = 1/128
---          s = offset * x
---          e = s + x
---          offset = fromIntegral (fromEnum c) - 32
-    
-
-dimText = 100
-
 line :: [Point2] -> Picture
 {-# INLINE line #-}
-line ps = thickLine ps 1
+line = Line
 
 thickLine :: [Point2] -> Float -> Picture
 {-# INLINE thickLine #-}
-thickLine ps x = blank
+thickLine ps t = pictures $ f ps
+    where f (x:y:ys) 
+            | x == y = f (x:ys)
+            | otherwise 
+                     = polygon [x +.+ n x y, x -.- n x y, y -.- n x y, y +.+ n x y] : f (y:ys)
+          f _        = []
+          n a b      = (t*0.5) *.* errorNormalizeV 42 (vNormal (a -.- b))
 
 thickCircle :: Float -> Float -> Picture
 {-# INLINE thickCircle #-}
@@ -296,9 +216,3 @@ bright (r,g,b,a) = (r*1.2,g*1.2,b*1.2,a)
 
 greyN :: Float -> Color
 greyN x = (x,x,x,1)
-
-
---zeroZ :: Point2 -> Point3
---{-# INLINE zeroZ #-}
---zeroZ (x,y) = (x,y,0)
-
diff --git a/src/Picture/Data.hs b/src/Picture/Data.hs
index b010f253b..e3d070389 100644
--- a/src/Picture/Data.hs
+++ b/src/Picture/Data.hs
@@ -14,24 +14,6 @@ import Control.Lens
 type RGBA = (Float,Float,Float,Float)
 type Color = (Float,Float,Float,Float)
 
-
---type VerticesContainer a = Se.Seq a
---toVC = Se.fromList
---fromVC :: VerticesContainer a -> [a]
---fromVC = F.toList
---type VerticesContainer a = DL.DList a
---toVC = DL.fromList
---fromVC = DL.toList
-type VerticesContainer a = [a]
-toVC = id
-fromVC = id
-{-# INLINE toVC #-}
-{-# INLINE fromVC #-}
-{-# INLINE mapVC #-}
-
-mapVC :: (a -> b) -> VerticesContainer a -> VerticesContainer b
-mapVC = fmap
-
 data FTree a
     = FBranch (a -> a) (FTree a)
     | FBranches [FTree a]
@@ -43,33 +25,6 @@ instance Foldable FTree where
     foldMap g (FLeaf x) = g x
     {-# INLINE foldMap #-}
 
---reduceShapeTree :: (Shape -> Shape) -> ShapeTree -> [Shape]
---reduceShapeTree
---    (TransformShape f xs) = map (f . reduceShapeTree) xs
---reduceShapeTree
---    (Leaf s) = [s]
-
---  data ShapeTree 
---      = TransformShape (Shape -> Shape) [ShapeTree]
---      | Leaf Shape
---  
---  data Shape 
---      = Shape 
---          { _shPos :: VerticesContainer Point3
---          , _shCol :: VerticesContainer RGBA
---          }
---      | TextShape
---          { _shPos :: VerticesContainer Point3
---          , _shCol :: VerticesContainer RGBA
---          , _shTex :: VerticesContainer Point2
---          }
---
---combineShapes :: Shape -> Shape -> Shape
---combineShapes sa sb = Shape
---    { _shPos  = _shPos  sa <> _shPos sb
---    , _shCol  = _shCol  sa <> _shCol sb
---    }
-
 flat2 (x,y)     = [x,y]
 flat3 (x,y,z)   = [x,y,z]
 flat4 (x,y,z,w) = [x,y,z,w]
@@ -80,49 +35,25 @@ flat4 (x,y,z,w) = [x,y,z,w]
 data RenderType
     = RenderPoly [(Point3,Point4)]
     | RenderText [(Point3,Point4,Point2)]
+    | RenderCirc (Point3,Point4,Float)
+    | RenderArc  (Point3,Point4,Point4)
+    | RenderLine [(Point3,Point4)]
     | RenderBlank
 
 data Picture
     = Blank
     | Text String
     | Polygon [Point2]
+    | PolygonCol [(Point2,RGBA)]
+    | Circle Float
     | Scale Float Float Picture
     | Translate Float Float Picture
     | Rotate Float Picture
     | SetDepth Float Picture
     | Color RGBA Picture
     | Pictures [Picture]
-
-data Scene = Scene
-    { _scPosTri  :: VerticesContainer Point3
-    , _scColTri  :: VerticesContainer RGBA
-    , _scPosChar :: VerticesContainer Point3
-    , _scColChar :: VerticesContainer RGBA
-    , _scTexChar :: VerticesContainer Point2
-    }
-
-emptyScene :: Scene
-{-# INLINE emptyScene #-}
-emptyScene = Scene mempty mempty mempty mempty mempty
+    | Line [Point2]
 
 blank :: Picture
 {-# INLINE blank #-}
 blank = Blank
-
-combineScenes :: Scene -> Scene -> Scene
-{-# INLINE combineScenes #-}
-combineScenes sa sb = Scene
-    { _scPosTri  = _scPosTri  sa <> _scPosTri sb
-    , _scColTri  = _scColTri  sa <> _scColTri sb
-    , _scPosChar = _scPosChar sa <> _scPosChar sb
-    , _scColChar = _scColChar sa <> _scColChar sb
-    , _scTexChar = _scTexChar sa <> _scTexChar sb
-    }
-
-instance Semigroup Scene where
-    (<>) = combineScenes
-instance Monoid Scene where
-    mempty = emptyScene
-    --mappend = combineScenes
-
-makeLenses ''Scene
diff --git a/src/Picture/Preload.hs b/src/Picture/Preload.hs
index 3ecc90861..71d8246f9 100644
--- a/src/Picture/Preload.hs
+++ b/src/Picture/Preload.hs
@@ -10,6 +10,7 @@ import qualified Graphics.Rendering.OpenGL as GL
 import qualified Data.Vector.Storable as V
 
 import Control.Lens
+import Control.Monad
 
 import Foreign
 
@@ -20,19 +21,55 @@ data PreloadData = PreloadData
 --    , _textures :: [Image PixelRGBA8]
     , _basicShader :: Program
     , _textShader :: Program
+    , _circShader :: Program
+    , _arcShader  :: Program
+    , _lineShader :: Program
     , _fadeCircleShader :: Program
     , _basicVAO :: VertexArrayObject
     , _textVAO  :: VertexArrayObject
+    , _circVAO  :: VertexArrayObject
+    , _arcVAO  :: VertexArrayObject
     , _posVBO :: BufferObject
     , _colVBO :: BufferObject
     , _texVBO :: BufferObject
     , _ptrPosVBO :: Ptr Float
     , _ptrColVBO :: Ptr Float
-    , _ptrTexVBO :: Ptr Float
+    , _ptrCharPos :: Ptr Float
+    , _ptrCharCol :: Ptr Float
+    , _ptrCharTex :: Ptr Float
+    , _ptrCircPos :: Ptr Float
+    , _ptrCircCol :: Ptr Float
+    , _ptrCircSca :: Ptr Float
+    , _ptrArcPos :: Ptr Float
+    , _ptrArcCol :: Ptr Float
+    , _ptrArcSca :: Ptr Float
+    , _ptrLinePos :: Ptr Float
+    , _ptrLineCol :: Ptr Float
+    , _uniWinSize :: UniformLocation
+    , _csZoomUni :: UniformLocation
+    , _asWinUni :: UniformLocation
+    , _asZoomUni :: UniformLocation
     }
 
 makeLenses ''PreloadData
 
+floatSize = sizeOf (0.5 :: GLfloat)
+
+setupVAO :: [(BufferObject,GLuint,Int)] -> IO VertexArrayObject
+setupVAO ps = do
+    theVAO <- genObjectName
+    bindVertexArrayObject $= Just theVAO
+    forM_ ps $ \(vbo,aloc,i) -> do
+        bindBuffer ArrayBuffer $= Just vbo
+        vertexAttribPointer (AttribLocation aloc) $=
+            ( ToFloat
+            , VertexArrayDescriptor (fromIntegral i) 
+                                    Float 
+                                    (fromIntegral $ floatSize * i) 
+                                    (bufferOffset 0)
+            )
+        vertexAttribArray (AttribLocation aloc) $= Enabled
+    return theVAO
 
 loadTextures :: IO [Image PixelRGBA8]
 loadTextures = do
@@ -53,8 +90,16 @@ doPreload' = do
 -- compile shader programs
     bs <- makeBasicShader
     ts <- makeTextureShader
+    cs <- makeCircleShader
+    as <- makeArcShader
     fcs <- makeFadeShader
 
+    winSizeUni <- GL.uniformLocation cs "winSize"
+    zoomUni    <- GL.uniformLocation cs "zoom"
+    asWinSizeUniLoc <- GL.uniformLocation as "winSize"
+    asZoomUniLoc    <- GL.uniformLocation as "zoom"
+-- get uniform locations
+
 --setup vbos
 --need to be bound before assigning the vertex attribute pointers
     posVBO <- genObjectName
@@ -76,81 +121,75 @@ doPreload' = do
     generateMipmap' Texture2D
     textureFilter Texture2D $= ((Linear',Just Linear') , Nearest)
 
-    let vertexSize = sizeOf (0.5 :: GLfloat)
-        firstIndex = 0
-
 -- setup VAOs: basic vao
-    basicVAO <- genObjectName
-    bindVertexArrayObject $= Just basicVAO
-
---    let posAttrib = AttribLocation 0
---        colAttrib = AttribLocation 1
-    bindBuffer ArrayBuffer $= Just posVBO
-    vertexAttribPointer (AttribLocation 0) $=
-        ( ToFloat
-        , VertexArrayDescriptor 3 Float (fromIntegral $ vertexSize * 3) 
-                                            (bufferOffset (firstIndex * vertexSize))
-        )
-    vertexAttribArray (AttribLocation 0) $= Enabled
-
-    bindBuffer ArrayBuffer $= Just colVBO
-    vertexAttribPointer (AttribLocation 1) $=
-        ( ToFloat
-        , VertexArrayDescriptor 4 Float (fromIntegral $ vertexSize * 4) 
-                                            (bufferOffset (firstIndex * vertexSize) )
-        )
-    vertexAttribArray (AttribLocation 1) $= Enabled
-
--- setup second vao
-    textVAO <- genObjectName
-    bindVertexArrayObject $= Just textVAO
-
-    bindBuffer ArrayBuffer $= Just posVBO
-    vertexAttribPointer (AttribLocation 0) $=
-        ( ToFloat
-        , VertexArrayDescriptor 3 Float (fromIntegral $ vertexSize * 3) 
-                                            (bufferOffset (firstIndex * vertexSize))
-        )
-    vertexAttribArray (AttribLocation 0) $= Enabled
-
-    bindBuffer ArrayBuffer $= Just colVBO
-    vertexAttribPointer (AttribLocation 1) $=
-        ( ToFloat
-        , VertexArrayDescriptor 4 Float (fromIntegral $ vertexSize * 4) 
-                                            (bufferOffset (firstIndex * vertexSize) )
-        )
-    vertexAttribArray (AttribLocation 1) $= Enabled
-
-    bindBuffer ArrayBuffer $= Just texVBO
-    vertexAttribPointer (AttribLocation 2) $=
-        ( ToFloat
-        , VertexArrayDescriptor 2 Float (fromIntegral $ vertexSize * 2) 
-                                            (bufferOffset (firstIndex * vertexSize) )
-        )
-    vertexAttribArray (AttribLocation 2) $= Enabled
+    basicVAO <- setupVAO [(posVBO,0,3),(colVBO,1,4)]
+    textVAO <- setupVAO [(posVBO,0,3),(colVBO,1,4),(texVBO,2,2)]
+    circVAO <- setupVAO [(posVBO,0,3),(colVBO,1,4),(texVBO,2,1)]
+    arcVAO <- setupVAO [(posVBO,0,3),(colVBO,1,4),(texVBO,2,3)]
 
 -- allocate memory for vertex attributes
+-- for triangles
     ptrPosVBO <- mallocArray (3*3*20000)
     ptrColVBO <- mallocArray (3*4*20000)
-    ptrTexVBO <- mallocArray (3*2*20000)
+-- for characters
+    ptrCharPos <- mallocArray (3*20000)
+    ptrCharCol <- mallocArray (4*20000)
+    ptrCharTex <- mallocArray (2*20000)
+-- for circles
+    ptrCircPos <- mallocArray (3*20000)
+    ptrCircCol <- mallocArray (4*20000)
+    ptrCircSca <- mallocArray (2*20000)
+-- for lines
+    ptrLinePos <- mallocArray (3*20000)
+    ptrLineCol <- mallocArray (4*20000)
+-- for arcs
+    ptrArcPos <- mallocArray (3*20000)
+    ptrArcCol <- mallocArray (4*20000)
+    ptrArcSca <- mallocArray (3*20000)
 
     return $ PreloadData
         { _charMap      = convertRGBA8 cmap
         , _basicShader  = bs
         , _textShader   = ts
+        , _circShader = cs
+        , _arcShader = as
         , _fadeCircleShader = fcs
         , _basicVAO = basicVAO
         , _textVAO  = textVAO
+        , _circVAO  = circVAO
+        , _arcVAO   = arcVAO
         , _posVBO = posVBO
         , _colVBO = colVBO
         , _texVBO = texVBO
         , _ptrPosVBO = ptrPosVBO
         , _ptrColVBO = ptrColVBO
-        , _ptrTexVBO = ptrTexVBO
+        , _ptrCharPos = ptrCharPos
+        , _ptrCharCol = ptrCharCol
+        , _ptrCharTex = ptrCharTex
+        , _ptrCircPos = ptrCircPos
+        , _ptrCircCol = ptrCircCol
+        , _ptrCircSca = ptrCircSca
+        , _ptrArcPos = ptrArcPos
+        , _ptrArcCol = ptrArcCol
+        , _ptrArcSca = ptrArcSca
+        , _ptrLinePos = ptrLinePos
+        , _ptrLineCol = ptrLineCol
+        , _uniWinSize = winSizeUni
+        , _csZoomUni  = zoomUni
+        , _asWinUni = asWinSizeUniLoc
+        , _asZoomUni = asZoomUniLoc
         }
 
 cleanUpPreload :: PreloadData -> IO ()
 cleanUpPreload pd = do
     free (_ptrPosVBO pd)
     free (_ptrColVBO pd)
-    free (_ptrTexVBO pd)
+    free (_ptrCharPos pd)
+    free (_ptrCharCol pd)
+    free (_ptrCharTex pd)
+    free (_ptrCircPos pd)
+    free (_ptrCircCol pd)
+    free (_ptrCircSca pd)
+    free (_ptrArcPos pd)
+    free (_ptrArcCol pd)
+    free (_ptrArcSca pd)
diff --git a/src/Picture/Render.hs b/src/Picture/Render.hs
index 51c928378..fda44175d 100644
--- a/src/Picture/Render.hs
+++ b/src/Picture/Render.hs
@@ -6,6 +6,8 @@ import Control.Lens
 import Control.Monad
 import Control.Monad.Trans.State
 
+import qualified Control.Foldl as F
+
 import Data.Bifunctor
 
 import Picture
@@ -18,7 +20,7 @@ import Foreign
 
 import Codec.Picture
 
-import Graphics.Rendering.OpenGL hiding (get,translate,scale,imageHeight,imageWidth,Polygon,Color,T)
+import Graphics.Rendering.OpenGL hiding (Line,get,translate,scale,imageHeight,imageWidth,Polygon,Color,T)
 import qualified Graphics.Rendering.OpenGL as GL
 
 import Data.Foldable
@@ -36,27 +38,11 @@ toVec2 (x,y) = Vector2 x y
 toVec3 (x,y,z) = Vector3 x y z
 toVec4 (x,y,z,w) = Vector4 x y z w
 
-mapFlat :: (NFData b) => (a -> VerticesContainer b) -> VerticesContainer a -> [b]
-mapFlat f = fromVC . foldMap f
-
 polyToTris :: [s] -> [s]
 {-# INLINE polyToTris #-}
 polyToTris (a:b:c:as) = a : intercalate [a] (zipWith (\x y->[x,y]) (init (b:c:as)) (c:as))
 polyToTris _ = []
 
-data Tx a = Tx [Tx a] | Lx a
-
-deriving instance Foldable Tx
-
-stateBump :: [Int] -> () -> State Int [Int]
-stateBump xs _ = do
-    s <- get
-    modify (+1)
-    return (s:xs)
-
-redT :: Foldable t => t () -> [Int]
-redT x = evalState (foldM stateBump [] x) 0
-
 tripFirst :: (a -> a') -> (a,b,c) -> (a',b,c)
 {-# INLINE tripFirst #-}
 tripFirst f (x,y,z) = (f x,y,z)
@@ -66,42 +52,57 @@ tripSecond :: (b -> b') -> (a,b,c) -> (a,b',c)
 tripSecond f (x,y,z) = (x,f y,z)
 
 scaleT :: Float -> (Point3,Point4,Point2) -> (Point3,Point4,Point2)
+{-# INLINE scaleT #-}
 scaleT x (a,b,(o,s)) = (a,b,(o,s*x))
 
+overPos :: (Point3 -> Point3) -> RenderType -> RenderType
+overPos f (RenderPoly vs) = RenderPoly $ map (first $ f) vs
+overPos f (RenderLine vs) = RenderLine $ map (first $ f) vs
+overPos f (RenderText vs) = RenderText $ map (\(a,b,c) -> (f a,b,c)) vs
+overPos f (RenderCirc (a,b,c)) = RenderCirc (f a,b,c)
+overPos _ RenderBlank = RenderBlank
+
+overCol :: (Point4 -> Point4) -> RenderType -> RenderType
+overCol f (RenderPoly vs) = RenderPoly $ map (second $ f) vs
+overCol f (RenderLine vs) = RenderLine $ map (second $ f) vs
+overCol f (RenderText vs) = RenderText $ map (\(a,b,c) -> (a,f b,c)) vs
+overCol f (RenderCirc (a,b,c)) = RenderCirc (a,f b,c)
+overCol _ RenderBlank = RenderBlank
+
 scaleRen,translateRen :: Float -> Float -> RenderType -> RenderType
-scaleRen x y (RenderPoly xs) = RenderPoly $ map (first $ scale3 x y) xs
-scaleRen x y (RenderText xs) = RenderText $ map (tripFirst (scale3 x y ) . scaleT x) xs
---scaleRen x y (RenderText xs) = RenderText $ map (\(a,b,c) -> (a,b, (0,0.2))) xs
-scaleRen x y rt = rt
-translateRen x y (RenderPoly xs) = RenderPoly $ map (first $ translate3 x y) xs
-translateRen x y (RenderText xs) = RenderText $ map (tripFirst $ translate3 x y) xs
---translateRen x y (RenderText xs) = RenderText $ map (tripFirst $ const (0.2,0.2,0)) xs
-translateRen x y rt = rt
+{-# INLINE scaleRen #-}
+scaleRen x y (RenderText vs) = overPos (scale3 x y) $ RenderText $ map (scaleT x) vs
+scaleRen x y (RenderCirc (a,b,c)) = overPos (scale3 x y) $ RenderCirc (a,b,c)
+scaleRen x y rt = overPos (scale3 x y) rt
+{-# INLINE translateRen #-}
+translateRen x y = overPos $ translate3 x y
 rotateRen,setDepthRen :: Float -> RenderType -> RenderType
-rotateRen a (RenderPoly xs) = RenderPoly $ map (first $ rotate3 a) xs
-rotateRen a (RenderText xs) = RenderText $ map (tripFirst $ rotate3 a) xs
-rotateRen a rt = rt
-setDepthRen a (RenderPoly xs) = RenderPoly $ map (first $ (\(x,y,_) -> (x,y,a))) xs
-setDepthRen a (RenderText xs) = RenderText $ map (tripFirst $ (\(x,y,_) -> (x,y,a))) xs
-setDepthRen a rt = rt
+{-# INLINE rotateRen #-}
+rotateRen a = overPos $ rotate3 a
+{-# INLINE setDepthRen #-}
+setDepthRen d = overPos $ \(x,y,_) -> (x,y,-d)
+{-# INLINE colorRen #-}
 colorRen :: RGBA -> RenderType -> RenderType
-colorRen c (RenderPoly xs) = RenderPoly $ map (second $ const c) xs
-colorRen c (RenderText xs) = RenderText $ map (tripSecond $ const c) xs
-colorRen c rt = rt
+colorRen c = overCol $ const c
 
 stringToList :: String -> [(Point3,Point4,Point2)]
-stringToList s = zipWith (\x (a,b,c) -> (translate3 x (0-dimText) a,b,c))
+{-# INLINE stringToList #-}
+stringToList s = zipWith (\x (a,b,c) -> (translate3 x 0 a,b,c))
                          [0,0.9*dimText..]
                          $ map charToTuple s
     where dimText = 100
 
 charToTuple :: Char -> (Point3,Point4,Point2)
+{-# INLINE charToTuple #-}
 charToTuple c = ((0,0,0),white,(offset,100))
     where offset = fromIntegral (fromEnum c) - 32
 
 picToFTree :: Picture -> FTree RenderType
 {-# INLINE picToFTree #-}
 picToFTree (Polygon ps) = FLeaf $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ repeat black
+picToFTree (PolygonCol vs) = let (ps,cs) = unzip vs
+                             in  FLeaf $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ polyToTris cs
+picToFTree (Circle r)   = FLeaf $ RenderCirc $ ((0.5,0,0),red,r)
 picToFTree Blank    = FLeaf $ RenderBlank
 picToFTree (Text s) = FLeaf $ RenderText $ stringToList s
 picToFTree (Scale x y pic) = FBranch (scaleRen x y) $ picToFTree pic
@@ -110,10 +111,75 @@ picToFTree (Rotate a pic) = FBranch (rotateRen a) $ picToFTree pic
 picToFTree (SetDepth a pic) = FBranch (setDepthRen a) $ picToFTree pic
 picToFTree (Color c pic) = FBranch (colorRen c) $ picToFTree pic
 picToFTree (Pictures pics) = FBranches $ map picToFTree pics
+picToFTree (Line ps) = FLeaf $ RenderLine $ zip (map zeroZ $ doubleLine ps) $ repeat black
 
-pokeTexts :: Ptr Float -> Ptr Float -> Ptr Float -> FTree RenderType -> IO Int
-pokeTexts = go 0
-    where go n pa pb pc t = foldM (pokeText pa pb pc) n t
+doubleLine :: [Point2] -> [Point2]
+doubleLine (x:y:xs) = concat $ zipWith (:) (init (x:y:xs)) $ map (\a -> [a]) (y:xs)
+doubleLine _ = []
+
+pokeFold :: (Ptr Float, Ptr Float) -> F.FoldM IO RenderType Int
+pokeFold (pa,pb) = F.FoldM
+    (pokePoly pa pb)
+    (return 0)
+    return
+pokeTextFold :: (Ptr Float, Ptr Float,Ptr Float) -> F.FoldM IO RenderType Int
+pokeTextFold (pa,pb,pc) = F.FoldM
+    (pokeText pa pb pc)
+    (return 0)
+    return
+pokeCircFold :: (Ptr Float, Ptr Float,Ptr Float) -> F.FoldM IO RenderType Int
+pokeCircFold (pa,pb,pc) = F.FoldM
+    (pokeCirc pa pb pc)
+    (return 0)
+    return
+
+theFold :: (Ptr Float,Ptr Float) 
+        -> (Ptr Float,Ptr Float,Ptr Float)
+        -> (Ptr Float,Ptr Float,Ptr Float)
+        -> (Ptr Float,Ptr Float)
+        -> F.FoldM IO RenderType (Int,Int,Int,Int)
+theFold pas pbs pcs pds = (,,,) <$> pokeFold pas <*> pokeTextFold pbs <*> pokeCircFold pcs
+                                    <*> pokeLineFold pds
+
+pokeLineFold :: (Ptr Float, Ptr Float) -> F.FoldM IO RenderType Int
+pokeLineFold (pa,pb) = F.FoldM
+    (pokeLine pa pb)
+    (return 0)
+    return
+pokeLine :: Ptr Float -> Ptr Float -> Int -> RenderType -> IO Int
+pokeLine pa pb n (RenderLine vs) = foldM (pokeLineVert pa pb) n vs
+pokeLine _  _  n _               = return n
+
+pokeLineVert :: Ptr Float -> Ptr Float -> Int -> (Point3, Point4) -> IO Int
+pokeLineVert pa pb n ((x,y,z),(r,g,b,a))
+    | n > 20000 * 2 = return n
+    | otherwise = do
+        pokeElemOff pa (3*n+0) x
+        pokeElemOff pa (3*n+1) y
+        pokeElemOff pa (3*n+2) z
+        pokeElemOff pb (4*n+0) r
+        pokeElemOff pb (4*n+1) g
+        pokeElemOff pb (4*n+2) b
+        pokeElemOff pb (4*n+3) a
+        return (n+1)
+
+pokeCirc :: Ptr Float -> Ptr Float ->  Ptr Float -> Int -> RenderType -> IO Int
+pokeCirc pa pb pc n (RenderCirc vs) = pokeCircVert pa pb pc n vs
+pokeCirc _  _  _  n _               = return n
+
+pokeCircVert :: Ptr Float -> Ptr Float -> Ptr Float -> Int -> (Point3, Point4, Float) -> IO Int
+pokeCircVert pa pb pc n ((x,y,z),(r,g,b,a),s)
+    | n > 20000 * 2 = return n
+    | otherwise = do
+        pokeElemOff pa (3*n+0) x
+        pokeElemOff pa (3*n+1) y
+        pokeElemOff pa (3*n+2) z
+        pokeElemOff pb (4*n+0) r
+        pokeElemOff pb (4*n+1) g
+        pokeElemOff pb (4*n+2) b
+        pokeElemOff pb (4*n+3) a
+        pokeElemOff pc n s
+        return (n+1)
 
 pokeText :: Ptr Float -> Ptr Float -> Ptr Float -> Int -> RenderType -> IO Int
 pokeText pa pb pc n (RenderText vs) = foldM (pokeTextVert pa pb pc) n vs
@@ -155,33 +221,6 @@ pokeVert pa pb n ((x,y,z),(r,g,b,a))
         pokeElemOff pb (4*n+3) a
         return (n+1)
 
-
-
-reducePicture :: Picture -> (DL.DList Float,DL.DList Float)
-{-# INLINE reducePicture #-}
-reducePicture = reducePicture' black id
-    where 
-        reducePicture' :: RGBA -> (Point3 -> Point3) -> Picture -> (DL.DList Float,DL.DList Float)
-        reducePicture' col tran Blank = (DL.empty,DL.empty)
-        reducePicture' col tran (Text _)  = (DL.empty,DL.empty)
-        reducePicture' col tran (Polygon ps) 
-            = ( DL.fromList $ concatMap (flat3 . tran . zeroZ) (polyToTris ps)
-              , DL.fromList $ concatMap (flat4 . const col)    (polyToTris ps)
-              )
-        reducePicture' col tran (Scale x y pic)
-            = reducePicture' col (tran . scale3 x y) pic
-        reducePicture' col tran (Translate x y pic)
-            = reducePicture' col (tran . translate3 x y) pic
-        reducePicture' col tran (Rotate a pic)
-            = reducePicture' col (tran . rotate3 a) pic
-        reducePicture' col tran (SetDepth a pic)
-            = reducePicture' col (tran . \(x,y,z) -> (x,y,a)) pic
-        reducePicture' col tran (Color c pic)
-            = reducePicture' c tran pic
-        reducePicture' col tran (Pictures pics)
-            = foldr com (DL.empty,DL.empty) $ map (reducePicture' col tran) pics
-                where com (xs,ys) (xs',ys') = (xs <> xs', ys <> ys')
-
 translate3 :: Float -> Float -> Point3 -> Point3
 {-# INLINE translate3 #-}
 translate3 a b (x,y,z) = (x+a,y+b,z)
@@ -193,72 +232,57 @@ rotate3 :: Float -> Point3 -> Point3
 rotate3 a (x,y,z) = (x',y',z)
     where (x',y') = rotateV a (x,y)
 
-renderPicture' :: PreloadData -> Picture -> IO ()
-renderPicture' pdata pic = do
+renderPicture' :: PreloadData -> Float -> (Float,Float) -> Picture -> IO ()
+renderPicture' pdata zoom (winx,winy) pic = do
     let firstIndex = 0
         fSize = sizeOf (0::Float)
 
+    (nTriVs,numVert',numCircVs,nLineVs) 
+        <- F.foldM (theFold (_ptrPosVBO pdata, _ptrColVBO pdata)  
+                                          (_ptrCharPos pdata, _ptrCharCol pdata, _ptrCharTex pdata)
+                                          (_ptrCircPos pdata, _ptrCircCol pdata, _ptrCircSca pdata)
+                                          (_ptrLinePos pdata, _ptrLineCol pdata)
+                   ) $ picToFTree pic
+
+    depthFunc $= Just Less
+-- draw triangles
     currentProgram $= Just (_basicShader pdata)
-    numVert <- pokePic (_ptrPosVBO pdata) (_ptrColVBO pdata) $ picToFTree pic
     bindVertexArrayObject $= Just (_basicVAO pdata)
     bindBuffer ArrayBuffer $= Just (_posVBO pdata)
-    bufferData ArrayBuffer $= (fromIntegral $ fSize * numVert * 3, _ptrPosVBO pdata, StreamDraw)
+    bufferData ArrayBuffer $= (fromIntegral $ fSize * nTriVs * 3, _ptrPosVBO pdata, StreamDraw)
     bindBuffer ArrayBuffer $= Just (_colVBO pdata)
-    bufferData ArrayBuffer $= (fromIntegral $ fSize * numVert * 4, _ptrColVBO pdata, StreamDraw)
-    drawArrays Triangles (fromIntegral firstIndex) (fromIntegral $ numVert)
+    bufferData ArrayBuffer $= (fromIntegral $ fSize * nTriVs * 4, _ptrColVBO pdata, StreamDraw)
+    drawArrays Triangles (fromIntegral firstIndex) (fromIntegral $ nTriVs)
+-- draw lines, don't need to change the program or vaos, just need to bind the
+-- vbos and draw
+    bindBuffer ArrayBuffer $= Just (_posVBO pdata)
+    bufferData ArrayBuffer $= (fromIntegral $ fSize * nLineVs * 3, _ptrLinePos pdata, StreamDraw)
+    bindBuffer ArrayBuffer $= Just (_colVBO pdata)
+    bufferData ArrayBuffer $= (fromIntegral $ fSize * nLineVs * 4, _ptrLineCol pdata, StreamDraw)
+    drawArrays Lines (fromIntegral firstIndex) (fromIntegral $ nLineVs)
+-- draw circles
+    currentProgram $= Just (_circShader pdata)
+    uniform (_uniWinSize pdata) $= Vector2 winx winy
+    uniform (_csZoomUni pdata)  $= zoom
+    bindVertexArrayObject $= Just (_circVAO pdata)
+    bindBuffer ArrayBuffer $= Just (_posVBO pdata)
+    bufferData ArrayBuffer $= (fromIntegral $ fSize * numVert' *3, _ptrCircPos pdata, StreamDraw)
+    bindBuffer ArrayBuffer $= Just (_colVBO pdata)
+    bufferData ArrayBuffer $= (fromIntegral $ fSize * numVert' *4, _ptrCircCol pdata, StreamDraw)
+    bindBuffer ArrayBuffer $= Just (_texVBO pdata)
+    bufferData ArrayBuffer $= (fromIntegral $ fSize * numVert' *1, _ptrCircSca pdata, StreamDraw)
+    drawArrays Points (fromIntegral firstIndex) (fromIntegral $ numCircVs)
 
     currentProgram $= Just (_textShader pdata)
-    numVert' <- pokeTexts (_ptrPosVBO pdata) (_ptrColVBO pdata) (_ptrTexVBO pdata) $ picToFTree pic
     bindVertexArrayObject $= Just (_textVAO pdata)
     bindBuffer ArrayBuffer $= Just (_posVBO pdata)
-    bufferData ArrayBuffer $= (fromIntegral $ fSize * numVert' *3, _ptrPosVBO pdata, StreamDraw)
+    bufferData ArrayBuffer $= (fromIntegral $ fSize * numVert' *3, _ptrCharPos pdata, StreamDraw)
     bindBuffer ArrayBuffer $= Just (_colVBO pdata)
-    bufferData ArrayBuffer $= (fromIntegral $ fSize * numVert' *4, _ptrColVBO pdata, StreamDraw)
+    bufferData ArrayBuffer $= (fromIntegral $ fSize * numVert' *4, _ptrCharCol pdata, StreamDraw)
     bindBuffer ArrayBuffer $= Just (_texVBO pdata)
-    bufferData ArrayBuffer $= (fromIntegral $ fSize * numVert' *2, _ptrTexVBO pdata, StreamDraw)
+    bufferData ArrayBuffer $= (fromIntegral $ fSize * numVert' *2, _ptrCharTex pdata, StreamDraw)
     drawArrays Points (fromIntegral firstIndex) (fromIntegral $ numVert')
 
-renderPicture :: PreloadData -> Picture -> IO ()
-renderPicture pdata pic = do
-    currentProgram $= Just (_basicShader pdata)
-    bindVertexArrayObject $= Just (_basicVAO pdata)
-    bindBuffer ArrayBuffer $= Just (_posVBO pdata)
-    let firstIndex = 0
-    let (vs,cs) = reducePicture pic
-        vertices :: [Float]
-        vertices = DL.toList vs
-        numVertices = length vertices
-        vertexSize = sizeOf (head vertices)
-    pokeArray (_ptrPosVBO pdata) vertices
-    bufferData ArrayBuffer $= (fromIntegral (length vertices * vertexSize), _ptrPosVBO pdata, StreamDraw)
---    marshallVs vertices $ \ptr -> do
---        bufferData ArrayBuffer $= (fromIntegral (numVertices * vertexSize), ptr, StreamDraw)
-    bindBuffer ArrayBuffer $= Just (_colVBO pdata)
-    let colVs = DL.toList cs
-    pokeArray (_ptrColVBO pdata) colVs
-    bufferData ArrayBuffer $= (fromIntegral (length colVs * vertexSize), _ptrColVBO pdata, StreamDraw)
---    marshallVs colVs $ \ptr -> do
---        bufferData ArrayBuffer $= (fromIntegral (div (4 * numVertices * colVsize) 3), ptr, StreamDraw)
-    drawArrays Triangles (fromIntegral firstIndex) (fromIntegral $ numVertices)
-
-----    currentProgram $= Just (_textShader pdata)
-----    bindVertexArrayObject $= Just (_textVAO pdata)
-----    bindBuffer ArrayBuffer $= Just (_posVBO pdata)
-----    let vertices' = concatMap flat3 posChar
-----        numVertices' = length posChar
-----        vertexSize'  = sizeOf $ head vertices'
-----    pokeArray (_ptrPosVBO pdata) vertices'
-----    bufferData ArrayBuffer $= (fromIntegral (3 * numVertices' * vertexSize'), _ptrPosVBO pdata, StreamDraw)
-----    --withArray vertices' $ \ptr -> do
-----    --    bufferData ArrayBuffer $= (fromIntegral (3 * numVertices' * vertexSize'), ptr, StreamDraw)
-----    bindBuffer ArrayBuffer $= Just (_colVBO pdata)
-----    pokeArray (_ptrColVBO pdata) $ concatMap flat4 colChar
-----    bufferData ArrayBuffer $= (fromIntegral (4 * numVertices' * vertexSize'), _ptrColVBO pdata, StreamDraw)
-----    bindBuffer ArrayBuffer $= Just (_texVBO pdata)
-----    pokeArray (_ptrTexVBO pdata) $ concatMap flat2 texChar
-----    bufferData ArrayBuffer $= (fromIntegral (2 * numVertices' * vertexSize'), _ptrTexVBO pdata, StreamDraw)
-----    drawArrays Points (fromIntegral firstIndex) (fromIntegral $ numVertices')
-
 
 
 bufferOffset :: Integral a => a -> Ptr b
diff --git a/src/Shaders.hs b/src/Shaders.hs
index c976690aa..79aa525cc 100644
--- a/src/Shaders.hs
+++ b/src/Shaders.hs
@@ -6,6 +6,8 @@ module Shaders
     ,makeTextureShader
     ,makeBasicShader
     ,makeFadeShader
+    ,makeCircleShader
+    ,makeArcShader
     )
     where
 import Graphics.Rendering.OpenGL
@@ -34,6 +36,28 @@ setupBasicShader = do
     shaderProgram <- makeBasicShader
     currentProgram $= (Just shaderProgram)
 
+makeCircleShader :: IO Program
+makeCircleShader = do
+    vsSource <- BS.readFile "shader/circle.vert"
+    gsSource <- BS.readFile "shader/circle.geom"
+    fsSource <- BS.readFile "shader/circle.frag"
+
+    makeShaderProgram [(VertexShader,   vsSource )
+                      ,(GeometryShader, gsSource )
+                      ,(FragmentShader, fsSource )
+                      ]
+
+makeArcShader :: IO Program
+makeArcShader = do
+    vsSource <- BS.readFile "shader/arc.vert"
+    gsSource <- BS.readFile "shader/arc.geom"
+    fsSource <- BS.readFile "shader/arc.frag"
+
+    makeShaderProgram [(VertexShader,   vsSource )
+                      ,(GeometryShader, gsSource )
+                      ,(FragmentShader, fsSource )
+                      ]
+
 makeFadeShader :: IO Program
 makeFadeShader = do
     vsSource <- BS.readFile "shader/fadeCircle.vert"