Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

first commit

  • Loading branch information...
commit 13104d3a469311c73e8791c4d61ba3a1928c470c 0 parents
@michaelfeathers authored
Showing with 260 additions and 0 deletions.
  1. +119 −0 editbuffer.hs
  2. +18 −0 input.hs
  3. +22 −0 license.txt
  4. +42 −0 rendering.hs
  5. +59 −0 vih.hs
119 editbuffer.hs
@@ -0,0 +1,119 @@
+
+module EditBuffer
+ ( EditBuffer(..)
+ , Location
+ , emptyBuffer
+ , enterCommandMode
+ , getBufferContents
+ , lineCount
+ , insertChar, deleteChar
+ , insertLineAfter
+ , deleteLine
+ , moveLeft, moveRight, moveUp, moveDown
+ , moveToHome, moveToEnd
+ , moveToLineStart, moveToLineEnd
+ , showRepresentation
+ )
+where
+
+type Location = (Int, Int)
+data EditBuffer = EditBuffer Location String deriving Show
+
+emptyBuffer = EditBuffer (0,0) ""
+
+enterCommandMode :: EditBuffer -> EditBuffer
+enterCommandMode = forceLocation
+
+getBufferContents:: EditBuffer -> String
+getBufferContents (EditBuffer _ contents) = contents
+
+lineCount :: EditBuffer -> Int
+lineCount (EditBuffer _ contents) = length . lines $ contents
+
+insertChar :: Char -> EditBuffer -> EditBuffer
+insertChar ch buffer@(EditBuffer (x, y) contents)
+ | ch == '\n' = EditBuffer (0, y+1) newContents
+ | otherwise = EditBuffer (x+1, y) newContents
+ where newContents = before ++ [ch] ++ after
+ (before, after) = split buffer
+
+deleteChar :: EditBuffer -> EditBuffer
+deleteChar buffer@(EditBuffer location@(x,y) contents)
+ | (currentLineLength buffer == 0) = buffer
+ | otherwise = satX 0 (EditBuffer location newContents)
+ where newContents = before ++ (tail after)
+ (before, after) = split buffer
+
+insertLineAfter :: EditBuffer -> EditBuffer
+insertLineAfter (EditBuffer _ "") = EditBuffer (0,1) "\n"
+insertLineAfter (EditBuffer (_,y) contents) = EditBuffer (0,y+1) newContents
+ where newContents = unlines [transform numberedLine | numberedLine <- zip (lines contents) [0..]]
+ transform (line, pos) = if pos == y then line ++ "\n" else line
+
+deleteLine :: EditBuffer ->EditBuffer
+deleteLine (EditBuffer location@(_,y) contents) = forceLocation (EditBuffer location newContents)
+ where newContents = unlines [ line | (line, pos) <- zip (lines contents) [0..], pos /= y]
+
+moveLeft, moveRight, moveUp, moveDown :: EditBuffer -> EditBuffer
+moveLeft = saturate (-1, 0)
+moveRight = saturate ( 1, 0)
+moveUp = saturate ( 0,-1)
+moveDown = saturate ( 0, 1)
+
+moveToHome :: EditBuffer -> EditBuffer
+moveToHome (EditBuffer _ contents) = EditBuffer (0,0) contents
+
+moveToEnd :: EditBuffer -> EditBuffer
+moveToEnd = saturate (lastPos, lastPos)
+ where lastPos = (maxBound :: Int) - 1
+
+moveToLineStart :: EditBuffer -> EditBuffer
+moveToLineStart (EditBuffer (_,y) contents) = EditBuffer (0,y) contents
+
+moveToLineEnd :: EditBuffer -> EditBuffer
+moveToLineEnd buffer@(EditBuffer (_,y) contents) =
+ satX 0 $ (EditBuffer ((currentLineLength buffer), y) contents)
+
+showRepresentation :: EditBuffer -> String
+showRepresentation (EditBuffer location contents) =
+ show location ++ " " ++ show contents
+
+
+forceLocation = saturate (0,0)
+
+currentLine :: EditBuffer -> String
+currentLine (EditBuffer _ "") = ""
+currentLine buffer@(EditBuffer (_, y) contents)
+ | (y < 0) || (y >= (lineCount buffer)) = ""
+ | otherwise = (lines contents) !! y
+
+currentLineLength :: EditBuffer -> Int
+currentLineLength = length . currentLine
+
+split :: EditBuffer -> (String,String)
+split buffer@(EditBuffer _ contents) = splitAt point contents
+ where point = absPosition buffer
+
+absPosition :: EditBuffer -> Int
+absPosition (EditBuffer (x, y) contents) =
+ (x+) . length . unlines . take y . lines $ contents
+
+saturate :: (Int,Int) -> EditBuffer -> EditBuffer
+saturate (adjX,adjY) = satX adjX . satY adjY
+
+satX :: Int -> EditBuffer -> EditBuffer
+satX adjX buffer@(EditBuffer (x,y) contents) =
+ EditBuffer (saturateValue (currentLineLength buffer) (x + adjX), y) contents
+
+satY :: Int -> EditBuffer -> EditBuffer
+satY adjY buffer@(EditBuffer (x,y) contents) =
+ EditBuffer (x, saturateValue (lineCount buffer) (y + adjY)) contents
+
+saturateValue :: Int -> Int -> Int
+saturateValue bound value
+ | bound <= 1 = 0
+ | value <= 0 = 0
+ | value >= bound = bound - 1
+ | otherwise = value
+
+
18 input.hs
@@ -0,0 +1,18 @@
+
+
+module Input(initInput,getInputChar) where
+
+import System.IO
+import IO
+
+initInput :: IO ()
+initInput = do hSetBuffering stdin NoBuffering
+
+getInputChar :: IO Char
+getInputChar =
+ do hSetEcho stdin False
+ c <- getChar
+ hSetEcho stdin True
+ return c
+
+
22 license.txt
@@ -0,0 +1,22 @@
+# Copyright (c) 2009 Michael Feathers
+#
+# Permission is hereby granted, free of charge, to any person
+# obtaining a copy of this software and associated documentation
+# files (the "Software"), to deal in the Software without
+# restriction, including without limitation the rights to use,
+# copy, modify, merge, publish, distribute, sublicense, and/or sell
+# copies of the Software, and to permit persons to whom the
+# Software is furnished to do so, subject to the following
+# conditions:
+#
+# The above copyright notice and this permission notice shall be
+# included in all copies or substantial portions of the Software.
+#
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
+# OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+# NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+# HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+# WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
+# OTHER DEALINGS IN THE SOFTWARE.
42 rendering.hs
@@ -0,0 +1,42 @@
+
+
+module Rendering
+ ( render
+ , cls
+ , goto
+ , home
+ , commandHome
+ , writeAt
+ )
+where
+
+import EditBuffer
+import IO
+
+yExtent :: Int
+yExtent = 40
+
+home :: Location
+home = (0,0)
+
+commandHome :: Location
+commandHome = (0, yExtent + 1)
+
+cls :: IO ()
+cls = putStr "\ESC[2J"
+
+render :: String -> IO ()
+render s = do
+ writeAt home $ frame screenLines
+ where frame = unlines . take yExtent
+ screenLines = (lines s) ++ (repeat "~")
+
+goto :: Location -> IO ()
+goto (x,y) =
+ putStr ("\ESC[" ++ show (y + 1) ++ "; " ++ show (x + 1) ++ "H")
+
+writeAt :: Location -> String -> IO ()
+writeAt location xs = do
+ goto location
+ putStr xs
+
59 vih.hs
@@ -0,0 +1,59 @@
+
+import EditBuffer
+import Rendering
+import Input
+import Char
+
+data EditMode = Command | Insert deriving (Eq,Show)
+
+vih :: IO ()
+vih =
+ do initInput
+ mainLoop Command emptyBuffer
+
+mainLoop :: EditMode -> EditBuffer -> IO ()
+mainLoop mode buffer@(EditBuffer location contents) =
+ do cls
+ render $ getBufferContents buffer
+ -- writeAt commandHome (showRepresentation buffer)
+ goto location
+ ch <- getInputChar
+ if mode == Insert
+ then
+ case ch of
+ '\ESC' -> mainLoop Command (enterCommandMode buffer)
+ _ -> if not (isControl ch)
+ then mainLoop mode (insertChar ch buffer)
+ else mainLoop mode buffer
+ else
+ case ch of
+ ':' -> handleCommandLine buffer
+ 'i' -> mainLoop Insert buffer
+ 'h' -> mainLoop mode (moveLeft buffer)
+ 'j' -> mainLoop mode (moveDown buffer)
+ 'k' -> mainLoop mode (moveUp buffer)
+ 'l' -> mainLoop mode (moveRight buffer)
+ 'd' -> do nextCh <- getInputChar
+ if nextCh == 'd'
+ then mainLoop mode (deleteLine buffer)
+ else mainLoop mode buffer
+ 'g' -> do nextCh <- getInputChar
+ if nextCh == 'g'
+ then mainLoop mode (moveToHome buffer)
+ else mainLoop mode buffer
+ 'G' -> mainLoop mode (moveToEnd buffer)
+ '0' -> mainLoop mode (moveToLineStart buffer)
+ '$' -> mainLoop mode (moveToLineEnd buffer)
+ 'o' -> mainLoop Insert (insertLineAfter buffer)
+ 'x' -> mainLoop mode (deleteChar buffer)
+ _ -> mainLoop mode buffer
+
+
+handleCommandLine :: EditBuffer -> IO ()
+handleCommandLine buffer =
+ do goto commandHome
+ putStr ":"
+ command <- getLine
+ if head command == 'q'
+ then return ()
+ else mainLoop Command buffer
Please sign in to comment.
Something went wrong with that request. Please try again.