AMOS PD CD/amospdcd.iso/sourcecode/games/easy_treasure.amos/easy_treasure.amosSourceCode

AMOS Source Code | 1992-06-04 | 15KB | 533 lines

' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'
'                             AMOS Treasure Search
'
'                                By P.J.Hickman
'
'                       The First AMOS P.D. Game.........
'
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Default
Global TWOPERSONS,PERSON1$,PERSON2$
Global NAME$
Global DISTANCE,GOLDX,GOLDY,XGUESS,YGUESS
Global SIZE,STGRIDX,FINISHGRIDY
Global PREV_PIC
Global THEYDONTWANTANOTHERGO
Global HINTS,HARD,LIMIT
Curs Off : Flash Off : Hide On : Screen Close 0
Led Off
Dir$="Apd2:"
INITIALISE
Gr Writing 0
Rem --------------------------------------------------------------------
Rem                      GLOBAL VARIABLE DECLARATION
Rem --------------------------------------------------------------------
Repeat
   TWOPERSONS=0
   HINTS=0
   HARD=0
   THEYDONTWANTANOTHERGO=0
   LIMIT=1000
   DISTANCE=0
   PREV_PIC=0
   GOLDX=0
   GOLDY=0
   XGUESS=0
   YGUESS=0
   SIZE=14
   STGRIDX=168
   STGRIDY=30
   FINISHGRIDX=STGRIDX+(SIZE*9)
   FINISHGRIDY=STGRIDY+(SIZE*9)
   PERSON1$="Shipmate"
   PERSON2$=PERSON1$
   NAME$=PERSON1$
   Rem --------------------------------------------------------------------
   Rem                           MAIN PROGRAM
   Rem --------------------------------------------------------------------
   NTRO
   NAMES
   GAME_TYPE
   If Rnd(1)=1 Then PICCYON_UP[2] Else PICCYON_DOWN[2] : Wait Vbl
   T0_POOL[2]
   PERSON=1
   PICK_TREASURE_LOCATION
   Repeat
      If PERSON=1 Then NAME$=PERSON1$ Else NAME$=PERSON2$
      GUESS
      CALCULATE_DISTANCE_FROM_TREASURE
      MARK_MOVE
      If(Rnd(1)=0 and DISTANCE>0) or(PREV_PIC=4 and DISTANCE>0)
         GIVE_FUNNY_PICTURE
      Else
         If DISTANCE>0
            PREV_PIC=4
            Load "Raw_Samples/No_Treasure.Abk"
            Sam Raw 15,Start(6),23458,8000
            Wait 160
            Erase 6
         End If
      End If
      If(HINTS and DISTANCE>0) Then GIVE_HELP
      If TWOPERSONS=-1 and PERSON=1 Then PERSON=2 Else PERSON=1
      If HARD=-1 Then LIMIT=LIMIT-1
   Until DISTANCE=0 or LIMIT=0
   If LIMIT>=0 and DISTANCE=0 Then FOUND_TREASURE Else MUTINY
   ANOTHER_GO
   Screen Close 6
Until THEYDONTWANTANOTHERGO=False
End
Rem -------------------------------------------------------------------
Rem                      INITIAL LOADING SEQUENCE
Rem -------------------------------------------------------------------
Procedure INITIALISE
   Rem ---------- LOAD PICTURE AND DISPLAY IT ----------
   Load Iff "Pictures/MAINSCR2.IFF",1
Screen Hide 1
   If Rnd(1)=1 Then PICCYON_UP[1] Else PICCYON_DOWN[1]
   Rem ---------- LOAD SAMPLES AND OTHER BITS ----------
   Load Iff "Pictures/MAINSCR3.iff",2
Screen Hide 2
   Rem ---------- OPEN "POOL" SCREEN ----------
   Screen Open 0,320,200,16,Lowres : Curs Off : Flash Off
   Rem ---------- COPY SCREEN 2 TO SCREEN 1 AND REUSE SCREEN 2 ----------
   Screen Copy 2,0,0,320,200 To 1,0,0
   T0_POOL[1]
   Screen Close 2
   Load Iff "Pictures/Scrolls.iff",2
