Club Amiga de Montreal - CAM/CAM_CD_1.iso/files/058.lha/enigma

AmigaBASIC Source Code | 1986-11-20 | 9.3 KB | 516 lines

REM ENIGMA
 GOSUB INITIALIZE
PLAYGAME:
 GOSUB GAME
PLAYAGAIN:
 LOCATE 20,21: PRINT "Play Again ? ";
 ROW=20: X0=337: GOSUB DECIDE
 IF BUTTON=1 THEN PLAYGAME
 GOSUB GOODBYE
END

INITIALIZE:
 GOSUB SETSCREEN
 GOSUB KEYVALUES
 GOSUB SETMENUS
 GOSUB SETCOLORS
 GOSUB HEADING
RETURN

SETSCREEN:
 SCREEN 1,640,200,3,2
 WINDOW 2,"Enigma",,0,1
RETURN

KEYVALUES:
 DEFINT A-Z
 RANDOMIZE TIMER
 DIM ALBT(26)
 BK$=CHR$(32)
 LT$(1)="Y": LT$(2)="N"
 REM NUMBER OF PHRASES
  DATA 75
  READ NP
 REM MAXIMUM MOVES
  DATA 25,20,15
  FOR I=1 TO 3
   READ MOVES(I)
  NEXT
RETURN

SETMENUS:
 DATA 2, Rules, Yes, No
 DATA 3, Game, Easy, Medium, Hard
 DATA 2, Secret, Amiga Selects, Player Selects
 DATA 3, Stop, Go to BASIC
 DATA Go to Games Menu, Goto System
 FOR I=1 TO 4
  READ NUMBER
  FOR J=0 TO NUMBER
   READ TITLE$
  IF J<>0 THEN TITLE$=SPACE$(3)+TITLE$
  STATUS=1
   IF I<>4 AND J=1 THEN STATUS=2
  MENU I,J,STSTUS,TITLE$
 NEXT J,I
 RULES=1: GAME=1: SELECTOR=1
 MENU ON
 ON MENU GOSUB OPTIONS
RETURN

SETCOLORS:
 REM GREEN AND RED
  PALETTE 5,0.14,0.43,0
  PALETTE 6,0.93,0.2,0
RETURN

HEADING:
 LINE(233,78)-(393,108),2,BF
 COLOR 6,2
 LOCATE 11: PRINT PTAB(284)"Enigma"
 COLOR 1,0
 LOCATE 17,24:PRINT "Please use menus,"
 LOCATE 19,23:PRINT "Click mouse to play"
 GOSUB CLICKIT
RETURN

OPTIONS:
 ID=MENU(0): ITEM=MENU(1)
 ON ID GOSUB MENU1,MENU2,MENU3,GOODBYE
 ITEM=0
RETURN

MENU1:
 MENU 1,RULES,1: MENU 1,ITEM,2
 RULE=ITEM
RETURN

MENU2:
 MENU 2,GAME,1: MENU 2,ITEM,2
 GAME=ITEM
RETURN

MENU3:
 MENU 3,SELECTOR,1: MENU 3,ITEM,2
 SELECTOR=ITEM
RETURN

GOODBYE:
 WINDOW CLOSE 2: WINDOW 1: MENU RESET
 SCREEN CLOSE 1
 IF ITEM=2 THEN RUN "GAMES"
 IF ITEM=3 THEN SYSTEM
 COLOR 1,0: CLS
 PRINT "Bye-Bye"
 STOP
RETURN

CLICKIT:
 S$=""
 WHILE MOUSE(0)=0 AND S$=""
  S$=INKEY$
 WEND
 X=MOUSE(1)
 Y=MOUSE(2)
 WHILE MOUSE(0) <> 0: WEND: REM RESET
RETURN

GAME:
 IF RULES=1 THEN GOSUB RULES
 ON SELECTOR GOSUB AMIGA, HUMAN
 GOSUB LABEL
 GOSUB PUNCTUATION
 GOSUB SCRAMBLE
 GOSUB PLAY
 COLOR 1,0
 IF GAME$="WIN" THEN
   LOCATE 17,23: PRINT "Congratulations !"
   SOUND 900,2
  ELSE
   GOSUB DEFEAT
 END IF
RETURN

RULES:
 CLS
 PRINT
 PRINT "   Department G2 has intercepted a ";
 COLOR 6,2: PRINT "SECRET";: COLOR 1,0
 PRINT " enemy transmission."
 PRINT
 PRINT "   Your goal is to decode it by:"
 PRINT
 PRINT "   -- Clicking the mouse on a letter in";
 PRINT " the garbled message."
 PRINT
 PRINT "   -- Entering what you think is the";
 PRINT " correct character."
 LOCATE 20,26:PRINT "Click Mouse";
 GOSUB CLICKIT
