The code presented here is an update for the code posted earlier, which was written for PBCC 4.
Due to small differences between PBCC 4 and 5, that code caused problems when compiled with PBCC 5.
The current version is tested to compile and run with Win XP both with PBCC 4 and 5.
I want to thank those who gave their comments. Any further comments and suggestions are welcomed.

The code produces graphic images for artistic or entertaining purposes from numerical models.
It is based on the "Shaded/Contourplot for Artists" routine, which was reworked and extended
to a practical applicaton. With the code comes a manual describing all background involved.
A separate file with 10 example models is also added.

Arie Verheul

--------------------------------------------------------------

Below is the content of three files :

1. File with LapGraph code
2. File with demonstration models, to be saved as LapGraph.txt
3. Manual

--------------------------------------------------------------

This is the LapGraph code


Code:
 
'  ---------------------------------------------------------------------------
 
'  Laplacian Graphics - Arie Verheul - Version 1.1 - januari 2009
 
#Compiler PBCC
#Compile Exe
#Dim All
#Break On                ' Remove this line for use with PBCC 4
 
' ---------------------------------------------------------------------------
    ' Program messages
 
    $Error               = "Error(s) in model"
    $IrregularModelName  = "  Correct format is        : Model, Name"
    $Unrecognised        = "  What do yo mean ?        :  "
    $PointArgCountError  = "  3 parameters are needed  :  "
    $LineArgCountError   = "  6 parameters are needed  :  "
    $PointOutOfBounds    = "  Point offscreen          :  "
    $ZeroLengthLine      = "  Line has zero length     :  "
    $Continue            = "  Continue anyway ? (Y/N)  :  "
    $ProgramAborted      = "  Program will terminate"
    $ProgramContinues    = "  Program will continue with model error"
    $Saved               = "Saved to: "
    $Hint                = "Use in Graphic mode:   Space  to pause  program   -   Left Mouse for Menu"
 
    $ModelFile           = "LapGraph.txt"
    $SaveParms           = "LapGraph.bin"
    $ProgramName         = "  Laplacian Graphics"
    $Author              = " - ver 1.1 - Arie Verheul 2008 - Public Domain Software"
 
' ---------------------------------------------------------------------------
    ' Program equates
 
    %NumIntX             = 120
    %NumIntY             =  90
    %PlotRange           = 100
    %ModNameLength       =  16
 
    %ConsFClr            =  10   ' Console colors
    %ConsHiClr           =  15
    %ConsBClr            =   0
 
    %MaxNumZones         = 999   ' Maximum allowed parameter values
    %MaXWhiteContent     =  99
    %MaxSeparation       =  99
    %MaxSleepTime        = 9999
 
    %Menu1Col            = 2     ' Menu positions
    %Menu2Col            = 20
    %Menu3Col            = 38
    %CaptionLen          = 16
    %InputPos            = 28
 
    %ModNameRow          = 2
    %UniBrightnessRow    = 12
    %NumZonesRow         = 16
    %SeparationRow       = 18
    %WhiteContentRow     = 20
    %UpdateTimeRow       = 22
 
' ---------------------------------------------------------------------------
    ' ProgramStatus bit index
 
    %ModelSelected       =   1
    %ModelLoaded         =   2
    %ModelError          =  16
    %MenuHidden          =  20
    %ProgramPaused       =  29
    %ProgramInterrupted  =  30
    %ProgramAborted      =  31
 
' ---------------------------------------------------------------------------
Type ContourParmset          ' Variable to store plot settings
 
    NumZones        As Word  ' Number of zones in pos. and neg. half of range
 
    DiceMode        As Word  ' Mode 1 = pseudo random 3 color
                             ' Mode 2 = pseudo random 2 color (saturated)
                             ' Mode 3 = R + G only
                             ' Mode 4 = R + B only
                             ' Mode 5 = B + G only
 
    UniBrightness   As Word  ' On/off switch for uniform uniform brightness
 
    WhiteContent    As Word  ' Specifies amount of white in pastel colors
 
    MapMode         As Word  ' Specifies relation of colors in pos. and neg. zones
                             ' Mode 1 = Complementary
                             ' Mode 2 = Rotate right
                             ' Mode 3 = Rotate left
                             ' Mode 4 = Swap R <> G
                             ' Mode 5 = Swap R <> B
                             ' Mode 6 = Swap B <> G
                             ' Mode 7 = Independent
 
    Interlacing     As Word  ' Specifies interlacing
                             ' Mode 1 = Every zone
                             ' Mode 2 = Every 2nd zone
                             ' Mode 3 = Every 3rd zone
                             ' Mode 4 = Every 4th zone
                             ' Mode 5 = Every 6th zone
                             ' Mode 6 = Every 12th zone
 
    Separation      As Word  ' Specifies area around zero to skip
    SleepTime       As Word
    GraphicBGCol    As Long
End Type
 
' ---------------------------------------------------------------------------
Type CHOOSECOLORAPI          ' Variable for Windows color dialog box
 
    lStructSize     As Long
    hwndOwner       As Dword
    hInstance       As Dword
    rgbResult       As Long
    lpCustColors    As Long Ptr
    Flags           As Dword
    lCustData       As Long
    lpfnHook        As Dword
    lpTemplateName  As Asciiz Ptr
End Type
 
' ---------------------------------------------------------------------------
' Sub and function declarations
 
Declare Sub         DisplayMenu     (Action () As Byte)
Declare Sub         MainMenu
Declare Sub         HighlightSelection
Declare Function    SelectModel     As String
Declare Sub         LoadModel
Declare Sub         FiniteDifference
Declare Sub         MapArrayToWindow
Declare Sub         ColorPlot
Declare Sub         EstablishColors (PositiveShade As Long, NegativeShade As Long)
Declare Sub         ColorDice       (RGB_() As Integer)
Declare Sub         UniformBrightness (RGB_() As Integer)
Declare Sub         SetGraphicWindow
Declare Sub         SetBGColor
Declare Sub         ViewModel
Declare Sub         SetConsole      (ConsType As Long)
Declare Function    IntegerInput    (NumDigits As Long) As Long
Declare Function    ExePath          As String
Declare Sub         UpdatePParms    (ByVal Modus As Asciiz*2)
Declare Sub         ProgramReset
Declare Sub         ErrorHandler    (ErrorReport As String)
Declare Sub         SaveToBitMap
Declare Sub         TextBox         (Caption As String, VertPos As Long)
Declare Sub         SetToTop        (hTopWin As Dword)
Declare Sub         Process_Windows_Message( ByVal hWnd As Dword, ByVal wMsg As Dword,_
                                          ByVal wParam As Dword, ByVal lParam As Long)
 
' ---------------------------------------------------------------------------
' Windows API declarations
 
Declare Function CallWindowProc Lib "USER32.DLL" Alias "CallWindowProcA" (_
                         ByVal lpPrevWndFunc As Dword,_
                         ByVal hWnd As Dword,_
                         ByVal uMsg As Dword,_
                         ByVal wParam As Dword,_
                         ByVal lParam As Long) As Long
 
Declare Function ChooseColor Lib "COMDLG32.DLL" Alias "ChooseColorA"(_
                         lpcc As CHOOSECOLORAPI) As Long
 
Declare Function DeleteMenu Lib "USER32.DLL" Alias "DeleteMenu"(_
                         ByVal hMenu As Dword,_
                         ByVal nPosition As Long,_
                         ByVal wFlags As Dword) As Long
 
Declare Function GetModuleFileName Lib "KERNEL32.DLL" Alias "GetModuleFileNameA"(_
                         ByVal hModule As Dword,_
                               lpFileName As Asciiz,_
                         ByVal nSize As Dword) As Dword
 
Declare Function GetSystemMenu Lib "USER32.DLL" Alias "GetSystemMenu"(_
                         ByVal hWnd As Dword,_
                         ByVal bRevert As Long) As Long
 
Declare Function GetWindow Lib "USER32.DLL" Alias "GetWindow" (_
                         ByVal hWnd As Dword,_
                         ByVal wCmd As Dword) As Long
 
Declare Function IsWindow Lib "USER32.DLL" Alias "IsWindow" (ByVal hWnd As Dword) As Long
 
Declare Function SetForegroundWindow Lib "USER32.DLL" Alias "SetForegroundWindow" (_
                         ByVal hWnd As Dword) As Long
 
