diff --git a/scss/style.scss b/scss/style.scss index 809015c..c725499 100644 --- a/scss/style.scss +++ b/scss/style.scss @@ -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; +} diff --git a/src/ClassSchedule/View.elm b/src/ClassSchedule/View.elm index 3e7b1e7..61301f4 100644 --- a/src/ClassSchedule/View.elm +++ b/src/ClassSchedule/View.elm @@ -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" ] diff --git a/src/Main.elm b/src/Main.elm index 5ecfba6..2ff070b 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -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"]