View write
#! /bin/bash | |
DATE=`date +%Y-%m-%d` | |
FILE="./entries/$DATE.md" | |
if [ ! -f $FILE ]; then | |
printf "# $DATE\n" >> $FILE | |
fi | |
nvim $FILE | |
git add entries -A |
View perspective.hs
newtype Face = Face { getFace :: Polygon } | |
newtype Box = Box { getBox :: [Face] } | |
drawFace face = do | |
brightness <- getRandomR (0.4,0.6) | |
cairo $ do | |
draw (getFace face) | |
setSourceHsv (HSV 0 0 brightness) *> fillPreserve | |
setSourceHsv (HSV 0 0 0) *> stroke |
View Auth.hs
orNotFound :: MaybeT Handler a -> Handler a | |
orNotFound mHandler = do | |
act <- runMaybeT mHandler | |
maybe notFound act | |
withStudentToken :: (StudentId -> CourseId -> Handler a) -> MaybeT Handler a | |
withStudentToken action = do | |
mStudentToken <- MaybeT optionalStudentToken | |
case mStudentToken of | |
Nothing -> mempty |
View SpaceColonization.hs
data Graph = Graph | |
{ pointsLeft :: Set.Set (V2 Double) | |
-- ^ All the points in the whole graph left to be connected | |
, branches :: Set.Set LineSegment | |
-- ^ All branches we have found, connecting two points | |
, currentPoints :: [V2 Double] | |
-- ^ Points that are currently being processed | |
, maxDist :: Double | |
-- ^ Maximum distance a thing can be away from a thing | |
} |
View waves.hs
renderSketch :: Generate () | |
renderSketch = do | |
fillScreenHsv linen | |
cairo $ setLineJoin LineJoinRound | |
cairo $ setLineCap LineCapRound | |
cairo $ setLineWidth 0.1 | |
xScale <- sampleRVar (D.uniform 0 3) | |
yScale <- sampleRVar (D.uniform 0 3) |
View SpringMesh.hs
type SpringMesh = Space2d Mover | |
updateSpringMesh :: Rect -> SpringMesh -> SpringMesh | |
updateSpringMesh rect springMesh = Space2d.mapWithKey springify springMesh | |
where | |
springify index mover = | |
let movers = Space2d.neighbors index springMesh | |
in update | |
. bounceRect rect | |
. applyFriction 0.05 |
View JSONB.hs
newtype JSONB a = JSONB { unJSONB :: a } | |
deriving | |
( Generic | |
, Eq | |
, Foldable | |
, Functor | |
, Ord | |
, Read | |
, Show | |
, Traversable |
View Sketch.hs
module Sketch where | |
import Data.Space2d | |
-- (Other imports omitted) | |
-- | Generate a unit vector space given a size | |
randomSpace2d :: Rational -> Generate (Space2d (V2 Double)) | |
randomSpace2d size = do | |
(w, h) <- getSize | |
let |
View LineBounce.hs
{-# OPTIONS_GHC -fno-warn-unused-imports #-} | |
{-# LANGUAGE FlexibleContexts #-} | |
{-# LANGUAGE LambdaCase #-} | |
{-# LANGUAGE RecordWildCards #-} | |
{-# LANGUAGE ScopedTypeVariables #-} | |
{-# LANGUAGE TypeApplications #-} | |
-- | A "living" module for short-lived experiments. | |
module Sketch where | |
import Algorithms.Bezier (ControlPoint (..)) |
View taper.hs
taperGeometric | |
:: Double | |
-- ^ percentage to decrease by each iteration | |
-> Double | |
-- ^ Starting width | |
-> [V2 Double] | |
-- ^ The path | |
-> [(V2 Double, Double)] | |
-- ^ The path, augmented with line widths | |
taperGeometric percentage startingWidth path = zip path widths |
NewerOlder