1,000 Games/Disc2.iso/CASINO/PRO31/BLACKJCK.BAS

BASIC Source File | 1991-10-30 | 46KB | 1,579 lines

DEFINT A-Z

DECLARE SUB Instructions (User)
DECLARE SUB BlackJack ()
DECLARE SUB Zeeks ()
DECLARE SUB Credits ()
DECLARE SUB Ending (A$)
DECLARE SUB Wins ()
DECLARE SUB Insults ()
DECLARE SUB Text (A$, B$)
DECLARE SUB ShowHigh ()
DECLARE SUB GetAccount (User%, Name$, Money AS LONG)
DECLARE SUB NewAccount (Name$, User%)
DECLARE SUB Title ()
DECLARE SUB UdCom ()
DECLARE SUB UdPlayer ()
DECLARE SUB DrawCard (X, Y, Num, Suit, up)
DECLARE SUB Shuffle ()
DECLARE SUB InitScreen ()
DECLARE SUB GiveComputer (up)
DECLARE SUB GivePlayer ()
DECLARE SUB PlaceBet ()
DECLARE SUB Deal ()
DECLARE SUB Blink (As$)
DECLARE SUB SwitchScreen (Scrn%)
DECLARE SUB MoneyPrint (A AS LONG)
DECLARE SUB WaitKey ()
DECLARE SUB Warning ()

DECLARE FUNCTION Getkey$ ()
DECLARE FUNCTION Strip$ (A$)
DECLARE FUNCTION Month ()
DECLARE FUNCTION Year ()
DECLARE FUNCTION Day ()
DECLARE FUNCTION JulianDay! (M, D, Y)

CLEAR , , 3000
CONST True = -1, False = NOT True
TYPE CardType
    Number AS INTEGER
    Suit AS INTEGER
    up AS INTEGER
END TYPE
TYPE Acctype
    Used AS INTEGER
    UserName AS STRING * 16
    password AS STRING * 8
    Money AS LONG
    Plays AS INTEGER
    LastTime AS SINGLE
END TYPE
TYPE HighType
    UserName AS STRING * 16
    Money AS LONG
    Plays AS INTEGER
END TYPE
DIM SHARED Number$(13), Suit$(4), BigSuit$(4)
DIM SHARED card(52) AS CardType, Player(10) AS CardType, Computer(10) AS CardType
DIM SHARED NextCard AS INTEGER, ComCard AS INTEGER, PlayCard AS INTEGER
DIM SHARED ComScore AS INTEGER, PlayScore AS INTEGER, bet AS SINGLE
DIM SHARED Money AS LONG, XC AS INTEGER, YC AS INTEGER, XP AS INTEGER, YP AS INTEGER
DIM SHARED Characters$(128)
DIM SHARED Insult$(20), Win$(20), NumInsults, NumWin
DIM SHARED Last
DIM SHARED IRQ, Ikey$, AfterUpdate
DIM Buffer AS Acctype, BufferA AS HighType, BufferB AS HighType

NumInsults = 14
NumWin = 14
DATA U7E1R3F1D3NL5D4BR2
DATA U8R4F1D2G1NL4F1D2G1NL4BR3
DATA BU1F1R3NE1L3H1U6E1R3F1BR2BD7
DATA U8R4F1D6G1NL4BR3
DATA U8NR5D4NR3D4R5BR2
DATA U8NR5D4NR3D4BR7
DATA U8R4NF1BD8NL4E1U2H1NL1BR3BD4
DATA U8D4R5NU4D4BR2
DATA NR4R2U8NL2R2BR2BD8
DATA BU1NU1F1R3E1NU7BR2BD1
DATA NU8U4R1F4BU8G4BR6BD4
DATA NU8R5BR2
DATA U8F3E3D8BR2
DATA U8F6NU6D2BR2
DATA U8R5D8NL5BR2
DATA U8R4F1D2G1NL4BR3BD4
DATA BU1U6E1R3F1D4G3L1H1BR4NH2F1BR2
DATA U8R4F1D2G1L4R1F4BR2
DATA BU1F1R3E1U2H1L3H1U2E1R3F1BR2BD7
DATA BU8R6L3D8BR5
DATA NU8R5NU8BR2
DATA BU2NU6F2R1E2NU6BR2BD2
DATA NU8E3F3NU8BR2
DATA U1E6U1BL6D1F6D1BR2
DATA BR3U4H2U2BR4D2G2BR4BD4
DATA NR5U2E5U1NL5BR2BD8
FOR A = ASC("A") TO ASC("Z")
    READ Characters$(A)
NEXT
Characters$(32) = "BR7"
Characters$(63) = "br4u0bu2u1e3h2l3g1BM+8,+7"
Characters$(45) = "BU3R4BR2BD3"
DEF Fnr (X) = INT(RND(1) * X + 1)
Suit$(1) = "BR2H3UERFERFDG3U3GU2GUR4DLD"
Suit$(2) = "R3HUEFU3GHEL3FGHD3EFD2U4RDL"
Suit$(3) = "BU3F2E2H2G2R3HD2"
Suit$(4) = "BRR2LU2L2R4UL4E2FL"
BigSuit$(1) = "HUH2UH2UH2UHU3EUE2R3F2E2R3F2DFD3GDG2DG2DG2DGBU5P4,4"
BigSuit$(2) = "L3ER2HU5G3L3H2U3E2R3FEH2U3E2R3F2D3G2FER3F2D3G2L3H3D5F2L2BU10P0,0"
BigSuit$(3) = "H3UH2UH3E3UE2UE3F3DF2DF3G3DG2DG3BU5P4,4"
BigSuit$(4) = "L2EU7G3L2H2U4EUE7F7DFD4G2L2H3D7FL2BU15P0,0"
Number$(1) = "U4E2F2D2NL3D2"
Number$(2) = "BU5ER2FDGL2GD2R4"
Number$(3) = "BR3L2HBU4ER2FDGLRFDG"
Number$(4) = "BR3U6G3DR4"
Number$(5) = "BR3L2HBU5R4L4D2R3FD2G"
Number$(6) = "BR3L2HU4ER2FBD2BL3R2FDG"
Number$(7) = "BU6R4DG3D2"
Number$(8) = "BR3L2HUEHUER2FDGL2R2FDG"
Number$(9) = "BUFR2EU2L3HUER2FD4"
Number$(10) = "R2LU5LRUBR5R2FD4GL2HU4E"
Number$(11) = "UDR3U6L2R4"
Number$(12) = "BR1HU4ER2FD4GLBUF2"
Number$(13) = "U6BR4G3F3"
DATA "Ha Ha!   Zeek got ya!  Good work Ray!"

DATA "Stupid! You really messed up that one! Maybe next time..."
DATA "Wow! That's one for the books..."
DATA "Ha Ha Ha!  How stupid! I knew you would lose!"
DATA "Wow! How bad can you get?"
DATA "Real good playing there, Ray!"
DATA "Nice play, Shakespeare.   When's act II?"
DATA "Good job. Next time, try to win!"
DATA "In your face, Ray!"
DATA "You win...       SIEKE!!"
DATA "Yo dork,  who taught you how to play...  Mr. Rogers?"
DATA "...and now for the further adventures of BrokeMan!"
DATA "Here's a tip. Don't ever go to Las Vegas."

FOR A = 1 TO NumInsults - 1
    READ Insult$(A)
NEXT
Insult$(14) = "What a " + CHR$(34) + "Jerk" + CHR$(34) + ". Who do you think you are, Pee Wee?"

