FreeBasic

Мало кто не знаком с фильмом матрица, а так же с экраном по которому стекают вниз зеленые буквы. Пример неплохо подойдет для заставки. 

Платформа: Windows , Linux
Автор: tempeleng

#INCLUDE Once "fbgfx.bi"
#DEFINE UPDATE_SPEED        60 'lower is faster
#DEFINE UPDATE_CHANCE        11 'out of 256
#DEFINE NON_SPACE_CHANCE 26 'out of 256
#DEFINE SPACE_CHANCE          8 'out of 256
#DEFINE CHARACTER_WIDTH   8 'pixels
#DEFINE CHARACTER_HEIGHT 16 'pixels
Function ScreenSupported(Byval ScreenWidth As Integer, Byval ScreenHeight As Integer, Byval Colour As Integer) As Integer
    Dim As Integer mode, w, h
    mode = Screenlist(Colour)
    While (mode)
        w = Hiword(mode)
        h = Loword(mode)
        If w = ScreenWidth And h = ScreenHeight Then
            Function = -1
            Exit Function
        End If
        mode = Screenlist
    Wend
End Function
Function randomNumber(iSeed As Integer) As Integer
    Static aiArray(0 To 7) As Integer
    Dim As Integer iX, iZ = 0, aiTemp(0 To 7), iA, iB
    'Fill in initial values from the 8 lower bits
    If iSeed > 0 Then
        For iX = 0 To 7
            If (iSeed And (2 ^ iX)) Then
                aiArray(iX) = 1
            Else
                aiArray(iX) = 0
            End If
        Next iX
    End If
    'Loop through cellular automata algo
    For iX = 0 To 7
        iA = iX - 1
        iB = iX + 1
        If iA < 0 Then iA = 7
        If iB > 7 Then iB = 0
        If aiArray(iA) Then
            If aiArray(iX) Or aiArray(iB) Then
                aiTemp(iX) = 0
            Else
                aiTemp(iX) = 1
            End If
        Else
            If aiArray(iX) Or aiArray(iB) Then
                aiTemp(iX) = 1
            Else
                aiTemp(iX) = 0
            End If
        End If
        If aiTemp(iX) Then iZ = iZ Or (2 ^ iX)
    Next iX
    For iX = 0 To 7
        aiArray(iX) = aiTemp(iX)
    Next iX
    Return iZ
End Function

'Prep the screen
Dim As Integer iX, iY, iScreenWidth, iScreenHeight, aiAvailableScreens(0 To 1, 0 To 4) => {{1440, 1280, 1024, 800, 640}, {900, 1024, 768, 600, 480}}
For iX = 0 To Ubound(aiAvailableScreens, 2)
    iScreenWidth = aiAvailableScreens(0, iX)
    iScreenHeight = aiAvailableScreens(1, iX)
    iY = ScreenSupported(iScreenWidth, iScreenHeight, 32)
    If iY Then
        Screenres iScreenWidth, iScreenHeight, 32, 1, 1 '0=Windowed 1=Fullscreen
        Width iScreenWidth \ CHARACTER_WIDTH, iScreenHeight \ CHARACTER_HEIGHT
        Exit For
    End If
Next
If Not iY Then End

'Lookups & variables
Dim As Integer xm_aiPreviousChar()                        'The character printed in the row above
Dim As Integer xm_aiCurrentRow()                        'Current row index for each column
Dim As Integer xm_aiPosCol(), xm_aiPosRow()        'X & Y positions, screen pixel coordinates
Dim As Integer xm_aiColumnInitd()                        'Column active status
Dim As Integer xm_iCountCol, xm_iCountRow        'Number of columns & rows
Dim As Integer iDice
Dim As fb.EVENT e

'Initialize timer
randomNumber(Timer)

'Find out how many columns & rows
xm_iCountCol = iScreenWidth \ CHARACTER_WIDTH
xm_iCountRow = iScreenHeight \ CHARACTER_HEIGHT

'Resize arrays to hold data
Redim xm_aiPreviousChar(xm_iCountCol - 1)
Redim xm_aiPosCol(xm_iCountCol - 1)
Redim xm_aiPosRow(xm_iCountRow - 1)
Redim xm_aiColumnInitd(xm_iCountCol - 1)
Redim xm_aiCurrentRow(xm_iCountCol - 1)

