'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *'
'* Line Demonstration Screen Saver                 Version 2.1 *'
'*                                                             *'
'* Written by Zsolt Nagy Perge in Nov. 1997.                   *'
'* Modified in Oct. 1999: Mouse port 02F8 check was added.     *'
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *'

DEFINT A-Z
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *'
'* Function Declarations                                       *'
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *'
DECLARE SUB Delay ()
DECLARE SUB SetColor ()
DECLARE SUB FadeColor ()
DECLARE SUB ResetRGBPalette ()
DECLARE SUB ResetCoordinate ()
DECLARE SUB SetRGBPalette (C, RColor, GColor, BColor)
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *'
'* Screen Information                                          *'
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *'
CONST Minx = 0          ' Window Left Side Coordinate
CONST Miny = 0          ' Window Upper Side Coordinate
CONST Maxx = 640        ' Window Right Side Coordinate
CONST Maxy = 350        ' Window Lower Side Coordinate
CONST Midx = Maxx / 2   ' Window Horizontal Center
CONST Midy = Maxy / 2   ' Window Vertical Center
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *'
'* Line Setup                                                  *'
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *'
CONST NL = 2            ' Number of flying lines
CONST MCL = 5           ' Maximal Color Limit (1 to 15)
CONST PP = 30           ' Pause Probability
CONST MinSize = 20      ' Line Coil Loop Minimal Size
CONST MaxSize = 50      ' Line Coil Loop Maximal Size
CONST MinDelay = 500    ' Line Coil Loop Delay
CONST MaxDelay = 1000   ' Line Coil Loop Delay
CONST FDL& = 5000       ' Fading Delay Length
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *'
'* Variable Declarations                                       *'
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *'
COMMON SHARED CC                        ' Color Counter
COMMON SHARED DL&                       ' Delay Length
DIM SHARED C(NL)                        ' Color
DIM SHARED R(MCL + 1), G(MCL + 1), B(MCL + 1)       ' R/G/B
DIM SHARED Rm(MCL + 1), Gm(MCL + 1), Bm(MCL + 1)    ' R/G/B Direction
DIM SHARED x1(NL), y1(NL)               ' 1. x and y Coordinates
DIM SHARED x2(NL), y2(NL)               ' 2. x and y Coordinates
DIM SHARED x1m(NL), y1m(NL)             ' 1. x and y Speed & Movement
DIM SHARED x2m(NL), y2m(NL)             ' 2. x and y Speed & Movement
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *'
'* Initialization                                              *'
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *'
Initialization:
    RANDOMIZE TIMER
    ResetRGBPalette
    ResetCoordinate
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *'
'* Main Loop                                                   *'
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *'
Main:
    SCREEN 9
    WIDTH 80, 25
    CLS
   
    FOR CC = 1 TO MCL
        PALETTE CC, CC
    NEXT CC

    DO
        p2F8 = INP(&H2F8)
        MC = MC + NL
        Stp = RND * 6 + 2
        DL& = RND * (MaxDelay - MinDelay) + MinDelay
       
        ' Clearing Fade Loop
        IF MC > 100 - PP AND RND * 99 + 1 < 50 THEN
            FOR MC = 0 TO 1000
                ' Keyboard check
                IF NOT INKEY$ = "" THEN EXIT DO
               
                ' Mouse check
                IF NOT p2F8 = INP(&H2F8) THEN EXIT DO
               
                ' Fading Delay
                FOR TC& = 0 TO FDL&: NEXT TC&

                SetColor
            NEXT MC
            MC = 0
            FadeColor
            CLS
            ResetCoordinate
            ResetRGBPalette
        END IF

        ' Line Information Change
        FOR LC = 1 TO NL
            
            ' New Color
            C(LC) = RND * MCL
           
            ' New x Speed & Movement
            IF x1m(LC) > 0 THEN x1m(LC) = -RND * Stp * 2 ELSE x1m(LC) = RND * Stp * 2
            IF x2m(LC) > 0 THEN x2m(LC) = -RND * Stp * 2 ELSE x2m(LC) = RND * Stp * 2
  
            ' New y Speed & Movement
            IF y1m(LC) > 0 THEN y1m(LC) = -RND * Stp ELSE y1m(LC) = RND * Stp
            IF y2m(LC) > 0 THEN y2m(LC) = -RND * Stp ELSE y2m(LC) = RND * Stp

            ' x Speed & Movement Control
            IF x1(LC) < 0 THEN x1m(LC) = RND * Stp
            IF x2(LC) < 0 THEN x2m(LC) = RND * Stp
            IF x1(LC) > Midx THEN x1m(LC) = -RND * Stp
            IF x2(LC) > Midx THEN x2m(LC) = -RND * Stp

            ' y Speed & Movement Control
            IF y1(LC) < 0 THEN y1m(LC) = RND * Stp
            IF y2(LC) < 0 THEN y2m(LC) = RND * Stp
            IF y1(LC) > Midy THEN y1m(LC) = -RND * Stp
            IF y2(LC) > Midy THEN y2m(LC) = -RND * Stp
        NEXT LC
    
        ' Line Coil Loop
        FOR CL = 0 TO RND * (MaxSize - MinSize) + MinSize
            FOR LC = 1 TO NL

                SetColor
               
                ' Keyboard check
                IF NOT INKEY$ = "" THEN EXIT DO
               
                ' Mouse check
                IF NOT p2F8 = INP(&H2F8) THEN EXIT DO

                LINE (x1(LC), y1(LC))-(x2(LC), y2(LC)), C(LC)
                LINE (Maxx - x1(LC), y1(LC))-(Maxx - x2(LC), y2(LC)), C(LC)
                LINE (x1(LC), Maxy - y1(LC))-(x2(LC), Maxy - y2(LC)), C(LC)
                LINE (Maxx - x1(LC), Maxy - y1(LC))-(Maxx - x2(LC), Maxy - y2(LC)), C(LC)
               
                x1(LC) = x1(LC) + x1m(LC)
                x2(LC) = x2(LC) + x2m(LC)
                y1(LC) = y1(LC) + y1m(LC)
                y2(LC) = y2(LC) + y2m(LC)
       
                Delay
            NEXT LC
        NEXT CL
    LOOP
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *'
'* Termination                                                 *'
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *'
Termination:
    SCREEN 0
    CLS
    SYSTEM
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *'

