REM **********************************************
REM            More Qbasic Software at
REM   http://www.euronet.nl/users/rkohm/software
REM          Any questions? E-mail to:
REM              rkohm@euronet.nl
REM **********************************************

DECLARE SUB menusub ()
DECLARE SUB waitawhile (howlong!)
DECLARE SUB check ()
DECLARE SUB choose (choice1!, choice2!)
DECLARE SUB turnchange ()
DECLARE SUB redraw ()
DECLARE SUB getname (player!)
DECLARE SUB printt (text$, linenr!)
DECLARE SUB background ()

COMMON SHARED name1$, name2$, turn, wich, numplay$, move

DIM SHARED place(5), pname(2) AS STRING
place(1) = 1: place(2) = 1: place(3) = 0: place(4) = 2: place(5) = 2

SCREEN 12: RANDOMIZE TIMER
ON KEY(10) GOSUB endofgame
KEY(10) ON

menusub
CLS
background
redraw
printt "How many players? (1/2)", 1
 DO: numplay$ = INKEY$: LOOP UNTIL numplay$ <> ""

SELECT CASE VAL(numplay$)
 CASE 1
  printt "", 0
  printt "Because there is only one player and this is a two", 1
  printt "player game you play against the computer. The", 2
  printt "computer's name is 'Robin'. Press a key...", 3
  DO: LOOP UNTIL INKEY$ <> "": printt "", 0
  printt "What's your name?", 1
  getname (1)
  pname(2) = "Robin"
  LOCATE 6, 66: PRINT pname(1) + SPACE$(10 - LEN(pname(1)))
  LOCATE 8, 66: PRINT pname(2) + SPACE$(10 - LEN(pname(2)))
  DO: number = FIX(RND * 100 + 1): LOOP UNTIL number > 0 AND number <= 100
  SELECT CASE number
   CASE IS <= 50: turn = 1: printt pname(1) + " begins. Press a key...", 3
   CASE IS > 50: turn = 2: printt pname(2) + " begins. Press a key...", 3
  END SELECT
  DO: LOOP UNTIL INKEY$ <> ""
  printt "", 0
  printt "Which level? (1/2)", 1
  printt " 1. Possible.", 2
  printt " 2. Impossible.", 3
  DO: us$ = INKEY$: LOOP UNTIL us$ = "1" OR us$ = "2"
  level = VAL(us$)

overagain:
  SELECT CASE turn
   CASE 1
    printt "", 0
    printt pname(turn) + ", which coin do you want to move?", 1
    DO: wich$ = INKEY$: LOOP UNTIL VAL(wich$) > 0 AND VAL(wich$) < 6
    IF place(VAL(wich$)) = 0 THEN
     PLAY "l30<ba>": printt "There is no coin at that position! Press a key...", 2
     DO: LOOP UNTIL INKEY$ <> "": GOTO overagain
    END IF
    IF place(VAL(wich$)) <> turn AND place(VAL(wich$)) <> 0 THEN
     PLAY "l30<ba>": printt "That's not one of YOUR coins! Press a key...", 2
     DO: LOOP UNTIL INKEY$ <> "": GOTO overagain
    END IF
    GOSUB whereto
   CASE 2
    printt "", 0
    printt "Robin's turn.", 1
    waitawhile .2
    combi$ = STR$(place(1)) + STR$(place(2)) + STR$(place(3)) + STR$(place(4)) + STR$(place(5))
    SELECT CASE VAL(combi$)
     CASE 11022: choose 4, 5
     CASE 10122: move = 5
     CASE 1122: move = 4
     CASE 21021: choose 1, 4: IF level = 2 THEN move = 4
     CASE 20121: move = 1
     CASE 22011: choose 1, 2
     CASE 22101: move = 1
     CASE 22110: move = 2
     CASE 12012: choose 2, 5: IF level = 2 THEN move = 5
     CASE 2112: move = 2
     CASE 20112: choose 1, 5: IF level = 2 THEN move = 5
     CASE 21012: choose 1, 5: IF level = 2 THEN move = 1
     CASE 21102: move = 1
     CASE 12021: choose 2, 4: IF level = 2 THEN move = 2
     CASE 2121: choose 2, 4: IF level = 2 THEN move = 4
     CASE 12120: move = 2
     CASE 21210: move = 3
     CASE 20211: choose 1, 3: IF level = 2 THEN move = 1
     CASE 10221: move = 3
     CASE 1221: choose 3, 4: IF level = 2 THEN move = 4
     CASE 11220: move = 3
     CASE 1212: move = 3
     CASE 11202: move = 3
     CASE 10212: choose 3, 5: IF level = 2 THEN move = 5
     CASE 2211: choose 2, 3: IF level = 2 THEN move = 2
     CASE 12201: move = 3
    END SELECT
    wich$ = STR$(move)
    GOSUB whereto
  END SELECT
 redraw
 check
 turnchange