Declare Function SetWindowLong Lib "USER32.DLL" Alias "SetWindowLongA" (_
                         ByVal hWnd As Dword,_
                         ByVal nIndex As Long,_
                         ByVal lNewLong As Long) As Long
 
Declare Function SetWindowPos Lib "USER32.DLL" Alias "SetWindowPos" (_
                         ByVal hWnd As Dword, ByVal hWndInsertAfter As Dword,_
                         ByVal x As Long, ByVal y As Long, ByVal cx As Long,_
                         ByVal cy As Long, ByVal wFlags As Dword) As Long
 
Declare Function ShowWindow Lib "USER32.DLL" Alias "ShowWindow"(_
                         ByVal hWnd As Dword,_
                         ByVal nCmdShow As Long) As Long
' ---------------------------------------------------------------------------
    ' Windows API equates
 
    %sc_minimize         = &HF020
    %sc_restore          = &HF120
    %wm_destroy          = &H2
    %GW_CHILD            =  5
    %GWL_WNDPROC         = -4
    %wm_lbuttondown      = &H201
    %wm_char             = &H102
    %wm_destroy          =  2
    %CC_RGBINIT          =  1
    %cc_fullopen         =  2
    %HWND_TOPMOST        = &HFFFFFFFF
    %HWND_NOTOPMOST      = &HFFFFFFFE
    %SWP_NOSIZE          = &H1
    %SWP_NOMOVE          = &H2
    %SWP_SHOWWINDOW      = &H40
 
' ---------------------------------------------------------------------------
 
Function PBMain () As Long
 
    Local WinWidth, WinHeight As Long
 
    Dim PParms         As Global ContourParmset
    Dim hWnd           As Global Dword
    Dim OldProc        As Global Long
    Dim ProgramStatus  As Global Dword
    Dim ModelName      As Global String * %ModNameLength
 
    SetGraphicWindow
 
    Graphic Get Client To WinWidth, WinHeight
 
    Dim PlotArray   (%NumIntX, %NumIntY)                     As Global Single
    Dim Boundary    (Ceil(%NumIntX + 1)*(%NumIntY + 1) / 32) As Global Dword
    Dim ScreenArray (1 To WinWidth, 1 To WinHeight)          As Global Integer
 
    TextBox  $ProgramName + $Author, 50
    TextBox  $Hint, WinHeight - 90
 
    UpdatePParms "L"
    MainMenu
 
End Function
 
' ---------------------------------------------------------------------------
 
Sub DisplayMenu (Action () As Byte)
 
    ' Prints menu captions
 
    Local N, MenuLength, Row, Col As Long
 
    SetConsole 1
 
    MenuLength = IIf(Bit(ProgramStatus, %ModelLoaded), DataCount, DataCount - 24)
 
    ' Display 'Paint' through 'Save to BMP' captions only after model has been loaded
 
    For N = 1 To MenuLength  Step 4            ' Print menu captions
 
        Row = Val(Read$(N))
        Col = Val(Read$(N + 1))
 
        Action(Col, Row) = Val(Read$(N + 2))   ' Action() stores indices of actions
                                               ' associated with captions
 
        Col = Choose&(Val(Read$(N + 1)),%Menu1Col,%Menu2Col,%Menu3Col)
 
        If Read$(N + 3) <> "" Then
            Locate Row, Col
            Print Chr$(219,32) + Read$(N + 3);
        End If
    Next N
 
    For N = 1 To 8                                   ' Print separation lines
 
        Locate Choose&(N,3,5,13,15,17,19,21,23), 1
        Print String$(56,196)
    Next N
 
    Locate 11,2: Print String$(%CaptionLen + 1,196)  ' And one more separation
 
Exit Sub
 
' ---------------------------------------------------------------------------
 
' Menu captions may be changed, provided that new captions do not exceed %CaptionLen.
' Button type captions may simply be deleted from the list, if desired.
 
' Row, MenuColumn, Action, Caption
 
Data  2, 1, 1,  "Select Model"
' row stored in %ModNameRow
 
Data  4, 1, 0,  "COLOR"
 
Data  6, 1, 11, "Random 3 color"
Data  7, 1, 12, "Saturated"
Data  8, 1, 13, "Red  + Green"
Data  9, 1, 14, "Red  + Blue"
Data 10, 1, 15, "Blue + Green"
 
Data 12, 1, 19, "Uni Brightness"
' row stored in %UniBrightnessRow
 
 
Data  4, 2, 0,  "COMPOSITION"
 
Data  6, 2, 21, "Complementary"
Data  7, 2, 22, "Rotate right"
Data  8, 2, 23, "Rotate left"
Data  9, 2, 24, "Swap R <> G"
Data 10, 2, 25, "Swap R <> B"
Data 11, 2, 26, "Swap B <> G"
Data 12, 2, 27, "Independent"
 
Data  4, 3,  0, "SPACING"
 
Data  6, 3, 31, "Every zone"
Data  7, 3, 32, "Every  2nd zone"
Data  8, 3, 33, "Every  3rd zone"
Data  9, 3, 34, "Every  4th zone"
Data 10, 3, 35, "Every  6th zone"
Data 11, 3, 36, "Every 12th zone"
 
' The following four items stretch over two columns and are therefore registered in both
' When moving these items change both DATA statements and equates
 
Data 16, 1, 41, "Number of zones"
Data 16, 2, 41, ""
' row stored in %NumZonesRow
 
Data 18, 1, 42, "Separation (%)"
Data 18, 2, 42, ""
' row stored in %SeparationRow
 
Data 20, 1, 43, "Pastel white content"
Data 20, 2, 43, ""
' row stored %WhiteContentRow
 
Data 22, 1, 44, "Update time (ms)"
Data 22, 2, 44, ""
' row stored in %UpdateTimeRow
 
' The following six items are only to be displayed if model is loaded
' and must therefore remain at the end of the list
 
Data 14, 3, 51, "Paint"
Data 16, 3, 49, "Set BG Color"
Data 18, 3, 53, "Clear Window"
Data 20, 3,255, "Hide Menu"
Data 22, 3, 52, "View model"
Data 24, 3, 54, "Save to BMP"
 
End Sub
 
' ---------------------------------------------------------------------------
 
Sub MainMenu
 
    ' Handles menu actions
 
    Local M, N, MenuAction As Byte
    Local ForeGroundWindow As Dword
    Local KeyVal As String
    Dim   Action (1 To 3, 1 To 25) As Byte
 
    DisplayMenu Action()
 
    Do
        HighlightSelection
        Do
 
            MenuAction = 0
 
            ForeGroundWindow = IIf(Bit(ProgramStatus,%MenuHidden),hWnd,ConsHndl)
 
            SetToTop ForeGroundWindow
 
            Do
                KeyVal = InKey$
                N = Len(KeyVal)
 
            Loop Until N = 4   ' Wait for mouseclick
 
            ' -----------------------------------------------------------------
            ' Determine MenuAction from MouseX and MouseY
 
            Select Case MouseX
 
                Case %Menu1Col + 2 To %Menu2Col - 2 : N = 1   ' First column
                Case %Menu2Col + 2 To %Menu3Col - 2 : N = 2   ' Second column
                Case > %Menu3Col + 1                : N = 3   ' Third column
            End Select
 
            MenuAction = Action(N, MouseY)
        Loop Until MenuAction
 
        ' ------------------------------------------------------------------
        ' Perform desired action
 
        Select Case MenuAction
 
            Case 1                          ' Select model
                ProgramReset
                LoadModel
                FiniteDifference
                DisplayMenu Action()
 
            Case 11 To 15                   ' Set Dice mode
                PParms.DiceMode = MenuAction - 10
 
            Case 19
                Bit Toggle PParms.UniBrightness, 1
 
            Case 21 To 27                   ' Set Map mode
                PParms.MapMode = MenuAction - 20
 
            Case 31 To 36                   ' Set Interlacing
                PParms.InterLacing = MenuAction - 30
 
            Case 41                         ' Set Number of zones
                Locate %NumZonesRow, %InputPos
                PParms.NumZones = IntegerInput(3)
 
            Case 42                         ' Set separation
                Locate %SeparationRow, %InputPos
                PParms.Separation = IntegerInput(2)
 
            Case 43                         ' Set Pastel White component
                Locate %WhiteContentRow, %InputPos
                PParms.WhiteContent = IntegerInput(2)
 
            Case 44                         ' Set Update time
                Locate %UpdateTimeRow, %InputPos
                PParms.SleepTime = IntegerInput(4)
 
            Case 49
                 SetToTop hWnd
                 SetBGColor                 ' Set BG color
 
            Case 51                         ' Paint
                 Bit Reset ProgramStatus, %ProgramInterrupted
                 MapArrayToWindow
                 SetToTop hWnd
                 ColorPlot
 
            Case 52                         ' View model
                ViewModel
                Graphic Attach hWnd,0       ' Return to main window
 
            Case 53                         ' Clear window
                Graphic Color 0, PParms.GraphicBGCol
                Graphic Clear
 
            Case 54 : SaveToBitMap
 
            Case 255                         ' Dummy loop to keep menu hidden
                Bit Set ProgramStatus, %MenuHidden
                SetToTop hWnd
                Do: Sleep 100: Loop Until IsFalse Bit(ProgramStatus, %MenuHidden)
 
        End Select
 
        UpdatePParms "S"
 
    Loop Until Bit(ProgramStatus,%ProgramAborted)
 
