REM puzzle.opl - REM Copyright 1992 Stephen J Lacey REM sj@doc.ic.ac.uk REM REM All standard disclaimers apply REM I am not responsible for what this REM program does to your machine or REM sanity! REM REM History: REM changed itos$ to num$ REM RTFM steve :) REM suggested by steve@maths.warwick.ac.uk REM REM This program is "BEERWARE" - REM If you like this program, please REM buy the author few pints or send him REM the equivelent in beer tokens :-) REM REM Use the arrow keys or 1->4, q->r, REM etc... to reference tiles. PROC puzzle: local inf%(32), i%, x%, y%, keyp% local tmp%, k$(1), k2$(1), k% local a$(5), h$(10) global fx%, fy%, free%, moves% global chrw%, tilewin%, tile%(16) global yad%, solved%, bwin%, th% h$ = "xr" th% = inf%(3) while (i% < 16) i% = i%+1 tile%(i%) = i% endwh gInfo inf%() chrw% = (inf%(7)*2) + 6 yad% = inf%(3)+4 fx% = 3 fy% = 3 free% = 16 stat: movep: drawt: mix: do k% = get if k%=$122 Rem Menu Key setmenu: k%=menu if k% and intf(loc(h$,chr$(k%))) a$="menu"+chr$(k%) @(a$): Rem Call appropriate routine endif elseif k% and $200 REM hotkey k%=(k%-$200) and $ffdf k%=loc(h$,chr$(k%)) if k% a$="menu"+mid$(h$,k%,1) @(a$): endif endif k2$ = chr$(k%) keyp% = loc("1234qwerasdfzxcv", k2$) if keyp% or ((k%>255) and (k%<260)) if keyp% : rem alpha move tmp% = keyp%-1 y% = tmp%/4 : x% = tmp% and 3 else : rem arrow key move x% = fx% : y% = fy% if k% = 256 : y% = fy%+1 elseif k% = 257 : y% = fy%-1 elseif k% = 258 : x% = fx%-1 else : x% = fx%+1 endif if (x% < 0) or (y% < 0) or (x% > 3) or (y% > 3) : continue : endif keyp% = (y%*4)+x%+1 endif if ((x% = fx%) and (abs(y%-fy%) = 1)) or ((y% = fy%) and (abs(x%-fx%) = 1)) tile%(free%) = tile%(keyp%) tile%(keyp%) = 16 printt:(keyp%) printt:(free%) fx% = x% fy% = y% free% = keyp% moves% = moves%+1 movep: endif endif until solved: ENDP PROC mix: local i%, to% local px%, py%, ppx%, ppy% busy "Mixing tiles...", 3 randomize month*minute*day while (i% < 50) if (int(rnd*2) = 1) if (fx% = 0) : fx% = 1 elseif (fx% = 3) : fx% = 2 else if (int(rnd*2) = 0) : fx% = fx%-1 else : fx% = fx%+1 endif endif else if (fy% = 0) : fy% = 1 elseif (fy% = 3) : fy% = 2 else if (int(rnd*2) = 0) : fy% = fy%-1 else : fy% = fy%+1 endif endif endif if (ppx% = fx%) and (ppy% = fy%) fx% = px% fy% = py% continue endif ppx% = px% : ppy% = py% px% = fx% : py% = fy% to% = (fy%*4)+fx%+1 tile%(free%) = tile%(to%) tile%(to%) = 16 printt:(free%) printt:(to%) free% = to% i% = i%+1 endwh busy off ENDP PROC movep: At 18, 8 Print "Moves : ", moves%, " " ENDP PROC stat: local w%, s% s% = (chrw%*4)+20 gUse 1 gStyle 9 w% = GTwidth("Puzzle!") gAT s%, 30 : gPrint "Puzzle!" gStyle 0 gAt s%+w%+4, 30 : gPrint "by Steevie" gAt s%, 40 : gPrint "" ENDP PROC solved: local i%, c% while (i% < 16) i% = i%+1 if (tile%(i%) <> i%) return 0 endif endwh c%=1 dInit "You've solved the puzzle!" dChoice c%, "Try again?", "Yes,No" if dialog and (c%=1) mix: moves% = 0 movep: return 0 else return 1 endif ENDP PROC drawt: local s%, i% s% = chrw%*4 bwin% = gCreate(0, 0, s%+8, s%+8, 1) gBorder $201 tilewin% = gCreate(4, 4, s%, s%, 1) gUse tilewin% gUpdate off while (i% < 15) i% = i%+1 printt:(i%) endwh gUpdate on ENDP PROC printt:(i%) local j%, y%, x%, s$(2), s% s%=chrw%*4 y% = ((i%-1)/4) * chrw% : x% = ((i%-1) and 3) * chrw% if (tile%(i%) = 16) gAt x%, y% : gFill chrw%, chrw%, 1 return endif j% = i% s$ = num$(tile%(i%), 2) gAt x%, y% : gBox chrw%, chrw% gAt x% + ((chrw% - gTwidth(s$))/2), y% + yad% gPrint s$ ENDP PROC setmenu: mInit mCard "Options","Restart",%R,"Exit",%X ENDP PROC menux: local c% c%=1 dInit "Really exit?" dChoice c%, "Well??", "Yes,No" if dialog and (c%=1) stop endif ENDP PROC menur: local c% c%=1 dInit "Are you sure?" dChoice c%, "Well??", "Yes,No" if dialog and (c%=1) mix: moves% = 0 movep: endif ENDP