RETURN

AMIGA:
 RESTORE PHRASES
 Z=INT(RND*NP)+1
 FOR I=1 TO Z
  READ SECRET$
 NEXT
RETURN

HUMAN:
 CLS
 SOUND 440,2
 LOCATE 2,3: PRINT "Please enter your secret.";
 PRINT "  Use the Back Space key to"
 PRINT " correct a mistake."
 ROW=6: L=45: GOSUB ENTER.PHRASE
 SECRET$=PHRASE$
RETURN

ENTER.PHRASE:
 Y0=ROW*9-15
 LINE (16,Y0)-((L+3)*10,Y0+18),2,BF
 S$="": C=3: COLOR 6,2
 GOSUB KEY
RETURN

KEY:
 LOCATE ROW,C: PRINT CHR$(124);
 L$=INKEY$: IF L$="" THEN KEY
 A=ASC(L$)
 IF C=3 AND (A=8 OR A=13) THEN
  SOUND 900,2: GOTO KEY
 END IF
 IF A=8 THEN
  S$=LEFT$(S$,LEN(S$)-1)
  PRINT CHR$(8);
  C=C-1
  GOTO KEY
 END IF
 IF C=L+3 AND A<>13 THEN SOUND 900,2: GOTO KEY
 IF A <> 13 THEN
  PRINT CHR$(8);UCASE$(L$)
  S$=S$+UCASE$(L$)
  C=C+1
  GOTO KEY
 END IF
 PHRASE$=S$
RETURN

LABEL:
 COLOR 1,0
 CLS
 LINE(15,5)-(160,29),1,BF
 COLOR 6,1
 LOCATE 2,3: PRINT "Guesses"
 LOCATE 3,3: PRINT "Remaining:"
RETURN

PUNCTUATION:
 GUESS$=""
 L=LEN(SECRET$)
 FOR I=1 TO L
  L$=MID$(SECRET$,I,1): A=ASC(L$)
  IF A > 64 AND A < 91 THEN L$=BK$
  GUESS$=GUESS$+L$
 NEXT
RETURN

SCRAMBLE:
 COLOR 1,0
 FOR I=1 TO 26: ALBT(I)=0: NEXT
 LOCATE 10,27: PRINT "Scrambling ..."
 SCRAMBLE$=GUESS$
 FOR I=1 TO L
  LT$=MID$(SECRET$,I,1)
  S$=MID$(SCRAMBLE$,I,1)
  IF LT$ <> BK$ AND S$=BK$ THEN
   GOSUB RANDOM.LETTER
   GOSUB SUBSTITUTE
  END IF
 NEXT I
RETURN

RANDOM.LETTER:
 SOUND 200,1
 SEARCH$="ON"
 WHILE SEARCH$="ON"
  V=INT(26*RND)+1
  IF ALBT(V) <> 1 THEN SEARCH$="OFF"
 WEND
 RL$=CHR$(64+V): ALBT(V)=1
RETURN

SUBSTITUTE:
 FOR J=I TO L
  IF MID$(SECRET$,J,1)=LT$ THEN
   MID$(SCRAMBLE$,J,1)=RL$
  END IF
 NEXT J
RETURN

PLAY:
 GOSUB DRAWBARS
 GOSUB INITIAL.VALUES
 WHILE GAME$="ON" AND N < MAX.MOVES
  GOSUB ENTER.LETTER
  GOSUB CHECK.FOR.MATCH
  IF GUESS$=SECRET$ THEN GAME$="WIN"
  IF GAME$="ON" AND AN$="Right" THEN
   GOSUB ASK.TO.DECODE
  END IF
 WEND
RETURN

INITIAL.VALUES:
 N=0: REM NUMBER OF WRONG GUESSES
 MAX.MOVES=MOVES(GAME)
 COLOR 6,1
 LOCATE 3,13: PRINT MAX.MOVES
 GAME$="ON"
 REM HIGHLIGHT FIRST LETTER
  COL=3: COL.HOLD=3: P=1
  COLOR 1,3
  LOCATE 8,3: PRINT MID$(SCRAMBLE$,1,1)
RETURN

DRAWBARS:
 COLOR 1,0
 LOCATE 10,27: PRINT SPACE$(14)
 LOCATE 6,3: PRINT "Secret Code:"
 LINE(16,57)-(22+L*10,75),3,BF
 COLOR 2,3
 LOCATE 8,3: PRINT SCRAMBLE$
 LINE(16,93)-(22+L*10,111),1,BF
 COLOR 0,1
 LOCATE 12,3: PRINT GUESS$
RETURN

