Keskustelu: Koodit: QB: Starfield ja StarTrek

DECLARE SUB MainTitle ()
DECLARE SUB Menus ()
DECLARE SUB Story ()
DECLARE SUB NewStar ()
DECLARE SUB DrawStars ()
DECLARE SUB HideStars ()
DECLARE FUNCTION MenuResult! (XPos!, YPos!, DefaultIndex!, MenuCount!)
DECLARE SUB OUTColor (ColorSlot!)
DECLARE SUB Pause (Delay AS SINGLE)
DECLARE SUB SetColors ()
DECLARE FUNCTION SolveAngle! (x1!, y1!, x2!, y2!)
DECLARE SUB DrawShots ()
DECLARE SUB HideShots ()

    DIM SHARED OnAir AS INTEGER
    DIM SHARED Menu(1 TO 7) AS STRING

'Background stars
    TYPE BackgroundStar
        X AS SINGLE
        Y AS SINGLE
        StartX AS SINGLE
        StartY AS SINGLE
        Angle AS SINGLE
        Speed AS SINGLE
        Distance AS SINGLE
        Visible AS INTEGER
        Shown AS INTEGER
    END TYPE

    DIM SHARED Star(50) AS BackgroundStar
    DIM SHARED NewStarDelay AS INTEGER
    CONST StarDelay = 1

    TYPE ShotType
        Speed AS SINGLE
        Angle AS INTEGER
        Clr AS SINGLE
        Distance AS SINGLE
        Visible AS INTEGER
        CX AS SINGLE
        CY AS SINGLE
    END TYPE

        DIM SHARED Shot(9) AS ShotType
        DIM SHARED LastShotSide
            LastShotSide = 70

'Color tables
    TYPE ColorTable
        Red AS SINGLE
        Green AS SINGLE
        Blue AS SINGLE
    END TYPE

    DIM SHARED RGBColor(0 TO 255) AS ColorTable
    DIM SHARED Brightness AS SINGLE

    DIM SHARED XTurning AS SINGLE, YTurning AS SINGLE
    DIM SHARED Spin AS SINGLE, SpinAccel AS SINGLE

ON ERROR RESUME NEXT
    'Settings
    DIM SHARED ShowStars AS INTEGER
    DIM SHARED FancyMenu AS INTEGER
    FancyMenu = -1

    SCREEN 13

    Brightness = 100
    OnAir = 0

    SetColors

    Story
    MainTitle
    Menus

    '(!) DISTANCE:
        'eX = Star(i).StartX - Star(i).x: eY = Star(i).StartY - Star(i).y
        'Dist = SQR((ABS(eX) * ABS(eX)) + (ABS(eY) * ABS(eY)))

CLS
DO

    HideStars
    HideShots

    XTurning = (ABS(XTurning) - .05) * SGN(XTurning)
    IF ABS(XTurning) < .05 THEN XTurning = 0
    IF ABS(XTurning) > 2 THEN XTurning = 2 * SGN(XTurning)

    YTurning = (ABS(YTurning) - .05) * SGN(YTurning)
    IF ABS(YTurning) < .05 THEN YTurning = 0
    IF ABS(YTurning) > 2 THEN YTurning = 2 * SGN(YTurning)

    SpinAccel = (ABS(SpinAccel) - .02) * SGN(SpinAccel)
    IF ABS(SpinAccel) < .02 THEN SpinAccel = 0
        Spin = Spin + SpinAccel

    DrawStars
    DrawShots

    LINE (157, 100)-(163, 100), 32
    LINE (160, 97)-(160, 103), 32
    PSET (160, 100), 45
    CIRCLE (160, 100), 2, 40
    SELECT CASE INKEY$
        CASE CHR$(0) + "K": XTurning = XTurning - .2: SpinAccel = SpinAccel + .04
        CASE CHR$(0) + "H": YTurning = YTurning - .2
        CASE CHR$(0) + "M": XTurning = XTurning + .2: SpinAccel = SpinAccel - .04
        CASE CHR$(0) + "P": YTurning = YTurning + .2
        CASE CHR$(13)
            FOR i = 0 TO UBOUND(Shot)
                IF NOT Shot(i).Visible THEN
                    Shot(i).Distance = 0
                    Shot(i).CX = 160: Shot(i).CY = 100
                    Shot(i).Speed = 10
                    Shot(i).Angle = 180 - LastShotSide - Spin
                    LastShotSide = -LastShotSide
                    Shot(i).Clr = 126
                    Shot(i).Visible = -1
                    FOR f = 3500 TO 1000 STEP -250
                        SOUND f, .05
                    NEXT
                    EXIT FOR
                END IF
            NEXT
        CASE CHR$(27): END
    END SELECT

    Pause .01

