humza/sml-projects
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add bgVertexBuffer and bgProgram to imperative shell, so we can draw bg and cursor without overlap, and without z-index

Browse Source
This commit is contained in:
Humza Shahid
2024-11-15 10:26:22 +00:00
parent d5eb19f8d9
commit 2a2f64f00c
4 changed files with 115 additions and 52 deletions
Download Patch File Download Diff File Expand all files Collapse all files

98
fcore/text-builder.sml
View File

@@ -9,18 +9,19 @@ structure TextBuilder :> TEXT_BUILDER =
struct
open TextConstants
fun accToDrawMsg (textAcc, cursorAcc) =
fun accToDrawMsg (textAcc, cursorAcc, bgAcc) =
let
open MailboxType
open DrawMsg
val textAcc = Vector.concat textAcc
val cursorAcc = Vector.concat cursorAcc
val bgAcc = Vector.concat bgAcc
val textMsg = REDRAW_TEXT textAcc
val cursorMsg = REDRAW_CURSOR cursorAcc
val bgMsg = REDRAW_BG bgAcc
in
[DRAW textMsg, DRAW cursorMsg]
[DRAW bgMsg, DRAW textMsg, DRAW cursorMsg]
end
fun buildCursor (posX, posY, fWindowWidth, fWindowHeight, r, g, b) =
@@ -83,7 +84,7 @@ struct
fun buildTextString
( pos, str, acc, posX, posY, startX
, tl, absIdx, cursorPos, cursorAcc
, tl, absIdx, cursorPos, cursorAcc, bgAcc
, windowData: window_data, colourData: colour_data
) =
if pos < String.size str then
@@ -95,7 +96,7 @@ struct
(* not in cursur *)
buildTextString
( pos + 1, str, acc, posX + xSpace, posY, startX
, tl, absIdx + 1, cursorPos, cursorAcc
, tl, absIdx + 1, cursorPos, cursorAcc, bgAcc
, windowData, colourData
)
else
@@ -104,12 +105,11 @@ struct
val {fw, fh, ...} = windowData
val {r, g, b, ...} = colourData
val cursorHd = buildCursor (posX, posY, fw, fh, r, g ,b)
val cursorAcc = cursorHd :: cursorAcc
val cursorAcc = buildCursor (posX, posY, fw, fh, r, g ,b)
in
buildTextString
( pos + 1, str, acc, posX + xSpace, posY, startX
, tl, absIdx + 1, cursorPos, cursorAcc
, tl, absIdx + 1, cursorPos, cursorAcc, bgAcc
, windowData, colourData
)
end
@@ -119,7 +119,7 @@ struct
(* not in cursor position, so iterate like normal *)
buildTextString
( pos + 1, str, acc, startX, posY + ySpace, startX
, tl, absIdx + 1, cursorPos, cursorAcc
, tl, absIdx + 1, cursorPos, cursorAcc, bgAcc
, windowData, colourData
)
else
@@ -128,17 +128,16 @@ struct
val {fw, fh, ...} = windowData
val {r, g, b, ...} = colourData
val cursorHd = buildCursor (posX, posY, fw, fh, r, g ,b)
val cursorAcc = cursorHd :: cursorAcc
val cursorAcc = buildCursor (posX, posY, fw, fh, r, g ,b)
in
buildTextString
( pos + 1, str, acc, startX, posY + ySpace, startX
, tl, absIdx + 1, cursorPos, cursorAcc
, tl, absIdx + 1, cursorPos, cursorAcc, bgAcc
, windowData, colourData
)
end
else
accToDrawMsg (acc, cursorAcc)
accToDrawMsg (acc, cursorAcc, bgAcc)
| chr =>
let
val chrFun = Vector.sub (CozetteAscii.asciiTable, Char.ord chr)
@@ -156,7 +155,7 @@ struct
in
buildTextString
( pos + 1, str, acc, posX + xSpace, posY, startX
, tl, absIdx + 1, cursorPos, cursorAcc
, tl, absIdx + 1, cursorPos, cursorAcc, bgAcc
, windowData, colourData
)
end
@@ -173,19 +172,18 @@ struct
in
buildTextString
( pos + 1, str, acc, startX + xSpace, posY + ySpace, startX
, tl, absIdx + 1, cursorPos, cursorAcc
, tl, absIdx + 1, cursorPos, cursorAcc, bgAcc
, windowData, colourData
)
end
else
accToDrawMsg (acc, cursorAcc)
accToDrawMsg (acc, cursorAcc, bgAcc)
else
(* equal to cursor *)
let
val {fw, fh, ...} = windowData
val {r, g, b, hr, hg, hb} = colourData
val cursorHd = buildCursor (posX, posY, fw, fh, r, g ,b)
val cursorAcc = cursorHd :: cursorAcc
val cursorAcc = buildCursor (posX, posY, fw, fh, r, g ,b)
in
if posX + xSpace < #w windowData then
let
@@ -199,7 +197,7 @@ struct
* since cursor was built *)
buildTextString
( pos + 1, str, acc, posX + xSpace, posY, startX
, tl, absIdx + 1, cursorPos, cursorAcc
, tl, absIdx + 1, cursorPos, cursorAcc, bgAcc
, windowData, colourData
)
end
@@ -215,12 +213,12 @@ struct
* since cursor was built *)
buildTextString
( pos + 1, str, acc, startX + xSpace, posY + ySpace, startX
, tl, absIdx + 1, cursorPos, cursorAcc
, tl, absIdx + 1, cursorPos, cursorAcc, bgAcc
, windowData, colourData
)
end
else
accToDrawMsg (acc, cursorAcc)
accToDrawMsg (acc, cursorAcc, bgAcc)
end
end
else
@@ -229,11 +227,11 @@ struct
hd :: tl =>
buildTextString
( 0, hd, acc, posX, posY, startX
, tl, absIdx, cursorPos, cursorAcc
, tl, absIdx, cursorPos, cursorAcc, bgAcc
, windowData, colourData
)
| [] =>
accToDrawMsg (acc, cursorAcc)
accToDrawMsg (acc, cursorAcc, bgAcc)
fun isInSearchRange (absIdx, searchPos, searchHd, searchLen) =
let
@@ -251,7 +249,7 @@ struct
fun buildTextStringSearch
( pos, str, acc, posX, posY, startX
, tl, absIdx, cursorPos, cursorAcc
, tl, absIdx, cursorPos, cursorAcc, bgAcc
, windowData: window_data, colourData: colour_data
, searchHd, searchTl, searchPos, searchLen
) =
@@ -261,7 +259,7 @@ struct
(* go to next search hd/tl *)
buildTextStringSearch
( pos, str, acc, posX, posY, startX
, tl, absIdx, cursorPos, cursorAcc
, tl, absIdx, cursorPos, cursorAcc, bgAcc
, windowData, colourData
, searchHd, searchTl, 0, searchLen
)
@@ -269,7 +267,7 @@ struct
(* exhausted search hd/tl so calll normal build function *)
buildTextString
( pos, str, acc, posX, posY, startX
, tl, absIdx, cursorPos, cursorAcc
, tl, absIdx, cursorPos, cursorAcc, bgAcc
, windowData, colourData
)
else if pos < String.size str then
@@ -289,11 +287,11 @@ struct
val {fw, fh, ...} = windowData
val space = buildCursor (posX, posY, fw, fh, r, g, b)
val cursorAcc = space :: cursorAcc
val bgAcc = space :: bgAcc
in
buildTextStringSearch
( pos + 1, str, acc, posX + xSpace, posY, startX
, tl, absIdx + 1, cursorPos, cursorAcc
, tl, absIdx + 1, cursorPos, cursorAcc, bgAcc
, windowData, colourData
, searchHd, searchTl, searchPos, searchLen
)
@@ -301,7 +299,7 @@ struct
else
buildTextStringSearch
( pos + 1, str, acc, posX + xSpace, posY, startX
, tl, absIdx + 1, cursorPos, cursorAcc
, tl, absIdx + 1, cursorPos, cursorAcc, bgAcc
, windowData, colourData
, searchHd, searchTl, searchPos, searchLen
)
@@ -311,12 +309,11 @@ struct
val {fw, fh, ...} = windowData
val {r, g, b, ...} = colourData
val cursorHd = buildCursor (posX, posY, fw, fh, r, g ,b)
val cursorAcc = cursorHd :: cursorAcc
val cursorAcc = buildCursor (posX, posY, fw, fh, r, g ,b)
in
buildTextStringSearch
( pos + 1, str, acc, posX + xSpace, posY, startX
, tl, absIdx + 1, cursorPos, cursorAcc
, tl, absIdx + 1, cursorPos, cursorAcc, bgAcc
, windowData, colourData
, searchHd, searchTl, searchPos, searchLen
)
@@ -327,7 +324,7 @@ struct
(* not in cursor position, so iterate like normal *)
buildTextStringSearch
( pos + 1, str, acc, startX, posY + ySpace, startX
, tl, absIdx + 1, cursorPos, cursorAcc
, tl, absIdx + 1, cursorPos, cursorAcc, bgAcc
, windowData, colourData
, searchHd, searchTl, searchPos, searchLen
)
@@ -337,18 +334,17 @@ struct
val {fw, fh, ...} = windowData
val {r, g, b, ...} = colourData
val cursorHd = buildCursor (posX, posY, fw, fh, r, g ,b)
val cursorAcc = cursorHd :: cursorAcc
val cursorAcc = buildCursor (posX, posY, fw, fh, r, g ,b)
in
buildTextStringSearch
( pos + 1, str, acc, startX, posY + ySpace, startX
, tl, absIdx + 1, cursorPos, cursorAcc
, tl, absIdx + 1, cursorPos, cursorAcc, bgAcc
, windowData, colourData
, searchHd, searchTl, searchPos, searchLen
)
end
else
accToDrawMsg (acc, cursorAcc)
accToDrawMsg (acc, cursorAcc, bgAcc)
| chr =>
let
val chrFun = Vector.sub (CozetteAscii.asciiTable, Char.ord chr)
@@ -376,11 +372,11 @@ struct
val b: Real32.real = 0.1
val space = buildCursor (posX, posY, fw, fh, r, g, b)
val cursorAcc = space :: cursorAcc
val bgAcc = space :: bgAcc
in
buildTextStringSearch
( pos + 1, str, acc, posX + xSpace, posY, startX
, tl, absIdx + 1, cursorPos, cursorAcc
, tl, absIdx + 1, cursorPos, cursorAcc, bgAcc
, windowData, colourData
, searchHd, searchTl, searchPos, searchLen
)
@@ -400,7 +396,7 @@ struct
in
buildTextStringSearch
( pos + 1, str, acc, posX + xSpace, posY, startX
, tl, absIdx + 1, cursorPos, cursorAcc
, tl, absIdx + 1, cursorPos, cursorAcc, bgAcc
, windowData, colourData
, searchHd, searchTl, searchPos, searchLen
)
@@ -418,20 +414,19 @@ struct
in
buildTextStringSearch
( pos + 1, str, acc, startX + xSpace, posY + ySpace, startX
, tl, absIdx + 1, cursorPos, cursorAcc
, tl, absIdx + 1, cursorPos, cursorAcc, bgAcc
, windowData, colourData
, searchHd, searchTl, searchPos, searchLen
)
end
else
accToDrawMsg (acc, cursorAcc)
accToDrawMsg (acc, cursorAcc, bgAcc)
else
(* equal to cursor *)
let
val {fw, fh, ...} = windowData
val {r, g, b, hr, hg, hb} = colourData
val cursorHd = buildCursor (posX, posY, fw, fh, r, g ,b)
val cursorAcc = cursorHd :: cursorAcc
val cursorAcc = buildCursor (posX, posY, fw, fh, r, g ,b)
in
if posX + xSpace < #w windowData then
let
@@ -445,7 +440,7 @@ struct
* since cursor was built *)
buildTextStringSearch
( pos + 1, str, acc, posX + xSpace, posY, startX
, tl, absIdx + 1, cursorPos, cursorAcc
, tl, absIdx + 1, cursorPos, cursorAcc, bgAcc
, windowData, colourData
, searchHd, searchTl, searchPos, searchLen
)
@@ -462,13 +457,13 @@ struct
* since cursor was built *)
buildTextStringSearch
( pos + 1, str, acc, startX + xSpace, posY + ySpace, startX
, tl, absIdx + 1, cursorPos, cursorAcc
, tl, absIdx + 1, cursorPos, cursorAcc, bgAcc
, windowData, colourData
, searchHd, searchTl, searchPos, searchLen
)
end
else
accToDrawMsg (acc, cursorAcc)
accToDrawMsg (acc, cursorAcc, bgAcc)
end
end
else
@@ -477,12 +472,12 @@ struct
hd :: tl =>
buildTextStringSearch
( 0, hd, acc, posX, posY, startX
, tl, absIdx, cursorPos, cursorAcc
, tl, absIdx, cursorPos, cursorAcc, bgAcc
, windowData, colourData
, searchHd, searchTl, searchPos, searchLen
)
| [] =>
accToDrawMsg (acc, cursorAcc)
accToDrawMsg (acc, cursorAcc, bgAcc)
fun build
( startLine, cursorPos, lineGap: LineGap.t
@@ -534,6 +529,7 @@ struct
, hg = 0.219
, hb = 0.25
}
val cursorAcc = Vector.fromList []
in
(case #right searchList of
searchHd :: searchTl =>
@@ -542,7 +538,7 @@ struct
in
buildTextStringSearch
( startIdx, rStrHd, [], 5, 5, 5
, rStrTl, absIdx, cursorPos, []
, rStrTl, absIdx, cursorPos, cursorAcc, []
, windowData, colourData
, searchHd, searchTl, searchPos, String.size searchString
)
@@ -550,7 +546,7 @@ struct
| [] =>
buildTextString
( startIdx, rStrHd, [], 5, 5, 5
, rStrTl, absIdx, cursorPos, []
, rStrTl, absIdx, cursorPos, cursorAcc, []
, windowData, colourData
))
end