ENTER.LETTER:
 COLOR 1,0
 LOCATE 6,16: PRINT "(Click on letter;";
 PRINT " enter guess)"
 ACTION$="OK"
 WHILE ACTION$ <> "LETTER"
  GOSUB CLICKIT
  IF S$="" THEN GOSUB LOCATION :ELSE GOSUB LETTER
  IF ACTION$="BAD" THEN SOUND 900,2
 WEND
 COLOR 1,0
 LOCATE 10,COL: PRINT C$
RETURN

LOCATION:
 ACTION$="OK"
 C1=INT(X/10)+1
 IF Y<57 OR Y>75 OR C1<3 OR C1 > L+2 THEN
  ACTION$="BAD"
 ELSE
  COL=C1: P=COL-2
  COLOR 2,3
  LOCATE 8,COL.HOLD
  PRINT MID$(SCRAMBLE$,COL.HOLD-2,1)
  COLOR 1,3
  LTR$=MID$(SCRAMBLE$,P,1)
  IF LTR$=BK$ THEN LTR$=CHR$(124)
  LOCATE 8,COL: PRINT LTR$
  COL.HOLD=COL
 END IF
RETURN

LETTER:
 ACTION$="LETTER"
 S$=UCASE$(S$): A=ASC(S$): C$=CHR$(A)
 L1$=MID$(GUESS$,P,1)
 L2$=MID$(SECRET$,P,1)
 IF A<65 OR A>90 OR L1$<>BK$ OR L2$=BK$ THEN
  ACTION$="BAD"
 END IF
RETURN

CHECK.FOR.MATCH:
 IF L2$=C$ THEN AN$="Right" :ELSE AN$="Wrong"
 LOCATE 6,16: PRINT SPACE$(30)
 LOCATE 6,16: PRINT AN$;" Letter."
 GOSUB GURGLE
 IF AN$="Right" THEN GOSUB HIT :ELSE GOSUB MISS
RETURN

HIT:
 FOR J=1 TO L
  S$=MID$(SECRET$,J,1)
  IF S$=C$ THEN MID$(GUESS$,J,1)=C$
 NEXT
 COLOR 0,1
 LOCATE 12,3: PRINT GUESS$
RETURN

MISS:
 COLOR 6,1
 N=N+1
 LOCATE 3,13: PRINT MAX.MOVES-N
 FOR PAUSE=1 TO 7500: NEXT
RETURN

GURGLE:
 FREQ=300
 FOR G=1 TO 7
  FREQ=500-FREQ
  SOUND FREQ,1,50
 NEXT G
RETURN

ASK.TO.DECODE:
 COLOR 1,0
 LOCATE 16,20: PRINT "Decode ?"
 ROW=16: X0=275: GOSUB DECIDE
 LOCATE 16,20: PRINT SPACE$(8)
 LINE(X0,Y0)-(X0+96,Y0+14),0,BF
 IF BUTTON=1 THEN GOSUB GET.ANSWER
RETURN

DECIDE:
 BUTTON=0
 GOSUB DRAWBUTTON
 GOSUB PUSHBUTTON
 COLOR 1,0
RETURN

DRAWBUTTON:
 Y0=9*ROW-13
 XB(1)=X0+27: XB(2)=X0+69: YB=Y0+7
 LINE (X0,Y0)-(X0+96,Y0+14),1,BF
 FOR I=1 TO 2
  CIRCLE (XB(I),YB),12,I+4
  PAINT (XB(I),YB),I+4
  COLOR 1,I+4
  LOCATE ROW: PRINT PTAB(XB(I)-4);LT$(I);
 NEXT I
RETURN

PUSHBUTTON:
 SOUND 440,2
 GOSUB CLICKIT
 S$=UCASE$(S$)
 IF S$="Y" THEN BUTTON=1
 IF S$="N" THEN BUTTON=2
 FOR I=1 TO 2
  XD=ABS(X-XB(I)): YD=ABS(Y-YB)
  IF XD<13 AND YD<7 THEN BUTTON=I: I=2
 NEXT
 IF BUTTON=0 THEN PUSHBUTTON
RETURN

GET.ANSWER:
 ROW=15
 GOSUB ENTER.PHRASE
 IF PHRASE$=SECRET$ THEN
  GAME$="WIN"
 ELSE
  COLOR 1,0
  LOCATE 18,23: PRINT "Wrong translation."
  SOUND 150,9: SOUND 130,9
  LOCATE 20,26: PRINT "Click Mouse";
  GOSUB CLICKIT
  LOCATE 18,23: PRINT SPACE$(18)
  LOCATE 20,26: PRINT SPACE$(11);
  LINE(16,Y0)-((L+3)*10,Y0+18),0,BF
 END IF