GOTO overagain

 CASE 2
  printt "", 0
  printt "What's the name of Player 1?", 1
  getname (1)
  printt "What's the name of Player 2?", 2
  getname (2)
  LOCATE 6, 66: PRINT pname(1) + SPACE$(10 - LEN(pname(1)))
  LOCATE 8, 66: PRINT pname(2) + SPACE$(10 - LEN(pname(2)))
  DO: number = FIX(RND * 100 + 1): LOOP UNTIL number > 0 AND number <= 100
  SELECT CASE number
   CASE IS <= 50: turn = 1: printt pname(1) + " begins. Press a key...", 3
   CASE IS > 50: turn = 2: printt pname(2) + " begins. Press a key...", 3
  END SELECT
  DO: LOOP UNTIL INKEY$ <> ""
again:
  printt "", 0
  printt pname(turn) + ", which coin do you want to move?", 1
  DO: wich$ = INKEY$: LOOP UNTIL VAL(wich$) > 0 AND VAL(wich$) < 6
  IF place(VAL(wich$)) = 0 THEN
   PLAY "l30<ba>": printt "There is no coin at that position! Press a key...", 2
   DO: LOOP UNTIL INKEY$ <> "": GOTO again
  END IF
  IF place(VAL(wich$)) <> turn AND place(VAL(wich$)) <> 0 THEN
   PLAY "l30<ba>": printt "That's not one of YOUR coins! Press a key...", 2
   DO: LOOP UNTIL INKEY$ <> "": GOTO again
  END IF
  GOSUB whereto
 redraw
 check
 turnchange
 GOTO again
END SELECT
END

endofgame:
END

whereto:
SELECT CASE VAL(wich$)
 CASE 1
  IF place(2) = 0 THEN place(VAL(wich$)) = 0: place(2) = turn: RETURN
  IF place(3) = 0 THEN place(VAL(wich$)) = 0: place(3) = turn: RETURN
  IF place(4) = 0 THEN place(VAL(wich$)) = 0: place(4) = turn: RETURN
  PLAY "l30<ba>": printt "You can't move that coin.", 2
  printt "Press a key...", 3
  DO: LOOP UNTIL INKEY$ <> ""
  IF numplay$ = "1" THEN GOTO overagain
  IF numplay$ = "2" THEN GOTO again
 CASE 2
  IF place(1) = 0 THEN place(VAL(wich$)) = 0: place(1) = turn: RETURN
  IF place(3) = 0 THEN place(VAL(wich$)) = 0: place(3) = turn: RETURN
  IF place(5) = 0 THEN place(VAL(wich$)) = 0: place(5) = turn: RETURN
  PLAY "l30<ba>": printt "You can't move that coin.", 2
  printt "Press a key...", 3
  DO: LOOP UNTIL INKEY$ <> ""
  IF numplay$ = "1" THEN GOTO overagain
  IF numplay$ = "2" THEN GOTO again
 CASE 3
  IF place(1) = 0 THEN place(VAL(wich$)) = 0: place(1) = turn: RETURN
  IF place(2) = 0 THEN place(VAL(wich$)) = 0: place(2) = turn: RETURN
  IF place(4) = 0 THEN place(VAL(wich$)) = 0: place(4) = turn: RETURN
  IF place(5) = 0 THEN place(VAL(wich$)) = 0: place(5) = turn: RETURN
  PLAY "l30<ba>": printt "You can't move that coin.", 2
  printt "Press a key...", 3
  DO: LOOP UNTIL INKEY$ <> ""
  IF numplay$ = "1" THEN GOTO overagain
  IF numplay$ = "2" THEN GOTO again
 CASE 4
  IF place(1) = 0 THEN place(VAL(wich$)) = 0: place(1) = turn: RETURN
  IF place(3) = 0 THEN place(VAL(wich$)) = 0: place(3) = turn: RETURN
  PLAY "l30<ba>": printt "You can't move that coin.", 2
  printt "Press a key...", 3
  DO: LOOP UNTIL INKEY$ <> ""
  IF numplay$ = "1" THEN GOTO overagain
  IF numplay$ = "2" THEN GOTO again
 CASE 5
  IF place(2) = 0 THEN place(VAL(wich$)) = 0: place(2) = turn: RETURN
  IF place(3) = 0 THEN place(VAL(wich$)) = 0: place(3) = turn: RETURN
  PLAY "l30<ba>": printt "You can't move that coin.", 2
  printt "Press a key...", 3
  DO: LOOP UNTIL INKEY$ <> ""
  IF numplay$ = "1" THEN GOTO overagain
  IF numplay$ = "2" THEN GOTO again