DATA "Poor Zeek! How could you!"
DATA "Zeek's thugs whip out the ghetto blaster and slowly drain your screaming body of all fluids. How about that for a bad day!"
DATA "Good job, but Zeek thinks you cheated."
DATA "Zeek promises you won't do that again."
DATA "Great Job!  Zeek's thugs are waiting outside for you..."
DATA "You won again. If I were you, I'd watch my back!!!"
DATA "Zeek hates when that happens..."
DATA "Nice win... Retards luck!"
DATA "The alarm sounds as the gaurds come crashing in and graciously give you a Colombian Neck Tie free of charge! Wow,  what a deal!"
DATA "Zeek sees that ace up your sleeve, SCUMBAG!"
DATA "Zeeks thugs rip a new place of excretion for your body..."
DATA "Heroshima was a big bang. Too bad your not!"
DATA "Life goes on! But you won't!"
DATA "Ooooooo...  I'm scared now Ray!"
FOR A = 1 TO NumWin
    READ Win$(A)
NEXT

DATA yousuck.grf,Warning.Grf,KXS.BAS,KYS.BAS,KXE.BAS,KYE.BAS,PXS.BAS,PXE.BAS,PYS.BAS,PYE.BAS,ZXS.BAS,ZXE.BAS,ZYS.BAS,ZYE.BAS,RXS.BAS,RXE.BAS,RYS.BAS,RYE.BAS,end

DO
    READ A$
    IF A$ <> "end" THEN
        OPEN A$ FOR RANDOM AS #1 LEN = 1
        IF LOF(1) = 0 THEN
            CLOSE #1
            KILL A$
            COLOR 14
            BEEP
            PRINT "Zeek can't find one of his files! You better get them quick, Zeek has got a"
            PRINT "very short temper! (Is that Zeek's jackknife I see? Naa, it's couldn't be...)"
            PRINT "File "; : COLOR 6: PRINT UCASE$(A$); : COLOR 14: PRINT " is missing! Abnormal Termination!"
            COLOR 15
            END
        ELSE
            CLOSE #1
        END IF
    END IF
LOOP UNTIL A$ = "end"
Warning
Title
DO
    NextCard = 0
    StartAgain = False
    GetAccount User, Name$, Money
    Instructions User
    SwitchScreen 8
    DO
        PlaceBet
        InitScreen
        ComCard = 0
        PlayCard = 0
        Deal
        UdPlayer
        LOCATE 23, 60: PRINT "Press Esc to save."
        B$ = ""
        DO UNTIL PlayScore >= 21 OR B$ = "S" OR StartAgain
            LOCATE 19, 60
            PRINT "Hit or Stay(H/S)?"
            DO
                B$ = Getkey$
            LOOP UNTIL B$ = "H" OR B$ = "S" OR B$ = " " OR B$ = CHR$(27)
            LOCATE 19, 60
            PRINT SPACE$(17)
            IF B$ = CHR$(27) THEN
                SwitchScreen 12
                LOCATE 15, 1
                PRINT "Saving..."
                OPEN "Accounts.dat" FOR RANDOM AS #1 LEN = 40
                GET #1, User, Buffer
                Buffer.Money = Money
                Buffer.Plays = Buffer.Plays + 1
                Buffer.LastTime = JulianDay(Month, Day, Year)

                PUT #1, User, Buffer

                CLOSE
                StartAgain = True
            END IF
            IF B$ = "H" OR B$ = " " THEN
                GivePlayer
                UdPlayer
            END IF
        LOOP
        IF NOT StartAgain THEN
            SLEEP 2
            Win = False: Bust = False
            IF PlayScore = 21 THEN
                CLS
                Wins
                Win = True
                IF PlayCard = 2 THEN
                    Money = Money + INT(bet * 1.5)
                ELSEIF PlayCard < 6 THEN
                    Money = Money + bet * 2
                ELSEIF PlayCard = 6 THEN
                    Money = Money + bet * 3
                END IF
            END IF
            IF PlayScore > 21 THEN
                CLS
                Insults
                Bust = True
                Money = Money - bet
            END IF
            IF NOT Win AND NOT Bust THEN
                PCOPY 0, 1
                SCREEN 8, , 1, 0
                LINE (20, 97)-(438, 10), 0, BF
                XC = 20
                FOR A = 0 TO 1
                    DrawCard XC, YC, Computer(A).Number, Computer(A).Suit, True
                    XC = XC + 20
                NEXT
                UdCom
                Hit = True
                SCREEN 8, , 0, 0
                PCOPY 1, 0
                LOCATE 3, 60
                PRINT "Hit"
                DO UNTIL ComScore >= 21 OR NOT Hit
                    IF ComScore <= 16 THEN
                        GiveComputer True
                        UdCom
                        SLEEP 1
                    ELSE
                        Hit = False
                        LOCATE 3, 60
                        PRINT "Stay"
                        SLEEP 1
                    END IF
                LOOP
                LOCATE 4, 60
                PRINT "Score:"; ComScore
                SLEEP 3
                IF ComScore = 21 OR (ComScore > PlayScore AND ComScore < 22) THEN
                    CLS
                    Insults
                    Money = Money - bet
                END IF
                IF ComScore < PlayScore OR ComScore > 21 THEN
                    CLS
                    Wins
                    Money = Money + bet
                END IF
                IF ComScore = PlayScore THEN
                    CLS
                    Insults
                    Money = Money - bet
                END IF
            END IF
        END IF
    LOOP UNTIL StartAgain OR Money <= 0
    IF Money = 0 THEN
        CLS
        OPEN "Accounts.dat" FOR RANDOM AS #1 LEN = 40
        Buffer.Used = False
        PUT #1, User, Buffer
        CLOSE #1
        Ending K$
    END IF
    IF StartAgain THEN
        SwitchScreen (12)
        CLS
        OPEN "ZeekHigh.dat" FOR RANDOM AS #1 LEN = 22
        IF LOF(1) = 0 THEN
            BufferA.UserName = "Ray" + CHR$(255)
            FOR A = 2 TO 10
                BufferA.Plays = INT(RND(1) * 60)
                BufferA.Money = (11 - A) * 800
                PUT #1, A, BufferA
            NEXT
            BufferA.UserName = "Zeek" + CHR$(255)
            BufferA.Money = 15000
            BufferA.Plays = 1
            PUT #1, 1, BufferA
        END IF
        Fall = False
        FOR A = 1 TO 10
            GET #1, A, BufferA
            IF Strip$(BufferA.UserName) = Name$ THEN
                Fall = True
                IF BufferA.Money < Money THEN
                    BufferA.Money = Money

                    OPEN "Accounts.Dat" FOR RANDOM AS #2 LEN = 40
                    GET #2, User, Buffer
                    BufferA.Plays = Buffer.Plays
                    CLOSE #2

                    PUT #1, A, BufferA

                    DO
                        Swaps = False
                        FOR B = 1 TO 9
                            GET #1, B, BufferA
                            GET #1, B + 1, BufferB
                            IF BufferB.Money > BufferA.Money THEN
                                SWAP BufferA, BufferB
                                PUT #1, B, BufferA
                                PUT #1, B + 1, BufferB
                                Swaps = True
                            END IF
                        NEXT B
                    LOOP WHILE Swaps
                    CLOSE #1
                    ShowHigh
                    EXIT FOR
                END IF
            END IF
        NEXT
        IF NOT Fall THEN
            FOR A = 1 TO 10
                GET #1, A, BufferA
                IF Money > BufferA.Money THEN
                    FOR Move = 9 TO A STEP -1
                        GET #1, Move, BufferB
                        PUT #1, Move + 1, BufferB
                    NEXT
                    BufferA.UserName = Name$ + CHR$(255)
                    OPEN "Accounts.Dat" FOR RANDOM AS #2 LEN = 40
                    GET #2, User, Buffer
                    BufferA.Plays = Buffer.Plays
                    CLOSE #2
                    BufferA.Money = Money
                    PUT #1, A, BufferA
                    CLOSE
                    ShowHigh
                    EXIT FOR
                END IF
            NEXT
            CLOSE
        END IF
        CLS
        LOCATE 15, 20
        PRINT "Would you like to continue playing(Y/N)?"
        DO
            K$ = UCASE$(INPUT$(1))
        LOOP UNTIL K$ = "Y" OR K$ = "N"
        IF K$ = "N" THEN
            StartAgain = False
        END IF
    END IF
