spade 0.1.0.8 → 0.1.0.9

raw patch · 55 files changed

+1454/−664 lines, 55 filesdep +sdl2-gfxdep +sdl2-ttfdep +unliftiodep ~Decimaldep ~WAVEdep ~aesonbinary-added

Dependencies added: sdl2-gfx, sdl2-ttf, unliftio, unliftio-core

Dependency ranges changed: Decimal, WAVE, aeson, ansi-terminal, bytestring, constraints, containers, cryptonite, directory, exceptions, file-embed, filepath, hedgehog, hex-text, hspec, hspec-discover, hspec-hedgehog, memory, monad-loops, mtl, neat-interpolation, ordered-containers, process, random, regex-tdfa, scientific, sdl2, sdl2-mixer, stm, strip-ansi-escape, template-haskell, terminal, text, time, unix, unordered-containers, vector, with-utf8

Files

• ChangeLog.md +7/−1
• README.md +27/−13
• app/Main.hs +2/−1
• docs/character-graphics.md +37/−0
• docs/functions/concurrency.md +73/−26
• docs/functions/container.md +0/−1
• docs/functions/dictionary.md +4/−3
• docs/functions/error-handling.md +10/−2
• docs/functions/file.md +1/−4
• docs/functions/graphics.md +67/−55
• docs/functions/keyboard.md +3/−8
• docs/functions/list.md +3/−6
• docs/functions/math.md +6/−11
• docs/functions/misc.md +34/−9
• docs/functions/sound.md +0/−1
• docs/language-reference.md +195/−59
• docs/toc.md +11/−7
• docs/tui-toolkit.md +6/−0
• fonts/AileronBlack.otf binary
• samples/char-animation.spd +0/−0
• samples/char-graphics.spd +6/−0
• samples/concurrency.spd +10/−0
• samples/filechecker.spd +1/−1
• samples/mandelbrot.spd +6/−6
• samples/paratrooper.spd +15/−12
• samples/text-rendering.spd +9/−0
• samples/tui.spd +24/−0
• spade.cabal +130/−105
• src/Common.hs +8/−4
• src/Compiler/AST/Expression.hs +10/−3
• src/Compiler/AST/FunctionDef.hs +7/−4
• src/Compiler/AST/FunctionStatement.hs +38/−19
• src/Compiler/AST/Parser/Common.hs +10/−3
• src/Compiler/Lexer/Keywords.hs +9/−0
• src/IDE/Help.hs +10/−8
• src/IDE/Help/Parser.hs +34/−16
• src/IDE/IDE.hs +29/−16
• src/Interpreter.hs +12/−22
• src/Interpreter/Common.hs +112/−29
• src/Interpreter/Initialize.hs +19/−1
• src/Interpreter/Interpreter.hs +166/−65
• src/Interpreter/Lib/Concurrency.hs +15/−7
• src/Interpreter/Lib/Fonts.hs +8/−0
• src/Interpreter/Lib/Misc.hs +63/−17
• src/Interpreter/Lib/SDL.hs +162/−81
• src/Interpreter/Lib/String.hs +5/−2
• src/UI/Widgets/Common.hs +32/−21
• src/UI/Widgets/Editor.hs +2/−2
• src/UI/Widgets/LogWidget.hs +1/−1
• src/UI/Widgets/Spade/Button.hs +3/−1
• src/UI/Widgets/Spade/Input.hs +4/−5
• src/UI/Widgets/Spade/Layout.hs +1/−1
• src/UI/Widgets/Spade/Selector.hs +4/−1
• test/Interpreter/InterpreterSpec.hs +1/−2
• test/UI/EditorSpec.hs +2/−2

@@ -1,6 +1,12 @@ # Changelog for S.P.A.D.E -## Unreleased+## 0.1.0.9++* Add step option to for loops.+* Support fractional values in for loops.+* Add `log` function to log messages to the Log window when program is run in IDE.+* Add support for modules and imports in interpreter.+* Add more graphics functions.  ## 0.1.0.8 

@@ -20,32 +20,44 @@ The entire language and function reference is available in the IDE in an easily searchable way. Press F1 or use the help menu to access it. -NOTE: This is still a very early version. The standard library is virtually non-existent, and those function present are the only ones that were required to write the-sample programs in the "samples" folder in this repo.- ### IDE Demo-A short screen recording of SPADE in action can be seen [here](https://vimeo.com/692243011).+Some short screen recordings of SPADE IDE and programs are listed below. -### Installing+[Hello world!](https://vimeo.com/835322221) -#### Linux+[Draw a bunch of random circles](https://vimeo.com/835319686) +[List all files in a directory](https://vimeo.com/835324278)++[Paratrooper (game) clone attempt](https://vimeo.com/835347764)++### Installing+ ##### Run from a portable binary. -TODO+If you are on Linux then you can, -#### From source+1. Download the appimage executable from [here](https://sras.me/releases/spade.run)+2. Make it executable using `chmod +x spade.run`+3. Run it using command `./spade.run`. +If you get an error mentioning a requirement for 'FUSE', you can extract+the program from the app image and run it as shown below. -##### Dependencies+```+./spade.run --appimage-extract+./squashfs-root/AppRun+``` +#### From source+ To install depdendencies:  ```-  apt-get install libsdl2-dev-  apt-get install libsdl2-mixer-dev-  apt-get install libtinfo-dev+  apt-get install libsdl2-dev libsdl2-mixer-dev \+    libsdl2-ttf-dev \+    libsdl2-gfx-dev \+    libtinfo-dev ```  You will need the `cabal` tool. Once you have either of these, running@@ -98,6 +110,8 @@ ``` spade run /tmp/temp.spd ```++Some sample programs should be available [here](https://hackage.haskell.org/package/spade/src/samples/)  Will execute the program without opening the IDE. 

@@ -1,5 +1,6 @@ module Main where +import System.FilePath import Control.Concurrent import Control.Concurrent.STM import Control.Monad@@ -89,7 +90,7 @@       content <- T.readFile filePath       program <- compile content       TERM.Size h w <- TERM.withTerminal $ TERM.runTerminalT TERM.getWindowSize-      void $ interpret (\is -> is { isTerminalParams = Just (ScreenPos 0 0, Dimensions w h) }) program+      void $ interpret (\is -> is { isTerminalParams = Just (ScreenPos 0 0, Dimensions w h) }) (Just $ takeDirectory filePath) program      StartIDE filePath -> do       inputChan <- liftIO newTChanIO

@@ -0,0 +1,37 @@+### Text User interface toolkit++Spade includes a basic text UI toolkit with which you can assemble some basic+user interface. The toolkit includes input boxes, select dropdowns+etc.++### Layouts++Layouts are used to arrage various widgets on the screen.+Layouts can be either Horizontal or Vertical. A UI can be built by nested+combination of horizontal and vertical layouts.++### Character graphics++Spade includes the ability to write text to arbitrary screen locations+and do screen updates without flicker. This is done by painting only the+changes portions of the screen. Try running 'char-animation.spd' program+from the samples folder to see this.++To start using this feature, you should first initialize the buffers+using #link: csinit# function. The you can start writing stuff to arbitrary+locations on screen by going to the required location using #link: csgoto#+and writing stuff using #link: csprint# function. Then at the end, you have+to call the #link: csdraw# function to actually display the screen. You might+also want to call #link: csclear# function to clear the buffers before starting+to draw the next frame.++Here is a small program that prints "Hello world!" at 10 columns right and 10 rows+down.++```+csinit()+csgoto(10, 10)+csprint("Hello world!")+csdraw()+waitforkey()+```

@@ -2,20 +2,28 @@  #### startthread -Starts a thread that executes the passed callback. Immediately returns a special-result object, that can be used with #link: awaitresult#, to get the value returned-from the callback, after it has finished execution in the thread. This can also-be used with #link: killthread# to stop the execution of a thread.+Starts a thread of execution that executes the passed callback. The function+immediately returns a special object, that can be used with #link: awaitresult#+, to get the value returned from the callback, after it has+finished execution in the thread. This can also be used with #link: killthread#+to stop the execution of a thread. -The first argument to this function is the function that should be run in the thread.-The second argument is passed to the thread function. Use a list to pass multiple values-to the thread function.+The first argument to this function is the function that should be run in the+thread. The second argument is passed to the thread function. If you want to pass+multiple values, then you can simply wrap the values in a list, and pass the list+to the thread. -The thread function does not inherit any scope from main thread. If you have to share-some data with the thread, you have to use a mutable reference, that is passed to the-thread function using the second argument to `startthread` function.+The thread function inherits scope from main thread in a readonly way. This+means that any change made to the variables from the thread will not be visible+from the main thread. If you have to share some data with the thread that+should be modified by the thread, you have to use a mutable reference, passed+to the thread function using the second argument to `startthread` function.  Example:++If you run the following program, you can see that the functions+`thread1` and `thread2` being run concurrently.+ ``` proc thread1(threadname)   for i = 1 to 10@@ -35,13 +43,13 @@ let t2 = startthread(thread2, "thread 2") await(t1) await(t2)-getkey()+waitforkey()  ```  #### killthread -Kill a thread using the thread info object returned by the `startthread` function.+Kill a thread using the object returned by the `startthread` function.  Example: @@ -57,26 +65,26 @@ wait(3) -- Wait 3 seconds killthread(t1) println("Thread killed")-getkey()+waitforkey()  ```  #### awaitresult  Wait till the procedure in corresponding thread finish executing and return the result.+If the thread function does not return a value, that will be a runtime error.  Example:  ``` proc thread1(threadname)-wait(3)-return 100+  wait(3)+  return 100 endproc- let t1 = startthread(thread1, "thread 1") println("Thread started, waiting for result...") println(awaitresult(t1))-getkey()+waitforkey()  ``` @@ -85,6 +93,8 @@ Just wait till the procedure in corresponding thread finish executing. Does not expect the thread callback to return a value. +Example:+ ``` proc thread1(threadname)   wait(3)@@ -94,15 +104,24 @@ println("Thread started, waiting to end...") await(t1) println("Thread finished")-getkey()+waitforkey()  ```  #### newchannel -Create a new channel for communication with threads.+Create a new channel. A channel enables values to be sent and receieved between+multiple threads. +Example: +In the following program, we use a channel to get values sent from a thread.+We first create a channel, then start a thread passing the channel to it. In the+thread we use the #link: writechannel# function to write a value to the channel every second.++In the main thead, we wait on the channel using the #link: readchannel# function+and just print the values receieved on the channel.+ ``` proc thread1(args)   loop@@ -117,16 +136,14 @@   let x = readchannel(ch)   println(x) endloop-getkey()+waitforkey() ```  #### writechannel -```-writechannel(channel, value)-```+Write a value to a channel. -Write a value to a channel. See #link: newchannel# for an example.+See #link: newchannel# for an example.  #### readchannel @@ -137,9 +154,13 @@ Wait till a value is available on a channel, and return it when it is available. See #link: newchannel# for an example. +#### ischannelempty++Check if a channel is empty and if `readchannel` will block on it. Returns a boolean.+ #### newref -Get a new mutable reference.+Create a new mutable reference with with initial value set to the argument.  #### readref @@ -151,4 +172,30 @@  #### modifyref -Atomically modify a reference using a callback+Atomically modify a reference using a callback.++Example:++Increment a mutable reference in three threads.++```+proc thread1(ref)+  for i = 1 to 10000+    modifyref(ref, fn (n) (n + 1) endfn)+  endfor+endproc++let myref = newref(0)++let t1 = startthread(thread1, myref)+let t2 = startthread(thread1, myref)+let t3 = startthread(thread1, myref)+await(t1)+await(t2)+await(t3)+println(readref(myref))+```++This program should print 30000 as the final value of the ref every time+it is run. Try replacing modifyref call with readref/writeref calls and+see how the result is sometimes less than 30000.

@@ -1,1 +0,0 @@-### List/Dictionary Functions

@@ -9,7 +9,7 @@ ``` let mydict = { name: "John", age: 33 } inspect(haskey(mydict, "address"))-getkey()+waitforkey() ```  #### addkey@@ -18,8 +18,9 @@  #### getkey -Adds a new key to the dictionary.-+Get the value associated with the key from the dictionary. If the value is not+in the dictionary, then this will return an error value. Wrap the call in a+  #link: try# to provide a default value.  #### Getting number of items in dictionary 

@@ -2,5 +2,13 @@  #### try -Returns the first argument itself, if it is an non-error value. Or else-returns the second argument.+Accepts two arguments. If the first argument is not an error value, then+return it, or else return the second argument.++#### error++Construct an error value with the provided message.++#### iserror++Check if a value is an error value..

@@ -61,10 +61,7 @@  #### readfilehandle -Reads the specified number of bytes from the provided file handle. If there is-not enough data remaining to read, returns all the remaining data. So it-returns a bytes value of zero length on end of file, and can be used to detect-EOF.+Reads the specified number of bytes from the provided file handle. If there is not enough data remaining to read, returns all the remaining data. So it returns a bytes value of zero length on end of file, and can be used to detect EOF.  #### writefilehandle 

@@ -2,8 +2,7 @@  ##### graphics -Starts the graphics mode. The argument here is an optional-boolean. A true value indicates the graphics will use acceleration.+Starts the graphics mode. The argument here is an optional boolean. A true value indicates the graphics will use acceleration.  In accelerated graphics mode, screen is only updated on #link: render# @@ -14,8 +13,7 @@  #### graphicswindow -Starts the graphics windowed mode. The first two arguments decides the width-and height of the window. The third argument decides if the display is accelerated.+Starts the graphics windowed mode. The first two arguments decides the width and height of the window. The third argument decides if the display is accelerated.  Example: @@ -27,27 +25,15 @@  Draws everything to the screen at once. -Example:--```-render()-```- #### point  Turns the pixel at given cordinates on, with the current drawing color.  use #link: setcolor# to set drawing color. -Example:--```-point(100, 100)-```- #### points -Turns the pixels at the given coordinates on, with current drawing color.+Turns the pixels at the given coordinates on, with current drawing color. The arguments is a single list where each element is inturn a list with only two values representing x and y co-ordinates.  use #link: setcolor# to set drawing color. @@ -59,9 +45,7 @@  #### line --Draws a line from co-ordinates (100, 100) to (200, 200) using the current color-use #link: setcolor# to set drawing color.+Draws a line from the specified co-ordinates. First and second arguments represents x and y co-ordinates of the starting point, and the third and fourth arguments represents co-ordinates of the end point.  Example: @@ -71,9 +55,7 @@  #### lines -Draws a sequence of lines from a list of points. Each point is represented-by a list of two numbers, first one representing the x coordinate and the second-one representing the y-coordinate.+Draws a sequence of lines from a list of points. Each point is represented by a list of two numbers, first one representing the x coordinate and the second one representing the y-coordinate.  use #link: setcolor# to set drawing color. @@ -85,8 +67,7 @@  #### box -Draws a rectangle in current color, with top left corner at co-ordinates (100,-100) and having 20 pixels wide and 30 pixel tall.+Draws a rectangle in current color. As with the #link: line# function the arguments represents the co-ordinates of the top left and bottom right corners.  use #link: setcolor# to set drawing color. @@ -98,8 +79,7 @@  #### circle -Draws a rectangle in current color, with center at co-ordinates (100,-100) and having a radius of 20 pixels.+Draws a circle that can be optionally filled.  use #link: setcolor# to set drawing color. @@ -109,56 +89,70 @@ circle(100, 100, 20) ``` -#### arc+#### smoothcircle -```-arc(center_x, center_y, radius, start_angle, end_angle, fill)-```+Similar to #link: circle# function, but draws an smooth (antialiased)+circle. +#### ellipse++Draws an ellipse which can be optionally filled.++#### smoothellipse++Draws a smooth (antialiased) ellipse.++#### arc+ Similar to #link: circle#, but draws an arc. -#### polygon+#### pie -```-polygon(points, fill)-```+Similar to #link: arc#, but draws a pie shape. -Draws a polygon taking a list of points as input. The last point is joined with-the first one, closing the polygon. The second optional argument specifies-wether the polygon should be filled.+#### polygon +Draws a polygon taking a list of points as input. The last point is joined with the first one, closing the polygon. The second optional argument specifies wether the polygon should be filled.+ Sample:  ``` polygon([[100, 100], [150, 50], [200, 100]]) ``` +#### smoothpolygon +Same as #link: polygon#, but draws an anti-aliased polygon, and does not have the option to draw filled polygon.++#### setbgcolor++Sets the current background color using red, green and blue component values. The function #link: clearscreen# will use this color to clear the screen.+ #### setcolor  Sets the current drawing color using red, green and blue component values. -Example:+#### setcolora -```-setcolor(100, 10, 200)-```+Sets the current drawing color using red, green, blue and transparency component values.  #### clearscreen -Fills the graphics screen with current draw color.+Fills the graphics screen with current background color.  Example:  ```-setcolor(0, 0, 0)-clearscreen() -- paints the entire screen black.+setbgcolor(255, 0, 0)+clearscreen() -- paints the entire screen red. ```  #### getwindowsize  Gets the dimensions of the graphics window. +Example:+ ``` graphics() let windowsize = getwindowsize()@@ -168,27 +162,45 @@  #### setlogicalsize -Sets the logical size of the display, so that things being drawn on screen-are scaled to fit the entire dimensions of actual display. Check #link: Graphics and Animation# to-read more about using this function.+Sets the logical size of the display, so that things being drawn on screen are scaled to fit the entire dimensions of actual display. Check #link: Graphics and Animation# to read more about using this function. -#### waitforkey+#### gwaitforkey -Waits for the user to press a key when the graphics window is in focus.+Suspends the program till a key is pressed when the graphics window has focus. Use #link: waitforkey#+to wait for key press when running in a terminal window. -Example: -```-waitforkey()-```- ##### loadtexture  Loads a bitmap file into a texture. +##### setfont++Sets the default font and font-size that will be used by text rendering+functions.++##### loadfont++Load a font and return it. First argument is the point size of the target font. The second optional argument is the path to the font file (.ttf or .otf) file. If it is not provided, a default font will be used.+++##### texttotexture++Creates a texture from text+ ##### destroytexture  Destroys a loaded texture.++##### drawtextat++Draw text at the provided location using the currently active font (set using #link: setfont#)+and active color.++##### drawtextrotatedat++Draw rotated text at the provided location and angle using the currently active font (set using #link: setfont#)+and active color.  ##### copytexture 

@@ -2,20 +2,15 @@  #### getkeystate -Captures the keyboard state and returns the captured state.-This state can be used with #link: inkeystate# function to check if some-keys were pressed during the capture.+Captures the keyboard state and returns the captured state. This state can be used with #link: inkeystate# function to check if some keys were pressed during the capture.  #### inkeystate -Checks if the provided key was pressed when the keyboard state was captured.-The function accept the keyboard scancode, and should be passed values in-the builtin #link: scancodes# dictionary.+Checks if the provided key was pressed when the keyboard state was captured. The function accept the keyboard scancode, and should be passed values in the builtin #link: scancodes# dictionary.  #### getkeypresses -Returns the keycodes of all the keys that were pressed since the last call-to this function, in a list.+Returns the keycodes of all the keys that were pressed since the last call to this function, in a list.  #### keycodes 

@@ -2,8 +2,7 @@  #### insertleft -Inserts an element at the start of the list, and returns the modified-list.+Inserts an element at the start of the list, and returns the modified list.  Example: @@ -16,8 +15,7 @@  #### insertright -Inserts an element at the end of the list, and returns the modified-list.+Inserts an element at the end of the list, and returns the modified list.  Example: @@ -116,5 +114,4 @@  #### repeat -Returns a list with the provided item repeated the specified number-of times.+Returns a list with the provided item repeated the specified number of times.

@@ -3,18 +3,15 @@  #### sin -The trignometric sine function. Accepts an angle in degrees and return-it's sine value+The trignometric sine function. Accepts an angle in degrees and return it's sine value  #### cos -The trignometric cosine function. Accepts an angle in degrees and return-it's cosine value+The trignometric cosine function. Accepts an angle in degrees and return it's cosine value  #### tan -The trignometric tangent function. Accepts an angle in degrees and return-it's tan value+The trignometric tangent function. Accepts an angle in degrees and return it's tan value  #### asin @@ -46,9 +43,10 @@  #### hash -Computes the hash using algorith specified and of input bytes.-Right now only support following algorithms.+Computes the hash using algorith specified and of input bytes. Right now only support following algorithms. +1. md5+ #### hashinit  Initialize a hash context for incremental hashing.@@ -60,6 +58,3 @@ #### hashfinalize  Gets the final hash.---1. md5

@@ -1,13 +1,5 @@ ### Miscellaneous Functions -#### error--Construct an error value with the provided message.--#### iserror--Check if a value is an error value..- #### print  Accept many values and prints them in order, without an ending newline.@@ -151,8 +143,20 @@  #### csscreensize -TODO+Gets the screen/terminal size. Returns an object with+"width" and "height" keys. +#### waitforkey++Waits for the user to press a key when the graphics window is in focus.++Example:++```+waitforkey()+```++ #### setsize  TODO@@ -192,3 +196,24 @@ #### button  TODO++#### log++TODO++#### import++TODO++#### next++TODO++#### exec++Execute the program using the file path and provided arguments.++#### mkdir++Create directory at the path provided by first argument. Create parents of the directory as well, if the second argument is True. If the directory exist, do nothing.+