END SELECT
RETURN

SUB background
SCREEN 12
LINE (220, 75)-(420, 225)
LINE (420, 75)-(220, 225)
LINE (220, 75)-(420, 75)
LINE (220, 75)-(220, 225)
LINE (420, 75)-(420, 225)
CIRCLE (220, 75), 15, 15
 CIRCLE STEP(0, 0), 12, 4: DRAW "bu2p15,15"
CIRCLE (420, 75), 15, 15
 CIRCLE STEP(0, 0), 12, 4: DRAW "bu2p15,15"
CIRCLE (420, 225), 15, 15
 CIRCLE STEP(0, 0), 12, 4: DRAW "br3p15,15"
CIRCLE (220, 225), 15, 15
 CIRCLE STEP(0, 0), 12, 4: DRAW "bl4p15,15"
CIRCLE (320, 150), 15, 15
 CIRCLE STEP(0, 0), 10, 4: DRAW "bu5p15,15"

DRAW "c14bm170,25d250r300u250l300"

LOCATE 6, 66: PRINT "Player 1"
CIRCLE (505, 87), 5, 1: PAINT (505, 87), 1, 1
LOCATE 8, 66: PRINT "Player 2"
CIRCLE (505, 119), 5, 4: PAINT (505, 119), 4, 4
DRAW "bm495,103 c14r110u32l110d65r110u65"
LOCATE 12, 66: COLOR 14: PRINT "F10 "; : COLOR 15: PRINT "Exit"
DRAW "bm495,170 c14r110d26l110u26"
COLOR 7: LOCATE 25, 35: PRINT "by Robin Ohm"
DRAW "bm265,380 d22r109u22l109"

DRAW "bm60,420"
DRAW "c14u10l10h10u10e10r10u10l20g10d30f10r20bhp1,14bf"
DRAW "br60"
DRAW "c14u50l30d50r30bh10u30l10d30r10bhp8,14bfbfp4,14bf9"
DRAW "br60"
DRAW "c14bl10u50bu5l10u10r10d10l10bep1,14c14bgbd5nr10d50r10bhp1,14bfbr10"
DRAW "br60"
DRAW "c14u40h10l20d50r10u40r10d40r10bhp4,14bf"
DRAW "br200"
DRAW "c14u20l8d10l8h10u10e10r16u10l24g10d30f10r24bhp1,14bf"
DRAW "br60"
DRAW "c14u50l30d50r10u20r10d20r10u50bg10l10d10r10u10bgp8,14be12d50bh2p4,14bf2"
DRAW "br60"
DRAW "c14r10u40h10l40d50r10u40r10d40r10u40r10d40r10bhp1,14bfbl12"
DRAW "br60"
DRAW "c14u10l20u10r10u10l10u10r20u10l30d50r30bhp4,14bg"