LOOP WHILE K$ = "Y" OR StartAgain
CLS
END



Interrupt:
    Ikey$ = INKEY$
    IF Ikey$ <> "" THEN
        IRQ = -1
    ELSE
        IRQ = 0
    END IF
RETURN
KeepBusy:
    PCOPY 0, 2
    SCREEN 7, , 0, 0
    LOCATE 23, 13
    COLOR 1
    PRINT "Please Wait..."
    AfterUpdate = True
    SCREEN 7, , 1, 0
    TIMER OFF
RETURN

SUB BlackJack
SCREEN 7, , 1, 0
'$DYNAMIC
REDIM X(150, 52) AS INTEGER
REDIM Y(150, 52) AS INTEGER
REDIM X1(150, 52) AS INTEGER
REDIM Y1(150, 52) AS INTEGER
DIM Start AS SINGLE
PCOPY 0, 2

AfterUpdate = False
ON TIMER(1) GOSUB KeepBusy
TIMER ON

DEF SEG = VARSEG(X(0, 0))
BLOAD "KXS", VARPTR(X(0, 0))

DEF SEG = VARSEG(X1(0, 0))
BLOAD "KXE", VARPTR(X1(0, 0))

DEF SEG = VARSEG(Y(0, 0))
BLOAD "KYS", VARPTR(Y(0, 0))

DEF SEG = VARSEG(Y1(0, 0))
BLOAD "KYE", VARPTR(Y1(0, 0))

IF AfterUpdate THEN
    PCOPY 2, 0
ELSE
    TIMER OFF

END IF

TIMER OFF
ON TIMER(1) GOSUB Interrupt
TIMER ON

    FOR Rev = 150 TO 0 STEP -1
        PCOPY 2, 1
        FOR Lines = 0 TO 52
            LINE (X(Rev, Lines), Y(Rev, Lines))-(X1(Rev, Lines), Y1(Rev, Lines)), 14
        NEXT
        PCOPY 1, 0
        IF IRQ THEN TIMER OFF: EXIT SUB
    NEXT
    Start = TIMER
    DO
    LOOP UNTIL TIMER - Start > 4 OR IRQ
    IF IRQ THEN TIMER OFF: EXIT SUB
    FOR Rev = 0 TO 150
        PCOPY 2, 1
        FOR Lines = 0 TO 52
            LINE (X(Rev, Lines), Y(Rev, Lines))-(X1(Rev, Lines), Y1(Rev, Lines)), 14
        NEXT
        PCOPY 1, 0
        IF IRQ THEN TIMER OFF: EXIT SUB
    NEXT
    FOR Lines = 0 TO 52
        LINE (X(150, Lines), Y(150, Lines))-(X1(150, Lines), Y1(150, Lines)), 0
    NEXT
    PCOPY 1, 0


END SUB

REM $STATIC
SUB Blink (As$)
    SwitchScreen 12
    PALETTE 4, 63
    COLOR 4
    As$ = LTRIM$(RTRIM$(As$))
    IF As$ = "" THEN STOP
    Lne = 10
    DO
        IF LEN(As$) <= 80 THEN
            LOCATE Lne, ((80 - LEN(As$)) / 2)
            PRINT As$
            As$ = ""
        ELSE
            A = 81
            DO
                A = A - 1
            LOOP UNTIL MID$(As$, A, 1) = " "
            A = A - 1: A$ = LEFT$(As$, A)
            LOCATE Lne, ((80 - LEN(LTRIM$(RTRIM$(A$)))) / 2): PRINT A$
            Lne = Lne + 1
            As$ = MID$(As$, A + 2)
        END IF
        As$ = RTRIM$(LTRIM$(As$))
    LOOP UNTIL As$ = ""
    DO
        SLEEP 3
        FOR A = 63 TO 0 STEP -1
            PALETTE 4, A
            FOR Time = 1 TO 400: NEXT
        NEXT
        A$ = INKEY$
        IF A$ = "" THEN
            SLEEP 1
            FOR A = 0 TO 63
                PALETTE 4, A
                FOR Time = 1 TO 300: NEXT
            NEXT
            A$ = INKEY$
        END IF
    LOOP WHILE A$ = ""
    SwitchScreen 8
END SUB

SUB Credits
    DIM Start AS SINGLE
    PCOPY 0, 1
    LOCATE 1, 1
    COLOR 1
    LOCATE 1, 12
    PRINT "Zeek's BlackJack"
    LOCATE 3, 9
    PRINT "July - September 1991"
    LOCATE 9, 5
    PRINT "Programmed by: Rich Geldreich"
    LOCATE 11, 13
    PRINT "Contributors:"
    LOCATE 13, 14
    PRINT "Lee Cooper"
    LOCATE 15, 13
    PRINT "Tom Gettings"
    LOCATE 17, 12
    PRINT "Jamie Williams"
    PCOPY 1, 0
    Start = TIMER
    DO
    LOOP UNTIL TIMER - Start > 10 OR IRQ
    TIMER OFF
END SUB

FUNCTION Day
    Day = VAL(MID$(DATE$, 4, 2))
END FUNCTION

SUB Deal
    GivePlayer
    GivePlayer
    GiveComputer False
    GiveComputer True
END SUB

SUB DrawCard (X, Y, Num, Suit, up)
    LINE (X + 4, Y + 4)-(X + 107, Y - 67), 0, B
    LINE (X + 5, Y + 5)-(X + 106, Y - 66), 7, BF
    PRESET (X + 5, Y + 5): PRESET (X + 106, Y - 66): PRESET (X + 106, Y + 5): PRESET (X + 5, Y - 66)
    LINE (X - 1, Y + 1)-(X + 101, Y - 71), 0, B
    LINE (X, Y)-(X + 100, Y - 70), 15, BF
    PRESET (X, Y): PRESET (X + 100, Y): PRESET (X + 100, Y - 70): PRESET (X, Y - 70)
    IF up THEN
        IF Suit = 1 OR Suit = 3 THEN
            DRAW "C4"
        ELSE
            DRAW "C0"
        END IF
        DRAW "BM" + STR$(X) + "," + STR$(Y) + "BU60BR4" + Number$(Num)
        DRAW "A2BM" + STR$(X + 97) + "," + STR$(Y - 10) + Number$(Num)
        DRAW "A0BM" + STR$(X + 4) + "," + STR$(Y - 52) + Suit$(Suit)
        DRAW "A2BM" + STR$(X + 97) + "," + STR$(Y - 18) + Suit$(Suit)
        DRAW "A0BM" + STR$(X + 50) + "," + STR$(Y - 25) + BigSuit$(Suit)
    END IF
