CS-565
/
Homework-4
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Add code to display table.

This commit is contained in:
Danila Fedorin 2021-05-16 21:00:04 -07:00
parent 39764dd4a5
commit 3a237d0d0e
3 changed files with 206 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

65
scss/style.scss
View File

@ -1,13 +1,18 @@
$off-grey-color: #ededed;
$off-color: #eef2f9;
html {
height: 100%;
}
body {
font-family: sans-serif;
margin: 2rem;
height: 100%;
}
.main {
margin: auto;
max-width: 1600px;
}
.split-pane {
@ -17,6 +22,9 @@ body {
.split-elem {
flex-grow: 1;
flex-shrink: 0;
flex-basis: 40%;
margin: 0.25rem;
}
.table-wrapper {
@ -27,6 +35,7 @@ body {
display: inline-block;
margin-top: 1rem;
box-shadow: 0px 0px 5px rgba(grey, 0.1);
box-sizing: border-box;
}
.class-table {
@ -70,16 +79,52 @@ body {
border-radius: 0.25rem;
vertical-align: middle;
}
&.color-green {
background-color: lighten(#5bc275, 30%);
border-color: #5bc275;
color: darken(#5bc275, 30%);
}
.color-green {
background-color: lighten(#5bc275, 30%);
border-color: #5bc275;
color: darken(#5bc275, 30%);
}
&.color-red {
background-color: lighten(#c25b75, 30%);
border-color: #c25b75;
color: darken(#c25b75, 30%);
.color-red {
background-color: lighten(#c25b75, 30%);
border-color: #c25b75;
color: darken(#c25b75, 30%);
}
.week-grid {
display: grid;
width: 100%;
height: 50vh;
grid-template-columns: auto repeat(7, 1fr);
grid-template-rows: auto repeat(10, 1fr);
}
.course-block {
position: absolute;
border: 1px solid;
border-radius: 0.25rem;
padding: 0.25rem;
box-sizing: border-box;
overflow: hidden;
text-overflow: ellipsis;
&.selected {
border-style: dashed;
border-width: 2px;
}
}
.column-container {
position: relative;
padding: 0.25rem;
box-sizing: border-box;
border-left: 0.5px solid lighten(grey, 20%);
border-right: 0.5px solid lighten(grey, 20%);
}
.table-day-header {
padding: 0.25rem;
text-align: center;
}

143
src/ClassSchedule/View.elm
View File

@ -1,7 +1,7 @@
module ClassSchedule.View exposing (..)
import ClassSchedule.Model exposing (..)
import Html exposing (Html, Attribute, div, text, table, td, th, tr, span, input, h1)
import Html.Attributes exposing (class, classList, type_)
import Html.Attributes exposing (class, classList, type_, style)
import Html.Events exposing (onClick)
import Tuple exposing (..)
import Dict exposing (..)
@ -35,7 +35,7 @@ viewTime : Time -> String
viewTime (m, h, dh) = viewTimeNumber m ++ ":" ++ viewTimeNumber h ++ viewDayHalf dh
viewTimeRange : (Time, Time) -> String
viewTimeRange (t1, t2) = viewTime t1 ++ " to " ++ viewTime t2
viewTimeRange (t1, t2) = viewTime t1 ++ "-" ++ viewTime t2
viewDayCode : DayOfWeek -> String
viewDayCode dw =
@ -121,10 +121,143 @@ viewClassList m = div []
Nothing -> text "Please select a term!"
]
hour24 : Time -> Int
hour24 (h, _, th) = if th == AM then h else h + 12
from24 : Int -> Time
from24 i = (modBy 12 i, 0, if i >= 12 then PM else AM)
timeSortable : Time -> Int
timeSortable (h, m, th) = hour24 (h,m,th) * 60 + m
rangeSortable : (Time, Time) -> (Int, Int)
rangeSortable (t1, t2) = (timeSortable t1, -(timeSortable t2))
toHourCount : Time -> Time -> Float
toHourCount t1 t2 = toFloat (timeSortable t2 - timeSortable t1) / 60
maxTime : Time -> Time -> Time
maxTime t1 t2 = if timeSortable t1 > timeSortable t2 then t1 else t2
index : List a -> List (Int, a)
index =
let
indexWith n l =
case l of
[] -> []
(x::xs) -> (n,x) :: indexWith (n+1) xs
in indexWith 0
type alias SelectionReason = (CourseStatus, Bool)
findDay : Maybe Int -> DayOfWeek -> List (CourseStatus, Course) -> List (Course, SelectionReason, (Time, Time))
findDay ms dw l =
let
find (cs, b, c) = List.filter (\(ndw, _, _) -> ndw == dw) c.times
|> List.map (\(_, t1, t2) -> (c, (cs, b), (t1, t2)))
active (i, (cs, c)) =
if cs == Added || ms == Just i
then Just (cs, ms == Just i, c)
else Nothing
in
index l
|> List.filterMap active
|> List.concatMap find
findGroups : List (Course, SelectionReason, (Time, Time)) -> List (List (Course, SelectionReason, (Time, Time)))
findGroups cs =
let
findGroupsRec acc mt rcs =
case rcs of
[] ->
case acc of
[] -> []
_ -> [List.reverse acc]
((c, sr, (t1, t2))::trcs) ->
if timeSortable mt > timeSortable t1
then findGroupsRec ((c,sr,(t1,t2))::acc) (maxTime t2 mt) trcs
else List.reverse acc :: findGroupsRec [(c, sr, (t1, t2))] (maxTime t2 mt) trcs
in
findGroupsRec [] (0, 0, AM) <| List.sortBy (\(_, _, r) -> rangeSortable r) cs
type alias CellInfo =
{ width : Float
, height : Float
, verticalOffset : Float
, index : Int
, reason : SelectionReason
}
const : a -> b -> a
const x _ = x
mergeDicts : (a -> a -> a) -> Dict comparable a -> Dict comparable a -> Dict comparable a
mergeDicts f d1 d2 = Dict.merge Dict.insert (\k a b -> Dict.insert k (f a b)) Dict.insert d1 d2 Dict.empty
groupDims : List (Course, SelectionReason, (Time, Time)) -> Dict Int (List (Course, CellInfo))
groupDims l =
let
width = 100.0 / toFloat (List.length l)
courseInfo i (c, cr, (t1, t2)) = Dict.singleton (hour24 t1 - 8)
<| List.singleton
<| pair c
<|
{ width = width
, height = 100 * toHourCount t1 t2
, verticalOffset = let (_, m, _) = t1 in 100 * toFloat m / 60
, index = i
, reason = cr
}
in
List.foldl (mergeDicts (++)) Dict.empty <| List.indexedMap courseInfo l
days : List DayOfWeek
days = [Monday, Tuesday, Wednesday, Thursday, Friday, Saturday, Sunday]
buildCellDict : Maybe Int -> List (CourseStatus, Course) -> Dict Int (Dict Int (List (Course, CellInfo)))
buildCellDict ms l =
let
singleDay i dw = findDay ms dw l
|> findGroups
|> List.map groupDims
|> List.foldl (mergeDicts (++)) Dict.empty
|> Dict.singleton i
in
List.foldl Dict.union Dict.empty <| List.indexedMap singleDay days
viewCourseBlock : CellInfo -> String -> Html Msg
viewCourseBlock ci s =
let
ps f = String.fromFloat f ++ "%"
nw = if (ci.width) == 100.0 then 100.0 else (ci.width)*0.95
(ad, sel) = ci.reason
in div
[ class "course-block"
, style "width" (ps nw)
, style "height" (ps (ci.height))
, style "left" (ps (toFloat ci.index * ci.width))
, style "top" (ps (ci.verticalOffset))
, classList [("selected", sel), ("color-green", ad == Added)]
]
[ text s ]
viewTableDayHeader : DayOfWeek -> Html Msg
viewTableDayHeader dw = span [ class "table-day-header" ] [ text <| viewDayCode dw ]
viewClassSchedule : Model -> Html Msg
viewClassSchedule m = div [ class "table-wrapper" ]
[ text "Nothing here yet!"
]
viewClassSchedule m =
let
header = span [] [] :: List.map viewTableDayHeader days
cellDict = buildCellDict m.selected (Maybe.withDefault [] <| Dict.get m.term m.terms)
times = List.range 0 10
time h = List.map (\w -> Maybe.withDefault [] <| Maybe.andThen (Dict.get h) <| Dict.get w cellDict) (List.range 0 6)
container xs = div [ class "column-container" ] <|
List.map (\(c, ci) -> viewCourseBlock ci (viewCrn c.crn)) xs
in
Debug.log (Debug.toString cellDict) <| div [ class "table-wrapper", style "width" "100%", style "padding" "1rem" ]
[ div [ class "week-grid" ] <|
header ++ (List.concatMap (\i -> span [ style "padding-right" "1rem" ] [ text <| viewTime <| from24 (i+8)] :: List.map container (time i)) times)
]
viewModel : Model -> Html Msg
viewModel m = div [ class "main" ]

13
src/Main.elm
View File

@ -8,6 +8,9 @@ import Tuple exposing (..)
oneHour : Time -> (Time, Time)
oneHour t = (t, addMinutes 50 t)
twoHours : Time -> (Time, Time)
twoHours t = (t, addMinutes 110 t)
nAm : Int -> Time
nAm i = (i, 0, AM)
@ -34,6 +37,16 @@ classes =
, instructors = ["Eric Walkingshaw"]
, times = onDays [Monday, Wednesday] <| oneHour <| nAm 10
}
, { crn = (ComputerScience, 583)
, name = "Advanced Functional Programming"
, instructors = ["Eric Walkingshaw"]
, times = onDays [Monday, Wednesday] <| oneHour <| nAm 11
}
, { crn = (ComputerScience, 583)
, name = "Advanced Functional Programming"
, instructors = ["Eric Walkingshaw"]
, times = onDays [Monday, Wednesday] <| twoHours <| nAm 10
}
, { crn = (ComputerScience, 582)
, name = "Programming Languages II"
, instructors = ["Martin Erwig"]