End Sub
 
' ---------------------------------------------------------------------------
 
Sub HighlightSelection
 
    ' Highlights selections in main menu, and prints values of settings
 
    Local N, M, MenuCol As Long
 
    For N = 6 To 14                            ' Remove previous highlights
        Locate N, 1
        Color %ConsFClr, %ConsBClr,56
    Next N
 
    For N = 1 To 3                             ' Make new highlights
 
        MenuCol = Choose&(N,%Menu1Col,%Menu2Col,%Menu3Col) + 2
 
        M = Choose&(N,PParms.DiceMode, PParms.MapMode, PParms.Interlacing) + 5
 
        Locate M, MenuCol
        Color %ConsHiClr, %ConsBClr,%CaptionLen
    Next N
 
    If PParms.UniBrightness Then               ' Treat uniform brightnes as a separate case
        Locate %UniBrightnessRow, %Menu1Col + 2
        Color %ConsHiClr, %ConsBClr,%CaptionLen
    End If
 
    ' ----------------------------------------------------------------------
 
    ' Print current PParms values
 
    Color %ConsHiClr, %ConsBClr
 
    Locate %NumZonesRow,     %InputPos: Print Using$(" #### ";PParms.NumZones)
    Locate %SeparationRow,   %InputPos: Print Using$(" #### ";PParms.Separation)
    Locate %WhiteContentRow, %InputPos: Print Using$(" #### ";PParms.WhiteContent)
    Locate %UpdateTimeRow,   %InputPos: Print Using$(" #### ";PParms.SleepTime)
 
    ' If model has been selected then print model name
 
    Locate %ModNameRow, %Menu2Col
 
    If Bit(ProgramStatus, %ModelSelected) Then
        Print ModelName;
    Else
        Print Spc(%ModNameLength);
    End If
 
    Color %ConsFClr, %ConsBClr
 
End Sub
 
' ---------------------------------------------------------------------------
 
Function SelectModel As String
 
    ' Reads the model file and selects one model from it
 
    Local I, J, ModelCount, LineCount As Long
    Local A_String, B_String, ErrorReport  As String
 
    ' ---------------------------------------------------------------------------
 
    Open ExePath + $ModelFile For Binary As #0  ' Load model file into string
        Get$ 0, Lof(0), A_String
    Close #0
 
    ' ---------------------------------------------------------------------------
    ' Organise model data
 
    LineCount = ParseCount (A_String, Chr$(13,10))
 
    Dim Model(LineCount) As String              ' Determine number of lines
 
    Parse A_String, Model(), Chr$(13,10)        ' Parse buffer into lines to array Model()
 
    For I = 0 To LineCount                      ' Remove comment
        Model(I) = Extract$(Model(I), "'")
    Next I
 
    A_String = Join$(Model(),Chr$(13,10))       ' Join the result back to A_String
 
    B_String = MCase$ (A_String)                ' Convert to mixed case
    A_String = Remove$(B_String, Chr$(32))      ' Remove spaces
    B_String = Remove$(A_String, Chr$(10,13))   ' Remove empty lines
    A_String = Remove$(B_String, Chr$(10))      ' Remove Line feeds
 
    ' Model data is now organised
 
    ' ---------------------------------------------------------------------------
 
    ' Determine number of models in model file
 
    ModelCount = Tally(A_String, "Model")
 
    If Tally(A_String, "Model,") <> ModelCount Then ' Check for presence of comma
 
        ErrorReport = $IrregularModelName
        Errorhandler ErrorReport
    End If
 
    If Bit(ProgramStatus, %ProgramInterrupted) Then Function = "": Exit Function
 
    SetConsole 2
    Console Name "Select Model"
    If ModelCount > 30 Then Console Set Virtual  ModelCount, %ModNameLength
 
    ' If list does not fit in window, then make window scrollable
 
    ' ---------------------------------------------------------------------------
 
    ReDim Model(ModelCount) As String
 
    Parse A_String, Model(), "Model,"
 
    ' This results in an array of strings, each containing one model description
 
    For J = 1 To ModelCount    ' Extract and print model names
        Locate J,1
        Print Chr$ (254,32) + Extract$(Model(J),Chr$(13))
    Next J
 
    Console Set View 1, 1      ' Set to top if list higher than window
 
    Do : Loop Until Len(WaitKey$) = 4  And MouseY <= ModelCount ' Wait for mouse click
 
    Locate MouseY, 2
    Color %ConsHiClr, %ConsBClr, %ModNameLength             ' Highligth selection
 
    Function = Model(MouseY)                                ' Extract selected model
 
    ' Selected model has been extracted
 
End Function
 
' ---------------------------------------------------------------------------
 
Sub LoadModel
 
    Local I, J, M, N, X1, Y1, X2, Y2 As Long
    Local A, B, V1, V2 As Single
    Local ModelBuffer, ErrorReport As String
 
    ' ---------------------------------------------------------------------------
 
    ' Boundary points must be left untouched by Finite difference algorithm
    ' Therefore all Boundary points are marked in bitarray Boundary(0)
 
    For J = 0 To %NumIntX               ' Mark boundary points along the edges
 
        For I = 1 To 4
 
            M = Choose&(I, 0, J, %NumIntY, J)
            N = Choose&(I, J, 0, J, %NumIntX)
 
            If M > %NumIntY Then Iterate For
 
            Bit Set Boundary(0), (120 * M + N)
        Next I
    Next J
 
    ' ---------------------------------------------------------------------------
 
    ModelBuffer = SelectModel                  ' Call Selectmodel to get a model
 
    I = ParseCount (ModelBuffer, $Cr)          ' Parse model into lines
 
    Decr I                                     ' Use zero based array
 
    Dim Model(I) As String                     ' Dim array to store parsed elements
 
    Parse ModelBuffer, Model(), $Cr
 
    ModelName = Model(0)
 
    Bit Set ProgramStatus, %ModelSelected
 
    ' ---------------------------------------------------------------------------
 
    ' This section parses statements, checks them and enters values
    ' Any error reports are written to string ErrorReport
 
    For J = 1 To I                             ' Extract statements
 
        If Model(J) = "" Then Iterate For      ' Last element may be empty
 
        Select Case Parse$(Model(J),1)         ' ... and process parameters
 
            ' ---------------------------------------------------------------
 
            Case "Point"
 
                If ParseCount(Model(J)) <> 4 Then   ' Report incorrect statement
 
                    Bit Set ProgramStatus, %ModelError
                    ErrorReport = ErrorReport + $PointArgCountError + Model(J) +$CrLf
                    Iterate For
                End If
 
                N  = Val(Parse$(Model(J),2))
 
                M  = Val(Parse$(Model(J),3))
 
                V1 = Val(Parse$(Model(J),4))
 
                If N >= 0 And N <= %NumIntX And _          ' Check for off screen
                   M >= 0 And M <= %NumIntY Then
 
                    PlotArray(N, M) = V1                   ' Assign value
                    Bit Set Boundary(0), (120 * M + N)     ' Mark boundary point
                Else
                    Bit Set ProgramStatus, %ModelError
                    ErrorReport = ErrorReport + $PointOutOfBounds + Model(J) + $CrLf
                End If
 
            ' ---------------------------------------------------------------
 
            Case "Line"
 
                If ParseCount(Model(J)) <> 7 Then   ' Report incorrect statement
 
                    Bit Set ProgramStatus, %ModelError
                    ErrorReport = ErrorReport + $LineArgCountError + Model(J) + $CrLf
                    Iterate For
                End If
 
                X1 = Val(Parse$(Model(J),2))   ' Read first endpoint
 
                Y1 = Val(Parse$(Model(J),3))
 
                V1 = Val(Parse$(Model(J),4))
 
                X2 = Val(Parse$(Model(J),5))   ' Read second endpoint
 
                Y2 = Val(Parse$(Model(J),6))
 
                V2 = Val(Parse$(Model(J),7))
 
                If X1 = X2 And Y1 = Y2 Then    ' Zero length
 
                    Bit Set ProgramStatus, %ModelError
                    ErrorReport = ErrorReport + $ZeroLengthLine + Model(J)  + $CrLf
                    Iterate For
                End If
 
                If Abs(X2 - X1) > Abs(Y2 - Y1) Then ' Line is prevailing horizontal
 
                    A = (Y2 - Y1) / (X2 - X1)       ' Calculate slope of line
                    B = (V2 - V1) / (X2 - X1)       ' with respect to hor. axis
 
                    For N = X1 To X2 Step Sgn (X2 - X1)
 
                        M = Y1 + A * (N - X1)       ' Calculate vert. position of point
 
                        If N < 0 Or N > %NumIntX Or _
                           M < 0 Or M > %NumIntY Then Iterate For
 
                        PlotArray (N,M) = V1 + B * (N - X1) ' Calculate value for point
                        Bit Set Boundary(0), (120 * M + N)  ' Mark boundary point
                    Next N
 
                Else                                ' Line is prevailing vertical
                    A = (X2 - X1) / (Y2 - Y1)       ' Calculate slope of line
                    B = (V2 - V1) / (Y2 - Y1)       ' with respect to vert. axis
 
                    For M = Y1 To Y2 Step Sgn (Y2 - Y1)
 
                        N = X1 + A * (M - Y1)       ' Calculate hor. position of point
 
                        If N < 0 Or N > %NumIntX Or _
                           M < 0 Or M > %NumIntY Then Iterate For
 
                        PlotArray (N,M) = V1 + B * (M - Y1) ' Calculate value for point
                        Bit Set Boundary(0), (120 * M + N)  ' Mark boundary point
                    Next M
                End If
 
            ' ---------------------------------------------------------------
 
            Case Else                               ' Unrecognised statement
                Bit Set ProgramStatus, %ModelError
                ErrorReport = ErrorReport + $Unrecognised + Model(J) + $CrLf
            End Select
    Next J
 
    If Bit(ProgramStatus, %ModelError) Then ErrorHandler ErrorReport
 
