{-# LANGUAGE ScopedTypeVariables #-}-- Copyright (C) 2007-8 JP Bernardy-- Copyright (C) 2004-5 Don Stewart - http://www.cse.unsw.edu.au/~dons-- Originally derived from: riot/UI.hs Copyright (c) Tuomo Valkonen 2004.-- | This module defines a user interface implemented using vty.moduleYi.UI.Vty(start)whereimportYi.Preludehiding((<|>))importPrelude(map,take,zip,repeat,length,break,splitAt)importControl.ArrowimportControl.ConcurrentimportControl.ExceptionimportControl.Monad(forever)importControl.Monad.State(runState,get,put)importControl.Monad.Trans(liftIO,MonadIO)importData.Char(ord,chr)importData.IORefimportData.List(partition,sort,nub)importqualifiedData.List.PointedList.CircularasPLimportData.MaybeimportData.MonoidimportSystem.ExitimportSystem.Posix.Signals(raiseSignal,sigTSTP)importSystem.Posix.TerminalimportSystem.Posix.IO(stdInput)importYi.BufferimportYi.EditorimportYi.EventimportYi.StyleimportqualifiedYi.UI.CommonasCommonimportYi.ConfigimportYi.WindowimportYi.StyleasStyleimportGraphics.VtyasVtyhiding(refresh,Default)importqualifiedGraphics.VtyasVtyimportYi.Keymap(makeAction,YiM)importYi.UI.UtilsimportYi.UI.TabBardataRendered=Rendered{picture::!Image-- ^ the picture currently displayed.,cursor::!(Maybe(Int,Int))-- ^ cursor point on the above}dataUI=UI{vty::Vty-- ^ Vty,scrsize::IORef(Int,Int)-- ^ screen size,uiThread::ThreadId,uiEnd::MVar(),uiRefresh::MVar(),uiEditor::IORefEditor-- ^ Copy of the editor state, local to the UI, used to show stuff when the window is resized.,config::Config,oAttrs::TerminalAttributes}mkUI::UI->Common.UImkUIui=Common.dummyUI{Common.main=mainui,Common.end=endui,Common.suspend=raiseSignalsigTSTP,Common.refresh=refreshui,Common.layout=layoutui,Common.userForceRefresh=userForceRefreshui}-- | Initialise the uistart::UIBootstartcfgchoutCheditor=doliftIO$dooattr<-getTerminalAttributesstdInputv<-mkVtyEscDelay$configVtyEscDelay$configUI$cfgnattr<-getTerminalAttributesstdInputsetTerminalAttributesstdInput(withoutModenattrExtendedFunctions)Immediately-- remove the above call to setTerminalAttributes when vty does it.Vty.DisplayRegionx0y0<-Vty.display_bounds$Vty.terminalvsz<-newIORef(fromEnumy0,fromEnumx0)-- fork input-reading thread. important to block *thread* on getKey-- otherwise all threads will block waiting for inputtid<-myThreadIdendUI<-newEmptyMVartuiRefresh<-newEmptyMVareditorRef<-newIORefeditorletresult=UIvsztidendUItuiRefresheditorRefcfgoattr-- | Action to read characters into a channelgetcLoop=maybe(getKey>>=ch>>getcLoop)(const(return()))=<<tryTakeMVarendUI-- | Read a key. UIs need to define a method for getting events.getKey=doevent<-Vty.next_eventvcaseeventof(EvResizexy)->dologPutStrLn$"UI: EvResize: "++show(x,y)writeIORefsz(y,x)outCh[makeAction(layoutActionresult::YiM())]-- since any action will force a refresh, return () is probably -- sufficient instead of "layoutAction result"getKey_->return(fromVtyEventevent)discard$forkIOgetcLoopreturn(mkUIresult)main::UI->IO()mainui=dolet-- | When the editor state isn't being modified, refresh, then wait for-- it to be modified again.refreshLoop::IO()refreshLoop=forever$dologPutStrLn"waiting for refresh"takeMVar(uiRefreshui)handle(\(except::IOException)->dologPutStrLn"refresh crashed with IO Error"logError$show$except)(readRef(uiEditorui)>>=refreshui>>return())logPutStrLn"refreshLoop started"refreshLoop-- | Clean up and go homeend::UI->Bool->IO()endireallyQuit=doVty.shutdown(vtyi)setTerminalAttributesstdInput(oAttrsi)Immediatelydiscard$tryPutMVar(uiEndi)()whenreallyQuit$throwTo(uiThreadi)ExitSuccessreturn()fromVtyEvent::Vty.Event->Yi.Event.EventfromVtyEvent(EvKeyVty.KBackTabmods)=EventYi.Event.KTab(sort$nub$Yi.Event.MShift:mapfromVtyModmods)fromVtyEvent(EvKeykmods)=Event(fromVtyKeyk)(sort$mapfromVtyModmods)fromVtyEvent_=error"fromVtyEvent: unsupported event encountered."fromVtyKey::Vty.Key->Yi.Event.KeyfromVtyKey(Vty.KEsc)=Yi.Event.KEscfromVtyKey(Vty.KFunx)=Yi.Event.KFunxfromVtyKey(Vty.KPrtScr)=Yi.Event.KPrtScrfromVtyKey(Vty.KPause)=Yi.Event.KPausefromVtyKey(Vty.KASCII'\t')=Yi.Event.KTabfromVtyKey(Vty.KASCIIc)=Yi.Event.KASCIIcfromVtyKey(Vty.KBS)=Yi.Event.KBSfromVtyKey(Vty.KIns)=Yi.Event.KInsfromVtyKey(Vty.KHome)=Yi.Event.KHomefromVtyKey(Vty.KPageUp)=Yi.Event.KPageUpfromVtyKey(Vty.KDel)=Yi.Event.KDelfromVtyKey(Vty.KEnd)=Yi.Event.KEndfromVtyKey(Vty.KPageDown)=Yi.Event.KPageDownfromVtyKey(Vty.KNP5)=Yi.Event.KNP5fromVtyKey(Vty.KUp)=Yi.Event.KUpfromVtyKey(Vty.KMenu)=Yi.Event.KMenufromVtyKey(Vty.KLeft)=Yi.Event.KLeftfromVtyKey(Vty.KDown)=Yi.Event.KDownfromVtyKey(Vty.KRight)=Yi.Event.KRightfromVtyKey(Vty.KEnter)=Yi.Event.KEnterfromVtyKey(Vty.KBackTab)=error"This should be handled in fromVtyEvent"fromVtyMod::Vty.Modifier->Yi.Event.ModifierfromVtyModVty.MShift=Yi.Event.MShiftfromVtyModVty.MCtrl=Yi.Event.MCtrlfromVtyModVty.MMeta=Yi.Event.MMetafromVtyModVty.MAlt=Yi.Event.MMeta-- This re-computes the heights and widths of all the windows.layout::UI->Editor->IOEditorlayoutuie=do(rows,cols)<-readIORef(scrsizeui)letws=windowsetabBarHeight=ifhasTabBareuithen1else0(cmd,_)=statusLineInfoeniceCmd=arrangeItemscmdcols(maxStatusHeighte)cmdHeight=lengthniceCmdws'=applyHeights(computeHeights(rows-tabBarHeight-cmdHeight+1)ws)wsws''=fmap(apply.discardOldRegion)ws'discardOldRegionw=w{winRegion=emptyRegion}-- Discard this field, otherwise we keep retaining reference to-- old Window objects (leak)applywin=win{winRegion=getRegionImplwin(configUI$configui)ecols(heightwin)}return$windowsA^=ws''$e-- Do Vty layout inside the Yi event looplayoutAction::(MonadEditorm,MonadIOm)=>UI->m()layoutActionui=dowithEditor.put=<<io.layoutui=<<withEditorgetwithEditor$mapM_(flipwithWindowEsnapInsB)=<<getAwindowsA-- | Redraw the entire terminal from the UI.refresh::UI->Editor->IO()refreshuie=do(_,xss)<-readRef(scrsizeui)letws=windowsetabBarHeight=ifhasTabBareuithen1else0windowStartY=tabBarHeight(cmd,cmdSty)=statusLineInfoeniceCmd=arrangeItemscmdxss(maxStatusHeighte)formatCmdLinetext=withAttributesstatusBarStyle(takexss$text++repeat' ')renders=fmap(renderWindow(configUI$configui)exss)(PL.withFocusws)startXs=scanrT(+)windowStartY(fmapheightws)wImages=fmappicturerendersstatusBarStyle=((appEndo<$>cmdSty)<*>baseAttributes)$configStyle$configUI$config$uitabBarImages=renderTabBareuixsslogPutStrLn"refreshing screen."logPutStrLn$"startXs: "++showstartXsVty.update(vty$ui)(pic_for_image(vert_cattabBarImages<->vert_cat(toListwImages)<->vert_cat(fmapformatCmdLineniceCmd))){pic_cursor=casecursor(PL.focusrenders)ofJust(y,x)->Cursor(toEnumx)(toEnum$y+PL.focusstartXs)-- Add the position of the window to the position of the cursorNothing->NoCursor-- This case can occur if the user resizes the window. -- Not really nice, but upon the next refresh the cursor will show.}return()-- | Construct images for the tabbar if at least one tab exists.renderTabBar::Editor->UI->Int->[Image]renderTabBareuixss=ifhasTabBareuithen[tabImages<|>extraImage]else[]wheretabImages=foldr1(<|>)$fmaptabToVtyImage$tabBarDescreextraImage=withAttributes(tabBarAttributesuiStyle)(replicate(xss-fromEnumtotalTabWidth)' ')totalTabWidth=Vty.image_widthtabImagesuiStyle=configStyle$configUI$config$uitabTitletext=" "++text++" "baseAttrbsty=ifbthenattributesToAttr(appEndo(tabInFocusStyleuiStyle)sty)Vty.def_attrelseattributesToAttr(appEndo(tabNotFocusedStyleuiStyle)sty)Vty.def_attr`Vty.with_style`Vty.underlinetabAttrb=baseAttrb$tabBarAttributesuiStyletabToVtyImage_tab@(TabDescrtextinFocus)=Vty.string(tabAttrinFocus)(tabTitletext)-- | Determine whether it is necessary to render the tab barhasTabBar::Editor->UI->BoolhasTabBareui=(not.configAutoHideTabBar.configUI.config$ui)||(PL.length$e^.tabsA)>1-- As scanr, but generalized to a traversable (TODO)scanrT::(Int->Int->Int)->Int->PL.PointedListInt->PL.PointedListIntscanrT(+*+)kt=fst$runState(mapMft)kwherefx=dos<-getlets'=s+*+xputs'returnsgetRegionImpl::Window->UIConfig->Editor->Int->Int->RegiongetRegionImplwincfgewh=snd$drawWindowcfge(error"focus must not be used")winwh-- | Return a rendered wiew of the window.renderWindow::UIConfig->Editor->Int->(Window,Bool)->RenderedrenderWindowcfgewidth(win,hasFocus)=let(rendered,_)=drawWindowcfgehasFocuswinwidth(heightwin)inrendered-- | Draw a window-- TODO: horizontal scrolling.drawWindow::UIConfig->Editor->Bool->Window->Int->Int->(Rendered,Region)drawWindowcfgefocusedwinwh=(Rendered{picture=pict,cursor=cur},mkRegionfromMarkPointtoMarkPoint')whereb=findBufferWith(bufkeywin)esty=configStylecfgnotMini=not(isMiniwin)-- off reserves space for the mode line. The mini window does not have a mode line.off=ifnotMinithen1else0h'=h-offground=baseAttributesstywsty=attributesToAttrgroundVty.def_attreofsty=appEndo(eofStylesty)ground(point,_)=runBufferwinbpointB(eofPoint,_)=runBufferwinbsizeBregion=mkSizeRegionfromMarkPoint(Size(w*h'))-- Work around a problem with the mini window never displaying it's contents due to a-- fromMark that is always equal to the end of the buffer contents.(Just(MarkSetfromM__),_)=runBufferwinb(getMarkswin)fromMarkPoint=ifnotMinithenfst$runBufferwinb(getMarkPointBfromM)elsePoint0(text,_)=runBufferwinb(indexedAnnotatedStreamBfromMarkPoint)-- read chars from the buffer, lazily(attributes,_)=runBufferwinb$attributesPictureAndSelBsty(currentRegexe)region-- TODO: I suspect that this costs quite a lot of CPU in the "dry run" which determines the window size;-- In that case, since attributes are also useless there, it might help to replace the call by a dummy value.-- This is also approximately valid of the call to "indexedAnnotatedStreamB".colors=map(second(($Vty.def_attr).attributesToAttr))attributesbufData=-- trace (unlines (map show text) ++ unlines (map show $ concat strokes)) $ paintCharsVty.def_attrcolorstexttabWidth=tabSize.fst$runBufferwinbindentSettingsBprompt=ifisMiniwinthenminiIdentStringbelse""(rendered,toMarkPoint',cur)=drawTexth'wfromMarkPointpointtabWidth([(c,(wsty,(-1)))|c<-prompt]++bufData++[(' ',(wsty,eofPoint))])-- we always add one character which can be used to position the cursor at the end of file(modeLine0,_)=runBufferwinb$getModeLine(commonNamePrefixe)modeLine=ifnotMinithenJustmodeLine0elseNothingmodeLines=map(withAttributesmodeStyle.takew.(++repeat' '))$maybeToList$modeLinemodeStyle=(iffocusedthenappEndo(modelineFocusStylesty)elseid)(modelineAttributessty)filler=takew(configWindowFillcfg:repeat' ')pict=vert_cat(takeh'(rendered++repeat(withAttributeseofstyfiller))++modeLines)-- | Renders text in a rectangle.-- This also returns -- * the index of the last character fitting in the rectangle-- * the position of the Point in (x,y) coordinates, if in the window.drawText::Int-- ^ The height of the part of the window we are in->Int-- ^ The width of the part of the window we are in->Point-- ^ The position of the first character to draw->Point-- ^ The position of the cursor->Int-- ^ The number of spaces to represent a tab character with.->[(Char,(Vty.Attr,Point))]-- ^ The data to draw.->([Image],Point,Maybe(Int,Int))drawTexthwtopPointpointtabWidthbufData|h==0||w==0=([],topPoint,Nothing)|otherwise=(rendered_lines,bottomPoint,pntpos)wherelns0=takeh$concatMap(wrapLinew)$map(concatMapexpandGraphic)$takeh$lines'$bufDatabottomPoint=caselns0of[]->topPoint_->snd$snd$last$last$lns0pntpos=listToMaybe[(y,x)|(y,l)<-zip[0..]lns0,(x,(_char,(_attr,p)))<-zip[0..]l,p==point]-- fill lines with blanks, so the selection looks ok.rendered_lines=mapfillColorLinelns0colorChar(c,(a,_aPoint))=Vty.characfillColorLine::[(Char,(Vty.Attr,Point))]->ImagefillColorLine[]=char_fillVty.def_attr' 'w1fillColorLinel=horiz_cat(mapcolorCharl)<|>char_filla' '(w-lengthl)1where(_,(a,_x))=lastl-- | Cut a string in lines separated by a '\n' char. Note-- that we add a blank character where the \n was, so the-- cursor can be positioned there.lines'::[(Char,a)]->[[(Char,a)]]lines'[]=[]lines's=cases'of[]->[l]((_,x):s'')->(l++[(' ',x)]):lines's''where(l,s')=break((=='\n').fst)swrapLine::Int->[x]->[[x]]wrapLine_[]=[]wrapLinenl=let(x,rest)=splitAtnlinx:wrapLinenrestexpandGraphic('\t',p)=replicatetabWidth(' ',p)expandGraphic(c,p)|ordc<32=[('^',p),(chr(ordc+64),p)]|otherwise=[(c,p)]withAttributes::Attributes->String->ImagewithAttributesstystr=Vty.string(attributesToAttrstyVty.def_attr)str------------------------------------------------------------------------userForceRefresh::UI->IO()userForceRefresh=Vty.refresh.vty-- | Calculate window heights, given all the windows and current height.-- (No specific code for modelines)computeHeights::Int->PL.PointedListWindow->[Int]computeHeightstotalHeightws=((y+r-1):repeaty)where(mwls,wls)=partitionisMini(toListws)(y,r)=getY(totalHeight-lengthmwls)(lengthwls)getY::Int->Int->(Int,Int)getYscreenHeight0=(screenHeight,0)getYscreenHeightnumberOfWindows=screenHeight`quotRem`numberOfWindows-------------------------------- Low-level stuff-------------------------------------------------------------------------- | Convert a Yi Attr into a Vty attribute change.colorToAttr::(Vty.Color->Vty.Attr->Vty.Attr)->Vty.Color->Style.Color->(Vty.Attr->Vty.Attr)colorToAttrsetunknownc=casecofRGB000->setVty.blackRGB128128128->setVty.bright_blackRGB13900->setVty.redRGB25500->setVty.bright_redRGB01000->setVty.greenRGB01280->setVty.bright_greenRGB1654242->setVty.yellowRGB2552550->setVty.bright_yellowRGB00139->setVty.blueRGB00255->setVty.bright_blueRGB1280128->setVty.magentaRGB2550255->setVty.bright_magentaRGB0139139->setVty.cyanRGB0255255->setVty.bright_cyanRGB165165165->setVty.whiteRGB255255255->setVty.bright_whiteDefault->id_->setunknown-- NBattributesToAttr::Attributes->(Vty.Attr->Vty.Attr)attributesToAttr(Attributesfgbgreversebd_itlcunderline')=(ifreversethen(flipVty.with_styleVty.reverse_video)elseid).(ifbdthen(flipVty.with_styleVty.bold)elseid).(ifunderline'then(flipVty.with_styleVty.underline)elseid).colorToAttr(flipVty.with_fore_color)Vty.blackfg.colorToAttr(flipVty.with_back_color)Vty.whitebg----------------------------------- | Apply the attributes in @sty@ and @changes@ to @cs@. If the-- attributes are not used, @sty@ and @changes@ are not evaluated.paintChars::a->[(Point,a)]->[(Point,Char)]->[(Char,(a,Point))]paintCharsstychangescs=[(c,(s,p))|((p,c),s)<-zipcsattrs]whereattrs=lazy(stysstychangescs)lazy::[a]->[a]lazyl=headl:lazy(taill)stys::a->[(Point,a)]->[(Point,Char)]->[a]styssty[]cs=[sty|_<-cs]styssty((endPos,sty'):xs)cs=[sty|_<-previous]++styssty'xslaterwhere(previous,later)=break((endPos<=).fst)cs