@@ -41,4 +41,3 @@  Sets the sound volume of the channel specified by the first argument. The left, right volumes are specified using the second and thrird arguments, as a value from 0 to 128.-

@@ -1,13 +1,122 @@ ## Language Reference +Every program in SPADE is made up of a bunch modules, which are inturn made up of a bunch of statements, each of which tells the computer (the SPADE interpreter to be precise) to do one thing or the other. A bunch of statements can be wrapped in procedures/functions so that they can be reused throughout the code. Intermediate values can be stored in variables so that they can be used or referenced from various places.++### Modules++A module is just a file that contain SPADE code. You can import a module using the `import` function. The snippet below imports a module and calls a function inside it.++```+let common = import("/path/to/the/module.spd")+common.a_function_in_the_module()+```++You can read more about modules and imports in #link: Modules and Imports# section.+ ### Variables  Variables are initialized using `let` statement. For example  ```-let a = 10+  let myVar = 10 ``` +creates a variable named `myVar` with a value of `10`. The same statement can also change the value of an existing variable.++### Procedures++Procedures are a way to reuse code by bunching statements together and providing a way to call or invoke them from different parts of the program. In SPADE, They are declared using the `proc` keyword. Procedures can have "arguments", which are just values that are passed to and made available in the scope where the statements in the procedure are executed.++You can customize the behavior of the procedure using the arguments. For example, if you have a procedure to draw a circle, you can use arguments to pass the center and radius of the circle that should be drawn. Procedures can also "return" a value to the calling code, so you can optionally pass the result that was computed by the statements in the procedure. For example Here is a procedure to multiply two of its arguments and return the result.++```+  proc multiply(a, b)+    return a * b+  endproc++  let product = multiply(5, 2) -- Here we call the "multiply" procedure+  println(product)+```++### Anonymous procedures++An anonymous procedures are a single use, throwaway procedures without a name. They are useful as a callback to pass some logic into another procedures.++You can create anonymous procedures using the `fn` keyword. Anonymous procedures can contain only a single expression, and the value of the expression is returned automatically.++Below is an Example where a callback using an anonymous procedures is passed to the `filter` function. So here we have a list of numbers, and using the `filter` function we remove the elements that are less than three from it. An anonymous function is used to pass the logic that checks if the number is less than three.++```+  let a = [1, 2, 3, 4, 5]+  let b = filter(a, fn (x) x >= 3 endfn) -- anonymous procedures that returns true for numbers >= 3+  inspect(b) -- will print [3, 4, 5]+```++Named procedures can also be used in place of callbacks. So if you want to include more logic inside a callback, you can use a regular named procedure as a callback. For example the above program can be written as,++```+  proc filterFn(x)+    return (x >= 3)+  endproc++  let a = [1, 2, 3, 4, 5]+  let b = filter(a, filterFn) -- The procedures name `filterFn` is used in place of a callback.+  inspect(b)+```++There is no requirement that anonymous procedures must return a value. But if the code that uses it expect a value to be returned from it, and it does not return a value, then it will be a run time error.++#### Global variables++A global variable is just a variable who's definition is not inside a procedure. Such a variable is available everywhere inside the module it is defined in. See the example below.++```+  let myGlobal = 10++  proc printMyGlobal()+    println(myGlobal) -- Variable "myGlobal" is available here+  endproc++  printMyGlobal()+```++##### Updating a global variable++Updating global variables from within a procedures require special syntax. You should use the `global` keyword for this. Not using the `global` keyword just creates a local variable with the same name, within the scope of the procedure.++For example, if you do the following,++```+  let myGlobal = 10++  proc printMyGlobal()+    println(myGlobal)+  endproc++  proc updateMyGlobal()+    let myGlobal = 20+  endproc++  printMyGlobal()+  updateMyGlobal()+  printMyGlobal()+```++In the above program, we first print the value of global variable `myGlobal` using `printMyGlobal` procedure and then we call another procedure that tries to update the value of this global variable, and then we again print the global variable using the `printMyGlobal` procedure. We see that in the last step, the `printMyGlobal`+procedure still prints `10`. This is because the following line,++```+  let myGlobal = 20+```++instead of updating the global variable, created a local variable with name `myGlobal`, and the global variable was untouched. To update the global variable, we should change this line to,++```+  let global myGlobal = 20+```++When using this syntax, the global variable that is referenced should exist already. If there is no global variable by the name referenced, then it would be a runtime error. In other words, you cannot create new global variables using this syntax.+ ### Conditionals  #### if-then@@ -50,15 +159,35 @@ endif ``` +### Lists++Lists can hold an arbitrary number of values. For example,++```+let myList = ["one",2,3]+```++Lists in SPADE are one based so list indexes starts from 1 and not 0. So in the above list, the index `1` will have value "one", the index `1` will have value `2` and index `3` will have value `3`. You can read more about list indexing at #link: Index access#++### Dictionaries++Like lists, dictionaries can also hold muiltiple values, but in a dictionary each value can be associated with a key. In the following snippet you can see how a dictionary is initialized and how indvidual values can be accessed.++```+let person = { name: "John", age: 25 }+println(person.name) -- prints "John"+println(person.age) -- prints 25+```++You can read more about key access at #link: Key access#.+ ### Loops -Loops are using to execute a sequence of statements repeatedly. Following-looping constructs are available.+Loops are using to execute a sequence of statements repeatedly. Following looping constructs are available.  #### for statement -This loop can be used to execute some group of statements repeatedly,-while incrementing a variable at each iteration.+This loop can be used to execute some group of statements repeatedly, while incrementing a variable at each iteration.  Example: @@ -68,12 +197,20 @@ endfor ``` -The `break` statement can be used to break out of the loop.+A step value can be optionally provided. The following example will print 1, 3, 5, 7 and 9 and so on till+the end value is reached. +```+for i = 1 to 10 step 2+  println(i)+endfor+```++The start/end/step value can be either interger or fractional. The break statement can be used to break out of the loop.+ #### while statement -This loop execute a group of statements repeatedly as long as the specified-condition hold.+This loop execute a group of statements repeatedly as long as the specified condition hold.  Example: @@ -87,10 +224,9 @@  The `break` statement can be used to break out of the loop. -#### loop statement+### loop statement -This is an unconditional looping statement.-The only way to exit from the loop is by using a `break` statement.+This is an unconditional looping statement. The only way to exit from the loop is by using a `break` statement.  Example: @@ -104,34 +240,9 @@ getkey() ``` -### Functions/Procedures--Functions are declared using the `proc` keyword. For example--```-proc multiply(a, b)-  return a * b-endproc--println(multiply(5, 2))-```--### Anonymous functions or Lambdas--You can create anonymous function using the `fn` keyword. Example where-a callback using an anonymous function is passed to the `filter` function.--```-let mylist = [2, 3, 4, 5, 6]-let filtered = filter(mylist, fn(x) mod(x, 2) == 0 endfn)-```--Anonymous functions can contain only a single expression.- ### Scoping -Variables assigned at the top level are globals and are available-inside functions without special syntax.+Variables defined inside the procedure are local to the procedure and is available everywhere inside the procedure. Variables assigned at the top level are globals and are available as readonly values inside procedure without special syntax.  For example, the program below will print `10` when executed. @@ -145,9 +256,7 @@ myProc() ``` -There is a caveat to this though. Global variables defined below a-function call will not be available inside the function. For example-the following program results in an "Unknown symbol reference" error.+There is a caveat to this though. Global variables defined below a procedure call will not be available inside the procedure. For example the following program results in an "Unknown symbol reference" error.  ``` proc myProc()@@ -160,12 +269,23 @@ -- ^ Global variable `a` defined after `myProc` call. Variable `a` -- is not available inside `myProc`. ```+Any assignment to a global variables inside a procedure will just create a local variable with the same name. For example, the following program will print `10`. +```+let a = 10++proc myFn()+  let a = (a + 1)+endproc+myFn()+println(a)+```++If you want global mutable values, you can use a global mutable reference, see #link: newref#.+ #### Closures -When a function returns an unnamed function, the returned function holds-a copy of the parent functions local scope. For example, the following function-prints `10 20`+When a procedure returns an unnamed procedures, the returned procedures holds a copy of the parent procedures local scope. For example, the following procedure prints `10 20`  ``` proc myFunc(x)@@ -181,8 +301,7 @@  ### Expressions -Expressions are things that can be evaluated to a value. Following types-of expressions are available in the language.+Expressions are things that can be evaluated to a value. Following types of expressions are available in the language.  #### Literals @@ -199,15 +318,14 @@  #### Variable expression -These refer to a variable, and evaluate to the same value that is held-by the variable.+These refer to a variable, and evaluate to the same value that is held by the variable.  #### Conditional expression -These provide conditional evaluation, for example.+Expressions that evaluate to one value or other based on a condition.  ```-let x = if x == 0 then 1 else x+let p = if x == 0 then 5 else 10 ```  #### Binary expression@@ -321,8 +439,7 @@  #### Numbers -Numbers are either represented as integers (which can be as big as required)-or double precision floating point values.+Numbers are either represented as integers (which can be as big as required) or double precision floating point values.  Mathematical operations convert from integer to floating point values as required. @@ -356,25 +473,44 @@  ``` -Item at an index `x` in list `l` can be accessed using notation `l[x]`.-Indexes start at `1`, so to access the first item in a list use `l[1]`.+Item at an index `x` in list `l` can be accessed using notation `l[x]`. Indexes start at `1`, so to access the first item in a list use `l[1]`.  See #link: List Functions#  #### Dictionary -Dictionaries are containers that can hold content at a string key.-For example, the data for a person can be held in a dictionary.+Dictionaries are containers that can hold content at a string key. For example, the data for a person can be held in a dictionary.  ``` let person = { name: "John", age: 45} ``` -indvidual items can be accessed using the key access notation. For example-to print the name of the person, we can do something like the following.--See #link: Dictionary Functions#+indvidual items can be accessed using the key access notation. For example to print the name of the person, we can do something like the following.  ``` println(person.name) ```++#### Modules and Imports++You can split a program into a number of source files or source modules. You can import a module using the #link: import# function. The #link: import# function returns a module value, and the functions inside the imported module can be accessed using the dot operator. For example,++```+let m = import("mymodule.spd")+println(m.myDouble(2))+```++Where contents of "mymodule.spd" is++```+proc myDouble(x)+  return 2 * x+endproc+```++A module is just a value, so it can be passed to functions, stored in a variable etc. Modules have their own scope and importing a module executes the top level statements in it. So Modules can also import each other recursively as long as the top level statements, if any, does not trigger a recursive execution. Only function from a module can be accessed from other modules. If you want to export a value from a module, you should wrap that in a function and return it from there.++When a module is imported, top level statements from that source file are executed. A module gets its on private scope, and the global variables in a module reside in this private scope. This scope is retained and restored between calls to functions in this instance of the module. The module scope is not shared between instances of the same module.++To update a module global variable use the `let` statement with `global` keyword. So `let global x = 10` stores the value `10` in module global variable `x`. If the global variable does not exist at this point, it is created.+

@@ -9,14 +9,12 @@  ## Table of contents -IDE Reference-  #link: Menu#-  #link: Windows#-  #link: Shortcuts#-  #link: Debugging# #link: Language Reference#+  #link: Modules#   #link: Variables#-  #link: Scoping#+  #link: Procedures#+  #link: Lists#+  #link: Dictionaries#   #link: Expressions#     #link: Literals#     #link: Variable expression#@@ -35,7 +33,8 @@     #link: for statement#     #link: while statement#     #link: loop statement#-  #link: Functions/Procedures#+  #link: Scoping#+  #link: Closures#   #link: Builtin data types# #link: Graphics and Animation#   #link: Working with screens of different resolutions#@@ -56,3 +55,8 @@   #link: Error Handling Functions#   #link: Debugging Functions#   #link: Miscellaneous Functions#+IDE Reference+  #link: Menu#+  #link: Windows#+  #link: Shortcuts#+  #link: Debugging#

@@ -0,0 +1,6 @@+### TUI Toolkit++Spade includes a user interface building library to build simple TUIs (Text user+interfaces).++Widgets can be arranged in a UI by nesting Horizontal/Vertical layouts.

binary file changed (absent → 29904 bytes)

@@ -0,0 +1,6 @@+csinit()+csclear()+csgoto(10, 10)+csprint("Hello world!")+csdraw()+waitforkey()

@@ -0,0 +1,10 @@+proc thread1(r)+  for i = 1 to 500+    let rv = readref(r)+    writeref(r, (rv + 1))+  endfor+endproc+let ref = newref(0)+let t = startthread(thread1)+await(t)+print(readref(ref))

@@ -184,7 +184,7 @@     break   endif endloop-getkey()+ -- let catalogPath = getCatalogPath() -- let catalogPath = selectPath(false) -- csclear()

@@ -1,5 +1,5 @@ graphicswindow(800, 800, false)-let params = {"height":800,"scale":2.63331,"start":{"img":-1.54217315,"real":-2.0421},"step":0.0101525597994770,"width":800}+let params = {height: 800, scale: 2.63331, start: {img: -1.54217315, real: -2.0421}, step: 0.0101525597994770, width: 800} let params_ref = newref(params) loop   let ws = getwindowsize()@@ -17,7 +17,7 @@   for x = 0 to round((params.width / params.scale))     let n = drawonecol(params, x)     if (n == "exit") then-      return n+      return not()     elseif (n == "redraw") then       break     endif@@ -30,7 +30,7 @@   for y = 0 to round((params.height / params.scale))     let n = processkeys(params, getkeypresses())     if (n !== "continue") then-      return n+      return not()     endif     let current = {img: (params.start.img + (y * params.step)), real: real}     let ds = isinset(current)@@ -65,13 +65,13 @@ proc amendstep(params, mult)   let current_center_x = (params.start.real + ((params.width / (2 * params.scale)) * params.step))   let current_center_y = (params.start.img + ((params.height / (2 * params.scale)) * params.step))-  let newstep = (params.step * mult)+  let newstep = (params["step"] * mult)   let new_center_x = (params.start.real + ((params.width / (2 * params.scale)) * newstep))   let new_center_y = (params.start.img + ((params.height / (2 * params.scale)) * newstep))   let params.start.real = (params.start.real + (current_center_x - new_center_x))   let params.start.img = (params.start.img + (current_center_y - new_center_y))-  let params.step = newstep-  return params+  let params["step"] = newstep+  return paramsendproc endproc  proc processkeys(range_start, keys)

@@ -7,7 +7,8 @@ let cannon = {angle: 0, x: (ws.width / 2), y: (ws.height - 90)} let gamestate = {bullets: [], cannon: cannon, fragments: [], helicopters: [], troopers: []} let lasttime = 0-let gatlingsound = maketone(355) -- loadsound("/home/sras/temp/gatling.aud.wav")+let gatlingsound = maketone(355)+-- loadsound("/home/sras/temp/gatling.aud.wav") let helicopterpoints = [[1920, 1076], [1920, 1076], [1920, 1052], [1920, 1052], [1979, 1015], [1979, 1015], [2056, 1015], [2056, 1015], [2063, 1049], [2063, 1049], [2208, 1049], [2208, 1049], [2221, 1000], [2221, 1000], [2269, 1000], [2269, 1000], [2269, 1053], [2269, 1053], [1922, 1077], [1922, 1077]] let trooperpoints = [[1920, 1034], [1920, 1034], [1920, 1012], [1920, 1012], [1933, 1012], [1933, 1012], [1933, 1034], [1933, 1034], [1947, 1034], [1947, 1034], [1952, 1051], [1952, 1051], [1946, 1053], [1946, 1053], [1946, 1043], [1946, 1043], [1939, 1058], [1939, 1058], [1945, 1080], [1945, 1080], [1935, 1080], [1935, 1080], [1933, 1058], [1933, 1058], [1924, 1078], [1924, 1078], [1916, 1078], [1916, 1078], [1920, 1058], [1920, 1058], [1913, 1041], [1913, 1041], [1911, 1055], [1911, 1055], [1901, 1055], [1901, 1055], [1909, 1035], [1909, 1035], [1921, 1035], [1921, 1035]] let helicopterpoints_rl = scaleandnormalize(helicopterpoints, 1)@@ -15,10 +16,13 @@ let trooperpoints_s = scaleandnormalize(trooperpoints, 1) playsound(gatlingsound, 0) setvolume(0, 0)+let lastbullettime = 0 loop+  let nowtime = timestamp()   drawworld(gamestate)   let keys = getkeystate()-  if inkeystate(keys, scancodes.up) then+  if (inkeystate(keys, scancodes.up) and ((nowtime - lastbullettime) > 500000)) then+    let lastbullettime = nowtime     setvolume(0, 128)     let gamestate.bullets = insertleft(makebullet(gamestate.cannon.angle, 14000), gamestate.bullets)   else@@ -27,7 +31,6 @@   if inkeystate(keys, scancodes.q) then     break   endif-  let nowtime = timestamp()   let d = random(0, 2000)   if ((d > 10) and (d < 13)) then     if (d == 11) then@@ -58,7 +61,7 @@   let total_x = 0   let total_y = 0   let p = []-  foreach pi as i+  foreach pi as i      let p = insertright(p, [(i[1] / 4), (i[2] / 4)])   endforeach   for i = 1 to size(p)@@ -79,7 +82,7 @@ endproc  proc maketrooper(x, y)-  return {state: 0, x: x, y: y, destroyed: false}+  return {destroyed: false, state: 0, x: x, y: y} endproc  proc makefragments(x, y, d)@@ -93,7 +96,7 @@ proc drawtrooper(trooper)   setcolor(0, 255, 0)   let tps = []-  foreach trooperpoints_s as tp+  foreach trooperpoints_s as tp      let tps = insertright(tps, [(tp[1] + trooper.x), (tp[2] + trooper.y)])   endforeach   lines(tps)@@ -123,7 +126,7 @@     let h = gs.helicopters[i]     let gs.helicopters[i].x = (h.x + (h.direction * (100 * et)))     let gs.helicopters[i].bladepos = (gs.helicopters[i].bladepos + 1)-    foreach gs.bullets as b+    foreach gs.bullets as b        let dx = (b.x - gs.helicopters[i].x)       let dy = (b.y - gs.helicopters[i].y)       if (((dx * dx) + (dy * dy)) < 2050) then@@ -135,7 +138,7 @@   endfor   for i = 1 to size(gs.troopers)     let gs.troopers[i].y = (gs.troopers[i].y + (100 * et))-    foreach gs.bullets as b+    foreach gs.bullets as b        let dx = (b.x - gs.troopers[i].x)       let dy = (b.y - gs.troopers[i].y)       if (((dx * dx) + (dy * dy)) < 2050) then@@ -152,10 +155,10 @@     let gs.fragments[i].vy = (t.vy - (1000 * et))     let gs.fragments[i].age = (gs.fragments[i].age + 0.01)   endfor-  let gs.helicopters = filter(gs.helicopters, fn (h) (h.x > -40) and (h.x < (ws.width + 40)) and not(h.destroyed) endfn)+  let gs.helicopters = filter(gs.helicopters, fn (h) ((h.x > -40) and ((h.x < (ws.width + 40)) and not(h.destroyed))) endfn)   let gs.bullets = filter(gs.bullets, fn (b) ((b.y > -1000) and ((b.x < ws.width) and ((b.x > 0) and (b.y < ws.height)))) endfn)   let gs.fragments = filter(gs.fragments, fn (fr) (fr.y < 2000) endfn)-  let gs.troopers = filter(gs.troopers, fn (t) (t.y < ws.height and not(t.destroyed)) endfn)+  let gs.troopers = filter(gs.troopers, fn (t) ((t.y < ws.height) and not(t.destroyed)) endfn)   return gs endproc @@ -200,10 +203,10 @@   for i = 1 to size(gs.helicopters)     drawhelicopter(gs.helicopters[i], 1000)   endfor-  foreach gs.troopers as trooper+  foreach gs.troopers as trooper      drawtrooper(trooper)   endforeach-  foreach gs.fragments as f+  foreach gs.fragments as f      let c = (255 / f.age)     setcolor(c, c, c)     box(f.x, f.y, random(4, 25), random(4, 25), true)

@@ -0,0 +1,9 @@+graphics()+let texture = texturefromtext("/usr/share/fonts/truetype/dejavu/DejaVuSansMono.ttf", 40, 255, 0, 0, 55, "Hello World!")+for i = 1 to 1000+  setcolor(0, 0, 0)+  clearscreen()+  copytexture(texture, (i + 200), 200, textureinfo(texture).width, textureinfo(texture).height)+  render()+endfor+gwaitforkey()

@@ -0,0 +1,24 @@+csinit()+let l = layout("v", [])+setsize(l, 100, 30)+let s = selector("Test selector", [[1, "Option 1"], [2, "Option 2"]])+let s1 = selector("Test selector", [[1, "Option 1"], [2, "Option 2"]])+let b1 = button("Button 1")+let b2 = button("Button 2")+let ml = multilineinput()+attach(l, s)+attach(l, s1)+attach(l, b1)+attach(l, b2)+attach(l, ml)+setsize(ml, 30, 10)+setfocus(l, true)+++loop+  csclear()+  draw(l)+  csdraw()+  let ks = waitforkey()+  handle(l, ks)+endloop