LOOP

SUB DrawShots

    FOR i = 0 TO UBOUND(Shot)
        IF Shot(i).Visible THEN
            Shot(i).Distance = Shot(i).Distance + Shot(i).Speed
            Shot(i).Speed = Shot(i).Speed * .89
            Clr = Shot(i).Clr
            Shot(i).Clr = Shot(i).Clr - 3

                Shot(i).CX = Shot(i).CX - XTurning
                Shot(i).CY = Shot(i).CY + YTurning

            IF Shot(i).Clr < 66 THEN Shot(i).Visible = False: GOTO NextShot
            Dist1 = 150 - (Shot(i).Distance / 63 * 110)
            Dist2 = Dist1 + (150 - Shot(i).Distance * 2) / 5
            a = (Shot(i).Angle + Spin - 90) * 3.141592 / 180
                x1 = COS(a) * Dist1 + Shot(i).CX
                y1 = SIN(a) * Dist1 + Shot(i).CY
                x2 = COS(a) * Dist2 + Shot(i).CX
                y2 = SIN(a) * Dist2 + Shot(i).CY
                LINE (x1, y1)-(x2, y2), Clr
        END IF
NextShot:
    NEXT

END SUB

SUB DrawStars

    NewStarDelay = NewStarDelay - 1
    IF NewStarDelay <= 0 THEN
        NewStar
        NewStarDelay = StarDelay
    END IF


    FOR i = 0 TO UBOUND(Star)
        IF Star(i).Visible THEN

            a = (Star(i).Angle - 90) * 3.141592 / 180
                Star(i).X = COS(a) * Star(i).Distance / 3 + Star(i).StartX
                Star(i).Y = SIN(a) * Star(i).Distance / 3 + Star(i).StartY
                Star(i).StartX = Star(i).StartX - XTurning
                Star(i).StartY = Star(i).StartY + YTurning

            IF Star(i).X < 0 OR Star(i).X > 319 OR Star(i).Y < 0 OR Star(i).Y > 199 THEN
                Star(i).Visible = 0
                GOTO NextStar
            END IF

            Clr = Star(i).Distance * .5
            IF Clr > 65 THEN Clr = 65

            a = SolveAngle(160, 100, Star(i).X, Star(i).Y)
            eX = 160 - Star(i).X: eY = 100 - Star(i).Y
            Dist = SQR((ABS(eX) * ABS(eX)) + (ABS(eY) * ABS(eY)))
            a = (a + Spin - 90) * 3.141592 / 180
                X = COS(a) * Dist + 160
                Y = SIN(a) * Dist + 100

            IF Clr >= 0 AND POINT(Star(i).X, Star(i).Y) = 0 THEN
                PSET (X, Y), Clr
                Star(i).Shown = -1
            ELSE
                Star(i).Shown = 0
            END IF
            Star(i).Distance = Star(i).Distance + Star(i).Speed
            Star(i).Speed = Star(i).Speed * 1.1
        END IF
NextStar:
    NEXT

END SUB