2
message-types/draw-msg.sml
View File

@@ -3,6 +3,7 @@ sig
datatype t =
REDRAW_TEXT of Real32.real vector
| REDRAW_CURSOR of Real32.real vector
| REDRAW_BG of Real32.real vector
| YANK of string
end
@@ -11,5 +12,6 @@ struct
datatype t =
REDRAW_TEXT of Real32.real vector
| REDRAW_CURSOR of Real32.real vector
| REDRAW_BG of Real32.real vector
| YANK of string
end

65
shell/gl-draw.sml
View File

@@ -17,6 +17,10 @@ struct
, cursorProgram: Word32.word
, cursorDrawLength: int
, bgVertexBuffer: Word32.word
, bgProgram: Word32.word
, bgDrawLength: int
, drawMailbox: DrawMsg.t Mailbox.mbox
, window: MLton.Pointer.t
}
@@ -56,6 +60,10 @@ struct
val cursorVertexBuffer = Gles3.createBuffer ()
val cursorProgram = createProgram (xyrgbVertexShader, rgbFragmentShader)
(* create background buffer and program *)
val bgVertexBuffer = Gles3.createBuffer ()
val bgProgram = createProgram (xyrgbVertexShader, rgbFragmentShader)
(* clean up shaders which are no longer needed once progran is linked. *)
val _ = Gles3.deleteShader xyrgbVertexShader
val _ = Gles3.deleteShader rgbFragmentShader
@@ -63,9 +71,15 @@ struct
{ textVertexBuffer = textVertexBuffer
, textProgram = textProgram
, textDrawLength = 0
, cursorVertexBuffer = cursorVertexBuffer
, cursorProgram = cursorProgram
, cursorDrawLength = 0
, bgVertexBuffer = bgVertexBuffer
, bgProgram = bgProgram
, bgDrawLength = 0
, drawMailbox = drawMailbox
, window = window
}
@@ -80,6 +94,9 @@ struct
, cursorVertexBuffer
, cursorProgram
, cursorDrawLength
, bgVertexBuffer
, bgProgram
, bgDrawLength
, window
, drawMailbox
} = shellState
@@ -94,6 +111,9 @@ struct
, cursorVertexBuffer = cursorVertexBuffer
, cursorProgram = cursorProgram
, cursorDrawLength = cursorDrawLength
, bgVertexBuffer = bgVertexBuffer
, bgProgram = bgProgram
, bgDrawLength = bgDrawLength
, drawMailbox = drawMailbox
, window = window
}
@@ -108,6 +128,9 @@ struct
, cursorVertexBuffer
, cursorProgram
, cursorDrawLength = _
, bgVertexBuffer
, bgProgram
, bgDrawLength
, window
, drawMailbox
} = shellState
@@ -122,6 +145,43 @@ struct
, cursorVertexBuffer = cursorVertexBuffer
, cursorProgram = cursorProgram
, cursorDrawLength = newCursorDrawLength
, bgVertexBuffer = bgVertexBuffer
, bgProgram = bgProgram
, bgDrawLength = bgDrawLength
, drawMailbox = drawMailbox
, window = window
}
end
fun uploadBg (shellState: t, vec) =
let
val
{ textVertexBuffer
, textProgram
, textDrawLength
, cursorVertexBuffer
, cursorProgram
, cursorDrawLength
, bgVertexBuffer
, bgProgram
, bgDrawLength = _
, window
, drawMailbox
} = shellState
val _ = Gles3.bindBuffer bgVertexBuffer
val _ = Gles3.bufferData (vec, Vector.length vec, Gles3.STATIC_DRAW)
val newBgDrawLength = Vector.length vec div 5
in
{ textVertexBuffer = textVertexBuffer
, textProgram = textProgram
, textDrawLength = textDrawLength
, cursorVertexBuffer = cursorVertexBuffer
, cursorProgram = cursorProgram
, cursorDrawLength = cursorDrawLength
, bgVertexBuffer = bgVertexBuffer
, bgProgram = bgProgram
, bgDrawLength = newBgDrawLength
, drawMailbox = drawMailbox
, window = window
}
@@ -155,9 +215,13 @@ struct
, cursorVertexBuffer
, cursorDrawLength
, cursorProgram
, bgVertexBuffer
, bgProgram
, bgDrawLength
, ...
} = drawObject
val _ = drawXyrgb (bgVertexBuffer, bgProgram, bgDrawLength)
val _ = drawXyrgb (cursorVertexBuffer, cursorProgram, cursorDrawLength)
val _ = drawXyrgb (textVertexBuffer, textProgram, textDrawLength)
in
@@ -183,6 +247,7 @@ struct
case msg of
REDRAW_TEXT textVec => uploadText (shellState, textVec)
| REDRAW_CURSOR cursorVec => uploadCursor (shellState, cursorVec)
| REDRAW_BG bgVec => uploadBg (shellState, bgVec)
| YANK str => yank (shellState, str)
end

BIN
shf
View File

Binary file not shown.