End Sub
 
' ---------------------------------------------------------------------------
 
Sub FiniteDifference ()
 
' This is the Finite Difference algortithm
 
    Local K, N, M, I As Long
 
    For I = 1 To 2000                   ' Iterations
        For M = 1 To %NumIntY - 1       ' Vert. direction
            For N = 1 To %NumIntX - 1   ' Hor. direction
 
                K = 120 * M + N
                If Bit (Boundary(0),K) Then Iterate For
 
                PlotArray(N,M) = (PlotArray(N-1,M) + PlotArray(N+1,M)_
                                 + PlotArray(N,M-1) + PlotArray(N,M+1)) / 4
            Next N
        Next M
    Next I
 
    Bit Set ProgramStatus, %ModelLoaded
End Sub
 
' ---------------------------------------------------------------------------
 
Sub MapArrayToWindow
 
    ' This sub calculates linearly interpolated values from the PlotArray() grid
    ' for each pixel in ScreenArray()
 
    ' Note: in the following the rectangular area enclosed by
    ' four neighbouring gridpoints is designated as an element
 
    Local WinWidth, WinHeight As Long
    Local Xmax, Ymax As Long
    Local ColorIndex, ColorScaleUBound, ColorScaleLBound As Long
    Local I, ElementRow, Pix, PixRow, ArrayRow, CurrentRow As Long
    Local X, PixRowPos, VertIntFactor, CalibrationFactor As Single
 
    Xmax                =  %NumIntX
    Ymax                =  %NumIntY
 
    WinWidth            =  UBound(ScreenArray(),1)
    WinHeight           =  UBound(ScreenArray(),2)
 
    CalibrationFactor   =  PParms.NumZones / %PlotRange
    ColorScaleUBound    =  PParms.NumZones
    ColorScaleLBound    = -PParms.NumZones
 
    ' ---------------------------------------------------------------------------
 
    Dim TopRow(Xmax)            As Single    ' Top nodes of current element row
    Dim BotRow(Xmax)            As Single   ' Bottom nodes of current element row
    Dim RowDiff(Xmax)           As Single   ' Differential (TopRow() - BotRow)
    Dim InterpRow(Xmax)         As Single   ' Interpolated values for position of pixel row
    Dim ElDiff(Xmax - 1)        As Single   ' Hor. differential in InterpRow()
    Dim HorIntNumber (WinWidth) As Long     ' Element to use for interpolation for specific pixel
    Dim HorIntFactor (WinWidth) As Single   ' Interpolation factor for specific pixel
 
    ' ---------------------------------------------------------------------------
    ' Make tables for pixel locations and interpolation factors in element grid coordinates
    ' in horizontal direction; these tables are valid for each row of pixels.
 
    For Pix = 1 To WinWidth             ' For each pixel in horizontal row
 
        X = Pix * Xmax / WinWidth       ' > Pixel position in element grid coordinates
        HorIntNumber (Pix) = Int  (X)   ' > Element where pixel is located
        HorIntFactor (Pix) = Frac (X)   ' > Interpolation factor within element
    Next  Pix
 
    ' ---------------------------------------------------------------------------
    ' Do the actual interpolation, working row by row
 
    CurrentRow = -1                   ' Pointer to keep track of current element row
 
    ArrayRow = WinHeight              ' Position in ScreenArray() :
                                      ' As PlotArray() has origin at left-bottom,
                                      ' ScreenArray() has origin at left top,
                                      ' so while PixRow goes up, ArrayRow goes down
 
    For PixRow = 0 To WinHeight - 1               ' Work row by row
 
        ' Note : PixRowPos may under no circumstance be outside the domain.
 
       PixRowPos = Ymax*(PixRow + .5) / WinHeight ' Vertical position of pixel row
                                                  ' in element grid coordinates
 
        ElementRow    = Int  (PixRowPos)          ' Element row to use for interpolation
        VertIntFactor = Frac (PixRowPos)          ' Interpolation factor
 
        If ElementRow <> CurrentRow Then          ' If interpolation has reached next
                                                  ' element row then data must be refreshed
 
            ' Full row of data is extracted from PlotArray() by placing 1D array on top
            ' Using MAT these data are manipulated row by row
 
            ReDim TopRow(Xmax) As Single At VarPtr (PlotArray(0, ElementRow + 1))
            ReDim BotRow(Xmax) As Single At VarPtr (PlotArray(0, ElementRow))
 
            Mat   RowDiff() = TopRow() - BotRow()    ' Vertical differentials
 
            CurrentRow = ElementRow
        End If
 
        Mat    InterpRow () = (VertIntFactor) * RowDiff()
        Mat    InterpRow () = BotRow() + InterpRow()
 
        ' InterpRow() now contains an interpolated row of data from PlotArray()
        ' at PixRowPos, the position of the row of pixels that is treated currently.
 
    ' ---------------------------------------------------------------------------
        ' Next within this row the differentials are calculated, and stored in ElDiff()
 
        For I = 0 To Xmax - 1           ' Horizontal differential in InterpRow()
 
            ElDiff(I) = InterpRow(I + 1) - InterpRow(I)
        Next I
 
    ' ---------------------------------------------------------------------------
        ' From InterpRow() and ElDiff() the values for each pixel are calculated
 
        For Pix = 1 To WinWidth      ' Work along a row of pixels
 
            I = HorIntNumber(Pix)    ' Element where pixel is located
 
            ColorIndex = (CalibrationFactor * (InterpRow(I) + ElDiff(I) * HorIntFactor(Pix)))
 
            ColorIndex = Min(ColorIndex, ColorScaleUBound)  ' overflow check
            ColorIndex = Max(ColorIndex, ColorScaleLBound)
 
            ScreenArray(Pix, ArrayRow) = ColorIndex
        Next Pix
 
        Decr ArrayRow
    Next PixRow
 
