'===========================================================================
' Subject: CONNECT 4                         Date: 11-18-98 (18:10)       
' Author:  Dominik Kaspar                    Code: QB, QBasic, PDS        
' Origin:  pedok@pop.agri.ch               Packet: GAMES.ABC
'===========================================================================
'This is my first game I programmed that actually works like it should, at
'least on my computer...

'This program is made by: Dominik Kaspar
'                         Ahornweg 15
'                         5615 Fahrwangen
'                         Switzerland        [email: pedok@pop.agri.ch]

DECLARE SUB Intro ()
DECLARE SUB Fertig (N1$, N2$, Farbe)
DECLARE SUB Comp (N1$, N2$, Farbe)
Intro
SCREEN 12
LINE (0, 0)-(639, 479), 8, B
LINE (1, 1)-(638, 478), 7, B
LINE (2, 2)-(637, 477), 8, B
COLOR 13: LOCATE 4, 4: PRINT "CONNECT 4"
COLOR 12: LOCATE 7, 4
PRINT "You have to use the numeric keys in this game:": COLOR 9
LOCATE 9, 6: PRINT CHR$(27); "   to move to the left"
LOCATE 11, 6: PRINT CHR$(26); "   to move to the right"
LOCATE 13, 6: PRINT CHR$(25); "   to set a coin"
LOCATE 15, 6: PRINT CHR$(24); "   remove coin from slot"
LOCATE 17, 6: PRINT "ESC to quit this fantastic game"
LOCATE 19, 6: PRINT "F1  for help"

COLOR 12: LOCATE 22, 4
PRINT "Please enter the names of the players:"
LOCATE 24, 15: COLOR 2: LINE INPUT "Player 1: ", N1$
LOCATE 26, 15: COLOR 4: LINE INPUT "Player 2: ", N2$
N1$ = RTRIM$(N1$): N2$ = RTRIM$(N2$)
N1$ = LTRIM$(N1$): N2$ = LTRIM$(N2$)
N1$ = UCASE$(N1$): N2$ = UCASE$(N2$)
IF N1$ = "" THEN N1$ = "Nummer 1"
IF N2$ = "" THEN N2$ = "Nummer 2"
IF LEN(N1$) > 46 THEN N1$ = LEFT$(N1$, 46)
IF LEN(N2$) > 46 THEN N2$ = LEFT$(N1$, 46)
IF N1$ = N2$ THEN : N1$ = N1$ + " (1)": N2$ = N2$ + " (2)"

CLS : Farbe = 2: Dg = 0: u = 1: Langw = 0

ON TIMER(30) GOSUB Langweilig
KEY(13) ON: ON KEY(13) GOSUB rechts
KEY(12) ON: ON KEY(12) GOSUB links
KEY(14) ON: ON KEY(14) GOSUB Fall
KEY(11) ON: ON KEY(11) GOSUB Undo
KEY(1) ON: ON KEY(1) GOSUB Hilfe

LINE (20, 100)-(600, 440), 1, BF
LINE (20, 100)-(600, 440), 9, B
FOR A = 130 TO 410 STEP 40
FOR B = 60 TO 580 STEP 50
CIRCLE (B, A), 18, 0
PAINT (B, A), 0
CIRCLE (B, A), 18, 9
NEXT B
NEXT A

x = 50: y = 20
PSET (x, y), 0
TIMER ON
DO
DRAW "c" + STR$(Farbe) + "d40l10f20e20l10u40l20bf3d33f1e1u33h1g1bh3"
IF Dg >= 88 THEN Farbe = 0: Fertig N1$, N2$, Farbe
LOOP UNTIL INKEY$ = CHR$(27)
SYSTEM

rechts:
DRAW "c0d40l10f20e20l10u40l20bf3d33f1e1u33h1g1bh3"
x = x + 50: IF x > 580 THEN x = x - 50
PSET (x, y), 0: RETURN

links:
DRAW "c0d40l10f20e20l10u40l20bf3d33f1e1u33h1g1bh3"
x = x - 50: IF x < 40 THEN x = x + 50
PSET (x, y), 0: RETURN

Fall: TIMER OFF
FOR A = 410 TO 130 STEP -40
IF NOT POINT(x + 10, 130) = 0 THEN RETURN
IF POINT(x + 10, A) = 0 THEN
   Dg = Dg + 1: Langw = 0
   LOCATE 1: PRINT SPACE$(80)
   xx = x + 10: yy = A: u = 0
   CIRCLE (x + 10, A), 18, Farbe
   PAINT (x + 10, A), Farbe
   CIRCLE (x + 10, A), 18, 9
   PSET (x, y), 0
   Comp N1$, N2$, Farbe
   TIMER ON
   IF Farbe = 2 THEN Farbe = 4: RETURN
   IF Farbe = 4 THEN Farbe = 2: RETURN
