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