Imports System.Threading
Imports System.Drawing.Imaging
Imports System.Runtime.InteropServices

' MODE 0x13: http://www.brackeen.com/vga/basics.html
' Color Graphics Adapter (CGA) http://webpages.charter.net/danrollins/techhelp/0066.HTM

Public Class CGAWinForms
    Inherits CGAAdapter

    Private mRenderControl As Control
    Private videoBMP As Bitmap
    Private videoBMPRect As Rectangle

    Private charSize As Size
    Private cursorSize As Size
    Private blinkCounter As Integer

    Private mZoom As Double = 1.0
    ' TODO: See if, at some point, we can add support for bitmap-based (.fon) font formats:
    '   http://falloutmods.wikia.com/wiki/FON_File_Format

    Private preferredFont As String = "Perfect DOS VGA 437"
    'Private preferredFont As String = "ASCII"
    Private mFont As Font = New Font(preferredFont, 16, FontStyle.Regular, GraphicsUnit.Pixel)
    Private textFormat As System.Drawing.StringFormat = New System.Drawing.StringFormat(StringFormat.GenericTypographic)

    Private charSizeCache As Dictionary(Of Integer, Size)

    Private penCache(16 - 1) As Pen
    Private brushCache(16 - 1) As SolidBrush
    Private cursorBrush = New SolidBrush(Color.FromArgb(128, Color.White))

    Private mCPU As x8086

    Private Class TaskSC
        Inherits Scheduler.Task

        Public Sub New(owner As IOPortHandler)
            MyBase.New(owner)
        End Sub

        Public Overrides Sub Run()
            Owner.Run()
        End Sub

        Public Overrides ReadOnly Property Name As Object
            Get
                Return Owner.Name
            End Get
        End Property
    End Class
    Private task As Scheduler.Task = New TaskSC(Me)

    Public Sub New(cpu As x8086, renderControl As Control)
        MyBase.New(cpu)
        mCPU = cpu
        Me.RenderControl = renderControl

        charSizeCache = New Dictionary(Of Integer, Size)

        AddHandler mRenderControl.KeyDown, Sub(sender As Object, e As System.Windows.Forms.KeyEventArgs) OnKeyDown(Me, e)
        AddHandler mRenderControl.KeyUp, Sub(sender As Object, e As System.Windows.Forms.KeyEventArgs) OnKeyUp(Me, e)

        If mFont.Name <> preferredFont Then
            MsgBox("CGAWinForms requires the '" + preferredFont + "' font. Please install it before using this adapter", MsgBoxStyle.Information Or MsgBoxStyle.OkOnly)
            mFont = New Font("Consolas", 16, FontStyle.Regular, GraphicsUnit.Pixel)
            If mFont.Name <> "Consolas" Then
                mFont = New Font("Andale Mono", 16, FontStyle.Regular, GraphicsUnit.Pixel)
                If mFont.Name <> "Andale Mono" Then
                    mFont = New Font("Courier New", 16, FontStyle.Regular, GraphicsUnit.Pixel)
                End If
            End If
        End If

        textFormat.FormatFlags = StringFormatFlags.NoWrap Or
                                   StringFormatFlags.MeasureTrailingSpaces Or
                                   StringFormatFlags.FitBlackBox Or
                                   StringFormatFlags.NoClip
    End Sub

    Public Property RenderControl As Control
        Get
            Return mRenderControl
        End Get
        Set(value As Control)
            DetachRenderControl()
            mRenderControl = value
            InitiAdapter()

            AddHandler mRenderControl.Paint, AddressOf Paint
        End Set
    End Property

    Protected Sub DetachRenderControl()
        If mRenderControl IsNot Nothing Then RemoveHandler mRenderControl.Paint, AddressOf Paint
    End Sub

    Public Property Zoom As Double
        Get
            Return mZoom
        End Get
        Set(value As Double)
            mZoom = value
            AutoSize()
        End Set
    End Property

    Public Overrides Sub CloseAdapter()
        MyBase.CloseAdapter()

        DisposeColorCaches()
        DetachRenderControl()
    End Sub

    Public Overrides Sub AutoSize()
        If mRenderControl IsNot Nothing Then
            If mRenderControl.InvokeRequired Then
                mRenderControl.Invoke(New MethodInvoker(AddressOf ResizeRenderControl))
            Else
                ResizeRenderControl()
            End If
        End If
    End Sub

    Private Sub ResizeRenderControl()
        Dim ctrlSize As Size

        If MainMode = MainModes.Text Then
            Using g As Graphics = mRenderControl.CreateGraphics()
                ctrlSize = New Size(charSize.Width * TextResolution.Width, charSize.Height * TextResolution.Height)
            End Using
        Else
            ctrlSize = New Size(VideoResolution.Width, VideoResolution.Height)
        End If

        ctrlSize.Width *= mZoom
        ctrlSize.Height *= mZoom

        mRenderControl.Size = ctrlSize
    End Sub

    Protected Overrides Sub Render()
        mRenderControl.Invalidate()
    End Sub

    Private Sub Paint(sender As Object, e As System.Windows.Forms.PaintEventArgs)
        SyncLock lockObject
            Dim g As Graphics = e.Graphics

            g.SmoothingMode = Drawing2D.SmoothingMode.None
            g.PixelOffsetMode = Drawing2D.PixelOffsetMode.HighQuality

            If mZoom <> 1 Then g.ScaleTransform(mZoom, mZoom)

            Try
                Select Case MainMode
                    Case MainModes.Text : RenderText(g)
                    Case MainModes.Graphics : RenderGraphics(g)
                End Select
            Catch
            End Try

            'RenderWaveform(g)
        End SyncLock
    End Sub

    Protected Overrides Sub OnPaletteRegisterChanged()
        MyBase.OnPaletteRegisterChanged()

        SyncLock lockObject
            DisposeColorCaches()
            For i As Integer = 0 To CGAPalette.Length - 1
                penCache(i) = New Pen(CGAPalette(i))
                brushCache(i) = New SolidBrush(CGAPalette(i))
            Next
        End SyncLock
    End Sub

    Private Sub RenderGraphics(g As Graphics)
        Dim b As Byte
        Dim c As Color
        Dim pixelsPerByte As Integer = If(VideoMode = VideoModes.Mode6_Graphic_Color_640x200, 8, 4)
        Dim yOffset As Integer
        Dim v As Byte

        Dim sourceData = videoBMP.LockBits(videoBMPRect, ImageLockMode.WriteOnly, videoBMP.PixelFormat)
        Dim sourcePointer = sourceData.Scan0
        Dim sourceStride = sourceData.Stride
        Dim sourceOffset As Integer
        Dim yStride As Integer

        For y As Integer = 0 To 200 - 1
            If y < 100 Then ' Even Scan Lines
                yOffset = StartGraphicsVideoAddress + y * 80
                yStride = y * 2
            Else            ' Odd Scan Lines
                yStride = y Mod 100
                yOffset = StartGraphicsVideoAddress + yStride * 80 + &H2000
                yStride = yStride * 2 + 1
            End If
            yStride *= sourceStride

            For x As Integer = 0 To 80 - 1
                b = Emulator.RAM(x + yOffset)

                For pixel As Integer = 0 To pixelsPerByte - 1
                    If VideoMode = VideoModes.Mode4_Graphic_Color_320x200 Then
                        Select Case pixel And 3
                            Case 3 : v = b And 3
                            Case 2 : v = (b >> 2) And 3
                            Case 1 : v = (b >> 4) And 3
                            Case 0 : v = (b >> 6) And 3
                        End Select
                    Else
                        v = (b >> (7 - (pixel And 7))) And 1
                    End If

                    'If mVideoMode = VideoModes.Mode4_Graphic_Color_320x200 Then
                    'b *= 2
                    'Else
                    'b *= 63
                    'End If
                    c = CGAPalette(v)

                    sourceOffset = (x * pixelsPerByte + pixel) * 3 + yStride
                    Marshal.WriteByte(sourcePointer, sourceOffset + 0, c.B)      ' B
                    Marshal.WriteByte(sourcePointer, sourceOffset + 1, c.G)      ' G
                    Marshal.WriteByte(sourcePointer, sourceOffset + 2, c.R)      ' R
                Next
            Next
        Next

        videoBMP.UnlockBits(sourceData)
        g.DrawImageUnscaled(videoBMP, 0, 0)
    End Sub

    Private Sub RenderText(g As Graphics)
        Dim b0 As Byte
        Dim b1 As Byte

        Dim col As Integer = 0
        Dim row As Integer = 0

        Dim r As New Rectangle(Point.Empty, charSize)

        'g.TextRenderingHint = Drawing.Text.TextRenderingHint.ClearTypeGridFit

        For address = StartTextVideoAddress To EndTextVideoAddress Step 2
            b0 = Emulator.RAM(address)
            b1 = Emulator.RAM(address + 1)

            g.FillRectangle(brushCache(b1.HighNib()), r)
            g.DrawString(chars(b0), mFont, brushCache(b1.LowNib()), r.Location, textFormat)

            If CursorVisible AndAlso row = CursorRow AndAlso col = CursorCol Then
                If (Not BlinkCursor) OrElse (blinkCounter < 10) Then
                    g.FillRectangle(cursorBrush, r.X + 1, r.Y, cursorSize.Width, cursorSize.Height - 2)
                End If
                blinkCounter = (blinkCounter + 1) Mod 20
            End If

            r.X += charSize.Width
            col += 1
            If col = TextResolution.Width Then
                col = 0
                row += 1
                If row = TextResolution.Height Then Exit For

                r.X = 0
                r.Y += charSize.Height
            End If
        Next
    End Sub

    Private Sub RenderWaveform(g As Graphics)