END SUB

SUB Ending (A$)
    DIM PointsX(50) AS INTEGER, PointsY(50) AS INTEGER, Ay AS SINGLE
    DIM Blood(115) AS INTEGER
    DIM Used(25) AS INTEGER, Num(25) AS INTEGER
    DIM X(25) AS SINGLE, Y(25) AS SINGLE, X1(25) AS SINGLE, Y1(25) AS SINGLE
    DIM Y2(25) AS SINGLE, Excel(25) AS SINGLE
    DIM TEMP(12000) AS INTEGER
    SwitchScreen 12
    PALETTE 14, 0
    DEF SEG = VARSEG(TEMP(0))
    BLOAD "Yousuck.grf", VARPTR(TEMP(0))
    PALETTE 4, 0
    PUT (95, 28), TEMP, PSET
    PALETTE 4, 50
    Xs = 101: Ys = 130
    Xe = 530: Ye = 90
    Ar = 0
    FOR Ay = 0 TO 1 STEP 1 / 25
        PointsX(Ar) = Xs + (Xe - Xs) * Ay
        PointsY(Ar) = Ys + (Ye - Ys) * Ay
        Ar = Ar + 1
    NEXT
    Ar = Ar - 1
    PALETTE 5, 0
    CIRCLE (5, 15), 5, 5
    PAINT (5, 15), 5, 5
    LINE (0, 15)-(5, 0), 5
    LINE (10, 15)-(5, 0), 5
    PAINT (5, 4), 5, 5
    GET (0, 0)-(10, 20), Blood
    LINE (0, 0)-(10, 20), 0, BF
    PALETTE 5, 30
    DO
        A$ = INKEY$
    LOOP WHILE A$ <> ""
    LOCATE 23, 35: PRINT "Game Over"
    LOCATE 24, 26: PRINT "Press any key to continue...";
    Drops = 6
    FOR A = 0 TO Ar
        Used(A) = False
    NEXT
    PALETTE 1, 30: PALETTE 10, 30
    FOR A = 1 TO Drops
        DO
            A1 = Fnr(Ar + 1) - 1
        LOOP WHILE Used(A1)
        Used(A1) = True
        Num(A) = A1
        X(A) = PointsX(A1): Y(A) = PointsY(A1): X1(A) = X(A): Y1(A) = Y(A): Y2(A) = 0
        PUT (X1(A), Y1(A)), Blood
        DO
            Excel(A) = INT(RND(1) * 100) / 100
        LOOP WHILE Excel(A) < .09
    NEXT
    DO
        FOR A = 1 TO Drops
            PUT (X1(A), Y1(A)), Blood: PUT (X(A), Y(A)), Blood: X1(A) = X(A): Y1(A) = Y(A)
            Y(A) = Y(A) + Y2(A): Y2(A) = Y2(A) + Excel(A)
            IF Y(A) > 450 THEN
                PUT (X1(A), Y1(A)), Blood
                Used(Num(A)) = False
                DO
                    A1 = Fnr(Ar + 1) - 1
                LOOP WHILE Used(A1)
                Used(A1) = True
                Num(A) = A1
                X(A) = PointsX(A1): Y(A) = PointsY(A1): X1(A) = X(A): Y1(A) = Y(A): Y2(A) = 0
                PUT (X1(A), Y1(A)), Blood
                DO
                    Excel(A) = INT(RND(1) * 100) / 100
                LOOP WHILE Excel(A) < .09
            END IF
        NEXT
    LOOP UNTIL INKEY$ <> ""
    CLS
    PALETTE
    LOCATE 12, 8
    PRINT "Ollie North dips your account papers into his nifty shredder..."
    LOCATE 14, 24
    PRINT "Thank you very much for playing."
    LOCATE 16, 13
    PRINT "Don't let the door hit you in the but on the way out!"
    WaitKey
    CLS
    LOCATE 15, 32: PRINT "Lose Again?(y/n)"
    DO
        A$ = UCASE$(INPUT$(1))
    LOOP UNTIL A$ = "Y" OR A$ = "N"
END SUB

SUB GetAccount (User, Name$, Money AS LONG)
    DIM Buffer AS Acctype
    SwitchScreen 12
    DO
        Retry = False
        CLS
        DO
            LOCATE 14, 22: PRINT "Zeek would like to know who you are."
            LOCATE 16, 12: PRINT "(Just press enter to tell Zeek you would like to quit.)"
            LOCATE 15, 1: PRINT STRING$(80, 32);
            LOCATE 15, 22: LINE INPUT A$
            IF A$ = "" THEN
                CLS
                LOCATE 15, 28: PRINT "Would You Like To Quit?"
                B$ = UCASE$(INPUT$(1))
                IF B$ = "Y" THEN
                    END
                ELSE
                    CLS
                END IF
            END IF
        LOOP WHILE LEN(A$) > 14 OR A$ = ""
        A$ = UCASE$(A$)
        CLS
        LOCATE 14, 19: PRINT "Wait a second. Zeek is checking you out..."
        OPEN "Accounts.dat" FOR RANDOM AS #1 LEN = 40
        IF LOF(1) = 0 THEN
            NewAccount Name$, User
            Money = 500
            CLOSE
            EXIT SUB
        ELSE
            FOR A = 1 TO LOF(1)
                GET #1, A, Buffer
                IF Buffer.Used THEN
                    IF Strip$(Buffer.UserName) = A$ THEN
                        CLS
                        LOCATE 14, 30
                        PRINT "What's the password?"
                        LOCATE 15, 30
                        LINE INPUT Pass$
                        Pass$ = UCASE$(Pass$)
                        IF Strip$(Buffer.password) = Pass$ THEN
                            User = A
                            Name$ = A$
                            Money = Buffer.Money
                            SLEEP 1
                            CLOSE
                            EXIT SUB
                        ELSE
                            Retry = True
                            EXIT FOR
                        END IF
                    END IF
                END IF
            NEXT
            IF NOT Retry THEN
                NewAccount Name$, User
                Money = 500
                CLOSE
                EXIT SUB
            ELSE
                CLOSE
                LOCATE 15, 11
                PRINT "Bad Human! You have the wrong password. Try again stupid!!"
                WaitKey
            END IF
        END IF
    LOOP
END SUB

FUNCTION Getkey$
    K$ = UCASE$(INPUT$(1))
    IF K$ = "Q" THEN END
    Getkey$ = K$
END FUNCTION

SUB GiveComputer (up)
    IF NextCard = 0 THEN
        Shuffle
    END IF

    Computer(ComCard).Number = card(NextCard).Number
    Computer(ComCard).Suit = card(NextCard).Suit
    Computer(ComCard).up = up
    PCOPY 0, 1
    SCREEN 8, , 1, 0
    DrawCard XC, YC, Computer(ComCard).Number, Computer(ComCard).Suit, up
    SCREEN 8, , 0, 0
    PCOPY 1, 0
    XC = XC + 20
    ComCard = ComCard + 1
    NextCard = NextCard - 1
END SUB

SUB GivePlayer
    IF NextCard = 0 THEN
        Shuffle
    END IF

    Player(PlayCard).Number = card(NextCard).Number
    Player(PlayCard).Suit = card(NextCard).Suit
    Player(PlayCard).up = True
    PCOPY 0, 1
    SCREEN 8, , 1, 0
    DrawCard XP, YP, Player(PlayCard).Number, Player(PlayCard).Suit, True
    SCREEN 8, , 0, 0
    PCOPY 1, 0
    XP = XP + 20
    PlayCard = PlayCard + 1
    NextCard = NextCard - 1