Screen Hide 2
   Load "Sprites/Feet.abk"
   T0_POOL[1]
   Music Off
End Proc
Rem -------------------------------------------------------------------
Procedure NTRO
   T0_POOL[1]
   Pen 15 : Paper 6
   Ink 15
   Text 5,68,"How many people"
   Text 6,78,"will help me find"
   Text 5,88,"my lost treasure?"
   Text 24,105,"Press 1 or 2"
   Repeat
      KEY
      SCAN
      SCANPRESS=Param
   Until SCANPRESS=1 or SCANPRESS=2
   Bell
   If SCANPRESS=1 Then TWOPERSONS=0 Else TWOPERSONS=-1
End Proc
Rem -------------------------------------------------------------------
Procedure WHERE_IS_TREASURE
   CLEAN_TOP_SCROLL
   CLEAN_BOTTOM_SCROLL
   Screen 0
   Pen 1 : Paper 5 : Ink 1
   TEMP=Text Length(NAME$)
   Text(135-TEMP)/2,24,NAME$
   Text 25,42,"Where is"
   Text 35,56,"the lost"
   Text 30,70,"treasure"
   Text 32,84,"hidden?"
   Text 38,126,"I think"
   Text 34,138,"the lost"
   Text 30,150,"treasure"
   Text 26,162,"is hidden"
   Text 34,174,"at"
   Text 55,174,"("
   Text 74,174,","
   Text 90,174,")"
End Proc
Rem -------------------------------------------------------------------
Procedure ALREADY_SEARCHED
   CLEAN_TOP_SCROLL
   CLEAN_BOTTOM_SCROLL
   Ink 1
   TEMP=Text Length(NAME$)
   Text(135-TEMP)/2,20,NAME$
   Text 24,36,"This place"
   Text 51,50,"has"
   Text 36,64,"already"
   Text 48,78,"been"
   Text 27,92,"searched!!"
   PRESS_ANY_KEY
End Proc
Rem -------------------------------------------------------------------
Procedure CALCULATE_DISTANCE_FROM_TREASURE
   TEMPX=GOLDX-XGUESS
   TEMPY=GOLDY-YGUESS
   If TEMPX<0
      TEMPX=Abs(TEMPX)
   End If
   If TEMPY<0
      TEMPY=Abs(TEMPY)
   End If
   If TEMPX>TEMPY Then DISTANCE=TEMPX Else DISTANCE=TEMPY
End Proc
Rem -------------------------------------------------------------------
Procedure MARK_MOVE
   TEMPX=STGRIDX+(SIZE*XGUESS)
   TEMPY=FINISHGRIDY-(SIZE*YGUESS)
   If XGUESS>0 or YGUESS>0
      Load "Raw_Samples/Feet_Sample.Abk",6
   End If
   If XGUESS>0 Then WALKX[TEMPX,TEMPY]
   If YGUESS>0 Then WALKY[TEMPX,TEMPY]
   Bob Off : Wait Vbl
   If DISTANCE>4 Then Ink 11 Else If DISTANCE>0 Then Ink 16-DISTANCE Else Ink 15
   Bar TEMPX-3,TEMPY-4 To TEMPX+5,TEMPY+4
   Ink 1
   Box TEMPX-3,TEMPY-4 To TEMPX+5,TEMPY+4
   Erase 6
End Proc
Rem -------------------------------------------------------------------
Procedure GIVE_HELP
   CLEAN_TOP_SCROLL
   CLEAN_BOTTOM_SCROLL
   Ink 1
   TEMP=Text Length(NAME$)
   Text(135-TEMP)/2,16,NAME$
   Text 34,30,"You are"
   Text 55,42,Str$(DISTANCE)
   If DISTANCE=1
      Text 22,54,"Kilometre"
   Else
      Text 19,54,"Kilometres"
   End If
   Text 21,66,"away from"
   Text 53,78,"the"
   Text 32,90,"treasure"
   PRESS_ANY_KEY