SUB Delay
    FOR TC& = 0 TO DL&
        RN = RND
    NEXT TC&
END SUB

SUB FadeColor
    FOR CC = MCL TO 0 STEP -1
        FOR RGBC = 1 TO 64
            IF R(CC) > 0 THEN R(CC) = R(CC) - 1
            IF G(CC) > 0 THEN G(CC) = G(CC) - 1
            IF B(CC) > 0 THEN B(CC) = B(CC) - 1
            IF R(CC) < 0 THEN R(CC) = R(CC) + 1
            IF G(CC) < 0 THEN G(CC) = G(CC) + 1
            IF B(CC) < 0 THEN B(CC) = B(CC) + 1
            SetRGBPalette CC, R(CC), G(CC), B(CC)
           
            ' Fading Delay
            FOR TC& = 0 TO 2 * FDL&: NEXT TC&
        NEXT RGBC
    NEXT CC
END SUB

SUB ResetCoordinate
    FOR LC = 1 TO NL
        x1(LC) = RND * Midx
        y1(LC) = RND * Midy
        x2(LC) = RND * Midx / 2
        y2(LC) = RND * Midy / 2
    NEXT LC
END SUB

SUB ResetRGBPalette
    FOR CC = 0 TO MCL
        R(CC) = RND * 60 + 2
        G(CC) = RND * 60 + 2
        B(CC) = RND * 60 + 2
        Rm(CC) = RND / 2 + 1: IF RND * 10 > 5 THEN Rm(CC) = -Rm(CC)
        Gm(CC) = RND / 2 + 1: IF RND * 10 > 5 THEN Rm(CC) = -Rm(CC)
        Bm(CC) = RND / 2 + 1: IF RND * 10 > 5 THEN Rm(CC) = -Rm(CC)
    NEXT CC
END SUB

SUB SetColor
    IF CC > MCL THEN CC = 0 ELSE CC = CC + 1

    IF R(CC) <= 0 THEN Rm(CC) = RND / 2 + 1: R(CC) = 0
    IF G(CC) <= 0 THEN Gm(CC) = RND / 2 + 1: G(CC) = 0
    IF B(CC) <= 0 THEN Bm(CC) = RND / 2 + 1: B(CC) = 0
    IF R(CC) >= 63 THEN Rm(CC) = -1 * RND - 1: R(CC) = 63
    IF G(CC) >= 63 THEN Gm(CC) = -1 * RND - 1: G(CC) = 63
    IF B(CC) >= 63 THEN Bm(CC) = -1 * RND - 1: B(CC) = 63
              
    SetRGBPalette CC, R(CC), G(CC), B(CC)
              
    R(CC) = R(CC) + Rm(CC)
    G(CC) = G(CC) + Gm(CC)
    B(CC) = B(CC) + Bm(CC)
END SUB

SUB SetRGBPalette (C, RColor, GColor, BColor)
   
    ' Color Overflow Control
    IF RColor > 63 THEN RColor = 63
    IF GColor > 63 THEN GColor = 63
    IF BColor > 63 THEN BColor = 63
    IF RColor < 0 THEN RColor = 0
    IF GColor < 0 THEN GColor = 0
    IF BColor < 0 THEN BColor = 0

    OUT &H3C7, C

    OUT &H3C9, RColor
    OUT &H3C9, GColor
    OUT &H3C9, BColor
END SUB