home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 3 / PDCD_3.iso / pocketbk / games / pegout / pegout.opl < prev    next >
Text File  |  1994-08-31  |  4KB  |  220 lines
  1. REM PegOut - The Game
  2. REM Liam Relihan, 1994
  3. REM relihanl@ul.ie
  4. REM Freeware
  5. REM Version 1.0
  6.  
  7. app PegOut
  8.     type 1
  9.     icon "\OPD\pegout.pic"
  10. enda
  11.  
  12. proc main:
  13.     GLOBAL map$(11,11),bitid%,winid%,ckey%,cx%,cy%,pcnt%
  14.     LOCAL pset%
  15.  
  16.     bitid%=gloadbit("\OPD\PEGS.PIC")
  17.     winid%=gcreate(0,0,239,79,1)
  18.     initg:
  19.  
  20.     do
  21.         ckey% = kget%:
  22.         cursr:(cx%,cy%,1)
  23.         if ckey% = 258
  24.             if pset%=1 and atm:(cx%+1,cy%)=42 and atm:(cx%+2,cy%)=32
  25.                 setm:(cx%,cy%,32) 
  26.                 setm:(cx%+1,cy%,32)
  27.                 setm:(cx%+2,cy%,42)
  28.                 cx%=cx%+2:
  29.                 pcnt%=pcnt%-1
  30.                 pset%=0
  31.             elseif pset%=0 and atm:(cx%+1,cy%) <> 45
  32.                 cx%=cx%+1
  33.             else
  34.                 beep 5,300
  35.                 if pset%=1 : invert:(cx%,cy%) : pset%=0 : endif
  36.             endif
  37.         elseif ckey% = 259
  38.             if pset%=1 and atm:(cx%-1,cy%)=42 and atm:(cx%-2,cy%)=32
  39.                 setm:(cx%,cy%,32)
  40.                 setm:(cx%-1,cy%,32)
  41.                 setm:(cx%-2,cy%,42)
  42.                 cx%=cx%-2
  43.                 pcnt%=pcnt%-1
  44.                 pset%=0
  45.             elseif pset%=0 and atm:(cx%-1,cy%) <> 45
  46.                 cx%=cx%-1
  47.             else
  48.                 beep 5,300
  49.                 if pset%=1 : invert:(cx%,cy%) : pset%=0 : endif
  50.             endif
  51.         elseif ckey% = 256
  52.             if pset%=1 and atm:(cx%,cy%-1)=42 and atm:(cx%,cy%-2)=32
  53.                 setm:(cx%,cy%,32)
  54.                 setm:(cx%,cy%-1,32)
  55.                 setm:(cx%,cy%-2,42)
  56.                 cy%=cy%-2
  57.                 pcnt%=pcnt%-1
  58.                 pset%=0
  59.             elseif pset%=0 and atm:(cx%,cy%-1) <> 45
  60.                 cy%=cy%-1
  61.             else
  62.                 beep 5,300
  63.                 if pset%=1 : invert:(cx%,cy%) : pset%=0 : endif
  64.             endif
  65.         elseif ckey% = 257
  66.             if pset%=1 and atm:(cx%,cy%+1)=42 and atm:(cx%,cy%+2)=32
  67.                 setm:(cx%,cy%,32)
  68.                 setm:(cx%,cy%+1,32)
  69.                 setm:(cx%,cy%+2,42)
  70.                 cy%=cy%+2
  71.                 pcnt%=pcnt%-1
  72.                 pset%=0
  73.             elseif pset%=0 and atm:(cx%,cy%+1) <> 45
  74.                 cy%=cy%+1
  75.             else
  76.                 beep 5,300
  77.                 if pset%=1 : invert:(cx%,cy%) : pset%=0 : endif
  78.             endif
  79.         elseif ckey%=13
  80.             if pset%=0 and atm:(cx%,cy%) <> 32
  81.                 invert:(cx%,cy%)
  82.                 pset%=1
  83.             elseif pset%=1
  84.                 invert:(cx%,cy%)
  85.                 pset%=0
  86.             else
  87.                 beep 5,300
  88.             endif    
  89.         endif
  90.         cursr:(cx%,cy%,0)
  91.         scr:
  92.     until 1 <> 1
  93. endp
  94.  
  95. proc scr:
  96.     gstyle 1
  97.     gat 150,15
  98.     gprintb "Remaining: "+gen$(pcnt%,3),80,2,3,3
  99.     gstyle 0
  100. endp
  101.  
  102. proc initg:
  103.     local i%,j%
  104.  
  105.     map$(1)= "---*****---"
  106.     map$(2)= "---*****---"
  107.     map$(3)= "---*****---"
  108.     map$(4)= "***********"
  109.     map$(5)= "***********"
  110.     map$(6)= "***** *****"
  111.     map$(7)= "***********"
  112.     map$(8)= "***********"
  113.     map$(9)= "---*****---"
  114.     map$(10)="---*****---"
  115.     map$(11)="---*****---"
  116.     cx%=6:cy%=6:pcnt%=84
  117.     gupdate off
  118.     gat 6,0 : gbox 79,79
  119.     j%=1
  120.     while j%<12
  121.         i%=1
  122.         while i%<12
  123.             printm:(i%,j%)
  124.             i%=i%+1
  125.         endwh
  126.         j%=j%+1
  127.     endwh
  128.     cursr:(cx%,cy%,0)
  129.     scr:
  130.     gstyle 8 
  131.     gat 145,35 :    gprint "PegOut"
  132.     gstyle 32
  133.     gat 155,50 : gprint "by" 
  134.     gat 130,65 : gprint "Liam Relihan" 
  135.     gstyle 16
  136.     gat 115,75 : gprint "<relihanl@ul.ie>"
  137.     gstyle 0
  138.     gupdate on
  139. endp
  140.  
  141. proc cursr:(i%,j%,mode%)
  142.     gat i%*7,(j%*7)-6
  143.     ggmode mode%
  144.     gbox 7,7
  145.     ggmode 0
  146. endp
  147.  
  148. proc invert:(i%,j%)
  149.     gat i%*7,(j%*7)-6
  150.     ginvert 7,7
  151. endp
  152.  
  153. proc atm:(i%,j%)
  154.     if i%<1 or i% > 11:return 45:endif
  155.     if j%<1 or j% > 11:return 45:endif
  156.     return peekb(addr(map$(j%))+i%)
  157. endp
  158.  
  159. proc setm:(i%,j%,val%)
  160.     pokeb addr(map$(j%))+i%,val%
  161.     printm:(i%,j%)
  162. endp
  163.  
  164. proc printm:(i%,j%)
  165.     local val%
  166.  
  167.     gat i%*7,(j%*7)-6
  168.     val%=peekb(addr(map$(j%))+i%)
  169.     if val%=32
  170.         gcopy bitid%,0,0,7,7,3
  171.     elseif val%=42
  172.         gcopy bitid%,7,0,7,7,3
  173.     endif    
  174. endp
  175.  
  176. proc kget%:
  177.     local k%,h$(9),a$(5)
  178.  
  179.     h$="NX"
  180.     while 1
  181.         k%=GET
  182.         if k%=$122
  183.             minit
  184.             mcard "Game","New",%N,"Exit",%X
  185.             k%=menu
  186.             if k% and intf(loc(h$,chr$(k%)))
  187.                 a$="proc"+chr$(k%)
  188.                 @(a$):
  189.             endif
  190.         elseif k% and $200
  191.             k%=(k%-$200) and $FFDF
  192.             k%=loc(h$,chr$(k%))
  193.             if k%
  194.                 a$="proc"+mid$(h$,k%,1)
  195.                 @(a$):
  196.             endif
  197.         else
  198.             return k%
  199.         endif
  200.     endwh
  201. endp
  202.  
  203. proc procn:
  204.     local c%
  205.  
  206.     dinit "Restart"
  207.     dchoice c%,"Are you sure?","Yes,No"
  208.     if dialog and (c%=1) : initg: : endif
  209. endp
  210.  
  211. proc procx:
  212.     local c%
  213.  
  214.     dinit "Exit"
  215.     dchoice c%,"Are you sure?","Yes,No"
  216.     if dialog and (c%=1) : stop : endif
  217. endp
  218.  
  219.  
  220.