home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / sourcecode / various / amosgold.amos / amosgold.amosSourceCode next >
AMOS Source Code  |  1993-01-08  |  11KB  |  501 lines
  1. '*                    POKER MACHINE                        * 
  2. '*             WRITTEN IN AMOS BASIC V1.2                  *     
  3. '*              BY PETER CRAVEN MAY 1991                   *   
  4. '*                 P.O. Box 561 WEIPA                      *   
  5. '*                      Qld. 4874                          *   
  6. Set Buffer 18
  7. Unpack 2 To 0
  8. Unpack 3 To 1
  9. Limit Mouse 128,42 To 440,294
  10. Double Buffer 
  11. Colour 13,822
  12. Flash 3,"(B22,10)(FF0,10)"
  13. Dim REEL$(15),HELD(5),HOLDBOB(15),REELSTOP(15),RSTOP$(15),LINE(3),RESULT(5,3),AJPOT$(8),BJPOT$(8),CJPOT$(8),APAYT(8),BPAYT(8),CPAYT(8),LINE$(3)
  14. Global REEL$(),HELD(),HOLDBOB(),REELSTOP(),LINE(),RESULT(),SIT,HOLDOPTION,MZ,LASTHELD
  15. Global AJPOT$(),BJPOT$(),CJPOT$(),LINE$(),RSTOP$(),WIN,GO,GAME,NOHOLD
  16. Global APAYT(),BPAYT(),CPAYT(),CREDIT,REELSHELD
  17. Gr Writing 0
  18. For K=1 To 3
  19.    Hot Spot 8+K,0,128
  20. Next K
  21. Bob 16,277,203,9
  22. Proc CREATEZONES
  23. Proc HOWTO
  24. HOLDOPTION=0 : LASTHELD=0 : CREDIT=100 : GAME=0 : FIRST=1
  25. For K=1 To 3
  26.    LINE(K)=0
  27. Next K
  28. Proc SCORES
  29. Proc REELSTARTPOS
  30. Proc CHANSET
  31. RESTART:
  32. GAME=0
  33. Proc SCOREBOARD
  34. Proc HOLDREEL
  35. Proc LINESELECT
  36. Proc REELSET
  37. If FIRST=0
  38.    Proc REELPOSITION
  39. End If 
  40. FIRST=0
  41. Do 
  42.    Proc GAMEPLAY["NO"]
  43.    GO=LINE(1)+LINE(2)+LINE(3)
  44.    Exit If GO>0 and REELSHELD<5
  45.    If REELSHELD=5
  46.       Ink 3,7
  47.       Text 70,214,"CANNOT HOLD ALL REELS!!"
  48.       Wait 100
  49.       Cls 7,70,204 To 264,215
  50.    End If 
  51.    If GO=0
  52.       Ink 3,7
  53.       Text 95,214,"NO COINS PLAYED!!"
  54.       Wait 100
  55.       Cls 7,94,204 To 240,215
  56.    End If 
  57. Loop 
  58. GAME=1
  59. Proc SPINRESULT
  60. Proc LIMIT
  61. Proc HANDLE
  62. Proc SPIN
  63. Proc TESTBOB
  64. Proc PAYOUT
  65. Add CREDIT,WIN
  66. Proc SCOREBOARD
  67. If WIN>0
  68.    Ink 3
  69.    Paint 1,1
  70.    Wait 100
  71.    Ink 13
  72.    Paint 1,1
  73. End If 
  74. Do 
  75.    K=Mouse Key
  76.    Exit If K=1
  77.    If K=2
  78.       Proc CHART
  79.    End If 
  80. Loop 
  81. Proc RESET
  82. Goto RESTART
  83. Procedure RESET
  84.    LASTHELD=0 : REELSHELD=0
  85.    For K=1 To 3
  86.       LINE$(K)=""
  87.       LINE(K)=0
  88.    Next K
  89.    For K=1 To 15
  90.       HOLDBOB(K)=0
  91.    Next K
  92.    For K=1 To 5
  93.       If HELD(K)=1 Then LASTHELD=1
  94.       HELD(K)=0
  95.    Next K
  96.    If WIN=0 and LASTHELD=0 and NOHOLD=0
  97.       HOLDOPTION=1
  98.    Else HOLDOPTION=0
  99.    End If 
  100.    WIN=0 : NOHOLD=0
  101. End Proc
  102. Procedure CHANSET
  103.    For K=1 To 15
  104.       Channel K To Bob K
  105.    Next K
  106. End Proc
  107. Procedure SPIN
  108.    For K=1 To 15
  109.       If HOLDBOB(K)<>1
  110.          Anim K,RSTOP$(K)
  111.       End If 
  112.       Anim On 
  113.    Next K
  114.    Wait SIT+5
  115. End Proc
  116. Procedure REELSTARTPOS
  117.    For K=1 To 8
  118.       Hot Spot K,0,0
  119.    Next K
  120.    For K=1 To 15
  121.       Read X,Y,I
  122.       Bob K,X,Y,I
  123.    Next K
  124.    Data 73,59,6,73,95,4,73,131,2
  125.    Data 109,59,8,109,95,2,109,131,7
  126.    Data 145,59,2,145,95,5,145,131,4
  127.    Data 181,59,2,181,95,8,181,131,6
  128.    Data 217,59,4,217,95,6,217,131,2
  129. End Proc
  130. Procedure HANDLE
  131.    Channel 0 To Bob 16
  132.    HANDLE$="A 1,(9,10)(10,10)(11,8)(10,6)(9,10)"
  133.    Amal 0,HANDLE$
  134.    Amal On 
  135.    Wait 10
  136. End Proc
  137. Procedure SPINRESULT
  138.    Randomize Timer
  139.    For K=1 To 5
  140.       RSTOP=(Rnd(19)+1)*5
  141.       For M=1 To 3
  142.          REELSTOP((K-1)*3+M)=RSTOP
  143.       Next M
  144.    Next K
  145.    For K=1 To 15
  146.       RSTOP$(K)=Left$(REEL$(K),REELSTOP(K))
  147.    Next K
  148.    For K=1 To 5
  149.       If HELD(K)=0
  150.          For N=K To 5
  151.             If HELD(N)=0
  152.                For M=1 To 3
  153.                   H=(N-1)*3+M
  154.                   RSTOP$(H)=REEL$(H)+RSTOP$(H)
  155.                Next M
  156.             End If 
  157.          Next N
  158.       End If 
  159.    Next K
  160.    For K=1 To 15
  161.       RSTOP$(K)=RSTOP$(K)+Right$(RSTOP$(K),5)
  162.    Next K
  163. End Proc
  164. Procedure TESTBOB
  165.    For L=1 To 3
  166.       For C=1 To 5
  167.          K=(C-1)*3+L
  168.          RESULT(C,L)=I Bob(K)
  169.       Next C
  170.    Next L
  171. End Proc
  172. Procedure HOLDREEL
  173.    Set Paint 1
  174.    Ink 12,,9
  175.    Bar 69,176 To 251,200
  176.    Ink 9
  177.    For K=1 To 5
  178.       Box 71+(K-1)*36,178 To 105+(K-1)*36,198
  179.       If HOLDOPTION=1
  180.          Ink 9
  181.          Text 73+(K-1)*36,190,"HOLD"
  182.       End If 
  183.    Next K
  184. End Proc
  185. Procedure LINESELECT
  186.    Ink 11
  187.    Bar 4,56 To 44,166
  188.    Ink 9
  189.    For K=1 To 3
  190.       Box 6,58+(K-1)*36 To 42,92+(K-1)*36
  191.       Text 8,78+(K-1)*36,"LINE"
  192.    Next K
  193. End Proc
  194. Procedure GAMEPLAY[SPIN$]
  195.    While SPIN$="NO"
  196.       MC=Mouse Key
  197.       MZ=Mouse Zone
  198.       If MZ=9 and MC>0
  199.          SPIN$="GO"
  200.       End If 
  201.       If MC>0 and(MZ=1 or MZ=2 or MZ=3)
  202.          Proc LINES
  203.       End If 
  204.       If MC>0 and MZ>=4 and MZ<=8 and HOLDOPTION=1
  205.          Proc HOLD
  206.       End If 
  207.       If MZ=10 and MC>0
  208.          Proc CHART
  209.       End If 
  210.    Wend 
  211. End Proc
  212. Procedure CREATEZONES
  213.    Reserve Zone 12
  214.    For K=1 To 3
  215.       Set Zone K,6,58+(K-1)*36 To 42,92+(K-1)*36
  216.    Next K
  217.    For K=1 To 5
  218.       Set Zone K+3,71+(K-1)*36,178 To 105+(K-1)*36,198
  219.    Next K
  220.    Set Zone 9,272,72 To 304,200
  221.    Set Zone 10,50,8 To 270,36
  222. End Proc
  223. Procedure LINES
  224.    If LINE(MZ)=1
  225.       LINE(MZ)=0
  226.       K=11 : N=9
  227.       Inc CREDIT
  228.    Else 
  229.       LINE(MZ)=1
  230.       K=24 : N=0
  231.       Dec CREDIT
  232.    End If 
  233.    Cls K,7,59+(MZ-1)*36 To 42,92+(MZ-1)*36
  234.    Ink N : Text 8,78+(MZ-1)*36,"LINE"
  235.    Proc SCOREBOARD
  236. End Proc
  237. Procedure SCORES
  238.    For K=1 To 8
  239.       Read AJPOT$(K)
  240.    Next K
  241.    For K=1 To 8
  242.       BJPOT$(K)=Left$(AJPOT$(K),4)
  243.    Next K
  244.    For K=1 To 8
  245.       CJPOT$(K)=Left$(AJPOT$(K),3)
  246.    Next K
  247.    For K=1 To 8
  248.       Read APAYT(K)
  249.    Next K
  250.    For K=1 To 8
  251.       Read BPAYT(K)
  252.    Next K
  253.    For K=1 To 8
  254.       Read CPAYT(K)
  255.    Next K
  256.    Data "11111","22222","33333","44444","55555","66666","77777","88888"
  257.    Data 3000,500,5000,4000,300,2000,1000,150
  258.    Data 200,50,500,500,25,150,75,25
  259.    Data 50,15,100,75,10,25,15,10
  260. End Proc
  261. Procedure PAYOUT
  262.    SCATS=0
  263.    For L=1 To 3
  264.       For C=1 To 5
  265.          LINE$(L)=LINE$(L)+Str$(RESULT(C,L))-" "
  266.       Next C
  267.    Next L
  268.    For L=1 To 3
  269.       LL$=LINE$(L)
  270.       For K=1 To 8
  271.          If LL$=(AJPOT$(K)) and(APAYT(K)>WIN) and(LINE(L)=1)
  272.             WIN=APAYT(K)
  273.          End If 
  274.          If LL$=(AJPOT$(K)) and(LINE(L))=0
  275.             NOHOLD=1
  276.          End If 
  277.       Next K
  278.    Next L
  279.    If WIN>0
  280.       Pop Proc
  281.    End If 
  282.    For L=1 To 3
  283.       LL$=Left$(LINE$(L),4)
  284.       For K=1 To 8
  285.          If LL$=(BJPOT$(K)) and(BPAYT(K)>WIN) and(LINE(L)=1)
  286.             WIN=BPAYT(K)
  287.          End If 
  288.          If LL$=(BJPOT$(K)) and(LINE(L))=0
  289.             NOHOLD=1
  290.          End If 
  291.       Next K
  292.    Next L
  293.    If WIN>0
  294.       Pop Proc
  295.    End If 
  296.    For L=1 To 3
  297.       LL$=Right$(LINE$(L),4)
  298.       For K=1 To 8
  299.          If LL$=(BJPOT$(K)) and(BPAYT(K)>WIN) and(LINE(L)=1)
  300.             WIN=BPAYT(K)
  301.          End If 
  302.          If LL$=(BJPOT$(K)) and(LINE(L))=0
  303.             NOHOLD=1
  304.          End If 
  305.       Next K
  306.    Next L
  307.    If WIN>0
  308.       Pop Proc
  309.    End If 
  310.    For L=1 To 3
  311.       LL$=Left$(LINE$(L),3)
  312.       For K=1 To 8
  313.          If LL$=(CJPOT$(K)) and(CPAYT(K)>WIN) and(LINE(L)=1)
  314.             WIN=CPAYT(K)
  315.          End If 
  316.          If LL$=(CJPOT$(K)) and(LINE(L))=0
  317.             NOHOLD=1
  318.          End If 
  319.       Next K
  320.    Next L
  321.    If WIN>0
  322.       Pop Proc
  323.    End If 
  324.    For L=1 To 3
  325.       LL$=Right$(LINE$(L),3)
  326.       For K=1 To 8
  327.          If LL$=(CJPOT$(K)) and(CPAYT(K)>WIN) and(LINE(L)=1)
  328.             WIN=CPAYT(K)
  329.          End If 
  330.          If LL$=(CJPOT$(K)) and(LINE(L))=0
  331.             NOHOLD=1
  332.          End If 
  333.       Next K
  334.    Next L
  335.    For DWN=1 To 5
  336.       For ROW=1 To 3
  337.          D=RESULT(DWN,ROW)
  338.          If D=3
  339.             Inc SCATS
  340.          End If 
  341.       Next ROW
  342.    Next DWN
  343.    If GO=3
  344.       If SCATS=5 and WIN<40
  345.          WIN=25
  346.       End If 
  347.       If SCATS=4 and WIN<15
  348.          WIN=15
  349.       End If 
  350.    End If 
  351.    If SCATS>3 and GO<3
  352.       NOHOLD=1
  353.    End If 
  354.    If WIN>0
  355.       Pop Proc
  356.    End If 
  357.    For L=1 To 3
  358.       LL$=Left$(LINE$(L),2) : LR$=Right$(LINE$(L),2)
  359.       If(LL$="88") and(LINE(L)=1)
  360.          WIN=5
  361.       End If 
  362.       If(LR$="88") and(LINE(L)=1)
  363.          WIN=5
  364.       End If 
  365.       If(LR$="88") and(LINE(L)=0)
  366.          NOHOLD=1
  367.       End If 
  368.       If(LL$="88") and(LINE(L)=0)
  369.          NOHOLD=1
  370.       End If 
  371.    Next L
  372. End Proc
  373. Procedure LIMIT
  374.    N=6 : LASTREEL=0
  375.    While LASTREEL=0
  376.       Dec N
  377.       If HELD(N)=0 Then LASTREEL=N
  378.    Wend 
  379.    NOHELDS=5-REELSHELD
  380.    SIT=4+80*NOHELDS+((REELSTOP(LASTREEL*3))/5)*4
  381. End Proc
  382. Procedure HOLD
  383.    M=MZ-3
  384.    If HELD(M)=0
  385.       HELD(M)=1
  386.       Inc REELSHELD
  387.       K=23 : N=0
  388.    Else HELD(M)=0
  389.       K=12 : N=9
  390.       Dec REELSHELD
  391.    End If 
  392.    Cls K,72+(M-1)*36,179 To 105+(M-1)*36,198
  393.    Ink N : Text 73+(M-1)*36,190,"HOLD"
  394.    For K=1 To 5
  395.       For N=1 To 3
  396.          M=N+(K-1)*3
  397.          If HELD(K)=1
  398.             HOLDBOB(M)=1
  399.          Else HOLDBOB(M)=0
  400.          End If 
  401.       Next N
  402.    Next K
  403. End Proc
  404. Procedure SCOREBOARD
  405.    WIN$=Str$(WIN)-" "
  406.    CREDIT$=Str$(CREDIT)-" "
  407.    If WIN=0
  408.       If GAME=0
  409.          WIN$=""
  410.       Else WIN$="---"
  411.       End If 
  412.    End If 
  413.    Cls 0,98,222 To 136,232
  414.    Ink 3 : Text 135-Len(WIN$)*8,230,WIN$
  415.    Cls 0,190,222 To 252,232
  416.    Ink 5 : Text 250-Len(CREDIT$)*8,230,CREDIT$
  417. End Proc
  418. Procedure CHART
  419.    Screen To Back 1
  420.    Limit Mouse 128,48 To 148,68
  421.    While MCLICK=0
  422.       MCLICK=Mouse Click
  423.    Wend 
  424.    Screen To Back 0
  425.    Limit Mouse 
  426. End Proc
  427. Procedure HOWTO
  428.    HOLDOPTION=1
  429.    Proc LINESELECT
  430.    Proc HOLDREEL
  431.    Ink 19
  432.    Set Text 1
  433.    Text 116,66,"HOW TO PLAY"
  434.    Set Text 4
  435.    Ink 4 : Text 72,78,"To Select LINE" : Ink 5 : Text 86,86,"Click boxes at left"
  436.    Ink 4 : Text 72,98,"To Select HOLD" : Ink 5 : Text 86,106,"Click boxes below"
  437.    Ink 4 : Text 72,118,"To View Odds Screen" : Ink 5 : Text 86,126,"click AMOS GOLD"
  438.    Ink 4 : Text 72,138,"To Spin the reels" : Ink 5 : Text 86,146,"click Handle"
  439.    Set Text 1
  440.    Ink 26 : Text 110,160,"PRESS ANY KEY"
  441.    Set Text 0
  442.    While HOW$=""
  443.       HOW$=Inkey$
  444.       MZ=Mouse Zone
  445.       MC=Mouse Key
  446.       If MZ=9 and MC=1
  447.          Proc HANDLE
  448.       End If 
  449.       If MZ=10 and MC=1
  450.          Proc CHART
  451.       End If 
  452.       If MZ>0 and MZ<4 and MC=1
  453.          Proc LINES
  454.          Wait 20
  455.       End If 
  456.       If MZ>3 and MZ<9 and MC=1
  457.          Proc HOLD
  458.          Wait 20
  459.       End If 
  460.    Wend 
  461.    For K=1 To 5
  462.       HELD(K)=0
  463.    Next K
  464.    For K=1 To 15
  465.       HOLDBOB(K)=0
  466.    Next K
  467.    Def Scroll 11,72,58 To 249,110,-2,-3
  468.    Def Scroll 12,71,109 To 249,164,2,3
  469.    For K=1 To 20
  470.       Scroll 11 : Scroll 12
  471.    Next K
  472. End Proc
  473. Procedure REELSET
  474.    REEL$(1)="(6,4)(2,4)(5,4)(1,4)(2,4)(7,4)(8,4)(7,4)(5,4)(3,4)(8,4)(4,4)(7,4)(1,4)(3,4)(6,4)(5,4)(8,4)(2,4)(4,4)"
  475.    REEL$(2)="(4,4)"+Left$(REEL$(1),95)
  476.    REEL$(3)="(2,4)"+Left$(REEL$(2),95)
  477.    '
  478.    REEL$(4)="(8,4)(6,4)(3,4)(5,4)(2,4)(1,4)(7,4)(2,4)(8,4)(5,4)(6,4)(8,4)(4,4)(1,4)(5,4)(6,4)(8,4)(5,4)(7,4)(2,4)"
  479.    REEL$(5)="(2,4)"+Left$(REEL$(4),95)
  480.    REEL$(6)="(7,4)"+Left$(REEL$(5),95)
  481.    '
  482.    REEL$(7)="(2,4)(8,4)(1,4)(6,4)(7,4)(3,4)(5,4)(4,4)(5,4)(2,4)(8,4)(7,4)(8,4)(2,4)(7,4)(6,4)(1,4)(5,4)(4,4)(5,4)"
  483.    REEL$(8)="(5,4)"+Left$(REEL$(7),95)
  484.    REEL$(9)="(4,4)"+Left$(REEL$(8),95)
  485.    '
  486.    REEL$(10)="(2,4)(7,4)(5,4)(8,4)(6,4)(5,4)(1,4)(4,4)(8,4)(6,4)(5,4)(8,4)(2,4)(7,4)(1,4)(2,4)(5,4)(3,4)(6,4)(8,4)"
  487.    REEL$(11)="(8,4)"+Left$(REEL$(10),95)
  488.    REEL$(12)="(6,4)"+Left$(REEL$(11),95)
  489.    '
  490.    REEL$(13)="(4,4)(2,4)(8,4)(5,4)(6,4)(3,4)(1,4)(7,4)(4,4)(8,4)(3,4)(5,4)(7,4)(8,4)(7,4)(2,4)(1,4)(5,4)(2,4)(6,4)"
  491.    REEL$(14)="(6,4)"+Left$(REEL$(13),95)
  492.    REEL$(15)="(2,4)"+Left$(REEL$(14),95)
  493. End Proc
  494. Procedure REELPOSITION
  495.    REELCYCLE=Len(REEL$(1))
  496.    For K=1 To 15
  497.       L$=Right$(REEL$(K),REELCYCLE-(REELSTOP(K)-5))
  498.       R$=Left$(REEL$(K),REELSTOP(K)-5)
  499.       REEL$(K)=L$+R$
  500.    Next K
  501. End Proc