D-Miner

1 rem $$chan=9
2 rem $$stak=30000
3 rem $$heap=2048
4 rem REMark $$asmb=win2_rxt_snd_sound_bin,0,10
5 rem $$asmb=win4_asm_tmr_TIMER_BIN,0,10
6 rem REMark $$asmb=win1_prg_game_mine_ptrmen_cde,0,82
7 rem $$asmb=win1_prg_game_mine_MINES_BIN,0,10
8 :
9 rem Prepare two versions:
10 rem 1) Mines_bin, Timer_bin
11 rem 2) The above + sound_bin, ptrmen_cde
12 :
13 rem D-Miner
14 :
15 rem Minesweeper Qlone
16 rem ©pjwitte 2oo4++
17 rem V 0.23  September 26th 2013
18 :
19 restore
20 :
21 rem     Constants
22 :
23 c0% = 0: c1% = 1: c2% = 2: c3% = 3: c4% = 4: c5% = 5
24 c6% = 6: c7% = 7: c8% = 8: c9% = 9: c10% = 10: cm1% = -1
25 nul$ = '': spc$ = ' ': esc% = 27: hsh$ = '#': bks$ = '\'
26 ok$ = 'Ok'
27 :
28 con$ = 'con_': scr$ = 'scr_'
29 on% = c1%: off% = c0%
30 :
31 sqsz% = 16:               rem square size
32 spr% = -2
33 minx% = c9%: miny% = c9%: rem min size
34 :
35 sp_litemavabg%  = 520: rem Loose item available background
36 sp_litemavafg%  = 521: rem Loose item available foreground
37 sp_litemselbg%  = 522: rem Loose item selected background
38 sp_litemselfg%  = 523: rem Loose item selected foreground
39 sp_litemunabg%  = 524: rem Loose item unavailable background
40 sp_litemunafg%  = 525: rem Loose item unavailable foreground
41 sp_appbg%       = 535: rem Application window background
42 sp_infwinbg%    = 527: rem Information window background
43 sp_infwinfg%    = 528: rem Information window foreground
44 sp_buthigh%     = 548: rem Button highlight
45 sp_butbd%       = 549: rem Button border
46 sp_butbg%       = 550: rem Button background
47 sp_butfg%       = 551: rem Button foreground
48 sp_errbg%       = 556: rem Error message background
49 sp_errfg%       = 557: rem Error message foreground
50 :
51 rem     Init global variables
52 :
53 dim prec%(16):  rem pointer record
54 dim tprec%(16): rem Temporary prec%
55 grdx% = c9%: grdy% = c9%: rem default initial size
56 mencon = 65536
57 tpause% = c0%:            rem Technical pause flag
58 :
59 dim game%(c2%, c5%)
60 for i% = c0% to c2%
61  for j% = c0% to c5%: read game%(i%, j%)
62 end for i%
63 rem  c   x  X   y   m   t
64 data 0, 10, 1, 10, -1, -1: rem games 1..3
65 data 1, 15, 1, 15, -1, -1: rem Current
66 data 0, 20, 1, 20, -1, -1
67 dim gameT$(c2%, c6%)
68 for i% = c0% to c2%: read gameT$(i%)
69 data 'Auto', 'Timer', 'None'
70 gameM$ = 'Auto'
71 :
72 dim colour$(c3%, c6%)
73 for i% = 0 to c3%: read colour$(i%)
74 data 'Red','Green','Orange','Blue'
75 :
76 li_move% = -1:  rem wmov button - internal
77 li_resz% = -2:  rem resize button
78 li_zzz%  = -3:  rem zleep
79 li_quit% = -4:  rem quit
80 li_new%  = -5:  rem new game
81 li_conf% = -6:  rem config menu
82 li_stat% = -7:  rem stats menu
83 li_game% = -8:  rem game menu
84 li_help% = -9:  rem help
85 li_info% =-10:  rem about
86 :
87 redraw = 0
88 lost = -1: playing = 0: won = 1: stopped = 2: paused = 3
89 game = stopped: laststate = game
90 tmi_use% = -4:  rem Timer loose items
91 tmi_aut% = -5:  rem Auto
92 tmi_cup% = -6:  rem Count up
93 tmi_cdn% = -7:  rem Countdown
94 tmi_lrc% = -14: rem Last record
95 tmi_dgs% = -8:  rem Digits start
96 tmi_dge% = -13: rem Digits end
97 tmw_dg1% = 11: tmw_dg3% = 13: rem Timer digit windows 1..3
98 wmcnt%   = c4%: rem Mine count window
99 wtime%   = c2%: rem Timer window
100 mapp%    = c1%: rem main application window
101 tvx%     = 4 + 16:  rem Escape termination vector
102 immediate% = 48: rem Immediate return
103 mvec%      = 11: rem Normal
104 menv% = c1% + c8%: rem For colour picker
105 nsvi% = c4%: nsvo% = 32 + c4%: rem Term for NumSel
106 nstio% = 30:    rem Key repeat delay for numsel
107 bomb%    = c9%:  rem Code for mine: 0 = blank, 1..8
108 events% = c1% + c2%: rem 1 => timed out, 2 => warning
109 tio% = cm1%:     rem Timeout
110 tmr_chg = 0:     rem Timer changed flag
111 changed = 0:     rem Overall changed flag
112 butsx% = 64: butsy% = 14: rem Button
113 butsprx% = 48: butch = 0
114 but_vi% = 33: but_vo% = 17: rem Return vectors for button
115 mwtv% = 32: _w% = 16:       rem MessWin stuff
116 hlpxs% = 480: hlpys% = 180: rem Help stuff
117 abtxs% = 186: abtys% = 60: abtcx% = 29 : rem About stuff
118 wrnxs% = 250: wrnys% = 60: rem Warn stuff
119 sx$ = '_ub': rem Sound file extension
120 hx$ = '_txt': rem Help file extension
121 mgDmnr$ = 'dmnr01':       rem ID for config file
122 mgDmsc$ = 'dmsc01':       rem ID for score files
123 :
124 rem     Misc global variables
125 sqr$ = Spra$(sp_square):        rem mawitem addr
126 rem xdim%, ydim%                dimn + 1
127 rem xsize%, ysize%, xpos%, ypos%
128 rem maxx%, maxy%                max grid size in squares
129 rem mcount%, mleft%             mines
130 rem ch, ch% & ci, ci%           channels
131 rem k, awn, m%                  item number, etc
132 rem status%(), mines%(), mines$()
133 rem dummy%, er%, st%            throwaway
134 rem tmr_use%, tmr_id...         timer
135 rem events%, eve%, ev%          timer events
136 rem bfpresent                   button frame
137 rem butbf, butch, butx%, buty%, butsx%, butsy%
138 rem but_t%, but_s%
139 :
140 rem     Initialise
141 :
142 rem Fail unless hicolor
143 hicol = 0
144 if ver$ = 'HBA' then
145  if ver$(c1%) >= '3.00' and disp_type > c8%: hicol = 1
146 end if
147 :
148 if hicol = 0: PrePreWarn 'This program only runs in high colour mode!'
149 if tstthg%("Menus") <> c0%: PrePreWarn 'This program NEEDS QMenu to run'
150 rem Establish home directory
151 homed$ = cfhome$: rem Default
152 if tstthg%("HOME") = c0% then
153  if len(home_dir$) > c4%: homed$ = home_dir$
154 end if
155 :
156 rem Test for button frame
157 x% = butsx%: y% = butsy%
158 er% = butuse%(x%, y%)
159 if er% <> c0% then
160  bfpresent = 0: rem No button frame
161 else
162  bfpresent = 1: butfree
163 end if
164 :
165 ssspresent = 0: TstSSS: rem Check for sound system
166 :
167 rem     Read Configuration or use defaults
168 :
169 hlpprg$   = homed$ & 'Help_obj'  : rem Configure by editing cfg file
170 msgprg$   = homed$ & 'Choice_obj':
171 colsq$    = homed$ & 'colsq24_spr'
172 rem Fixed locations:
173 snd$ = homed$ & 'snd_': rem Location of sound files
174 paln$ = 'dminer_thm'
175 palset = 0: rem No job palette yet set
176 fnmscore$ = homed$ & 'score_txt': rem temp
177 SetDefaults
178 ch = fopen(con$): ert ch: ch% = ch: rem Main window
179 colour_24
180 :
181 when err
182  Burp 'bomb': pause#ch; 50
183  if ernum = -2 then
184   rem Probably timer got killed
185   if tmr_id then
186    if not JobLives(tmr_id) then
187     if PreWarn('Timer job died', 'Quit', 'Repair', nul$) = 1 then
188      Bye
189     else
190      tmr_id = 0: TimerSet: TimerStart
191      retry erlin
192     end if
193    end if
194   end if
195  else
196   er = PreWarn('Fatal error ' & ernum, 'Quit', nul$, nul$)
197   Bye
198  end if
199 end when
200 :
201 er = CfgRead(homed$ & 'dminer_cfg')
202 if ftest(msgprg$) + ftest(hlpprg$) + ftest(colsq$) <> c0% then
203  PrePreWarn "Essential resources not found. See readme!"
204 end if
205 if er then
206  if er < 0 then
207   mtx$ = 'Cannot read configuration file\\'
208  else
209   mtx$ = 'Configuration file may be corrupt!\\'
210  end if
211  if PreWarn(mtx$ & Centre$(len(mtx$), "Use defaults?") & bks$ & bks$, ok$, 'Quit', nul$) = 2:  >>
    quit er