DRAW "bm116,284c14d53r407u53l407bup8,14"
DRAW "bm195,80nl3nr3u13g3"
DRAW "bm445,80nr4l3lefu2e6u2h2l3g3"
DRAW "bm290,145e2r3f2d3g2f2d3g2l3h2"
DRAW "bm195,232u6d2nr3l6ta-30u9ta0"
DRAW "bm449,220l8d7e2r4f2d4g2l4h2"
COLOR 15
END SUB

SUB check
IF place(2) = place(5) AND place(1) = place(3) THEN
 printt "", 0
 printt pname(place(1)) + " has won the game! Press enter...", 1
 DO: user$ = INKEY$: LOOP UNTIL user$ = CHR$(13)
 CLS : END
END IF
IF place(1) = place(4) AND place(3) = place(2) THEN
 printt "", 0
 printt pname(place(3)) + " has won this game! Press enter...", 1
 DO: user$ = INKEY$: LOOP UNTIL user$ = CHR$(13)
 CLS : END
END IF
END SUB

SUB choose (choice1, choice2)
DO: number = FIX(RND * 100 + 1): LOOP UNTIL number > 0 AND number <= 100
SELECT CASE number
 CASE IS <= 50: move = choice1
 CASE IS > 50: move = choice2
END SELECT
END SUB

SUB getname (player)
SELECT CASE player
 CASE 1
  COLOR 15: LOCATE 19, 45: PRINT "__________"
  g = 45
  COLOR 15
  DO
   hit$ = INKEY$
   IF hit$ = "" THEN GOTO dothis
   SELECT CASE ASC(hit$)
    CASE 8    'backspace
     IF g > 45 THEN g = g - 1: LOCATE 19, g: PRINT "_"
    CASE 13
     EXIT DO
    CASE ELSE  'not backspace
     IF g < 55 THEN
      LOCATE 19, g: PRINT hit$: g = g + 1
     END IF
   END SELECT
dothis:
  LOOP
 
  nothing$ = "no"
  FOR h = 54 TO 45 STEP -1
   part = SCREEN(19, h)
   SELECT CASE part
    CASE ASC("_")
     IF nothing$ = "yes" THEN pname(1) = pname(1) + " "
    CASE ELSE
     nothing$ = "yes"
     pname(1) = CHR$(part) + pname(1)
   END SELECT
  NEXT

 CASE 2
  COLOR 15: LOCATE 20, 45: PRINT "__________"
  g = 45
  COLOR 15
  DO
   hit$ = INKEY$
   IF hit$ = "" THEN GOTO dothis2
   SELECT CASE ASC(hit$)
    CASE 8    'backspace
     IF g > 45 THEN g = g - 1: LOCATE 20, g: PRINT "_"
    CASE 13
     EXIT DO
    CASE ELSE  'not backspace
     IF g < 55 THEN
      LOCATE 20, g: PRINT hit$: g = g + 1
     END IF
   END SELECT
dothis2:
  LOOP
 
  nothing$ = "no"
  FOR h = 54 TO 45 STEP -1
   part = SCREEN(20, h)
   SELECT CASE part
    CASE ASC("_")
     IF nothing$ = "yes" THEN pname(2) = pname(2) + " "
    CASE ELSE
     nothing$ = "yes"
     pname(2) = CHR$(part) + pname(2)
   END SELECT
  NEXT
END SELECT
END SUB

SUB menusub
menu:
CLS
COLOR 6: LOCATE 10, 25: PRINT "Your choice?"

COLOR 1: LOCATE 12, 35: PRINT "1. Play a game"
COLOR 2: LOCATE 13, 35: PRINT "2. Instructions"
COLOR 4: LOCATE 14, 35: PRINT "3. Exit"

DO: choice$ = INKEY$: LOOP UNTIL VAL(choice$) >= 1 AND VAL(choice$) <= 3

SELECT CASE VAL(choice$)
 CASE 3: CLS : END
 CASE 2