END SUB

SUB InitScreen
    CLS
    LINE (0, 0)-(639, 3), 14, BF
    LINE (0, 0)-(5, 199), 14, BF
    LINE (0, 196)-(639, 199), 14, BF
    LINE (634, 0)-(639, 199), 14, BF
    LINE (439, 0)-(444, 199), 14, BF
    LINE (0, 100)-(639, 103), 14, BF
    LOCATE 2, 64
    PRINT "Computer"
    LOCATE 14, 66
    PRINT "You"
    LOCATE 16, 60
    PRINT "Money:"; : MoneyPrint Money
    LOCATE 17, 60
    PRINT "Bet:"; : MoneyPrint CLNG(bet)
    XC = 20
    YC = 85
    XP = 20
    YP = 185
END SUB

SUB Instructions (User)
    DIM Buffer AS Acctype, Dte AS SINGLE, Lst AS SINGLE

    SwitchScreen 12


    OPEN "ACCOUNTS.DAT" FOR RANDOM AS #1 LEN = 40
    IF LOF(1) = 0 THEN STOP
    GET #1, User, Buffer
    Lst = Buffer.LastTime
    CLOSE #1

    Dte = JulianDay(Month, Day, Year)

    IF Lst = Dte THEN EXIT SUB
    IF Lst = 0 THEN
        Text "WELCOME TO ZEEKS BLACKJACK", "BM120,30S8C14"
        COLOR 14
        LOCATE 6, 1
        PRINT "       Zeek greets you to his latest new way of making money! This game of"
        PRINT "   BlackJack  plays  just  like  the  real thing  except  splits  are  not"
        PRINT "   allowed(well,  that  was  just  too complicated  for  Zeek. What do you"
        PRINT "   expect from a first grade education, anyway?) "
        PRINT "       When the dealer has the same score as you, you lose the hand. Also,"
        PRINT "   the computer never cheats(well, I hope Zeek doesn't cheat...). The deck"
        PRINT "   is handled just like a real deck."
        PRINT "       The accounting system Zeek has set up is very simple. At the"
        PRINT "   beginning of a game, Zeek will ask for your  name. After  your name  is"
        PRINT "   inputted, Zeek will see if  you  have played  this  game before. If you"
        PRINT "   haven't, then Zeek will  take  ask  your  name and a password so he can"
        PRINT "   make an account for you. If you do have an  account, then Zeek will ask"
        PRINT "   for your password(choose a simple password so you don't forget it).  If"
        PRINT "   you input the correct password(upper and lowercase  are ignored),  then"
        PRINT "   you may play the game. If you input an incorrect password, then you are"
        PRINT "   asked to input your name again. If your stuck  and can't  remember your"
        PRINT "   password, then type this in at the MS-DOS prompt(making sure you are in"
        PRINT "   the directory of the game):"
        PRINT
        PRINT "   TYPE ACCOUNTS.DAT"
        PRINT
        PRINT "       All of the accounts and their passwords will be listed on the screen."

        LOCATE 30, 3: PRINT "Press any key to continue...";
        WaitKey
        CLS
        PRINT "While playing the game:"
        PRINT "   Playing Zeek's BlackJack is very simple. To get a card, press the "; CHR$(34); "H"; CHR$(34); " or"
        PRINT "spacebar keys. To stay, press the "; CHR$(34); "S"; CHR$(34); " key. The computer will automatically"
        PRINT "tally your correct score for you after each card."
        PRINT "   If you don't wish tp play the game anymore while you still have money left,"
        PRINT "press the ESC while on the play screen. This will save your game in your account"
        PRINT "for later play."
        PRINT
        PRINT "    The code for Zeek's BlackJack was made with Microsoft's Quick Basic version"
        PRINT "4.5(which has been supplied). If you make any improvements or find any bugs,"
        PRINT "please send them to me. My address is:"
        PRINT
        PRINT "Rich Geldreich"
        PRINT "410 Market Street"
        PRINT "Gloucester City, New Jersey 08030"
        PRINT "Phone [phone]"
        PRINT
        PRINT "I will be more than happy to return the media on which the program is sent on."
        PRINT
        PRINT "This program was made on a Tandy 1000 RLX hard drive system. It had an 80286, 10"
        PRINT "megahertz processor with a VGA adaptor. On an 8 megahertz machine, the"
        PRINT "introduction screens may be a little slugish. A hard drive is recommended, but"
        PRINT "not needed."
        PRINT
        PRINT "Press any key to begin..."
        WaitKey
    ELSEIF SGN(Dte - Lst) = 1 THEN
        Blink "Zeek Welcomes You Back! The Last Time You Played This Game Was " + MID$(STR$(Dte - Lst), 2) + " Day(s) Ago. Press Any Key To Play..."
    END IF

END SUB

SUB Insults
    A = Fnr(NumInsults)
    A$ = Insult$(A)
    Blink A$
END SUB

DEFSNG A-Z
FUNCTION JulianDay (M AS INTEGER, D AS INTEGER, Y AS INTEGER)
    DEFSNG A-Z
    Z = .9999
    W = INT((M - 14) / 12 + Z)
    Jd = INT(1461 * (Y + 4800 + W) / 4)
    B = 367 * (M - 2 - W * 12) / 12
    IF B < 0 THEN B = B + Z
    B = INT(B): Jd = Jd + B
    B = INT(INT(3 * (Y + 4900 + W) / 100) / 4)
    JulianDay = Jd + D - 32075 - B
END FUNCTION

DEFINT A-Z
SUB MoneyPrint (A AS LONG)
    SELECT CASE A
    CASE IS <= 999
        PRINT USING "$###"; A;
    CASE IS <= 999999
        PRINT USING "$###,###"; A;
    CASE ELSE
        PRINT USING "$###,###,###"; A;
    END SELECT
END SUB

FUNCTION Month
    Month = VAL(LEFT$(DATE$, 2))
END FUNCTION