212  mtx$ = nul$
213  SetDefaults
214 end if
215 Palette palno
216 :
217 rem     Set the scene
218 :
219 randomise date
220 ct = fopen(con$): ert ct: rem Timer window
221 :
222 base = scr_base(#ch)
223 llen = scr_llen(#ch)
224 bpp% = (llen / scr_xlim(#ch))
225 :
226 SetCol#ct; col_ptm, col_itm
227 flim#ch; maxx%, maxy%, dummy%, dummy%
228 maxx% = (maxx% - 80) div sqsz%: maxy% = (maxy% - 90) div sqsz%
229 if maxx% > 25: maxx% = 25
230 if maxy% > 25: maxy% = 25
231 tmr_stat% = off%
232 tmr_id = 0:  rem Timer ID
233 :
234 SetGame
235 Winit xpos%, ypos%
236 Ping 'startup': ClearFields
237 events% = events% * 256: eve% = events%
238 :
239 rem     Main program loop
240 rep main
241  k = mcallt(#ch%, eve%, tio%, k, c0%)
242  pval#ch%; prec%
243  sel on k
244  = li_move%: wmove mwdef(#ch%): mwlink#ch; wtime%, #ct: rem Reassert link!
245    rdpt#ch; immediate%: pval#ch; prec%
246    xpos% = prec%(c10%) - c4%
247    ypos% = prec%(11) - c2%
248    changed = changed + 1
249  = li_resz%: rem Resize interactive
250    if WarnGame then
251     TimerStop: Resize: TimerShow cm1%
252    end if
253  = li_zzz%: rem Sleep
254    DoButton
255  = li_new%: rem Refresh/New game
256    if moves% = on% and game = playing then
257     if WarnGame = 0: next main: else : pause#ch; 50
258    end if
259    if gme_jsd% = on% then
260     if WarnGame then
261      TimerStop: ClearFields
262      if prec%(c5%) = do%: JumpStart: GameStart
263     end if
264    else
265     TimerStop: ClearFields
266     if prec%(c5%) = do%: JumpStart: GameStart
267    end if
268  = li_quit%: if WarnGame: Bye
269  = li_game%: rem game menu
270    if WarnGame: GameMenu
271  = li_stat%: rem stats menu
272    MenuStats -1, -1, -1, -1
273  = li_conf%: rem config menu
274    pal = palno: redraw = 0
275    xp% = prec%(c10%) - c2%: yp% = prec%(11) - c2%
276    MenuConf
277    if redraw then
278     if pal <> palno then
279      palno = pal
280      Palette palno
281     end if
282     mclear#ch%
283     RestoreGame xp%, yp%
284     TimerShow cm1%: rem ### TimerShow should work out correct state!
285    end if
286  = li_help%: rem help
287    Help#ch%; 'hlp_gen'
288  = li_info%: About
289  = mencon to 2E9: rem Game
290    if (timer_state%(tmr_id) && c4%) <> c0% and game = playing and tmr_cup% = off% and tmr_stat%  >>
    = on% then
291     rem Timed out unnoticed
292     Burp 'loose': GameLoose
293     next main
294    end if
295    if game = paused then
296     TimerResume
297     game = laststate
298    end if
299    if game = playing or game = stopped then
300     GameStart
301     moves% = on%: rem Flag that a move has been made
302     awn = k: minum = mawnum(#ch%, awn, x%, y%)
303     if prec%(c5%) = hit% then
304      Mark k, x%, y%
305     else
306      if status%(x%, y%) = c0% then
307       m% = mines%(x%, y%)
308       sel on m%
309        = bomb%: rem Hit a mine
310          if Oooo%(k) > cm1%: Explode k, x%, y%, c0%
311        = c0%: rem Blank
312          if Oooo%(k) > cm1% then
313           Unravel x%, y%
314          end if
315        = remainder
316          if Oooo%(k) > cm1% then
317           mawitem#ch%, k, spr%, sp_n(m%)
318           status%(x%, y%) = cm1%
319          else
320           Ping 'release'
321          end if
322       end sel
323      else
324       ClearAround x%, y%
325      end if
326     end if
327    else
328     if game = lost then
329      mitem#ch%; li_new%, spr%, sp_sour
330     end if
331    end if
332  = -1280: rem Event
333    ev% = eve% div 256
334    sel on ev%
335    = c1%: rem Timed out
336      if tmr_cup% = off% then
337       rem Doesnt timeout on countup
338       Burp 'loose': GameLoose
339      else
340       TimerStop
341      end if
342      tmr_stat% = off%
343      SetCol#ct; col_pto, col_ito
344      TimerShow timer_time%(tmr_id)
345    = c2%: rem Warning
346      Burp 'timeup': SetCol#ct; col_ptw, col_itw
347    end sel
348    eve% = events%
349  = wtime%: rem Timer window
350    MenuTimer: gme_chg = tmr_chg
351  = remainder : rem ErrMess idec$(k, 12,0)
352  end sel
353 end rep main
354 :
355 rem     Init windows and grid
356 :
357 def proc  Winit(px%, py%)
358 rem Window initialisation
359 xsize% = (grdx% + c1%) * sqsz% + c4%: if xsize% < 140: xsize% = 140
360 ysize% = (grdy% + c1%) * sqsz% + 70: if ysize% < 104: ysize% = 104
361 mdraw#ch%; mn_mines, px%, py%, xsize%, ysize%
362 rdpt#ch%; immediate%: pval#ch%; prec%: x% = prec%(14): y% = prec%(15)
363 xpos% = prec%(c10%) - c4%
364 ypos% = prec%(11) - c2%
365 end def Winit
366 :
367 def proc  ClearFields
368 loc i%, j%, x%, y%, r%, c%
369 rem (Re-)setup grid, set mines and grade proximities
370 dim mines$(grdx%, grdy%, 12), mines%(grdx%, grdy%)
371 dim status%(grdx%, grdy%): rem Game Status fields (not Wman)
372 xdim% = grdx% + c1%: ydim% = grdy% + c1%
373 game = stopped
374 :
375 rem Calculate number of mines. Increase relative number of mines as size
376 rem grows (paranthesis to avoid overflow) (this formula grows too fast)
377 rem mcount% = ((log10(xdim%) * xdim% * xdim%) div 100) * ydim%: rem 10%++ mines
378 if gme_mcauto%: mcount% = GetMCount%
379 mleft% = mcount%
380 ShowCount: rem Display mine count
381 TimerSet: TimerShow cm1%
382 :
383 InitGrid
384 SetMines
385 GradeSquares
386 mitem#ch%; li_new%, spr%, sp_smile
387 end def ClearFields
388 :
389 def fn  GetMCount%
390 rem Thanks to Marcel Kilgus for this one:
391 ret .4167 * xdim% * ydim% - 5.833 * sqrt(xdim% * ydim%) + 26.667
392 end def GetMCount%
393 :
394 def proc  InitGrid
395 rem Use caller's locals
396 rem Fill array with cover sprites and display
397 for i% = c0% to grdx%
398  for j% = c0% to grdy%: mines$(i%, j%) = sqr$
399 end for i%
400 mawdraw#ch%; mapp%, mines$, c0%, c0%, spr%, sqsz%, sqsz%, c0%, c0%
401 end def InitGrid
402 :
403 def proc  SetMines
404 loc sml
405 rem Uses caller's locals
406 rem Set given number of sprites randomly
407 c% = xdim% * grdy%
408 for i% = c1% to mcount%
409  rep sml
410   r% = rnd(c0% to c%)
411   x% = r% mod xdim%: y% = r% div xdim%
412   if mines%(x%, y%) <> bomb%: exit sml
413  end rep sml
414  mines%(x%, y%) = bomb%
415 end for i%
416 end def SetMines
417 :
418 def proc  GradeSquares
419 rem Uses caller's locals
420 rem Grade squares according to mines in proximity
421 for x% = c0% to grdx%
422  for y% = c0% to grdy%
423   if mines%(x%, y%) = bomb% then
424    for i% = cm1% to c1%
425     c% = x% + i%
426     for j% = cm1% to c1%
427      if not (i% = c0% and j% = c0%) then
428       r% = y% + j%
429       if c% >= c0% and c% <= grdx% and r% >= c0% and r% <= grdy% then
430        if mines%(c%, r%) <> bomb%
431         mines%(c%, r%) = mines%(c%, r%) + c1%
432        end if
433       end if
434      end if
435     end for j%
436    end for i%
437   end if
438  end for y%
439 end for x%
440 end def GradeSquares
441 :
442 def proc  Resize
443 loc x%, y%
444 if prec%(c5%) = c2% then
445  grdx% = minx%: grdy% = miny%
446 else
447  wresz mwdef(#ch); x%, y%
448  grdx% = grdx% - (x% div sqsz%): grdy% = grdy% - (y% div sqsz%)
449  if grdx% < minx%: grdx% = minx%
450  if grdx% > maxx%: grdx% = maxx%
451  if grdy% < miny%: grdy% = miny%
452  if grdy% > maxy%: grdy% = maxy%
453  if gme_mcauto% = off% then
454   minm% = grdx% * grdy% div 12: rem Max/Min number of mines
455   maxm% = minm% * c4%:          rem for this grid size
456   if mcount% > maxm%: mcount% = maxm%
457   if mcount% < minm%: mcount% = minm%
458  end if
459  prec%(c10%) = prec%(c10%) + x%: if prec%(c10%) < c4%: prec%(c10%) = c4%
460  prec%(11) = prec%(11) + y%: if prec%(11) < c2%: prec%(11) = c2%
461 end if
462 NewWin prec%(c10%) - c4%, prec%(11) - c2%
463 gme_chg = 1
464 end def Resize
465 :
466 def proc  NewWin(xp%, yp%)
467 rem Set up a new window
468 mclear#ch%: clamp
469 Winit xp%, yp%
470 ClearFields
471 end def NewWin
472 :
473 rem     Mines
474 :
475 def proc  Mark(it, xp%, yp%)
476 loc i%, j%, s%
477 rem Mark bomb square and check if game over
478 if status%(xp%, yp%) = c1% then
479  Burp 'unflag'
480  mawitem#ch%; it, spr%, sp_square
481  mines$(xp%, yp%) = Spra$(sp_square)
482  status%(xp%, yp%) = c0%
483  mleft% = mleft% + c1%
484 else
485  if status%(xp%, yp%) = c0% then
486   Ping 'flag'
487   mawitem#ch%; it, spr%, sp_flag
488   mines$(xp%, yp%) = Spra$(sp_flag)
489   status%(xp%, yp%) = c1%
490   mleft% = mleft% - c1%
491  end if
492 end if
493 if mleft% <= c0% then
494  s% = c1%
495  for i% = c0% to grdx%
496   for j% = c0% to grdy%
497    if (mines%(i%, j%) = bomb% and status%(i%, j%) <> c1%) or (status%(i%, j%) = c1% and mines%( >>
    i%, j%) <> bomb%): s% = c0%: exit j%
498   end for j%
499   if s% = c0%: exit i%
500  end for i%
501  if s% = c1% then
502   for i% = c0 to grdx%
503    for j% = c0% to grdy%: status%(i%, j%) = cm1%
504   end for i%
505   mstat#ch%, mapp%, status%: mawdraw#ch%; mapp%
506   GameWin
507  else
508   Burp 'illegal'
509  end if
510 end if
511 ShowCount
512 if mleft% <= -c10%: Burp 'loose': GameLoose
513 end def Mark
514 :
515 def proc  Unravel(xp%, yp%)
516 loc i%, j%, c%, r%
517 rem Uncover adjacent blanks. Recursive!
518 mawitem#ch%; ItNo(xp%, yp%), spr%, sp_blank
519 mines$(xp%, yp%) = Spra$(sp_blank)
520 status%(xp%, yp%) = cm1%
521 s% = mstat%(#ch%; ItNo(xp%, yp%) to c0%\ c0%)
522 for i% = cm1% to c1%
523  c% = xp% + i%
524  for j% = cm1% to c1%
525   if not (i% = c0% and j% = c0%) then
526    r% = yp% + j%
527    if c% >= c0% and c% <= grdx% and r% >= c0% and r% <= grdy% then
528     if status%(c%, r%) = c0% then
529      if mines%(c%, r%) = c0% then
530       Unravel c%, r%
531      else
532       if mines%(c%, r%) < bomb% then
533        mawitem#ch%; ItNo(c%, r%), spr%, sp_n(mines%(c%, r%))
534        mines$(c%, r%) = Spra$(sp_n(mines%(c%, r%)))
535        status%(c%, r%) = cm1%
536        s% = mstat%(#ch%; ItNo(c%, r%) to c0%\ c0%)
537       end if
538      end if
539     end if
540    end if
541   end if
542  end for j%
543 end for i%
544 s% = mstat%(#ch%; ItNo(xp%, yp%) to c0%): rem Redraw changed
545 end def Unravel
546 :
547 def proc  Explode(it, xp%, yp%, e%)
548 loc i%, j%
549 rem Explode bomb, reveal all, and finish game
550 if e% = c0% then
551  mawitem#ch%, it, spr%, sp_bombx
552  mines$(xp%, yp%) = Spra$(sp_bombx)
553  Burp 'bomb'
554 end if
555 status%(xp%, yp%) = cm1%
556 for i% = c0% to grdx%
557  for j% = c0% to grdy%
558   if status%(i%, j%) = c1% then
559    if mines%(i%, j%) <> bomb% then
560     mawitem#ch%, ItNo(i%, j%), spr%, sp_bombe
561     mines$(i%, j%) = Spra$(sp_bombe)
562    end if
563   else
564    if status%(i%, j%) = c0% and mines%(i%, j%) = bomb% then
565     mawitem#ch%, ItNo(i%, j%), spr%, sp_bomb
566     mines$(i%, j%) = Spra$(sp_bomb)
567    end if
568   end if
569   status%(i%, j%) = cm1%
570  end for j%
571 end for i%
572 mstat#ch%, mapp%, status%: mawdraw#ch%; mapp%
573 GameLoose
574 end def Explode
575 :
576 def fn  Oooo%(it)
577 rem Simulate button depress and allow regret
578 Ping 'press'
579 mitem#ch%; li_new%, spr%, sp_oooo: mlidraw#ch%; li_new%
580 mwindow#ch%; it
581 sprw#ch%; c0%, c0%, sp_blank
582 rdpt#ch%; tvx%: pval#ch%; prec%
583 Ping 'release'
584 mitem#ch%; li_new%, spr%, sp_smile
585 ret prec%(c3%): rem Escape if pointer out of window
586 end def Oooo%
587 :
588 def proc  ClearAround(xp%, yp%)
589 loc i%, j%, c%, r%, s%, i
590 rem If no unmarked mines clear around numbered square else flash
591 if status%(xp%, yp%) <> cm1% or mines%(xp%, yp%) = c0%: Burp 'illegal': ret
592 s% = c1%
593 for i% = cm1% to c1%
594  c% = xp% + i%
595  for j% = cm1% to c1%
596   r% = yp% + j%
597   if c% >= c0% and c% <= grdx% and r% >= c0% and r% <= grdy% then
598    if mines%(c%, r%) = bomb% then
599     if status%(c%, r%) = c0% then
600      s% = c0%
601     end if
602    else
603     if status%(c%, r%) = c1% then
604      s% = cm1%: exit j%
605     end if
606    end if
607   end if
608  end for j%
609  if s% = cm1%: exit i%
610 end for i%
611 :
612 rem Check for wrongly marked mines
613 if s% = cm1% then
614  Burp 'loose'
615  i = ItNo(c%, r%)
616  mawitem#ch%; i, spr%, sp_bombe
617  mines$(c%, r%) = Spra$(sp_bombe)
618  Explode i, c%, r%, c1%: rem Flag wrong marker
619  ret
620 end if
621 :
622 rem Unmarked mine(s) found: Flash
623 if s% = c0% then
624  for i% = cm1% to c1%
625   c% = xp% + i%
626   for j% = cm1% to c1%
627    r% = yp% + j%
628    if c% >= c0% and c% <= grdx% and r% >= c0% and r% <= grdy% then
629     if status%(c%, r%) = c0% then
630      Ping 'flash'
631      i = ItNo(c%, r%)
632      mawitem#ch%; i, spr%, sp_blank
633      mines$(c%, r%) = Spra$(sp_blank)
634      s% = mstat%(#ch%; i to c1%\ c0%)
635     end if
636    end if
637   end for j%
638  end for i%
639  s% = mstat%(#ch%; i to c0%)
640 :
641  rem Wait for keyup, then unflash
642  rdpt#ch%; c4%
643  Ping 'release'
644  for i% = cm1% to c1%
645   c% = xp% + i%
646   for j% = cm1% to c1%
647    r% = yp% + j%
648    if c% >= c0% and c% <= grdx% and r% >= c0% and r% <= grdy% then
649     if status%(c%, r%) = c0% then
650      i = ItNo(c%, r%)
651      mawitem#ch%; i, spr%, sp_square
652      mines$(c%, r%) = Spra$(sp_square)
653      s% = mstat%(#ch%; i to c0%\ c0%)
654     end if
655    end if
656   end for j%
657  end for i%
658  s% = mstat%(#ch%; i to c0%)
659 else
660 :
661  rem No unmarked mines found: Clear surrounding squares
662  Ping 'clear'
663  for i% = cm1% to c1%
664   c% = xp% + i%
665   for j% = cm1% to c1%
666    r% = yp% + j%
667    if c% >= c0% and c% <= grdx% and r% >= c0% and r% <= grdy% then
668     if status%(c%, r%) = c0% then
669      if mines%(c%, r%) = c0% then
670       Unravel c%, r%
671      else
672       i = ItNo(c%, r%)
673       mawitem#ch; i, spr%, sp_n(mines%(c%, r%))
674       mines$(c%, r%) = Spra$(sp_n(mines%(c%, r%)))
675       s% = mstat%(#ch%; i to c0%)
676      end if
677      status%(c%, r%) = cm1%
678     end if
679    end if
680   end for j%
681  end for i%
682 end if
683 end def ClearAround
684 :
685 def proc  JumpStart
686 loc rl, c%, r%
687 rem Unravel a random field
688 Ping 'new'
689 rep rl
690  c% = rnd(c0% to grdx%): r% = rnd(c0% to grdy%)
691  if mines%(c%, r%) = c0% then
692   Unravel c%, r%
693   exit rl
694  end if
695 end rep rl
696 end def JumpStart
697 :
698 rem     Submenus
699 :
700 def proc  MenuTimer
701 loc awl, k%
702 loc retrac: rem Local to menus
703 rep awl
704  k% = AwRead%(wtime%)
705  sel on k%
706  = esc%: exit awl
707  = c1%: rem HIT
708    if tmr_use% = on% and tmr_stat% = on% then
709     if tmr_pause% = on% then
710      TimerResume: Ping ok$
711      game = laststate
712     else
713      TimerPause: Ping 'pause'
714      laststate = game: game = paused
715     end if
716    end if
717    next awl
718  = c2%: rem DO
719    MenuTime prec%(10) - 80, prec%(11) + 22
720  = remainder : next awl
721  end sel
722 end rep awl
723 end def MenuTimer
724 :
725 def proc  MenuTime(xp%, yp%)
726 loc tml, i%, cm, st%, tk, d$(c3%)
727 cm = fopen(con$): ert cm
728 msetup#cm; mn_timer, xp%, yp%
729 mitem#cm; tmi_use%, spr%, sp_spotn(spot%)
730 mitem#cm; tmi_aut%, spr%, sp_spotn(spot%)
731 mitem#cm; tmi_cup%, spr%, sp_spotn(spot%)
732 mitem#cm; tmi_cdn%, spr%, sp_spotn(spot%)
733 mitem#cm; tmi_lrc%, spr%, sp_spotn(spot%)
734 st% = mstat%(#cm; tmi_lrc% to cm1%\ c0%): rem NI yet
735 if tmr_use% = on% then
736  SwitchOn
737 else
738  SwitchOff
739 end if
740 TechnicalPause
741 mdraw#cm
742 Digits
743 st% = c0%
744 rep tml
745  tk = mcall(#cm; tk! st%)
746  pval#cm; tprec%
747  sel on tk
748  = -2: Help#cm; 'hlp_timer': st% = c0%
749  = -3: rem Quit
750    retrac = tprec%(c5%) = c2%
751    mclear#cm: close#cm
752    exit tml
753  = tmi_use%: rem Toggle Use timer
754    if game = playing then
755     Burp 'illegal': next tml
756    else
757     tmr_use% = mstat%(#cm; tk)
758     if tmr_use% = on% then
759      SwitchOn
760      TimerSet
761     else
762      TimerOff
763      SwitchOff
764     end if
765    end if
766    st% = mstat%(#cm; tk to tmr_use%): rem Re-draw
767    tmr_chg = 1
768  = tmi_aut%: rem Toggle auto-calculate countdown
769    st% = mstat%(#cm; tk): tmr_auto% = st%
770    if tmr_auto% = on%: tmr_cup% = off%
771    SwitchOn
772    st% = mstat%(#cm; tk to st%): rem Re-draw
773    tmr_chg = 1
774  = tmi_cup%: rem Toggle Count up
775    st% = mstat%(#cm; tk)
776    tmr_cup% = st%: tmr_auto% = off%
777    SwitchOn
778    st% = mstat%(#cm; tk to st%): rem Re-draw
779    tmr_chg = 1
780  = tmi_cdn%: rem Toggle Count down
781    st% = mstat%(#cm; tk)
782    if st% = on%: tmr_cup% = off%: else : tmr_cup% = on%
783    tmr_auto% = off%
784    SwitchOn
785    st% = mstat%(#cm; tk to st%): rem Re-draw
786    tmr_chg = 1
787    rem Edit Start time
788  = tmi_dgs% - c2% to tmi_dgs%: rem Up
789    d$ = Z$(tmr_start%)
790    i% = abs(tk) - c7%
791    if tprec%(c5%) = c2% then
792     if d$(i%) = c9%: d$(i%) = c5%: else : d$(i%) = c9%
793    else
794     if d$(i%) = c9% then
795      d$(i%) = c0%
796     else
797      d$(i%) = d$(i%) + c1%
798     end if
799    end if
800    tmr_start% = d$: tmr_auto% = off%
801    st% = c0%: tmr_chg = 1
802  = tmi_dge% to tmi_dgs% - c3%: rem Down
803    d$ = Z$(tmr_start%)
804    i% = abs(tk) - c10%
805    if tprec%(c5%) = c2% then
806     if d$(i%) = c0%: d$(i%) = c5%: else : d$(i%) = c0%
807    else
808     if d$(i%) = c0% then
809      d$(i%) = c9%
810     else
811      d$(i%) = d$(i%) - c1%
812     end if
813    end if
814    tmr_start% = d$: tmr_auto% = off%
815    st% = c0%: tmr_chg = 1
816  = tmi_lrc%: rem Timer Last record
817  end sel
818  Digits
819 end rep tml
820 TechnicalResume
821 if tmr_use% = on%: timer_disp tmr_id, c1%
822 if tmr_chg = 1 then
823  rem Timer changed
824  TimerSet
825  if tmr_stat% = off%: TimerShow cm1%
826  if tmr_pause% = on%: TimerResume: Ping ok$
827 end if
828 if tmr_use% = on% and tmr_stat% = on% and tmr_pause% = off% then
829  if tmr_id = 0 then
830   TimerShow cm1%
831  end if
832 end if
833 end def MenuTime
834 :
835 def proc  TechnicalPause
836 if tpause% = c0% then
837  if tmr_use% = on% and tmr_pause% = off%: timer_disp tmr_id, c0%: tpause% = c1%
838 end if
839 end def TechnicalPause
840 :
841 def proc  TechnicalResume
842 if tpause% = c1% then
843  if tmr_use% = on% and tmr_pause% = off%: timer_disp tmr_id, c1%: tpause% = c0%
844 end if
845 end def TechnicalResume
846 :
847 def proc  SwitchOn
848 loc i%, st%
849 st% = mstat%(#cm; tmi_use% to c1%\ c0%)
850 if tmr_auto% = on% then
851  st% = mstat%(#cm; tmi_aut% to c1%\ c0%)
852  st% = mstat%(#cm; tmi_cup% to cm1%\ c0%)
853  st% = mstat%(#cm; tmi_cdn% to cm1%\ c0%)
854  for i% = tmi_cup% to tmi_dge% step cm1%
855    st% = mstat%(#cm; i% to cm1%\ c0%)
856  end for i%
857 else
858  if tmr_cup% = on% then
859   st% = mstat%(#cm; tmi_cup% to c1%\ c0%)
860   st% = mstat%(#cm; tmi_aut% to c0%\ c0%)
861   st% = mstat%(#cm; tmi_cdn% to c0%\ c0%)
862   for i% =tmi_dgs% to tmi_dge% step cm1%
863    st% = mstat%(#cm; i% to cm1%\ c0%)
864   end for i%
865  else
866   st% = mstat%(#cm; tmi_cdn% to c1%\ c0%)
867   st% = mstat%(#cm; tmi_aut% to c0%\ c0%)
868   st% = mstat%(#cm; tmi_cup% to c0%\ c0%)
869   for i% = tmi_dgs% to tmi_dge% step cm1%
870    st% = mstat%(#cm; i% to c0%\ c0%)
871   end for i%
872  end if
873 end if
874 end def SwitchOn
875 :
876 def proc  SwitchOff
877 loc i%, st%
878 st% = mstat%(#cm; tmi_use% to c0%\ c0%)
879 for i% = tmi_aut% to tmi_dge% step cm1%
880  st% = mstat%(#cm; i% to cm1%\ c0%)
881 end for i%
882 end def SwitchOff
883 :
884 def proc  Digits
885 loc i%, d$(c3%)
886 if tmr_use% = off% then
887  d$ = '---'
888 else
889  if tmr_cup% = on% then
890   d$ = '000'
891  else
892   d$ = Z$(tmr_start%)
893  end if
894 end if
895 for i% = tmw_dg1% to tmw_dg3%
896  mwindow#cm; i%! c0%: timer_led#cm; c1%, d$(i% - tmw_dg1% + c1%)
897 end for i%
898 end def Digits
899 :
900 rem     Timer
901 :
902 def proc  TimerSet
903 SetCol#ct; col_ptm, col_itm
904 if tmr_use% = off%: ret
905 if tmr_id = 0 then
906  tmr_id = timer_init(#ct! c3%): rem padded to three digits
907 end if
908 if tmr_auto% = on% or tmr_cup% = off% then
909  if tmr_auto% = on% then
910   tmr_start% = TmrStart%(mcount%, xdim%, ydim%)
911  end if
912  timer_set tmr_id, tmr_start% to tmr_end%, tmr_wrd%
913 else
914  timer_set tmr_id, c0% to 999, tmr_wru%
915 end if
916 end def TimerSet
917 :
918 def fn  TmrStart%(mc%, xd%, yd%)
919 loc t%
920 t% = tmr_fact * mc% * mc% / xd% / yd%
921 if t% > 999: t% = 999
922 ret t%
923 end def TmrStart%
924 :
925 def proc  TimerShow(n%)
926 mwlink#ch; wtime%, #ct
927 if tmr_use% = on% then
928  if n% > cm1% then
929   timer_led#ct; c3%, Z$(n%)
930  else
931   if tmr_cup% = on% then
932    timer_led#ct; c3%, '000'
933   else
934    timer_led#ct; c3%, Z$(tmr_start%)
935   end if
936  end if
937 else
938  timer_led#ct; c3%, '---'
939 end if
940 end def TimerShow
941 :
942 def proc  TimerStart
943 if tmr_use% = off% or tmr_stat% = on%: ret : rem Untimed/already running
944 tmr_stat% = on%: tmr_pause% = off%
945 TimerShow cm1%: timer_start tmr_id
946 end def TimerStart
947 :
948 def proc  TimerPause
949 if tmr_use% = off%: ret : rem Untimed
950 if tmr_stat% = on% then
951  timer_pause tmr_id
952  tmr_pause% = on%
953 end if
954 end def TimerPause
955 :
956 def proc  TimerStop
957 if tmr_use% = off%: ret : rem Untimed
958 timer_stop tmr_id
959 tmr_stat% = off%: tmr_pause% = off%
960 end def TimerStop
961 :
962 def proc  TimerOff
963 if tmr_use% = off%: ret : rem Already off
964 timer_kill tmr_id: tmr_id = 0
965 tmr_stat% = off%: tmr_pause% = off%
966 end def TimerOff
967 :
968 def proc  TimerResume
969 if tmr_use% = off%: ret : rem Untimed
970 timer_pause tmr_id
971 tmr_stat% = on%: tmr_pause% = off%
972 end def TimerResume
973 :
974 rem     Misc
975 :
976 def proc  ShowCount
977 rem Display count
978 mwindow#ch; wmcnt%! c0%: SetCol#ch; col_pmc, col_imc
979 timer_led#ch; c3%, Z$(mleft%)
980 wm_paper#ch; sp_appbg%: rem To avoid flash of col_pmc
981 end def ShowCount
982 :
983 def fn  Z$(n%)
984 loc s$
985 if n% < c0%: s$ = '-': else s$ = nul$
986 ret s$ & fill$("0", c3% - len(abs(n%) & s$)) & abs(n%)
987 end def
988 :
989 def fn  Centre$(w%, txt$)
990 rem Centre text
991 if len(txt$) > w% then
992  ret txt$(c1% to w%)
993 else
994  ret fill$(spc$, (w% - len(txt$)) div c2%) & txt$
995 end if
996 end def Centre$
997 :
998 def fn  ItNo(i%, j%)
999 rem Create item number from coordinates
1000 ret (j% * xdim% + i% + c1%) * mencon + 1
1001 end def ItNo
1002 :
1003 def fn  AwRead%(awno%)
1004 loc k%
1005 rdpt#ch; mvec%
1006 pval#ch; tprec%: k% = tprec%(c6%)
1007 if (tprec%(c2%) + c1%) <> awno%: ret esc%
1008 if k% = esc%: Bye
1009 ret k%
1010 end def AwRead%
1011 :
1012 def proc  SetCol(ch, cp, ci)
1013 paper#ch; cp: ink#ch; ci
1014 end def
1015 :
1016 def proc  Bye
1017 if tmr_id <> 0: timer_kill tmr_id
1018 if saveonx and changed: CfgSave: Ping 'saved'
1019 mclear#ch: clamp: close: quit
1020 end def Bye
1021 :
1022 rem     Button
1023 :
1024 def proc  DoButton
1025 rem Save timer and window statuses,
1026 rem and close windows
1027 if tmr_use% = on%  then
1028  but_t% = timer_time%(tmr_id): but_s% = timer_state%(tmr_id)
1029  if but_t% = 0 and game <> lost: but_t% = tmr_start%
1030  timer_kill tmr_id: tmr_id = 0
1031 rem if tmr_stat% = on% and game = playing then
1032  if game = playing then
1033   Ping 'pause'
1034   if tmr_cup% = on% then
1035    but_t% = but_t% - c1%
1036   else
1037    but_t% = but_t% + c1%
1038   end if
1039  end if
1040 end if
1041 pval#ch; prec%
1042 close#ct: mclear#ch: clamp: close#ch
1043 rem Use button frame if wanted and available
1044 if butbf then
1045  butx% = butsx%: buty% = butsy%
1046  er% = butuse%(butx%, buty%): rem Returns position in butx/y
1047  if er% <> c0%: butbf = 0
1048 end if
1049 ButWin
1050 end def DoButton
1051 :
1052 def proc  ButWake
1053 loc p, i, t%, a%, u%, w%
1054 rem Re-open windows and restore game
1055 close#butch: butch = 0: if bfpresent: butfree
1056 ch = fopen(con$): ert ch: ch% = ch: outl#ch
1057 ct = fopen(con$): ert ct: rem Timer window
1058 RestoreGame prec%(c10%) - c6%, prec%(11) - c4%
1059 :
1060 rem Restore timer state (a bit fiddley this)
1061 if tmr_use% = on% then
1062  tmr_id = timer_init(#ct! c3%)
1063  if tmr_stat% = on% then
1064   rem Set Paper/Ink colour according to state
1065   if (but_s% && 16) > c0% then
1066    SetCol#ct; col_ptw, col_itw
1067   else
1068    SetCol#ct; col_ptm, col_itm
1069   end if
1070   if tmr_cup% = on% then
1071    timer_set tmr_id, but_t% to 999, tmr_wru%
1072   else
1073    timer_set tmr_id, but_t% to c0%, tmr_wrd%
1074   end if
1075   TimerShow but_t%
1076   pause#ct; c1%: rem Re-schedule!
1077   if but_t% > c0% then
1078    timer_start tmr_id
1079    if tmr_pause% = on%: timer_pause tmr_id
1080   end if
1081  else
1082   rem Stopped, timedout or not initialised
1083   TimerSet
1084   mwlink#ch; wtime%, #ct
1085   if game = playing then
1086    SetCol#ct; col_ptm, col_itm
1087    TimerShow cm1%
1088   else
1089    if but_t% <= c0% and game = lost then
1090     SetCol#ct; col_pto, col_ito
1091    else
1092     SetCol#ct; col_ptm, col_itm
1093    end if
1094    TimerShow but_t%
1095   end if
1096  end if
1097 else
1098  rem Timer off
1099  mwlink#ch; wtime%, #ct
1100  SetCol#ct; col_ptm, col_itm
1101  TimerShow but_t%
1102 end if
1103 end def ButWake
1104 :
1105 def proc  ButWin
1106 rem Button window routine
1107 loc bl, owl
1108 butch = fopen(con$)
1109 if butch > 0 then
1110  rem Define button window and display
1111  if butx% < c0% or buty% < c0% then
1112   outl#butch; butsx%, butsy%, prec%(14), prec%(15)
1113  else
1114   outl#butch; butsx%, butsy%, butx%, buty%
1115  end if
1116  wm_border#butch; c1%, sp_butbd%
1117  wm_paper#butch; sp_butbg%: wm_ink#butch; sp_butfg%
1118  cls#butch: cursor#butch; c2%, c1%: print#butch; 'D-Miner';
1119  sprw#butch; butsprx%, c1%, sp_sleep
1120  :
1121  rem Pointer out of button window
1122  rep bl
1123   rdpt#butch; but_vi%
1124   if but_vi% div 256 >= c1%: exit bl
1125   Ping 'wake'
1126   wm_border#butch; c1%, sp_buthigh%
1127   sprw#butch; butsprx%, c1%, sp_wink
1128   :
1129  rem Pointer in button window
1130   rep owl
1131    rdpt#butch; but_vo%:
1132    if but_vo% div 256 >= c1% then
1133     if but_vo% div 256 = c2% or butbf: exit bl
1134     wm_border#butch; c0%, sp_butbd%: rem Why?
1135     wmove mwdef(#butch)
1136    end if
1137    wm_border#butch; c1%, sp_butbd%
1138    sprw#butch; butsprx%, c1%, sp_sleep
1139    exit owl
1140   end rep owl
1141  end rep bl
1142  ButWake
1143 else
1144  rem Cannot do button
1145  Burp 'illegal'
1146 end if
1147 end def ButWin
1148 :
1149 def proc  RestoreGame(xp%, yp%)
1150 Winit xp%, yp%
1151 ShowCount
1152 if game = lost then
1153  mitem#ch%; li_new%, spr%, sp_sour
1154 else
1155  if game = won: mitem#ch%; li_new%, spr%, sp_cool
1156 end if
1157 rem Restore game board
1158 mawdraw#ch%; mapp%, mines$, c0%, c0%, spr%, sqsz%, sqsz%, c0%, c0%
1159 end def RestoreGame
1160 :
1161 def proc  MenuConf
1162 loc ml, mc, mk, s%, xp%, t$(c4%), snd, sox
1163 loc retrac : rem Local to menus
1164 TechnicalPause
1165 retrac = 0: colsq = 0
1166 mc = fopen(con$): if mc < 0: ert mc
1167 xp% = prec%(c10%) + c10%
1168 msetup#mc; mn_config, xp%, prec%(11) + 40
1169 sox = saveonx: snd = sound
1170 SetConf
1171 mdraw#mc
1172 s% = c0%
1173 rep ml
1174  mk = mcall(#mc; mk, s%)
1175  sel on mk
1176  = -2: Help#mc; 'hlp_config'
1177  = -3: if changed: Ping ok$
1178    exit ml
1179  = -4: rem Sound
1180    s% = mstat%(#mc; mk)
1181    snd = s%: Ping ok$
1182    if snd = (sound <> 0) then
1183     changed = changed - 1: if changed < 0: changed = 0
1184    else
1185     changed = changed + 1
1186    end if
1187  = -5, -6: rem HIT/DO
1188    SwapHD
1189    if t$ = 'HIT': hit% = c2%: do% = c1%: else : hit% = c1%: do% = c2%
1190    s% = c0%: changed = changed + 1
1191  = -7: rem Look
1192     pval#mc; tprec%
1193     MenuLook tprec%(10) + 100, tprec%(11) + 76
1194     if pal <> palno: changed = changed + 1
1195     s% = c0%
1196  = -8: rem Timer
1197    tmr_chg = 0
1198    pval#mc; tprec%
1199    MenuTime tprec%(10) + 100, tprec%(11) + 92
1200    s% = c0%
1201    if tmr_chg: Ping ok$: changed = changed + tmr_chg
1202  = -9: rem Score
1203    pval#mc; tprec%
1204    changed = changed + MenuScore(tprec%(10) + 100, tprec%(11) + 108)
1205    s% = c0%
1206  = -10: rem Save on exit
1207    s% = mstat%(#mc; mk)
1208    if sox = s% then
1209     changed = changed - 1: if changed < 0: changed = 0
1210    else
1211     changed = changed + 1
1212     saveonx = s%
1213    end if
1214  = -11: rem Defaults
1215    SetDefaults: SetConf
1216    s% = mstat%(#mc; mk to c0%)
1217    changed = 1
1218    Ping ok$
1219  = -12: rem Save Now
1220    SetSound snd
1221    CfgSave: Ping 'saved'
1222    s% = cm1%: next ml
1223  end sel
1224  if changed then
1225   st% = mstat%(#mc; -12 to c1%\ c0%)
1226  else
1227   if retrac: exit ml
1228   st% = mstat%(#mc; -12 to cm1%\ c0%)
1229  end if
1230 end rep ml
1231 mclear#mc: close#mc
1232 SetSound snd
1233 if colsq: rechp colsq: colsq = 0
1234 TechnicalResume
1235 end def MenuConf
1236 :
1237 def proc  SetConf
1238 rem MenuConf subroutine
1239 mitem#mc; -4, spr%, sp_spotn(spot%)
1240 mitem#mc; -10, spr%, sp_spotn(spot%)
1241 if (hit% = c1% and mtext$(#mc; -5) <> 'HIT') or (hit% = c2% and mtext$(#mc; -5) <> 'DO'):  >>
     SwapHD
1242 if sound: s% = mstat%(#mc; -4, c1%\ c0%): else : s% = mstat%(#mc; -4, c0%\ c0%)
1243 s% = mstat%(#mc; -10, saveonx\ c0%)
1244 if changed: s% = mstat%(#mc; -12, c1%\ c0%): else : s% = mstat%(#mc; -12, cm1%\ c0%)
1245 end def SetConf
1246 :
1247 def proc  SwapHD
1248 rem MenuConf subroutine
1249 t$ = mtext$(#mc; -5)
1250 mitem#mc; -5, c0%, mtext$(#mc; -6)
1251 mitem#mc; -6, c0%, t$
1252 end def SwapHD
1253 :
1254 def proc  CfgSave
1255 loc i%, sc
1256 sc = fop_over(homed$ & 'dminer_cfg'): if sc < 0: Burp 'illegal': ret
1257 :
1258 rem Magic
1259 print#sc; mgDmnr$
1260 :
1261 print#sc\\ '* - File locations'\\
1262 Cfg 'Help', hlpprg$
1263 Cfg 'Message', msgprg$
1264 Cfg 'ColourSquare', colsq$
1265 Cfg 'SoundDir', snd$
1266 :
1267 print#sc\\ '* - Game board'\\
1268 Cfg 'x-pos', xpos%
1269 Cfg 'y-pos', ypos%
1270 :
1271 for i% = c0% to dimn(game%)
1272  print#sc\\ '* - Game #' & i%\\
1273  Cfg 'current', YN$(game%(i%, c0%))
1274  Cfg 'x-grid', game%(i%, c1%)
1275  Cfg 'linked', YN$(game%(i%, c2%))
1276  Cfg 'y-grid', game%(i%, c3%)
1277  Cfg 'mines', GetOpt$(game%(i%, c4%), gameM$)
1278  Cfg 'timer', GetOpt$(game%(i%, c5%), gameT$)
1279 end for i%
1280 :
1281 print#sc\\ '* - General'\\
1282 Cfg 'sound', YN$(sound)
1283 Cfg 'palette', palno
1284 Cfg 'spots', colour$(spot% - c1%)
1285 Cfg 'HIT', hit%
1286 Cfg 'Save on Exit', YN$(saveonx)
1287 :
1288 print#sc\\ '* - Timer'\\
1289 Cfg 'factor', tmr_fact
1290 Cfg 'warn up', tmr_wru%
1291 Cfg 'warn down', tmr_wrd%
1292 :
1293 print#sc\\ '* - Score on'\\
1294 Cfg 'Count up', YN$(gme_cup%)
1295 Cfg 'Jump start', YN$(gme_jst%)
1296 Cfg 'Discard JS', YN$(gme_jsd%)
1297 print#sc
1298 Cfg 'Auto save', YN$(autosave)
1299 :
1300 print#sc\\ '* - Colours'\\
1301 Cfg 'Counter ink', Col$(col_imc)
1302 Cfg 'Counter paper', Col$(col_pmc)
1303 Cfg 'Timer ink', Col$(col_itm)
1304 Cfg 'Timer paper', Col$(col_ptm)
1305 Cfg 'Warn ink', Col$(col_itw)
1306 Cfg 'Warn paper', Col$(col_ptw)
1307 Cfg 'Timeout paper', Col$(col_pto)
1308 Cfg 'Timeout ink', Col$(col_ito)
1309 :
1310 print#sc\\ '* - Button'\\
1311 Cfg 'Use button frame', YN$(butbf)
1312 Cfg 'Position x', butx%
1313 Cfg 'Position y', buty%
1314 :
1315 close#sc
1316 changed = 0
1317 end def CfgSave
1318 :
1319 def proc  Cfg(n$, e$)
1320 print#sc; n$; to 18; ':'! e$
1321 end def Cfg
1322 :
1323 def fn  YN$(c)
1324 if c: ret 'Yes': else : ret 'No'
1325 end def YN$
1326 :
1327 def fn  Col$(n)
1328 ret '$' & hex$(n, 24)
1329 end def Col$
1330 :
1331 def fn  CfgRead(fnm$)
1332 loc i%, il, sc, er, op, o$, l$, t$
1333 sc = GetMagic(fnm$, mgDmnr$)
1334 if sc < 0: ret sc
1335 :
1336 er = 0
1337 :
1338 rem * - File locations
1339 rem If not a valid filename, dont change default
1340 t$ = Gcfg$('Help'): if len(t$) > c5%: hlpprg$ = t$
1341 t$ = Gcfg$('Message'): if len(t$) > c5%: msgprg$ = t$
1342 t$ = Gcfg$('ColourSquare'): if len(t$) > c5%: colsq$ = t$
1343 t$ = Gcfg$('SoundDir'): if len(t$) > c4%: snd$ = t$
1344 :
1345 rem * - Game board
1346 xpos% = Gcfg$('x-pos')
1347 ypos% = Gcfg$('y-pos')
1348 :
1349 for i% = c0% to dimn(game%)
1350  rem * - Game #
1351  game%(i%, c0%) = GcfgY('current')
1352  game%(i%, c1%) = Gcfg$('x-grid')
1353  game%(i%, c2%) = GcfgY('linked')
1354  game%(i%, c3%) = Gcfg$('y-grid')
1355  game%(i%, c4%) = GcfgO('mines', gameM$)
1356  game%(i%, c5%) = GcfgO('timer', gameT$)
1357 end for i%
1358 :
1359 rem * - General
1360 sound = GcfgY('sound')
1361 SetSound sound
1362 :
1363 palno = Gcfg$('palette')
1364 spot% = abs(GcfgO('spots', colour$))
1365 hit% = Gcfg$('HIT')
1366 saveonx = GcfgY('Save on Exit')
1367 :
1368 rem * - Timer
1369 tmr_fact = Gcfg$('factor')
1370 tmr_wru% = Gcfg$('warn up')
1371 tmr_wrd% = Gcfg$('warn down')
1372 :
1373 rem * - Score on
1374 gme_cup% = GcfgY('Count up')
1375 gme_jst% = GcfgY('Jump start')
1376 gme_jsd% = GcfgY('Discard JS')
1377 autosave = GcfgY('Auto save')
1378 :
1379 rem * - Colours
1380 col_imc = GcfgC('Counter ink')
1381 col_pmc = GcfgC('Counter paper')
1382 col_itm = GcfgC('Timer ink')
1383 col_ptm = GcfgC('Timer paper')
1384 col_itw = GcfgC('Warn ink')
1385 col_ptw = GcfgC('Warn paper')
1386 col_pto = GcfgC('Timeout paper')
1387 col_ito = GcfgC('Timeout ink')
1388 :
1389 rem * - Button
1390 butbf = GcfgY('Use button frame')
1391 butx% = Gcfg$('Position x')
1392 buty% = Gcfg$('Position y')
1393 :
1394 close#sc
1395 ret er
1396 end def CfgRead
1397 :
1398 def fn  Gcfg$(tx$)
1399 rep il
1400  if eof(#sc): er = er + 1: exit il
1401  input#sc; l$
1402  if len(l$) = c0%: next il
1403  p% = ': ' instr l$: if p% = c0%: next il
1404  if (tx$ instr l$) <> c1%: next il
1405  exit il
1406 end rep il
1407 if er: ret nul$
1408 ret l$(p% + c2% to len(l$))
1409 end def Gcfg
1410 :
1411 def fn  GcfgY(tx$)
1412 o$ = Gcfg$(tx$)
1413 if 'yes' instr o$: ret 1: else : ret 0
1414 end def Gcfg
1415 :
1416 def fn  GcfgO(tx$, ar$)
1417 loc i%
1418 o$ = Gcfg$(tx$)
1419 op = 1000
1420 if dimn(ar$) > c0% then
1421  for i% = c0% to dimn(ar$)
1422   if o$ == ar$(i%): op = cm1% - i%: exit i%
1423  end for i%
1424 else
1425  if o$ == ar$: op = cm1%
1426 end if
1427 if op = 1000: op = '0' & o$
1428 ret op
1429 end def Gcfg
1430 :
1431 def fn  GcfgC(tx$)
1432 o$ = Gcfg$(tx$)
1433 if len(o$) <> c7%: er = er + 1: ret 0
1434 ret hex(o$(c2% to len(o$)))
1435 end def Gcfg
1436 :
1437 def proc  MenuLook(xp%, yp%)
1438 loc ml, mc, mk, x%, y%
1439 mc = fopen(con$): if mc < 0: ert mc
1440 msetup#mc; mn_look, xp%, yp%
1441 mitem#mc; -4, c0%, nul$ & pal
1442 mdraw#mc
1443 rep ml
1444  mk = mcall(#mc; mk, c0%)
1445  pval#mc; tprec%
1446  x% = tprec%(10) + 92
1447  sel on mk
1448  = -2: Help#mc; 'hlp_look'
1449  = -3: rem Exit
1450    retrac = (tprec%(c5%) = c2%)
1451    if changed: Ping ok$
1452    exit ml
1453  = -4: rem Palette
1454    if tprec%(c5%) = c2% then
1455     pal = (mtext$(#mc; mk) + c1%) mod c5%
1456    else
1457     pal = (mtext$(#mc; mk) - c1%)
1458     if pal < 0: pal = c4%
1459    end if
1460    Palette pal
1461    mclear#mc: mdraw#mc; mn_look, xp%, yp%
1462    mitem#mc; mk, 0, nul$ & pal
1463  = -5: rem Spots
1464    MenuSpotsel x%, tprec%(11) + 40
1465  = -6: rem Run
1466    y% = tprec%(11) + 76
1467    MenuColsel 'Run', x%, y%, col_ptm, col_itm, tmr_start%
1468  = -7: rem Warn
1469    y% = tprec%(11) + 92
1470    MenuColsel 'Warn', x%, y%, col_ptw, col_itw, tmr_wrn%
1471  = -8: rem Timeout
1472    y% = tprec%(11) + 108
1473    MenuColsel 'Time', x%, y%, col_pto, col_ito, tmr_end%
1474  = -9: rem Minecount
1475    y% = tprec%(11) + 124
1476    MenuColsel 'Count', x%, y%, col_pmc, col_imc, mcount%
1477  end sel
1478  if retrac: exit ml
1479 end rep ml
1480 if pal <> palno then
1481  redraw = 1
1482  Palette palno: rem Dont change before exit config
1483 end if
1484 mclear#mc: close#mc
1485 end def MenuLook
1486 :
1487 def proc  Palette(p%)
1488 loc cp, adr, c$(c6%)
1489 if p% = c4% then
1490  if palset < 0 then
1491   rem No palette available
1492   p% = c0%: Burp 'illegal'
1493  else
1494   if palset = 0 then
1495    palset = alchp(sp_getcount * c2%)
1496    if palset = 0 or palset = -3 then
1497     palset = 0: p% = c0%
1498     sp_jobpal -1, p%
1499     ErrMess 'Not enough memory!'
1500    else
1501     LoadPal
1502    end if
1503   else
1504 rem   sp_jobownpal -1, palset
1505    setpal palset
1506   end if
1507  end if
1508 else
1509  sp_jobpal -1, p%
1510 end if
1511 end def Palette
1512 :
1513 def proc  LoadPal
1514 rem Palette subroutine
1515 cp = fop_in(homed$ & paln$)
1516 if cp < 0 then
1517  rechp palset
1518  palset = 0: p% = c0%
1519  sp_jobpal -1, p%
1520  ErrMess 'Palette\' & paln$ & '\\not found!'
1521 else
1522  for adr = palset to palset + (sp_getcount - c1%) * c2% step c2%
1523   input#cp; c$
1524   poke_w adr, hex(c$(c2% to len(c$)))
1525  end for adr
1526  close#cp
1527 rem sp_jobownpal -1, palset
1528  setpal palset
1529 end if
1530 end def LoadPal
1531 :
1532 def proc  MenuSpotsel(xp%, yp%)
1533 loc mc, mk, s%
1534 mc = fopen(con$): if mc < 0: ert mc
1535 msetup#mc; mn_spotsel, xp%, yp%
1536 s% = mstat%(#mc; -spot%, c1%\ c0%)
1537 s% = spot%
1538 mdraw#mc
1539 mk = mcall(#mc; mk, s%)
1540 pval#mc; tprec%
1541 if tprec%(c5%) = c2% then
1542  spot% = abs(mk)
1543  if s% <> spot%: changed = changed + 1
1544  Ping ok$
1545 end if
1546 mclear#mc: close#mc
1547 end def MenuSpotsel
1548 :
1549 def proc  MenuColsel(n$, xp%, yp%, colp, coli, t%)
1550 loc ml, cl, mc, mk, s%, x%, y%, c, c$(c4%)
1551 loc ci, cp, chg
1552 rem GLObal colsq, menv%, llen, base, bpp%
1553 rem Alters parameters!
1554 rem V0.01 April 18th 2004
1555 :
1556 if colsq = 0 then
1557  colsq = flen(\colsq$)
1558  if colsq > 0 then
1559   colsq = alchp(colsq)
1560   lbytes colsq$, colsq
1561  else
1562   Burp 'illegal': ret
1563  end if
1564 end if
1565 :
1566 mc = fopen(con$): if mc < 0: ert mc
1567 msetup#mc; mn_colour, xp%, yp%
1568 minob#mc; c2%, c1%, Centre$(c6%, n$)
1569 mdraw#mc
1570 p% = mstat%(#mc; -3 to c1%)
1571 mwindow#mc; c5%! c0%
1572 paper#mc; colp: ink#mc; coli
1573 timer_led#mc; c3%, Z$(t%)
1574 mwindow#mc; c1%
1575 sprw#mc; c0%, c0%, colsq
1576 ok% = c1%: s% = c0%
1577 ci = coli: cp = colp: chg = 0
1578 colour_native
1579 rep ml
1580  mk = mcall(#mc; mk, s%)
1581  sel on mk
1582   = -2: rem Exit
1583     pval#mc; tprec%
1584     retrac = (tprec%(c5%) = c2%)
1585     chg = 0
1586     exit ml
1587   = -3: rem Paper
1588     TogglePink mk
1589     ok% = c1%
1590   = -4: rem Ink
1591     TogglePink mk
1592     ok% = c2%
1593   = 1: rem Colour square
1594      pval#mc; tprec%
1595      x% = tprec%(14): y% = tprec%(15)
1596      rep cl
1597       rdpt#mc; menv%, x%, y%
1598       pval#mc; tprec%
1599       if tprec%(c2%) <> c0%: exit cl: rem Out of this apwin
1600       if tprec%(c5%) = c2% then
1601        if ok% = c1%
1602         cp = c: TogglePink -4
1603         ok% = c2%
1604        else
1605         if ok% = c0%
1606          if mstat%(#mc; -3): ok% = c1%: else : ok% = c2%
1607          next cl
1608         else
1609          ci = c: TogglePink -3
1610          ok% = c1%
1611         end if
1612        end if
1613        chg = 1
1614       else
1615        if tprec%(c5%) = c1% then
1616         if ok% = c1%: cp = c: else : ci = c
1617         chg = 1
1618         ok% = c0%
1619         exit cl: rem End colour select
1620        else
1621         if ok% = c0%: exit cl
1622        end if
1623       end if
1624       if bpp% = c1% then
1625        c = peek(base + llen * y% + x%)
1626       else
1627        c = peek_w(base + llen * y% + x% + x%)
1628        if disp_type = 32: c = PCBO(c)
1629       end if
1630       mwindow#mc; c5%! c0%
1631       if ok% = c1% then
1632        paper#mc; c
1633       else
1634        ink#mc; c
1635       end if
1636       timer_led#mc; c3%, Z$(t%)
1637      end rep cl
1638      s% = c0%
1639   = -1025: rem DO Counter
1640     Ping ok$: exit ml
1641   = remainder : Burp 'illegal'
1642  end sel
1643 end rep ml
1644 mclear#mc: close#mc
1645 if chg then
1646  changed = changed + chg
1647  redraw = 1
1648  if disp_type = 32: ci = PCBO(ci): cp = PCBO(cp)
1649  coli = nat2rgb(ci): colp = nat2rgb(cp)
1650 end if
1651 colour_24
1652 end def MenuColsel
1653 :
1654 def proc  TogglePink(k)
1655 loc k1, k2
1656 if k = -3: k1 = -3: k2 = -4: else : k2 = -3: k1 = -4
1657 s% = mstat%(#mc; k2, c0%\ c0%)
1658 s% = mstat%(#mc; k1, c1% to c0%)
1659 end def TogglePink
1660 :
1661 def fn  PCBO(n)
1662 loc c$(c4%)
1663 rem Little-endian for QPC
1664 c$ = hex$(n, _w%)
1665 ret hex(c$(c3% to c4%) & c$(c1% to c2%))
1666 rem c = c div 256 + (c mod 256) * 256: Doesnt work
1667 end def PCBO
1668 :
1669 rem     NumSel
1670 :
1671 def fn  NumSel%(xp%, yp%, st%, en%, cr%, opt$)
1672 loc nl, cn, nk, o%, n%, t%, o$(c8%)
1673 rem V0.01 Positive only
1674 :
1675 o% = cr%
1676 o$ = GetOpt$(o%, opt$)
1677 if o% < c0%: n% = st%: else : n% = o%
1678 t% = c0%
1679 cn = fopen(con$)
1680 msetup#cn; mn_numsel, xp%, yp%
1681 mitem#cn; -2, c0%, o$
1682 mdraw#cn
1683 rep nl
1684  nk = mcall(#cn; nk, c0%)
1685  pval#cn; tprec%
1686  sel on nk
1687  = -1: rem Up
1688    if tprec%(c5%) = c2% then
1689     ScrollUp #cn, c10%
1690    else
1691     ScrollUp #cn; c1%
1692    end if
1693    o% = n%
1694  = -2: rem Dial
1695    if tprec%(c5%) = c1% or tprec%(c6%) = esc% then
1696     o% = cr%: rem Discard changes
1697    end if
1698    exit nl
1699  = -3: rem Down
1700    if tprec%(c5%) = c2% then
1701     ScrollDn #cn; c10%
1702    else
1703     ScrollDn #cn; c1%
1704    end if
1705    o% = n%
1706  = -4, -5: rem Left/Right
1707    if mk = -4 then
1708     t% = (t% - c1%) mod (dimn(opt$) + c2%)
1709    else
1710     t% = (t% + c1%) mod (dimn(opt$) + c2%)
1711    end if
1712    if t% > dimn(opt$) then
1713     o% = n%
1714    else
1715     o% = cm1% - t%
1716    end if
1717    o$ = GetOpt$(o%, opt$)
1718    mitem #cn; -2, c0%, o$
1719  end sel
1720 end rep nl
1721 mclear#cn: close#cn
1722 ret o%: rem ret o$
1723 end def NumSel%
1724 :
1725 def fn  GetOpt$(p%, opt$)
1726 if p% < c0% then
1727  if dimn(opt$) = c0% then
1728   ret opt$: rem Plain variable
1729  else
1730   ret opt$(abs(p%) - c1%): rem Array
1731  end if
1732 end if
1733 ret nul$ & p%: rem Anything else is a number
1734 end def GetOpt$
1735 :
1736 def proc  ScrollUp(ch, a%)
1737 loc sul, x%, y%
1738 x% = tprec%(14): y% = tprec%(15)
1739 rdpt#ch; nsvi%, x%, y%, nstio%
1740 rep sul
1741  rdpt#ch; nsvo%
1742  pval#ch; tprec%
1743  NSInc a%
1744  s% = mstat%(#ch; -2 to c0%)
1745  if tprec%(c5%) = c0%: exit sul
1746 end rep sul
1747 t% = c1%
1748 end def ScrollUp
1749 :
1750 def proc  ScrollDn(ch, a%)
1751 loc sul, x%, y%
1752 x% = tprec%(14): y% = tprec%(15)
1753 rdpt#ch; nsvi%, x%, y%, nstio%
1754 rep sul
1755  rdpt#ch; nsvo%
1756  pval#ch; tprec%
1757  NSDec a%
1758  s% = mstat%(#ch; -2 to c0%)
1759  if tprec%(c5%) = c0%: exit sul
1760 end rep sul
1761 t% = n%
1762 end def ScrollDn
1763 :
1764 def proc  NSInc(a%)
1765 rem Subroutine of NumSel%
1766 n% = (n% + a%) mod (en% + c1%)
1767 if n% < st%: n% = st%
1768 mitem#cn; -2, c0%, nul$ & n%
1769 end def NSInc
1770 :
1771 def proc  NSDec(a%)
1772 rem Subroutine of NumSel%
1773 n% = (n% - a%) mod (en% + c1%)
1774 if n% < st%: n% = en%
1775 mitem#cn; -2, c0%, nul$ & n%
1776 end def NSDec
1777 :
1778 rem     End Numsel
1779 :
1780 def fn  MenuScore(xp%, yp%)
1781 loc ml, cl, cm, mk, s%, chg
1782 rem V0.01 May 10th 2004
1783 rem V0.02 March 20th 2005 added Help
1784 :
1785 chg = 0
1786 cm = fopen(con$): if cm < 0: ert cm
1787 msetup#cm; mn_score, xp%, yp%
1788 mitem#cm; -4, spr%, sp_spotn(spot%)
1789 mitem#cm; -5, spr%, sp_spotn(spot%)
1790 mitem#cm; -6, spr%, sp_spotn(spot%)
1791 mitem#cm; -7, spr%, sp_spotn(spot%)
1792 s% = mstat%(#cm; -4, gme_cup%\ c0%)
1793 s% = mstat%(#cm; -5, gme_jst%\ c0%)
1794 s% = mstat%(#cm; -6, gme_jsd%\ c0%)
1795 s% = mstat%(#cm; -7, autosave\ c0%)
1796 mdraw#cm
1797 s% = c0%
1798 rep ml
1799  mk = mcall(#cm; mk, s%)
1800  sel on mk
1801   = -2: Help#cm; 'hlp_score'
1802     next ml
1803   = -3: rem Exit
1804     if chg = 0 then
1805      pval#cm; tprec%
1806      retrac = (tprec%(c5%) = c2%)
1807     else
1808      Ping ok$
1809     end if
1810     exit ml
1811   = -4: rem Count up
1812     s% = mstat%(#cm; mk)
1813     gme_cup% = s%
1814   = -5: rem Jump start
1815     s% = mstat%(#cm; mk)
1816     gme_jst% = s%
1817   = -6: rem Discard
1818     s% = mstat%(#cm; mk)
1819     gme_jsd% = s%
1820   = -7: rem Autosave
1821     s% = mstat%(#cm; mk)
1822     autosave = s%
1823  end sel
1824  chg = 1
1825 end rep ml
1826 mclear#cm: close#cm
1827 ret chg
1828 end def MenuScore
1829 :
1830 def proc  UpdtGame
1831 loc i%, j%, s%, it%
1832 for i% = c0% to dimn(game%)
1833  for j% = c0% to dimn(game%(c0%))
1834   it% = -4 - (i% * (dimn(game%(c0%)) + c1%) + j%)
1835   sel on it%
1836    = -4, -10, -16: rem Spots
1837      rem Current game
1838      if gme_chg: game%(i%, j%) = c0%: rem No game selected => game changed
1839      mitem#cm; it%, spr%, sp_spotn(spot%)
1840      s% = mstat%(#cm; it%, game%(i%, j%)\ c0%)
1841    = -5, -7, -11, -13, -17, -19: rem Grid x, y
1842      mitem#cm; it%, c0%, nul$ & game%(i%, j%)
1843    = -6, -12, -18: rem x
1844      rem If x selected then gridy is unavailable
1845      if game%(i%, c1%) <> game%(i%, c3%) then
1846       rem But if x/y size different then unlock
1847       game%(i%, j%) = c0%
1848      end if
1849      if game%(i%, j%) = c1%: st% = mstat%(#cm; it% - c1%, cm1%\ c0%)
1850    = -8, -14, -20: rem Mines
1851      o$ = GetOpt$(game%(i%, j%), gameM$)
1852      mitem#cm; it%, c0%, o$
1853    = -9, -15, -21: rem Timer
1854      o$ = GetOpt$(game%(i%, j%), gameT$)
1855      mitem#cm; it%, c0%, o$
1856   end sel
1857  end for j%
1858 end for i%
1859 end def UpdtGame
1860 :
1861 def fn  MenuGame(xp%, yp%)
1862 loc i%, j%, ml, cl, cm, mk, s%, st%, chg, o$(c6%)
1863 rem V0.01 May 10th 2004
1864 rem V0.02 March 14th 2005 Removed default game
1865 rem V0.03 March 19th 2005 Added Help
1866 rem V0.04 March 26th 2005 Fixed positioning. External changes reflected
1867 :
1868 chg = 0
1869 cm = fopen(con$): if cm < 0: ert cm
1870 msetup#cm; mn_game, xp%, yp%
1871 UpdtGame
1872 rem Save now
1873 s% = mstat%(#cm; -22, cm1%\ c0%)
1874 mdraw#cm
1875 s% = c0%
1876 rep ml
1877  mk = mcall(#cm; mk, s%)
1878  i% = abs(mk + c4%) div (dimn(game%(c0%)) + c1%)
1879  j% = abs(mk + c4%) mod (dimn(game%(c0%)) + c1%)
1880  sel on mk
1881   = -2: Help#cm; 'hlp_game'
1882   = -3: rem Exit
1883     if chg = 0 then
1884      pval#cm; tprec%
1885      retrac = (tprec%(c5%) = c2%)
1886     else
1887      Ping ok$
1888     end if
1889     exit ml
1890   = -4, -10, -16: rem Select game
1891     pval#cm; tprec%
1892     s% = mstat%(#cm; mk)
1893     if gme_chg and tprec%(c5%) = c1% then
1894      game%(i%, c0%) = c1%
1895      game%(i%, c1%) = xdim%
1896      game%(i%, c2%) = xdim% = ydim%
1897      game%(i%, c3%) = ydim%
1898      if gme_mcauto% = on%: game%(i%, c4%) = cm1%: else : game%(i%, c4%) = mcount%
1899      if tmr_use% = off% then
1900       game%(i%, c5%) = -3
1901      else : if tmr_auto% = on% then
1902       game%(i%, c5%) = cm1%
1903      else : if tmr_cup% = on% then
1904       game%(i%, c5%) = -2
1905      else : game%(i%, c5%) = tmr_start%
1906      end if : end if : end if
1907 rem if tmr_lrc% = on%: game%(i%, c5%) = -4 Not yet implemented
1908      gme_chg = 0: UpdtGame
1909     else
1910      for j% = -16, -10, -4: st% = mstat%(#cm; j%, c0%\ c0%)
1911      for j% = c0% to dimn(game%): game%(j%, c0%) = c0%
1912      st% = mstat%(#cm; mk, s%\ c0%)
1913      game%(i%, c0%) = c1%: s% = c1%
1914      if game%(i%, c1%) > maxx%: game%(i%, c1%) = maxx%: rem No bigger that max
1915      if game%(i%, c3%) > maxy%: game%(i%, c3%) = maxy%
1916      gme_chg = 0
1917     end if
1918     redraw = 1
1919     if tprec%(c5%) = c2%: exit ml
1920   = -5, -11, -17: rem Grid x
1921     game%(i%, j%) = NumSel%(-1, -1, c10%, maxx%, game%(i%, j%), game%(i%, j%))
1922     mitem#cm; mk, c0%, nul$ & game%(i%, j%)
1923     if game%(i%, c2%) = c1% then
1924      mitem#cm; mk - c2%, c0%, nul$ & game%(i%, j%)
1925      game%(i%, c3%) = game%(i%, j%)
1926     end if
1927     if game%(i%, c4%) >= c0% then
1928      Maxminm i%: rem Calculate max/min no. mines
1929      if game%(i%, c4%) > maxm%: game%(i%, c4%) = maxm%
1930      if game%(i%, c4%) < minm%: game%(i%, c4%) = minm%
1931      mitem#cm; mk - c3%, c0%, nul$ & game%(i%, c4%)
1932     end if
1933     if game%(i%, c0%) = c1%: redraw = 1: else : chg = 1
1934   = -7, -13, -19: rem Grid y
1935     game%(i%, j%) = NumSel%(-1, -1, c10%, maxy%, game%(i%, j%), game%(i%, j%))
1936     mitem#cm; mk, c0%, nul$ & game%(i%, j%)
1937     if game%(i%, c2%) = c1% then
1938      mitem#cm; mk + c2%, c0%, nul$ & game%(i%, j%)
1939      game%(i%, c1%) = game%(i%, j%)
1940     end if
1941     if game%(i%, c4%) >= c0% then
1942      Maxminm i%: rem Calculate max/min no. mines
1943      if game%(i%, c4%) > maxm%: game%(i%, c4%) = maxm%
1944      if game%(i%, c4%) < minm%: game%(i%, c4%) = minm%
1945      mitem#cm; mk - c1%, c0%, nul$ & game%(i%, c4%)
1946     end if
1947     if game%(i%, c0%) = c1%: redraw = 1: else : chg = 1
1948   = -6, -12, -18: rem x
1949     s% = mstat%(#cm; mk)
1950     game%(i%, j%) = s%
1951     if s% = c1% then
1952      st% = mstat%(#cm; mk - c1%, cm1%\ c0%)
1953     else
1954      st% = mstat%(#cm; mk - c1%, c0%\ c0%)
1955     end if
1956     chg = 1
1957   = -8, -14, -20: rem Mines
1958     Maxminm i%: rem Calculate max/min no. mines
1959     game%(i%, j%) = NumSel%(-1, -1, minm%, maxm%, game%(i%, j%), gameM$)
1960     o$ = GetOpt$(game%(i%, j%), gameM$)
1961     mitem#cm; mk, c0%, o$
1962     s% = c0%
1963     if game%(i%, c0%) = c1%: redraw = 1: else : chg = 1
1964   = -9, -15, -21: rem Timer
1965     game%(i%, j%) = NumSel%(-1, -1, c5%, 999, game%(i%, j%), gameT$)
1966     o$ = GetOpt$(game%(i%, j%), gameT$)
1967     mitem#cm; mk, c0%, o$
1968     s% = c0%
1969     if game%(i%, c0%) = c1%: redraw = 1: else : chg = 1
1970   = -22: rem Save now
1971     CfgSave: Ping 'saved'
1972     s% = cm1%: chg = 0
1973  end sel
1974  if chg or redraw: st% = mstat%(#cm; -22, c0%\ c0%)
1975 end rep ml
1976 mclear#cm: close#cm
1977 if redraw: chg = 1
1978 TechnicalResume
1979 ret chg
1980 end def MenuGame
1981 :
1982 def proc  Maxminm(g%)
1983 rem Calculate max and min number of mines for this grid size
1984 rem This to avoid crash (max too large) or stack overflow (min too small)
1985 minm% = game%(g%, c1%) * game%(g%, c3%) div 12: rem Min mines
1986 maxm% = minm% * c4%: rem Max mines
1987 end def Maxminm
1988 :
1989 def proc  SetGame
1990 loc i%, g%
1991 g% = cm1%
1992 rem Find current game
1993 for i% = c0% to dimn(game%)
1994  if game%(i%, c0%) = c1%: g% = i%: exit i%
1995 end for i%
1996 if g% = cm1%: g% = c0%: rem Nine found: Default is game #0
1997 grdx% = game%(g%, c1%) - c1%: grdy% = game%(g%, c3%) - c1%
1998 if game%(g%, c4%) = cm1% then
1999  gme_mcauto% = on%
2000 else
2001  gme_mcauto% = off%
2002  mcount% = game%(g%, c4%)
2003 end if
2004 i% = game%(g%, c5%)
2005 sel on i%
2006  = cm1%: rem Auto
2007    tmr_use% = on%
2008    tmr_auto% = on%
2009    tmr_cup% = off%
2010  = -2: rem Count time
2011    tmr_use% = on%
2012    tmr_cup% = on%
2013    tmr_auto% = off%
2014  = -3: rem No timer
2015    tmr_use% = off%
2016    tmr_auto% = off%
2017    tmr_cup% = off%
2018  = remainder : rem Seconds
2019    tmr_use% = on%
2020    tmr_auto% = off%
2021    tmr_cup% = off%
2022    tmr_start% = game%(g%, c5%)
2023 end sel
2024 end def SetGame
2025 :
2026 def proc  MenuStats
2027 loc wl, cm, mk
2028 loc xs%, ys%, dx%, i%, j%
2029 TechnicalPause
2030 xs% = xsize% - 20: ys% = ysize% - 60
2031 cm = fopen(con$): ert cm
2032 msetup#cm; mn_info, prec%(c10%) + c10%, prec%(11) + 40, xs%, ys%
2033 minob#cm; c2%, c1%, 'Stats'
2034 mdraw#cm; mn_info
2035 mwindow#cm; c6%! c0%
2036 over#cm; c0%
2037 xs% = xs% - c4%: ys% = ys% - 26
2038 dx% = xs% div 50: c% = c0%
2039 for i% = c0% to xs% - dx% step dx%
2040  j% = rnd(c% to ys%): c% = c% + c2%
2041  wm_block#cm; dx%, j%, i%, ys% - j%, sp_infwinfg%
2042 end for i%
2043 wm_strip#cm; sp_infwinbg%
2044 cursor#cm; (xs% - 126) div c2%, ys% div c2%
2045 print#cm; ' Stats not available '
2046 rep wl
2047  mk = mcall(#cm; mk, c0%)
2048  sel on mk
2049   = -2: Help#cm; 'hlp_stats'
2050   = -3: Ping ok$: exit wl
2051  end sel
2052 end rep wl
2053 mclear#cm: close#cm
2054 TechnicalResume
2055 end def MenuStats
2056 :
2057 def proc  GameLoose
2058 TimerStop
2059 game = lost
2060 mitem#ch%; li_new%, spr%, sp_sour
2061 end def GameLoose
2062 :
2063 def proc  GameWin
2064 TimerStop
2065 game = won
2066 Ping 'win'
2067 mitem#ch%; li_new%, spr%, sp_cool
2068 end def GameWin
2069 :
2070 def proc  GameStart
2071 loc grd%
2072 grd% = grdx% * grdy%
2073 moves% = off%: rem No moves have been made
2074 if 0 then
2075  rem ####
2076 if autosave then
2077  sco = GetMagic(fnmscore$, mgDmsc$)
2078  if sco < 0: ErrMess 'Opening score file\' & sco: ret
2079  put#sco\ 2E9; date, grd%, c0%, mcount%, mleft%
2080  close#sco
2081 end if
2082 end if
2083 TimerStart
2084 game = playing
2085 end def GameStart
2086 :
2087 def proc  GameStop
2088 rem Stop game = loose game except in certain circumstances
2089 if moves% = on% then
2090  game = lost
2091 else
2092  if gme_jsd% = off% and game = playing then
2093   game = stopped
2094  else
2095   game = lost
2096  end if
2097 end if
2098 end def GameStop
2099 :
2100 def fn  GetScore
2101 sco = GetMagic(fnmscore$, mgDmsc$)
2102 if sco < 0: ret sco
2103 rem ###
2104 close#sco
2105 end def GetScore
2106 :
2107 def fn  GetMagic(fnm$, mg$)
2108 loc i%, ch
2109 ch = fopen(fnm$): if ch < 0: ret ch
2110 for i% = c1% to len(mg$)
2111  if inkey$(#ch; cm1%) <> mg$(i%): close#ch: ret -12
2112 end for i%
2113 dummy% = code(inkey$(#ch; cm1%)): rem Final lf
2114 ret ch
2115 end def GetMagic
2116 :
2117 def proc  GameMenu
2118 redraw = 0
2119 xp% = prec%(c10%) + 90: yp% = prec%(11) + 38
2120 if MenuGame(xp%, yp%): Ping ok$
2121 if redraw then
2122  SetGame
2123  NewWin prec%(c10%) - c2%, prec%(11) - c2%
2124 end if
2125 end def GameMenu
2126 :
2127 rem     Messages start
2128 :
2129 def fn  PreWarn(msg$, ch1$, ch2$, ch3$)
2130 loc adr, r, xo%, yo%, par$
2131 Burp 'warn'
2132 xo% = (scr_xlim(#ch%) - 240) div c2%
2133 yo% = (scr_ylim(#ch%) - 100) div c2%
2134 adr = alchp(4)
2135 par$ = hex$(adr, 32) & hsh$ & cfname$ & spc$ & cfver$ & hsh$ & msg$ & hsh$ & ch1$ & hsh$ & ch2$ >>
      & hsh$ & ch3$
2136 ew msgprg$; hex$(240, _w%) & hex$(100, _w%) & hex$(xo%, _w%) & hex$(yo%, _w%) & hex$(c0%, 32) & >>
      par$
2137 r = peek_l(adr): rechp adr
2138 ret r
2139 end def PreWarn
2140 :
2141 def proc  ErrMess(tx$)
2142 loc i%, ce, c%, x%, y%
2143 Burp 'warn'
2144 ce = fopen(con$)
2145 rem Count lines in message (max == 6, not checked)
2146 c% = c0%
2147 for i% = c1% to len(tx$)
2148  if tx$(i%) = bks$: c% = c% + c1%
2149 end for i%
2150 if c% < c3%: c% = c3%
2151 y% = prec%(11) + (prec%(c9%) - (c% * c10% + 48)) div c2%
2152 x% = prec%(c10%) + (prec%(c8%) - 136) div c2%
2153 mdraw#ce; mn_err, x%, y%, 136, 56 + c% * c10%
2154 mwindow#ce; c3%! c0%: wm_ink#ce; sp_errfg%
2155 Split#ce, 21, tx$
2156 er = mcall(#ce): mclear#ce: close#ce
2157 end def ErrMess
2158 :
2159 def proc  Split(ch%, w%, t$)
2160 loc wl, p%, s%
2161 rem Slice lines at \ and print centred
2162 rem v0.01 March 25th 2005
2163 p% = c1%
2164 rep wl
2165  if p% > len(t$): exit wl
2166  s% = '\' instr t$(p% to len(t$))
2167  if s% > 0 then
2168   print#ch%; Centre$(w%, t$(p% to p% + s% - c2%))
2169   p% = p% + s%
2170  else
2171   print#ch%;! Centre$(w%, t$(p% to len(t$)))
2172   exit wl
2173  end if
2174 end rep wl
2175 end def Split
2176 :
2177 def proc  Help(hc%, hlp$)
2178 loc t%
2179 t% = tpause%
2180 if t% = c0%: TechnicalPause
2181 MessWin#hc%; hlpxs%, hlpys%, hlpprg$, homed$ & hlp$ & hx$, prec%
2182 if t% = c0%: TechnicalResume
2183 end def Help
2184 :
2185 def proc  About
2186 Ping 'startup'
2187 if Choose%(#ch%; 'About', Centre$(abtcx%, cfname$ & spc$ & cfver$) & '\' & Centre$(abtcx%, ' >>
     ©pjwitte 2oo4'), ok$, 'Readme', nul$) = c2% then
2188  Help#ch%; 'Readme'
2189 end if
2190 Ping ok$
2191 end def About
2192 :
2193 def fn  Choose%(cc%, tit$, msg$, ch1$, ch2$, ch3$)
2194 loc adr, r
2195 TechnicalPause
2196 if prec%(c8%) <= wrnxs% then
2197  prec%(c9%) = wrnys% + wrnys%
2198  adr = alchp(4)
2199  MessWin#cc%; wrnxs%, wrnys%, msgprg$, hex$(adr, 32) & hsh$ & tit$ & hsh$ & msg$ & hsh$ & ch1$  >>
     & hsh$ & ch2$ & hsh$ & ch3$, prec%
2200  r = peek_l(adr): rechp adr
2201 else
2202  r = item_select(tit$, msg$, ch1$, ch2$, ch3$)
2203 end if
2204 TechnicalResume
2205 ret r
2206 end def Choose%
2207 :
2208 def fn  Warn(msg$, ch1$, ch2$, ch3$)
2209 Burp 'warn'
2210 ret Choose%(#ch%; 'Warning', msg$, ch1$, ch2$, ch3$)
2211 end def Warn
2212 :
2213 def fn  WarnGame
2214 if game = playing and moves% = on% then
2215  if Warn(Centre$(39, 'Game in progress!') & '\If you continue the game is lost!','Resume', ' >>
     Quit game',  nul$) = 2 then
2216   Burp 'loose': GameLoose
2217   ret 1
2218  else
2219   ret 0
2220  end if
2221 else
2222  if moves% = off%: TechnicalPause
2223 end if
2224 ret 1
2225 end def WarnGame
2226 :
2227 rem <-                          MessWin                       ->
2228 :
2229 def proc  MessWin(ch%, sx%, sy%, prg$, par$, pr%)
2230 loc hl, id, xo%, yo%, p$(c8%)
2231 rem Display a message window larger than the job window
2232 rem V0.01 February 6th 2005
2233 rem V0.02 March 25th 2005   Supports jobownpal
2234 :
2235 rem Parameters:
2236 rem window x and y size, display program name, additional
2237 rem parameter, current pointer record
2238 :
2239 rem The job at the other end must parse the following
2240 rem standard parameters (in consecutive hex):
2241 rem sizex.w, sizey.w, xorig.w, yorig.w, syspal.b
2242 rem The calling routine can append additional parameters
2243 rem in par$
2244 :
2245 xo% = pr%(c10%) + pr%(c8%) div c2%
2246 yo% = pr%(11) + pr%(c9%) div c2%
2247 xo% = xo% - (sx% div c2%): if xo% < c0%: xo% = c0%
2248 yo% = yo% - (sy% div c2%): if yo% < c0%: yo% = c0%
2249 if palno = 4: p$ = hex$(palset, 32): else : p$ = hex$(palno, 32)
2250 if (xo% + sx% + c4%) > scr_xlim(#ch%): xo% = scr_xlim(#ch%) - sx% - c4%
2251 if (yo% + sy% + c4%) > scr_ylim(#ch%): yo% = scr_ylim(#ch%) - sy% - c4%
2252 id = exf(prg$; hex$(sx%, _w%) & hex$(sy%, _w%) & hex$(xo%, _w%) & hex$(yo%, _w%) & p$ & par$)
2253 :
2254 rep hl
2255  rdpt#ch%; mwtv%
2256  if JobLives(id) then
2257   ptop#ch%; id
2258  else
2259   exit hl
2260  end if
2261 end rep hl
2262 end def MessWin
2263 :
2264 def fn  JobLives(jid)
2265 loc nj, n
2266 if jid = 0: ret 1
2267 rep nj
2268  n = nxjob(n, 0)
2269  if n = 0 or n = jid: exit nj
2270 end rep nj
2271 ret n
2272 end def JobLives
2273 :
2274 rem             Messages end
2275 :
2276 def fn  Spra$(spr): ret '@»' & lin2str$(spr): end def
2277 :
2278 def proc  Ping(nm$)
2279 rem Nice sound
2280 if sound = 2 then
2281  if ftest(snd$ & nm$ & sx$) = 0 then
2282   killsound: soundfile snd$ & nm$ & sx$
2283  else
2284   beep c2%, c2%
2285  end if
2286 else
2287  if sound: beep c2%, c2%
2288 end if
2289 end def Ping
2290 :
2291 def proc  Burp(nm$)
2292 rem Bad sound
2293 if sound = 2 then
2294  if ftest(snd$ & nm$ & sx$) = 0 then
2295   killsound: soundfile snd$ & nm$ & sx$
2296  else
2297   beep 999, 999
2298  end if
2299 else
2300  if sound: beep 999, 999
2301 end if
2302 end def Burp
2303 :
2304 def proc  SetSound(s)
2305 if s then
2306  if ssspresent: sound = 2: else : sound = 1
2307 else
2308  sound = 0
2309 end if
2310 end def SetSound
2311 :
2312 def proc  SetDefaults
2313 hit% = c1%: do% = c2%:    rem Mouse buttons
2314 SetSound 1
2315 palno = 0:                rem palette number
2316 rem tmr_start% = 30:          rem Timer start time
2317 tmr_fact = 25:            rem Timer time factor
2318 tmr_end% = c0%:           rem Timer end time (count down)
2319 tmr_use% = on%:           rem Use timer
2320 tmr_cup% = off%:          rem Timer count up: 0 = down (default)
2321 tmr_auto% = on%:          rem Autocalculate time
2322 tmr_pause% = off%
2323 tmr_wru% = 989
2324 tmr_wrd% = 6
2325 spot% = c4%:              rem spot colour default
2326 butbf = bfpresent:        rem Use button frame if available..
2327 butx% = cm1%: buty% = cm1%: rem ..if not available use this position
2328 saveonx = 0:              rem Save on exit
2329 gme_cup% = c0%:           rem Game scoring variables
2330 gme_jst% = c0%
2331 gme_jsd% = c0%
2332 gme_mcauto% = on%:        rem Auto mine count
2333 gme_chg = 0:              rem Game changed outside game menu flag
2334 autosave = 1:             rem Autosave score after each game
2335 :
2336 palno = 4:                rem Defaults to own palette
2337 xpos% = cm1%: ypos% = cm1%: rem Window at pointer position
2338 :
2339 col_imc = '15772200':     rem Counter ink = $F0AA28 - orange
2340 col_pmc = 0:              rem Counter paper
2341 col_itm = '15772200':     rem Timer ink = $F0AA28 - orange
2342 col_ptm = 0:              rem Timer paper black
2343 col_itw = '16711680':     rem Timer ink = $FF0000 - red
2344 col_ptw = -1:             rem Warning paper white
2345 col_ito = '8421504':      rem Timeout ink $808080 - dark grey
2346 col_pto = '15790320':     rem Timeout paper $F0F0F0 - light grey
2347 end def SetDefaults
2348 :
2349 def proc  PrePreWarn(tx$)
2350 ch% = fopen("con_264x70"): Burp 'loose'
2351 border#ch%; 1, 255: paper#ch%; 2: cls#ch%
2352 print#ch%; Centre$(44, cfname$ & spc$ & cfver$)
2353 print#ch%; Centre$(44, fill$('-', len(cfname$ & spc$ & cfver$)))\\
2354 print#ch%; Centre$(44, tx$)\\
2355 print#ch%; Centre$(44, 'Press any key to quit')
2356 pause#ch%: quit
2357 end def PrePreWarn
2358 :
2359 def proc  TstSSS
2360 loc adr
2361 rem GLOBal ssspresent
2362 rem Test for presence of Sampled Sound System
2363 rem V0.01 pjwitte 2oo5
2364 :
2365 adr = alchp(26)
2366 poke_l adr + 0, hex("43fa0016"): rem lea.l result,a1
2367 poke_l adr + 4, hex("26780070"): rem move.l exv_i4,a3
2368 poke_l adr + 8, hex("0cab5353"): rem cmp.l #sss.flag,-8(a3)
2369 poke_l adr + 12, hex("5353fff8")
2370 poke_l adr + 16, hex("57e90001"): rem seq 1(a1)
2371 poke_w adr + 20, hex("7000")    : rem moveq#0,d0
2372 poke_w adr + 22, hex("4e75")    : rem rts
2373 poke_w adr + 24, 0              : rem ds.w 1
2374 call adr
2375 ssspresent = peek_w(adr + 24)
2376 rechp adr
2377 end def TstSSS
2378 :