SUB HideShots

    FOR i = 0 TO UBOUND(Shot)
        IF Shot(i).Visible THEN
            Dist1 = 150 - (Shot(i).Distance / 63 * 110)
            Dist2 = Dist1 + (150 - Shot(i).Distance * 2) / 5
            a = (Shot(i).Angle + Spin - 90) * 3.141592 / 180
                x1 = COS(a) * Dist1 + Shot(i).CX
                y1 = SIN(a) * Dist1 + Shot(i).CY
                x2 = COS(a) * Dist2 + Shot(i).CX
                y2 = SIN(a) * Dist2 + Shot(i).CY
                LINE (x1, y1)-(x2, y2), 0
        END IF
    NEXT

END SUB

SUB HideStars

    FOR i = 0 TO UBOUND(Star)
        IF Star(i).Visible AND Star(i).Shown THEN
            a = SolveAngle(160, 100, Star(i).X, Star(i).Y)
            eX = 160 - Star(i).X: eY = 100 - Star(i).Y
            Dist = SQR((ABS(eX) * ABS(eX)) + (ABS(eY) * ABS(eY)))
            a = (a + Spin - 90) * 3.141592 / 180
                X = COS(a) * Dist + 160
                Y = SIN(a) * Dist + 100

            PSET (X, Y), 0
        END IF
    NEXT

END SUB

SUB MainTitle


    Title$ = "STARTREK"
    CLS : COLOR 1: LOCATE 1, 1: PRINT Title$

    FOR Size = 0 TO 4 STEP .1
        YPos = YPos - .5
        Clr = Clr + .6
        BaseColor = Clr
        HideStars
        DrawStars
        Pause .01
            FOR Y = 0 TO 7
                Top = 60
                FOR X = 0 TO LEN(Title$) * 8
                    c = POINT(X, Y)
                    Tx1 = 160 - (Size * LEN(Title$) * 8 / 2) + (X * Size)
                    Ty1 = Top - (Size * LEN(Title$) / 2) + (Y * Size) + YPos
                    Tx2 = Tx1 + Size - 1: Ty2 = Ty1 + Size - 1
                    Top = Top - .2

                    BaseColor = BaseColor - .01
                    DrawColor = BaseColor - (X / 8) - (Y / 3) + RND
                    IF DrawColor < 0 THEN DrawColor = 0
                    IF c > 0 THEN LINE (Tx1, Ty1)-(Tx2, Ty2), DrawColor, BF
    NEXT X, Y, Size
    COLOR 0: LOCATE 1, 1: PRINT Title$


    Clr = 100
    Title$ = "Puhveli 2004"
    COLOR 1
    LOCATE 15, 1: PRINT Title$
    LOCATE 16, 1: PRINT SPACE$(LEN(Title$))
    SpeedStep = .01
    Size = 0
    DO
        Size = Size + SpeedStep
        Clr = Clr + .2
        SpeedStep = SpeedStep + .02
        BaseColor = Clr
        HideStars
        DrawStars
        Pause .01
        FOR Y = 0 TO 14
            Top = 80
            FOR X = 0 TO LEN(Title$) * 8
                c = POINT(X, Y + 112)
                Tx1 = 160 - (Size * LEN(Title$) * 8 / 2) + (X * Size)
                Ty1 = Top - (Size * LEN(Title$) / 2) + (Y * Size)
                Tx2 = INT(Tx1 + Size - 1): Ty2 = INT(Ty1 + Size - 1)
                Top = Top + ((1 - Size) / 10)

                BaseColor = BaseColor - .002
                DrawColor = (BaseColor - (X / 8) - (Y / 3) + RND) * SGN(c)
                IF DrawColor < 1 OR DrawColor > 64 THEN LINE (Tx1, Ty1)-(Tx2, Ty2), DrawColor, BF
        NEXT X, Y
    LOOP UNTIL Size >= 1
    LINE (0, 70)-(319, 199), 0, BF

END SUB