End Sub
 
' ---------------------------------------------------------------------------
 
Sub ColorPlot ()
 
    ' This sub translates values associated with pixels into shades
 
    Local I, N As Long
    Local ColorIndex, ColorScaleUBound, ColorScaleLBound As Long
    Local Separation, InterLacing, PositiveShade, NegativeShade As Long
    Local WindowImage As String
 
    Dim   PixelPtr As Long Pointer
    Dim   MapPtr   As Integer Pointer
 
    ColorScaleUBound =  PParms.NumZones
    ColorScaleLBound = -PParms.NumZones
 
    Separation       = PParms.Separation * ColorScaleUBound / 100
    InterLacing      = Choose&(PParms.Interlacing,5,2,3,4,6,0)
 
    SetGraphicWindow
 
    ' ---------------------------------------------------------------------------
    ' Note: GRAPHIC GET BITS / GRAPHIC SET BITS is used here
    ' because it is much faster than GRAPHIC SET PIXEL
 
     Graphic Get Bits To WindowImage       ' Get copy of video memory
 
    ' ---------------------------------------------------------------------------
 
    N = Rnd(-Timer)                   ' Random seed
 
    I = 0
 
    Do
        I = I Mod 12                  ' I walks through values 0 to 11, in a way
                                      ' determined by Interlacing parameter
 
   '    For ColorIndex = Separation + I To ColorScaleUBound Step 12     ' Work upwards
                                                                        ' or
        For ColorIndex = ColorScaleUBound - I To Separation Step -12    ' Work downwards
 
            While Bit(ProgramStatus, %ProgramPaused)    ' When paused program rests here
                Sleep 100
            Wend
 
            EstablishColors PositiveShade, NegativeShade
 
            PixelPtr = StrPtr(WindowImage) + 8          ' First two Long Int. contain size
 
            MapPtr   = VarPtr (ScreenArray(1,1))
 
            ' Work zone by zone, this is programmatically inefficient,
            ' but looks much better than updating a full screen at the time
 
            For N = 1 To (Len(WindowImage) - 8) / 4     ' = WinWidth*WinHeight
 
                ' Check for each element in ScreenArray() if it is in one of the
                ' two current zones, and write corresponding color to WindowImage
 
                If @MapPtr =  Colorindex Then @PixelPtr = PositiveShade                     '
                If @MapPtr = -Colorindex Then @PixelPtr = NegativeShade
 
                Incr PixelPtr
                Incr MapPtr
            Next N
 
            Graphic Set Bits WindowImage         ' Put modified WindowImage back
 
            For N = 1 To PParms.SleepTime / 100  ' Sleep, but wake up every now
                                                 ' and then to check for key press
                Sleep 100
                If Bit(ProgramStatus, %ProgramInterrupted) Then Exit For
            Next N
 
        Next ColorIndex
 
        I = I + Interlacing
 
    Loop Until Bit(ProgramStatus, %ProgramInterrupted)
 
End Sub
 
' ---------------------------------------------------------------------------------
 
Sub EstablishColors (PositiveShade As Long, NegativeShade As Long)
 
    ' Determines values for positive and negative colors according to settings
 
 
    Local K As Long
    Dim RGB_(2) As Integer
 
    ColorDice RGB_()
 
    PositiveShade = RGB(RGB_(2),RGB_(1),RGB_(0))
 
    Select Case PParms.MapMode  ' Determines how positive and negative colors are related
 
        Case 1                                                      ' Complementary
 
            For K = 0 To 2 : RGB_(K) = 255 - RGB_(K): Next K
            If PParms.UniBrightness Then UniformBrightness RGB_()
            NegativeShade = RGB(RGB_(2),RGB_(1),RGB_(0))
 
        Case 2 : NegativeShade = RGB(RGB_(1),RGB_(0),RGB_(2))       ' Rotate right
 
        Case 3 : NegativeShade = RGB(RGB_(0),RGB_(2),RGB_(1))       ' Rotate right
 
        Case 4 : NegativeShade = RGB(RGB_(2),RGB_(0),RGB_(1))       ' Swap Red and Green
 
        Case 5 : NegativeShade = RGB(RGB_(0),RGB_(1),RGB_(2))       ' Swap Red and Blue
 
        Case 6 : NegativeShade = RGB(RGB_(1),RGB_(2),RGB_(0))       ' Swap Blue and Green
 
        Case 7 : ColorDice RGB_(): NegativeShade = RGB(RGB_(2),RGB_(1),RGB_(0))
 
    End Select
End Sub
 
' ---------------------------------------------------------------------------------
 
Sub ColorDice (RGB_() As Integer)
 
    Local K As Long
 
    ' Mode 1 = pseudo random 3 color
    ' Mode 2 = pseudo random 2 color (saturated)
    ' Mode 3 = R + G only
    ' Mode 4 = R + B only
    ' Mode 5 = B + G only
 
    For K = 0 To 2
        RGB_(K) = Rnd(PParms.WhiteContent,255)
    Next K
 
    If PParms.DiceMode > 1 Then            ' Eliminate one of the components
 
        K = Choose&(PParms.DiceMode,0,Rnd(0,2),2,1,0)
 
        RGB_(K) = PParms.WhiteContent
    End If
 
    ' Adjust brightness to 255, if selected
 
    If PParms.UniBrightness Then UniformBrightness RGB_()
 
End Sub
 
' ---------------------------------------------------------------------------------
 
Sub UniformBrightness (RGB_() As Integer)
 
    Local Brightness As Single
 
        Brightness = Sqr(RGB_(0)^2 + RGB_(1)^2 + RGB_(2)^2)
 
        Brightness = 255 / Brightness
 
        Mat RGB_() = (Brightness) * RGB_()
 
End Sub
 
' ---------------------------------------------------------------------------------
 
Sub SetGraphicWindow
 
    Local ClientX, ClientY, WinWidth, WinHeight As Long
    Local hStatic As Dword
 
    If IsFalse IsWindow(hWnd) Then        ' If window does not already exist
 
        Desktop Get Client To WinWidth, WinHeight
        Desktop Get Loc    To ClientX,  ClientY
 
        WinWidth  = WinWidth  - 2         ' Allow for border line
        WinHeight = WinHeight - 2
 
        Graphic Window "", ClientX, ClientY, WinWidth, WinHeight To hWnd
 
        Graphic Attach hWnd, 0
        Graphic Color  -1, PParms.GraphicBGCol
        Graphic Clear
 
        ' Subclass window to capture keyboard and mouse input
 
        hStatic = GetWindow(hWnd, %GW_CHILD)
 
        OldProc = SetWindowLong(hStatic, %GWL_WNDPROC, CodePtr(Process_Windows_Message))
    End If
 
    Graphic Set Focus
 
End Sub
 
' -------------------------------------------------------------------------------
 
Sub SetBGColor
 
    Dim   CustomColors(15)       As Static Long
    Dim   PixelPtr               As Long Pointer
    Local lpcc                   As ChooseColorAPI
    Local OldColor, NewColor, N  As Long
    Local WindowImage            As String
 
    ' Set ChooseColorAPI variable
 
    lpcc.hwndOwner    = hWnd
    lpcc.lpCustColors = VarPtr(CustomColors(0))
    lpcc.lStructSize  = SizeOf (lpcc)
    lpcc.flags        = %CC_RGBINIT Or %cc_fullopen
    lpcc.rgbResult    = PParms.GraphicBGCol        ' Initialise ChooseColor
 
    Graphic Set Focus
 
    If IsFalse ChooseColor (lpcc) Then Exit Sub    ' ChooseColor aborted
 
    OldColor            = Bgr(PParms.GraphicBGCol)
    NewColor            = Bgr(lpcc.rgbResult)      ' RGB format produces BGR data
 
    PParms.GraphicBGCol = lpcc.rgbResult           ' Store result
 
    Graphic Get Bits To WindowImage                ' Get copy of video memory
 
    PixelPtr = StrPtr(WindowImage) + 8             ' First two Long Int. contain size
 
    For N = 1 To (Len(WindowImage) - 8) / 4
 
        If @PixelPtr = OldColor Then @PixelPtr = NewColor
        Incr PixelPtr
    Next N
 
    Graphic Set Bits WindowImage                   ' Put updated window map back
 
End Sub
 
' ---------------------------------------------------------------------------
 
Sub  ViewModel
 