@@ -1,11 +1,11 @@ cabal-version: 2.2 --- This file has been generated from package.yaml by hpack version 0.35.0.+-- This file has been generated from package.yaml by hpack version 0.35.2. -- -- see: https://github.com/sol/hpack  name:           spade-version:        0.1.0.8+version:        0.1.0.9 synopsis:       A simple programming and debugging environment. description:    A simple weakly typed, dynamic, interpreted programming langauge and terminal IDE. category:       language, interpreter, ide@@ -17,12 +17,13 @@ extra-source-files:     README.md     ChangeLog.md+    docs/character-graphics.md     docs/graphics-and-animation.md     docs/ide.md     docs/language-reference.md     docs/toc.md+    docs/tui-toolkit.md     docs/functions/concurrency.md-    docs/functions/container.md     docs/functions/debugging.md     docs/functions/dictionary.md     docs/functions/error-handling.md@@ -36,14 +37,19 @@     docs/functions/sound.md     docs/functions/string.md     docs/functions/time.md+    fonts/AileronBlack.otf     stack.yaml     stack.yaml.lock     samples/char-animation.spd+    samples/char-graphics.spd+    samples/concurrency.spd     samples/filechecker.spd     samples/mandelbrot.spd     samples/paratrooper.spd     samples/snake.spd     samples/spiral.spd+    samples/text-rendering.spd+    samples/tui.spd  library   exposed-modules:@@ -79,6 +85,7 @@       Interpreter.Lib.Concurrency       Interpreter.Lib.Crypto       Interpreter.Lib.FileSystem+      Interpreter.Lib.Fonts       Interpreter.Lib.Math       Interpreter.Lib.Misc       Interpreter.Lib.SDL@@ -163,42 +170,49 @@       InstanceSigs   ghc-options: -Wall -Wno-type-defaults   build-depends:-      Decimal-    , WAVE-    , aeson-    , ansi-terminal+      Decimal >=0.5.2 && <0.6+    , WAVE >=0.1.6 && <0.2+    , aeson >=2.1.2 && <2.2+    , ansi-terminal >=0.11.5 && <0.12     , base >=4.16.3 && <4.17-    , bytestring-    , constraints-    , containers-    , cryptonite-    , directory-    , exceptions-    , file-embed-    , filepath-    , hedgehog-    , hex-text-    , hspec-    , hspec-hedgehog-    , memory-    , monad-loops-    , mtl-    , ordered-containers-    , process-    , random-    , regex-tdfa-    , scientific-    , sdl2-    , sdl2-mixer-    , stm-    , template-haskell-    , terminal-    , text-    , time-    , unix-    , unordered-containers-    , vector-    , with-utf8+    , bytestring >=0.11.3 && <0.12+    , constraints >=0.13.4 && <0.14+    , containers >=0.6.5 && <0.7+    , cryptonite ==0.30.*+    , directory >=1.3.6 && <1.4+    , exceptions >=0.10.4 && <0.11+    , file-embed >=0.0.15 && <0.1+    , filepath >=1.4.2 && <1.5+    , hedgehog ==1.2.*+    , hex-text >=0.1.0 && <0.2+    , hspec >=2.11.0 && <2.12+    , hspec-discover >=2.11.1 && <2.12+    , hspec-hedgehog >=0.0.1 && <0.1+    , memory >=0.18.0 && <0.19+    , monad-loops >=0.4.3 && <0.5+    , mtl >=2.2.2 && <2.3+    , neat-interpolation >=0.5.1 && <0.6+    , ordered-containers >=0.2.3 && <0.3+    , process >=1.6.13 && <1.7+    , random >=1.2.1 && <1.3+    , regex-tdfa >=1.3.2 && <1.4+    , scientific >=0.3.7 && <0.4+    , sdl2 >=2.5.5 && <2.6+    , sdl2-gfx >=0.3.0 && <0.4+    , sdl2-mixer >=1.2.0 && <1.3+    , sdl2-ttf >=2.1.3 && <2.2+    , stm >=2.5.0 && <2.6+    , strip-ansi-escape >=0.1.0 && <0.2+    , template-haskell >=2.18.0 && <2.19+    , terminal >=0.2.0 && <0.3+    , text >=1.2.5 && <1.3+    , time >=1.11.1 && <1.12+    , unix >=2.7.2 && <2.8+    , unliftio >=0.2.24 && <0.3+    , unliftio-core >=0.2.1 && <0.3+    , unordered-containers >=0.2.19 && <0.3+    , vector >=0.13.0 && <0.14+    , with-utf8 >=1.0.2 && <1.1   default-language: Haskell2010   autogen-modules: Paths_spade @@ -256,43 +270,50 @@       InstanceSigs   ghc-options: -Wall -Wno-type-defaults -threaded -fPIC   build-depends:-      Decimal-    , WAVE-    , aeson-    , ansi-terminal+      Decimal >=0.5.2 && <0.6+    , WAVE >=0.1.6 && <0.2+    , aeson >=2.1.2 && <2.2+    , ansi-terminal >=0.11.5 && <0.12     , base >=4.16.3 && <4.17-    , bytestring-    , constraints-    , containers-    , cryptonite-    , directory-    , exceptions-    , file-embed-    , filepath-    , hedgehog-    , hex-text-    , hspec-    , hspec-hedgehog-    , memory-    , monad-loops-    , mtl-    , ordered-containers-    , process-    , random-    , regex-tdfa-    , scientific-    , sdl2-    , sdl2-mixer+    , bytestring >=0.11.3 && <0.12+    , constraints >=0.13.4 && <0.14+    , containers >=0.6.5 && <0.7+    , cryptonite ==0.30.*+    , directory >=1.3.6 && <1.4+    , exceptions >=0.10.4 && <0.11+    , file-embed >=0.0.15 && <0.1+    , filepath >=1.4.2 && <1.5+    , hedgehog ==1.2.*+    , hex-text >=0.1.0 && <0.2+    , hspec >=2.11.0 && <2.12+    , hspec-discover >=2.11.1 && <2.12+    , hspec-hedgehog >=0.0.1 && <0.1+    , memory >=0.18.0 && <0.19+    , monad-loops >=0.4.3 && <0.5+    , mtl >=2.2.2 && <2.3+    , neat-interpolation >=0.5.1 && <0.6+    , ordered-containers >=0.2.3 && <0.3+    , process >=1.6.13 && <1.7+    , random >=1.2.1 && <1.3+    , regex-tdfa >=1.3.2 && <1.4+    , scientific >=0.3.7 && <0.4+    , sdl2 >=2.5.5 && <2.6+    , sdl2-gfx >=0.3.0 && <0.4+    , sdl2-mixer >=1.2.0 && <1.3+    , sdl2-ttf >=2.1.3 && <2.2     , spade-    , stm-    , template-haskell-    , terminal-    , text-    , time-    , unix-    , unordered-containers-    , vector-    , with-utf8+    , stm >=2.5.0 && <2.6+    , strip-ansi-escape >=0.1.0 && <0.2+    , template-haskell >=2.18.0 && <2.19+    , terminal >=0.2.0 && <0.3+    , text >=1.2.5 && <1.3+    , time >=1.11.1 && <1.12+    , unix >=2.7.2 && <2.8+    , unliftio >=0.2.24 && <0.3+    , unliftio-core >=0.2.1 && <0.3+    , unordered-containers >=0.2.19 && <0.3+    , vector >=0.13.0 && <0.14+    , with-utf8 >=1.0.2 && <1.1   default-language: Haskell2010   autogen-modules: Paths_spade @@ -365,44 +386,48 @@       InstanceSigs   ghc-options: -Wall -Wno-type-defaults   build-depends:-      Decimal-    , WAVE-    , aeson-    , ansi-terminal+      Decimal >=0.5.2 && <0.6+    , WAVE >=0.1.6 && <0.2+    , aeson >=2.1.2 && <2.2+    , ansi-terminal >=0.11.5 && <0.12     , base >=4.16.3 && <4.17-    , bytestring-    , constraints-    , containers-    , cryptonite-    , directory-    , exceptions-    , file-embed-    , filepath+    , bytestring >=0.11.3 && <0.12+    , constraints >=0.13.4 && <0.14+    , containers >=0.6.5 && <0.7+    , cryptonite ==0.30.*+    , directory >=1.3.6 && <1.4+    , exceptions >=0.10.4 && <0.11+    , file-embed >=0.0.15 && <0.1+    , filepath >=1.4.2 && <1.5     , hedgehog-    , hex-text+    , hex-text >=0.1.0 && <0.2     , hspec     , hspec-discover     , hspec-hedgehog-    , memory-    , monad-loops-    , mtl+    , memory >=0.18.0 && <0.19+    , monad-loops >=0.4.3 && <0.5+    , mtl >=2.2.2 && <2.3     , neat-interpolation-    , ordered-containers-    , process-    , random-    , regex-tdfa-    , scientific-    , sdl2-    , sdl2-mixer+    , ordered-containers >=0.2.3 && <0.3+    , process >=1.6.13 && <1.7+    , random >=1.2.1 && <1.3+    , regex-tdfa >=1.3.2 && <1.4+    , scientific >=0.3.7 && <0.4+    , sdl2 >=2.5.5 && <2.6+    , sdl2-gfx >=0.3.0 && <0.4+    , sdl2-mixer >=1.2.0 && <1.3+    , sdl2-ttf >=2.1.3 && <2.2     , spade-    , stm+    , stm >=2.5.0 && <2.6     , strip-ansi-escape-    , template-haskell-    , terminal-    , text-    , time-    , unix-    , unordered-containers-    , vector-    , with-utf8+    , template-haskell >=2.18.0 && <2.19+    , terminal >=0.2.0 && <0.3+    , text >=1.2.5 && <1.3+    , time >=1.11.1 && <1.12+    , unix >=2.7.2 && <2.8+    , unliftio >=0.2.24 && <0.3+    , unliftio-core >=0.2.1 && <0.3+    , unordered-containers >=0.2.19 && <0.3+    , vector >=0.13.0 && <0.14+    , with-utf8 >=1.0.2 && <1.1   default-language: Haskell2010

@@ -11,6 +11,7 @@ import Data.Text as T import Data.Text.IO as T import Data.Time.Clock.POSIX (getPOSIXTime)+import Data.Time.Format import Data.Time.Clock.System import Data.Time.LocalTime import qualified Language.Haskell.TH.Syntax as TH@@ -34,7 +35,7 @@ getLocalTimeString = (formatLocalTime . localTimeOfDay) <$> getLocalTime  formatLocalTime :: TimeOfDay -> Text-formatLocalTime TimeOfDay {..} = (T.pack $ show todHour) <> ":" <> (T.pack $ show todMin) <> ":" <> (T.pack $ show (round todSec))+formatLocalTime tod = pack $ formatTime defaultTimeLocale "%T" tod  wait :: Double -> IO () wait s = threadDelay (floor $ s * 1000_000)@@ -134,11 +135,14 @@       in ((frag, Just tk): fragRst, ts)   | otherwise = ([], ti) -data Location = Location { lcLine :: Int, lcColumn :: Int, lcOffset :: Int }-  deriving (TH.Lift, Show, Eq)+data Location = Location+  { lcLine :: Int -- Line, obviously.+  , lcColumn :: Int -- Column, obviously+  , lcOffset :: Int -- Char offset from start of the token.+  } deriving (TH.Lift, Show, Eq)  instance HReadable Location where-  hReadable l = T.pack $ "Line: " <> (show (lcLine l)) <> " Column: " <> show (lcColumn l) <> " Offset: " <> show (lcOffset l)+  hReadable l = T.pack $ "Line: " <> (show (lcLine l)) <> " Column: " <> show (lcColumn l)  emptyLocation :: Location emptyLocation = Location 1 1 0

@@ -85,7 +85,7 @@   | EVar Identifier   | ESubscripted SubscriptedExpression   | EOperator Operator ExpressionWithLoc ExpressionWithLoc-  | ECall Identifier [ExpressionWithLoc] Bool -- Boolean is used during execution to mark tail calls+  | ECall ExpressionWithLoc [ExpressionWithLoc] Bool -- Boolean is used during execution to mark tail calls   | EConditional ExpressionWithLoc ExpressionWithLoc ExpressionWithLoc   | EParan ExpressionWithLoc   | EUnnamedFn [Identifier] ExpressionWithLoc@@ -163,8 +163,14 @@ addLRecursion exp0 = do     exp1 <- (parseAnyDots exp0) <|> (pure exp0)     exp2 <- (parseAnySubscripts exp1) <|> (pure exp1)-    ((precedenceSort <$> (operatorParser exp2)) <|> (pure exp2))+    exp3 <- (parseAnyFunctionCalls exp2) <|> (pure exp2)+    ((precedenceSort <$> (operatorParser exp3)) <|> (pure exp3)) +parseAnyFunctionCalls :: ExpressionWithLoc -> AstParser ExpressionWithLoc+parseAnyFunctionCalls exp0 = do+  margs <- surroundWs (parseItemListInParen (astParser @ExpressionWithLoc))+  addLRecursion (ExpressionWithLoc (ECall exp0 (fromMaybe [] (NE.toList <$> margs)) False) (elLocation exp0))+ parseAnyDots :: ExpressionWithLoc -> AstParser ExpressionWithLoc parseAnyDots exp0 = do   surroundWs_ (parseDelimeter DlPeriod)@@ -295,8 +301,9 @@  callParser :: AstParser Expression callParser = do+  loc <- getParserLocation   (idf, args) <- callParser_-  pure $ ECall idf args False+  pure $ ECall (ExpressionWithLoc (EVar idf) loc) args False  callParser_ :: AstParser (Identifier, [ExpressionWithLoc]) callParser_ = surroundWs $ do

@@ -15,7 +15,7 @@ import Test.Common  data FunctionDef-  = FunctionDef Identifier [Identifier] (NonEmpty FunctionStatementWithLoc)+  = FunctionDef Bool Identifier [Identifier] (NonEmpty FunctionStatementWithLoc)   deriving (Show, Eq)  instance HasAstParser FunctionDef where@@ -23,12 +23,15 @@     surroundWs_ (parseKeyword KwProc)     fnName <- surroundWs parseIdentifier     args <- parseItemListInParen parseIdentifier+    setGeneratorFlag False     stms <- mandatory (some (surroundWs (astParser @FunctionStatementWithLoc)))     mandatory $ surroundWs_ $ parseKeyword KwEndProc-    pure $ FunctionDef fnName (fromMaybe [] (NE.toList <$> args)) (NE.fromList stms)+    isGenerator <- getGeneratorFlag+    setGeneratorFlag False+    pure $ FunctionDef isGenerator fnName (fromMaybe [] (NE.toList <$> args)) (NE.fromList stms)  instance ToSource FunctionDef where-  toSourcePretty i (FunctionDef name args stms) =+  toSourcePretty i (FunctionDef _ name args stms) =     T.concat $       [nlt, indent i, toSource KwProc, wst, toSource name, toSource DlParenOpen] <>       (L.intersperse (toSource DlComma <> " ") (toSource <$> args)) <>@@ -36,4 +39,4 @@       [toSourcePretty (i+1) (NE.toList stms)] <> [nlt, indent i, toSource KwEndProc]  instance HasGen FunctionDef where-  getGen = FunctionDef <$> getGen <*> getGen <*> (nonEmptyGen getGen)+  getGen = (FunctionDef False) <$> getGen <*> getGen <*> (nonEmptyGen getGen)

