'===========================================================================
' Subject: PAPER-SCISSORS-ROCK GAME          Date: 08-01-96 (19:29)       
' Author:  Kenneth W. Melvin                 Code: PB                     
' Origin:  comp.lang.basic.misc            Packet: GAMES.ABC
'===========================================================================
'filename	: psr.bas for PowerBasic 2.1
'purpose	: a simple, silly game (paper-scissors-rock)
'date		: 08-01-96 modified from the 03-20-96 version
'programmer	: kwmelvin@nr.infi.net

$COMPILE EXE

DEFINT A-Z	'define all variables as type INTEGER
'----- Variables used in this program
'----- Color constants
black = 0
blue = 1
green = 2
cyan = 3
red = 4
magenta = 5
yellow = 6
white = 7
bright = 8
'----- other variables
x = 0		'holds random value
sleeq! = 0	'holds TIMER value

'----- CRT display mode
CLS
SCREEN 7
COLOR yellow + bright, cyan

'----- Begin Main Program {psr.bas}
CALL Intro
DO
  CLS
  CALL Prompt
  Choice$ = INPUT$(1)
  SELECT CASE UCASE$(Choice$)
    CASE "P"
      CALL Paper
    CASE "S"
      CALL Scissors
    CASE "R"
      CALL Rock
    CASE CHR$(27)
      CLS
      LOCATE 12, 12
      PRINT "Thanks for playing!"
      CALL SLEEP(3)
      GOTO Finish                 'use EXIT SUB in QBasic
    CASE ELSE
      CALL ErrorTrap
  END SELECT
LOOP
Finish:
END
'----- End Main Program {psr.bas}

'----- Begin Subprocedures
'----- Begin Subprocedure {Intro}
SUB Intro
  LOCATE 11, 15
  PRINT "Welcome  to"
  LOCATE 13, 15
  PRINT "the game of"
  LOCATE 15, 10
  PRINT "Paper, Scissors, Rock"
  CALL SLEEP(3)
END SUB
'----- End Subprocedure {Intro}

'----- Begin Subprocedure {Prompt}
SUB Prompt
  CLS
  LOCATE 11, 12
  PRINT "Choose P,S, or R"
  LOCATE 13, 9
  PRINT "Paper, Scissors, Rock"
  LOCATE 15, 13
  PRINT "or Esc to exit"
END SUB
'----- End Subprocedure {Prompt}

'----- Begin Subprocedure {Paper}
SUB Paper
  CLS
  LOCATE 11, 13
  PRINT "You chose Paper"
  RANDOMIZE TIMER
  x = INT(RND * 3) + 1
  IF x = 3 THEN GOSUB TiePaper
  IF x = 2 THEN GOSUB WinPaper
  IF x = 1 THEN GOSUB LosePaper
END SUB

TiePaper:
  LOCATE 13, 8
  PRINT "The computer chose Paper!"
  LOCATE 15, 18: PRINT "Tie!": PLAY "A"
  CALL SLEEP(3)
RETURN

WinPaper:
  LOCATE 13, 7
  PRINT "The computer chose Scissors!"
  LOCATE 15, 16: PRINT "You lose!": PLAY "B"
  CALL SLEEP(3)
RETURN

LosePaper:
  LOCATE 13, 8
  PRINT "The computer chose Rock!"
  LOCATE 15, 16: PRINT "You Win!": PLAY "C"
  CALL SLEEP(3)
RETURN
'----- End Subprocdure {Paper}

'----- Begin Subprocedure {Scissors}
SUB Scissors
  CLS
  LOCATE 11, 11
  PRINT "You chose Scissors"
  RANDOMIZE TIMER
  x = INT(RND * 3) + 1
  IF x = 3 THEN GOSUB TieScissors
  IF x = 2 THEN GOSUB WinScissors
  IF x = 1 THEN GOSUB LoseScissors
END SUB

TieScissors:
  LOCATE 13, 7
  PRINT "The computer chose Scissors!"
  LOCATE 15, 18: PRINT "Tie!": PLAY "A"
  CALL SLEEP(3)
RETURN

WinScissors:
  LOCATE 13, 8
  PRINT "The computer chose Rock!"
  LOCATE 15, 16: PRINT "You lose!": PLAY "B"
  CALL SLEEP(3)
RETURN

LoseScissors:
  LOCATE 13, 8
  PRINT "The computer chose Paper!"
  LOCATE 15, 16: PRINT "You Win!": PLAY "C"
  CALL SLEEP(3)
RETURN
'----- End Subprocedure {Scissors}

'----- Begin Subprocedure {Rock}
SUB Rock
  CLS
  LOCATE 11, 13
  PRINT "You chose Rock"
  RANDOMIZE TIMER
  x = INT(RND * 3) + 1
  IF x = 3 THEN GOSUB TieRock
  IF x = 2 THEN GOSUB WinRock
  IF x = 1 THEN GOSUB LoseRock
END SUB

TieRock:
  LOCATE 13, 8
  PRINT "The computer chose Rock!"
  LOCATE 15, 18: PRINT "Tie!": PLAY "A"
  CALL SLEEP(3)
RETURN

WinRock:
  LOCATE 13, 8
  PRINT "The computer chose Paper!"
  LOCATE 15, 16: PRINT "You lose!": PLAY "B"
  CALL SLEEP(3)
RETURN

LoseRock:
  LOCATE 13, 7
  PRINT "The computer chose Scissors!"
  LOCATE 15, 16: PRINT "You Win!": PLAY "C"
  CALL SLEEP(3)
RETURN
'----- End Subprocedure {Rock}

'----- Begin Subprocedure {Sleep}
SUB Sleep(Seconds)
Sleeq! = TIMER
WHILE TIMER < Sleeq! + Seconds
WEND
END SUB
'----- End Subprocedure {Sleep}

'----- Begin Subprocedure {ErrorTrap}
SUB ErrorTrap
  CLS
  LOCATE 13, 9
  PRINT "Please press P,S, or R"
  CALL SLEEP(3)
END SUB
'----- End Subprocedure {ErrorTrap}
'----- End Subprocedures