Local M, N, ColorToUse As Long
Local hViewer As Dword
 
    Desktop Get Client To N, M
 
    N = (N - 800)/2     ' Center window on screen
    M = (M - 630)/2
 
    Graphic Window "Model Viewer : " + ModelName,N,M,800,600 To hViewer
 
    Graphic Attach hViewer,0, ReDraw
    Graphic Scale (-1, %NumIntY + 1)-(%NumIntX + 1, -1)
    Graphic Color -1, %black
    Graphic Clear
 
    SetToTop hViewer
    DeleteMenu GetSystemMenu(hViewer, 0), %sc_minimize, 0   ' Turn minimize button off
 
    For N = 0 To %NumIntX                                   ' Draw grid
 
        ColorToUse = IIf(N Mod 10, &H003200, &H004800)      ' Highlight every 10th grid line
 
        Graphic Line (N,0)-(N,%NumIntY), ColorToUse
 
        If N <= %NumIntY Then Graphic Line (0,N)-(%NumIntX,N), ColorToUse
    Next N
 
    For M = 0 To %NumIntY                               ' Plot boundary points
        For N = 0 To %NumIntX
 
            If Bit (Boundary(0), (120 * M + N)) Then
 
                ColorToUse = Choose&(2 + Sgn(PlotArray(N,M)), &HFF4000, &HA0A0A0, &H0040FF)
                Graphic Ellipse (N - .4, M + .5)-(N + .6, M - .6), ColorToUse, ColorToUse
            End If
        Next N
    Next M
 
    Graphic ReDraw
 
    While IsWindow(hViewer)     ' Wait until window is closed
        Sleep 100
    Wend
 
End Sub
 
' ---------------------------------------------------------------------------------
 
Sub SetConsole(ConsType As Long)
 
    Local Rows, Cols, Hcon, Wcon, WinWidth, WinHeight As Long
    Local FColor, Bcolor As Byte
 
    Desktop Get Client To WinWidth, WinHeight
 
    Rows = Choose&(ConsType,25,30,25)
    Cols = Choose&(ConsType,56,%ModNameLength + 3,80)
 
    Console Set Screen Rows, Cols
    Console Get Size To Hcon, Wcon                          ' Console size in pixels
    Console Name $ProgramName
    ShowWindow ConsHndl, 3
    DeleteMenu GetSystemMenu(ConsHndl, 0), %sc_restore, 0   ' Turn icons off
    DeleteMenu GetSystemMenu(ConsHndl, 0), %sc_minimize, 0
    Console Set Loc (WinWidth - Hcon)/2, (WinHeight - Wcon)/2
    Color %ConsFClr, %ConsBClr
    Cursor Off
    Mouse On
    Mouse 1
 
    SetToTop ConsHndl
 
End Sub
 
' ---------------------------------------------------------------------------
 
Function IntegerInput (NumDigits As Long) As Long
 
    ' This function provides a controlled input for an integer with max. NumDigits
 
    Local KeyVal, AcceptedInput As String
    Local I, StartPos, ResultValue As Long
 
    StartPos = CursorX
 
    GoSub ReadValueFromScreen                         ' Save current value
 
    Color %ConsBClr, %ConsHiClr, 6                    ' Make input field
    Print String$(6,32);
    Locate ,StartPos + 1
 
 
    I = 1
                           ' Beyond NumDigits only Bsp, Enter and Esc are allowed
    Do
        AcceptedInput = IIf$(I > NumDigits, Chr$(8,13,27),Chr$(8,13,27,48 To 57))
 
        Do
            KeyVal = WaitKey$
            If Len(KeyVal) = 4 Then Keyval = Chr$(13) ' Leftmouse = Chr$(13)
        Loop Until InStr (AcceptedInput, KeyVal)
 
        Select Case Asc(KeyVal)
 
            Case 8      ' Backspace
 
                If I > 1 Then
                    Decr I
                    Locate ,CursorX - 1: Print Chr$(32);
                    Locate ,CursorX - 1
                End If
 
            Case 13
                GoSub ReadValueFromScreen
                Exit Loop
 
            Case 27
                Exit Loop
 
            Case Else
                Print KeyVal;
                Incr I
        End Select
    Loop
 
Function = ResultValue
 
Exit Function
 
'---------------------------------------------------------------
 
ReadValueFromScreen:
 
    KeyVal = ""
 
    For I = 0 To 5
        KeyVal = KeyVal + Chr$(Screen (CursorY, StartPos + I))
    Next I
 
    ResultValue = Val(KeyVal)
 
Return
 
End Function
 
' ---------------------------------------------------------------------------
 
