home *** CD-ROM | disk | FTP | other *** search
/ Boot Disc 8 / boot-disc-1997-04.iso / PDA_Soft / Psion / games / Bangko / BANGKOK.OPL < prev    next >
Text File  |  1994-01-23  |  12KB  |  649 lines
  1. APP Bangkok
  2.     TYPE $1000
  3.     ICON "a:\opl\bangkok.pic"                  
  4. ENDA
  5. PROC T30:
  6.     global dieval%(7),scrval%(6),dx%,sx%,SprID%
  7.     global lwx%,rwx%,newdice%,chosen%,score%
  8.     global InBonus%,Bonus%,NrPl&,S3a%,IsDrawn%(8)
  9.     global pname$(5,5),scores%(5),GameLmt&,pl%,S3aPl%
  10.     global WaitSw%, WinX%(13),lWinID%(7),rWinID%(7)
  11.     global BIsDrwn%,Sound%,HandPos%
  12.     local key%,i%,hiscore%,hix%
  13.     
  14.     REM Main program loop
  15.  
  16.     if GSetup%:<>0
  17.         pl%=1
  18.         do
  19.             ShowPl:(pl%)
  20.             key%=Player%:
  21.             if key%<>27
  22.                 if InBonus%=0
  23.                     scores%(pl%)=scores%(pl%)+(30-score%)
  24.                 else
  25.                     i%=1
  26.                     while i%<=NrPl&
  27.                         if i%<>pl%
  28.                             scores%(i%)=scores%(i%)+score%
  29.                         endif
  30.                         i%=i%+1
  31.                     endwh            
  32.                 endif
  33.             endif
  34.             i%=1 :hiscore%=-1
  35.             while i%<=NrPl&
  36.                 if scores%(i%)>hiscore%
  37.                     hiscore%=scores%(i%)
  38.                     hix%=i%
  39.                 endif
  40.                 i%=i%+1
  41.             endwh
  42.             pl%=pl%+1
  43.             if pl%>NrPl&
  44.                 pl%=1
  45.             endif
  46.         until key%=27 or hiscore%>=gameLmt&
  47.     endif
  48.     if hiscore%>0
  49.         ShowPl:(hix%)
  50.         if Sound%=1
  51.             playwve:("*Woody")
  52.         endif
  53.         dINIT "Game Over"
  54.         dTEXT "",PName$(hix%)+" pays for the beer"
  55.         dBUTTONS "OK",13
  56.         DIALOG
  57.     endif
  58. ENDP
  59.  
  60. REM Display current player
  61.  
  62. PROC ShowPl:(pl%)
  63.     local i%
  64.     i%=1
  65.     while i%<=NrPl&
  66.         gstyle 2
  67.         gtmode 3
  68.         gat 5+(i%-1)*50,50 :gprint "                "
  69.         if i%=pl%
  70.             gstyle 1+2+32
  71.         endif
  72.         gfont 6
  73.         gat 5+(i%-1)*50,50 :gprint PName$(i%)
  74.         gstyle 0
  75.         gat 5+(i%-1)*50,65 :gprint num$(scores%(i%),-5)
  76.         gfont $9a
  77.         i%=i%+1
  78.     endwh
  79. ENDP
  80.  
  81. REM Global setup (only at start of program)
  82.  
  83. PROC GSetup%:
  84.     local i%, s$(50)
  85.     
  86.     defaultwin 1
  87.     gborder 1
  88.     gat 1,1 
  89.     ggrey 1
  90.     gpatt -1,gwidth,gheight,0
  91.     ggrey 0
  92.     gat 1,30
  93.     gfont 8
  94.     gstyle 1+8
  95.     gprint "Tina's Tumblers"
  96. rem    gprint "Bangkok"
  97.     gstyle 1
  98.     gfont $9a
  99.     gat gwidth-98,0 :gbox 97,gheight
  100.     ggmode 0
  101.     gat gwidth-98,gheight-20 :glineto gwidth,gheight-20
  102.     gat gwidth-97,gheight-19
  103.     gfill 95,18,0
  104.     i%=1
  105.     while i%<=5
  106.         scores%(i%)=0
  107.         i%=i%+1
  108.     endwh
  109.     S3a%=1
  110.     NrPl&=2
  111.     GameLmt&=51
  112.     WaitSw%=-1
  113.     dINIT "Define Players"
  114.     dLONG NrPl&, "No. Players", 1, 5 
  115.     dCHOICE S3a%, "S3a?", "Yes,No"
  116.     dCHOICE Sound%, "Sound?", "Yes,No"
  117.     dLONG GameLmt&,"End Game:", 10,100
  118.     dBUTTONS "Abort",-27,"OK",13
  119.     i%=DIALOG
  120.     IF i% <= 0
  121.         return 0
  122.     endif
  123.     if S3a%=1
  124.         PName$(NrPL&)="S3a"
  125.         S3aPl%=NrPl&
  126.     else
  127.         S3aPl%=0
  128.     endif
  129.     PName$(1)="Ralph"
  130.     dINIT "Name Players"
  131.     i%=1
  132.     while i%<=NrPl&
  133.         if S3a%=1 and i%=NrPl&
  134.             dTEXT "Player"+num$(i%,1)+":",PName$(i%)
  135.         else
  136.             dEDIT PName$(i%),"Player"+num$(i%,1)+":"
  137.         endif    
  138.         i%=i%+1
  139.     endwh
  140.     dBUTTONS "Abort",-27,"OK",13
  141.     i%=DIALOG
  142.     IF i% <= 0
  143.         return 0
  144.     endif
  145.     gfont 1
  146.     gat 180,20 :gprint "(Game ends"
  147.     gat 180,30 :gprint "at "+num$(GameLmt&,2)+" points)"
  148.     s$="╕ RNSoft"
  149.     gstyle 0
  150.     i%=(gwidth-100)-gtwidth(s$)
  151.     gat i%, gheight-15 :gprint s$
  152.     s$="Ralph Nolte"
  153.     i%=(gwidth-100)-gtwidth(s$)
  154.     gat i%, gheight-5 :gprint s$
  155.     gfont $9a
  156.     gstyle 2
  157.     i%=1
  158.     while i%<=NrPl&
  159.         gat 5+(i%-1)*50,50 :gprint PName$(i%)
  160.         i%=i%+1
  161.     endwh
  162.     return -1
  163. ENDP
  164.  
  165. REM Process current player (rolls+bonus)
  166.  
  167. PROC Player%:    
  168.     local key%
  169.  
  170.     Setup:
  171.     key%=Process%:
  172.     Cleanup:
  173.     UnDraw:(-1)
  174.     return key%
  175. ENDP
  176.  
  177. REM Setup per Player
  178.  
  179. PROC Setup:
  180.     dx%=6 :sx%=0 :lwx%=0 :rwx%=0 :chosen%=0 :InBonus%=0
  181.     HandPos%=1
  182.     randomize minute*60+second
  183.     return -1
  184. ENDP
  185.  
  186. PROC Cleanup:
  187. ENDP
  188.  
  189. REM Display score/bonus in lower right corner
  190.  
  191. PROC DiScore:(s%)
  192.     local s$(3)
  193.     gat gwidth-97,gheight-19
  194.     gfill 95,18,0
  195.     gtmode 1
  196.     s$=num$(s%,3)
  197.     gfont 6
  198.     gat gwidth-49-(gtwidth(s$)/2),gheight-10+5
  199.     gprint s$
  200.     gtmode 3
  201.     gfont $9a
  202. ENDP
  203.  
  204. REM Guts of player processing
  205.  
  206. PROC Process%:
  207.     local i%,key%,s$(255), prvkey%,x%,t$(8),u$(5),r$(1)
  208.     
  209.     key%=0
  210.     newdice%=-1
  211.     while key<>0        REM flush keyboard buffer
  212.     endwh
  213.     while key%<>27 and dx%>0
  214.         DrawDice:
  215.         newdice%=0
  216.         key%=Choose%:
  217.         UnDraw:(0)
  218.         if key%=27 or key = 27
  219.             key%=CkAbort%:
  220.         endif
  221.     endwh
  222.     if key%=27 or key = 27
  223.         key%=CkAbort%:
  224.     endif
  225.     if key%=27
  226.         return key%
  227.     endif
  228.     DrawDice:
  229.     s$=" Score: "+num$(score%,2)+" .. "
  230.     if S3a%=1 and pl%=S3aPl%
  231.         u$="I"
  232.         r$=""
  233.     else
  234.         u$=PName$(pl%)
  235.         r$="s"
  236.     endif
  237.     if score% > 30
  238.         giprint s$+u$+" get"+r$+" bonus with '"+num$(score%-30,2)+"'... ",1
  239.     elseif score%=30
  240.         giprint s$+"No change",1
  241.     else
  242.         if score%=29
  243.             t$=" point "
  244.         else
  245.             t$=" points "
  246.         endif
  247.         giprint s$+u$+" receive"+r$+" "+num$(30-score%,2)+t$,1
  248.     endif
  249.     pause -40
  250.     if key%<>27 and score% > 30
  251.         Bonus% = score%-30
  252.       gtmode 3
  253.       gfont 5 
  254.       s$="BONUS ("+num$(Bonus%,1)+") for "+PName$(pl%)
  255.       gat 180,10
  256.       gstyle 1
  257.       gprint s$
  258.       gfont $9a
  259.       gstyle 0
  260.         UnDraw:(-1)
  261.         score%=Bonus%
  262.         InBonus%=-1 
  263.         key%=0
  264.         newdice%=-1
  265.         dx%=6
  266.         sx%=0
  267.         while key%<>27 and dx%>0 and key%<>-2
  268.             DrawDice:
  269.             if WaitSw%=0
  270.                 giprint "Press any key",1
  271.                 get
  272.             else
  273.                 pause WaitSw%
  274.             endif
  275.             key%=Choose%:
  276.             if key%=-1
  277.                 if newdice%=-1
  278.                     if SprID%<>0
  279.                         closesprite SprID%
  280.                         SprID%=0
  281.                     endif
  282.                     giprint " Total Bonus: "+num$(score%,2)+" ", 1
  283.                     pause -50
  284.                     UnDraw:(0)
  285.                     key%=-2
  286.                 else
  287.                     UnDraw:(0)
  288.                 endif
  289.                 newdice%=-1
  290.             else
  291.                 UnDraw:(0)
  292.                 newdice%=0
  293.             endif
  294.             if key = 27 or key%=27
  295.                 key%=CkAbort%:
  296.             endif
  297.         endwh
  298.         if dx%=0
  299.             DrawDice:
  300.             giprint " Total Bonus: "+num$(score%,2)+" ", 1
  301.             pause -50
  302.         endif
  303.       gtmode 1
  304.         gstyle 1
  305.       gfont 5
  306.       s$="BONUS ("+num$(Bonus%,1)+") for "+PName$(pl%)
  307.       gat 180,10
  308.       gprint s$
  309.       gfont $9a
  310.         gtmode 3
  311.       gstyle 0
  312.     endif
  313.     return key%
  314. ENDP
  315.  
  316. REM Undraw dice (at left or all)
  317.  
  318. PROC UnDraw:(isall%)
  319.     local i%
  320.     while lwx%>0
  321.         gclose(lWinID%(lwx%))
  322.         lwx%=lwx%-1
  323.     endwh
  324.     if isall%<>0
  325.         while rwx%>0
  326.             gclose(rWinID%(rwx%))
  327.             IsDrawn%(rwx%)=0
  328.             rwx%=rwx%-1
  329.         endwh
  330.         BisDrwn%=0
  331.     endif
  332. ENDP
  333.  
  334. REM get die choice from player or S3a
  335.  
  336. PROC Choose%:
  337.     local i%,key%,j%,ii%,tmp%, BonusX%
  338.  
  339.     if HandPos%=0
  340.         HandPos%=1
  341.     elseif HandPos%>dx%
  342.         HandPos%=dx%
  343.     endif
  344.     if InBonus%<>0
  345.         i%=1
  346.         while i%<=dx%
  347.             if dieval%(i%)=Bonus%
  348.                 break
  349.             endif
  350.             i%=i%+1
  351.         endwh
  352.         if i% > dx%
  353.             return -1
  354.         endif
  355.         DrawHand:(i%)
  356.         pause -20
  357.         closesprite(SprID%)
  358.         SprID%=0
  359.         sx%=sx%+1                                        REM move to
  360.         scrval%(sx%)=dieval%(i%)        REM   score area
  361.         j%=i%                                                REM squeeze out
  362.         while j%<dx%                                REM   of die area
  363.             dieval%(j%)=dieval%(j%+1)
  364.             j%=j%+1
  365.         endwh
  366.         dx%=dx%-1                                        REM now 1 less die
  367.         chosen%=chosen%+1
  368.         HandPos%=i%
  369.         return i%
  370.     else
  371.         i%=HandPos%
  372.         DrawHand:(i%)
  373.     endif
  374.     if pl%=S3aPl%
  375.         i%=PlayS3a%:
  376.         if i%>0
  377.             MoveHand:(i%)
  378.             key%=13                REM pick die per i%
  379.         else
  380.             key%=32                REM reroll
  381.         endif
  382.     else
  383.         key%=get
  384.     endif
  385.     if key = 27 or key% = 27
  386.         key%=CkAbort%:
  387.     endif
  388.     while key%<>27                REM wait for esc
  389.         if key%=258                    REM right arrow
  390.             i%=i%+1                        REM increment
  391.             if i%>dx%
  392.                 i%=1
  393.             endif
  394.         elseif key%=259            REM left arrow
  395.           i%=i%-1                        REM decrement
  396.           if i%=0
  397.               i%=dx%
  398.           endif
  399.         elseif key%=32            REM space
  400.             if chosen%=0
  401.                 giprint " Choose at least 1 die with <- -> and 'Enter'! ",3
  402.             else
  403.                 tmp%=newdice%
  404.                 newdice%=-1
  405.                 UnDraw:(0)
  406.                 HandPos%=1
  407.                 i%=1
  408.                 DrawDice:
  409.                 newdice%=tmp%
  410.                 chosen%=0                REM force choice
  411.             endif
  412.         elseif key%=13                                REM die chosen
  413.             sx%=sx%+1                                        REM move to
  414.             scrval%(sx%)=dieval%(i%)        REM   score area
  415.             j%=i%                                                REM squeeze out
  416.             while j%<dx%                                REM   of die area
  417.                 dieval%(j%)=dieval%(j%+1)
  418.                 j%=j%+1
  419.             endwh
  420.             if pl%=S3aPl%
  421.                 pause -20
  422.             endif
  423.             dx%=dx%-1                                        REM now 1 less die
  424.             if SprID%<>0
  425.                 closesprite SprID%
  426.                 SprID%=0
  427.             endif
  428.             chosen%=chosen%+1
  429.             HandPos%=i%
  430.             return key%
  431.         endif
  432.         MoveHand:(i%)
  433.         if pl%=S3aPl%
  434.             i%=PlayS3a%:
  435.             if i%>0
  436.                 MoveHand:(i%)
  437.                 key%=13                REM pick die per i%
  438.             else
  439.                 key%=32                REM reroll
  440.             endif
  441.         else
  442.             key%=get
  443.         endif
  444.         if key = 27 or key% = 27
  445.             key%=CkAbort%:
  446.         endif
  447.     endwh
  448.     if SprID%<>0
  449.         closesprite SprID%
  450.         SprID%=0
  451.     endif
  452.     HandPos%=i%
  453.     return key%
  454. ENDP
  455.  
  456. REM make choice for S3a
  457.  
  458. PROC PlayS3a%:
  459.     local i%,max%,maxx%
  460.     i%=1 :max%=0
  461.     while i%<=dx%
  462.         if dieval%(i%)>max%
  463.             max%=dieval%(i%)
  464.             maxx%=i%
  465.         endif
  466.         i%=i%+1
  467.     endwh
  468.     if max%=6 or chosen%=0 or (max%=5 and dx%<3)
  469.         return maxx%
  470.     endif
  471.     return -1            REM cause reroll
  472. ENDP
  473.  
  474. REM Draw hand if not on screen
  475.  
  476. PROC DrawHand:(AtDie%)
  477.     local bit$(6,255)
  478.  
  479.     if SprID%<>0
  480.         MoveHand:(AtDie%)
  481.         return
  482.     endif
  483.     SprID%=CREATESPRITE
  484.     bit$(1)="" :bit$(2)="" :bit$(3)="Bangkok.pic"
  485.     bit$(4)="" :bit$(5)="" :bit$(6)=""
  486.     appendsprite 5,bit$(),0,0
  487.     bit$(1)="" :bit$(2)="" :bit$(3)=""
  488.     bit$(4)="" :bit$(5)="" :bit$(6)=""
  489.     appendsprite 5,bit$(),0,0
  490.     drawsprite 10+(AtDie%-1)*50,70
  491. ENDP
  492.  
  493. REM Move hand if already on screen
  494.  
  495. PROC MoveHand:(AtDie%)
  496.     if SprID%=0
  497.         DrawHand:(AtDie%)
  498.     endif
  499.     possprite 10+(AtDie%-1)*50,70
  500. ENDP
  501.  
  502. REM Get arithm. remainder of a division
  503.  
  504. PROC mod%:(v1%, v2%)
  505.     return v1% - v1% / v2% * v2%
  506. ENDP
  507.  
  508. REM Draw dice on screen
  509.  
  510. PROC DrawDice:
  511.     local i%,x%,y%,tmp%
  512.     
  513.     if newdice%<>0
  514.         if SprID%<>0
  515.             closesprite SprID%
  516.             SprID%=0
  517.         endif
  518.         giprint "Rolling dice...",0
  519.         if Sound%<>1
  520.             pause -20
  521.         else            
  522.             if dx%=1
  523.                 playwve:("*die")
  524.             else
  525.                 playwve:("*dice")
  526.             endif
  527.         endif
  528.         if SprID%=0
  529.             DrawHand:(HandPos%)
  530.         endif
  531.     endif
  532.     if InBonus%<>0 and BIsDrwn%=0
  533.         BIsDrwn%=-1
  534.         i%=newdice%
  535.         newdice%=0
  536.         drawdie%:(Bonus%, 335, 5)
  537.         newdice%=i%
  538.     endif
  539.     i%=1                            REM Draw active dice lower left
  540.     while i% <= dx%
  541.         dieval%(i%)=drawdie%:(dieval%(i%),10+(i%-1)*50,115)
  542.         i%=i%+1
  543.     endwh
  544.     if InBonus%=0
  545.         score%=0
  546.     else
  547.         score%=Bonus%
  548.     endif
  549.     i%=1                            REM Draw scoring dice right
  550.     while i% <= sx%
  551.         if IsDrawn%(i%)=0
  552.             IsDrawn%(i%)=-1
  553.             x%=gwidth-(1+mod%:(i%,2))*45
  554.             y%=(((i%+1)/2)-1)*45+5
  555.             tmp%=newdice%        REM Override generation
  556.             newdice%=0            REM of new dice in score area
  557.             drawdie%:(scrval%(i%),x%,y%)
  558.             newdice%=tmp%
  559.         endif
  560.         score%=score%+scrval%(i%)
  561.         i%=i%+1
  562.     endwh
  563.     DiScore:(score%)
  564. ENDP
  565.  
  566. REM Draw a single die 
  567.  
  568. PROC drawdie%:(i%,x%, y%)
  569.     local id%, die%
  570.  
  571.     id%=gcreate(x%,y%,40,40,1)
  572.     guse 1
  573.     gtmode 3
  574.     gat gwidth/2, 20
  575.     if x% < gwidth-100 and y% > gheight / 2
  576.         guse id%        
  577.         lwx%=lwx%+1
  578.         lWinID%(lwx%)=id%
  579.     else
  580.         guse id%
  581.         rwx%=rwx%+1
  582.         rWinID%(rwx%)=id%
  583.     endif
  584.     gborder 3
  585.     if newdice%<>0
  586.         die%=1+int(rnd*6)
  587.     else
  588.         die%=i%
  589.     endif
  590.     if die%=1
  591.         gat 17,17 :gfill 3,3,0
  592.     elseif die%=2
  593.         gat 7,7 :gfill 3,3,0
  594.         gat 28,28 :gfill 3,3,0
  595.     elseif die%=3
  596.         gat 17,17 :gfill 3,3,0
  597.         gat 7,7 :gfill 3,3,0
  598.         gat 28,28 :gfill 3,3,0
  599.     elseif die%=4
  600.         gat 7,7 :gfill 3,3,0
  601.         gat 7,28 :gfill 3,3,0
  602.         gat 28,7 :gfill 3,3,0
  603.         gat 28,28 :gfill 3,3,0
  604.     elseif die%=5
  605.         gat 7,7 :gfill 3,3,0
  606.         gat 7,28 :gfill 3,3,0
  607.         gat 28,7 :gfill 3,3,0
  608.         gat 28,28 :gfill 3,3,0
  609.         gat 17,17 :gfill 3,3,0
  610.     elseif die%=6
  611.         gat 7,7 :gfill 3,3,0
  612.         gat 7,28 :gfill 3,3,0
  613.         gat 28,7 :gfill 3,3,0
  614.         gat 28,28 :gfill 3,3,0
  615.         gat 7,17 :gfill 3,3,0
  616.         gat 28,17 :gfill 3,3,0
  617.     endif
  618.     guse 1
  619.     return die%
  620. ENDP
  621. PROC playwve:(wfn$)
  622.     local name$(128),p%,ret%
  623.     p%=peekw($1c)+6
  624.     name$=wfn$+chr$(0)
  625.     ret%=call($1f86,uadd(addr(name$),1),0,0)
  626.     if peekw(p%) and 1
  627.         return ret% or $ff00
  628.     endif
  629. ENDP
  630. PROC Ckabort%:
  631.     local i%
  632.     dINIT "Abort Game"
  633.     dTEXT "", "Terminate Game?",2
  634.     dBUTTONS "NO!!",-27,"Yes",13,"Sound",-83
  635.     i%=DIALOG
  636.     if i% > 0
  637.         if i%=13
  638.             stop
  639.         elseif i%=83 or i%=115
  640.             if Sound%=1
  641.                 Sound%=2
  642.             else
  643.                 Sound%=1
  644.             endif
  645.         endif    
  646.     endif
  647.     return 0
  648. ENDP
  649.