@@ -1,10 +1,9 @@ module Compiler.AST.FunctionStatement where  import Control.Applicative-import Data.List as L import Data.List.NonEmpty as NE-import Data.Maybe import Data.Text as T+import Data.Maybe (isJust)  import Common import Compiler.AST.Common@@ -35,17 +34,20 @@ instance HasGen FunctionStatementWithLoc where   getGen = FunctionStatementWithLoc <$> getGen <*> (pure emptyLocation) +type IsGlobal = Bool+ data FunctionStatement-  = Let Subscript ExpressionWithLoc-  | Call Identifier [ExpressionWithLoc]+  = Let Subscript IsGlobal ExpressionWithLoc+  | Call ExpressionWithLoc   | If ExpressionWithLoc (NonEmpty FunctionStatementWithLoc) (NonEmpty FunctionStatementWithLoc)   | MultiIf ExpressionWithLoc (NonEmpty FunctionStatementWithLoc) (NonEmpty (ExpressionWithLoc, NonEmpty FunctionStatementWithLoc)) (Maybe (NonEmpty FunctionStatementWithLoc))   | IfThen ExpressionWithLoc (NonEmpty FunctionStatementWithLoc)-  | For Identifier ExpressionWithLoc ExpressionWithLoc (NonEmpty FunctionStatementWithLoc)+  | For Identifier ExpressionWithLoc ExpressionWithLoc (NonEmpty FunctionStatementWithLoc) (Maybe ExpressionWithLoc)   | ForEach Identifier ExpressionWithLoc (NonEmpty FunctionStatementWithLoc)   | While ExpressionWithLoc (NonEmpty FunctionStatementWithLoc)   | Loop (NonEmpty FunctionStatementWithLoc)   | Return ExpressionWithLoc+  | Yield ExpressionWithLoc   | Break   | Pass   | FnComment Comment@@ -55,23 +57,29 @@   toSourcePretty i Break = T.concat [indent i, toSource KwBreak]   toSourcePretty i Pass = T.concat [indent i, toSource KwPass]   toSourcePretty i (FnComment c) = stripEnd (toSourcePretty i c)-  toSourcePretty i (Let idf expr) =+  toSourcePretty i (Let idf False expr) =     T.concat [indent i, toSource KwLet, wst, toSource idf, wst, toSource KwAssignment, wst, toSource expr]-  toSourcePretty i (Call idf args) =-    T.concat $ [indent i, toSource idf, toSource DlParenOpen] <> argsSrc <> [toSource DlParenClose]-    where-      argsSrc = (L.intersperse (toSource DlComma <> " ") (toSource <$> args))+  toSourcePretty i (Let idf True expr) =+    T.concat [indent i, toSource KwLet, wst, toSource KwGlobal, wst, toSource idf, wst, toSource KwAssignment, wst, toSource expr]+  toSourcePretty i (Call expr) =+    T.concat $ [indent i, toSource expr]   toSourcePretty i (Return expr) = T.concat $ [indent i, toSource KwReturn, wst, toSource expr]+  toSourcePretty i (Yield expr) = T.concat $ [indent i, toSource KwYield, wst, toSource expr]   toSourcePretty i (ForEach idf expr1 stms) =     T.concat $       [indent i, toSource KwForEach, wst, toSource expr1, wst, toSource KwAs, wst, toSource idf, wst, nlt] <>       [toSourcePretty (i+1) (NE.toList stms)] <>       [nlt, indent i, toSource KwEndForEach]-  toSourcePretty i (For idf expr1 expr2 stms) =+  toSourcePretty i (For idf expr1 expr2 stms Nothing) =     T.concat $       [indent i, toSource KwFor, wst, toSource idf, wst, toSource KwAssignment, wst, toSource expr1, wst, toSource KwTo, wst, toSource expr2, nlt] <>       [toSourcePretty (i+1) (NE.toList stms)] <>       [nlt, indent i, toSource KwEndFor]+  toSourcePretty i (For idf expr1 expr2 stms (Just stepExpr)) =+    T.concat $+      [indent i, toSource KwFor, wst, toSource idf, wst, toSource KwAssignment, wst, toSource expr1, wst, toSource KwTo, wst, toSource expr2, wst, toSource KwStep, wst, toSource stepExpr, nlt] <>+      [toSourcePretty (i+1) (NE.toList stms)] <>+      [nlt, indent i, toSource KwEndFor]   toSourcePretty i (IfThen expr stms) =     T.concat $       [indent i, toSource KwIf, wst, toSource expr, wst, toSource KwThen, nlt] <>@@ -115,9 +123,10 @@  instance HasGen FunctionStatement where   getGen = recursive choice-    [ Let <$> getGen <*> getGen-    , Call <$> getGen <*> getGen+    [ Let <$> getGen <*> bool <*> getGen+    , Call <$> getGen     , Return <$> getGen+    , Yield <$> getGen     , FnComment <$> getGen     , pure Break     , pure Pass@@ -125,7 +134,7 @@     [ If <$> getGen <*> (nonEmptyGen getGen) <*> (nonEmptyGen getGen)     , IfThen <$> getGen <*> (nonEmptyGen getGen)     , MultiIf <$> getGen <*> (nonEmptyGen getGen) <*> (nonEmptyGen ((,) <$> getGen <*> (nonEmptyGen getGen))) <*> (Test.Common.maybe (nonEmptyGen getGen))-    , For <$> getGen <*> getGen <*> getGen <*> (nonEmptyGen getGen)+    , For <$> getGen <*> getGen <*> getGen <*> (nonEmptyGen getGen) <*> getGen     , Loop <$> (nonEmptyGen getGen)     , While <$> getGen <*> (nonEmptyGen getGen)     ]@@ -144,6 +153,7 @@     <|> whileParser     <|> loopParser     <|> returnParser+    <|> yieldParser     <|> breakParser     <|> passParser     <|> callStatementParser@@ -152,19 +162,19 @@ letParser :: AstParser FunctionStatement letParser = nameParser "Let statement" $ do   surroundWs_ (parseKeyword KwLet)+  (isJust -> isGlobal) <- surroundWs (optional (parseKeyword KwGlobal))   idf <- surroundWs (mandatory parseSubscript)   surroundWs_ (mandatory (parseToken "assignment" isAssignment))   expr <- surroundWs (mandatory (astParser @ExpressionWithLoc))-  pure $ Let idf expr+  pure $ Let idf isGlobal expr   where     isAssignment (TkKeyword KwAssignment) = Just ()     isAssignment _                        = Nothing  callStatementParser :: AstParser FunctionStatement callStatementParser = nameParser "Function call" $ do-  idf <- surroundWs parseIdentifier-  args <- parseItemListInParen (astParser @ExpressionWithLoc)-  pure $ Call idf $ fromMaybe [] (NE.toList <$> args)+  expr <- surroundWs (astParser @ExpressionWithLoc)+  pure $ Call expr  loopParser :: AstParser FunctionStatement loopParser = nameParser "Loop Statement" $ do@@ -189,9 +199,12 @@   startExp <- surroundWs (mandatory $ astParser @ExpressionWithLoc)   surroundWs_ (mandatory (parseKeyword KwTo))   endExp <- surroundWs (mandatory $ astParser @ExpressionWithLoc)+  mStepExpr <- surroundWs (optional (parseKeyword KwStep)) >>= \case+    Just _ -> Just <$> surroundWs (mandatory $ astParser @ExpressionWithLoc)+    Nothing -> pure Nothing   stms <- mandatory (some $ astParser @FunctionStatementWithLoc)   surroundWs_ (mandatory (parseKeyword KwEndFor))-  pure $ For idf startExp endExp (NE.fromList stms)+  pure $ For idf startExp endExp (NE.fromList stms) mStepExpr  forEachParser :: AstParser FunctionStatement forEachParser = nameParser "ForEach Statement" $ do@@ -240,6 +253,12 @@ returnParser = nameParser "return statement" $ do   surroundWs_ (parseKeyword KwReturn)   Return <$> (surroundWs $ astParser @ExpressionWithLoc)++yieldParser :: AstParser FunctionStatement+yieldParser = nameParser "yield statement" $ do+  surroundWs_ (parseKeyword KwYield)+  setGeneratorFlag True+  Yield <$> (surroundWs $ astParser @ExpressionWithLoc)  breakParser :: AstParser FunctionStatement breakParser = nameParser "break statement" $ do

@@ -7,10 +7,17 @@ type AstParser a = ParserM IO AstParserState a  data AstParserState = AstParserState-  { astInput  :: [Token]-  , astIndent :: Int+  { astInput           :: [Token]+  , astIndent          :: Int+  , astGeneratorFlag   :: Bool   } deriving Show +setGeneratorFlag :: Bool -> AstParser ()+setGeneratorFlag f = ParserM "" (\s -> pure $ (Right (), s { astGeneratorFlag = f }))++getGeneratorFlag :: AstParser Bool+getGeneratorFlag = ParserM "" (\s -> pure $ (Right $ astGeneratorFlag s, s))+ instance HaveLocation AstParserState where   getLocation (astInput -> (t:_)) =  tkLocation t   getLocation _ = error "No location for empty input"@@ -19,7 +26,7 @@   isEmpty s = astInput s == []  mkAstParserState :: [Token] -> AstParserState-mkAstParserState ts = AstParserState ts 0+mkAstParserState ts = AstParserState ts 0 False  liftModifier   :: Monad m

@@ -10,11 +10,14 @@ data Keyword   = KwFor   | KwEndFor+  | KwStep   | KwForEach   | KwAs+  | KwGlobal   | KwEndForEach   | KwBreak   | KwWhile+  | KwYield   | KwEndWhile   | KwLet   | KwIf@@ -39,7 +42,9 @@     = parseFor KwForEach     <|> parseFor KwEndForEach     <|> parseFor KwFor+    <|> parseFor KwStep     <|> parseFor KwAs+    <|> parseFor KwGlobal     <|> parseFor KwEndFor     <|> parseFor KwWhile     <|> parseFor KwBreak@@ -58,6 +63,7 @@     <|> parseFor KwEndProc     <|> parseFor KwTo     <|> parseFor KwReturn+    <|> parseFor KwYield     <|> parseFor KwPass     <|> parseFor KwAssignment     where@@ -82,8 +88,11 @@   toSource = \case     KwFor        -> "for"     KwEndFor     -> "endfor"+    KwGlobal     -> "global"     KwForEach    -> "foreach"+    KwStep       -> "step"     KwAs         -> "as"+    KwYield      -> "yield"     KwEndForEach -> "endforeach"     KwBreak      -> "break"     KwWhile      -> "while"

@@ -45,6 +45,7 @@   , hwHistory               :: [(HelpPage, Int)]   , hwSearchResult          :: MVar (SearchPage, V.Vector HToken)   , hwSearchChan            :: TChan SearchPage+  , hwBuiltIns              :: Map.Map Text Text   }  instance Drawable HelpWidget where@@ -54,7 +55,7 @@       True -> do         (liftIO $ tryTakeMVar (hwSearchResult w)) >>= \case           Just (sp, htokens) -> do-            let (contentText, dTokens) = convertToDisplay htokens+            let (contentText, dTokens) = convertToDisplay (hwBuiltIns w) htokens             loadTokens r (contentText, dTokens)             modifyWRef r (\wd -> wd { hwCurrentPage = Just (Left sp) })           Nothing -> pass@@ -259,8 +260,8 @@         DisplayToken (DTLink _ n) l e -> DisplayToken (DTLink False n) l e         _                             -> dt -parsedDocContent :: IO (Map.Map FilePath (Text, V.Vector DisplayToken))-parsedDocContent = UI.Widgets.foldM foldFn mempty docContent+parsedDocContent :: Map.Map Text Text -> IO (Map.Map FilePath (Text, V.Vector DisplayToken))+parsedDocContent builtIns = UI.Widgets.foldM foldFn mempty docContent   where     foldFn       :: Map.Map FilePath (Text, V.Vector DisplayToken)@@ -270,7 +271,7 @@       parseHelp (decodeUtf8 sbs) >>= \case         Right tokens -> do           checkSamples fp tokens-          pure $ Map.insert fp (convertToDisplay (V.fromList tokens)) idx+          pure $ Map.insert fp (convertToDisplay builtIns (V.fromList tokens)) idx         Left err -> do           putStrLn err           error $ "Error while parsing help file: " <> fp@@ -285,8 +286,9 @@         error ("Error parsing code in help file:"<> fp <> ":" <> show err)     checkOneSample _ = pure () -helpWidget :: WidgetC m => [Text] -> TChan IDEEvent -> m (WRef HelpWidget)-helpWidget builtins ideEventRef = do+helpWidget :: WidgetC m => Map.Map Text Text -> TChan IDEEvent -> m (WRef HelpWidget)+helpWidget builtinsFull ideEventRef = do+    let builtins = (Prelude.head . T.split (== '.')) <$> (Map.keys builtinsFull)     -- The help window     let helpWidgetDimDistrbution = [           undefined@@ -316,7 +318,7 @@     (newWRef nullWidget) >>= addWidget helptopLayoutRef     addWidget helpLayoutRef helptopLayoutRef     addWidget helpLayoutRef helpContent-    docs <- liftIO parsedDocContent+    docs <- liftIO $ parsedDocContent builtinsFull     let docIndex = buildIndex docs     void $ liftIO $ forkIO (searchThread docIndex searchChan searchResultRef)     let builtinOperators = "=" : ((\x -> toSource $ toEnum @Operator x) <$> [0 .. fromEnum $ maxBound @Operator])@@ -332,6 +334,6 @@         if (Set.size(missingDocs) > 0)           then error $ "Missing documents for: " <> show missingDocs           else do-            r <- newWRef $ HelpWidget helpSearchInput helpContent helpLayoutRef True cursorRef (Just tokenProcessingThreadId) ideEventRef tokensRef docs docIndex Nothing [] searchResultRef searchChan+            r <- newWRef $ HelpWidget helpSearchInput helpContent helpLayoutRef True cursorRef (Just tokenProcessingThreadId) ideEventRef tokensRef docs docIndex Nothing [] searchResultRef searchChan builtinsFull             loadPage r (Right "toc.md")             pure r

@@ -2,12 +2,15 @@  import Control.Applicative import Control.Monad+import qualified Data.Map as Map+import qualified Data.List as DL import Data.Text as T import qualified Data.Vector as V import System.Console.ANSI (Color(..))  import Common import qualified Compiler.Lexer.Tokens as CT+import qualified Compiler.Lexer.Identifiers as CI import Parser.Lib import Parser.Parser import DiffRender.DiffRender@@ -45,24 +48,39 @@ data DisplayToken = DisplayToken { dtTr :: DisplayTokenRaw, dtLocation :: Location, dtOffsetEnd :: Int }   deriving (Show, Eq) -convertToDisplay :: V.Vector HToken -> (Text, V.Vector DisplayToken)-convertToDisplay tokens = let (_, src, dt) = V.foldl' fn (0, "", V.empty) tokens in (src, dt)+convertToDisplay :: Map.Map Text Text -> V.Vector HToken -> (Text, V.Vector DisplayToken)+convertToDisplay builtIns tokens = let (_, src, dt) = V.foldl' fn (0, "", V.empty) tokens in (src, dt)   where-  fn :: (Int, Text, V.Vector DisplayToken) -> HToken -> (Int, Text, V.Vector DisplayToken)-  fn (lastOffset, srcin, tkns) a = let-    thisTokens = case tkRaw a of-      PlainText t -> V.singleton (DTPlain t)-      Heading _ s t -> V.singleton (DTHeading s t)-      Code _ t -> (V.cons DTNewLine (V.fromList (DTCode <$> t))) <> (V.singleton DTNewLine)-      InlineCode _ t -> V.fromList $ DTInlineCode <$> t-      Link t -> V.singleton (DTLink False t)-      NewLine -> V.singleton (DTNewLine)-    in V.foldl' fn2 (lastOffset, srcin, tkns) thisTokens+    makeArgs :: Text -> V.Vector DisplayTokenRaw+    makeArgs (T.breakOn "(" -> (fnName, (T.drop 1 . T.dropEnd 1 -> argsRaw))) = let+      fnNameTk = DTInlineCode $ CT.Token (CT.TkIdentifier $ CI.Identifier fnName) emptyLocation 0+      in V.fromList $ DTPlain "Arguments: "+          : fnNameTk : DTPlain "("+          : (DL.concat $ DL.intersperse [DTPlain ", "] $+              mkArg <$> (T.splitOn ", " argsRaw)) <> [DTPlain ")"] -  fn2 :: (Int, Text, V.Vector DisplayToken) -> DisplayTokenRaw -> (Int, Text, V.Vector DisplayToken)-  fn2 (thisOffset, srcin, tkns) tkraw = let-    thisSize = T.length $ toSource tkraw-    in (thisOffset + thisSize, srcin <> (toSource tkraw), V.snoc tkns (DisplayToken tkraw (Location 0 0 thisOffset) (thisOffset + thisSize - 1)))+    mkArg :: Text -> [DisplayTokenRaw]+    mkArg t = let+      (argName, argType) = T.breakOn ":" t+      in [DTInlineCode $ (CT.Token (CT.TkIdentifier $ CI.Identifier argName) emptyLocation 0), DTPlain argType]++    fn :: (Int, Text, V.Vector DisplayToken) -> HToken -> (Int, Text, V.Vector DisplayToken)+    fn (lastOffset, srcin, tkns) a = let+      thisTokens = case tkRaw a of+        PlainText t -> V.singleton (DTPlain t)+        Heading _ s t -> case Map.lookup (t<> "()") builtIns of+          Just x -> V.cons (DTHeading s t) (V.cons DTNewLine $ V.cons DTNewLine $ makeArgs x)+          Nothing -> V.singleton $ DTHeading s t+        Code _ t -> (V.cons DTNewLine (V.fromList (DTCode <$> t))) <> (V.singleton DTNewLine)+        InlineCode _ t -> V.fromList $ DTInlineCode <$> t+        Link t -> V.singleton (DTLink False t)+        NewLine -> V.singleton (DTNewLine)+      in V.foldl' fn2 (lastOffset, srcin, tkns) thisTokens++    fn2 :: (Int, Text, V.Vector DisplayToken) -> DisplayTokenRaw -> (Int, Text, V.Vector DisplayToken)+    fn2 (thisOffset, srcin, tkns) tkraw = let+      thisSize = T.length $ toSource tkraw+      in (thisOffset + thisSize, srcin <> (toSource tkraw), V.snoc tkns (DisplayToken tkraw (Location 0 0 thisOffset) (thisOffset + thisSize - 1)))  data HTokenRaw   = PlainText Text

@@ -3,12 +3,13 @@ import Common import Data.Text.Encoding (decodeUtf8) import Compiler.Lexer+import Control.Monad.State.Strict import Compiler.Parser import Control.Concurrent import Control.Concurrent.STM import Control.Concurrent.STM.TSem import Control.Exception-import Control.Monad+import Control.Monad.IO.Unlift import Data.IORef import qualified Data.List as DL import Data.Map as Map@@ -62,8 +63,6 @@  type Clipboard = (Text -> IO (), IO (Maybe Text)) -type IDEM a = WidgetM IO a- putStrLnFlush :: Text -> IO () putStrLnFlush s = do   T.putStrLn s@@ -72,7 +71,7 @@ extractBuiltIns :: IO ([(Text, Text)], [(Text, Text)]) extractBuiltIns = do   sdlWindowsRef <- newIORef []-  scope <- isGlobalScope . snd <$> runStateT loadBuiltIns (emptyIs sdlWindowsRef)+  scope <- (isGlobalScope . snd) <$> (runInterpretM (emptyIs sdlWindowsRef) loadBuiltIns)   let keywords = (\x -> let s = toSource $ toEnum @Keyword x in (s, s)) <$> [0 .. fromEnum $ maxBound @Keyword]   let builtIns = DL.foldl' extractOneDoc [] (Map.assocs scope)   pure (keywords, builtIns)@@ -142,6 +141,7 @@   (keywords, builtIns) <- extractBuiltIns   ideStateRef <- newTVarIO ideStartState   ideEventsRef <- newTChanIO+  logChannel <- newTChanIO   atomically $ writeTChan ideEventsRef (IDEAppendLog ("Loaded file: " <> (T.pack filePath)))    clipboardRef <- newIORef @(Maybe Text) Nothing@@ -194,9 +194,10 @@           ]      logRef <- logWidget+     titledLogRef <- titledContainer (SomeWidgetRef logRef) " Log " -    helpWidgetRef <- helpWidget ((Prelude.head . T.split (== '.'). fst) <$> builtIns) ideEventsRef+    helpWidgetRef <- helpWidget (Map.fromList builtIns) ideEventsRef     -- The autocomplete widget     ac <- autoComplete     modifyWRef editorRef (\ed -> ed { ewAutocompleteWidget = Just $ SomeWidgetRef ac })@@ -240,12 +241,12 @@           [ ("File", SubMenu ["Save (F6)", "Beautify", "Exit"])           , ("Edit", SubMenu ["Cut", "Copy", "Paste", "Select All"])           , ("Run", SubMenu ["Run (F5)", "Step (F8)", "Stop (F9)"])-          , ("Windows", SubMenu ["Clear log", "Clear Output", "Toggle Output"])+          , ("Windows", SubMenu ["Clear log", "Clear Output", "Toggle Output(F7)"])           , ("Help", SubMenu ["About", "Contents"])           ] Nothing (Just $ T.pack filePath)     menuContainerRef <- menuContainer (SomeWidgetRef layoutRef') menu (selectionHandler ideEventsRef) -    modify $ liftWSMod (\ws -> ws { wsCursorWidget = Just $ SomeKeyInputWidget editorRef })+    modifyWidgetM $ liftWSMod (\ws -> ws { wsCursorWidget = Just $ SomeKeyInputWidget editorRef })       -- A snippet that refresh the screen.@@ -256,6 +257,11 @@         draw menuContainerRef         csDraw Nothing +    void $ withRunInIO $ \runInIO -> forkIO $ forever $ runInIO $ do+      msg <- liftIO $ atomically $ readTChan logChannel+      insertLog logRef msg+      ideRedraw+     let       getActiveEditor :: WidgetC m => m (WRef EditorWidget)       getActiveEditor = do@@ -314,6 +320,7 @@                       , isOutputHandle = pOutHandle                       , isTerminalParams = Just (outputScreenOffset, outputScreenSize)                       , isStdoutLock = mOutBufLock+                      , isLogChannel = Just logChannel                       })                     Start -> (\is -> is                       { isRunMode = DebugMode (DebugEnv Continue debugIn debugOut)@@ -321,11 +328,12 @@                       , isOutputHandle = pOutHandle                       , isTerminalParams = Just (outputScreenOffset, outputScreenSize)                       , isStdoutLock = mOutBufLock+                      , isLogChannel = Just logChannel                       })                     _ -> error "Impossible!"                  flip catch handler (void $ do-                  void $ interpret stateFn p+                  void $ interpret stateFn Nothing p                   atomically (writeTBQueue debugOut (Finished False))                   )                 -- Reset IDE debuggins state@@ -341,6 +349,7 @@               atomically $ putTMVar interpreterDebugInChanRef debugIn               pure (Right ideDebugEnv, mOutBufLock)             Left err -> do+              atomically $ writeTChan ideEventsRef IDEClearDraw               pure (Left (hReadable err), mOutBufLock)      uiLoop ideEventsRef (\case@@ -367,13 +376,13 @@             setVisibility helpWidgetRef False             setVisibility editorRef True             setVisibility watchWidgetRef True-            modify $ liftWSMod (\ws -> ws { wsCursorWidget = Just $ SomeKeyInputWidget editorRef })+            modifyWidgetM $ liftWSMod (\ws -> ws { wsCursorWidget = Just $ SomeKeyInputWidget editorRef })             liftIO $ atomically (modifyTVar ideStateRef (\is -> is { idsKeyInputReciever = Just $ SomeKeyInputWidget editorRef }))           False -> do             setVisibility helpWidgetRef True             setVisibility editorRef False             setVisibility watchWidgetRef False-            modify $ liftWSMod (\ws -> ws { wsCursorWidget = Just $ SomeKeyInputWidget helpWidgetRef })+            modifyWidgetM $ liftWSMod (\ws -> ws { wsCursorWidget = Just $ SomeKeyInputWidget helpWidgetRef })             liftIO $ atomically (modifyTVar ideStateRef (\is -> is { idsKeyInputReciever = Just $ SomeKeyInputWidget helpWidgetRef }))         d <- getScreenBounds         csInitialize d@@ -513,15 +522,15 @@                 mDisplayThreadExitFlag <- liftIO (newTVarIO False)                 mDisplayUpdateThread <- case mStdoutLock of                   Nothing -> pure False-                  Just sem -> do-                    ws <- get-                    _ <- (liftIO $ forkIO $ let+                  Just sem -> withRunInIO $ \runInIO -> do+                    _ <- (forkIO $ runInIO $ let+                        go :: WidgetM IO ()                         go = do                           liftIO $ atomically $ waitTSem sem-                          void $ runWidgetM'' ws ideRedraw+                          ideRedraw                           liftIO $ atomically $ signalTSem sem-                          wait 0.1-                          liftIO $ readTVarIO mDisplayThreadExitFlag >>= \case+                          liftIO $ wait 0.1+                          (liftIO $ readTVarIO mDisplayThreadExitFlag) >>= \case                             True -> pure ()                             _ -> go                       in go)@@ -812,5 +821,9 @@        KeyCtrl _ _ _ (Fun 5) -> do         liftIO $ atomically $ writeTChan ideEventRef IDERun+        pure True++      KeyCtrl _ _ _ (Fun 7) -> do+        liftIO $ atomically $ writeTChan ideEventRef IDEToggleOutput         pure True       _               -> pure False

@@ -2,40 +2,30 @@  import Prelude hiding (map) -import Control.Monad import Control.Monad.Catch (finally) import Data.IORef (newIORef)-import Data.Map as M hiding (map)+import System.Directory+import Control.Concurrent.STM.TVar  import Compiler.AST.Program-import Control.Monad.State.Strict+import Control.Monad.Reader import Interpreter.Common import Interpreter.Initialize import Interpreter.Interpreter import Interpreter.Lib.SDL -interpret :: (InterpreterState -> InterpreterState) -> Program -> IO InterpreterState-interpret stFn prg = snd <$> do+interpret :: (InterpreterState -> InterpreterState) -> Maybe FilePath -> Program -> IO InterpreterState+interpret stFn mFp prg = do   sdlWindowsRef <- newIORef []-  let istate = emptyIs sdlWindowsRef-  flip runStateT (stFn istate) $ (do+  filePath <- case mFp of+    Just fp -> pure fp+    Nothing -> getCurrentDirectory+  let istate = (emptyIs sdlWindowsRef) { isCurrentModulePath = Just filePath }+  sTVar <- newTVarIO (stFn istate)+  flip runReaderT sTVar $ (do     loadBuiltIns     interpretPassOne prg     interpretPassTwo prg+    liftIO $ readTVarIO sTVar     ) `finally` cleanupSDL -interpretPassOne :: Program -> InterpretM ()-interpretPassOne x = mapM_ (\a -> fn a) x-  where-    fn :: ProgramStatement -> InterpretM ()-    fn (FunctionDefStatement fdef@(FunctionDef name _ _)) = modify $ mapGlobalScope $-      \s -> insert (SkIdentifier name) (ProcedureValue fdef) s-    fn _ = pure ()--interpretPassTwo :: Program -> InterpretM ()-interpretPassTwo x = mapM_ (\a -> fn a) x-  where-    fn :: ProgramStatement -> InterpretM ()-    fn (FunctionDefStatement (FunctionDef _ _ _)) = pure ()-    fn (NakedStatement fs)                        = void $ executeStatement fs-    fn (TopLevelComment _)                        = pure ()

@@ -1,11 +1,15 @@ module Interpreter.Common where  import Control.Concurrent+import Control.Monad.IO.Unlift import Control.Concurrent.STM.TBQueue import Control.Concurrent.STM.TChan import Control.Concurrent.STM.TMVar import Control.Concurrent.STM.TSem import Control.Concurrent.STM.TVar+import Control.Monad.State.Strict+import Control.Concurrent.STM (atomically)+import Control.Monad.Reader import Control.Exception import Control.Monad.Catch (MonadCatch, MonadThrow, throwM) import Crypto.Hash@@ -17,16 +21,17 @@ import Data.Proxy import Data.Text as T import Data.Text.IO as T-import Data.Typeable import qualified Data.Vector as V import qualified Data.Vector.Storable as VS import Data.Word import Foreign.C.Types import GHC.OverloadedLabels+import GHC.Int (Int16) import GHC.TypeLits import SDL hiding (Keycode, Scancode, get) import qualified SDL as SDL import qualified SDL.Mixer as SDLM+import qualified SDL.Font as SDLF import System.IO import qualified System.IO as SIO import System.Posix.Directory@@ -61,6 +66,7 @@   | KeyboardState SDLKeyboardStateCallback   | SoundSample Sample   | Texture SDL.Texture+  | Font SDLF.Font  instance Show SDLValue where   show (Keycode k)       = "(SDL_KEY)" <> show k@@ -70,6 +76,7 @@   show (Renderer _)      = "(SDL_RENDERER)"   show (SoundSample _)   = "(SDL_SOUND)"   show (Texture _)       = "(SDL_TEXTURE)"+  show (Font _)          = "(SDL_FONT)"  data Number   = NumberInt IntType@@ -149,6 +156,16 @@ instance Show FileHandle where   show _ = "(FileHandle)" +newtype ScopeRef = ScopeRef (TVar Scope)++instance Show ScopeRef where+  show _ = "(scoperef)"++data GeneratorChannels = GeneratorChannels (TChan ()) (TChan (Maybe Value))++instance Show GeneratorChannels where+  show _ = "(generator)"+ data Value   = StringValue Text   | NumberValue Number@@ -168,6 +185,8 @@   | WidgetValue SomeWidgetRef   | HashContextValue HashContext   | EventValue KeyEvent+  | GeneratorValue GeneratorChannels+  | ModuleValue FilePath ScopeRef (Maybe Identifier)   | ErrorValue Text       -- ^ This should probably never be used directly, and should throw a CustomRTE instead       --  so that it will be caught and rethrown with location information.@@ -189,12 +208,14 @@   Channel _                        -> "(concurrency_channel)"   Ref _                            -> "(mutable_ref)"   UnnamedFnValue _                 -> "(unnamed_function)"+  GeneratorValue _                 -> "(generator)"   Void                             -> "(void)"   BuiltIn _                        -> "(builtin)"   DirectoryStack _                 -> "(directory)"   WidgetValue _                    -> "(widget)"   HashContextValue _               -> "(hash_context)"   FileHandleValue _                -> "(file_handle)"+  ModuleValue _ _ _                  -> "(module)"   s@(ErrorValue _)                 -> pack $ show s   SDLValue s                       -> pack $ show s   EventValue ke                    -> pack $ show ke@@ -277,8 +298,11 @@  data InterpreterState = InterpreterState   { isLocal              :: [Scope]+  , isCurrentModulePath  :: Maybe FilePath   , isRunMode            :: RunMode+  , isGeneratorChannels  :: Maybe GeneratorChannels   , isGlobalScope        :: Scope+  , isModuleScope        :: [Scope]   , isDefaultRenderer    :: Maybe SDL.Renderer   , isAccelerated        :: Maybe Bool   , isDefaultWindow      :: Maybe SDL.Window@@ -290,22 +314,25 @@   , isWidgetState        :: Maybe WidgetState   , isTerminalParams     :: Maybe (ScreenPos, Dimensions)   , isStdoutLock         :: Maybe TSem+  , isLogChannel         :: Maybe (TChan Text)   , isDefaultPrintParams :: Maybe (Text, Int, [Int])+  , isDefaultFont        :: Maybe SDLF.Font+  , isBgColor            :: Maybe (Word8, Word8, Word8, Word8)   -- ^ This lock is required to sync stdout writing when the program   -- is run from within the IDE and both IDE code and the interepreted   -- program wants to write to stdout concurrently.   } -instance MonadIO m => HasDiffRender (StateT InterpreterState m) where-  getDiffRender = (fromMaybe (error "Char screen not initialized") . isDiffRender) <$> get-  putDiffRender dfr = modify (\us -> us { isDiffRender = Just dfr })-  modifyDiffRender fn = modify (\us -> us { isDiffRender = fn <$> (isDiffRender us) })+instance HasDiffRender (ReaderT (TVar InterpreterState) IO) where+  getDiffRender = (fromMaybe (error "Char screen not initialized") . isDiffRender) <$> getInterpretM+  putDiffRender dfr = modifyInterpretM (\us -> us { isDiffRender = Just dfr })+  modifyDiffRender fn = modifyInterpretM (\us -> us { isDiffRender = fn <$> (isDiffRender us) }) -instance MonadIO m => HasWidgetState (StateT InterpreterState m) where-  getWidgetState = (fromMaybe (error "Widgets not initialized") . isWidgetState) <$> get-  getWidgetStateMaybe = isWidgetState <$> get-  putWidgetState ws = modify (\us -> us { isWidgetState = Just ws })-  modifyWidgetState fn = modify (\us -> us { isWidgetState = fn <$> isWidgetState us })+instance HasWidgetState (ReaderT (TVar InterpreterState) IO) where+  getWidgetState = (fromMaybe (error "Widgets not initialized") . isWidgetState) <$> getInterpretM+  getWidgetStateMaybe = isWidgetState <$> getInterpretM+  putWidgetState ws = modifyInterpretM (\us -> us { isWidgetState = Just ws })+  modifyWidgetState fn = modifyInterpretM (\us -> us { isWidgetState = fn <$> isWidgetState us })  instance Show InterpreterState where   show InterpreterState {..} = show (isJust isDefaultWindow)@@ -314,7 +341,10 @@ dummyIS = InterpreterState   { isLocal = mempty   , isRunMode = NormalMode+  , isGeneratorChannels = Nothing+  , isCurrentModulePath = Nothing   , isGlobalScope = mempty+  , isModuleScope = mempty   , isDefaultRenderer = Nothing   , isAccelerated = Nothing   , isDefaultWindow = Nothing@@ -325,16 +355,22 @@   , isDiffRender = Nothing   , isTerminalParams = Nothing   , isStdoutLock = Nothing+  , isLogChannel = Nothing   , isWidgetState = Nothing   , isDefaultPrintParams = Nothing+  , isDefaultFont = Nothing+  , isBgColor = Nothing   -- ^ Some parameters that decides the comma placement when numbers are printed.   }  emptyIs :: IORef [SDL.Window] -> InterpreterState emptyIs sdlWindowsRef = InterpreterState   { isLocal = mempty+  , isCurrentModulePath = Nothing+  , isGeneratorChannels = Nothing   , isRunMode = NormalMode   , isGlobalScope = mempty+  , isModuleScope = (mempty : mempty)   , isDefaultRenderer = Nothing   , isAccelerated = Nothing   , isDefaultWindow = Nothing@@ -345,21 +381,24 @@   , isDiffRender = Nothing   , isTerminalParams = Nothing   , isStdoutLock = Nothing+  , isLogChannel = Nothing   , isWidgetState = Just emptyWidgetState   , isDefaultPrintParams = Just (".", 2, [3, 2, 2, 2, 2, 2, 2])+  , isBgColor = Just (0, 0, 0, 255)+  , isDefaultFont = Nothing   }  interpreterOutput :: Text -> InterpretM ()-interpreterOutput c = isOutputHandle <$> get >>= (liftIO . flip T.hPutStr c)+interpreterOutput c = isOutputHandle <$> getInterpretM >>= (liftIO . flip T.hPutStr c)  interpreterOutputFlush :: InterpretM ()-interpreterOutputFlush = isOutputHandle <$> get >>= (liftIO . SIO.hFlush)+interpreterOutputFlush = isOutputHandle <$> getInterpretM >>= (liftIO . SIO.hFlush)  interpreterInputChar :: InterpretM Char-interpreterInputChar = isInputHandle <$> get >>= (liftIO . SIO.hGetChar)+interpreterInputChar = isInputHandle <$> getInterpretM >>= (liftIO . SIO.hGetChar)  interpreterInput :: InterpretM Text-interpreterInput = isInputHandle <$> get >>= (liftIO . T.hGetContents)+interpreterInput = isInputHandle <$> getInterpretM >>= (liftIO . T.hGetContents)  readInterpreterInputLine :: InterpretM Text readInterpreterInputLine = readInput ""@@ -384,11 +423,38 @@ mapGlobalScope :: (Scope -> Scope) -> (InterpreterState -> InterpreterState) mapGlobalScope fn = \is -> is { isGlobalScope = fn $ isGlobalScope is } -type InterpretM a = forall m. (MonadCatch m, MonadIO m, Typeable m) => StateT InterpreterState m a+type InterpretM a = ReaderT (TVar InterpreterState) IO a -runInterpretM :: (MonadCatch m, MonadIO m, Typeable m) => InterpreterState -> InterpretM a -> m (a, InterpreterState)-runInterpretM istate act  = flip runStateT (istate) act+withStateClone :: InterpretM a -> InterpretM a+withStateClone act = do+  sVar <- ask+  svarClone <- liftIO $ atomically $ do+    currentVal <- readTVar sVar+    newTVar currentVal+  local (const svarClone) act +getInterpretM :: InterpretM InterpreterState+getInterpretM = do+  stateTvar <- ask+  liftIO $ readTVarIO stateTvar++setInterpretM :: InterpreterState -> InterpretM ()+setInterpretM newstate = do+  stateTvar <- ask+  liftIO $ atomically $ writeTVar stateTvar newstate++modifyInterpretM :: (InterpreterState -> InterpreterState) -> InterpretM ()+modifyInterpretM modFn = do+  stateTvar <- ask+  liftIO $ atomically $ modifyTVar' stateTvar modFn++runInterpretM ::  InterpreterState -> InterpretM a -> IO (a, InterpreterState)+runInterpretM istate act  = do+  stvar <- liftIO $ newTVarIO istate+  r <- flip runReaderT stvar act+  s <- readTVarIO stvar+  pure (r, s)+ instance {-# OVERLAPPING #-} (MonadCatch m, MonadIO m) => MonadIO (StateT InterpreterState m) where   liftIO act = lift $ liftIO @m (wrapSomeException IOError act) @@ -404,6 +470,11 @@   fromValue a               = throwErr $ UnexpectedType ("widget", a)   typeName = "widget" +instance FromValue GeneratorChannels where+  fromValue (GeneratorValue s) = s+  fromValue a               = throwErr $ UnexpectedType ("generator", a)+  typeName = "generator"+ instance FromValue KeyEvent where   fromValue (EventValue s) = s   fromValue a              = throwErr $ UnexpectedType ("event", a)@@ -488,7 +559,7 @@  instance FromValue Callback where   fromValue (UnnamedFnValue un) = CallbackUnNamed un-  fromValue (ProcedureValue (FunctionDef idf _ _)) = CallbackNamed idf+  fromValue (ProcedureValue (FunctionDef _ idf _ _)) = CallbackNamed idf   fromValue a = throwErr $ UnexpectedType ("callback", a)   typeName = "callback" @@ -557,17 +628,23 @@   fromValue a            = throwErr $ UnexpectedType ("number", a)   typeName = "number" +instance FromValue Int16 where+  fromValue (NumberValue (NumberInt i)) = fromIntegral i+  fromValue (NumberValue (NumberFractional i)) = fromIntegral $ round i+  fromValue a            = throwErr $ UnexpectedType ("number", a)+  typeName = "number"+ instance FromValue Value where   fromValue = id   typeName = "any" -mkPoint :: CInt -> CInt -> SDL.Point SDL.V2 CInt+mkPoint :: a -> a -> SDL.Point SDL.V2 a mkPoint x y = SDL.P (SDL.V2 x y) -instance FromValue (VS.Vector (SDL.Point V2 CInt)) where+instance forall a. (FromValue a, VS.Storable a) => FromValue (VS.Vector (SDL.Point V2 a)) where   fromValue (ArrayValue v) = VS.fromList $ V.toList $ fn <$> v     where-      fn :: Value -> SDL.Point V2 CInt+      fn :: Value -> SDL.Point V2 a       fn (ArrayValue (V.toList -> [v1, v2])) = mkPoint (fromValue v1) (fromValue v2)       fn a = throwErr $ UnexpectedType ("list(2)", a)   fromValue a = throwErr $ UnexpectedType ("list", a)@@ -678,12 +755,14 @@   | UnexpectedType (Text, Value)   | MissingProcedureReturn   | EmptyScopeStack+  | EmptyModuleScopeStack   | BadArguments (Text, Text)  data RuntimeError   = IOError Text   | SDLError Text   | IndexOutOfBounds Int+  | GeneratorExhausted   | KeyNotFound Text   | UnserializeableValue   | CustomRTE Text@@ -702,11 +781,13 @@       _ -> "Unexpected type, expected " <> e <> ", but got: " <> (T.pack $ show f)     MissingProcedureReturn -> "Function or callback call did not return a value as expected"     EmptyScopeStack -> "Stack was unexpectedly empty"+    EmptyModuleScopeStack -> "Module stack was unexpectedly empty"     BadArguments (e, f) -> "Unexpected argument count or type, expected: " <> e <> ", but got: " <> f  instance HReadable RuntimeError where   hReadable = \case     IOError t -> "Input/Output error: " <> t+    GeneratorExhausted -> "A generator has run out"     SDLError t -> "SDL error: " <> t     Interpreter.Common.IndexOutOfBounds t -> "Out of bound access of index: " <> (T.pack $ show t)     KeyNotFound t -> "Non-existing key access in dictionary at key: " <> t@@ -757,30 +838,32 @@     threadDelay (fromInteger $ v * 1000000)  insertBuiltInVal :: ScopeKey -> Value -> InterpretM ()-insertBuiltInVal sk val = modify $ mapGlobalScope fn+insertBuiltInVal sk val = modifyInterpretM $ mapGlobalScope fn   where     fn :: Scope -> Scope     fn s = M.insert sk (BuiltIn $ BuiltinVal val) s  insertBuiltIn :: ScopeKey -> BuiltInFn -> InterpretM ()-insertBuiltIn sk val = modify $ mapGlobalScope fn+insertBuiltIn sk val = modifyInterpretM $ mapGlobalScope fn   where     fn :: Scope -> Scope     fn s = M.insert sk (BuiltIn $ BuiltinCall val) s  insertBuiltInWithDoc :: ScopeKey -> SomeBuiltin -> InterpretM ()-insertBuiltInWithDoc sk val = modify $ mapGlobalScope fn+insertBuiltInWithDoc sk val = modifyInterpretM $ mapGlobalScope fn   where     fn :: Scope -> Scope     fn s = M.insert sk (BuiltIn $ BuiltinCallWithDoc val) s -insertBinding :: ScopeKey -> Value -> InterpretM ()-insertBinding sk val = modify fn+insertBinding :: Bool -> ScopeKey -> Value -> InterpretM ()+insertBinding isGlobal sk val = modifyInterpretM fn   where     fn :: InterpreterState -> InterpreterState-    fn is@(InterpreterState { isGlobalScope, isLocal }) = case isLocal of-      []        -> is { isGlobalScope = M.insert sk val isGlobalScope }-      (s : rst) -> is { isLocal = (M.insert sk val s) : rst }+    fn is@(InterpreterState { isModuleScope, isLocal }) = case (isLocal, isModuleScope, isGlobal) of+      ([], (ms: rst),  _)        -> is { isModuleScope = (M.insert sk val ms) : rst }+      (_, (ms: rst), True)        -> is { isModuleScope = (M.insert sk val ms) : rst }+      ((s : rst), _, False) -> is { isLocal = (M.insert sk val s) : rst }+      a -> error $ show a  -- | Separates the given text using the decimal separator -- and inserts commas as specivied by the positions list

@@ -58,6 +58,7 @@   insertBuiltInWithDoc (SkIdentifier $ Identifier "waitforkey") (SomeBuiltin waitForKey)    -- Files+  insertBuiltInWithDoc (SkIdentifier $ Identifier "mkdir") (SomeBuiltin builtInReadFile)   insertBuiltInWithDoc (SkIdentifier $ Identifier "readfile") (SomeBuiltin builtInReadFile)   insertBuiltInWithDoc (SkIdentifier $ Identifier "readtextfile") (SomeBuiltin builtInReadTextFile)   insertBuiltInWithDoc (SkIdentifier $ Identifier "writefile") (SomeBuiltin builtInWriteFile)@@ -97,6 +98,9 @@   insertBuiltInWithDoc (SkIdentifier $ Identifier "repeat") (SomeBuiltin builtInRepeat)    -- Misc+  insertBuiltInWithDoc (SkIdentifier $ Identifier "mkdir") (SomeBuiltin builtinCreateDirectory)+  insertBuiltInWithDoc (SkIdentifier $ Identifier "exec") (SomeBuiltin builtinExec)+  insertBuiltInWithDoc (SkIdentifier $ Identifier "log") (SomeBuiltin builtinConsoleLog)   insertBuiltInWithDoc (SkIdentifier $ Identifier "try") (SomeBuiltin builtInTry)   insertBuiltInWithDoc (SkIdentifier $ Identifier "error") (SomeBuiltin builtInError)   insertBuiltInWithDoc (SkIdentifier $ Identifier "iserror") (SomeBuiltin builtInIsError)@@ -123,6 +127,7 @@   insertBuiltInWithDoc (SkIdentifier $ Identifier "csclearline") (SomeBuiltin charScreenClearLine)   insertBuiltInWithDoc (SkIdentifier $ Identifier "csdraw") (SomeBuiltin charScreenDraw)   insertBuiltInWithDoc (SkIdentifier $ Identifier "csscreensize") (SomeBuiltin charGetDimensions)+  insertBuiltInWithDoc (SkIdentifier $ Identifier "import") (SomeBuiltin builtinImport)    -- Widgets   insertBuiltInWithDoc (SkIdentifier $ Identifier "resizinglayout") (SomeBuiltin builtInLayoutWidget)@@ -162,10 +167,17 @@   insertBuiltInWithDoc (SkIdentifier $ Identifier "lines") (SomeBuiltin drawLines)   insertBuiltInWithDoc (SkIdentifier $ Identifier "arc") (SomeBuiltin drawArc)   insertBuiltInWithDoc (SkIdentifier $ Identifier "circle") (SomeBuiltin drawCircle)+  insertBuiltInWithDoc (SkIdentifier $ Identifier "smoothcircle") (SomeBuiltin drawSmoothCircle)+  insertBuiltInWithDoc (SkIdentifier $ Identifier "ellipse") (SomeBuiltin drawEllipse)+  insertBuiltInWithDoc (SkIdentifier $ Identifier "smoothellipse") (SomeBuiltin drawSmoothEllipse)+  insertBuiltInWithDoc (SkIdentifier $ Identifier "pie") (SomeBuiltin drawPie)   insertBuiltInWithDoc (SkIdentifier $ Identifier "polygon") (SomeBuiltin drawPoly)+  insertBuiltInWithDoc (SkIdentifier $ Identifier "smoothpolygon") (SomeBuiltin drawPolySmooth)   insertBuiltInWithDoc (SkIdentifier $ Identifier "box") (SomeBuiltin drawBox)   insertBuiltInWithDoc (SkIdentifier $ Identifier "render") (SomeBuiltin draw)   insertBuiltInWithDoc (SkIdentifier $ Identifier "setcolor") (SomeBuiltin setDrawColor)+  insertBuiltInWithDoc (SkIdentifier $ Identifier "setbgcolor") (SomeBuiltin setBgColor)+  insertBuiltInWithDoc (SkIdentifier $ Identifier "setcolora") (SomeBuiltin setDrawColorAlpha)   insertBuiltInWithDoc (SkIdentifier $ Identifier "clearscreen") (SomeBuiltin clear)   insertBuiltInWithDoc (SkIdentifier $ Identifier "getwindowsize") (SomeBuiltin getWindowSize)   insertBuiltInWithDoc (SkIdentifier $ Identifier "setlogicalsize") (SomeBuiltin setLogicalSize)@@ -175,10 +187,15 @@   insertBuiltInWithDoc (SkIdentifier $ Identifier "copytexturepart") (SomeBuiltin copyTexturePart)   insertBuiltInWithDoc (SkIdentifier $ Identifier "copytexturerotated") (SomeBuiltin copyTextureRotated)   insertBuiltInWithDoc (SkIdentifier $ Identifier "textureinfo") (SomeBuiltin textureInfo)+  insertBuiltInWithDoc (SkIdentifier $ Identifier "texttotexture") (SomeBuiltin createTextTexture)+  insertBuiltInWithDoc (SkIdentifier $ Identifier "drawtextat") (SomeBuiltin drawTextAt)+  insertBuiltInWithDoc (SkIdentifier $ Identifier "drawtextrotatedat") (SomeBuiltin drawTextAtRotated)+  insertBuiltInWithDoc (SkIdentifier $ Identifier "setfont") (SomeBuiltin setFont)+  insertBuiltInWithDoc (SkIdentifier $ Identifier "loadfont") (SomeBuiltin loadFont)    -- SDL Keyboard   insertBuiltInWithDoc (SkIdentifier $ Identifier "getkeypresses") (SomeBuiltin getKeys)-  insertBuiltInWithDoc (SkIdentifier $ Identifier "waitforkey") (SomeBuiltin waitForSDLKey)+  insertBuiltInWithDoc (SkIdentifier $ Identifier "gwaitforkey") (SomeBuiltin waitForSDLKey)   insertBuiltInWithDoc (SkIdentifier $ Identifier "getkeystate") (SomeBuiltin getKeyboardState)   insertBuiltInWithDoc (SkIdentifier $ Identifier "inkeystate") (SomeBuiltin wasKeyDownIn) @@ -194,6 +211,7 @@   insertBuiltInWithDoc (SkIdentifier $ Identifier "readref") (SomeBuiltin builtInReadRef)   insertBuiltInWithDoc (SkIdentifier $ Identifier "writeref") (SomeBuiltin builtInWriteRef)   insertBuiltInWithDoc (SkIdentifier $ Identifier "modifyref") (SomeBuiltin builtInModifyRef)+  insertBuiltInWithDoc (SkIdentifier $ Identifier "next") (SomeBuiltin builtInGeneratorNext)    -- Crypto   insertBuiltInWithDoc (SkIdentifier $ Identifier "hash") (SomeBuiltin builtInHash)

@@ -2,7 +2,9 @@  import Prelude hiding (map) +import Control.Monad.IO.Unlift import Control.Monad.Catch (try)+import Control.Concurrent import Control.Concurrent.STM as STM import Control.Exception (throw, IOException) import Control.Monad@@ -23,17 +25,18 @@ import Compiler.AST.FunctionStatement import Compiler.AST.Program import Compiler.Lexer-import Control.Monad.State.Strict import Interpreter.Common  lookupScope :: ScopeKey -> InterpretM Value lookupScope key =-  ((lookupInTopScope key . isLocal) <$> get) >>= \case+  ((lookupInTopScope key . isLocal) <$> getInterpretM) >>= \case     Just v -> pure v-    Nothing -> ((M.lookup key . isGlobalScope) <$> get) >>= \case+    Nothing -> ((lookupInTopScope key . isModuleScope) <$> getInterpretM) >>= \case       Just v -> pure v-      Nothing ->-        throwErr $ SymbolNotFound (pack $ show key)+      Nothing -> do+        ((M.lookup key . isGlobalScope) <$> getInterpretM) >>= \case+          Just v -> pure v+          Nothing -> throwErr $ SymbolNotFound (pack $ show key)  lookupInTopScope :: ScopeKey -> [Scope] -> Maybe Value lookupInTopScope _ [] = Nothing@@ -65,24 +68,28 @@   evaluateFn (FnOp op) [e1, e2] False >>= \case     Just v  -> pure v     Nothing -> pure Void-evaluateExpression_ (ECall iden exprs isTail)  =  evaluateFn (FnName iden) exprs isTail >>= \case+evaluateExpression_ (ECall (ExpressionWithLoc (EVar iden) _) exprs isTail)  =  evaluateFn (FnName iden) exprs isTail >>= \case   Just v  -> pure v   Nothing -> pure Void+evaluateExpression_ (ECall ex exprs isTail)  =  evaluateFn (FnExpr ex) exprs isTail >>= \case+  Just v  -> pure v+  Nothing -> pure Void evaluateExpression_ (EUnnamedFn args expr)  = do-  isLocal <$> get >>= \case+  isLocal <$> getInterpretM >>= \case     [] -> pure $ UnnamedFnValue $ UnNamedFn args mempty expr     (h: _) -> pure $ UnnamedFnValue $ UnNamedFn args h expr  popScope :: InterpretM () popScope = do-  (isLocal <$> get) >>= \case+  (isLocal <$> getInterpretM) >>= \case     (_:rst) -> do-      modify (\is -> is { isLocal = rst })+      modifyInterpretM (\is -> is { isLocal = rst })     _ -> throwErr EmptyScopeStack  data FnId   = FnOp Operator   | FnName Identifier+  | FnExpr ExpressionWithLoc  evaluateCallback :: Callback -> [Value] -> InterpretM (Maybe Value) evaluateCallback (CallbackUnNamed un) args = Just <$> evaluateUnnamedFn un args@@ -93,8 +100,19 @@ insertEmptyScope = insertScope mempty  insertScope :: Scope -> InterpretM ()-insertScope scope = modify $ mapLocal (\s -> scope : s)+insertScope scope = modifyInterpretM $ mapLocal (\s -> scope : s) +pushModuleScope :: Scope -> InterpretM ()+pushModuleScope scope = modifyInterpretM $ (\s -> s {isModuleScope = scope : (isModuleScope s)} )++popModuleScope :: InterpretM Scope+popModuleScope =+  (isModuleScope <$> getInterpretM) >>= \case+    [] -> throwErr EmptyModuleScopeStack+    (scp : rst) -> do+      modifyInterpretM $ (\s -> s {isModuleScope = rst} )+      pure scp+ evaluateUnnamedFn :: UnNamedFn -> [Value] -> InterpretM Value evaluateUnnamedFn (UnNamedFn [] scope expr) _ = do   insertScope scope@@ -103,52 +121,84 @@   pure x evaluateUnnamedFn (UnNamedFn argNames scope expr) argsVals = do   insertScope scope-  zipWithM_ (\a1 a2 -> insertBinding a1 a2) (SkIdentifier <$> argNames) argsVals -- @TODO Check argument counts+  zipWithM_ (\a1 a2 -> insertBinding False a1 a2) (SkIdentifier <$> argNames) argsVals -- @TODO Check argument counts   r <- evaluateExpression expr   popScope   pure r  evaluateProcedure_ :: Value -> [Value] -> InterpretM (Maybe Value) evaluateProcedure_ fnVal args = case fnVal of+  ModuleValue fp (ScopeRef scopeRef) (Just fnId) -> do+    scope <- liftIO $ readTVarIO scopeRef+    pushModuleScope scope+    lookupScope (SkIdentifier fnId) >>= \case+      ProcedureValue fndef -> do+        insertEmptyScope+        oldFp <- isCurrentModulePath <$> getInterpretM+        modifyInterpretM (\is -> is { isCurrentModulePath = Just fp })+        r <- case fndef of+          FunctionDef False _ _ _ -> runProcedure fndef+          FunctionDef True _ _ _ -> withStateClone $ runProcedure fndef+        finalModuleScope <- popModuleScope+        modifyInterpretM (\is -> is { isCurrentModulePath = oldFp })+        liftIO $ atomically $ writeTVar scopeRef finalModuleScope+        pure r+      _ -> throwErr $ SymbolNotFound (pack $ show fnId)   UnnamedFnValue un -> Just <$> evaluateUnnamedFn un args-  (ProcedureValue (FunctionDef _ argNames (NE.toList -> stms))) -> do+  ProcedureValue fndef -> do     insertEmptyScope-    zipWithM_ (\a1 a2 -> insertBinding a1 a2) (SkIdentifier <$> argNames) args -- @TODO Check argument counts-    executeStatements stms >>= \case-      ProcReturn False v -> do-        popScope-        pure $ Just v-      ProcReturn True v -> do-        -- Don't pop stack if the return was a tail call return-        -- because the stack was popped before entering the-        -- call.-        pure $ Just v-      ProcBreak -> do-        popScope-        pure Nothing-      ProcContinue -> do-        popScope-        pure Nothing+    runProcedure fndef   (BuiltIn (BuiltinCall cb)) -> cb args   (BuiltIn (BuiltinCallWithDoc (SomeBuiltin cb))) -> cb (toArgs args)   a -> throwErr $ UnexpectedType ("Procedure", a)+  where+    runProcedure :: FunctionDef -> InterpretM (Maybe Value)+    runProcedure = \case+      FunctionDef True a b c -> do+        inChan <- liftIO newTChanIO+        outChan <- liftIO newTChanIO+        let gChans = GeneratorChannels inChan outChan+        void $ withRunInIO $ \runInIO -> forkIO $ runInIO (do+            modifyInterpretM (\is -> is { isGeneratorChannels = Just gChans })+            void $ runProcedure $ FunctionDef False a b c+            liftIO $ atomically $ writeTChan outChan Nothing+            )+        pure $ Just $ GeneratorValue gChans +      FunctionDef False _ argNames (NE.toList -> stms) -> do+        zipWithM_ (\a1 a2 -> insertBinding False a1 a2) (SkIdentifier <$> argNames) args -- @TODO Check argument counts+        executeStatements stms >>= \case+          ProcReturn False v -> do+            popScope+            pure $ Just v+          ProcReturn True v -> do+            -- Don't pop stack if the return was a tail call return+            -- because the stack was popped before entering the+            -- call.+            pure $ Just v+          ProcBreak -> do+            popScope+            pure Nothing+          ProcContinue -> do+            popScope+            pure Nothing+ evaluateProcedure :: ScopeKey -> [Value] -> InterpretM (Maybe Value) evaluateProcedure sk args =   lookupScope sk >>= (\x -> evaluateProcedure_ x args)  evaluateFn :: FnId -> [ExpressionWithLoc] -> Bool -> InterpretM (Maybe Value) evaluateFn fnId argsExps isTail = do-  let sk = case fnId of-        FnOp op    -> SkOperator op-        FnName idf -> SkIdentifier idf   args <- mapM (\x -> evaluateExpression x) argsExps+  fnVal <- case fnId of+    FnOp op -> lookupScope (SkOperator op)+    FnName op -> lookupScope (SkIdentifier op)+    FnExpr expr -> evaluateExpression expr   if isTail     then do-      fnVal <- lookupScope sk       popScope       evaluateProcedure_ fnVal args-    else evaluateProcedure sk args+    else evaluateProcedure_ fnVal args  evaluateSubscriptedExpr :: SubscriptedExpression -> InterpretM Value evaluateSubscriptedExpr (EArraySubscript expr indexExpr) = evaluateExpression expr >>= \case@@ -181,6 +231,7 @@   ObjectValue mp -> case M.lookup key mp of       Just v  -> pure v       Nothing -> throwErr $ KeyNotFound (pack $ show key)+  ModuleValue fp scope Nothing -> pure $ ModuleValue fp scope $ Just $ Identifier key   a -> throwErr $ UnexpectedType ("Map", a)  evaluateVar :: Subscript -> InterpretM Value@@ -231,21 +282,21 @@     fn ProcBreak _       = pure ProcBreak     fn ProcContinue fs   = executeStatement fs -modifyBinding :: Subscript -> Value -> InterpretM ()-modifyBinding (NoSubscript idf) val = insertBinding (SkIdentifier idf) val-modifyBinding (PropertySubscript sub (unIdentifer -> key)) val = do+modifyBinding :: Bool -> Subscript -> Value -> InterpretM ()+modifyBinding isGlobal (NoSubscript idf) val = insertBinding isGlobal (SkIdentifier idf) val+modifyBinding isGlobal (PropertySubscript sub (unIdentifer -> key)) val = do   evaluateVar sub >>= \case     ObjectValue v -> case M.lookup key v of-      Just _  -> modifyBinding sub (ObjectValue $ M.insert key val v)+      Just _  -> modifyBinding isGlobal sub (ObjectValue $ M.insert key val v)       Nothing -> throwErr (KeyNotFound key)     a -> throwErr $ UnexpectedType ("Map", a)-modifyBinding (SubscriptExpr sub expr) val = do+modifyBinding isGlobal (SubscriptExpr sub expr) val = do   evaluateVar sub >>= \case     ArrayValue v -> evaluateExpression expr >>= \case       NumberValue (NumberInt idx) -> do         let index :: Int = fromIntegral idx         if (index <= V.length v && index > 0)-          then modifyBinding sub (ArrayValue $ V.update v (V.fromList [(index - 1, val)]))+          then modifyBinding isGlobal sub (ArrayValue $ V.update v (V.fromList [(index - 1, val)]))           else throwErr $ IndexOutOfBounds index       a -> throwErr $ UnexpectedType ("Integer Index", a)     BytesValue v -> evaluateExpression expr >>= \case@@ -257,7 +308,7 @@               prefix = BS.take (index - 1) v               suffix = BS.drop index v               wv = fromValue val-            in modifyBinding sub (BytesValue $ prefix <> BS.cons wv suffix)+            in modifyBinding isGlobal sub (BytesValue $ prefix <> BS.cons wv suffix)           else throwErr $ IndexOutOfBounds index       a -> throwErr $ UnexpectedType ("Integer Index", a)     StringValue v -> evaluateExpression expr >>= \case@@ -269,12 +320,12 @@               prefix = T.take (index - 1) v               suffix = T.drop index v               wv = fromValue val-            in modifyBinding sub (StringValue $ prefix <> T.cons wv suffix)+            in modifyBinding isGlobal sub (StringValue $ prefix <> T.cons wv suffix)           else throwErr $ IndexOutOfBounds index       a -> throwErr $ UnexpectedType ("Integer Index", a)     ObjectValue v -> evaluateExpression expr >>= \case       StringValue key -> case M.lookup key v of-        Just _  -> modifyBinding sub (ObjectValue $ M.insert key val v)+        Just _  -> modifyBinding isGlobal sub (ObjectValue $ M.insert key val v)         Nothing -> throwErr (KeyNotFound key)       a -> throwErr $ UnexpectedType ("String", a)     a -> throwErr $ UnexpectedType ("Map", a)@@ -303,7 +354,7 @@  executeDebugStepable :: Show a => DebugStepable a b => a -> InterpretM b executeDebugStepable dbs = do-  isRunMode <$> get >>= \case+  isRunMode <$> getInterpretM >>= \case     NormalMode -> do       execute dbs     DebugMode debugEnv@(DebugEnv { deInQueue = isDebugIn, deOutQueue = isDebugOut, deStepMode = stepMode }) -> do@@ -321,15 +372,15 @@           sendDebugOut isDebugOut           (liftIO $ atomically $ readTBQueue isDebugIn) >>= \case               Run -> do-                modify (\is -> is { isRunMode = DebugMode $ debugEnv { deStepMode = Continue } })+                modifyInterpretM (\is -> is { isRunMode = DebugMode $ debugEnv { deStepMode = Continue } })                 execute dbs               StepIn -> do-                modify (\is -> is { isRunMode = DebugMode (DebugEnv SingleStep isDebugIn isDebugOut) })+                modifyInterpretM (\is -> is { isRunMode = DebugMode (DebugEnv SingleStep isDebugIn isDebugOut) })                 execute dbs               _ -> error "Unexpected debug command"   where     sendDebugOut debugOut = do-      is <- get+      is <- getInterpretM       let currentScope = case isLocal is of             [] -> isGlobalScope is             (scope : _) -> scope@@ -341,12 +392,12 @@  executeStatement_ :: FunctionStatement -> InterpretM ProcResult executeStatement_ (FnComment _) = pure ProcContinue-executeStatement_ (Let sub exp') = do+executeStatement_ (Let sub isGlobal exp') = do   sourceValue <- evaluateExpression exp'-  modifyBinding sub sourceValue+  modifyBinding isGlobal sub sourceValue   pure ProcContinue-executeStatement_ (Call iden args) = do-  _ <- evaluateFn (FnName iden) args False+executeStatement_ (Call expr) = do+  _ <- evaluateExpression expr   pure ProcContinue executeStatement_ (IfThen expr stms) = evaluateExpression expr >>= \case   BoolValue True -> executeStatements (NE.toList stms)@@ -377,6 +428,13 @@   -- TCO   evaluateExpression (eloc { elExpression = ECall idf args True }) >>= pure . ProcReturn True executeStatement_ (Return expr) = evaluateExpression expr >>= pure . ProcReturn False+executeStatement_ (Yield expr) = evaluateExpression expr >>= \v ->+  isGeneratorChannels <$> getInterpretM >>= \case+    Nothing -> error "Generator channel unavailable unexpectedly!"+    Just (GeneratorChannels inChan outChan) -> liftIO $ do+      atomically $ writeTChan outChan $ Just v+      atomically $ readTChan inChan+      pure $ ProcContinue executeStatement_ Break = pure ProcBreak executeStatement_ Pass = pure ProcContinue executeStatement_ (Loop (NE.toList -> stms)) = do@@ -400,22 +458,37 @@   case r of     ProcBreak -> pure ProcContinue     a         -> pure a-executeStatement_ (For iden exprFrom exprTo (NE.toList -> stms)) = evaluateExpression exprFrom >>= \case-  NumberValue (NumberInt start) -> evaluateExpression exprTo >>= \case-    NumberValue (NumberInt end) -> do-      let-        fn :: ProcResult -> IntType -> InterpretM ProcResult-        fn ProcContinue current = do-          insertBinding (SkIdentifier iden) (NumberValue $ NumberInt $ current)-          executeStatements stms-        fn r _ = pure r-      foldM (\a1 a2 -> fn a1 a2) ProcContinue [start .. end] >>= \case-        ProcReturn tc v -> pure $ ProcReturn tc v-        _            -> pure ProcContinue-    a            ->  throwErr $ UnexpectedType ("Int", a)-  a            ->  throwErr $ UnexpectedType ("Int", a)+executeStatement_ (For iden exprFrom exprTo (NE.toList -> stms) mStepExpr) = do+  fromVal <- evaluateExpression exprFrom >>= \case+    NumberValue n -> pure n+    a -> throwErr $ UnexpectedType ("Int/Fractional", a)+  toVal <- evaluateExpression exprTo >>= \case+    NumberValue n -> pure n+    a -> throwErr $ UnexpectedType ("Int/Fractional", a)+  stepValue <- case mStepExpr of+    Just stepExpr -> evaluateExpression stepExpr >>= \case+      NumberValue n -> pure n+      a -> throwErr $ UnexpectedType ("Int/Fractional", a)+    Nothing -> pure $ NumberInt 1+  let+    fn :: ProcResult -> Number -> InterpretM ProcResult+    fn ProcContinue current = do+      insertBinding False (SkIdentifier iden) (NumberValue current)+      executeStatements stms+    fn r _ = pure r +  foldM (\a1 a2 -> fn a1 a2) ProcContinue (Prelude.takeWhile (<= toVal) $ iterate ((numberBinaryFn (+)) stepValue) fromVal)  >>= \case+    ProcReturn tc v -> pure $ ProcReturn tc v+    _            -> pure ProcContinue+ executeStatement_ (ForEach iden expr (NE.toList -> stms)) = evaluateExpression expr >>= \case+  GeneratorValue genChans -> let+    go (ProcReturn tc v) = pure $ ProcReturn tc v+    go r =+      generatorNext genChans >>= \case+        Just v -> fn r v >>= go+        Nothing -> pure r+    in go ProcContinue   ObjectValue map -> do     foldM (\a1 (k, v) -> fn a1 (ObjectValue $ M.fromList [("key", StringValue k), ("value", v)])) ProcContinue (M.assocs map) >>= \case       ProcReturn tc v -> pure $ ProcReturn tc v@@ -434,10 +507,21 @@   where     fn :: ProcResult -> Value -> InterpretM ProcResult     fn ProcContinue current = do-      insertBinding (SkIdentifier iden) current+      insertBinding False (SkIdentifier iden) current       executeStatements stms     fn r _ = pure r +generatorNext :: GeneratorChannels -> InterpretM (Maybe Value)+generatorNext (GeneratorChannels inChan outChan) = do+  v <- liftIO $ do+    atomically $ writeTChan inChan ()+    atomically $ readTChan outChan+  case v of+    Just v' -> pure $ Just v'+    Nothing -> do+      liftIO $ atomically $ unGetTChan outChan Nothing+      pure Nothing+ data FileEntry  = FileItem FilePath  | DirItem FilePath@@ -511,3 +595,20 @@     fn v = evaluateCallback callback [v] >>= \case       Just (BoolValue x) -> pure x       _           -> throwErr $ CustomRTE "Callback returned a non-bool value"+++interpretPassOne :: Program -> InterpretM ()+interpretPassOne x = mapM_ (\a -> fn a) x+  where+    fn :: ProgramStatement -> InterpretM ()+    fn (FunctionDefStatement fdef@(FunctionDef _ name _ _)) = modifyInterpretM $ mapGlobalScope $+      \s -> insert (SkIdentifier name) (ProcedureValue fdef) s+    fn _ = pure ()++interpretPassTwo :: Program -> InterpretM ()+interpretPassTwo x = mapM_ (\a -> fn a) x+  where+    fn :: ProgramStatement -> InterpretM ()+    fn (FunctionDefStatement (FunctionDef _ _ _ _)) = pure ()+    fn (NakedStatement fs)                        = void $ executeStatement fs+    fn (TopLevelComment _)                        = pure ()

@@ -5,29 +5,27 @@ import Control.Concurrent.STM.TChan import Control.Concurrent.STM.TSem import Control.Concurrent.STM.TMVar-import Control.Exception (AsyncException(..), SomeException, catch, toException)+import Control.Exception (SomeException, catch, toException) import Control.Monad.IO.Class+import Control.Monad.IO.Unlift import Control.Monad.State.Strict import Data.Coerce-import Data.Text (pack)  import Interpreter.Common import Interpreter.Interpreter  builtInLaunchThread :: BuiltInFnWithDoc '[ '("callback_thread", Callback), '("callback_arg", Maybe Value) ]-builtInLaunchThread ((coerce -> (processCb :: Callback)) :> (coerce -> (mthreadArg)) :> EmptyArgs) = do-  istate <- get+builtInLaunchThread ((coerce -> (processCb :: Callback)) :> (coerce -> (mthreadArg)) :> EmptyArgs) = withRunInIO $ \runInIO -> do   liftIO $ do     resultRef <- newEmptyTMVarIO     threadId <- forkIO $ flip catch (asynExHandler resultRef) $ do-      threadId <- myThreadId-      (r, _) <- flip runStateT (istate { isThreadName = pack (show threadId) }) (evaluateCallback processCb $ maybe [] (\x -> [x]) mthreadArg)+      r <- runInIO (withStateClone $ evaluateCallback processCb $ maybe [] (\x -> [x]) mthreadArg)       atomically $ putTMVar resultRef $ case r of         Just r' -> Right r'         Nothing -> Left (toException MissingProcedureReturn)     pure $ Just $ ThreadRef $ ThreadInfo threadId resultRef   where-    asynExHandler :: TMVar (Either SomeException Value) -> AsyncException -> IO ()+    asynExHandler :: TMVar (Either SomeException Value) -> SomeException -> IO ()     asynExHandler ref e = atomically $ putTMVar ref $ Left $ toException e  builtInKillThread :: BuiltInFnWithDoc '[ '("thread_result", ThreadInfo) ]@@ -58,6 +56,10 @@ builtInReadChannel ((coerce -> (ChannelRef chan)) :> _) =   Just <$> (liftIO $ atomically $ readTChan chan) +builtInIsChannelEmpty :: BuiltInFnWithDoc '[ '("channel_ref", ChannelRef)]+builtInIsChannelEmpty ((coerce -> (ChannelRef chan)) :> _) =+  (Just . BoolValue) <$> (liftIO $ atomically $ isEmptyTChan chan)+ builtInNewRef :: BuiltInFnWithDoc '[ '("init_value", Value) ] builtInNewRef ((coerce -> (v :: Value)) :> EmptyArgs) = do   (ref, sem) <- liftIO $ do@@ -87,3 +89,9 @@ builtInReadRef ((coerce -> (MutableRef ref _)) :>  EmptyArgs) = do   v <- liftIO $ atomically $ readTMVar ref   pure $ Just v++builtInGeneratorNext :: BuiltInFnWithDoc '[ '("generator", GeneratorChannels) ]+builtInGeneratorNext ((coerce -> genChans) :>  EmptyArgs) = do+  generatorNext genChans >>= \case+    Just v' -> pure $ Just v'+    Nothing -> throwErr GeneratorExhausted

@@ -0,0 +1,8 @@+module Interpreter.Lib.Fonts where++import Data.FileEmbed++import qualified Data.ByteString++defaultFont :: Data.ByteString.ByteString+defaultFont = $(embedFile "fonts/AileronBlack.otf")

@@ -1,9 +1,11 @@ module Interpreter.Lib.Misc where -import Control.Concurrent.STM (atomically)+import Control.Concurrent.STM (atomically, newTVarIO, writeTChan) import Control.Concurrent.STM.TSem import Control.Monad.IO.Class-import Control.Monad.State.Strict as SM+import System.Directory+import System.Process+import System.FilePath import qualified Data.Aeson as A import qualified Data.Aeson.Key as A import qualified Data.Aeson.KeyMap as A@@ -24,8 +26,10 @@ import Data.Typeable  import Common+import Compiler.AST.Program import DiffRender.DiffRender import Interpreter.Common+import Interpreter.Interpreter import UI.Widgets.BorderBox import UI.Widgets.Common hiding (getSelection) import UI.Widgets.Spade.Layout@@ -35,10 +39,11 @@ import UI.Widgets.Spade.RefLabel import UI.Widgets.Spade.Selector import UI.Widgets.Spade.Input+import Compiler.Parser  initCharScreen :: BuiltInFnWithDoc '[] initCharScreen _ = do-  isTerminalParams <$> get >>= \case+  isTerminalParams <$> getInterpretM >>= \case     Just (_, dm) ->  do       csInitialize dm       -- modifyDiffRender (\dfr -> dfr { dfDebug = True })@@ -52,7 +57,7 @@  charGetDimensions :: BuiltInFnWithDoc '[] charGetDimensions EmptyArgs = do-  isTerminalParams <$> get >>= \case+  isTerminalParams <$> getInterpretM >>= \case     Just (_, dm) ->       pure $ Just $ ObjectValue $ M.fromList [("width", NumberValue $ NumberInt $ fromIntegral $ diW dm), ("height", NumberValue $ NumberInt $ fromIntegral $ diH dm)]     Nothing -> throwErr $ CustomRTE "Unknown terminal size"@@ -62,7 +67,7 @@  charScreenGet' :: InterpretM ScreenPos charScreenGet' = do-  isDiffRender <$> get >>= \case+  isDiffRender <$> getInterpretM >>= \case     Just dm -> pure $ dfGetCursorPosition dm     Nothing -> throwErr $ CustomRTE "Char screen not initialized" @@ -76,8 +81,8 @@  charScreenMove' :: Int -> Int -> InterpretM () charScreenMove' x y = do-  isDiffRender <$> get >>= \case-    Just dm ->  SM.modify (\is -> is { isDiffRender = Just $ dfSetCursorPosition (+ x) (+ y) dm })+  isDiffRender <$> getInterpretM >>= \case+    Just dm ->  modifyInterpretM (\is -> is { isDiffRender = Just $ dfSetCursorPosition (+ x) (+ y) dm })     Nothing -> throwErr $ CustomRTE "Char screen not initialized"  charScreenPrint :: BuiltInFnWithDoc '[ '("values", Variadic)]@@ -122,8 +127,8 @@  charScreenDraw' :: InterpretM () charScreenDraw' = do-  tp <- isTerminalParams <$> get-  isStdoutLock <$> get >>= \case+  tp <- isTerminalParams <$> getInterpretM+  isStdoutLock <$> getInterpretM >>= \case     Just sem -> do       liftIO $ atomically $ waitTSem sem       csDraw tp@@ -147,8 +152,8 @@  builtInInitWIdgets :: BuiltInFnWithDoc '[] builtInInitWIdgets EmptyArgs = do-  isWidgetState <$> get >>= \case-    Nothing -> UI.Widgets.Common.modify (\is -> is { isWidgetState = Just emptyWidgetState })+  isWidgetState <$> getInterpretM >>= \case+    Nothing -> modifyInterpretM (\is -> is { isWidgetState = Just emptyWidgetState })     Just _ -> pass   pure Nothing @@ -281,8 +286,8 @@  printValLn :: BuiltInFnWithDoc '[ '("value", Variadic)] printValLn ((coerce -> (Variadic vals)) :> EmptyArgs) = do-  outH <- isOutputHandle <$> get-  tstrFn <- isDefaultPrintParams <$> get >>= \case+  outH <- isOutputHandle <$> getInterpretM+  tstrFn <- isDefaultPrintParams <$> getInterpretM >>= \case     Just p  -> pure $ toStringValFmt p     Nothing -> pure toStringVal   liftIO $ do@@ -293,8 +298,8 @@  printVal :: BuiltInFnWithDoc '[ '("value", Variadic)] printVal ((coerce -> (Variadic vals)) :> EmptyArgs) = do-  outH <- isOutputHandle <$> get-  tstrFn <- isDefaultPrintParams <$> get >>= \case+  outH <- isOutputHandle <$> getInterpretM+  tstrFn <- isDefaultPrintParams <$> getInterpretM >>= \case     Just p  -> pure $ toStringValFmt p     Nothing -> pure toStringVal   liftIO $ do@@ -431,7 +436,7 @@  builtInDebug :: BuiltInFnWithDoc '[] builtInDebug _ = do-  SM.modify (\is -> case isRunMode is of+  modifyInterpretM (\is -> case isRunMode is of     DebugMode debugEnv -> is { isRunMode = DebugMode (debugEnv { deStepMode = SingleStep }) }     _ -> is     )@@ -464,7 +469,7 @@  waitForKey :: BuiltInFnWithDoc '[] waitForKey _ = do-  inputHandle <- isInputHandle <$> get+  inputHandle <- isInputHandle <$> getInterpretM   c <- liftIO $ readKey_ inputHandle   pure $ Just $ ArrayValue $ V.fromList (EventValue <$> strToKeyEvent c) @@ -474,6 +479,20 @@   interpreterOutputFlush   (Just . StringValue) <$> readInterpreterInputLine +builtinImport :: BuiltInFnWithDoc '[ '("filepath", FilePath)]+builtinImport ((coerce -> filepath) :> _) =+  Just <$> importModule filepath++builtinExec :: BuiltInFnWithDoc '[ '("filepath", FilePath), '("args", [String])]+builtinExec ((coerce -> filepath) :> (coerce -> (args :: [String])) :> _) = do+  liftIO $ callProcess filepath args+  pure Nothing++builtinCreateDirectory :: BuiltInFnWithDoc '[ '("filepath", FilePath), '("createParents", Bool)]+builtinCreateDirectory ((coerce -> filePath) :> (coerce -> (createParents :: Bool)) :> _) = do+  liftIO $ createDirectoryIfMissing createParents filePath+  pure Nothing+ valueSize :: BuiltInFnWithDoc '[ '("list_or_map", Value)] valueSize ((coerce -> v1) :> _) = case v1 of   ArrayValue v  -> pure $ Just $ NumberValue $ NumberInt $ fromIntegral $ V.length v@@ -481,3 +500,30 @@   StringValue t -> pure $ Just $ NumberValue $ NumberInt $ fromIntegral $ T.length t   BytesValue t -> pure $ Just $ NumberValue $ NumberInt $ fromIntegral $ BS.length t   v             -> throwErr (UnexpectedType ("Array/Object/Bytes/String", v))++builtinConsoleLog :: BuiltInFnWithDoc '[ '("msg", Text)]+builtinConsoleLog ((coerce -> msg) :> _) = do+  consoleLog msg+  pure Nothing++consoleLog :: Text -> InterpretM ()+consoleLog msg = do+  isLogChannel <$> getInterpretM >>= \case+    Just chan ->  liftIO $ atomically $ writeTChan chan msg+    Nothing -> pass++importModule :: FilePath -> InterpretM Value+importModule filePath = do+  fullPath <- isCurrentModulePath <$> getInterpretM >>= \case+    Just p -> liftIO $ canonicalizePath $ p </> filePath+    Nothing -> error "Import path not available"+  content <- do+    liftIO $ T.readFile fullPath+  program <- liftIO $ compile @Program content+  pushModuleScope mempty+  modifyInterpretM (\is -> is { isCurrentModulePath = Just $ takeDirectory fullPath })+  interpretPassOne program+  interpretPassTwo program+  moduleScope <- popModuleScope+  scopeTVar <- liftIO $ newTVarIO moduleScope+  pure $ ModuleValue filePath (ScopeRef scopeTVar) Nothing

@@ -1,5 +1,6 @@ module Interpreter.Lib.SDL where +import qualified Data.Text as T import Control.Monad.IO.Class import Control.Monad.Loops import Control.Monad.State.Strict@@ -7,7 +8,7 @@ import System.Process (createPipe) import Data.Coerce import Data.IORef-import Data.Int (Int32)+import Data.Int (Int16, Int32) import qualified Data.List as DL import qualified Data.Map as M import Data.Maybe@@ -19,9 +20,12 @@ import SDL hiding (Keycode, Scancode, get) import qualified SDL import SDL.Mixer as SDLM+import qualified SDL.Primitive as SDLP+import qualified SDL.Font as SDLF  import Interpreter.Common import Interpreter.Interpreter+import qualified Interpreter.Lib.Fonts as Fonts  makeSinWaveChunk :: Double -> BS.ByteString makeSinWaveChunk freq = BS.pack $@@ -47,6 +51,7 @@   let windowName = "S.P.A.D.E Program"   (renderer, window) <- liftIO $ do     SDL.initialize [SDL.InitVideo, SDL.InitAudio, SDL.InitEvents, SDL.InitTimer]+    SDLF.initialize     SDLM.openAudio SDLM.defaultAudio 256     window <- if isfulscren       then case md of@@ -58,13 +63,16 @@     renderer <- case acc of       True -> SDL.createRenderer window (-1) SDL.defaultRenderer       _ -> SDL.createRenderer window (-1) $ SDL.defaultRenderer { rendererType = SoftwareRenderer }+    SDL.rendererDrawColor renderer $= V4 255 255 255 255     pure (renderer, window)-  sdlWindowRefs <- isSDLWindows <$> get+  sdlWindowRefs <- isSDLWindows <$> getInterpretM   liftIO $ modifyIORef sdlWindowRefs (\l -> (window : l))-  modify (\x -> x+  font <- SDLF.decode Fonts.defaultFont 10+  modifyInterpretM (\x -> x     { isDefaultWindow = Just window     , isDefaultRenderer = Just renderer     , isAccelerated = Just acc+    , isDefaultFont = Just font     })   pure $ Just $ SDLValue $ Renderer renderer @@ -90,13 +98,66 @@  setLogicalSize :: BuiltInFnWithDoc ['("x", CInt), '("y", CInt)] setLogicalSize ((coerce -> (lx :: CInt)) :> (coerce -> (ly :: CInt)) :> _) =-  isDefaultRenderer <$> get >>= \case+  isDefaultRenderer <$> getInterpretM >>= \case     Just renderer  -> do       SDL.V2 x y <- getWindowSize'       SDL.rendererScale renderer SDL.$= (SDL.V2 (realToFrac x/realToFrac lx) (realToFrac y/realToFrac ly))       pure Nothing     Nothing -> throwErr $ SDLError "Graphics not Initialized" +createTextTexture :: BuiltInFnWithDoc '[ '("content", T.Text)]+createTextTexture ((coerce -> (content :: T.Text)) :> _) = do+  isDefaultRenderer <$> getInterpretM >>= \case+    Just renderer  -> do+      (V4 r g b a) <- SDL.get (SDL.rendererDrawColor renderer)+      (Just . SDLValue . Texture) <$> createTextTexture' (r, g, b, a) content+    Nothing -> throwErr $ SDLError "Graphics not Initialized"++loadFont :: BuiltInFnWithDoc ['("pointSize", SDLF.PointSize), '("filePath", Maybe FilePath)]+loadFont ( (coerce -> pointSize) :> (coerce -> mFilePath) :> _) = do+  fontSrc <- case mFilePath of+    Just filePath -> liftIO $ BS.readFile filePath+    Nothing -> pure $ Fonts.defaultFont+  font <- SDLF.decode fontSrc pointSize+  pure $ Just $ SDLValue $ Font font++setFont :: BuiltInFnWithDoc '[ '("font", Value)]+setFont ((coerce -> fsValue) :> _) = do+  case fsValue of+    SDLValue (Font f) -> modifyInterpretM (\im -> im { isDefaultFont = Just f })+    _ -> throwErr $ SDLError "Font value expected"+  pure Nothing++drawTextAt+  :: BuiltInFnWithDoc ['("x", CInt), '("y", CInt), '("content", T.Text)]+drawTextAt ((coerce -> x) :> (coerce -> y) :> (coerce -> (content :: T.Text)) :> _) = do+  drawTextAt' x y 0 content+  pure Nothing++drawTextAtRotated+  :: BuiltInFnWithDoc ['("x", CInt), '("y", CInt), '("angle", CDouble), '("content", T.Text)]+drawTextAtRotated ((coerce -> x) :> (coerce -> y) :> (coerce -> rotAng) :> (coerce -> (content :: T.Text)) :> _) = do+  drawTextAt' x y rotAng content+  pure Nothing++drawTextAt' :: CInt -> CInt -> CDouble -> T.Text -> InterpretM ()+drawTextAt' x y rotAng content = do+  renderer <- getDefaultRenderer+  (V4 r g b a) <- SDL.get (SDL.rendererDrawColor renderer)+  texture <- createTextTexture' (r, g, b, a) content+  ti <- SDL.queryTexture texture+  SDL.copyEx renderer texture Nothing (Just $ SDL.Rectangle (SDL.P (SDL.V2 x y)) (SDL.V2 (SDL.textureWidth ti) (SDL.textureHeight ti))) rotAng (Just $ mkPoint 0 (SDL.textureHeight ti)) (SDL.V2 False False)+  drawIfNotAccelerated++createTextTexture' :: (Word8, Word8, Word8, Word8) -> T.Text -> InterpretM SDL.Texture+createTextTexture' (r, g, b, a) t = do+  renderer <- getDefaultRenderer+  isDefaultFont <$> getInterpretM >>= \case+    Just font -> do+      texture <- SDLF.solid font (V4 r g b a) t >>= SDL.createTextureFromSurface renderer+      pure texture+    Nothing -> throwErr $ SDLError "Font not set"+ loadTexture' :: FilePath -> InterpretM Value loadTexture' fp = do   renderer <- getDefaultRenderer@@ -113,6 +174,7 @@ copyTexture' texture x y w h = do   renderer <- getDefaultRenderer   SDL.copy renderer texture Nothing (Just $ SDL.Rectangle (SDL.P (SDL.V2 x y)) (SDL.V2 w h))+  drawIfNotAccelerated  copyTexturePart' :: SDL.Texture -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> InterpretM () copyTexturePart' texture sx sy sw sh x y w h = do@@ -120,6 +182,7 @@   SDL.copy renderer texture     (Just $ SDL.Rectangle (SDL.P (SDL.V2 sx sy)) (SDL.V2 sw sh))     (Just $ SDL.Rectangle (SDL.P (SDL.V2 x y)) (SDL.V2 w h))+  drawIfNotAccelerated  copyTextureRotated'   :: SDL.Texture@@ -145,6 +208,7 @@     rotationDeg     (Just $ mkPoint rx ry)     (SDL.V2 fx fy)+  drawIfNotAccelerated  loadTexture :: BuiltInFnWithDoc '[ '("bmp_file", FilePath)] loadTexture ((coerce -> fp) :> EmptyArgs) =@@ -255,12 +319,12 @@   pure Nothing  getDefaultWindow :: InterpretM SDL.Window-getDefaultWindow = isDefaultWindow <$> get >>= \case+getDefaultWindow = isDefaultWindow <$> getInterpretM >>= \case   Just x  -> pure x   Nothing -> throwErr $ SDLError "Graphics not Initialized"  getDefaultRenderer :: InterpretM SDL.Renderer-getDefaultRenderer = isDefaultRenderer <$> get >>= \case+getDefaultRenderer = isDefaultRenderer <$> getInterpretM >>= \case   Just x  -> pure x   Nothing -> throwErr $ SDLError "Graphics not Initialized" @@ -273,7 +337,7 @@ draw' = getDefaultRenderer >>= SDL.present  drawIfNotAccelerated :: InterpretM ()-drawIfNotAccelerated = (isAccelerated <$> get) >>= \case+drawIfNotAccelerated = (isAccelerated <$> getInterpretM) >>= \case   (Just False) -> draw'   _            -> pure () @@ -282,20 +346,36 @@   setDrawColor' r g b 255   pure Nothing -setDrawColorAlpha :: BuiltInFnWithDoc '[ '("red_component", Word8), '("green_component", Word8), '("blue_component", Word8), '("alpha", Word8)]-setDrawColorAlpha ((coerce -> r) :> (coerce -> g) :> (coerce -> b) :> (coerce -> a) :> _) = do-  setDrawColor' r g b a+setBgColor :: BuiltInFnWithDoc '[ '("red_component", Word8), '("green_component", Word8), '("blue_component", Word8)]+setBgColor ((coerce -> r) :> (coerce -> g) :> (coerce -> b) :> _) = do+  setBgColor' r g b 255   pure Nothing +setDrawColorAlpha :: BuiltInFnWithDoc '[ '("red_component", Word8), '("green_component", Word8), '("blue_component", Word8), '("transparency", Word8)]+setDrawColorAlpha ((coerce -> r) :> (coerce -> g) :> (coerce -> b) :> (coerce -> t) :> _) = do+  setDrawColor' r g b t+  pure Nothing+ setDrawColor' :: Word8 -> Word8 -> Word8 -> Word8 -> InterpretM () setDrawColor' r g b a = do   getDefaultRenderer >>= \renderer -> do     SDL.rendererDrawColor renderer $= V4 r g b a +setBgColor' :: Word8 -> Word8 -> Word8 -> Word8 -> InterpretM ()+setBgColor' r g b a = modifyInterpretM (\im -> im { isBgColor = Just (r, g, b, a) })+ clear :: BuiltInFnWithDoc '[]-clear _ = do-  getDefaultRenderer >>= SDL.clear-  pure Nothing+clear _ =+  getDefaultRenderer >>= \renderer -> do+    isBgColor <$> getInterpretM >>= \case+      Just (r, g, b, a) -> do+        (V4 r' g' b' a') <- SDL.get (SDL.rendererDrawColor renderer)+        SDL.rendererDrawColor renderer $= V4 r g b a+        SDL.clear renderer+        SDL.rendererDrawColor renderer $= V4 r' g' b' a'+        drawIfNotAccelerated+      Nothing -> throwErr $ SDLError "Background color not set"+    pure Nothing  drawPoint :: BuiltInFnWithDoc ['("x", CInt), '("y", CInt)] drawPoint ((coerce -> x) :> (coerce -> y) :> _) = do@@ -336,59 +416,29 @@ v2Snd :: Point V2 a -> a v2Snd (P (V2 _ a)) = a -drawPoly :: BuiltInFnWithDoc '[ '("points", VS.Vector (SDL.Point V2 CInt)), '("fill", Maybe Bool)]+drawPoly :: BuiltInFnWithDoc '[ '("points", VS.Vector (SDL.Point V2 Int16)), '("fill", Maybe Bool)] drawPoly ((coerce -> v) :> (coerce -> f) :> EmptyArgs) = do-  drawPoly' v f+  drawPoly' v False f   pure Nothing -drawPoly' :: VS.Vector (SDL.Point V2 CInt) -> Maybe Bool -> InterpretM ()-drawPoly' v f = do-  let fill = fromMaybe False f-  renderer <- getDefaultRenderer-  SDL.drawLines renderer v-  if VS.length v > 0 then do-    let last' = VS.last v-    let first' = VS.head v-    SDL.drawLine renderer last' first'-    SDL.drawPoint renderer last'-    SDL.drawPoint renderer last'-    if fill then do-      let points = v2ToTuple <$> (VS.toList v)-      let pointsY = snd <$> points-      let between v1 (b1, b2) = (b1 <= v1 && b2 >= v1) || (b2 <= v1 && b1 >= v1)-      let minY = minimum pointsY-      let maxY = maximum pointsY-      let pointPairs = zip points ((drop 1 points) <> [head points])-      let-        getXes :: CInt -> [Maybe CInt]-        getXes y =-            flip fmap pointPairs $ \((x1, y1), (x2, y2)) ->-              if y `between` (y1, y2)-                then-                  if (not $ y1 == y2)-                    then do-                      let slope = ((realToFrac $ x2 - x1) :: Double)/(realToFrac $ y2 - y1)-                      Just $ x1 + (round $ (realToFrac $ y - y1 :: Double) * slope)-                    else Nothing-                else Nothing-      let-        dlPairs :: MonadIO m => [(CInt, CInt)] -> m ()-        dlPairs ((x1, y1) : (x2, y2) : xs) = do-          SDL.drawLine renderer (mkPoint x1 y1) (mkPoint x2 y2)-          dlPairs xs-        dlPairs _  = pure ()-      let-        drawY :: MonadIO m => CInt -> m ()-        drawY y = do-          let mxses = getXes y-          let xses = catMaybes mxses-          let cords = zip (DL.sort $ DL.nub xses) (repeat y)-          dlPairs cords-      forM_ [minY..maxY] drawY-    else pure ()-  else pure ()+drawPolySmooth :: BuiltInFnWithDoc '[ '("points", VS.Vector (SDL.Point V2 Int16))]+drawPolySmooth ((coerce -> v) :> EmptyArgs) = do+  drawPoly' v True Nothing+  pure Nothing +drawPoly' :: VS.Vector (SDL.Point V2 Int16) -> Bool -> Maybe Bool -> InterpretM ()+drawPoly' v smth f = do+  renderer <- getDefaultRenderer+  dcl <- SDL.get (SDL.rendererDrawColor renderer)+  if (fromMaybe False f)+    then SDLP.fillPolygon renderer (toSingle (\(P (V2 a _)) -> a) v) (toSingle (\(P (V2 _ b)) -> b) v) dcl+    else if smth+      then SDLP.smoothPolygon renderer (toSingle (\(P (V2 a _)) -> a) v) (toSingle (\(P (V2 _ b)) -> b) v) dcl+      else SDLP.polygon renderer (toSingle (\(P (V2 a _)) -> a) v) (toSingle (\(P (V2 _ b)) -> b) v) dcl   drawIfNotAccelerated+  where+    toSingle :: (SDL.Point V2 Int16 -> Int16) ->  VS.Vector (SDL.Point V2 Int16) -> VS.Vector Int16+    toSingle fn vec = VS.map fn vec  drawLine :: BuiltInFnWithDoc ['("start_x", CInt), '("start_y", CInt), '("end_x", CInt), '("end_y", CInt)] drawLine ((coerce -> x) :> (coerce -> y) :> (coerce -> xEnd) :> (coerce -> yEnd) :>_) = do@@ -416,29 +466,60 @@   drawIfNotAccelerated   pure Nothing -drawArc :: BuiltInFnWithDoc ['("center_x", CInt), '("center_y", CInt), '("radius", Double), '("angle_start", Double),  '("angle_end", Double), '("fill", Maybe Bool)]-drawArc ((coerce -> x) :> (coerce -> y) :> (coerce -> radius) :> (coerce -> angles) :> (coerce -> anglee) :> (coerce -> f) :> _) = do-  drawArc' x y radius (fromMaybe False f) angles anglee+drawArc :: BuiltInFnWithDoc ['("center_x", CInt), '("center_y", CInt), '("radius", CInt), '("angle_start", CInt),  '("angle_end", CInt)]+drawArc ((coerce -> x) :> (coerce -> y) :> (coerce -> radius) :> (coerce -> angles) :> (coerce -> anglee) :> _) = do+  renderer <- getDefaultRenderer+  dcl <- SDL.get (SDL.rendererDrawColor renderer)+  SDLP.arc renderer (SDL.V2 x y) radius angles anglee dcl+  drawIfNotAccelerated   pure Nothing -drawCircle :: BuiltInFnWithDoc ['("center_x", CInt), '("center_y", CInt), '("radius", Double), '("fill", Maybe Bool)]-drawCircle ((coerce -> x) :> (coerce -> y) :> (coerce -> radius) :> (coerce -> f) :> _) = do-  drawArc' x y radius (fromMaybe False f) 0 360+drawPie :: BuiltInFnWithDoc ['("center_x", CInt), '("center_y", CInt), '("radius", CInt), '("angle_start", CInt), '("angle_end", CInt), '("fill", Maybe Bool)]+drawPie ((coerce -> x) :> (coerce -> y) :> (coerce -> radius) :> (coerce -> angles) :> (coerce -> anglee) :> (coerce -> (f :: Maybe Bool)) :> _)  = do+  renderer <- getDefaultRenderer+  dcl <- SDL.get (SDL.rendererDrawColor renderer)+  case f of+    Just True -> SDLP.fillPie renderer (SDL.V2 x y) radius angles anglee dcl+    _ -> SDLP.pie renderer (SDL.V2 x y) radius angles anglee dcl+  drawIfNotAccelerated   pure Nothing -drawArc' :: CInt -> CInt -> Double -> Bool -> Double -> Double -> InterpretM ()-drawArc' x y radius f angles anglee = do-  let start_angle = angles * 2 * pi / 360-  let end_angle = anglee * 2 * pi / 360-  let one_degree = (600/radius) * 2 * pi / 360 -- We use more segments as the arc gets bigger.-  let angle_list = takeWhile (\a -> a <= end_angle) $ (DL.iterate' (+ one_degree) start_angle)-  let dx = realToFrac x-  let dy = realToFrac y-  let points = (\a -> mkPoint (round $ dx + (cos a) * radius) (round $ dy + (sin a) * radius)) <$> (angle_list <> [end_angle])-  if f then drawPoly' (VS.fromList (points <> [mkPoint x y])) (Just True)-    else drawLines' (VS.fromList points)+drawCircle :: BuiltInFnWithDoc ['("center_x", CInt), '("center_y", CInt), '("radius", CInt), '("fill", Maybe Bool)]+drawCircle ((coerce -> x) :> (coerce -> y) :> (coerce -> radius) :> (coerce -> (f :: Maybe Bool)) :> _) = do+  renderer <- getDefaultRenderer+  dcl <- SDL.get (SDL.rendererDrawColor renderer)+  case f of+    Just True -> SDLP.fillCircle renderer (SDL.V2 x y) radius dcl+    _ -> SDLP.circle renderer (SDL.V2 x y) radius dcl   drawIfNotAccelerated+  pure Nothing +drawEllipse :: BuiltInFnWithDoc ['("center_x", CInt), '("center_y", CInt), '("radiusx", CInt), '("radiusy", CInt), '("fill", Maybe Bool)]+drawEllipse ((coerce -> x) :> (coerce -> y) :> (coerce -> radiusx) :> (coerce -> radiusy) :> (coerce -> (f :: Maybe Bool)) :> _) = do+  renderer <- getDefaultRenderer+  dcl <- SDL.get (SDL.rendererDrawColor renderer)+  case f of+    Just True -> SDLP.fillEllipse renderer (SDL.V2 x y) radiusx radiusy dcl+    _ -> SDLP.ellipse renderer (SDL.V2 x y) radiusx radiusy dcl+  drawIfNotAccelerated+  pure Nothing++drawSmoothEllipse :: BuiltInFnWithDoc ['("center_x", CInt), '("center_y", CInt), '("radiusx", CInt), '("radiusy", CInt)]+drawSmoothEllipse ((coerce -> x) :> (coerce -> y) :> (coerce -> radiusx) :> (coerce -> radiusy) :> _) = do+  renderer <- getDefaultRenderer+  dcl <- SDL.get (SDL.rendererDrawColor renderer)+  SDLP.smoothEllipse renderer (SDL.V2 x y) radiusx radiusy dcl+  drawIfNotAccelerated+  pure Nothing++drawSmoothCircle :: BuiltInFnWithDoc ['("center_x", CInt), '("center_y", CInt), '("radius", CInt)]+drawSmoothCircle ((coerce -> x) :> (coerce -> y) :> (coerce -> radius) :> _) = do+  renderer <- getDefaultRenderer+  dcl <- SDL.get (SDL.rendererDrawColor renderer)+  SDLP.smoothCircle renderer (SDL.V2 x y) radius dcl+  drawIfNotAccelerated+  pure Nothing+ waitForSDLKey :: BuiltInFnWithDoc '[] waitForSDLKey _ = do   mv <- iterateWhile isNothing $ do@@ -545,11 +626,11 @@  cleanupSDL :: InterpretM () cleanupSDL = do-  sdlWindowRefs <- isSDLWindows <$> get+  sdlWindowRefs <- isSDLWindows <$> getInterpretM   windows <- liftIO $ readIORef sdlWindowRefs   mapM_ (liftIO . SDL.destroyWindow) windows-  modify (\x -> x { isDefaultRenderer = Nothing })-  modify (\x -> x { isDefaultWindow = Nothing })+  modifyInterpretM (\x -> x { isDefaultRenderer = Nothing })+  modifyInterpretM (\x -> x { isDefaultWindow = Nothing })   SDLM.closeAudio   SDL.quit 

@@ -14,8 +14,11 @@ builtInEncodeUTF8Bytes :: BuiltInFnWithDoc '[ '("string", Text)] builtInEncodeUTF8Bytes ((coerce -> b) :> EmptyArgs) = pure $ Just $ BytesValue $ encodeUtf8 b -builtInConcat :: BuiltInFnWithDoc '[ '("string1", Text), '("string2", Text)]-builtInConcat ((coerce -> b) :> (coerce -> d) :> EmptyArgs) = pure $ Just $ StringValue $ T.concat [b, d]+builtInConcat :: BuiltInFnWithDoc '[ '("strings", Variadic)]+builtInConcat ((coerce -> Variadic vals) :> EmptyArgs) = pure $ Just $ StringValue $ T.concat $ getStringVal <$> vals+  where+    getStringVal (StringValue x) = x+    getStringVal a = throwErr $ BadArguments ("Expecting a list of strings, but got", T.pack $ show a)  builtInJoin :: BuiltInFnWithDoc '[ '("joiner", Text), '("parts", [Text])] builtInJoin ((coerce -> b) :> (coerce -> d) :> EmptyArgs) =

@@ -4,7 +4,6 @@   , module Control.Monad   , module Data.Text   , module Control.Monad.IO.Class-  , module Control.Monad.State.Strict   , module Data.Constraint   , module GHC.Stack   ) where@@ -12,6 +11,8 @@ import Common import Control.Concurrent.STM (atomically) import Control.Concurrent.STM.TChan+import Control.Concurrent.STM.TVar+import Control.Monad.State.Strict import Control.Exception import Control.Monad.IO.Class import Control.Monad.Loops (iterateWhile)@@ -35,7 +36,7 @@ import UI.Terminal.IO  import Control.Monad-import Control.Monad.State.Strict+import Control.Monad.Reader import DiffRender.DiffRender import Highlighter.Highlighter import qualified System.Console.ANSI as A@@ -75,18 +76,17 @@   dfr <- emptyDiffRender dim   pure $ UIState emptyWidgetState dfr -type WidgetM m a = (MonadIO m, WidgetC m) => m a--runWidgetM' :: MonadIO m => StateT UIState m a -> m (a, UIState)-runWidgetM' act = do-  ws <- liftIO $ emptyUIState $ Dimensions 0 0-  runWidgetM'' ws act+type WidgetM m a = ReaderT (TVar UIState) m a -runWidgetM'' :: MonadIO m => UIState -> StateT UIState m a -> m (a, UIState)-runWidgetM'' ws act = flip runStateT ws act+runWidgetM'' :: MonadIO m => UIState -> WidgetM m a -> m a+runWidgetM'' uistate act = do+  ws <- liftIO $ newTVarIO uistate+  flip runReaderT ws act -runWidgetM :: MonadIO m => StateT UIState m a -> m a-runWidgetM act =  fst <$> runWidgetM' act+runWidgetM :: MonadIO m => WidgetM m a -> m a+runWidgetM act = do+  ws <- liftIO $ ((emptyUIState $ Dimensions 0 0))+  runWidgetM'' ws act  class HasDiffRender m where   getDiffRender :: m DiffRender@@ -99,16 +99,27 @@   putWidgetState :: WidgetState -> m ()   modifyWidgetState :: (WidgetState -> WidgetState) -> m () -instance MonadIO m => HasDiffRender (StateT UIState m) where-  getDiffRender = usDiffRender <$> get-  putDiffRender dfr = modify (\us -> us { usDiffRender = dfr })-  modifyDiffRender fn = modify (\us -> us { usDiffRender = fn $ usDiffRender us })+askWidgetM :: MonadIO m => WidgetM m UIState+askWidgetM = do+  tvar <- ask+  liftIO $ atomically $ readTVar tvar -instance MonadIO m => HasWidgetState (StateT UIState m) where-  getWidgetState = usWidgetState <$> get-  getWidgetStateMaybe = (Just . usWidgetState) <$> get-  putWidgetState ws = modify (\us -> us { usWidgetState = ws })-  modifyWidgetState fn = modify (\us -> us { usWidgetState = fn $ usWidgetState us })+modifyWidgetM :: MonadIO m => (UIState -> UIState) -> WidgetM m ()+modifyWidgetM fn = do+    tvar <- ask+    liftIO $ atomically $ modifyTVar tvar fn++instance MonadIO m => HasDiffRender (ReaderT (TVar UIState) m) where+  getDiffRender = usDiffRender <$> askWidgetM+  putDiffRender dfr = modifyWidgetM (\us -> us { usDiffRender = dfr })+  modifyDiffRender fn = modifyWidgetM (\us -> us { usDiffRender = fn $ usDiffRender us })++instance MonadIO m => HasWidgetState (ReaderT (TVar UIState) m) where+  getWidgetState = usWidgetState <$> askWidgetM+  getWidgetStateMaybe = (Just . usWidgetState) <$> askWidgetM+  putWidgetState ws =+    modifyWidgetM (\us -> us { usWidgetState = ws })+  modifyWidgetState fn = modifyWidgetM (\us -> us { usWidgetState = fn $ usWidgetState us })  type WidgetC m =   ( HasRandom m

@@ -68,7 +68,7 @@   getPos ref = ewPos <$> readWRef ref   move ref pos = modifyWRef ref (\ew -> ew { ewPos = pos })   getDim ref = ewDim <$> readWRef ref-  resize ref cb =+  resize ref cb = do     modifyWRef ref (\low -> low { ewDim = cb $ ewDim low })  instance Widget EditorWidget where@@ -586,7 +586,7 @@ editor mautocomplete mts =   newWRef $ EditorWidget     { ewContent = ""-    , ewDim = Dimensions 0 0+    , ewDim = Dimensions 600 2     , ewVisibility = True     , ewPos = ScreenPos 0 0     , ewCursor = 0

@@ -16,7 +16,7 @@ insertLog :: WidgetC m => WRef LogWidget -> Text -> m () insertLog ref l = do   timestr <- liftIO getLocalTimeString-  modifyWRef ref (\lw -> lw { lwContent = Prelude.take 20 $ (timestr <> ": " <> l) : lwContent lw  })+  modifyWRef ref (\lw -> lw { lwContent = Prelude.take 20 $ (timestr <> "| " <> l) : lwContent lw  })  instance Moveable LogWidget where   getPos ref = lwPos <$> readWRef ref

@@ -1,8 +1,10 @@ module UI.Widgets.Spade.Button where  import qualified Data.Text as T+import Control.Concurrent.STM.TVar import Data.Typeable import qualified System.Console.ANSI as A+import Control.Monad.Reader  import Common import DiffRender.DiffRender@@ -31,7 +33,7 @@       KeyCtrl _ _ _ Return -> do         w <- readWRef ref         case (bwAction w) of-          Just cb -> case eqT @m @(StateT InterpreterState IO) of+          Just cb -> case eqT @m @(ReaderT (TVar InterpreterState) IO) of             Just Refl -> void $ evaluateCallback cb []             Nothing -> error ""           Nothing -> pure ()

@@ -46,8 +46,8 @@   getPos ref = iwEditor <$> (readWRef ref) >>= getPos >>= (pure . moveLeft 1)   move ref pos = (iwEditor <$> readWRef ref) >>= (flip move (moveRight 1 pos))   getDim ref = iwEditor <$> (readWRef ref) >>= getDim >>= (pure . amendWidth (\x -> x + 1))-  resize ref cb =-    (iwEditor <$> readWRef ref) >>= (flip resize (amendWidth (\x -> x - 1) . cb))+  resize ref cb = do+    (iwEditor <$> readWRef ref) >>= (flip resize cb)  instance Focusable InputWidget where   setFocus ref b = modifyWRef ref (\w -> w { iwFocused = b })@@ -64,8 +64,7 @@   :: WidgetC m   => Dimensions   -> m (WRef InputWidget)-input dim = do+input _ = do   ew <- editor (\_ -> pure []) Nothing-  modifyWRef ew (\e -> e { ewParams = EditorParams 0 0 0 False False })-  resize ew (\_ -> amendWidth (\x -> x - 1) dim)+  modifyWRef ew (\e -> e { ewParams = EditorParams 0 0 0 True False })   newWRef $ InputWidget ew False

@@ -203,7 +203,7 @@ layoutWidget ori distr children = do   newWRef $     LayoutWidget-    { lowDim = Dimensions 1 1+    { lowDim = Dimensions 600 1     , lowPos = origin     , lowContent = (\c -> StackedWidget 0 c) <$> children     , lowOrientation = ori

@@ -3,6 +3,9 @@ import qualified Data.Text as T import Data.Typeable import qualified System.Console.ANSI as A+import Control.Monad.State.Strict+import Control.Monad.Reader+import Control.Concurrent.STM.TVar  import Common import DiffRender.DiffRender@@ -133,7 +136,7 @@             case selHiglighted w of               Just _ -> do                 case (selAction w) of-                  Just cb -> case eqT @m @(StateT InterpreterState IO) of+                  Just cb -> case eqT @m @(ReaderT (TVar InterpreterState) IO) of                     Just Refl -> void $ evaluateCallback cb [WidgetValue (SomeWidgetRef ref)]                     Nothing -> error ""                   Nothing -> pass

@@ -8,7 +8,6 @@ import Interpreter.Interpreter import Interpreter.Common - spec :: Spec spec = do   describe "While loop" $ do@@ -49,7 +48,7 @@         |]       compile program >>= interpret'' >>= ensureVarIs (SkIdentifier "a") (NumberValue $ NumberInt 10)   where-    interpret'' = interpret id+    interpret'' = interpret id Nothing  ensureVarIs :: ScopeKey -> Value -> InterpreterState -> Expectation ensureVarIs sk v (isGlobalScope -> scope) = (lookupInTopScope sk [scope]) `shouldBe` (Just v)

@@ -24,10 +24,10 @@   , rssCursorInfo :: CursorInfo   } -assertReferenceScreenState :: ReferenceScreenState -> WRef EditorWidget -> StateT UIState IO ()+assertReferenceScreenState :: ReferenceScreenState -> WRef EditorWidget -> WidgetM IO () assertReferenceScreenState ReferenceScreenState {..} ewRef = do   EditorWidget {..} <- readWRef ewRef-  ss <- (dfScreenState . usDiffRender) <$> get+  ss <- (dfScreenState . usDiffRender) <$> askWidgetM   let linesRef = (ssLines ss)   lines' <- MV.foldr'(:) [] linesRef   liftIO $ if lines' == rssLines then do