#If Win32 Then
        If mCPU.PIT.Speaker IsNot Nothing Then
            g.ResetTransform()

            Dim h As Integer = mRenderControl.Height
            Dim h2 As Integer = h / 2
            Dim p1 As Point = New Point(0, mCPU.PIT.Speaker.AudioBuffer(0) / Byte.MaxValue * h2 + h2)
            Dim p2 As Point
            Dim len As Integer = mCPU.PIT.Speaker.AudioBuffer.Length

            Using p As New Pen(Brushes.Red, 3)
                For i = 1 To len - 1
                    Try
                        p2 = New Point(i / len * mRenderControl.Width, mCPU.PIT.Speaker.AudioBuffer(i) / Byte.MaxValue * h2 + h2)
                        g.DrawLine(p, p1, p2)
                        p1 = p2
                    Catch
                        Exit For
                    End Try
                Next
            End Using
        End If
#End If
    End Sub

    Private Function MeasureChar(graphics As Graphics, code As Integer, text As Char, font As Font) As Size
        If charSizeCache.ContainsKey(code) Then Return charSizeCache(code)

        Dim rect As System.Drawing.RectangleF = New System.Drawing.RectangleF(0, 0, 1000, 1000)
        Dim ranges() As System.Drawing.CharacterRange = {New System.Drawing.CharacterRange(0, 1)}
        Dim regions() As System.Drawing.Region = {New System.Drawing.Region()}

        textFormat.SetMeasurableCharacterRanges(ranges)

        regions = graphics.MeasureCharacterRanges(text, font, rect, textFormat)
        rect = regions(0).GetBounds(graphics)

        Dim size As Size = New Size(rect.Right - 1, rect.Bottom)
        charSizeCache.Add(code, size)

        Return size
    End Function

    Public Overrides ReadOnly Property Description As String
        Get
            Return "CGA Adapter"
        End Get
    End Property

    Private Sub DisposeColorCaches()
        If penCache(0) IsNot Nothing Then
            For i As Integer = 0 To CGAPalette.Length - 1
                penCache(i).Dispose()
                brushCache(i).Dispose()
            Next
        End If
    End Sub

    Public Overrides ReadOnly Property Name As String
        Get
            Return "CGA"
        End Get
    End Property

    ' http://www.powernet.co.za/info/BIOS/Mem/
    ' http://www-ivs.cs.uni-magdeburg.de/~zbrog/asm/memory.html
    Private Sub UpdateSystemInformationArea()
        '' Display Mode
        'Emulator.RAM8(&H40, &H49) = CByte(MyBase.VideoMode)

        '' Number of columns on screen
        'Emulator.RAM16(&H40, &H4A) = TextResolution.Width

        '' Length of Regen Buffer
        'Emulator.RAM16(&H40, &H4C) = MyBase.EndTextVideoAddress - MyBase.StartTextVideoAddress

        '' Current video page start address in video memory (after 0B800:0000)
        '' Starting Address of Regen Buffer. Offset from the beginning of the display adapter memory
        'Emulator.RAM16(&H40, &H4E) = &HB800

        '' Current video page start address in video memory (after 0B800:0000)
        'For i As Integer = 0 To 1 'MyBase.pagesCount
        '    Emulator.RAM8(&H40, &H50 + i * 2 + 0) = CursorCol
        '    Emulator.RAM8(&H40, &H50 + i * 2 + 1) = CursorRow
        'Next

        '' Cursor Start and End Scan Lines
        'Emulator.RAM8(&H40, &H60) = 0 ' ????????
        'Emulator.RAM8(&H40, &H61) = 0 ' ????????

        '' Current Display Page
        'Emulator.RAM8(&H40, &H62) = 1 'activePage

        '' CRT Controller Base Address 
        'Emulator.RAM16(&H40, &H63) = &H3D4

        '' Current Setting of the Mode Control Register
        'Emulator.RAM8(&H40, &H65) = x8086.BitsArrayToWord(CGAModeControlRegister)

        '' Current Setting of the Color Select Register
        'Emulator.RAM16(&H40, &H66) = Emulator.RAM16(&H40, &H63) + 5

        '' Rows on screen minus one
        'Emulator.RAM8(&H40, &H84) = TextResolution.Height - 1
    End Sub

    Public Overrides Sub Run()
        If mRenderControl IsNot Nothing Then mRenderControl.Invalidate()
    End Sub

    Protected Overrides Sub InitVideoMemory(clearScreen As Boolean)
        MyBase.InitVideoMemory(clearScreen)

        If mRenderControl IsNot Nothing Then
            If clearScreen OrElse charSizeCache.Count = 0 Then
                SyncLock MyBase.lockObject
                    charSizeCache.Clear()
                    Using g = mRenderControl.CreateGraphics()
                        For i As Integer = 0 To 255
                            MeasureChar(g, i, chars(i), mFont)
                        Next
                    End Using
                End SyncLock
            End If

            SyncLock MyBase.lockObject
                If videoBMP IsNot Nothing Then videoBMP.Dispose()
                If MainMode = MainModes.Graphics Then
                    videoBMP = New Bitmap(VideoResolution.Width, VideoResolution.Height, PixelFormat.Format24bppRgb)
                    videoBMPRect = New Rectangle(0, 0, VideoResolution.Width, VideoResolution.Height)
                End If
            End SyncLock

            ' Monospace... duh!
            charSize = charSizeCache(32)

            cursorSize = charSize
            cursorSize.Width -= 1

            UpdateSystemInformationArea()
        End If
    End Sub
End Class