End Proc
Rem -------------------------------------------------------------------
Procedure GIVE_FUNNY_PICTURE
   CLEAN_TOP_SCROLL
   CLEAN_BOTTOM_SCROLL
   Repeat
      TEMP=Rnd(3)+1
   Until TEMP<>PREV_PIC
   PREV_PIC=TEMP
   TEMP2=Rnd(1)
   If TEMP=1 Then Load Iff "Pictures/LION.IFF",6
   If TEMP=2 Then Load Iff "Pictures/POT.IFF",6
   If TEMP=3 Then Load Iff "Pictures/UNDERWATER.IFF",6
   If TEMP=4 Then Load Iff "Pictures/Cave.Iff",6
   If TEMP2=1
      PICCYON_UP[6]
   Else
      PICCYON_DOWN[6]
   End If
   If TEMP=3
      Load "Raw_Samples/Blub.Abk"
   Else
      Load "Raw_Samples/No_Treasure.Abk"
   End If
   Flash 9,"(000,40)(CCC,22)"
   Timer=0
   Repeat
      If Timer mod 500=0
         If TEMP=3
            Sam Raw 15,Start(6),16600,4000
            Wait 200
         Else
            Sam Raw 15,Start(6),23458,8000
            Wait 160
         End If
      End If
   Until Inkey$<>""
   Flash Off
   If Rnd(1) Then PICCYON_UP[0] Else PICCYON_DOWN[0]
   Screen Close 6
   Erase 6
End Proc
Rem -------------------------------------------------------------------
Procedure MUTINY
   Load Iff "Pictures/MUTINY.IFF",6
   Load "Raw_Samples/Splash.Abk"
   Load "Raw_Samples/Walk_The_Plank.Abk",7
   If Rnd(1)=1 Then PICCYON_UP[6] Else PICCYON_DOWN[6]
   Sam Raw 15,Start(7),13900,6500
   Wait 130
   Sam Raw 15,Start(6),12000,5500
   Wait 130
   Erase 6 : Erase 7
End Proc
Rem -------------------------------------------------------------------
Procedure GUESS
   Repeat
      WHERE_IS_TREASURE
      Repeat
         Pen 9
         Print At(8,21);"_";
         Pen 8
         Repeat
            Repeat
               KEY
            Until Param$<>" "
            XGUESS=Asc(Param$)-48
         Until XGUESS>=0 and XGUESS<=9
         Pen 1
         Print At(8,21);Right$(Param$,1);
         Bell
         Pen 9
         Print At(10,21);"_";
         Pen 8
         Repeat
            Repeat
               KEY
            Until Param$<>" "
            YGUESS=Asc(Param$)-48
            SCAN
            SCANPRESS=Param
         Until(YGUESS>=0 and YGUESS<=9) or SCANPRESS=65
         Pen 1
         If SCANPRESS=65
            Print At(10,21);" ";
         Else
            Print At(10,21);Right$(Str$(YGUESS),1);
            Pen 8
            Bell
         End If
      Until SCANPRESS<>65
      TEMP=Point(STGRIDX+(SIZE*XGUESS),FINISHGRIDY-(SIZE*YGUESS))
      If TEMP>5 Then ALREADY_SEARCHED
   Until TEMP<6
End Proc
Rem -------------------------------------------------------------------
Procedure FOUND_TREASURE
   Load Iff "Pictures/GETGOLD.IFF",6
   Screen 6
   For Y=250 To 50 Step -5
      Screen Display 6,,Y,,200
Wait Vbl
   Next
   T0_POOL[6]
   Load "Raw_Samples/Well_Done.Abk"
   Load "Raw_Samples/Squark.Abk",7
   Pen 15 : Paper 10
   Flash 9,"(000,40)(CCC,22)"
   Ink 15
   TEMP=Text Length(NAME$)
   Text(135-TEMP)/2,54,NAME$
   Text 5,63,"You"
   Text 40,63,"have"
   Text 83,63,"found"
   Text 15,71,"my treasure!"
   Timer=0
   Repeat
      If Timer mod 600=0
         Sam Raw 15,Start(6),30266,8000
         Wait 185
         Sam Raw 15,Start(7),9000,6400
         Wait 65
      End If
   Until Inkey$<>""
   Erase 6
   Erase 7
   Flash Off