RETURN

DEFEAT:
 COLOR 1,0
 LOCATE 16,16: PRINT "View Secret ?"
 ROW=16: X0=285: GOSUB DECIDE
 LOCATE 16,16: PRINT SPACE$(13)
 LINE(X0,Y0)-(X0+96,Y0+14),0,BF
 IF BUTTON=1 THEN LOCATE 10,3: PRINT SECRET$
RETURN

PHRASES:
 DATA GOD SAVE THE QUEEN
 DATA "THE FEW, THE PROUD, THE MARINES !"
 DATA A FEW GOOD MEN
 DATA "I CAME, I SAW, I CONQUERED"
 DATA I SHALL NOT DEAL IN MALICE
 DATA LOVE THY NEIGHBOR
 DATA TAKE IT EASY
 DATA EVERY WHICH WAY BUT LOOSE
 DATA THE RUSSIANS ARE COMING
 DATA JACK AND JILL WENT UP A HILL
 DATA THE COW JUMPED OVER THE MOON
 DATA HEY DIDDLE DIDDLE
 DATA THE OLD GRAY MARE
 DATA "TINKER, TAILOR, SOLDIER, SPY"
 DATA THE GRAPES OF WRATH
 DATA GONE WITH THE WIND
 DATA THE GULAG ARCHIPELAGO
 DATA TIE ME KANGAROO DOWN MATE
 DATA MY LITTLE CHICKADEE
 DATA THE LAST OF THE MOHICANS
 DATA NICE GUYS FINISH LAST
 DATA THE WHOLE NINE YARDS
 DATA I LOVE NEW YORK
 DATA DON QUIXOTE AND SANCHO PANZA
 DATA HONEST ABE LINCOLN
 DATA "EAST SIDE, WEST SIDE"
 DATA SUGAR AND SPICE AND EVERYTHING NICE
 DATA OF MICE AND MEN
 DATA ALICE IN WONDERLAND
 DATA THERE'S SOMETHING ROTTEN IN DENMARK
 DATA WHAT A REVOLTING PREDICAMENT
 DATA A ROLLONG STONE GATHERS NO MOSS
 DATA BEAM ME ABOARD SCOTTY
 DATA IT'S A LONG WAY TO TIPPERARY
 DATA THE ANSWER IS BLOWING IN THE WIND
 DATA GIVE ME LIBERTY OR GIVE ME DEATH
 DATA DIVIDE AND CONQUER
 DATA IT'S THE REAL THING
 DATA I THINK THEREFORE I AM
 DATA A STITCH IN TIME SAVES NINE
 DATA THERE'S NO FREE LUNCH
 DATA TWAS THE NIGHT BEFORE CHRISTMAS
 DATA "RED SKY AT NIGHT, SAILOR'S DELIGHT"
 DATA IN THE LONG RUN, WE'RE ALL DEAD
 DATA "HAIL TO THE REDSKINS, HAIL VICTORY"
 DATA "TO ERR IN HUMAN, TO FORGIVE DIVINE"
 DATA THE MOUSE RAN UP THE CLOCK
 DATA A CAT HAS NINE LIVES
 DATA THE JOLLY GREEN GIANT
 DATA THE AMAZING AMIGA
 DATA "ELEMENTARY, MY DEAR WATSON"
 DATA MARY HAD A LITTLE LAMB
 DATA HE WHO HESITATES IS LOST
 DATA "COLUMBIA, THE GEM OF THE OCEAN"
 DATA THIS LAND IS MADE FOR YOU AND ME
 DATA "MOBY DICK, THE GREAT WHITE WHALE"
 DATA THE HOUND OF THE BASKERVILLES
 DATA THE BRONX BOMBER
 DATA I AM THE GREATEST
 DATA SLOW AS MOLASSES
 DATA THE LAND OF THE RISING SUN
 DATA "ALMOST HEAVEN, WEST VIRGINIA"
 DATA FROM THE HALLS OF MONTEZUMA
 DATA TOO MANY COOKS SPOIL THE BROTH
 DATA "HARK THE RAVEN, NEVERMORE !"
 DATA TOM SAWYER AND HUCKLEBERRY FINN
 DATA WHERE'S THE BEEF?
 DATA "TWINKLE, TWINKLE, LITTLE STAR"
 DATA IT'S A GRAND SLAM HOME RUN
 DATA E PLURIBUS UNUM
 DATA NO TAXATION WITHOUT REPRESENTATION
 DATA ONCE UPON A MIDNIGHT DREARY
 DATA E EQUALS MC SQUARED
 DATA THE HUNCHBACK OF NOTRE DAME
 DATA AND THEY LIVED HAPPILY EVER AFTER