COLOR 15: CLS : COLOR 15
PRINT : PRINT
COLOR 4: PRINT : PRINT "                          * * * Instructions * * *": PRINT
COLOR 15: LOCATE CSRLIN, 15: PRINT "This isn't the best game there is, but it is nice"
LOCATE CSRLIN, 15: PRINT "to play and it was nice to program it as well."
LOCATE CSRLIN, 15: PRINT "The rules are very easy:"
LOCATE CSRLIN, 15: PRINT "It is a two player-game. The two players both have"
LOCATE CSRLIN, 15: PRINT "two coins. Player 1 has two blue ones and Player 2"
LOCATE CSRLIN, 15: PRINT "has two red ones."
LOCATE CSRLIN, 15: PRINT "First Player 1 moves one of his coins to the empty"
LOCATE CSRLIN, 15: PRINT "place, and after that Player 2 moves one of his"
LOCATE CSRLIN, 15: PRINT "coins."
LOCATE CSRLIN, 15: PRINT "You can only move over the white lines, and you can't"
LOCATE CSRLIN, 15: PRINT "jump over one of your or your opponent's coins."
LOCATE CSRLIN, 15: PRINT "The player who can't move his coins, looses. So, if"
LOCATE CSRLIN, 15: PRINT "you are trapped by our opponent, you loose."
PRINT : PRINT
COLOR 14: LOCATE CSRLIN, 15: PRINT "By Robin Ohm, Holland"
LOCATE CSRLIN, 16: PRINT "email: rkohm@euronet.nl"
LOCATE CSRLIN, 16: PRINT "homepage: http://www.euronet.nl/users/rkohm/software/"

PRINT : PRINT : PRINT
COLOR 4: PRINT "                Have fun!"
COLOR 2: PRINT "                                    Press Enter to continue.."
DO: LOOP UNTIL INKEY$ = CHR$(13)
GOTO menu
END SELECT
COLOR 15
END SUB

SUB printt (text$, linenr)
SELECT CASE linenr
 CASE 1: LOCATE 19, 16: PRINT text$
 CASE 2: LOCATE 20, 16: PRINT text$
 CASE 3: LOCATE 21, 16: PRINT text$
 CASE 0: LOCATE 19, 16: PRINT SPACE$(50)
 LOCATE 20, 16: PRINT SPACE$(50): LOCATE 21, 16: PRINT SPACE$(50)
END SELECT
END SUB

SUB redraw
PAINT (220, 75), 15, 15
PAINT (220, 225), 15, 15
PAINT (320, 150), 15, 15
PAINT (420, 75), 15, 15
PAINT (420, 225), 15, 15
IF place(1) = 1 THEN CIRCLE (220, 75), 10, 1: DRAW "p1,1"
IF place(1) = 2 THEN CIRCLE (220, 75), 10, 4: DRAW "p4,4"
IF place(2) = 1 THEN CIRCLE (420, 75), 10, 1: DRAW "p1,1"
IF place(2) = 2 THEN CIRCLE (420, 75), 10, 4: DRAW "p4,4"
IF place(3) = 1 THEN CIRCLE (320, 150), 10, 1: DRAW "p1,1"
IF place(3) = 2 THEN CIRCLE (320, 150), 10, 4: DRAW "p4,4"
IF place(4) = 1 THEN CIRCLE (220, 225), 10, 1: DRAW "p1,1"
IF place(4) = 2 THEN CIRCLE (220, 225), 10, 4: DRAW "p4,4"
IF place(5) = 1 THEN CIRCLE (420, 225), 10, 1: DRAW "p1,1"
IF place(5) = 2 THEN CIRCLE (420, 225), 10, 4: DRAW "p4,4"
END SUB

SUB turnchange
SELECT CASE turn
 CASE 1: turn = 2: EXIT SUB
 CASE 2: turn = 1: EXIT SUB
END SELECT
END SUB

SUB waitawhile (howlong)
thetime = TIMER
DO: LOOP UNTIL TIMER >= thetime + howlong
END SUB