End Proc
Rem -------------------------------------------------------------------
Procedure WALKX[TEMPX,TEMPY]
   For LOP=STGRIDX To(TEMPX-14) Step 14
      Bob 2,LOP,FINISHGRIDY-10,3 : Wait Vbl
      Sam Raw 1,Start(6),3900,9000
      Wait 15
      Bob 3,LOP+6,FINISHGRIDY+2,4 : Wait Vbl
      Sam Raw 8,Start(6),3900,9000
      Wait 15
   Next LOP
   Bob Off 1
   Bob Off 2
End Proc
Rem -------------------------------------------------------------------
Procedure WALKY[TEMPX,TEMPY]
   For LOP=FINISHGRIDY To TEMPY Step -14
      Bob 2,TEMPX-11,LOP,1 : Wait Vbl
      Sam Raw 1,Start(6),3900,9000
      Wait 15
      Bob 3,TEMPX+2,LOP-6,2 : Wait Vbl
      Sam Raw 8,Start(6),3900,9000
      Wait 15
   Next LOP
   Bob Off 1
   Bob Off 2
End Proc
Rem -------------------------------------------------------------------
Procedure ANOTHER_GO
   If Rnd(1)=1 Then PICCYON_UP[1] Else PICCYON_DOWN[1]
   T0_POOL[1]
   Pen 15 : Paper 6 : Ink 15
   Text 14,65,"Would you like"
   Text 32,75,"another go?"
   Text 21,98,"Press Y or N"
   YES_NO
   THEYDONTWANTANOTHERGO=Param
End Proc
Rem -------------------------------------------------------------------
Procedure NAMES
   T0_POOL[1]
   Pen 15 : Paper 6
   If TWOPERSONS=-1
      Locate 1,7
      Text 27,65,"First Player"
      Text 8,75,"Enter your name"
   Else
      Text 3,65,"Please enter your"
      Text 59,75,"name"
   End If
   CUSTOM_INPUT[10,4,11,15,15]
   PERSON1$=Param$
   If TWOPERSONS=-1
      Cls 6,3,55 To 156,111
      Text 20,65,"Second Player"
      Text 10,75,"Enter your name"
      CUSTOM_INPUT[10,4,11,15,15]
      PERSON2$=Param$
   End If
End Proc
Rem -------------------------------------------------------------------
Procedure GAME_TYPE
   T0_POOL[1]
   Pen 15 : Paper 6
   Cls 6,3,55 To 156,111
   Text 14,65,"Would you like"
   Text 31,75,"some hints?"
   Text 21,98,"Press Y or N"
   YES_NO
   HINTS=Param
   T0_POOL[1]
   Cls 6,3,55 To 156,111
   Text 14,65,"Would you like"
   Text 20,75,"a hard game?"
   Text 21,98,"Press Y or N"
   YES_NO
   HARD=Param
   If HARD=-1
      T0_POOL[1]
      LIMIT=Rnd(8)+4
      Cls 6,3,55 To 156,111
      Text 32,65,"You have "+Right$(Str$(LIMIT),Len(Str$(LIMIT))-1)
      Text 20,75,"moves to find"
      Text 28,85,"my treasure"
      Text 10,105,"Press Any Key"
      Wait Key
   End If
End Proc
Rem -------------------------------------------------------------------
Procedure PRESS_ANY_KEY
   CLEAN_BOTTOM_SCROLL
   Ink 7
   Text 23,134,"Press any"
   Text 54,150,"key"
   Text 30,166,"shipmate"
   Ink 1
   Flash 7,"(000,40)(EC0,22)"
   Wait Key
   Bell
   CLEAN_BOTTOM_SCROLL
   Flash Off
   Get Palette 2
