Skip to content

Instantly share code, notes, and snippets.

@5outh
5outh / write
Created Jul 1, 2019
Journal setup
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
@5outh
5outh / Auth.hs
Last active Jul 3, 2018
Authorized
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