END IF
NEXT

Undo:
IF u = 1 THEN RETURN
CIRCLE (xx, yy), 18, 0
PAINT (xx, yy), 0
CIRCLE (xx, yy), 18, 9
u = 1: Dg = Dg - 1: PSET (x, y), 0
IF Farbe = 2 THEN Farbe = 4: RETURN
IF Farbe = 4 THEN Farbe = 2: RETURN

Langweilig: LOCATE 1, 1: COLOR Farbe
IF Farbe = 2 THEN PRINT N1$; ", ";
IF Farbe = 4 THEN PRINT N2$; ", ";
IF Langw = 0 THEN PRINT "IT'S GETTING BORING!"
IF Langw = 1 THEN PRINT "NOW IT IS BORING!   "
Langw = 1: RETURN

Hilfe:
TIMER OFF: KEY(11) OFF: KEY(12) OFF: KEY(13) OFF: KEY(14) OFF: KEY(1) OFF
DIM Kasten(16300)
GET (140, 120)-(500, 420), Kasten

LINE (140, 120)-(500, 420), 0, BF
LINE (140, 120)-(500, 420), 7, B
LINE (141, 121)-(499, 419), 8, B
LOCATE 10, 20: PRINT "DESCRIPTION OF CONNECT 4"
LOCATE 13, 20: PRINT "Move the coloured arrow with the arrow"
LOCATE 14, 20: PRINT "keys of your numeric key pad."
LOCATE 15, 20: PRINT "If you set a coin, it falls down into the"
LOCATE 16, 20: PRINT "slot where the arrow is pointing to."
LOCATE 17, 20: PRINT "Now it's the other player's turn, the ar-"
LOCATE 18, 20: PRINT "row also changed its color."
LOCATE 19, 20: PRINT "The game continues like that until one of"
LOCATE 20, 20: PRINT "the players has built a row of four coins"
LOCATE 21, 20: PRINT "with his color, this can be made in any"
LOCATE 22, 20: PRINT "possible direction."
LOCATE 25, 20: PRINT "Have fun playing!"
DO: LOOP UNTIL LEN(INKEY$)
PUT (140, 120), Kasten, PSET
PSET (x, y), 0
TIMER ON: KEY(11) ON: KEY(12) ON: KEY(13) ON: KEY(14) ON: KEY(1) ON
RETURN

SUB Comp (N1$, N2$, Farbe)
SLEEP 1
FOR A = 60 TO 580 STEP 50
FOR B = 130 TO 410 STEP 40
IF POINT(A, B) = Farbe THEN GOSUB test
NEXT B
NEXT A
EXIT SUB

test:
Z = Z + 1
IF POINT(A - 50, B) = Farbe AND POINT(A - 100, B) = Farbe AND POINT(A - 150, B) = Farbe THEN Fertig N1$, N2$, Farbe
IF POINT(A + 50, B) = Farbe AND POINT(A + 100, B) = Farbe AND POINT(A + 150, B) = Farbe THEN Fertig N1$, N2$, Farbe
IF POINT(A, B - 40) = Farbe AND POINT(A, B - 80) = Farbe AND POINT(A, B - 120) = Farbe THEN Fertig N1$, N2$, Farbe
IF POINT(A, B + 40) = Farbe AND POINT(A, B + 80) = Farbe AND POINT(A, B + 120) = Farbe THEN Fertig N1$, N2$, Farbe
IF POINT(A - 50, B - 40) = Farbe AND POINT(A - 100, B - 80) = Farbe AND POINT(A - 150, B - 120) = Farbe THEN Fertig N1$, N2$, Farbe
IF POINT(A + 50, B + 40) = Farbe AND POINT(A + 100, B + 80) = Farbe AND POINT(A + 150, B + 120) = Farbe THEN Fertig N1$, N2$, Farbe
IF POINT(A - 50, B + 40) = Farbe AND POINT(A - 100, B + 80) = Farbe AND POINT(A - 150, B + 120) = Farbe THEN Fertig N1$, N2$, Farbe
IF POINT(A + 50, B - 40) = Farbe AND POINT(A + 100, B - 80) = Farbe AND POINT(A + 150, B - 120) = Farbe THEN Fertig N1$, N2$, Farbe
RETURN

