Donnerstag, 4. Mai 2017

Die Matrix ist volljährig geworden / The Matrix has come of age

Als im Jahr 1999 der erste Teil der Matrix Trilogie in den Kinos anlief war ich (wie vermutlich viele andere) von den Zeichenkaskaden des Matrixcodes fasziniert. Irgendwann baute ich mir dann zum Spaß eine ähnliche Funktionalität für den _screen des VFP Entwicklungsfensters.
Nun zum 18jährigen Jubiläum des Films habe ich den angestaubten Code heraus gekramt und abgestaubt.

Der u.a. Code kann einfach in eine .prg Datei einkopiert werden.
Solltet Ihr auf Eurem Rechner die Schriftart 'Consolas' nicht installiert haben, dann ersetzt sie in der Funktion 'SetScreen' durch eine nicht proportionale Schriftart Eurer Wahl.

* // i n i t i a l i z a t i o n
ON KEY LABEL F12 ExitLoop()
CLEAR 

PUBLIC pbExit as Boolean, paRGB( 6 )

pbExit = .F.
paRGB( 1 )    = RGB(0,60,0)
paRGB( 2 )    = RGB(0,100,0)
paRGB( 3 )    = RGB(0,140,0)
paRGB( 4 )    = RGB(0,180,0)
paRGB( 5 )    = RGB(0,220,0)
paRGB( 6 )    = RGB(0,255,0)

=SetScreen( 1 )

LOCAL    liHMax as Integer, liVMax as Integer, ;
         liCol as Integer, liLight as Integer
        
liHMax   = INT( _screen.Width / FONTMETRIC( 6 , _screen.FontName , _screen.FontSize ) )
liVMax   = INT( _screen.Height / FONTMETRIC( 1 , _screen.FontName , _screen.FontSize ) )
liCol    = 0
liLight  = RGB(180,255,180)

LOCAL    laRowFadeOut( liHMax ), laRowCurrent( liHMax )
        
STORE -6 TO laRowFadeOut
STORE -1 TO laRowCurrent

* // T H E  M A T R I X C O D E
DO WHILE pbExit = .F.
    
    * // select random column
    liCol = INT( RAND() * liHMax )
    
    * // new value for current column
    IF laRowCurrent( liCol + 1 ) > laRowFadeOut( liCol + 1 ) ;
    OR ( laRowFadeOut( liCol + 1 ) > laRowCurrent( liCol + 1 ) AND laRowFadeOut( liCol + 1 ) - laRowCurrent( liCol + 1 ) > 20 )
        laRowCurrent( liCol + 1 ) = IIF( laRowCurrent( liCol + 1 ) >= liVMax - 1 OR ROUND( RAND() * liVMax , 0 ) > liVMax - 2 , 0 , laRowCurrent( liCol + 1 ) + 1 )
        @ laRowCurrent( liCol + 1 ) - 1, liCol say GetChar()
        _screen.ForeColor = liLight
        @ laRowCurrent( liCol + 1 ) , liCol say GetChar()
        _screen.ForeColor = paRGB( ALEN( paRGB , 1 ) )
    ENDIF 

    * // fade out for current colum
    IF laRowCurrent( liCol + 1 ) > INT( liVMax / 1.5 ) ;
    OR laRowFadeOut( liCol + 1 ) >= laRowCurrent( liCol + 1 )
        @ laRowFadeOut( liCol + 1 ) , liCol say [ ]
        FOR liLoop = 1 TO ALEN( paRGB , 1 )
            _screen.ForeColor = paRGB( liLoop )
            @ laRowFadeOut( liCol + 1 ) + liLoop , liCol say GetChar()
        ENDFOR                         
        laRowFadeOut( liCol + 1 ) = IIF( laRowFadeOut( liCol + 1 ) = liVMax - 1 , ALEN( paRGB , 1 ) * -1 , laRowFadeOut( liCol + 1 ) + 1 )
        _screen.ForeColor = paRGB( ALEN( paRGB , 1 ) )
    ENDIF 
    
    * // place 10 random chars in current column
    IF laRowFadeOut( liCol + 1 ) + ALEN( paRGB , 1 ) < laRowCurrent( liCol + 1 )
        FOR liLoop = 1 TO 10
            liVal = laRowCurrent( liCol + 1 ) - ( laRowFadeOut( liCol + 1 ) + ALEN( paRGB , 1 ) )
            liRow = INT( RAND() * liVal )
            @ laRowFadeOut( liCol + 1 ) + liRow + ALEN( paRGB , 1 ) , liCol say GetChar()
        ENDFOR 
    ENDIF 
    
ENDDO 

* // c l e a n u p
=SetScreen( 2 )
ON KEY LABEL F12
RELEASE paRGB, pbExit

* // f u n c t i o n s
FUNCTION GetChar()
    RETURN CAST( ROUND( RAND() * 96 , 0 ) as C( 1 ) )
ENDFUNC 
FUNCTION ExitLoop
    pbExit = .T.
    CLEAR 
ENDPROC 
FUNCTION SetScreen
LPARAMETERS vVariante as Integer
    DO CASE 
    CASE vVariante = 1
        _screen.FontName = [OCR A EXTENDED]
        _screen.FontSize = 11
        _screen.FontBold = .F.
        _screen.BackColor = paRGB( 1 )
        _screen.ForeColor = paRGB( 6 )
    CASE vVariante = 2
        _screen.FontName = [Consolas]
        _screen.FontSize = 10
        _screen.FontBold = .F.
        _screen.BackColor = RGB(255,255,255)
        _screen.ForeColor = RGB(0,0,0)
    ENDCASE 
ENDFUNC 

Viel Spaß beim Anschauen :) und nicht vergessen: Mit F12 geht's zurück in die Realität! ;)

05.05.17 EDIT: verbesserte Version eingefügt...

Keine Kommentare:

Kommentar veröffentlichen