home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 1B / DATAFILE_PDCD1B.iso / _pocketbk / pocketbook / opl / puzzle_opl < prev   
Text File  |  1994-10-13  |  4KB  |  230 lines
  1. REM puzzle.opl -
  2. REM Copyright 1992 Stephen J Lacey
  3. REM sj@doc.ic.ac.uk
  4. REM
  5. REM All standard disclaimers apply
  6. REM I am not responsible for what this
  7. REM program does to your machine or
  8. REM sanity!
  9. REM
  10. REM History:
  11. REM changed itos$ to num$
  12. REM RTFM steve :)
  13. REM suggested by steve@maths.warwick.ac.uk
  14. REM
  15. REM This program is "BEERWARE" -
  16. REM If you like this program, please
  17. REM buy the author few pints or send him
  18. REM the equivelent in beer tokens :-)
  19. REM
  20. REM Use the arrow keys or 1->4, q->r,
  21. REM etc... to reference tiles.
  22.  
  23. PROC puzzle:
  24.     local inf%(32), i%, x%, y%, keyp%
  25.     local tmp%, k$(1), k2$(1), k%
  26.     local a$(5), h$(10)
  27.     global fx%, fy%, free%, moves%
  28.     global chrw%, tilewin%, tile%(16)
  29.     global yad%, solved%, bwin%, th%
  30.     h$ = "xr"
  31.     th% = inf%(3)
  32.     while (i% < 16)
  33.         i% = i%+1
  34.         tile%(i%) = i%
  35.     endwh
  36.     gInfo inf%()
  37.     chrw% = (inf%(7)*2) + 6
  38.     yad% = inf%(3)+4
  39.     fx% = 3
  40.     fy% = 3
  41.     free% = 16
  42.     stat:
  43.     movep:
  44.     drawt:
  45.     mix:
  46.     do
  47.         k% = get
  48.         if k%=$122 Rem Menu Key
  49.             setmenu:
  50.             k%=menu
  51.             if k% and intf(loc(h$,chr$(k%)))
  52.                 a$="menu"+chr$(k%)
  53.                 @(a$): Rem Call appropriate routine
  54.             endif
  55.         elseif k% and $200 REM hotkey
  56.             k%=(k%-$200) and $ffdf
  57.             k%=loc(h$,chr$(k%))
  58.             if k%
  59.                 a$="menu"+mid$(h$,k%,1)
  60.                 @(a$):
  61.             endif
  62.         endif
  63.         k2$ = chr$(k%)
  64.         keyp% = loc("1234qwerasdfzxcv", k2$)
  65.         if keyp% or ((k%>255) and (k%<260))
  66.             if keyp% : rem alpha move
  67.                 tmp% = keyp%-1
  68.                 y% = tmp%/4 : x% = tmp% and 3
  69.             else : rem arrow key move
  70.                 x% = fx% : y% = fy%
  71.                 if k% = 256 : y% = fy%+1
  72.                 elseif k% = 257 : y% = fy%-1
  73.                 elseif k% = 258 : x% = fx%-1
  74.                 else : x% = fx%+1
  75.                 endif
  76.                 if (x% < 0) or (y% < 0) or (x% > 3) or (y% > 3) : continue : endif
  77.                 keyp% = (y%*4)+x%+1
  78.             endif
  79.             if ((x% = fx%) and (abs(y%-fy%) = 1)) or ((y% = fy%) and (abs(x%-fx%) = 1))
  80.                 tile%(free%) = tile%(keyp%)
  81.                 tile%(keyp%) = 16
  82.                 printt:(keyp%)
  83.                 printt:(free%)
  84.                 fx% = x%
  85.                 fy% = y%
  86.                 free% = keyp%
  87.                 moves% = moves%+1
  88.                 movep:
  89.             endif
  90.         endif
  91.     until solved:
  92. ENDP
  93.  
  94. PROC mix:
  95.     local i%, to%
  96.     local px%, py%, ppx%, ppy%
  97.     busy "Mixing tiles...", 3
  98.     randomize month*minute*day
  99.     while (i% < 50)
  100.         if (int(rnd*2) = 1)
  101.             if (fx% = 0) : fx% = 1
  102.             elseif (fx% = 3) : fx% = 2
  103.             else
  104.                 if (int(rnd*2) = 0) : fx% = fx%-1
  105.                 else : fx% = fx%+1
  106.                 endif
  107.             endif
  108.         else
  109.             if (fy% = 0) : fy% = 1
  110.             elseif (fy% = 3) : fy% = 2
  111.             else
  112.                 if (int(rnd*2) = 0) : fy% = fy%-1
  113.                 else : fy% = fy%+1
  114.                 endif
  115.             endif
  116.         endif
  117.         if (ppx% = fx%) and (ppy% = fy%)
  118.             fx% = px%
  119.             fy% = py%
  120.             continue
  121.         endif
  122.         ppx% = px% : ppy% = py%
  123.         px% = fx% : py% = fy%
  124.         to% = (fy%*4)+fx%+1
  125.         tile%(free%) = tile%(to%)
  126.         tile%(to%) = 16
  127.         printt:(free%)
  128.         printt:(to%)
  129.         free% = to%
  130.         i% = i%+1
  131.     endwh
  132.     busy off
  133. ENDP
  134.  
  135. PROC movep:
  136.     At 18, 8
  137.     Print "Moves : ", moves%, "         "
  138. ENDP
  139.  
  140. PROC stat:
  141.     local w%, s%
  142.     s% = (chrw%*4)+20
  143.     gUse 1
  144.     gStyle 9
  145.     w% = GTwidth("Puzzle!")
  146.     gAT s%, 30 : gPrint "Puzzle!"
  147.     gStyle 0
  148.     gAt s%+w%+4, 30 : gPrint "by Steevie"
  149.     gAt s%, 40 : gPrint "<sjl@doc.ic.ac.uk>"
  150. ENDP
  151.  
  152. PROC solved:
  153.     local i%, c%
  154.     while (i% < 16)
  155.         i% = i%+1
  156.         if (tile%(i%) <> i%)
  157.             return 0
  158.         endif
  159.     endwh
  160.     c%=1
  161.     dInit "You've solved the puzzle!"
  162.     dChoice c%, "Try again?", "Yes,No"
  163.     if dialog and (c%=1)
  164.         mix:
  165.         moves% = 0
  166.         movep:
  167.         return 0
  168.     else 
  169.         return 1
  170.     endif
  171. ENDP
  172.  
  173. PROC drawt:
  174.     local s%, i%
  175.     s% = chrw%*4
  176.     bwin% = gCreate(0, 0, s%+8, s%+8, 1)
  177.     gBorder $201
  178.     tilewin% = gCreate(4, 4, s%, s%, 1)
  179.     gUse tilewin%
  180.     gUpdate off
  181.     while (i% < 15)
  182.         i% = i%+1
  183.         printt:(i%)
  184.     endwh
  185.     gUpdate on
  186. ENDP
  187.  
  188. PROC printt:(i%)
  189.     local j%, y%, x%, s$(2), s%
  190.     s%=chrw%*4
  191.     y% = ((i%-1)/4) * chrw% : x% = ((i%-1) and 3) * chrw%
  192.     if (tile%(i%) = 16)
  193.         gAt x%, y% : gFill chrw%, chrw%, 1
  194.         return
  195.     endif
  196.     j% = i%
  197.     s$ = num$(tile%(i%), 2)
  198.     gAt x%, y% : gBox chrw%, chrw%
  199.     gAt x% + ((chrw% - gTwidth(s$))/2), y% + yad%
  200.     gPrint s$
  201. ENDP
  202.  
  203. PROC setmenu:
  204.     mInit 
  205.     mCard "Options","Restart",%R,"Exit",%X
  206. ENDP
  207.  
  208. PROC menux:
  209.     local c%
  210.     c%=1
  211.     dInit "Really exit?"
  212.     dChoice c%, "Well??", "Yes,No"
  213.     if dialog and (c%=1)
  214.         stop
  215.     endif
  216. ENDP
  217.  
  218. PROC menur:
  219.     local c%
  220.     c%=1
  221.     dInit "Are you sure?"
  222.     dChoice c%, "Well??", "Yes,No"
  223.     if dialog and (c%=1)
  224.         mix:
  225.         moves% = 0
  226.         movep:
  227.     endif
  228. ENDP
  229.  
  230.