diff --git a/fcore/buffer.sml b/fcore/buffer.sml index 117bbb5..6517210 100644 --- a/fcore/buffer.sml +++ b/fcore/buffer.sml @@ -1,5 +1,9 @@ structure Buffer = struct + val xSpace = 12 + val xSpace3 = xSpace * 3 + val ySpace = 23 + (* builds text from a string with char-wrap. * char-wrap is a similar concept to word-wrap, * but it breaks on character in the middle of a word. @@ -17,7 +21,7 @@ struct (* if space, then proceed forward one char * without adding to acc *) buildTextString - ( pos + 1, str, acc, posX + 25, posY, startX + ( pos + 1, str, acc, posX + xSpace, posY, startX , windowWidth, windowHeight, fWindowWidth, fWindowHeight , r, g, b, tl ) @@ -25,7 +29,7 @@ struct (* if tab, proceed forward one char, * and jump visually forwards three chars *) buildTextString - ( pos + 1, str, acc, posX + 75, posY, startX + ( pos + 1, str, acc, posX + xSpace3, posY, startX , windowWidth, windowHeight, fWindowWidth, fWindowHeight , r, g, b, tl ) @@ -33,9 +37,9 @@ struct (* if \n, move down vertically, and move to start horizontally * assuming we have not exceeded the window's height. * If we have exceeded the window's height, just return acc. *) - if posY + 25 < windowHeight then + if posY + ySpace < windowHeight then buildTextString - ( pos + 1, str, acc, startX, posY + 25, startX + ( pos + 1, str, acc, startX, posY + ySpace, startX , windowWidth, windowHeight, fWindowWidth, fWindowHeight , r, g, b, tl ) @@ -45,19 +49,19 @@ struct | #"\r" => (* same as \n, except we also check if we are in a \r\n pair, * and proceed two characters forward if so *) - if posY + 25 < windowHeight then + if posY + ySpace < windowHeight then if pos < String.size str - 1 andalso String.sub (str, pos + 1) = #"\n" then buildTextString - ( pos + 2, str, acc, startX, posY + 25, startX + ( pos + 2, str, acc, startX, posY + ySpace, startX , windowWidth, windowHeight, fWindowWidth, fWindowHeight , r, g, b, tl ) else buildTextString - ( pos + 1, str, acc, startX, posY + 25, startX + ( pos + 1, str, acc, startX, posY + ySpace, startX , windowWidth, windowHeight, fWindowWidth, fWindowHeight , r, g, b, tl ) @@ -70,7 +74,7 @@ struct let val chrFun = Vector.sub (CozetteAscii.asciiTable, Char.ord chr) in - if posX + 25 < windowWidth then + if posX + xSpace < windowWidth then (* if there is horizontal space, place char on the right *) let val chrVec = chrFun @@ -78,12 +82,12 @@ struct val acc = chrVec :: acc in buildTextString - ( pos + 1, str, acc, posX + 25, posY, startX + ( pos + 1, str, acc, posX + xSpace, posY, startX , windowWidth, windowHeight, fWindowWidth, fWindowHeight , r, g, b, tl ) end - else if posY + 25 < windowHeight then + else if posY + ySpace < windowHeight then (* if there is vertical space, place char down below at startX *) let val chrVec = chrFun @@ -94,7 +98,7 @@ struct val acc = chrVec :: acc in buildTextString - ( pos + 1, str, acc, startX + 25, posY + 25, startX + ( pos + 1, str, acc, startX + xSpace, posY + ySpace, startX , windowWidth, windowHeight, fWindowWidth, fWindowHeight , r, g, b, tl ) @@ -134,7 +138,7 @@ struct let val acc = continueBuildTextLineGap - ( #rightStrings lineGap, [], 10, 10, 10 + ( #rightStrings lineGap, [], 5, 5, 5 , windowWidth, windowHeight , Real32.fromInt windowWidth , Real32.fromInt windowHeight diff --git a/shell/gl-draw.sml b/shell/gl-draw.sml index 5d637d1..55a2aaa 100644 --- a/shell/gl-draw.sml +++ b/shell/gl-draw.sml @@ -55,12 +55,18 @@ struct } end - fun uploadText ({textVertexBuffer, ...}: t, vec) = + fun uploadText + ({textVertexBuffer, textProgram, window, textDrawLength = _}: t, vec) = let val _ = Gles3.bindBuffer textVertexBuffer val _ = Gles3.bufferData (vec, Vector.length vec, Gles3.STATIC_DRAW) + val newTextDrawLength = Vector.length vec div 5 in - () + { textVertexBuffer = textVertexBuffer + , textProgram = textProgram + , window = window + , textDrawLength = newTextDrawLength + } end fun drawText ({textVertexBuffer, textProgram, textDrawLength, ...}: t) = @@ -91,7 +97,7 @@ struct case Glfw.windowShouldClose window of false => let - val _ = Gles3.clearColor (0.1, 0.1, 0.1, 0.1) + val _ = Gles3.clearColor (1.0, 1.0, 1.0, 1.0) val _ = Gles3.clear () val _ = draw shellState diff --git a/shell/shell.sml b/shell/shell.sml index bf8d67d..cd5774b 100644 --- a/shell/shell.sml +++ b/shell/shell.sml @@ -2,6 +2,11 @@ structure Shell = struct open CML + fun ioToString (io, acc) = + case TextIO.inputLine io of + SOME str => ioToString (io, acc ^ str) + | NONE => acc + fun main () = let (* Set up GLFW. *) @@ -9,11 +14,21 @@ struct val _ = Glfw.windowHint (Glfw.CONTEXT_VERSION_MAJOR (), 3) val _ = Glfw.windowHint (Glfw.DEPRECATED (), Glfw.FALSE ()) val _ = Glfw.windowHint (Glfw.SAMPLES (), 4) - val window = Glfw.createWindow (1600, 900, "shf") + val window = Glfw.createWindow (1920, 1080, "shf") val _ = Glfw.makeContextCurrent window val _ = Gles3.loadGlad () - val _ = GlDraw.loop window + (* upload text vector *) + val io = TextIO.openIn "fcore/buffer.sml" + val str = ioToString (io, "") + val lineGap = LineGap.fromString str + val _ = TextIO.closeIn io + + val textVec = Buffer.startBuildTextLineGap (0, lineGap, 1920, 1080) + val shellState = GlDraw.create window + val shellState = GlDraw.uploadText (shellState, textVec) + + val _ = GlDraw.helpLoop shellState in () end diff --git a/shf b/shf index 1307237..a175db0 100755 Binary files a/shf and b/shf differ