diff --git a/dotscape b/dotscape index 3d5f85e..d0cc043 100755 Binary files a/dotscape and b/dotscape differ diff --git a/functional-core/app/app-init.sml b/functional-core/app/app-init.sml index e3011c4..7ef0ce3 100644 --- a/functional-core/app/app-init.sml +++ b/functional-core/app/app-init.sml @@ -38,6 +38,9 @@ struct , openFilePath = "" , fileBrowser = Vector.fromList [] , fileBrowserIdx = 0 + , r = 0.0 + , g = 0.0 + , b = 0.0 } end diff --git a/functional-core/app/app-type.sml b/functional-core/app/app-type.sml index da00532..86fe218 100644 --- a/functional-core/app/app-type.sml +++ b/functional-core/app/app-type.sml @@ -17,6 +17,9 @@ sig , y1: Real32.real , y2: Real32.real , y3: Real32.real + , r: Real32.real + , g: Real32.real + , b: Real32.real } type app_type = @@ -38,6 +41,9 @@ sig , openFilePath: string , fileBrowser: file_browser_item vector , fileBrowserIdx: int + , r: Real32.real + , g: Real32.real + , b: Real32.real } end @@ -49,11 +55,14 @@ struct type triangle = { x1: Real32.real - , y1: Real32.real , x2: Real32.real - , y2: Real32.real , x3: Real32.real + , y1: Real32.real + , y2: Real32.real , y3: Real32.real + , r: Real32.real + , g: Real32.real + , b: Real32.real } datatype triangle_stage = @@ -89,5 +98,8 @@ struct , openFilePath: string , fileBrowser: file_browser_item vector , fileBrowserIdx: int + , r: Real32.real + , g: Real32.real + , b: Real32.real } end diff --git a/functional-core/app/app-update.sml b/functional-core/app/app-update.sml index 8aac5d0..be47ea8 100644 --- a/functional-core/app/app-update.sml +++ b/functional-core/app/app-update.sml @@ -246,7 +246,7 @@ struct end | NO_TRIANGLE => (case #triangles model of - {x1, y1, x2, y2, x3, y3} :: trianglesTl => + {x1, y1, x2, y2, x3, y3, r, g, b} :: trianglesTl => (* Have to slice off (x3, y3) from triangle head, * turn (x1, y1, x2, y2) into a triangleStage, * and redraw both triangle and triangleStage. *) @@ -309,9 +309,19 @@ struct | SECOND {x1, y1, x2, y2} => (* clear triangle stage, add to trinagle list and redraw triangles *) let + val {r, g, b, ...} = model val newTriangleStage = NO_TRIANGLE val newTriangle = - {x1 = x1, y1 = y1, x2 = x2, y2 = y2, x3 = x, y3 = y} + { x1 = x1 + , y1 = y1 + , x2 = x2 + , y2 = y2 + , x3 = x + , y3 = y + , r = r + , g = g + , b = b + } val newTriangles = newTriangle :: (#triangles model) val model = AppWith.redo (model, newTriangleStage, newTriangles, redoHd) diff --git a/functional-core/app/app-with.sml b/functional-core/app/app-with.sml index 08b23b3..a644257 100644 --- a/functional-core/app/app-with.sml +++ b/functional-core/app/app-with.sml @@ -90,6 +90,9 @@ struct , openFilePath , fileBrowser , fileBrowserIdx + , r + , g + , b } = app val newUndo = newUndoHd :: undo @@ -112,6 +115,9 @@ struct , openFilePath = openFilePath , fileBrowser = fileBrowser , fileBrowserIdx = fileBrowserIdx + , r = r + , g = g + , b = b } end @@ -138,9 +144,22 @@ struct , openFilePath , fileBrowser , fileBrowserIdx + , r + , g + , b } = app - val newTriangle = {x1 = x1, y1 = y1, x2 = x2, y2 = y2, x3 = x3, y3 = y3} + val newTriangle = + { x1 = x1 + , y1 = y1 + , x2 = x2 + , y2 = y2 + , x3 = x3 + , y3 = y3 + , r = r + , g = g + , b = b + } val newTriangles = newTriangle :: triangles val newUndo = newUndoHd :: undo in @@ -162,6 +181,9 @@ struct , openFilePath = openFilePath , fileBrowser = fileBrowser , fileBrowserIdx = fileBrowserIdx + , r = r + , g = g + , b = b } end @@ -186,6 +208,9 @@ struct , openFilePath , fileBrowser , fileBrowserIdx + , r + , g + , b } = app in { mode = mode @@ -206,6 +231,9 @@ struct , openFilePath = openFilePath , fileBrowser = fileBrowser , fileBrowserIdx = fileBrowserIdx + , r = r + , g = g + , b = b } end @@ -230,6 +258,9 @@ struct , openFilePath , fileBrowser , fileBrowserIdx + , r + , g + , b } = app in { mode = mode @@ -250,6 +281,9 @@ struct , openFilePath = openFilePath , fileBrowser = fileBrowser , fileBrowserIdx = fileBrowserIdx + , r = r + , g = g + , b = b } end @@ -276,6 +310,9 @@ struct , openFilePath , fileBrowser , fileBrowserIdx + , r + , g + , b } = app val xClickPoints = ClickPoints.generate (wStart, wFinish, numClickPoints) @@ -299,6 +336,9 @@ struct , openFilePath = openFilePath , fileBrowser = fileBrowser , fileBrowserIdx = fileBrowserIdx + , r = r + , g = g + , b = b } end @@ -346,6 +386,9 @@ struct , openFilePath , fileBrowser , fileBrowserIdx + , r + , g + , b } = app in { mode = mode @@ -366,6 +409,9 @@ struct , openFilePath = openFilePath , fileBrowser = fileBrowser , fileBrowserIdx = fileBrowserIdx + , r = r + , g = g + , b = b } end @@ -391,6 +437,9 @@ struct , openFilePath , fileBrowser , fileBrowserIdx + , r + , g + , b } = app val newUndo = @@ -418,6 +467,9 @@ struct , openFilePath = openFilePath , fileBrowser = fileBrowser , fileBrowserIdx = fileBrowserIdx + , r = r + , g = g + , b = b } end @@ -443,6 +495,9 @@ struct , openFilePath , fileBrowser , fileBrowserIdx + , r + , g + , b } = app val newUndo = newUndoHd :: undo @@ -469,6 +524,9 @@ struct , openFilePath = openFilePath , fileBrowser = fileBrowser , fileBrowserIdx = fileBrowserIdx + , r = r + , g = g + , b = b } end @@ -493,6 +551,9 @@ struct , openFilePath , fileBrowser , fileBrowserIdx + , r + , g + , b } = app in { mode = mode @@ -513,6 +574,9 @@ struct , openFilePath = openFilePath , fileBrowser = fileBrowser , fileBrowserIdx = fileBrowserIdx + , r = r + , g = g + , b = b } end @@ -537,6 +601,9 @@ struct , openFilePath , fileBrowser , fileBrowserIdx + , r + , g + , b } = app in { mode = newMode @@ -557,6 +624,9 @@ struct , openFilePath = openFilePath , fileBrowser = fileBrowser , fileBrowserIdx = fileBrowserIdx + , r = r + , g = g + , b = b } end @@ -581,6 +651,9 @@ struct , openFilePath , fileBrowser , fileBrowserIdx + , r + , g + , b } = app val triangleStage = NO_TRIANGLE @@ -603,6 +676,9 @@ struct , openFilePath = openFilePath , fileBrowser = fileBrowser , fileBrowserIdx = fileBrowserIdx + , r = r + , g = g + , b = b } end @@ -627,6 +703,9 @@ struct , openFilePath = _ , fileBrowser = _ , fileBrowserIdx = _ + , r + , g + , b } = app in { mode = mode @@ -647,6 +726,9 @@ struct , openFilePath = path , fileBrowser = fileBrowser , fileBrowserIdx = 0 + , r = r + , g = g + , b = b } end @@ -671,6 +753,9 @@ struct , openFilePath = openFilePath , fileBrowser = fileBrowser , fileBrowserIdx = _ + , r + , g + , b } = app in { mode = mode @@ -691,6 +776,9 @@ struct , openFilePath = openFilePath , fileBrowser = fileBrowser , fileBrowserIdx = newFileBrowserIdx + , r = r + , g = g + , b = b } end end diff --git a/functional-core/app/triangles.sml b/functional-core/app/triangles.sml index cddb82b..bcb162f 100644 --- a/functional-core/app/triangles.sml +++ b/functional-core/app/triangles.sml @@ -9,7 +9,7 @@ struct fun helpToVector (lst, acc, windowWidth, windowHeight, halfWidth, halfHeight) = case lst of - {x1, y1, x2, y2, x3, y3} :: tl => + {x1, y1, x2, y2, x3, y3, r, g, b} :: tl => let val x1 = Ndc.centreAlignX (x1, windowWidth, windowHeight, halfWidth) val x2 = Ndc.centreAlignX (x2, windowWidth, windowHeight, halfWidth) @@ -22,10 +22,19 @@ struct val vec = #[ x1 / halfWidth , y1 / halfHeight + , r + , g + , b , x2 / halfWidth , y2 / halfHeight + , r + , g + , b , x3 / halfWidth , y3 / halfHeight + , r + , g + , b ] val acc = vec :: acc in diff --git a/functional-core/file/parse-file.sml b/functional-core/file/parse-file.sml index 4b33005..7b58591 100644 --- a/functional-core/file/parse-file.sml +++ b/functional-core/file/parse-file.sml @@ -7,16 +7,36 @@ structure ParseFile :> PARSE_FILE = struct datatype triangle_token = X | Y | COORD of Real32.real | UNKNOWN of string + val zero: Real32.real = 0.0 + fun extractTriangle lst = case lst of - [ X, COORD x1 - , Y, COORD y1 - , X, COORD x2 + [ X + , COORD x1 + , Y + , COORD y1 - , Y, COORD y2 - , X, COORD x3 - , Y, COORD y3 - ] => SOME {x1 = x1, y1 = y1, x2 = x2, y2 = y2, x3 = x3, y3 = y3} + , X + , COORD x2 + , Y + , COORD y2 + + , X + , COORD x3 + , Y + , COORD y3 + ] => + SOME + { x1 = x1 + , y1 = y1 + , x2 = x2 + , y2 = y2 + , x3 = x3 + , y3 = y3 + , r = zero + , g = zero + , b = zero + } | _ => NONE fun tokeniseString str = @@ -61,9 +81,7 @@ struct end fun parseLine line = - let - val lst = helpParseLine (line, 0, [], 0) - in - extractTriangle lst + let val lst = helpParseLine (line, 0, [], 0) + in extractTriangle lst end end diff --git a/imperative-shell/app-draw.sml b/imperative-shell/app-draw.sml index b58cc49..888cbb1 100644 --- a/imperative-shell/app-draw.sml +++ b/imperative-shell/app-draw.sml @@ -111,41 +111,7 @@ struct val uploadModalText = uploadDotVector val drawModalText = drawDot - fun initTriangles () = - let - val triangleDrawObject = initDrawObject - (Constants.graphVertexShaderString, Constants.graphFragmentShaderString) - val {vertexBuffer, program} = triangleDrawObject - - val _ = Gles3.bindBuffer vertexBuffer - val _ = Gles3.bufferData (#[], 0, Gles3.STATIC_DRAW ()) - val _ = Gles3.vertexAttribPointer (0, 2, 2, 0) - val _ = Gles3.enableVertexAttribArray 0 - in - triangleDrawObject - end - - fun uploadTrianglesVector (triangleDrawObject: draw_object, vec) = - let - val {vertexBuffer, ...} = triangleDrawObject - val _ = Gles3.bindBuffer vertexBuffer - val _ = Gles3.bufferData (vec, Vector.length vec, Gles3.STATIC_DRAW ()) - in - () - end - - fun drawTriangles (triangleDrawObject: draw_object, triangleDrawLength) = - if triangleDrawLength > 0 then - let - val {vertexBuffer, program} = triangleDrawObject - val _ = Gles3.bindBuffer vertexBuffer - val _ = Gles3.vertexAttribPointer (0, 2, 2, 0) - val _ = Gles3.enableVertexAttribArray 0 - val _ = Gles3.useProgram program - val _ = Gles3.drawArrays (Gles3.TRIANGLES (), 0, triangleDrawLength) - in - () - end - else - () + val initTriangles = initDot + val uploadTrianglesVector = uploadDotVector + val drawTriangles = drawDot end diff --git a/imperative-shell/draw-thread.sml b/imperative-shell/draw-thread.sml index e6947bd..abb6c8c 100644 --- a/imperative-shell/draw-thread.sml +++ b/imperative-shell/draw-thread.sml @@ -70,7 +70,7 @@ struct val _ = AppDraw.uploadTrianglesVector (triangleDrawObject, triangleVec) - val triangleDrawLength = Vector.length triangleVec div 2 + val triangleDrawLength = Vector.length triangleVec div 5 (* dots are reset by setting dotDrawLength to 0 *) in run @@ -91,7 +91,7 @@ struct val _ = AppDraw.uploadTrianglesVector (triangleDrawObject, triangleVec) - val triangleDrawLength = Vector.length triangleVec div 2 + val triangleDrawLength = Vector.length triangleVec div 5 val _ = AppDraw.uploadDotVector (dotDrawObject, dotsVec) val dotDrawLength = Vector.length dotsVec div 5 @@ -130,7 +130,7 @@ struct let val _ = AppDraw.uploadTrianglesVector (triangleDrawObject, triangles) - val triangleDrawLength = Vector.length triangles div 2 + val triangleDrawLength = Vector.length triangles div 5 val _ = AppDraw.uploadGraphLines (graphDrawObject, graphLines) val drawGraphLength = Vector.length graphLines div 2 diff --git a/imperative-shell/file-thread.sml b/imperative-shell/file-thread.sml index 3b423e9..69a3b9e 100644 --- a/imperative-shell/file-thread.sml +++ b/imperative-shell/file-thread.sml @@ -10,9 +10,9 @@ struct datatype parse_result = OK of AppType.triangle list | PARSE_ERROR - val structureName = "UnknownChar" - val filename = "fonts/unknown-char.dsc" - val exportFilename = "fonts/unknown-char.sml" + val structureName = "Green" + val filename = "green.dsc" + val exportFilename = "green.sml" fun ndcToLerpX num = let @@ -40,9 +40,14 @@ struct ^ ")) / windowHeight) - 1.0" end + fun colToString col = + let val col = Real32.toString col + in if String.isSubstring "." col then col else col ^ ".0" + end + fun helpExportTriangles (io, triangles) = case triangles of - {x1, y1, x2, y2, x3, y3} :: tl => + {x1, y1, x2, y2, x3, y3, r, g, b} :: tl => let val x1 = ndcToLerpX x1 val x2 = ndcToLerpX x2 @@ -52,6 +57,10 @@ struct val y2 = ndcToLerpY y2 val y3 = ndcToLerpY y3 + val r = colToString r + val g = colToString g + val b = colToString b + val line = String.concat [ x1 , ",\n" @@ -64,9 +73,15 @@ struct , x3 , ",\n" , y3 + , ", \n" + , r + , ", " + , g + , ", " + , b , case tl of - [] => ", r, g, b\n" - | _ => ", r, g, b,\n" + [] => "\n" + | _ => ",\n" ] val _ = TextIO.output (io, line) @@ -126,14 +141,17 @@ struct val inputMsg = case triangles of OK triangles => USE_TRIANGLES triangles - | PARSE_ERROR => TRIANGLES_LOAD_ERROR + | PARSE_ERROR => + let val _ = print "parse error\n" + in TRIANGLES_LOAD_ERROR + end in Mailbox.send (inputMailbox, inputMsg) end fun helpSaveTriangles (triangles, io) = case triangles of - {x1, y1, x2, y2, x3, y3} :: tl => + {x1, y1, x2, y2, x3, y3, r, g, b} :: tl => let val triString = String.concat [ "x " @@ -150,6 +168,14 @@ struct , Real32.toString x3 , " y " , Real32.toString y3 + + , " r " + , Real32.toString r + , " g " + , Real32.toString g + , " b " + , Real32.toString b + , "\n" ]