Subversion Repositories colinrmitchell.com

Rev

Rev 612 | Blame | Compare with Previous | Last modification | View Log | RSS feed

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}

import System.Environment (getArgs)
import Data.List (nub, (!!))
import Data.Maybe (fromJust)

import qualified Data.Text as T
import Text.Hamlet hiding (renderHtml)
import Text.Lucius
import Text.Blaze.Html.Renderer.String (renderHtml)
import Network.CGI hiding (renderHtml, Html)


main =
   runCGI $ do
      rows <- fmap (maybe 40 read) $ getInput "rows"
      sts <- fmap (maybe 10 read) $ getInput "sts"
      offset <- fmap (maybe 0 read) $ getInput "offset"
      start <- fmap (maybe False (\_ -> True)) $ getInput "start"
      end <- fmap (maybe False (\_ -> True)) $ getInput "end"
      ctype <- fmap (maybe Floor read) $ getInput "calcType"
     
      let x_1 = if start then 0 else -1
          y_1 = 0

      let x_2 = if end then (sts - 1) else sts
          y_2 = rows

      let slope = ((y_2 - y_1) / (x_2 - x_1))

      let f x = slope * x + (y_1 - (slope * x_1))

      output . renderHtml
         . form
            (floor rows)
            (floor sts)
            offset
            start
            end
            ctype
         $ map
            (\x -> offset + ((calcType ctype) (f x)))
            [0..(sts - 1)]

data CalcType = Floor | Ceiling | Average
  deriving (Read, Show, Eq)

calcType Floor = floor
calcType Ceiling = ceiling
calcType Average = round

form rows sts offset start end ctype results =
   [shamlet|
   <html>
      <head>
         <style>
            p {
             padding: 8px;
            }
            p:hover {
             font-size: larger;
             background-color: lightgreen;
            }
      <body>
         <form>
            <div style="padding: 8px">
               Number of rows
               <input type="text" name="rows" value="#{show rows}">
           
            <div style="padding: 8px">
               Number of stitches
               <input type="text" name="sts" value="#{show sts}">
           
            <div style="padding: 8px">
               Row offset
               <input type="text" name="offset" value="#{show offset}">
           
            <div style="padding: 8px">
               Start with increase or decrease
               <input type="checkbox" name="start" :start:checked>
           
            <div style="padding: 8px">
               End with increase or decrease
               <input type="checkbox" name="end" :end:checked>
           
            <div style="padding: 8px">
               Matching type
               <select name="calcType">
                  <option value="Floor" :isFloor:selected>
                     Floor
                  <option value="Ceiling" :isCeiling:selected>
                     Ceiling
                  <option value="Average" :isAverage:selected>
                     Round

            <div>
               <input type="submit" value="Submit">
           
            <div>
               <strong>Increase or decrease on rows:
           
               $forall r <- results
                  <p>#{show r}
   |]

   where
      isFloor = ctype == Floor
      isCeiling = ctype == Ceiling
      isAverage = ctype == Average