End Proc
Rem -------------------------------------------------------------------
Procedure CLEAN_BOTTOM_SCROLL
   Cls 5,20,116 To 114,180
End Proc
Rem -------------------------------------------------------------------
Procedure CLEAN_TOP_SCROLL
   Cls 5,19,9 To 114,94
End Proc
Rem -------------------------------------------------------------------
Procedure PICK_TREASURE_LOCATION
   GOLDX=Rnd(9)
   GOLDY=Rnd(9)
End Proc
Rem -------------------------------------------------------------------
Procedure YES_NO
   Repeat
      KEY
      SCAN
      SCANPRESS=Param
   Until SCANPRESS=21 or SCANPRESS=54
   Bell
   If SCANPRESS=21 Then SCANPRESS=-1 Else SCANPRESS=0
End Proc[SCANPRESS]
Rem -------------------------------------------------------------------
Procedure T0_POOL[SCRNUM]
   Screen Hide 0
   Screen Copy SCRNUM,0,0,320,200 To 0,0,0
   Screen 0
   Get Palette SCRNUM
   Screen To Front 0
   Screen Show 0
   Wait Vbl
End Proc
Rem -------------------------------------------------------------------
Procedure PICCYON_UP[SCR]
   Screen Display SCR,,350,,
Screen Show SCR
   Screen To Front SCR
   For Y=350 To 50 Step -5
      Screen Display SCR,,Y,,
      Wait Vbl
   Next
   Screen SCR
End Proc
Rem -------------------------------------------------------------------
Procedure PICCYON_DOWN[SCR]
   Screen Display SCR,,-200,,
Screen Show SCR
   Screen To Front SCR
   For Y=-200 To 50 Step 5
      Screen Display SCR,,Y,,
      Wait Vbl
   Next
   Screen SCR
End Proc
Rem -------------------------------------------------------------------
Procedure CUSTOM_INPUT[INPSIZE,X,Y,TCOL,CURSCOL]
   INP$=""
   COUNT=0
   SCANPRESS=0
   X2=X
   Locate X,Y
   Print String$(" ",INPSIZE+1);
   Repeat
      Locate X2,Y
      Pen CURSCOL : Print "_" : Pen TCOL
      Locate X2,Y
      Repeat
         KEY
         PRESSKEY$=Param$
         SCAN
         SCANPRESS=Param
      Until(Asc(PRESSKEY$)>=65 and Asc(PRESSKEY$)<=90) or SCANPRESS=65 or SCANPRESS=68
      If SCANPRESS<>65 and COUNT>0 and SCANPRESS<>68 Then PRESSKEY$=Lower$(PRESSKEY$)
      If SCANPRESS<>65 and COUNT<INPSIZE and SCANPRESS<>68 Then Print PRESSKEY$ : INP$=INP$+PRESSKEY$ : COUNT=COUNT+1 : X2=X2+1
      If SCANPRESS=65 and X2>X and SCANPRESS<>68 Then COUNT=COUNT-1 : X2=X2-1 : Locate X2,Y : Print "  "; : INP$=Left$(INP$,COUNT)
   Until SCANPRESS=68 and COUNT>0
   Locate X,Y : Print String$(" ",INPSIZE+1);
End Proc[INP$]
Rem -------------------------------------------------------------------
Procedure KEY
   Repeat
      PRESSKEY$=Upper$(Inkey$)
   Until PRESSKEY$<>""
End Proc[PRESSKEY$]
Rem -------------------------------------------------------------------
Procedure PAUSE[NUM]
   For LOP=1 To NUM
   Next
End Proc
Rem -------------------------------------------------------------------
Procedure SCAN
   SCANPRESS=Scancode
End Proc[SCANPRESS]
Rem -------------------------------------------------------------------
Procedure DISKEY
   KEY
   TEST$=Param$
   SCAN
   TEST=Param
   Print Asc(Param$);"  ";TEST
End Proc