Function ExePath As String
 
    'Function returns path to executable, including last backslash
 
    Local PathName As Asciiz*128
    Local I As Long
 
    GetModuleFileName 0, PathName, 127
 
    I = InStr(-1,PathName,"\")
 
    Function = Left$(PathName,I)
 
End Function
 
' ---------------------------------------------------------------------------
 
Sub UpdatePParms (ByVal Modus As Asciiz*2)
 
    Select Case Modus
 
        Case "L"     ' Load values from file, or defaults instead
 
            Open ExePath + $SaveParms For Binary As #1
 
                If Lof(1) < 20 Then                 ' No valid file present
 
                    PParms.DiceMode      =   1      ' Default Values
                    PParms.MapMode       =   2
                    PParms.NumZones      =  36
                    PParms.InterLacing   =   1
                    PParms.Separation    =  10
                    PParms.WhiteContent  =  20
                    PParms.SleepTime     = 500
 
                Else
                    Seek 1,1
                    Get  1,,PParms
                End If
            Close 1
                                                    ' Check values
 
                     PParms.NumZones     = Min&(PParms.NumZones,     %MaxNumZones)
                     PParms.WhiteContent = Min&(PParms.WhiteContent, %MaXWhiteContent)
                     PParms.Separation   = Min&(PParms.Separation,   %MaxSeparation)
                     PParms.SleepTime    = Min&(PParms.SleepTime,    %MaxSleepTime)
 
        Case "S"                                    ' Save values to file
 
            Open ExePath + $SaveParms For Binary As #1
                Seek 1,1
                Put  1,,PParms
            Close 1
 
        End Select
End Sub
 
' ---------------------------------------------------------------------------
 
Sub ProgramReset
 
    ProgramStatus   = 0
    ModelName       = ""
    Mat Boundary()  = Zer
    ReDim PlotArray (%NumIntX, %NumIntY)  As Global Single
    Graphic Color 0, PParms.GraphicBGCol
    Graphic Clear
 
End Sub
 
' -------------------------------------------------------------------------------
 
Sub ErrorHandler (ErrorReport As String)
 
Local KeyVal As String
 
    SetConsole 3
 
    Locate 2,3
    Print $Error
    Locate 4,3
    Print String$(76,196)
    StdOut ErrorReport
    Print
    Print $Continue;
 
    Do
        KeyVal = UCase$(WaitKey$)
    Loop Until Len(KeyVal) > 0 And InStr("JYN", KeyVal)
 
    Print:Print
 
    Select Case KeyVal
 
        Case "Y", "J"
            Print $ProgramContinues
 
        Case "N"
            Print $ProgramAborted
            Bit Set ProgramStatus, %ProgramInterrupted
    End Select
 
    Sleep 2000
 
End Sub
 
' ---------------------------------------------------------------------------
 
Sub SaveToBitMap
 
    Local FileName, SavePath As String
 
    SavePath = ExePath + "BMP"
 
    If Dir$(SavePath, 16) = "" Then MkDir SavePath
 
    ' Make filename with date and time
 
    FileName = "Laplace_" + Left$(Date$,5) + "_" + Left$(Time$,5) + ".bmp"
 
    Replace ":" With "h" In FileName             ' Colon is not allowed in file names
 
    Graphic Save SavePath + "\" + FileName
 
    Locate 24,2
    Color %ConsFClr
    Print $Saved;
    Color %ConsHiClr
    Print FileName;
 
End Sub
 
' -------------------------------------------------------------------------------
 
Sub TextBox (Caption As String, VertPos As Long)
 
    ' Prints a text centered in a graphic window
    ' Top of box is located at VerPos, top of text 10 pix below
 
    Local WinWidth, TextLength, TextHeight, StartPoint As Single
 
    Graphic Font "Verdana", 10,1
    Graphic Color RGB(252,253,254), RGB(2,3,4)
    Graphic Width 3
 
    Graphic Get Client To WinWidth, TextHeight
    Graphic Text Size Caption To TextLength, TextHeight
    StartPoint = (WinWidth - TextLength) / 2
 
    Graphic Box (StartPoint - 20, VertPos) - _
                (StartPoint + TextLength + 20, VertPos + TextHeight + 20), 20, RGB(1,191,2), RGB(2,3,4)
 
    Graphic Set Pos (StartPoint, VertPos + 10)
    Graphic Print Caption
 
End Sub
 
' -------------------------------------------------------------------------------
 
Sub SetToTop (hTopWin As Dword)
 
    Static hPrevious As Dword
 
    If hPrevious Then     ' Remove previous topmost from its position
 
        SetWindowPos hPrevious,%HWND_NOTOPMOST,0,0,0,0,_
                               %SWP_NOMOVE Or %SWP_NOSIZE Or %SWP_SHOWWINDOW
    End If
 
    SetWindowPos hTopWin,%HWND_TOPMOST,0,0,0,0,_
                         %SWP_NOMOVE Or %SWP_NOSIZE Or %SWP_SHOWWINDOW
 
    SetForeGroundWindow hTopWin
 
    hPrevious = hTopWin
 
End Sub
 
' -------------------------------------------------------------------------------
 
Sub Process_Windows_Message( ByVal hWnd As Dword, ByVal wMsg As Dword,_
                             ByVal wParam As Dword, ByVal lParam As Long)
 
    Graphic Attach hWnd,0
 
    Select Case wMsg
 
        Case %wm_destroy
            Bit Reset ProgramStatus,%ProgramPaused
            Bit Set   ProgramStatus,%ProgramInterrupted
            Bit Set   ProgramStatus,%ProgramAborted
 
        Case %wm_lbuttondown
 
            Bit Set ProgramStatus, %ProgramInterrupted
            Bit Reset ProgramStatus, %ProgramPaused
            Bit Reset ProgramStatus, %MenuHidden
            ShowWindow ConsHndl,3
 
        Case %wm_char
 
            Select Case wparam
 
               Case 13
                   Bit Set   ProgramStatus, %ProgramInterrupted
                   Bit Reset ProgramStatus, %ProgramPaused
                   Bit Reset ProgramStatus, %MenuHidden
                   ShowWindow ConsHndl,3
 
               Case 32
 
                   If IsFalse Bit(ProgramStatus, %MenuHidden) Then
                        Bit Toggle ProgramStatus, %ProgramPaused
                   End If
 
            End Select
 
        End Select
 
    CallWindowProc(OldProc, hWnd, wMsg, wParam, lParam)
 
End Sub
 
' -------------------------------------------------------------------------------
 
' END OF CODE

The following contains 10 example models.
Save it to a text file named LapGraph.txt
and place it in the same directory as the executable.

Code:
 
' Arie Verheul, november 2008
 
Model, Flower
 
'Note: paint with separation set to zero
 
Point, 60, 45, 100                      ' Point at center
 
Line, 60, 38, -100, 67, 45, -100        ' Inner rhombus
Line, 67, 45, -100, 60, 52, -100
Line, 60, 52, -100, 53, 45, -100
Line, 53, 45, -100, 60, 38, -100
 
Line, 45, 30,  100, 75, 30,  100        ' Square
Line, 45, 60,  100, 75, 60,  100
Line, 45, 30,  100, 45, 60,  100
Line, 75, 30,  100, 75, 60,  100
 
Line, 45, 30,  100, 30, 15,    0        ' Four diagonal outward lines
Line, 75, 30,  100, 90, 15,    0
Line, 45, 60,  100, 30, 75,    0
Line, 75, 60,  100, 90, 75,    0
 
Line,  0, 45,    0, 40, 45, -100        ' Four lines inward from edges
Line,120, 45,    0, 80, 45, -100
Line, 60,  0,    0, 60, 25, -100
Line, 60, 90,    0, 60, 65, -100
 
Model,Pattern
 
Point,  30, 22,  250                    ' Left bottom
Point,  90, 22, -275                    ' Right bottom
Point,  30, 68, -275                    ' Left top
Point,  90, 68,  250                    ' Right top
Point,  60, 45,  225                    ' Center
 
Model,Fish
 
Line,  120,  18,   0, 120,  90,  80     ' Right side
Line,    0,  90, -60,   0,  18,   0     ' Left side
Line,   48,  90,   0,   0,  90, -60     ' Left top
Line,  120,  90,  80,  80,  90,   0     ' Right top
 
Line,  0,   0,   0, 48,  0,  70         ' Left bottom
Line, 48,   0, -70, 96,  0,  0          ' Right bottom
 
Point, 36, 27, -200                     ' Left fish's eye
Point, 60, 27,  200                     ' Right fish's eye
 
Model,Sheherazade
 
Line,  60, 40,  300, 60, 10, -300       ' Vertical line across center
 
Point, 60, 75, -200                     ' Tree points at the center
Point, 60, 60,  200
Point, 60, 45, -400
 
Point, 30, 65, -100                     ' Point left top
Point, 90, 65, -100                     ' Point right top
 
Point, 18, 20, -100                     ' Point left bottom
Point, 102,20, -100                     ' Point right bottom
 
Model,Ladies
 
Line, 30,0, 100, 30, 70, 100            ' Left head
Line, 70,0,-100, 70, 80,-100            ' Right head
 
Line,30,20,-100,70,20,100               ' Scarfs
Line,30,20,-100,20,20,-80
Line,70,20,100,80,20,80
 
Line,0,0,0,30,0,100                     ' Bottom left
Line,30,0,100,70,0,-100                 ' Bottom between bodies
 
Line,70,0,-100,120,0,-50                ' Bottom right
Line,120,0,-50,120,120,0                ' Right edge
 
Model,Bello
 
Point, 40, 45,  300
Point, 60, 35, -300
Point, 80, 45,  300
 
Model,Meeting
 
Line,   0,  0,  100, 120,  0, - 100     ' Bottom
Line, 120,  0, -100, 120, 90,   100     ' Right side
Line, 120, 90,  100,   0, 90,  -100     ' Top
Line,   0, 90, -100,   0,  0,   100     ' Left side
 
Point, 36,  68, -280                    ' Four eyes
Point, 60,  40, -280
Point, 36,  40,  280
Point, 60,  68,  280
 
Model,Cactus
 
Point, 48, 45, -300
Point, 60, 45,  300
Point, 36, 45, -300
 
Line,  36, 45,   100,  0, 0, 100        ' Two lines from left bottom corner
Line,  84, 45,  -100, 20, 0,-100
 
Model,Eye
 
Point, 60,  45, 320
 
Line,  0,    0,   0,  120,   0,  40     ' Bottom
Line,  120,  0,  40,  120,  90,   0     ' Right side
Line,  120, 90,   0,    0,  90,  40     ' Top
Line,  0,   90,  40,    0,   0,   0     ' Left side
 
Model, Leaves
 
Line,50,0,0,10,70,100
Line,50,0,0,110,50,100
Line,70,90,0,50,20,-100

Below is the manual, to be saved as a plain text file.


Code:
'                         PAINTING WITH THE LAPLACIAN
'
'                                Arie  Verheul
'                                november 2008
'
'                               updated jan 2009 
'
' -------------------------------------------------------------------------------
'
'                              GENERAL USER GUIDE
'
' -------------------------------------------------------------------------------
'
' This application can be used to make beautiful pictures from mathematical models.
'
' Step 1. In the menu click on "Select model". A new window will open with the
'         names of the models that are with the application. Select one of them.
'
' Step 2. Click on the "PAINT" caption in the menu.
'         The application will start coloring the picture.
'
' Step 3. To continue coloring with a different scheme, press ENTER or the left
'         Mouse button, which will bring back the menu.
'         To just pause the application, press SPACE.
'         Pressing SPACE again will let the application continue.
'
' Step 4. The menu has several settings that control the way coloring is done.
'         In the top half of the menu there are captions that may be selected.
'         In the lower half values may be typed in.
'         Just try what these controls are doing. It is possible to continue
'         coloring with still new settings in always the same picture.
'
' Step 5. It may happen that the background does not match with the picture.
'         If this is the case, click on the 'Set BG Color' caption.
'         From the color dialog box a different background may be selected.
'         This will not erase the picture.
'
' Step 6. If a really good picture came out, it may be saved to disk.
'         To do this, click on the 'Save to BMP' caption.
'         The application will report that the picture has been saved.
'
'  To exit the application click on the 'X icon' at the right top of the menu,
'  or press Alt-F4.
'
' -------------------------------------------------------------------------------
'
'                            TECHNICAL DESCRIPTION
'
' -------------------------------------------------------------------------------
' GENERAL PRINCIPLE
' -------------------------------------------------------------------------------
'
'
' This software uses solutions of the Laplacian to produce graphic images.
' For those unfamiliar with this operator, it may probably best be understood by
' imagining an elastic membrane that is fixed to a rectangular frame.
' If poles are placed under this membrane, they may push it up or pull it down.
' The Laplacian describes in this case the deflections of the membrane.
' This approach was actually used to study Laplace problems before the advent of
' computers.
'
' Approximated solutions of the Laplacian may be obtained with the "Finite Diffe-
' rence" algorithm. This is a very simple and robust algorithm which, for rectan-
' gular coordinates and equal gridspacing in both directions, involves the repeated
' adjustment of the value at each gridpoint to the average of its four neighbours
' (except for the boundary points).
'
' To present the results of such a calculation it is common practice to draw height
' contours, like on a topographic map, and color the enclosed areas accordingly.
' In fact this software originated as an accidental spinoff of such an application.
' In this case however the coloring is randomised, which means that the colors
' have lost their technical function of representing results, whilst just the shapes
' of the contours are preserved. These shapes, disconnected from their technical
' meaning, may produce beautiful results.
'
' Although there are many mathematical functions and algorithms that can be used to
' produce graphic effects, the charm of this approach is that it allows a detailed
' input from the user, whilst on the other hand the algorithm is so robust that it
' will not be upset by any unusual input.
'
'
' -------------------------------------------------------------------------------
' PROGAM CONTROLS
' -------------------------------------------------------------------------------
'
' In the graphic mode there is no visible menu.
' Press ENTER or LeftMouse to bring up a menu.
' To pause application execution press SPACE.
'
'
' -------------------------------------------------------------------------------
' MODEL SELECTION
' -------------------------------------------------------------------------------
'
' The models that provide the input for the Finite Difference algorithm are loca-
' ted in an external model file, that may be edited and extended by the user.
' Clicking the 'Select model' caption in the main menu will bring up a pick box,
' from which a model may be selected with the mouse.
'
'
' -------------------------------------------------------------------------------
' COLOR SETTING
' -------------------------------------------------------------------------------
'
' Five options are available, that offer color schemes which are (pseudo) random
' to a varying degree :
'
'
'     1. Random 3 colors    Both color and intensity are random.
'
'     2. Random 2 colors    Colors have two randomly selected components.
'
'     3. Red + green        Colors are composed of only red and green
'
'     4. Red + blue         Colors are composed of only red and blue
'
'     5. Blue + green       Colors are composed of only blue and    green
'
'
' If 'Pastel white content' (see below) is set to zero, all 2 color modes result
' in saturated colors.
'
' Colors may be modified with two options that can be used in a cumulative way.
'
' UNIFORM BRIGHTNESS        The brightness of the resulting color is always
'                           adjusted to a preset value.
'
' PASTEL WHITE CONTENT      Specifies a lower limit to the randomising process,
'                           which results in pastel like colors.
'                           Values 0 to 99 may be entered.
'
' -------------------------------------------------------------------------------
' BACKGROUND COLOR
' -------------------------------------------------------------------------------
'
' It is at any moment possible to change the background color without erasing the
' picture. Clicking the 'Set BG Color' caption will bring up the well known
' Windows color dialog box.
'
'
' -------------------------------------------------------------------------------
' COMPOSITION
' -------------------------------------------------------------------------------
'
' The math involved may produce both positive and negative values.
' The COMPOSITION setting specifies the way in which shades assigned to positive
' and negative values will be related. It may bring some sort of harmony in the
' picture, if different parts of it are related in a way that is not immediately
' clear, but which is obviously there, just like this is commonly done in music.
'
' The mentioned relations are obtained by swapping and rotating color components.
' This gives five options:
'
'     Rotate right
'     Rotate left
'     Swap R and G
'     Swap R and B
'     Swap B and G
'
'
' Additionally there is a mode where positive and negative shades are complementary
' (producing white when added), and a mode where they are fully independent.
'
' -------------------------------------------------------------------------------
' SPACING
' -------------------------------------------------------------------------------
'
' Instead of filling the picture in a consecutive way, it may be more attractive to
' use a walking method. Therefore the range of contour zones is divided into blocks
' of 12, and in each round of the process one zone in each block is colored.
'
' Optionally it is possible to color not the whole plot, but just every 2nd, 3rd,
' 4th, 5th, 6th or 12th zone in each block.
' This gives the option of zebra like patterns.
'
' But as it is at all times possible to change the settings, it offers also the
' option to work like a conventional painter does, and continue coloring in an
' existing picture with new settings.
'
' Interesting results may be obtained by first coloring a large area in a small
' number of colors, and subsequently adding some thin lines by increasing the
' number of zones and simultaneously increasing the spacing to every 12th zone.
' Or vice versa, by filling the picture with a large number of colors, and later
' covering some parts of this with one or two colors.
'
'
' -------------------------------------------------------------------------------
' NUMBER OF ZONES
' -------------------------------------------------------------------------------
'
' The selected number of zones has a large effect upon the resulting picture.
' The menu allows up to 999 zones, but as an increasing number of zones reduces
' their width, at some point zones will simply disappear. However, even this may
' produce attractive results. The number of zones specified is for half the range,
' from zero to maximum, or from zero to minimum.
'
'
' -------------------------------------------------------------------------------
' SEPARATION
' -------------------------------------------------------------------------------
'
' It is possible to specify that a region around zero is skipped.
' Doing this makes parts of the picture to become separated from each other.
' To make the specification independent of the number of zones, the separation
' parameter is expressed as a percentage of the range.
'
'
' -------------------------------------------------------------------------------
' UPDATE TIME
' -------------------------------------------------------------------------------
'
' Coloring continues as long as the application is running.
' Between each modification of the image, a waiting time is observed to enable the
' user to view the result. The duration of this time may be specified in millisec.
' Values 0 to 9999 may be entered.
'
'
' -------------------------------------------------------------------------------
' OHTER FUNCTIONS
' -------------------------------------------------------------------------------
'
' PAINT           Clicking to this caption causes painting to start or to be resumed.
'
' SAVE TO BMP     Saves the current image to a BMP file.
'                 Files will be placed in a subdirectory \BMP\, and receive an auto
'                 generated file name with date and time.
'
' VIEW MODEL      A simple model viewer is provided to check the model.
'
' CLEAR           Explicitly clears the window
'
'
' -------------------------------------------------------------------------------
' MODEL FILE
' -------------------------------------------------------------------------------
'
' Models are located in an external model file, which makes it possible to write
' own models. One single file may contain multiple model descriptions.
' The application expects the model file in the same directory as the executable.
' Writing models is quite straightforward, and uses at this moment three statements:
'
'     MODEL, name
'
'         Each model description must start with the keyword MODEL, followed with
'         a name. Name must be one single word without spaces.
'         Name may be of any length, but only the first 16 characters will be listed.
'
'     POINT, x, y, value
'
'         This statement specifies one single point.
'
'     LINE, x1, y1, value1, x2, y2, value2
'
'         This statement specifies an array of points between endpoints x1,y1
'         and x2,y2. The respective values are linearly interpolated between
'         value1 and value2. This statement also offers the possibility of
'         redefing the values at the edges, which are normally set to zero.
'         A line with zero length is not allowed.
'
'     COMMENT
'
'         Everything after a single quote, and up to the end of a line is
'         considered as comment, and ignored in processing.
'
' Note the obligatory komma after the keyword.
' Also note that if not otherwise specified, all points along the edges
' are default set to zero.
'
'
' -------------------------------------------------------------------------------
' COORDINATES AND VALUE RANGE
' -------------------------------------------------------------------------------
'
' Coordinate ranges are internally fixed as follows:
'
'         x coordinate    0 to 120
'         y coordinate    0 to  90
'
'         The value assigned to a point is not formally restricted.
'         However the plotrange is fixed as -100 to 100, which limits the practical
'         range of values to about -300 to 300.
'
' -------------------------------------------------------------------------------
'