diff --git a/fcore/text-builder.sml b/fcore/text-builder.sml index 45c1677..45b9070 100644 --- a/fcore/text-builder.sml +++ b/fcore/text-builder.sml @@ -12,6 +12,20 @@ struct val ySpace = 25 val fontSize = 30.0 + fun buildTextAccToDrawMsg (textAcc, cursorAcc) = + let + open MailboxType + open DrawMsg + + val textAcc = Vector.concat textAcc + val cursorAcc = Vector.concat cursorAcc + + val textMsg = REDRAW_TEXT textAcc + val cursorMsg = REDRAW_CURSOR cursorAcc + in + [DRAW textMsg, DRAW cursorMsg] + end + (* 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. diff --git a/message-types/draw-msg.sml b/message-types/draw-msg.sml index 1b42205..2b6c79c 100644 --- a/message-types/draw-msg.sml +++ b/message-types/draw-msg.sml @@ -2,10 +2,12 @@ signature DRAW_MSG = sig datatype t = REDRAW_TEXT of Real32.real vector + | REDRAW_CURSOR of Real32.real vector end structure DrawMsg :> DRAW_MSG = struct datatype t = REDRAW_TEXT of Real32.real vector + | REDRAW_CURSOR of Real32.real vector end diff --git a/shell/gl-draw.sml b/shell/gl-draw.sml index aadca30..588bb50 100644 --- a/shell/gl-draw.sml +++ b/shell/gl-draw.sml @@ -12,6 +12,11 @@ struct { textVertexBuffer: Word32.word , textProgram: Word32.word , textDrawLength: int + + , cursorVertexBuffer: Word32.word + , cursorProgram: Word32.word + , cursorDrawLength: int + , drawMailbox: DrawMsg.t Mailbox.mbox , window: MLton.Pointer.t } @@ -47,6 +52,10 @@ struct val textProgram = createProgram (xyrgbVertexShader, rgbFragmentShader) + (* create cursor buffer, program, etc. *) + val cursorVertexBuffer = Gles3.createBuffer () + val cursorProgram = createProgram (xyrgbVertexShader, rgbFragmentShader) + (* clean up shaders which are no longer needed once progran is linked. *) val _ = Gles3.deleteShader xyrgbVertexShader val _ = Gles3.deleteShader rgbFragmentShader @@ -54,6 +63,9 @@ struct { textVertexBuffer = textVertexBuffer , textProgram = textProgram , textDrawLength = 0 + , cursorVertexBuffer = cursorVertexBuffer + , cursorProgram = cursorProgram + , cursorDrawLength = 0 , drawMailbox = drawMailbox , window = window } @@ -62,8 +74,15 @@ struct fun uploadText (shellState: t, vec) = let val - {textVertexBuffer, textProgram, window, drawMailbox, textDrawLength = _} = - shellState + { textVertexBuffer + , textProgram + , textDrawLength = _ + , cursorVertexBuffer + , cursorProgram + , cursorDrawLength + , window + , drawMailbox + } = shellState val _ = Gles3.bindBuffer textVertexBuffer val _ = Gles3.bufferData (vec, Vector.length vec, Gles3.STATIC_DRAW) @@ -71,16 +90,47 @@ struct in { textVertexBuffer = textVertexBuffer , textProgram = textProgram + , textDrawLength = newTextDrawLength + , cursorVertexBuffer = cursorVertexBuffer + , cursorProgram = cursorProgram + , cursorDrawLength = cursorDrawLength , drawMailbox = drawMailbox , window = window - , textDrawLength = newTextDrawLength } end - fun drawText ({textVertexBuffer, textProgram, textDrawLength, ...}: t) = - if textDrawLength > 0 then + fun uploadCursor (shellState: t, vec) = + let + val + { textVertexBuffer + , textProgram + , textDrawLength + , cursorVertexBuffer + , cursorProgram + , cursorDrawLength = _ + , window + , drawMailbox + } = shellState + + val _ = Gles3.bindBuffer cursorVertexBuffer + val _ = Gles3.bufferData (vec, Vector.length vec, Gles3.STATIC_DRAW) + val newCursorDrawLength = Vector.length vec div 5 + in + { textVertexBuffer = textVertexBuffer + , textProgram = textProgram + , textDrawLength = textDrawLength + , cursorVertexBuffer = cursorVertexBuffer + , cursorProgram = cursorProgram + , cursorDrawLength = newCursorDrawLength + , drawMailbox = drawMailbox + , window = window + } + end + + fun drawXyrgb (vertexBuffer, program, drawLength) = + if drawLength > 0 then let - val _ = Gles3.bindBuffer textVertexBuffer + val _ = Gles3.bindBuffer vertexBuffer (* enable xy component from uploaded array *) val _ = Gles3.vertexAttribPointer (0, 2, 5, 0) val _ = Gles3.enableVertexAttribArray 0 @@ -88,8 +138,8 @@ struct val _ = Gles3.vertexAttribPointer (1, 3, 5, 8) val _ = Gles3.enableVertexAttribArray 1 - val _ = Gles3.useProgram textProgram - val _ = Gles3.drawArrays (Gles3.TRIANGLES, 0, textDrawLength) + val _ = Gles3.useProgram program + val _ = Gles3.drawArrays (Gles3.TRIANGLES, 0, drawLength) in () end @@ -97,18 +147,36 @@ struct () fun draw (drawObject: t) = - let val _ = drawText drawObject - in () + let + val + { textVertexBuffer + , textDrawLength + , textProgram + , cursorVertexBuffer + , cursorDrawLength + , cursorProgram + , ... + } = drawObject + val _ = drawXyrgb (cursorVertexBuffer, cursorProgram, cursorDrawLength) + val _ = drawXyrgb (textVertexBuffer, textProgram, textDrawLength) + in + () end - fun consumeDrawEvent (shellState, msg) = let val - {textVertexBuffer, textProgram, window, drawMailbox, textDrawLength = _} = - shellState + { textVertexBuffer + , textProgram + , window + , drawMailbox + , textDrawLength = _ + , ... + } = shellState in - case msg of REDRAW_TEXT textVec => uploadText (shellState, textVec) + case msg of + REDRAW_TEXT textVec => uploadText (shellState, textVec) + | REDRAW_CURSOR cursorVec => uploadCursor (shellState, cursorVec) end fun consumeDrawEvents (shellState as {drawMailbox, ...}: t) = diff --git a/shf b/shf index 0a9cdff..a511687 100755 Binary files a/shf and b/shf differ