FUNCTION MenuResult (XPos, YPos, DefaultIndex, MenuCount)

    Index = DefaultIndex
    ShadowClr = 0
    ShadowFade = 0
    GOSUB DrawMenus

    IF FancyMenu THEN MenuBrightness = 0 ELSE MenuBrightness = 1: GOSUB DrawMenus

    DO
    IF ShadowClr > 30 THEN ShadowFade = ShadowFade - .1
    IF ShadowClr < 30 THEN ShadowFade = ShadowFade + .1
    ShadowClr = ShadowClr + ShadowFade
        IF MenuBrightness < 1 THEN MenuBrightness = MenuBrightness + .2: GOSUB DrawMenus

        Pause .01
        HideStars
        DrawStars

        SELECT CASE INKEY$
            CASE CHR$(0) + "H": Index = Index - 1
                IF Index < 1 THEN Index = MenuCount
                GOSUB DrawMenus
            CASE CHR$(0) + "P": Index = Index + 1
                IF Index > MenuCount THEN Index = 1
                GOSUB DrawMenus
            CASE CHR$(13): EXIT DO
            CASE CHR$(27): Index = 0: EXIT DO
        END SELECT

    LOOP
    IF FancyMenu THEN
        FOR MenuBrightness = 1 TO 0 STEP -.2
            HideStars
            DrawStars
            GOSUB DrawMenus
            Pause .01
        NEXT
    ELSE
        MenuBrightness = 0: GOSUB DrawMenus
    END IF

    MenuResult = Index
    EXIT FUNCTION

'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ

DrawMenus:
        FOR i = 1 TO MenuCount
            X = INT(XPosition - (LEN(Menu(i)) / 2 * 8))
            Y = INT(YPosition - (MenuCount / 2) + ((i - 1) * 2 * 7))
            COLOR 1
            LOCATE 23, 1
            PRINT Menu(i)

            FOR Y = 0 TO 9
            FOR X = 0 TO LEN(Menu(i)) * 8

                Tx = INT(XPos - (LEN(Menu(i)) * 4) + X)
                Ty = INT(YPos - (MenuCount * 17 / 2) + (i * 17) + Y)
                SelY = INT(YPos - (MenuCount * 17 / 2) + (Index * 17) + Y)

                c = POINT(X, Y + 176)
                IF FancyMenu THEN
                    eX = XPos - Tx: eY = SelY - Ty
                    Clr = 50 - (SQR((ABS(eX) * ABS(eX)) + (ABS(eY) * ABS(eY))) / 1.7)
                    IF i = Index THEN Clr = Clr + 15
                ELSE
                    IF i = Index THEN Clr = 50 ELSE Clr = 20
                END IF

                IF Clr < 0 THEN Clr = 0
                Clr = Clr * MenuBrightness
                IF c = 1 THEN
                    PSET (Tx, Ty), Clr
                    IF FancyMenu THEN PSET (Tx, Ty + 1), Clr / 2
                ELSEIF FancyMenu THEN
                    IF POINT(X, Y + 177) = 1 THEN PSET (Tx, Ty), Clr / 2
                END IF
            NEXT X, Y

        NEXT
RETURN

END FUNCTION

SUB Menus

LastMenu = 1
MainMenu:
    Menu(1) = "Play intro"
    Menu(2) = "Set things"
    Menu(3) = "Give a poo ('Xit)"

    SELECT CASE MenuResult(160, 120, LastMenu, 3)
        CASE 1: EXIT SUB
        CASE 2: LastMenu = 1: GOTO Settings
        CASE ELSE
            FOR Brightness = Brightness TO 0 STEP -.5
                FOR c = 0 TO 255: OUTColor c: NEXT
            NEXT
            END
    END SELECT


Settings:
    IF FancyMenu THEN Menu(1) = "Show plain menus" ELSE Menu(1) = "Show fancy menus"
    Menu(2) = "Validate"

    LastMenu = MenuResult(160, 120, LastMenu, 2)
    SELECT CASE LastMenu
        CASE 1: FancyMenu = NOT FancyMenu
        CASE ELSE: LastMenu = 2: GOTO MainMenu
    END SELECT: GOTO Settings

END SUB