'Fill in the data
For iX = 0 To xm_iCountCol - 1
    xm_aiPosCol(iX) = iX * CHARACTER_WIDTH
    xm_aiPreviousChar(iX) = -1
Next iX
For iX = 0 To xm_iCountRow - 1
    xm_aiPosRow(iX) = iX * CHARACTER_HEIGHT
Next iX

Do
    'Exit on escape
    If (Screenevent(@e)) Then If e.Type = 1 Then If e.ScanCode = 1 Then Exit Do

    'Lock updates
    Screenlock

    'Go through every column
    For iX = 1 To xm_iCountCol - 1

        'If column is not updating
        If xm_aiPreviousChar(iX) = -1 Then
            'Roll dice to see if it should be updated on the next check
            iDice = randomNumber(0)
            If iDice < UPDATE_CHANCE Then
                xm_aiPreviousChar(iX) = 0
            End If

        Else 'Its updating

            'First, blank out area to be drawn
            Line (xm_aiPosCol(iX), xm_aiPosRow(xm_aiCurrentRow(iX)))-(xm_aiPosCol(iX) + CHARACTER_WIDTH, xm_aiPosRow(xm_aiCurrentRow(iX)) + CHARACTER_HEIGHT), 0, BF

            'Draw over the previous char with the darker color
            If xm_aiCurrentRow(iX) > 0 Then
                'Select a random darker color
                iDice = randomNumber(0)
                If iDice < 85 Then
                    Draw String (xm_aiPosCol(iX), xm_aiPosRow(xm_aiCurrentRow(iX) - 1)), Chr$(xm_aiPreviousChar(iX)), 3585838
                Elseif iDice < 170 Then
                    Draw String (xm_aiPosCol(iX), xm_aiPosRow(xm_aiCurrentRow(iX) - 1)), Chr$(xm_aiPreviousChar(iX)), 1518611
                Else
                    Draw String (xm_aiPosCol(iX), xm_aiPosRow(xm_aiCurrentRow(iX) - 1)), Chr$(xm_aiPreviousChar(iX)), 16384
                End If
            End If

            'If previous character is an empty space
            If xm_aiPreviousChar(iX) = 0 Then

                'If it's never had a chance to draw characters before
                If xm_aiColumnInitd(iX) = 0 Then

                    'Roll dice to see if it should be changed to non space
                    iDice = randomNumber(0)
                    If iDice < NON_SPACE_CHANCE Then
                        xm_aiColumnInitd(iX) = 1
                        xm_aiPreviousChar(iX) = randomNumber(0) * 93 \ 256 + 33
                        xm_aiCurrentRow(iX) = -1
                    End If
                End If

            Else 'Previous character isn't an empty space

                'Roll dice to see if it should be changed to space
                iDice = randomNumber(0)
                If iDice < SPACE_CHANCE Then
                    'Change to space
                    xm_aiPreviousChar(iX) = 0

                Else 'It's not changing to space

                    'Draw it, bright color
                    iDice = randomNumber(0) * 93 \256 + 33
                    Draw String (xm_aiPosCol(iX), xm_aiPosRow(xm_aiCurrentRow(iX))), Chr$(iDice), 16580604

                    'Save the drawn char value
                    xm_aiPreviousChar(iX) = iDice
                End If
            End If

            'Increment the row index for this column
            xm_aiCurrentRow(iX) = xm_aiCurrentRow(iX) + 1

            'If we have reached the last row
            If xm_aiCurrentRow(iX) = xm_iCountRow Then
                'Reset it
                xm_aiCurrentRow(iX) = 0
                xm_aiPreviousChar(iX) = -1
                xm_aiColumnInitd(iX) = 0
            End If

        End If
    Next iX

    'Unlock updates
    Screensync
    Screenunlock

    Sleep UPDATE_SPEED
Loop

Erase xm_aiPreviousChar
Erase xm_aiCurrentRow
Erase xm_aiPosCol
Erase xm_aiPosRow
Erase xm_aiColumnInitd
Erase aiAvailableScreens