SUB NewAccount (Name$, User)
    DIM Buffer AS Acctype
    DO
        DO
            ReInput = False
            CLS
            PRINT "You must have an account before Zeek lets you play. First, Zeek must have your"
            PRINT "name. This name will also be used in the high score board(so pick wisely)..."
            PRINT "What's your name(14 characters or less)?"
            Lne = CSRLIN
            DO
                LOCATE Lne, 1
                PRINT STRING$(80, 32);
                LOCATE Lne, 1
                LINE INPUT Name$
                SELECT CASE LEN(Name$)
                CASE IS > 14
                    LOCATE Lne + 1, 1
                    PRINT "Dirtbag!!!! Where did you learn to count. Zeek's thugs get out the jackknife"
                    PRINT "and whip off those extra characters..."
                    PRINT
                    PRINT "For those of you who are still asleep, that means ONLY 14 CHARACTERS OR LESS."
                    PRINT "Thank You."
                CASE 0
                    PRINT "Yo! Zeek wants your name!  ...or else!"
                END SELECT
            LOOP WHILE Name$ = "" OR LEN(Name$) > 14
            FOR A = Lne + 1 TO Lne + 5
                LOCATE A, 1: PRINT STRING$(80, 32);
            NEXT
            Name$ = UCASE$(Name$)
            FOR A = 1 TO 128
                GET #1, A, Buffer
                IF Buffer.Used THEN
                    IF Buffer.UserName = Name$ THEN
                        PRINT "Zeek whips out the nine and blows your head off. Please try again(that means"
                        PRINT "someone else has used that name)."
                        WaitKey
                        ReInput = True
                        EXIT FOR
                    END IF
                END IF
            NEXT
        LOOP WHILE ReInput
        LOCATE Lne + 1, 1
        PRINT "Zeek needs to know a password so nobody can rob you blind."
        PRINT "What's your password(7 characters or less)?"
        Lne = CSRLIN
        DO
            LOCATE Lne, 1
            PRINT STRING$(80, 32);
            LOCATE Lne, 1
            LINE INPUT password$
            IF password$ = "" OR LEN(password$) > 7 THEN
                PRINT "You must use at least one character and less then 8!"
            END IF
        LOOP WHILE password$ = "" OR LEN(password$) > 7
        password$ = UCASE$(password$)
        LOCATE CSRLIN + 1, 1
        PRINT "Is this correct(Y/N)?"
        DO
            A$ = UCASE$(INPUT$(1))
        LOOP UNTIL A$ = "Y" OR A$ = "N"
    LOOP WHILE A$ = "N"
    CLS
    PRINT "Thanks! Zeeks making an account for you. You start out with $500 dollars."
    PRINT "Good Luck! Your going to need it!"
    SLEEP 2
    IF LOF(1) = 0 THEN
        Buffer.Used = False
        FOR A = 1 TO 128
            PUT #1, A, Buffer
        NEXT
        Buffer.Used = True
        Buffer.UserName = Name$ + CHR$(255)
        Buffer.password = password$ + CHR$(255)
        Buffer.Money = 500
        Buffer.Plays = 0
        Buffer.LastTime = 0
        PUT #1, 1, Buffer
        User = 1
        SLEEP 1
    ELSE
        FOR A = 1 TO LOF(1)
            GET #1, A, Buffer
            IF NOT Buffer.Used THEN
                Buffer.Used = True
                Buffer.UserName = Name$ + CHR$(255)
                Buffer.password = password$ + CHR$(255)
                Buffer.Money = 500
                Buffer.Plays = 0
                Buffer.LastTime = 0
                PUT #1, A, Buffer
                EXIT FOR
            END IF
        NEXT
        User = A
    END IF
END SUB

SUB PlaceBet
    DIM Min AS LONG
    SwitchScreen 12
    CLS
    Text "BETTING TABLE", "BM180,70S12C12TA5"
    LOCATE 12, 20
    PRINT "All right Ray. How much do you want to bet?"
    LOCATE 13, 20
    PRINT "You have ";
    MoneyPrint Money: PRINT " dollars."
    Min = INT(Money * .05)
    LOCATE 14, 20
    PRINT "The minimum bet is ";
    MoneyPrint Min: PRINT " dollars."
    DO
        LOCATE 15, 20
        DO
            A$ = INKEY$
        LOOP UNTIL A$ = ""
        LINE INPUT "> "; Bt$
        bet = VAL(Bt$)
        IF bet < Min OR bet = 0 OR bet < 0 OR bet > Money THEN
            PALETTE 4, 0
            IF bet = 0 THEN
                Text "SORRY RAY YOU HAVE TO BET", "S12ta5bm60,300c4"
            ELSEIF bet > Money THEN
                Text "YOU DONT HAVE THAT MUCH IDIOT", "S12TA5BM20,310C4"
            ELSEIF bet < 0 THEN
                Text "ZEEK DOES NOT ALLOW THOSE KIND OF BETS", "S8TA5BM40,310C4"
            ELSEIF bet < Min THEN
                Text "THERES A MINIMUM SCUMBAG", "S12ta5bm100,310c4"
            END IF
            B = 63
            DO
                A = (A + 1) MOD 15
                IF A = 14 THEN
                    B = B - 1: IF B < 0 THEN B = 63
                    PALETTE 4, 65536 * INT(B)
                END IF
            LOOP UNTIL INKEY$ <> ""
            LINE (0, 320)-(639, 225), 0, BF
        END IF
        IF bet = Money THEN
            CLS
            LOCATE 5, 30: PRINT "Betting the farm, huh?"
            LOCATE 7, 30: PRINT "Zeek likes that..."
            WaitKey
        END IF
    LOOP UNTIL bet >= Min AND bet <= Money
    SwitchScreen 8
END SUB

SUB ShowHigh
    DIM BufferA AS HighType
    SwitchScreen 12
    PALETTE 15, 50
    Text "THE GOOD PLAYERS", "Bm80,50s16c14"
    Text "NAME                MONEY         PLAYS", "Bm55,100s8c15"
    LINE (55, 105)-(605, 105), 15
    PALETTE 11, 63
    FOR A = 1 TO 10
        PALETTE A, 63 - A * 3
    NEXT
    OPEN "ZEEKHIGH.DAT" FOR RANDOM AS #1 LEN = 22
    IF LOF(1) = 0 THEN
        BufferA.UserName = "Ray" + CHR$(255)
        FOR A = 2 TO 10
            BufferA.Plays = INT(RND(1) * 60)
            BufferA.Money = (11 - A) * 800
            PUT #1, A, BufferA
        NEXT
        BufferA.UserName = "Zeek" + CHR$(255)
        BufferA.Money = 15000
        BufferA.Plays = 1
        PUT #1, 1, BufferA
    END IF
    FOR A = 1 TO 10
        COLOR A
        LOCATE A * 2 + 7, 2
        PRINT USING "##."; A
        GET #1, A, BufferA
        IF A = 1 THEN
            Text Strip$(UCASE$(BufferA.UserName)), "Bm35," + STR$(16 * (A * 2 + 7) - 5) + "s8c11"
        ELSE
            Text Strip$(UCASE$(BufferA.UserName)), "Bm35," + STR$(16 * (A * 2 + 7) - 5) + "s8c" + STR$(A)
        END IF
        LOCATE A * 2 + 7, 43: PRINT USING "$###,###"; BufferA.Money
        LOCATE A * 2 + 7, 70: PRINT USING "#,###"; BufferA.Plays
    NEXT
    CLOSE
    COLOR 14
    LOCATE 30, 26: PRINT "Press any key to continue...";
    Shade = 63: A = 0: Direction = -1
    DO
        A = (A + 1) MOD 20
        IF A = 19 THEN
            PALETTE 11, Shade
            Shade = Shade + Direction
            IF Shade < 0 OR Shade > 63 THEN Direction = -Direction: Shade = Shade + Direction
        END IF
    LOOP UNTIL INKEY$ <> ""
    CLS
    COLOR 15
    PALETTE
END SUB

SUB Shuffle
    RANDOMIZE TIMER
    SCREEN 8, , 1, 0
    CLS
    LINE (105, 70)-(505, 105), 7, BF
    LINE (100, 65)-(500, 100), 1, BF

    Text "PLEASE WAIT WHILE ZEEK SHUFFLES THE DECK", "C14bm155,85s4"
    SCREEN 8, , 1, 1
    A = 1
    FOR Num = 1 TO 13
        FOR Suit = 1 TO 4
            card(A).Number = Num
            card(A).Suit = Suit
            card(A).up = True
            A = A + 1
        NEXT
    NEXT
    FOR A = 1 TO 52 * (Fnr(80) + 15)
        DO
            B = Fnr(52)
            B1 = Fnr(52)
        LOOP UNTIL B <> B1
        SWAP card(B).Number, card(B1).Number
        SWAP card(B).Suit, card(B1).Suit
    NEXT
    NextCard = 52
    SCREEN 8, , 0, 0
    Last = 8