END SUB

SUB Fertig (N1$, N2$, Farbe)
LINE (0, 0)-(639, 80), 0, BF
COLOR 13: LOCATE 1, 5
PRINT "THE GAME IS OVER.": COLOR Farbe: LOCATE 3, 5
IF Farbe = 0 THEN COLOR 7: PRINT "You ended up tied!"
IF Farbe = 2 THEN PRINT N1$; " wins the game."
IF Farbe = 4 THEN PRINT N2$; " wins the game."
LOCATE 5, 5: COLOR 12
INPUT "Another game (Y/N) "; A$
A$ = UCASE$(A$)
IF A$ = "Y" OR A$ = "YES" THEN RUN
SYSTEM
END SUB

SUB Intro
SCREEN 7
PSET (40, 100)
g$ = "c1 l15g15d15f15r15e5u15l15d5r10d8g3l10h12u12e12r14bu5"
E$ = "r40bd5l30d15r10d5l10d15r30d5l36u5bu15u20l3"
W1$ = "br39f2d2f2d2f2d2f2d2f2d2f2d2f2df2d2f2d2f2d2f1r5e2u2e2f2d2f2r5u2e2u2"
W2$ = "e2u2e2u2e2u2e2u2e2u2e2u2e2u2e2u2e2bu5l4g2d2g2d2g2d2g2d2g2d2g2d2g2d2"
W3$ = "g2d2g2h2u2h2u2h2l2g2d2g2d2g2h2u2h2u2h2u2h2u2h2u2h2u2h2u2h2u2h2l4"
I$ = "br58r7d40bd5l7u40br7u5"
N1$ = "r7f2d2f2d2f2d2f2d2f2d2f2d2f2d2f2d2f2d2f2u38r7bd5d40l12h2u2h2u2h2u2"
N2$ = "h2u2h2u2h2u2h2d26l7bu45br33"
N3$ = "r7f2d2f2d2f2d2f2d2f2d2f2d2f2d2f2d2f2d2f2u38r7bd5d40l12h2u2h2u2h2u2"
N4$ = "h2u2h2u2h2u2h2d26l7bu45br33"
t$ = "r40d5l15d40l7u40l17" + "bl83bd20"
Z$ = "c4bl300r50d40r10u40r10u10l10u20l10d20l40u50l10d60"
W$ = W1$ + W2$ + W3$
N$ = N1$ + N2$ + N3$ + N4$
Bild$ = g$ + E$ + W$ + I$ + N$ + t$ + Z$

FOR g = 144 TO 2 STEP -1
IF INKEY$ = CHR$(27) THEN EXIT SUB
SCREEN 7, , A, B
CLS 1
Winkel = Winkel + 71
IF Winkel >= 360 THEN Winkel = 0
DRAW "s" + STR$(g) + "ta" + STR$(Winkel) + Bild$
t = TIMER: DO: LOOP UNTIL TIMER > t + .01
SWAP A, B
NEXT g

PSET (100, 40)
DRAW "c2 f4d4f4d4f4e4u4e4u4e4br8 d20r12l12u10r8l8u10r12br8 d20u20r6f6d2g6f6br8"
DRAW "r6e6h4l4h4u2e4r6br5 d20u20br16 g6d8f6r2e6u8h6br16 d20u20f4d4f4d4f4u20br40"
DRAW "bd10e10d20br6 r0bu20br14 g6d8f6r2e6u8h6br16"

PSET (100, 150)
DRAW "c12"
DRAW "d20r6e6u8h6l4br24 g6d8f6r2e6u8h6br16 d20u20f4d4f4e4u4e4d20u20br8 d20u20"
DRAW "br8 d20u20f4d4f4d4f4u20br8 d20u20br8 d20u10e10g10f10bu20br30"
DRAW "d20u10e10g10f10bu20br16 g4d4g2d4g2d4u4e2u2r12u2h2u4h4f4d4f2d4f2d4br8"
DRAW "r6e6h4l4h4u2e4r6br8 d20u20r6f6g6l6u10br24bu2 g4d4g2d4g2d4u4e2u2r12u2h2u4"
DRAW "h4f4d4f2d4f2d4br8bu20 d20u20r6f6d2g6f6br8"

t = TIMER
DO
IF TIMER - t > 10 THEN EXIT DO
LOOP UNTIL LEN(INKEY$)

END SUB