diff --git a/message-types/update-msg.sml b/message-types/update-msg.sml index 74e4d9c..2b832b0 100644 --- a/message-types/update-msg.sml +++ b/message-types/update-msg.sml @@ -1,7 +1,2 @@ -signature UPDATE_MESSAGE = -sig - datatype t = DRAW of DrawMessage.t | FILE of FileMessage.t -end - -structure UpdateMessage :> UPDATE_MESSAGE = +structure UpdateMessage = struct datatype t = DRAW of DrawMessage.t | FILE of FileMessage.t end diff --git a/temp-squares/fcore/app-update.sml b/temp-squares/fcore/app-update.sml new file mode 100644 index 0000000..c0005c8 --- /dev/null +++ b/temp-squares/fcore/app-update.sml @@ -0,0 +1,44 @@ +structure AppUpdate = +struct + open AppType + + open DrawMessage + open FileMessage + open InputMessage + open UpdateMessage + + fun getDotVecFromIndices (model: app_type, hIdx, vIdx) = + let + val {windowWidth, windowHeight, xClickPoints, yClickPoints, ...} = model + val xpos = Vector.sub (xClickPoints, hIdx) + val ypos = Vector.sub (yClickPoints, vIdx) + + val endXpos = + if hIdx + 1 = Vector.length xClickPoints then + xpos + else + Vector.sub (xClickPoints, hIdx + 1) + + val endYpos = + if vIdx + 1 = Vector.length yClickPoints then + ypos + else + Vector.sub (yClickPoints, vIdx + 1) + + val tl = + ClickPoints.getDrawDotRgb + (xpos, ypos, 1.0, 0.0, 0.0, windowWidth, windowHeight) + val tr = + ClickPoints.getDrawDotRgb + (endXpos, ypos, 1.0, 0.0, 0.0, windowWidth, windowHeight) + val bl = + ClickPoints.getDrawDotRgb + (xpos, endYpos, 1.0, 0.0, 0.0, windowWidth, windowHeight) + val br = + ClickPoints.getDrawDotRgb + (endXpos, endYpos, 1.0, 0.0, 0.0, windowWidth, windowHeight) + in + Vector.concat [tl, tr, bl, br] + end + +end diff --git a/temp-squares/fcore/click-points.sml b/temp-squares/fcore/click-points.sml index 16df628..d0922de 100644 --- a/temp-squares/fcore/click-points.sml +++ b/temp-squares/fcore/click-points.sml @@ -9,4 +9,38 @@ struct Vector.tabulate (numPoints + 1, fn idx => (Real32.fromInt idx * increment) + start) end + + fun getDrawDot (xpos, ypos, windowWidth, windowHeight) = + let + (* calculate normalised device coordinates *) + val halfWidth = Real32.fromInt (windowWidth div 2) + val halfHeight = Real32.fromInt (windowHeight div 2) + val hpos = xpos - halfWidth + val vpos = ~(ypos - halfHeight) + + (* coordinates to form small box around clicked area *) + val left = (hpos - 5.0) / halfWidth + val right = (hpos + 5.0) / halfWidth + val bottom = (vpos - 5.0) / halfHeight + val top = (vpos + 5.0) / halfHeight + in + Ndc.ltrbToVertex (left, top, right, bottom) + end + + fun getDrawDotRgb (xpos, ypos, r, g, b, windowWidth, windowHeight) = + let + (* calculate normalised device coordinates *) + val halfWidth = Real32.fromInt (windowWidth div 2) + val halfHeight = Real32.fromInt (windowHeight div 2) + val hpos = xpos - halfWidth + val vpos = ~(ypos - halfHeight) + + (* coordinates to form small box around clicked area *) + val left = (hpos - 5.0) / halfWidth + val right = (hpos + 5.0) / halfWidth + val bottom = (vpos - 5.0) / halfHeight + val top = (vpos + 5.0) / halfHeight + in + Ndc.ltrbToVertexRgb (left, top, right, bottom, r, g, b) + end end diff --git a/temp-squares/fcore/ndc.sml b/temp-squares/fcore/ndc.sml new file mode 100644 index 0000000..79926cd --- /dev/null +++ b/temp-squares/fcore/ndc.sml @@ -0,0 +1,23 @@ +structure Ndc = +struct + (* ndc = normalised device coordinates *) + fun ltrbToVertex (left, top, right, bottom) = + #[ left, bottom + , right, bottom + , left, top + + , left, top + , right, bottom + , right, top + ] + + fun ltrbToVertexRgb (left, top, right, bottom, r, g, b) = + #[ left, bottom, r, g, b + , right, bottom, r, g, b + , left, top, r, g, b + + , left, top, r, g, b + , right, bottom, r, g, b + , right, top, r, g, b + ] +end diff --git a/temp-squares/message-types/update-msg.sml b/temp-squares/message-types/update-msg.sml new file mode 100644 index 0000000..2b832b0 --- /dev/null +++ b/temp-squares/message-types/update-msg.sml @@ -0,0 +1,2 @@ +structure UpdateMessage = +struct datatype t = DRAW of DrawMessage.t | FILE of FileMessage.t end diff --git a/temp-squares/temp.mlb b/temp-squares/temp.mlb index 0616129..9e9149d 100644 --- a/temp-squares/temp.mlb +++ b/temp-squares/temp.mlb @@ -2,16 +2,22 @@ $(SML_LIB)/basis/basis.mlb (* FUNCTIONAL CORE *) fcore/app-type.sml -fcore/click-points.sml -fcore/app-init.sml -fcore/app-with.sml ann "allowVectorExps true" in + fcore/ndc.sml fcore/graph-lines.sml end +fcore/click-points.sml +fcore/app-init.sml +fcore/app-with.sml + message-types/draw-msg.sml message-types/file-msg.sml message-types/input-msg.sml +message-types/update-msg.sml + +fcore/app-update.sml +