END SUB

FUNCTION Strip$ (A$)
    Strip$ = LEFT$(A$, INSTR(A$, CHR$(255)) - 1)
END FUNCTION

SUB SwitchScreen (Scrn)
    IF Last <> Scrn THEN
        SCREEN Scrn, , 0, 0
    ELSE
        CLS
    END IF
    Last = Scrn
END SUB

SUB Text (A$, B$)
    DRAW B$
    FOR A = 1 TO LEN(A$)
        DRAW Characters$(ASC(MID$(A$, A, 1)))
    NEXT
END SUB

SUB Title
    Last = 8
    DO
        Zeeks
        Ikey$ = UCASE$(Ikey$)
        IF Ikey$ <> "" THEN
            IF Ikey$ = "H" THEN ShowHigh
            EXIT SUB
        END IF
        BlackJack
        Ikey$ = UCASE$(Ikey$)
        IF Ikey$ <> "" THEN
            IF Ikey$ = "H" THEN ShowHigh
            EXIT SUB
        END IF
        Credits
        Ikey$ = UCASE$(Ikey$)
        IF Ikey$ <> "" THEN
            IF Ikey$ = "H" THEN ShowHigh
            EXIT SUB
        END IF
    LOOP
END SUB

SUB UdCom
    ComScore = 0
    FOR A = 0 TO ComCard - 1
        N = Computer(A).Number
        IF N <> 1 THEN
            IF N > 1 AND N < 11 THEN
                ComScore = ComScore + N
            ELSE
                ComScore = ComScore + 10
            END IF
        END IF
    NEXT
    NumAces = 0
    FOR A = 0 TO ComCard - 1
        N = Computer(A).Number
        IF N = 1 THEN
            NumAces = NumAces + 1
        END IF
    NEXT
    FOR A = 1 TO NumAces
        IF ComScore + 11 <= (22 - NumAces) THEN
            ComScore = ComScore + 11
        ELSE
            ComScore = ComScore + 1
        END IF
    NEXT
END SUB

SUB UdPlayer
    PlayScore = 0
    FOR A = 0 TO PlayCard - 1
        N = Player(A).Number
        IF N <> 1 THEN
            IF N > 1 AND N < 11 THEN
                PlayScore = PlayScore + N
            ELSE
                PlayScore = PlayScore + 10
            END IF
        END IF
    NEXT
    NumAces = 0
    FOR A = 0 TO PlayCard - 1
        N = Player(A).Number
        IF N = 1 THEN
            NumAces = NumAces + 1
        END IF
    NEXT
    FOR A = 1 TO NumAces
        IF PlayScore + 11 <= (22 - NumAces) THEN
            PlayScore = PlayScore + 11
        ELSE
            PlayScore = PlayScore + 1
        END IF
    NEXT
    LOCATE 18, 60
    PRINT "Score:"; PlayScore
END SUB

SUB WaitKey
    DO
    LOOP UNTIL INKEY$ = ""
    DO
        A$ = INKEY$
    LOOP UNTIL A$ <> ""
END SUB

SUB Warning
    DIM Start AS SINGLE, X(4000) AS INTEGER, Y(4000) AS INTEGER
    DIM Buffer(17100) AS INTEGER
    CLS
    SwitchScreen 8
    FOR A = 0 TO 15: PALETTE A, 0: NEXT
    DEF SEG = VARSEG(Buffer(0))
    BLOAD "Warning.grf", VARPTR(Buffer(0))
    PUT (5, 35), Buffer
    DO
        Start = TIMER
        PALETTE 7, 0
        PALETTE 4, 0
        DO
        LOOP UNTIL TIMER - Start > .25
        PALETTE 7, 7
        PALETTE 4, 4
        Start = TIMER
        DO
        LOOP UNTIL TIMER - Start > .25
        A$ = INKEY$
    LOOP WHILE A$ = ""
    PALETTE 7, 0: PALETTE 14, 0
    Sc = 12: SwitchScreen 12
    LOCATE 15, 6
    PRINT "This program contains material which may be offensive to some users."
    LOCATE 17, 30
    PRINT "Thank You Very Much."
    PRINT
    PRINT TAB(35); "Zeek & Ray"
    WaitKey
    SCREEN 12
END SUB

SUB Wins
    A = Fnr(NumWin)
    A$ = Win$(A)
    Blink A$
END SUB

FUNCTION Year
    Year = VAL(RIGHT$(DATE$, 4))
END FUNCTION

SUB Zeeks
RANDOMIZE TIMER
'Dynamic$
REDIM Px(359, 7) AS INTEGER
REDIM Py(359, 7) AS INTEGER
REDIM Px1(359, 7) AS INTEGER
REDIM Py1(359, 7) AS INTEGER


REDIM Zx(144, 29) AS INTEGER
REDIM Zy(144, 29) AS INTEGER
REDIM Zx1(144, 29) AS INTEGER
REDIM Zy1(144, 29) AS INTEGER




REDIM Sx(79) AS INTEGER, Sy(79) AS INTEGER

REDIM Ex(160) AS INTEGER, Ey(160) AS INTEGER

REDIM Exr(160) AS INTEGER, Eyr(160) AS INTEGER


REDIM Tx(140) AS SINGLE, Ty(140) AS SINGLE




SCREEN 7, , 1, 0
PCOPY 0, 2
AfterUpdate = False
ON TIMER(1) GOSUB KeepBusy
TIMER ON

DEF SEG = VARSEG(Px(0, 0))
BLOAD "PXs", VARPTR(Px(0, 0))

DEF SEG = VARSEG(Px1(0, 0))
BLOAD "PXe", VARPTR(Px1(0, 0))

DEF SEG = VARSEG(Py(0, 0))
BLOAD "PYS", VARPTR(Py(0, 0))

DEF SEG = VARSEG(Py1(0, 0))
BLOAD "PYE", VARPTR(Py1(0, 0))


DEF SEG = VARSEG(Zx(0, 0))
BLOAD "ZXs", VARPTR(Zx(0, 0))

DEF SEG = VARSEG(Zy(0, 0))
BLOAD "ZYs", VARPTR(Zy(0, 0))

DEF SEG = VARSEG(Zx1(0, 0))
BLOAD "ZXe", VARPTR(Zx1(0, 0))

DEF SEG = VARSEG(Zy1(0, 0))
BLOAD "Zye", VARPTR(Zy1(0, 0))



'**


FOR T = 0 TO 79
    Sx(T) = INT(RND(1) * 319 + 1)
    Sy(T) = INT(RND(1) * 199 + 1)
NEXT
FOR A = 0 TO 160
    Ex(A) = 160
    Ey(A) = 100
    IF RND(1) > .5 THEN Exr(A) = -INT(RND(1) * 12 + 1) ELSE Exr(A) = INT(RND(1) * 12 + 1)
    IF RND(1) > .5 THEN Eyr(A) = -INT(RND(1) * 12 + 1) ELSE Eyr(A) = INT(RND(1) * 12 + 1)
NEXT
FOR B = 1 TO 140
    Tx(B) = RND(1) * 1.6
    Ty(B) = RND(1)
NEXT

IF AfterUpdate THEN
    PCOPY 2, 0
ELSE
    TIMER OFF
END IF


