structure TextBuilder = struct structure TC = TextConstants type env_data = { charR: Real32.real , charG: Real32.real , charB: Real32.real (* different colours for char when cursor is on char *) , cusorOnCharR: Real32.real , cusorOnCharG: Real32.real , cusorOnCharB: Real32.real , cursorR: Real32.real , cursorG: Real32.real , cursorB: Real32.real , highlightR: Real32.real , highlightG: Real32.real , highlightB: Real32.real , charZ: Real32.real , cursorZ: Real32.real , highlightZ: Real32.real , startX: int , startY: int , scrollColumnStart: int , scrollColumnEnd: int , lastLineNumber: int (* fw/fh = float window width and float window height *) , fw: Real32.real , fh: Real32.real , msgs: MailboxType.t list , searchList: int vector , searchLen: int } (* different functions to make vectors of different things we want to draw. *) fun makeCursor (posX, posY, env: t) = Rect.lerp ( Real32.fromInt (posX - 1) , Real32.fromInt posY , #cursorZ env , scale , #fw env , #fh env , #cursorR env , #cursorG env , #cursorB env ) fun makeHighlight (posX, posY, env: t) = Rect.lerp ( Real32.fromInt (posX - 1) , Real32.fromInt posY , #highLightZ env , scale , #fw env , #fh env , #highLightR env , #highLightG env , #highLightB env ) fun makeChr (chr, posX, posY, env: t) = CozetteAscii.make ( chr , Real32.fromInt posX , Real32.fromInt posY , #charZ env , scale , #fw env , #fh env , #charR env , #charG env , #charB env ) fun makeCursorOnChr (chr, posX, posY, env: t) = CozetteAscii.make ( chr , Real32.fromInt posX , Real32.fromInt posY , #charZ env , scale , #fw env , #fh env , #cursorOnCharR env , #cursorOnCharG env , #cursorOnCharB env ) fun buildTextString ( pos , str , stl , line , ltl , posX , posY , column , lineNumber , absIdx , cursorIdx , env: env_data , acc ) = if pos = String.size str then case (stl, ltl) of (str :: stl, line :: ltl) => buildTextString ( 0 , str , stl , line , ltl , posX , posY , column , lineNumber absIdx , cursorIdx , env , acc ) | (_, _) => acc else if column < #scrollColumnStart env then skipToColumnStart ( pos , str , stl , line , ltl , posY , lineNumber , absIdx , cursorIdx , env , acc ) else if lineNumber > #lastLineNumber env then acc else case String.sub (str, pos) of chr => raise Fail "unimplemented" fun buildTextString ( pos , str , acc , posX , posY , tl , absIdx , cursorPos , cursorAcc , bgAcc , env: env_data ) = if pos < String.size str then case String.sub (str, pos) of #" " => (* if inside cursor, then create cursorAcc; * else, just skip as usual *) if absIdx <> cursorPos then (* not in cursur *) buildTextString ( pos + 1 , str , acc , posX + xSpace , posY , tl , absIdx + 1 , cursorPos , cursorAcc , bgAcc , env ) else (* in cursor *) let val {r, g, b, fw, fh, ...} = env val cursorAcc = makeRect (posX, posY, fw, fh, r, g, b) in buildTextString ( pos + 1 , str , acc , posX + xSpace , posY , tl , absIdx + 1 , cursorPos , cursorAcc , bgAcc , env ) end | #"\n" => if posY + ySpace < #h env then if absIdx <> cursorPos then (* not in cursor position, so iterate like normal *) buildTextString ( pos + 1 , str , acc , #startX env , posY + ySpace , tl , absIdx + 1 , cursorPos , cursorAcc , bgAcc , env ) else (* in cursor position, so build cursorAcc *) let val {r, g, b, fw, fh, ...} = env val cursorAcc = makeRect (posX, posY, fw, fh, r, g, b) in buildTextString ( pos + 1 , str , acc , #startX env , posY + ySpace , tl , absIdx + 1 , cursorPos , cursorAcc , bgAcc , env ) end else accToDrawMsg (acc, cursorAcc, bgAcc, env) | chr => let in if absIdx <> cursorPos then (* not equal to cursor *) if posX + xSpace < #w env then let val {r, g, b, fw, fh, ...} = env val chrVec = makeChr (chr, posX, posY, fw, fh, r, g, b) val acc = chrVec :: acc in buildTextString ( pos + 1 , str , acc , posX + xSpace , posY , tl , absIdx + 1 , cursorPos , cursorAcc , bgAcc , env ) end else if posY + ySpace < #h env then let val {r, g, b, fw, fh, ...} = env val chrVec = makeChr (chr, #startX env, posY + ySpace, fw, fh, r, g, b) val acc = chrVec :: acc in buildTextString ( pos + 1 , str , acc , #startX env + xSpace , posY + ySpace , tl , absIdx + 1 , cursorPos , cursorAcc , bgAcc , env ) end else accToDrawMsg (acc, cursorAcc, bgAcc, env) else (* equal to cursor *) let val {fw, fh, r, g, b, hr, hg, hb, ...} = env val cursorAcc = makeRect (posX, posY, fw, fh, r, g, b) in if posX + xSpace < #w env then let val chrVec = makeChr (chr, posX, posY, fw, fh, hr, hg, hb) val acc = chrVec :: acc in (* can start building after cursor now, * since cursor was built *) buildTextString ( pos + 1 , str , acc , posX + xSpace , posY , tl , absIdx + 1 , cursorPos , cursorAcc , bgAcc , env ) end else if posY + ySpace < #h env then let val chrVec = makeChr (chr, #startX env, posY + ySpace, fw, fh, hr, hg, hb) val acc = chrVec :: acc in (* can start building after cursor now, * since cursor was built *) buildTextString ( pos + 1 , str , acc , #startX env + xSpace , posY + ySpace , tl , absIdx + 1 , cursorPos , cursorAcc , bgAcc , env ) end else accToDrawMsg (acc, cursorAcc, bgAcc, env) end end else (* change to searching in string's tl *) case tl of hd :: tl => buildTextString ( 0 , hd , acc , posX , posY , tl , absIdx , cursorPos , cursorAcc , bgAcc , env ) | [] => accToDrawMsg (acc, cursorAcc, bgAcc, env) fun isInSearchRange (absIdx, searchPos, searchList, searchLen) = let val searchIdx = Vector.sub (searchList, searchPos) in absIdx >= searchIdx andalso absIdx < searchIdx + searchLen end fun isAfterSearchRange (absIdx, searchPos, searchList, searchLen) = let val searchIdx = Vector.sub (searchList, searchPos) in absIdx >= searchIdx + searchLen end fun advanceSearchPos (absIdx, searchPos, searchList, searchLen) = if isAfterSearchRange (absIdx, searchPos, searchList, searchLen) then searchPos + 1 else searchPos local fun loop (pos, str, posX, posY, endX, acc, floatWindowWidth, floatWindowHeight) = if pos = String.size str then acc else if posX + TC.xSpace >= endX then acc else let val chr = String.sub (str, pos) val r: Real32.real = 0.67 val g: Real32.real = 0.51 val b: Real32.real = 0.83 val chr = makeChr (chr, posX, posY, floatWindowWidth, floatWindowHeight, r, g, b) val acc = chr :: acc val nextPosX = posX + TC.xSpace in loop ( pos + 1 , str , nextPosX , posY , endX , acc , floatWindowWidth , floatWindowHeight ) end in (* builds a single text line from a string. * Used for getting Real32.real vector representing search input. * Todo: Add | cursor to show position of search-string-cursor. *) fun buildLineToList (str, startX, startY, endX, floatWindowWidth, floatWindowHeight) = let val r: Real32.real = 0.67 val g: Real32.real = 0.51 val b: Real32.real = 0.83 val acc = makeChr (#"/", startX, startY, floatWindowWidth, floatWindowHeight, r, g, b) val posX = startX + TC.xSpace in loop ( 0 , str , posX , startY , endX , [acc] , floatWindowWidth , floatWindowHeight ) end end fun buildTextStringSearch ( pos , str , acc , posX , posY , tl , absIdx , cursorPos , cursorAcc , bgAcc , env: env_data , searchPos ) = if searchPos = Vector.length (#searchList env) then (* exhausted search list so call normal build function *) buildTextString ( pos , str , acc , posX , posY , tl , absIdx , cursorPos , cursorAcc , bgAcc , env ) else let val searchPos = advanceSearchPos (absIdx, searchPos, #searchList env, #searchLen env) in if searchPos = Vector.length (#searchList env) then (* exhausted search list so call normal build function *) buildTextString ( pos , str , acc , posX , posY , tl , absIdx , cursorPos , cursorAcc , bgAcc , env ) else if pos < String.size str then case String.sub (str, pos) of #" " => (* if inside cursor, then create cursorAcc; * else, just skip as usual *) if absIdx <> cursorPos then (* not in cursur *) if isInSearchRange (absIdx, searchPos, #searchList env, #searchLen env) then (* draw *) let (* todo: temp colours *) val r: Real32.real = 0.3 val g: Real32.real = 0.1 val b: Real32.real = 0.1 val {fw, fh, ...} = env val space = makeRect (posX, posY, fw, fh, r, g, b) val bgAcc = space :: bgAcc in buildTextStringSearch ( pos + 1 , str , acc , posX + xSpace , posY , tl , absIdx + 1 , cursorPos , cursorAcc , bgAcc , env , searchPos ) end else buildTextStringSearch ( pos + 1 , str , acc , posX + xSpace , posY , tl , absIdx + 1 , cursorPos , cursorAcc , bgAcc , env , searchPos ) else (* in cursor *) let val {fw, fh, r, g, b, ...} = env val cursorAcc = makeRect (posX, posY, fw, fh, r, g, b) in buildTextStringSearch ( pos + 1 , str , acc , posX + xSpace , posY , tl , absIdx + 1 , cursorPos , cursorAcc , bgAcc , env , searchPos ) end | #"\n" => if posY + ySpace < #h env then if absIdx <> cursorPos then (* not in cursor position, so iterate like normal *) buildTextStringSearch ( pos + 1 , str , acc , #startX env , posY + ySpace , tl , absIdx + 1 , cursorPos , cursorAcc , bgAcc , env , searchPos ) else (* in cursor position, so build cursorAcc *) let val {fw, fh, r, g, b, ...} = env val cursorAcc = makeRect (posX, posY, fw, fh, r, g, b) in buildTextStringSearch ( pos + 1 , str , acc , #startX env , posY + ySpace , tl , absIdx + 1 , cursorPos , cursorAcc , bgAcc , env , searchPos ) end else accToDrawMsg (acc, cursorAcc, bgAcc, env) | chr => let val chrFun = Vector.sub (CozetteAscii.asciiTable, Char.ord chr) in if absIdx <> cursorPos then (* not equal to cursor *) if posX + xSpace < #w env then if isInSearchRange (absIdx, searchPos, #searchList env, #searchLen env) then let val {fw, fh, ...} = env (* todo: temp colours *) val r: Real32.real = 0.7 val g: Real32.real = 0.7 val b: Real32.real = 0.7 (* build char vec *) val chrVec = makeChr (chr, posX, posY, fw, fh, r, g, b) val acc = chrVec :: acc (* build cursor (behind text) vec *) val r: Real32.real = 0.3 val g: Real32.real = 0.1 val b: Real32.real = 0.1 val space = makeRect (posX, posY, fw, fh, r, g, b) val bgAcc = space :: bgAcc in buildTextStringSearch ( pos + 1 , str , acc , posX + xSpace , posY , tl , absIdx + 1 , cursorPos , cursorAcc , bgAcc , env , searchPos ) end else let val {fw, fh, r, g, b, ...} = env val chrVec = makeChr (chr, posX, posY, fw, fh, r, g, b) val acc = chrVec :: acc in buildTextStringSearch ( pos + 1 , str , acc , posX + xSpace , posY , tl , absIdx + 1 , cursorPos , cursorAcc , bgAcc , env , searchPos ) end else if posY + ySpace < #h env then let val {fw, fh, r, g, b, ...} = env val chrVec = makeChr (chr, #startX env, posY + ySpace, fw, fh, r, g, b) val acc = chrVec :: acc in buildTextStringSearch ( pos + 1 , str , acc , #startX env + xSpace , posY + ySpace , tl , absIdx + 1 , cursorPos , cursorAcc , bgAcc , env , searchPos ) end else accToDrawMsg (acc, cursorAcc, bgAcc, env) else (* equal to cursor *) let val {fw, fh, r, g, b, hr, hg, hb, ...} = env val cursorAcc = makeRect (posX, posY, fw, fh, r, g, b) in if posX + xSpace < #w env then let val chrVec = makeChr (chr, posX, posY, fw, fh, hr, hg, hb) val acc = chrVec :: acc in (* can start building after cursor now, * since cursor was built *) buildTextStringSearch ( pos + 1 , str , acc , posX + xSpace , posY , tl , absIdx + 1 , cursorPos , cursorAcc , bgAcc , env , searchPos ) end else if posY + ySpace < #h env then let val chrVec = makeChr (chr, #startX env, posY + ySpace, fw, fh, hr, hg, hb) val acc = chrVec :: acc in (* can start building after cursor now, * since cursor was built *) buildTextStringSearch ( pos + 1 , str , acc , #startX env + xSpace , posY + ySpace , tl , absIdx + 1 , cursorPos , cursorAcc , bgAcc , env , searchPos ) end else accToDrawMsg (acc, cursorAcc, bgAcc, env) end end else (* change to searching in string's tl *) case tl of hd :: tl => buildTextStringSearch ( 0 , hd , acc , posX , posY , tl , absIdx , cursorPos , cursorAcc , bgAcc , env , searchPos ) | [] => accToDrawMsg (acc, cursorAcc, bgAcc, env) end (* gets line start idx, relative to right hd *) fun helpGetLineStartIdx (startLine, curLine, rLnHd) = if startLine > curLine then let val lnPos = startLine - curLine - 1 in Vector.sub (rLnHd, lnPos) + 1 end else 0 (* gets line start idx, absolute *) fun helpGetLineAbsIdx (curIdx, startLine, curLine, rLnHd) = let val startIdx = if startLine > curLine then let val lnPos = startLine - curLine - 1 in Vector.sub (rLnHd, lnPos) + 1 end else 0 in curIdx + startIdx end fun getLineAbsIdx (startLine, lineGap: LineGap.t) = let val {rightLines, line = curLine, idx = curIdx, ...} = lineGap in case rightLines of rLnHd :: _ => helpGetLineAbsIdx (curIdx, startLine, curLine, rLnHd) | [] => (* should never happen *) 0 end fun initEnv ( windowWidth , windowHeight , floatWindowWidth , floatWindowHeight , msgs , searchList , searchLen ) = if TC.textLineWidth > windowWidth then { w = windowWidth , h = windowHeight , startX = 5 , startY = 5 , z = 0.01 , fw = floatWindowWidth , fh = floatWindowHeight , r = 0.67 , g = 0.51 , b = 0.83 , hr = 0.211 , hg = 0.219 , hb = 0.25 , msgs = msgs , searchList = searchList , searchLen = searchLen } else let val startX = (windowWidth - TC.textLineWidth) div 2 val finishWidth = startX + TC.textLineWidth in { w = finishWidth , h = windowHeight , startX = startX , startY = 5 , z = 0.01 , fw = floatWindowWidth , fh = floatWindowHeight , r = 0.67 , g = 0.51 , b = 0.83 , hr = 0.211 , hg = 0.219 , hb = 0.25 , msgs = msgs , searchList = searchList , searchLen = searchLen } end (* todo: add startX and startY parameters, * so we can control where on the * screen the text starts from. * Not worth doing until we have/in preparation of tiling functionality *) fun buildWithExisting ( startLine , cursorPos , lineGap: LineGap.t , windowWidth , windowHeight , floatWindowWidth , floatWindowHeight , searchList: SearchList.t , searchString , msgs , textAcc , bgAcc ) = let val {rightStrings, rightLines, line = curLine, idx = curIdx, ...} = lineGap in case (rightStrings, rightLines) of (rStrHd :: rStrTl, rLnHd :: _) => let (* get relative index of line to start building from *) val startIdx = helpGetLineStartIdx (startLine, curLine, rLnHd) (* get absolute idx of line *) val absIdx = curIdx + startIdx val env = initEnv ( windowWidth , windowHeight , floatWindowWidth , floatWindowHeight , msgs , searchList , String.size searchString ) val {startX, startY, ...} = env val cursorAcc = Vector.fromList [] val searchPos = BinSearch.equalOrMore (absIdx, searchList) in buildTextStringSearch ( startIdx , rStrHd , textAcc , startX , startY , rStrTl , absIdx , cursorPos , cursorAcc , bgAcc , env , searchPos ) end | (_, _) => (* requested line goes beyond the buffer, * so just return empty list as there is nothig * else we can do. *) [] end fun build ( startLine , cursorPos , lineGap: LineGap.t , windowWidth , windowHeight , searchList: SearchList.t , searchString , msgs ) = buildWithExisting ( startLine , cursorPos , lineGap : LineGap.t , windowWidth , windowHeight , Real32.fromInt windowWidth , Real32.fromInt windowHeight , searchList : SearchList.t , searchString , msgs , [] , [] ) end