SUB NewStar

    FOR i = 0 TO UBOUND(Star)
        IF NOT Star(i).Visible THEN
            Star(i).X = RND * 320: Star(i).Y = RND * 200
            Star(i).StartX = Star(i).X: Star(i).StartY = Star(i).Y
            Star(i).Angle = SolveAngle(160, 100, Star(i).X, Star(i).Y)
            Star(i).Speed = RND * .1
            Star(i).Distance = 1: Star(i).Visible = -1
            Star(i).Shown = 0
            EXIT FOR
        END IF
    NEXT

END SUB

SUB OUTColor (ColorSlot)

    OUT &H3C8, ColorSlot
    OUT &H3C9, RGBColor(ColorSlot).Red * Brightness / 100
    OUT &H3C9, RGBColor(ColorSlot).Green * Brightness / 100
    OUT &H3C9, RGBColor(ColorSlot).Blue * Brightness / 100

END SUB

SUB Pause (Delay AS SINGLE)

    DIM StartTime AS SINGLE
    DIM CurrentTime AS SINGLE

    StartTime = TIMER: DO: CurrentTime = TIMER
    LOOP UNTIL CurrentTime - StartTime > Delay OR CurrentTime < StartTime

END SUB

SUB SetColors

    RGBColor(1).Red = 0
    RGBColor(1).Green = 0
    RGBColor(1).Blue = 0
        OUTColor 1

    FOR i = 2 TO 65
        RGBColor(i).Red = i - 2
        RGBColor(i).Green = i - 2
        RGBColor(i).Blue = i - 2
        OUTColor i
    NEXT

    FOR i = 66 TO 130
        RGBColor(i).Red = i - 66
        RGBColor(i).Green = i - 66
        RGBColor(i).Blue = 0
        OUTColor i
    NEXT

END SUB

FUNCTION SolveAngle (x1, y1, x2, y2)

    eX = x1 - x2
    eY = y1 - y2

    IF x2 > x1 AND eY = 0 THEN
        Angle = 90
    ELSE
        Angle = -45 / ATN(1) * ATN(eX / eY)
        IF y2 > y1 THEN Angle = Angle + 180
        IF x2 < x1 AND y2 < y1 THEN Angle = Angle + 360
    END IF
    SolveAngle = Angle

END FUNCTION

SUB Story

    DIM Wave(999) AS LONG
    WaveWidth = 2

    DIM Text(1 TO 4) AS STRING

    Clr = 0
    Index = 0

    DO
        d = d + 1

       c = c - .05
       Clr = Clr + c
    IF Clr < 0 THEN d = 0: Clr = 0: c = 2.5: Index = Index + 1

    SELECT CASE Index
        CASE 1
            Text(1) = "Space, the final frontier..."
            TextCount = 1
        CASE 2
            Text(1) = "These are the voyagers"
            Text(2) = "of the starship Enterprise"
            TextCount = 2
        CASE 3
            Text(1) = "Its continuing mission"
            Text(2) = "to explore strange new worlds"
            TextCount = 2
        CASE 4
            Text(1) = "To seek out new life"
            Text(2) = "and new civilizations"
            TextCount = 2
        CASE 5
            Text(1) = "To offer us a great"
            Text(2) = "ZIUUM*FOOM*BAM experience"
            TextCount = 2
        CASE ELSE: EXIT DO
    END SELECT


    FOR i = 1 TO TextCount
        Title$ = Text(i)
        Row = 10 - INT(TextCount / 2) + i * 2
        Column = 20 - INT(LEN(Title$) / 2)
        COLOR Clr: IF Clr < 5 THEN COLOR 0
        LOCATE Row, Column: PRINT Title$

        Top = (Row * 8) - 9
        FOR X = Column * 8 - 8 TO Column * 8 + (LEN(Title$) * 8) STEP WaveWidth
            Y = INT(SIN((X - d) / 5)) + Top + 1
            GET (X, Top)-(X + WaveWidth, Top + 8), Wave
            LINE (X, Top - 1)-(X + WaveWidth, Top + 11), 0, BF
            PUT (X, Y), Wave, PSET
        NEXT
    NEXT
        HideStars


        DrawStars
        Pause .01
    LOOP WHILE INKEY$ = ""

END SUB