SCREEN 7, , 2, 0
CLS
LOCATE 24, 1
COLOR 15
LOCATE 24, 3
PRINT "Press The H Key To See High Scores";
LOCATE 25, 3
PRINT "Or Any Other Key To Play The Game.";

SCREEN 7, , 1, 0
CLS
D1 = -4: D2 = -3: D3 = -2: D4 = -1
E1 = 0: E2 = 0: E3 = 0: E4 = 0
DO
    A$ = INKEY$
LOOP WHILE A$ <> ""

ON TIMER(1) GOSUB Interrupt
TIMER ON
A = 365
Am = -1
DO
    PCOPY 1, 0: PCOPY 2, 1

    IF A = 180 THEN
        D4 = 4: E4 = 5
        D3 = 3: E3 = 4
        D2 = 2: E2 = 2
        D1 = 1: E1 = 1
    END IF
    A = A + Am
    IF A < 360 THEN
        FOR B = 0 TO 7
            LINE (Px(A, B), Py(A, B))-(Px1(A, B), Py1(A, B)), 14
        NEXT
    END IF
    FOR B = 1 TO 19
        PSET (Sx(B), Sy(B))
        Sx(B) = (Sx(B) + D1) MOD 320: IF Sx(B) < 0 THEN Sx(B) = 319
        Sy(B) = (Sy(B) - E1) MOD 199: IF Sy(B) < 0 THEN Sy(B) = 199
    NEXT
    FOR B = 20 TO 29
        PSET (Sx(B), Sy(B))
        Sx(B) = (Sx(B) + D2) MOD 320: IF Sx(B) < 0 THEN Sx(B) = 319
        Sy(B) = (Sy(B) - E2) MOD 199: IF Sy(B) < 0 THEN Sy(B) = 199
    NEXT
    FOR B = 30 TO 49
        PSET (Sx(B), Sy(B))
        Sx(B) = (Sx(B) + D3) MOD 320: IF Sx(B) < 0 THEN Sx(B) = 319
        Sy(B) = (Sy(B) - E3) MOD 199: IF Sy(B) < 0 THEN Sy(B) = 199
    NEXT
    FOR B = 50 TO 79
        PSET (Sx(B), Sy(B))
        Sx(B) = (Sx(B) + D4) MOD 320: IF Sx(B) < 0 THEN Sx(B) = 319
        Sy(B) = (Sy(B) - E4) MOD 199: IF Sy(B) < 0 THEN Sy(B) = 199
    NEXT
LOOP UNTIL A = 0 OR IRQ
IF IRQ THEN TIMER OFF: EXIT SUB

ERASE Sx, Sy, Px, Py, Px1, Py1


REDIM Rx(2940) AS INTEGER, Ry(2940) AS INTEGER

FOR A = 0 TO 800 STEP 40
    Ar = A * .5
    Ar1 = A * .5 * 1.6
    FOR B = 1 TO 140
        Rx(C) = 160 + (Tx(B) * A - Ar1)
        Ry(C) = 100 + (Ty(B) * A - Ar)
        C = C + 1
    NEXT
NEXT
ERASE Tx, Ty

PCOPY 0, 2

Rev = 0
C = 0
FOR A = 200 TO 0 STEP -10
    PCOPY 2, 1
    FOR B = 1 TO 140
        LINE (160, 100)-(Rx(C), Ry(C)), 6: C = C + 1
    NEXT
    FOR B = 0 TO 29
        LINE (Zx(Rev, B), Zy(Rev, B))-(Zx1(Rev, B), Zy1(Rev, B)), 14
    NEXT: Rev = Rev + 1
    PCOPY 1, 0
    IF IRQ THEN TIMER OFF: EXIT SUB
NEXT
FOR A = 200 TO 0 STEP -10
    PCOPY 2, 1
    FOR B = 1 TO 140
        C = C - 1: LINE (160, 100)-(Rx(C), Ry(C)), 6
    NEXT
    FOR B = 0 TO 29
        LINE (Zx(Rev, B), Zy(Rev, B))-(Zx1(Rev, B), Zy1(Rev, B)), 14
    NEXT: Rev = Rev + 1
    PCOPY 1, 0
    IF IRQ THEN TIMER OFF: EXIT SUB
NEXT

SCREEN 7, , 2, 2
LINE (160 - 3, 100 - 3)-(160 + 3, 100 + 3), 0, BF
SCREEN 7, , 1, 0
FOR B = 1 TO 160
    PCOPY 1, 0: PCOPY 2, 1
    IF B < 10 THEN CIRCLE (160, 100), 10 - B, 6: PAINT (160, 100), 6, 6
    FOR A = 0 TO 30
        PSET (Ex(A), Ey(A)), 14
        Ex(A) = Ex(A) + Exr(A)
        Ey(A) = Ey(A) + Eyr(A)
    NEXT
    FOR A = 0 TO 29
        LINE (Zx(Rev, A), Zy(Rev, A))-(Zx1(Rev, A), Zy1(Rev, A)), 14
    NEXT: Rev = Rev + 1: IF Rev > 144 THEN Rev = 144



    IF B > 20 AND B < 41 THEN
        FOR A = 31 TO 50
            PSET (Ex(A), Ey(A)), 14
            Ex(A) = Ex(A) + Exr(A)
            Ey(A) = Ey(A) + Eyr(A)
        NEXT
    END IF
    IF B > 30 AND B < 60 THEN
        FOR A = 51 TO 70
            PSET (Ex(A), Ey(A)), 14
            Ex(A) = Ex(A) + Exr(A)
            Ey(A) = Ey(A) + Eyr(A)
        NEXT
    END IF
    IF B > 40 THEN
        FOR A = 141 TO 160
            PSET (Ex(A), Ey(A)), 14
            Ex(A) = Ex(A) + Exr(A)
            Ey(A) = Ey(A) + Eyr(A)
        NEXT
    END IF
    IF B > 90 THEN
        FOR A = 71 TO 140
            PSET (Ex(A), Ey(A)), 14
            Ex(A) = Ex(A) + Exr(A)
            Ey(A) = Ey(A) + Eyr(A)
        NEXT
    END IF
    IF IRQ THEN TIMER OFF: EXIT SUB

NEXT

ERASE Ex, Ey, Zx, Zy, Zx1, Zy1

REDIM Fx(300, 30) AS INTEGER
REDIM Fy(300, 30) AS INTEGER
REDIM Fx1(300, 30) AS INTEGER
REDIM Fy1(300, 30) AS INTEGER
DEF SEG = VARSEG(Fx(0, 0))

BLOAD "RXs", VARPTR(Fx(0, 0))

DEF SEG = VARSEG(Fy(0, 0))
BLOAD "RYs", VARPTR(Fy(0, 0))

DEF SEG = VARSEG(Fx1(0, 0))
BLOAD "RXe", VARPTR(Fx1(0, 0))

DEF SEG = VARSEG(Fy1(0, 0))
BLOAD "Rye", VARPTR(Fy1(0, 0))

FOR Rev = 0 TO 300
    PCOPY 2, 1
    FOR A = 0 TO 29
        LINE (Fx(Rev, A), Fy(Rev, A))-(Fx1(Rev, A), Fy1(Rev, A)), 14
    NEXT
    PCOPY 1, 0
    IF IRQ THEN TIMER OFF: EXIT SUB
NEXT
FOR A = 0 TO 29
    LINE (Fx(300, A), Fy(300, A))-(Fx1(300, A), Fy1(300, A)), 0
NEXT
PCOPY 1, 0
TIMER OFF
END SUB