Skip to content

Cleanup #1

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 5 commits into from
Dec 10, 2014
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
45 changes: 45 additions & 0 deletions README.md
Original file line number Diff line number Diff line change
@@ -0,0 +1,45 @@
# A Gentle Introduction to Linked Lists

An interactive web-page demonstration of Linked Lists and how they are
stored in memory based (very very closely) on a Java Applet written by
[Michael Goldwasser](http://mathcs.slu.edu/~goldwasser/)

This was written as a SLU Senior Capstone Project for Fall 2014 and is
released under a BSD-style two-clause license (see
[LICENSE](LICENSE)).

It's now finished as far as the assignment goes, so I guess
pull-requests are welcome! I've added a
[feature backlog](backlog.org) if you want ideas for contribution.

#### Building

You'll need to build the [GHCJS](https://github.com/GHCJS/GHCJS)
(which is kind of a pain right now). Follow that link for
instructions.

When you have GHCJS, just ```make``` and then install any dependencies
that cabal asks for (oh yeah, you also need cabal-install) and then
```make``` again and it should work.

The files should all end up in a folder called
```linked-list-dist```. Navigating a web-browser to
```linked-list-dist/index.html``` will give you the demo.

#### Other ways to use it

Since building is a pain, you can also grab a ```.tgz``` from
[releases](https://github.com/RoboNickBot/linked-list-web-demo/releases)
or (for now) go to
[Linked List Demo](http://octalsrc.net/demos/linked_list.html)

#### Code Guide

This is written in Haskell and uses the JQuery and Canvas libraries
from the [GHCJS project](https://github.com/ghcjs) as well as
[Reactive-Banana](https://www.haskell.org/haskellwiki/Reactive-banana)
for some minimal FRP business.

All the JQuery and Canvas things are in ```JS.hs``` and all FRP
happens in ```LinkedListDemo.hs``` (which is also the Main file).
List parsing and Layout generation happens in ```Links.hs```.
21 changes: 21 additions & 0 deletions backlog.org
Original file line number Diff line number Diff line change
@@ -0,0 +1,21 @@
Some features I intend to implement:

(this is an Emacs Org-Mode notes file; I'm sorry if GitHub renders it
weirdly)

* Improve randomInput function
Empty cells tend to bunch up at the end

* Highlight cell-drawing relationships
On mouse-over of boxes and arrows in the drawn list, they and the
cell in the memory-edit area that they represent should highlight in
some way as a quick indication of their relationship

* Improve sizing and centering of drawing area
** Properly center the drawn lists in the drawing area
** Get rid of that white-space at the bottom of the screen
(while making sure not to make a scroll-bar appear)
** Make the drawing auto-resize whenever the window-size changes

* General re-factoring
Particularly in JS.hs, it's kind of a mess in there
15 changes: 8 additions & 7 deletions src/Demo/Links.hs
Original file line number Diff line number Diff line change
Expand Up @@ -16,19 +16,20 @@ import qualified Data.List as L (delete, length)
randomEmptyCells = 2 :: Int
randomValueRange = ('A','Z')

{- I think there is a lot of refactoring-opportunity in here,
especially concerning the use of monads, but we'll leave that
for later.
{- I think there is a lot of refactoring-opportunity in this file,
especially concerning the use of monads for parsing, but we'll
leave that for later.
-}

mismatches :: InputState -> InputState -> (Bool,[Int])
mismatches (InSt i1 s1 h1 m1) (InSt i2 s2 h2 m2) =
mismatches :: InputState -> Maybe InputState -> (Bool,[Int])
mismatches (InSt i1 s1 h1 m1) (Just (InSt i2 s2 h2 m2)) =
let headChanged = h1 /= h2
f = (matchIndex m1 m2)
in (headChanged, (foldr
f
[]
[i1 .. (i1 + s1 - 1)] ))
mismatches _ _ = (False,[]) -- if last InSt is Nothing, no change

matchIndex :: M.Map Int Cell -> M.Map Int Cell -> Int -> [Int] -> [Int]
matchIndex c b i is = let f m = (fmap snd (M.lookup i m))
Expand Down Expand Up @@ -76,9 +77,9 @@ box _ _ = []
{- Failure for arrow: (end list)
1. the arrow cell is empty/non-existant
2. the value of the arrow cell is not an Int
2. the cell which the arrow points to is empty/invalid
3. the cell which the arrow points to is empty/invalid
Special failure: (add loopback and end list)
3. the cell which the arrow points to is already seen
4. the cell which the arrow points to is already seen
-}
arrow :: Step
arrow (m,s) (Just (i,val)) =
Expand Down
14 changes: 9 additions & 5 deletions src/Demo/Types.hs
Original file line number Diff line number Diff line change
@@ -1,3 +1,5 @@
{- Some types and constructors for the project -}

module Demo.Types ( InputState (..)
, emptyInput
, emptyCell
Expand All @@ -15,23 +17,23 @@ module Demo.Types ( InputState (..)

import qualified Data.Map as M (Map, empty, lookup, insert)

{- Here's a map of how these types are used:
{- Here's a map of how the main types are used:

InputState ---> Diagram ---> Layout ----*----> Drawable
InputState ---> Diagram ---> Layout ----*----> LayoutD
/
(canvas dimensions) ----*
-}

-- (Cell Index, Cell contents)
-- (cell Index, cell contents)
type Cell = (Int, String)
-- M.Map (Cell Index) Cell
-- M.Map (cell Index) Cell
type MemSt = M.Map Int Cell

mkMemSt :: [Cell] -> MemSt
mkMemSt = foldr (\(i,s) -> M.insert i (i,s)) M.empty

{- InputState: The current state of all the inputs on the
the webpage right now -}
the webpage -}
data InputState = InSt { startIndex :: Int
, cellCount :: Int
, headVal :: String
Expand Down Expand Up @@ -65,4 +67,6 @@ type LElem = (DElem, (Int, Int), (Int, Int))
unit-size -}
type Layout = [LElem]

{- LayoutD: The Layout transformed with the scale-size as a Double
replacing the previous unit-size Ints -}
type LayoutD = [(DElem, (Double, Double), (Double, Double))]
72 changes: 52 additions & 20 deletions src/LinkedListDemo.hs
Original file line number Diff line number Diff line change
Expand Up @@ -14,18 +14,22 @@ defaultHeadIndex = 23
defaultNumCells = 14

main = do initializePage (defaultHeadIndex, defaultNumCells)
(draw, rando, gener, clicks, keys) <- mkSources
wireButton draw sDrawButton (cullErrors >> readInputState)

-- init and connect reactive event-sources
(draw, rando, gener, clicks, keys) <- mkSources
wireButton draw sDrawButton (cullErrors
>> readInputState)
wireButton rando sRandomButton (cullErrors
>> mkCanvas
>>mkRandomInput
>> mkRandomInput
>> readInputState)
wireButton
gener
sCellGen
(cullErrors >> generateCells >> readInputState)
wireClicks clicks
wireButton gener sCellGen (cullErrors
>> generateCells
>> readInputState)
wireClicks clicks -- does nothing for now
wireKeys keys readInputState

-- build and "actuate" the reactive event network
n <- compile (mkNetwork (draw, rando, gener, clicks, keys))
actuate n

Expand All @@ -36,6 +40,8 @@ generateCells =
Right (start,size) -> initializePage (start,size)
Left err -> printHighError err

{- Tests number of cells and starting index to make sure they're valid.
Readability as Ints was already checked for in JS.hs code -}
checkGenInfo :: (Int,Int) -> Either String (Int,Int)
checkGenInfo (i,s)
| i < 0 = Left "Starting Index cannot be negative"
Expand All @@ -48,50 +54,76 @@ initializePage (start,size) =
>> mkCanvas

wireClicks _ = return () -- maybe implement this later?

-- Events responding to keypresses in the memory editing area
wireKeys (addHandler, fire) f = do let handler _ = f >>= fire
box <- sLowerControls
keyup handler def box

-- convenience function for wiring all the buttons
wireButton (addHandler, fire) button f = do
let handler _ = f >>= fire
b <- button
click handler def b

-- sources are in the IO monad, so we have to do this?
mkSources = do a <- newAddHandler
b <- newAddHandler
c <- newAddHandler
d <- newAddHandler
e <- newAddHandler
return (a,b,c,d,e)

-- convenience
addHandler = fst
fire = snd

mkNetwork (drawSource, randomSource, genSource, clickSource, keySource) = do
{- And now the fun stuff, describes the reactive "signal graph" of
events and behaviors, mainly used here to control when cells
are highlighted to show that they have been edited -}
mkNetwork ( drawSource
, randomSource
, genSource
, clickSource
, keySource ) = do

eDraws <- fromAddHandler (addHandler drawSource)
eRandoms <- fromAddHandler (addHandler randomSource)
eGens <- fromAddHandler (addHandler genSource)
eKeys <- fromAddHandler (addHandler keySource)
let eResets = eRandoms `union` eGens

let -- some useful collections of event-sources
eResets = eRandoms `union` eGens
eInputs = eRandoms `union` eGens `union` eKeys
--bInputState :: Behavior t InputState
bInputState = stepper (emptyInput 5 20) eInputs
eDrawnInputState = bInputState <@ eDraws
bLastInputState = stepper (emptyInput 5 20)
(eDrawnInputState `union` eResets)

-- convenience for processing LastInputStates
bNothing :: Behavior t (Maybe InputState)
bNothing = pure Nothing
-- clicking 'draw' should only count if it actually draws
bTest :: Behavior t (InputState -> Maybe InputState)
bTest = pure (\inState -> case parseInput inState of
Left _ -> Nothing
Right _ -> Just inState)

bInputState = stepper (emptyInput 5 20) eInputs
bLastInputState =
stepper Nothing
((bTest <@> eDraws) `union` (bNothing <@ eResets))
bDirty = mismatches <$> bInputState <*> bLastInputState

cIn <- changes bInputState
cLIn <- changes bLastInputState
cDirty <- changes bDirty


--reactimate' $ fmap (\is -> process is) eISChanged
--reactimate' <$> (fmap (fmap process) eISChanged)
-- Draw the list!
reactimate (fmap (\a -> mkCanvas >> process a) eDraws)
reactimate' $ fmap (\d -> mark d >> print (show d) >> return ()) <$> cDirty
-- Mark the "dirty" edited cells (or unmark them if clean)
reactimate' (fmap (\d -> mark d >> return ()) <$> cDirty)

-- (These are for debugging purposes and print only to the console)
reactimate' $ fmap (\d -> print ("InputState: " ++ show d)) <$> cIn
reactimate' $ fmap (\d -> print ("LastState: " ++ show d)) <$> cLIn
--reactimate (fmap (\_ -> fmap process bInputState) eDraws)


process :: InputState -> IO ()
process = displayOutput . fmap mkLayout . parseInput