D-Miner

100 rem $$chan=9
102 rem $$stak=30000
104 rem $$heap=2048
106 rem rem $$asmb=win2_rxt_snd_sound_bin,0,10
108 rem $$asmb=win4_TKS_TMR_TIMER_BIN,0,10
110 rem rem $$asmb=win1_prg_game_mine_ptrmen_cde,0,82
112 rem $$asmb=win1_prg_game_mine_MINES_BIN,0,10
114 :
116 EXT_PROC 'BUTFREE'
118 EXT_FN 'BUTUSE%', 'CFHOME$', 'CFNAME$', 'CFVER$', 'LIN2STR$'
120 EXT_FN 'MN_COLOUR', 'MN_CONFIG', 'MN_ERR', 'MN_GAME', 'MN_INFO'
122 EXT_FN 'MN_LOOK', 'MN_MINES', 'MN_NUMSEL', 'MN_QSEL', 'MN_SCORE'
124 EXT_FN 'MN_SPOTSEL', 'MN_TIMER', 'NAT2RGB'
126 EXT_FN 'SP_BLANK', 'SP_BOMB', 'SP_BOMBE', 'SP_BOMBX', 'SP_COOL'
128 EXT_FN 'SP_FLAG', 'SP_N', 'SP_OOOO', 'SP_SLEEP', 'SP_SMILE'
130 EXT_FN 'SP_SOUR', 'SP_SPOTN', 'SP_SQUARE', 'SP_TICK', 'SP_WINK'
132 EXT_FN 'TSTSSS%', 'TSTTHG%'
134 EXT_PROC 'TIMER_DISP', 'TIMER_KILL', 'TIMER_LED', 'TIMER_PAUSE'
136 EXT_PROC 'TIMER_SET', 'TIMER_START', 'TIMER_STOP', 'WL_DRAW_LED'
138 EXT_FN 'TIMER_INIT', 'TIMER_STATE%', 'TIMER_TIME%'
140 EXT_PROC 'KILLSOUND', 'SOUNDFILE'
142 :
144 rem Prepare two versions:
146 rem 1) Mines_bin, Timer_bin
148 rem 2) The above + sound_bin, ptrmen_cde
150 :
152 rem D-Miner
154 :
156 rem Minesweeper Qlone
158 rem ©pjwitte 2oo4++
160 rem V 0.25, 2023 May 27
162 :
164 rem If not compiled
166 IF PEEK$(\\-4, 4) = 'SBAS' THEN
168  LRESPR 'win1_prg_game_mine_mines_bin'
170  LRESPR 'win4_TKS_TMR_TIMER_BIN'
172 END IF
174 :
176 RESTORE
178 :
180 rem     Constants
182 :
184 c0% = 0: c1% = 1: c2% = 2: c3% = 3: c4% = 4: c5% = 5
186 c6% = 6: c7% = 7: c8% = 8: c9% = 9: c10% = 10: cm1% = -1
188 nul$ = '': spc$ = ' ': esc% = 27: hsh$ = '#': bks$ = '\'
190 ok$ = 'Ok'
192 :
194 con$ = 'con_': scr$ = 'scr_'
196 on% = c1%: off% = c0%
198 :
200 sqsz% = 16:               rem square size
202 spr% = -2
204 minx% = c9%: miny% = c9%: rem min size
206 :
208 sp_litemavabg%  = 520: rem Loose item available background
210 sp_litemavafg%  = 521: rem Loose item available foreground
212 sp_litemselbg%  = 522: rem Loose item selected background
214 sp_litemselfg%  = 523: rem Loose item selected foreground
216 sp_litemunabg%  = 524: rem Loose item unavailable background
218 sp_litemunafg%  = 525: rem Loose item unavailable foreground
220 sp_appbg%       = 535: rem Application window background
222 sp_infwinbg%    = 527: rem Information window background
224 sp_infwinfg%    = 528: rem Information window foreground
226 sp_buthigh%     = 548: rem Button highlight
228 sp_butbd%       = 549: rem Button border
230 sp_butbg%       = 550: rem Button background
232 sp_butfg%       = 551: rem Button foreground
234 sp_errbg%       = 556: rem Error message background
236 sp_errfg%       = 557: rem Error message foreground
238 :
240 rem     Init global variables
242 :
244 DIM prec%(16):  rem pointer record
246 DIM tprec%(16): rem Temporary prec%
248 grdx% = c9%: grdy% = c9%: rem default initial size
250 mencon = 65536
252 tpause% = c0%:            rem Technical pause flag
254 :
256 DIM game%(c2%, c5%)
258 FOR i% = c0% TO c2%
260  FOR j% = c0% TO c5%: READ game%(i%, j%)
262 END FOR i%
264 rem  c   x  X   y   m   t
266 DATA 0, 10, 1, 10, -1, -1: rem games 1..3
268 DATA 1, 15, 1, 15, -1, -1: rem Current
270 DATA 0, 20, 1, 20, -1, -1
272 DIM gameT$(c2%, c6%)
274 FOR i% = c0% TO c2%: READ gameT$(i%)
276 DATA 'Auto', 'Timer', 'None'
278 gameM$ = 'Auto'
280 :
282 DIM colour$(c3%, c6%)
284 FOR i% = 0 TO c3%: READ colour$(i%)
286 DATA 'Red','Green','Orange','Blue'
288 :
290 li_move% = -1:  rem wmov button - internal
292 li_resz% = -2:  rem resize button
294 li_zzz%  = -3:  rem zleep
296 li_quit% = -4:  rem quit
298 li_new%  = -5:  rem new game
300 li_conf% = -6:  rem config menu
302 li_stat% = -7:  rem stats menu
304 li_game% = -8:  rem game menu
306 li_help% = -9:  rem help
308 li_info% =-10:  rem about
310 :
312 redraw = 0
314 lost = -1: playing% = 0: won = 1: stopped = 2: paused = 3
316 game = stopped: laststate = game
318 tmi_use% = -4:  rem Timer loose items
320 tmi_aut% = -5:  rem Auto
322 tmi_cup% = -6:  rem Count up
324 tmi_cdn% = -7:  rem Countdown
326 tmi_lrc% = -14: rem Last record
328 tmi_dgs% = -8:  rem Digits start
330 tmi_dge% = -13: rem Digits end
332 tmw_dg1% = 11: tmw_dg3% = 13: rem Timer digit windows 1..3
334 wmcnt%   = c4%: rem Mine count window
336 wtime%   = c2%: rem Timer window
338 mapp%    = c1%: rem main application window
340 tvx%     = 4 + 16:  rem Escape termination vector
342 immediate% = 48: rem Immediate return
344 mvec%      = 11: rem Normal
346 menv% = c1% + c8%: rem For colour picker
348 nsvi% = c4%: nsvo% = 32 + c4%: rem Term for NumSel
350 nstio% = 30:    rem Key repeat delay for numsel
352 bomb%    = c9%:  rem Code for mine: 0 = blank, 1..8
354 events% = c1% + c2%: rem 1 => timed out, 2 => warning
356 tio% = cm1%:     rem Timeout
358 tmr_chg = 0:     rem Timer changed flag
360 changed = 0:     rem Overall changed flag
362 butsx% = 64: butsy% = 14: rem Button
364 butsprx% = 48: butch = 0
366 but_vi% = 33: but_vo% = 17: rem Return vectors for button
368 mwtv% = 32: _w% = 16:       rem MessWin stuff
370 hlpxs% = 480: hlpys% = 180: rem Help stuff
372 abtxs% = 186: abtys% = 60: abtcx% = 29 : rem About stuff
374 wrnxs% = 250: wrnys% = 60: rem Warn stuff
376 sx$ = '_ub': rem Sound file extension
378 hx$ = '_txt': rem Help file extension
380 mgDmnr$ = 'dmnr01':       rem ID for config file
382 mgDmsc$ = 'dmsc01':       rem ID for score files
384 :
386 rem     Misc global variables
388 sqr$ = Spra$(sp_square):        rem mawitem addr
390 rem xdim%, ydim%                dimn + 1
392 rem xsize%, ysize%, xpos%, ypos%
394 rem maxx%, maxy%                max grid size in squares
396 rem mcount%, mleft%             mines
398 rem ch, ch% & ci, ci%           channels
400 rem k, awn, m%                  item number, etc
402 rem status%(), mines%(), mines$()
404 rem dummy%, er%, st%            throwaway
406 rem tmr_use%, tmr_id...         timer
408 rem events%, eve%, ev%          timer events
410 rem bfpresent                   button frame
412 rem butbf, butch, butx%, buty%, butsx%, butsy%
414 rem but_t%, but_s%
416 :
418 rem     Initialise
420 :
422 rem Fail unless hicolor
424 hicol = 0
426 IF VER$ = 'HBA' THEN
428  IF VER$(c1%) >= '3.00' AND DISP_TYPE > c8%: hicol = 1
430 END IF
432 :
434 IF hicol = 0: PrePreWarn 'This program only runs in high colour mode!'
436 IF tstthg%("Menus") <> c0%: PrePreWarn 'This program NEEDS QMenu to run'
438 rem Establish home directory
440 homed$ = cfhome$: rem Default
442 IF tstthg%("HOME") = c0% THEN
444  IF LEN(HOME_DIR$) > c4%: homed$ = HOME_DIR$
446 END IF
448 :
450 rem Test for button frame
452 x% = butsx%: y% = butsy%
454 er% = butuse%(x%, y%)
456 IF er% <> c0% THEN
458  bfpresent = 0: rem No button frame
460 ELSE
462  bfpresent = 1: butfree
464 END IF
466 :
468 ssspresent = 0: TstSSS: rem Check for sound system
470 :
472 rem     Read Configuration or use defaults
474 :
476 hlpprg$   = homed$ & 'Help_obj'  : rem Configure by editing cfg file
478 msgprg$   = homed$ & 'Choice_obj':
480 colsq$    = homed$ & 'colsq24_spr'
482 rem Fixed locations:
484 snd$ = homed$ & 'snd_': rem Location of sound files
486 paln$ = 'dminer_thm'
488 palset = 0: rem No job palette yet set
490 fnmscore$ = homed$ & 'score_txt': rem temp
492 SetDefaults
494 ch = FOPEN(con$): ERT ch: ch% = ch: rem Main window
496 COLOUR_24
498 :
500 WHEN ERRor
502  Burp 'bomb': PAUSE#ch; 50
504  IF ERNUM = -2 THEN
506   rem Probably timer got killed
508   IF tmr_id THEN
510    IF NOT JobLives(tmr_id) THEN
512     IF PreWarn('Timer job died', 'Quit', 'Repair', nul$) = 1 THEN
514      tmr_use% = off%: tmr_id = 0: Bye
516     ELSE
518      tmr_id = 0: TimerSet: TimerStart
520      RETRY ERLIN
522     END IF
524    END IF
526   END IF
528  ELSE
530   er = PreWarn('Fatal error ' & ERNUM, 'Quit', nul$, nul$)
532   Bye
534  END IF
536 END WHEN
538 :
540 er = CfgRead(homed$ & 'dminer_cfg')
542 IF FTEST(msgprg$) + FTEST(hlpprg$) + FTEST(colsq$) <> c0% THEN
544  PrePreWarn "Essential resources not found. See readme!"
546 END IF
548 IF er THEN
550  IF er < 0 THEN
552   mtx$ = 'Cannot read configuration file\\'
554  ELSE
556   mtx$ = 'Configuration file may be corrupt!\\'
558  END IF
560  IF PreWarn(mtx$ & Centre$(LEN(mtx$), "Use defaults?") & bks$ & bks$, ok$, 'Quit', nul$) = 2:  >>
    QUIT er
562  mtx$ = nul$
564  SetDefaults
566 END IF
568 Palette palno
570 :
572 rem     Set the scene
574 :
576 RANDOMISE DATE
578 ct = FOPEN(con$): ERT ct: rem Timer window
580 :
582 base = SCR_BASE(#ch)
584 llen = SCR_LLEN(#ch)
586 bpp% = (llen / SCR_XLIM(#ch))
588 :
590 SetCol#ct; col_ptm, col_itm
592 FLIM#ch; maxx%, maxy%, dummy%, dummy%
594 maxx% = (maxx% - 80) DIV sqsz%: maxy% = (maxy% - 90) DIV sqsz%
596 IF maxx% > 25: maxx% = 25
598 IF maxy% > 25: maxy% = 25
600 tmr_stat% = off%
602 tmr_id = 0:  rem Timer ID
604 :
606 SetGame
608 Winit xpos%, ypos%
610 Ping 'startup': ClearFields
612 events% = events% * 256: eve% = events%
614 :
616 rem     Main program loop
618 REPeat main
620  k = MCALLT(#ch%, eve%, tio%, k, c0%)
622  PVAL#ch%; prec%
624  SELect ON k
626  = li_move%: WMOV#ch%; -1: MWLINK#ch; wtime%, #ct: rem Reassert link!
628    RDPT#ch; immediate%: PVAL#ch; prec%
630    xpos% = prec%(c10%) - c4%
632    ypos% = prec%(11) - c2%
634    changed = changed + 1
636  = li_resz%: rem Resize interactive
638    IF WarnGame THEN
640     TimerStop: Resize: TimerShow cm1%
642    END IF
644  = li_zzz%: rem Sleep
646    DoButton
648  = li_new%: rem Refresh/New game
650    IF moves% = on% AND game = playing% THEN
652     IF WarnGame = 0: NEXT main: ELSE : PAUSE#ch; 50
654    END IF
656    IF gme_jsd% = on% THEN
658     IF WarnGame THEN
660      TimerStop: ClearFields
662      IF prec%(c5%) = do%: JumpStart: GameStart
664     END IF
666    ELSE
668     TimerStop: ClearFields
670     IF prec%(c5%) = do%: JumpStart: GameStart
672    END IF
674  = li_quit%: IF WarnGame: Bye
676  = li_game%: rem game menu
678    IF WarnGame: GameMenu
680  = li_stat%: rem stats menu
682    MenuStats -1, -1, -1, -1
684  = li_conf%: rem config menu
686    pal = palno: redraw = 0
688    xp% = prec%(c10%) - c2%: yp% = prec%(11) - c2%
690    MenuConf
692    IF redraw THEN
694     IF pal <> palno THEN
696      palno = pal
698      Palette palno
700     END IF
702     MCLEAR#ch%
704     RestoreGame xp%, yp%
706     TimerShow cm1%: rem ### TimerShow should work out correct state!
708    END IF
710  = li_help%: rem help
712    Help#ch%; 'hlp_gen'
714  = li_info%: About
716  = mencon TO 2E9: rem Game
718    IF (timer_state%(tmr_id) && c4%) <> c0% AND game = playing% AND tmr_cup% = off% AND tmr_stat% >>
     = on% THEN
720     rem Timed out unnoticed
722     Burp 'loose': GameLoose
724     NEXT main
726    END IF
728    IF game = paused THEN
730     TimerResume
732     game = laststate
734    END IF
736    IF game = playing% OR game = stopped THEN
738     GameStart
740     moves% = on%: rem Flag that a move has been made
742     awn = k: minum = MAWNUM(#ch%, awn, x%, y%)
744     IF prec%(c5%) = hit% THEN
746      Mark k, x%, y%
748     ELSE
750      IF status%(x%, y%) = c0% THEN
752       m% = mines%(x%, y%)
754       SELect ON m%
756        = bomb%: rem Hit a mine
758          IF Oooo%(k) > cm1%: EXPLODE k, x%, y%, c0%
760        = c0%: rem Blank
762          IF Oooo%(k) > cm1% THEN
764           Unravel x%, y%
766          END IF
768        = REMAINDER
770          IF Oooo%(k) > cm1% THEN
772           MAWITEM#ch%, k, spr%, sp_n(m%)
774           status%(x%, y%) = cm1%
776          ELSE
778           Ping 'release'
780          END IF
782       END SELect
784      ELSE
786       ClearAround x%, y%
788      END IF
790     END IF
792    ELSE
794     IF game = lost THEN
796      MITEM#ch%; li_new%, spr%, sp_sour
798     END IF
800    END IF
802  = -1280: rem Event
804    ev% = eve% DIV 256
806    SELect ON ev%
808    = c1%: rem Timed out
810      IF tmr_cup% = off% THEN
812       rem Doesnt timeout on countup
814       Burp 'loose': GameLoose
816      ELSE
818       TimerStop
820      END IF
822      tmr_stat% = off%
824      SetCol#ct; col_pto, col_ito
826      TimerShow timer_time%(tmr_id)
828    = c2%: rem Warning
830      Burp 'timeup': SetCol#ct; col_ptw, col_itw
832    END SELect
834    eve% = events%
836  = wtime%: rem Timer window
838    MenuTimer: gme_chg = tmr_chg
840  = REMAINDER : rem ErrMess idec$(k, 12,0)
842  END SELect
844 END REPeat main
846 :
848 rem     Init windows and grid
850 :
852 DEFine PROCedure Winit(px%, py%)
854 rem Window initialisation
856 xsize% = (grdx% + c1%) * sqsz% + c4%: IF xsize% < 140: xsize% = 140
858 ysize% = (grdy% + c1%) * sqsz% + 70: IF ysize% < 104: ysize% = 104
860 MDRAW#ch%; mn_mines, px%, py%, xsize%, ysize%
862 RDPT#ch%; immediate%: PVAL#ch%; prec%: x% = prec%(14): y% = prec%(15)
864 xpos% = prec%(c10%) - c4%
866 ypos% = prec%(11) - c2%
868 END DEFine Winit
870 :
872 DEFine PROCedure ClearFields
874 LOCal i%, j%, x%, y%, r%, c%
876 rem (Re-)setup grid, set mines and grade proximities
878 DIM mines$(grdx%, grdy%, 12), mines%(grdx%, grdy%)
880 DIM status%(grdx%, grdy%): rem Game Status fields (not Wman)
882 xdim% = grdx% + c1%: ydim% = grdy% + c1%
884 game = stopped
886 :
888 rem Calculate number of mines. Increase relative number of mines as size
890 rem grows (paranthesis to avoid overflow) (this formula grows too fast)
892 rem mcount% = ((log10(xdim%) * xdim% * xdim%) div 100) * ydim%: rem 10%++ mines
894 IF gme_mcauto%: mcount% = GetMCount%
896 mleft% = mcount%
898 ShowCount: rem Display mine count
900 TimerSet: TimerShow cm1%
902 :
904 InitGrid
906 SetMines
908 GradeSquares
910 MITEM#ch%; li_new%, spr%, sp_smile
912 END DEFine ClearFields
914 :
916 DEFine FuNction GetMCount%
918 rem Thanks to Marcel Kilgus for this one:
920 RETurn .4167 * xdim% * ydim% - 5.833 * SQRT(xdim% * ydim%) + 26.667
922 END DEFine GetMCount%
924 :
926 DEFine PROCedure InitGrid
928 rem Use caller's locals
930 rem Fill array with cover sprites and display
932 FOR i% = c0% TO grdx%
934  FOR j% = c0% TO grdy%: mines$(i%, j%) = sqr$
936 END FOR i%
938 MAWDRAW#ch%; mapp%, mines$, c0%, c0%, spr%, sqsz%, sqsz%, c0%, c0%
940 END DEFine InitGrid
942 :
944 DEFine PROCedure SetMines
946 LOCal sml
948 rem Uses caller's locals
950 rem Set given number of sprites randomly
952 c% = xdim% * grdy%
954 FOR i% = c1% TO mcount%
956  REPeat sml
958   r% = RND(c0% TO c%)
960   x% = r% MOD xdim%: y% = r% DIV xdim%
962   IF mines%(x%, y%) <> bomb%: EXIT sml
964  END REPeat sml
966  mines%(x%, y%) = bomb%
968 END FOR i%
970 END DEFine SetMines
972 :
974 DEFine PROCedure GradeSquares
976 rem Uses caller's locals
978 rem Grade squares according to mines in proximity
980 FOR x% = c0% TO grdx%
982  FOR y% = c0% TO grdy%
984   IF mines%(x%, y%) = bomb% THEN
986    FOR i% = cm1% TO c1%
988     c% = x% + i%
990     FOR j% = cm1% TO c1%
992      IF NOT (i% = c0% AND j% = c0%) THEN
994       r% = y% + j%
996       IF c% >= c0% AND c% <= grdx% AND r% >= c0% AND r% <= grdy% THEN
998        IF mines%(c%, r%) <> bomb%
1000         mines%(c%, r%) = mines%(c%, r%) + c1%
1002        END IF
1004       END IF
1006      END IF
1008     END FOR j%
1010    END FOR i%
1012   END IF
1014  END FOR y%
1016 END FOR x%
1018 END DEFine GradeSquares
1020 :
1022 DEFine PROCedure Resize
1024 LOCal x%, y%
1026 IF prec%(c5%) = c2% THEN
1028  grdx% = minx%: grdy% = miny%
1030 ELSE
1032  WSIZE#ch; x%, y%
1034  grdx% = grdx% - (x% DIV sqsz%): grdy% = grdy% - (y% DIV sqsz%)
1036  IF grdx% < minx%: grdx% = minx%
1038  IF grdx% > maxx%: grdx% = maxx%
1040  IF grdy% < miny%: grdy% = miny%
1042  IF grdy% > maxy%: grdy% = maxy%
1044  IF gme_mcauto% = off% THEN
1046   minm% = grdx% * grdy% DIV 12: rem Max/Min number of mines
1048   maxm% = minm% * c4%:          rem for this grid size
1050   IF mcount% > maxm%: mcount% = maxm%
1052   IF mcount% < minm%: mcount% = minm%
1054  END IF
1056  prec%(c10%) = prec%(c10%) + x%: IF prec%(c10%) < c4%: prec%(c10%) = c4%
1058  prec%(11) = prec%(11) + y%: IF prec%(11) < c2%: prec%(11) = c2%
1060 END IF
1062 NewWin prec%(c10%) - c4%, prec%(11) - c2%
1064 gme_chg = 1
1066 END DEFine Resize
1068 :
1070 DEFine PROCedure NewWin(xp%, yp%)
1072 rem Set up a new window
1074 MCLEAR#ch%: CLAMP
1076 Winit xp%, yp%
1078 ClearFields
1080 END DEFine NewWin
1082 :
1084 rem     Mines
1086 :
1088 DEFine PROCedure Mark(it, xp%, yp%)
1090 LOCal i%, j%, s%
1092 rem Mark bomb square and check if game over
1094 IF status%(xp%, yp%) = c1% THEN
1096  Burp 'unflag'
1098  MAWITEM#ch%; it, spr%, sp_square
1100  mines$(xp%, yp%) = Spra$(sp_square)
1102  status%(xp%, yp%) = c0%
1104  mleft% = mleft% + c1%
1106 ELSE
1108  IF status%(xp%, yp%) = c0% THEN
1110   Ping 'flag'
1112   MAWITEM#ch%; it, spr%, sp_flag
1114   mines$(xp%, yp%) = Spra$(sp_flag)
1116   status%(xp%, yp%) = c1%
1118   mleft% = mleft% - c1%
1120  END IF
1122 END IF
1124 IF mleft% <= c0% THEN
1126  s% = c1%
1128  FOR i% = c0% TO grdx%
1130   FOR j% = c0% TO grdy%
1132    IF (mines%(i%, j%) = bomb% AND status%(i%, j%) <> c1%) OR (status%(i%, j%) = c1% AND mines%( >>
     i%, j%) <> bomb%): s% = c0%: EXIT j%
1134   END FOR j%
1136   IF s% = c0%: EXIT i%
1138  END FOR i%
1140  IF s% = c1% THEN
1142   FOR i% = c0 TO grdx%
1144    FOR j% = c0% TO grdy%: status%(i%, j%) = cm1%
1146   END FOR i%
1148   MSTAT#ch%, mapp%, status%: MAWDRAW#ch%; mapp%
1150   GameWin
1152  ELSE
1154   Burp 'illegal'
1156  END IF
1158 END IF
1160 ShowCount
1162 IF mleft% <= -c10%: Burp 'loose': GameLoose
1164 END DEFine Mark
1166 :
1168 DEFine PROCedure Unravel(xp%, yp%)
1170 LOCal i%, j%, c%, r%
1172 rem Uncover adjacent blanks. Recursive!
1174 MAWITEM#ch%; ItNo(xp%, yp%), spr%, sp_blank
1176 mines$(xp%, yp%) = Spra$(sp_blank)
1178 status%(xp%, yp%) = cm1%
1180 s% = MSTAT%(#ch%; ItNo(xp%, yp%) TO c0%\ c0%)
1182 FOR i% = cm1% TO c1%
1184  c% = xp% + i%
1186  FOR j% = cm1% TO c1%
1188   IF NOT (i% = c0% AND j% = c0%) THEN
1190    r% = yp% + j%
1192    IF c% >= c0% AND c% <= grdx% AND r% >= c0% AND r% <= grdy% THEN
1194     IF status%(c%, r%) = c0% THEN
1196      IF mines%(c%, r%) = c0% THEN
1198       Unravel c%, r%
1200      ELSE
1202       IF mines%(c%, r%) < bomb% THEN
1204        MAWITEM#ch%; ItNo(c%, r%), spr%, sp_n(mines%(c%, r%))
1206        mines$(c%, r%) = Spra$(sp_n(mines%(c%, r%)))
1208        status%(c%, r%) = cm1%
1210        s% = MSTAT%(#ch%; ItNo(c%, r%) TO c0%\ c0%)
1212       END IF
1214      END IF
1216     END IF
1218    END IF
1220   END IF
1222  END FOR j%
1224 END FOR i%
1226 s% = MSTAT%(#ch%; ItNo(xp%, yp%) TO c0%): rem Redraw changed
1228 END DEFine Unravel
1230 :
1232 DEFine PROCedure EXPLODE(it, xp%, yp%, e%)
1234 LOCal i%, j%
1236 rem Explode bomb, reveal all, and finish game
1238 IF e% = c0% THEN
1240  MAWITEM#ch%, it, spr%, sp_bombx
1242  mines$(xp%, yp%) = Spra$(sp_bombx)
1244  Burp 'bomb'
1246 END IF
1248 status%(xp%, yp%) = cm1%
1250 FOR i% = c0% TO grdx%
1252  FOR j% = c0% TO grdy%
1254   IF status%(i%, j%) = c1% THEN
1256    IF mines%(i%, j%) <> bomb% THEN
1258     MAWITEM#ch%, ItNo(i%, j%), spr%, sp_bombe
1260     mines$(i%, j%) = Spra$(sp_bombe)
1262    END IF
1264   ELSE
1266    IF status%(i%, j%) = c0% AND mines%(i%, j%) = bomb% THEN
1268     MAWITEM#ch%, ItNo(i%, j%), spr%, sp_bomb
1270     mines$(i%, j%) = Spra$(sp_bomb)
1272    END IF
1274   END IF
1276   status%(i%, j%) = cm1%
1278  END FOR j%
1280 END FOR i%
1282 MSTAT#ch%, mapp%, status%: MAWDRAW#ch%; mapp%
1284 GameLoose
1286 END DEFine EXPLODE
1288 :
1290 DEFine FuNction Oooo%(it)
1292 rem Simulate button depress and allow regret
1294 Ping 'press'
1296 MITEM#ch%; li_new%, spr%, sp_oooo: MLIDRAW#ch%; li_new%
1298 MWINDOW#ch%; it
1300 SPRW#ch%; c0%, c0%, sp_blank
1302 RDPT#ch%; tvx%: PVAL#ch%; prec%
1304 Ping 'release'
1306 MITEM#ch%; li_new%, spr%, sp_smile
1308 RETurn prec%(c3%): rem Escape if pointer out of window
1310 END DEFine Oooo%
1312 :
1314 DEFine PROCedure ClearAround(xp%, yp%)
1316 LOCal i%, j%, c%, r%, s%, i
1318 rem If no unmarked mines clear around numbered square else flash
1320 IF status%(xp%, yp%) <> cm1% OR mines%(xp%, yp%) = c0%: Burp 'illegal': RETurn
1322 s% = c1%
1324 FOR i% = cm1% TO c1%
1326  c% = xp% + i%
1328  FOR j% = cm1% TO c1%
1330   r% = yp% + j%
1332   IF c% >= c0% AND c% <= grdx% AND r% >= c0% AND r% <= grdy% THEN
1334    IF mines%(c%, r%) = bomb% THEN
1336     IF status%(c%, r%) = c0% THEN
1338      s% = c0%
1340     END IF
1342    ELSE
1344     IF status%(c%, r%) = c1% THEN
1346      s% = cm1%: EXIT j%
1348     END IF
1350    END IF
1352   END IF
1354  END FOR j%
1356  IF s% = cm1%: EXIT i%
1358 END FOR i%
1360 :
1362 rem Check for wrongly marked mines
1364 IF s% = cm1% THEN
1366  Burp 'loose'
1368  i = ItNo(c%, r%)
1370  MAWITEM#ch%; i, spr%, sp_bombe
1372  mines$(c%, r%) = Spra$(sp_bombe)
1374  EXPLODE i, c%, r%, c1%: rem Flag wrong marker
1376  RETurn
1378 END IF
1380 :
1382 rem Unmarked mine(s) found: Flash
1384 IF s% = c0% THEN
1386  FOR i% = cm1% TO c1%
1388   c% = xp% + i%
1390   FOR j% = cm1% TO c1%
1392    r% = yp% + j%
1394    IF c% >= c0% AND c% <= grdx% AND r% >= c0% AND r% <= grdy% THEN
1396     IF status%(c%, r%) = c0% THEN
1398      Ping 'flash'
1400      i = ItNo(c%, r%)
1402      MAWITEM#ch%; i, spr%, sp_blank
1404      mines$(c%, r%) = Spra$(sp_blank)
1406      s% = MSTAT%(#ch%; i TO c1%\ c0%)
1408     END IF
1410    END IF
1412   END FOR j%
1414  END FOR i%
1416  s% = MSTAT%(#ch%; i TO c0%)
1418 :
1420  rem Wait for keyup, then unflash
1422  RDPT#ch%; c4%
1424  Ping 'release'
1426  FOR i% = cm1% TO c1%
1428   c% = xp% + i%
1430   FOR j% = cm1% TO c1%
1432    r% = yp% + j%
1434    IF c% >= c0% AND c% <= grdx% AND r% >= c0% AND r% <= grdy% THEN
1436     IF status%(c%, r%) = c0% THEN
1438      i = ItNo(c%, r%)
1440      MAWITEM#ch%; i, spr%, sp_square
1442      mines$(c%, r%) = Spra$(sp_square)
1444      s% = MSTAT%(#ch%; i TO c0%\ c0%)
1446     END IF
1448    END IF
1450   END FOR j%
1452  END FOR i%
1454  s% = MSTAT%(#ch%; i TO c0%)
1456 ELSE
1458 :
1460  rem No unmarked mines found: Clear surrounding squares
1462  Ping 'clear'
1464  FOR i% = cm1% TO c1%
1466   c% = xp% + i%
1468   FOR j% = cm1% TO c1%
1470    r% = yp% + j%
1472    IF c% >= c0% AND c% <= grdx% AND r% >= c0% AND r% <= grdy% THEN
1474     IF status%(c%, r%) = c0% THEN
1476      IF mines%(c%, r%) = c0% THEN
1478       Unravel c%, r%
1480      ELSE
1482       i = ItNo(c%, r%)
1484       MAWITEM#ch; i, spr%, sp_n(mines%(c%, r%))
1486       mines$(c%, r%) = Spra$(sp_n(mines%(c%, r%)))
1488       s% = MSTAT%(#ch%; i TO c0%)
1490      END IF
1492      status%(c%, r%) = cm1%
1494     END IF
1496    END IF
1498   END FOR j%
1500  END FOR i%
1502 END IF
1504 END DEFine ClearAround
1506 :
1508 DEFine PROCedure JumpStart
1510 LOCal rl, c%, r%
1512 rem Unravel a random field
1514 Ping 'new'
1516 REPeat rl
1518  c% = RND(c0% TO grdx%): r% = RND(c0% TO grdy%)
1520  IF mines%(c%, r%) = c0% THEN
1522   Unravel c%, r%
1524   EXIT rl
1526  END IF
1528 END REPeat rl
1530 END DEFine JumpStart
1532 :
1534 rem     Submenus
1536 :
1538 DEFine PROCedure MenuTimer
1540 LOCal awl, k%
1542 LOCal retrac: rem Local to menus
1544 REPeat awl
1546  k% = AwRead%(wtime%)
1548  SELect ON k%
1550  = esc%: EXIT awl
1552  = c1%: rem HIT
1554    IF tmr_use% = on% AND tmr_stat% = on% THEN
1556     IF tmr_pause% = on% THEN
1558      TimerResume: Ping ok$
1560      game = laststate
1562     ELSE
1564      TimerPause: Ping 'pause'
1566      laststate = game: game = paused
1568     END IF
1570    END IF
1572    NEXT awl
1574  = c2%: rem DO
1576    MenuTime prec%(10) - 80, prec%(11) + 22
1578  = REMAINDER : NEXT awl
1580  END SELect
1582 END REPeat awl
1584 END DEFine MenuTimer
1586 :
1588 DEFine PROCedure MenuTime(xp%, yp%)
1590 LOCal tml, i%, cm, st%, tk, d$(c3%)
1592 cm = FOPEN(con$): ERT cm
1594 MSETUP#cm; mn_timer, xp%, yp%
1596 MITEM#cm; tmi_use%, spr%, sp_spotn(spot%)
1598 MITEM#cm; tmi_aut%, spr%, sp_spotn(spot%)
1600 MITEM#cm; tmi_cup%, spr%, sp_spotn(spot%)
1602 MITEM#cm; tmi_cdn%, spr%, sp_spotn(spot%)
1604 MITEM#cm; tmi_lrc%, spr%, sp_spotn(spot%)
1606 st% = MSTAT%(#cm; tmi_lrc% TO cm1%\ c0%): rem NI yet
1608 IF tmr_use% = on% THEN
1610  SwitchOn
1612 ELSE
1614  SwitchOff
1616 END IF
1618 TechnicalPause
1620 MDRAW#cm
1622 Digits
1624 st% = c0%
1626 REPeat tml
1628  tk = MCALL(#cm; tk! st%)
1630  PVAL#cm; tprec%
1632  SELect ON tk
1634  = -2: Help#cm; 'hlp_timer': st% = c0%
1636  = -3: rem Quit
1638    retrac = tprec%(c5%) = c2%
1640    MCLEAR#cm: CLOSE#cm
1642    EXIT tml
1644  = tmi_use%: rem Toggle Use timer
1646    IF game = playing% THEN
1648     Burp 'illegal': NEXT tml
1650    ELSE
1652     tmr_use% = MSTAT%(#cm; tk)
1654     IF tmr_use% = on% THEN
1656      SwitchOn
1658      TimerSet
1660     ELSE
1662      TimerOff
1664      SwitchOff
1666     END IF
1668    END IF
1670    st% = MSTAT%(#cm; tk TO tmr_use%): rem Re-draw
1672    tmr_chg = 1
1674  = tmi_aut%: rem Toggle auto-calculate countdown
1676    st% = MSTAT%(#cm; tk): tmr_auto% = st%
1678    IF tmr_auto% = on%: tmr_cup% = off%
1680    SwitchOn
1682    st% = MSTAT%(#cm; tk TO st%): rem Re-draw
1684    tmr_chg = 1
1686  = tmi_cup%: rem Toggle Count up
1688    st% = MSTAT%(#cm; tk)
1690    tmr_cup% = st%: tmr_auto% = off%
1692    SwitchOn
1694    st% = MSTAT%(#cm; tk TO st%): rem Re-draw
1696    tmr_chg = 1
1698  = tmi_cdn%: rem Toggle Count down
1700    st% = MSTAT%(#cm; tk)
1702    IF st% = on%: tmr_cup% = off%: ELSE : tmr_cup% = on%
1704    tmr_auto% = off%
1706    SwitchOn
1708    st% = MSTAT%(#cm; tk TO st%): rem Re-draw
1710    tmr_chg = 1
1712    rem Edit Start time
1714  = tmi_dgs% - c2% TO tmi_dgs%: rem Up
1716    d$ = Z$(tmr_start%)
1718    i% = ABS(tk) - c7%
1720    IF tprec%(c5%) = c2% THEN
1722     IF d$(i%) = c9%: d$(i%) = c5%: ELSE : d$(i%) = c9%
1724    ELSE
1726     IF d$(i%) = c9% THEN
1728      d$(i%) = c0%
1730     ELSE
1732      d$(i%) = d$(i%) + c1%
1734     END IF
1736    END IF
1738    tmr_start% = d$: tmr_auto% = off%
1740    st% = c0%: tmr_chg = 1
1742  = tmi_dge% TO tmi_dgs% - c3%: rem Down
1744    d$ = Z$(tmr_start%)
1746    i% = ABS(tk) - c10%
1748    IF tprec%(c5%) = c2% THEN
1750     IF d$(i%) = c0%: d$(i%) = c5%: ELSE : d$(i%) = c0%
1752    ELSE
1754     IF d$(i%) = c0% THEN
1756      d$(i%) = c9%
1758     ELSE
1760      d$(i%) = d$(i%) - c1%
1762     END IF
1764    END IF
1766    tmr_start% = d$: tmr_auto% = off%
1768    st% = c0%: tmr_chg = 1
1770  = tmi_lrc%: rem Timer Last record
1772  END SELect
1774  Digits
1776 END REPeat tml
1778 TechnicalResume
1780 IF tmr_use% = on%: timer_disp tmr_id, c1%
1782 IF tmr_chg = 1 THEN
1784  rem Timer changed
1786  TimerSet
1788  IF tmr_stat% = off%: TimerShow cm1%
1790  IF tmr_pause% = on%: TimerResume: Ping ok$
1792 END IF
1794 IF tmr_use% = on% AND tmr_stat% = on% AND tmr_pause% = off% THEN
1796  IF tmr_id = 0 THEN
1798   TimerShow cm1%
1800  END IF
1802 END IF
1804 END DEFine MenuTime
1806 :
1808 DEFine PROCedure TechnicalPause
1810 IF tpause% = c0% THEN
1812  IF tmr_use% = on% AND tmr_pause% = off%: timer_disp tmr_id, c0%: tpause% = c1%
1814 END IF
1816 END DEFine TechnicalPause
1818 :
1820 DEFine PROCedure TechnicalResume
1822 IF tpause% = c1% THEN
1824  IF tmr_use% = on% AND tmr_pause% = off%: timer_disp tmr_id, c1%: tpause% = c0%
1826 END IF
1828 END DEFine TechnicalResume
1830 :
1832 DEFine PROCedure SwitchOn
1834 LOCal i%, st%
1836 st% = MSTAT%(#cm; tmi_use% TO c1%\ c0%)
1838 IF tmr_auto% = on% THEN
1840  st% = MSTAT%(#cm; tmi_aut% TO c1%\ c0%)
1842  st% = MSTAT%(#cm; tmi_cup% TO cm1%\ c0%)
1844  st% = MSTAT%(#cm; tmi_cdn% TO cm1%\ c0%)
1846  FOR i% = tmi_cup% TO tmi_dge% STEP cm1%
1848    st% = MSTAT%(#cm; i% TO cm1%\ c0%)
1850  END FOR i%
1852 ELSE
1854  IF tmr_cup% = on% THEN
1856   st% = MSTAT%(#cm; tmi_cup% TO c1%\ c0%)
1858   st% = MSTAT%(#cm; tmi_aut% TO c0%\ c0%)
1860   st% = MSTAT%(#cm; tmi_cdn% TO c0%\ c0%)
1862   FOR i% =tmi_dgs% TO tmi_dge% STEP cm1%
1864    st% = MSTAT%(#cm; i% TO cm1%\ c0%)
1866   END FOR i%
1868  ELSE
1870   st% = MSTAT%(#cm; tmi_cdn% TO c1%\ c0%)
1872   st% = MSTAT%(#cm; tmi_aut% TO c0%\ c0%)
1874   st% = MSTAT%(#cm; tmi_cup% TO c0%\ c0%)
1876   FOR i% = tmi_dgs% TO tmi_dge% STEP cm1%
1878    st% = MSTAT%(#cm; i% TO c0%\ c0%)
1880   END FOR i%
1882  END IF
1884 END IF
1886 END DEFine SwitchOn
1888 :
1890 DEFine PROCedure SwitchOff
1892 LOCal i%, st%
1894 st% = MSTAT%(#cm; tmi_use% TO c0%\ c0%)
1896 FOR i% = tmi_aut% TO tmi_dge% STEP cm1%
1898  st% = MSTAT%(#cm; i% TO cm1%\ c0%)
1900 END FOR i%
1902 END DEFine SwitchOff
1904 :
1906 DEFine PROCedure Digits
1908 LOCal i%, d$(c3%)
1910 IF tmr_use% = off% THEN
1912  d$ = '---'
1914 ELSE
1916  IF tmr_cup% = on% THEN
1918   d$ = '000'
1920  ELSE
1922   d$ = Z$(tmr_start%)
1924  END IF
1926 END IF
1928 FOR i% = tmw_dg1% TO tmw_dg3%
1930  MWINDOW#cm; i%! c0%: timer_led#cm; c1%, d$(i% - tmw_dg1% + c1%)
1932 END FOR i%
1934 END DEFine Digits
1936 :
1938 rem     Timer
1940 :
1942 DEFine PROCedure TimerSet
1944 SetCol#ct; col_ptm, col_itm
1946 IF tmr_use% = off%: RETurn
1948 IF tmr_id = 0 THEN
1950  tmr_id = timer_init(#ct! c3%): rem padded to three digits
1952 END IF
1954 IF tmr_auto% = on% OR tmr_cup% = off% THEN
1956  IF tmr_auto% = on% THEN
1958   tmr_start% = TmrStart%(mcount%, xdim%, ydim%)
1960  END IF
1962  timer_set tmr_id, tmr_start% TO tmr_end%, tmr_wrd%
1964 ELSE
1966  timer_set tmr_id, c0% TO 999, tmr_wru%
1968 END IF
1970 END DEFine TimerSet
1972 :
1974 DEFine FuNction TmrStart%(mc%, xd%, yd%)
1976 LOCal t%
1978 t% = tmr_fact * mc% * mc% / xd% / yd%
1980 IF t% > 999: t% = 999
1982 RETurn t%
1984 END DEFine TmrStart%
1986 :
1988 DEFine PROCedure TimerShow(n%)
1990 MWLINK#ch; wtime%, #ct
1992 IF tmr_use% = on% THEN
1994  IF n% > cm1% THEN
1996   timer_led#ct; c3%, Z$(n%)
1998  ELSE
2000   IF tmr_cup% = on% THEN
2002    timer_led#ct; c3%, '000'
2004   ELSE
2006    timer_led#ct; c3%, Z$(tmr_start%)
2008   END IF
2010  END IF
2012 ELSE
2014  timer_led#ct; c3%, '---'
2016 END IF
2018 END DEFine TimerShow
2020 :
2022 DEFine PROCedure TimerStart
2024 IF tmr_use% = off% OR tmr_stat% = on%: RETurn : rem Untimed/already running
2026 tmr_stat% = on%: tmr_pause% = off%
2028 TimerShow cm1%: timer_start tmr_id
2030 END DEFine TimerStart
2032 :
2034 DEFine PROCedure TimerPause
2036 IF tmr_use% = off%: RETurn : rem Untimed
2038 IF tmr_stat% = on% THEN
2040  timer_pause tmr_id
2042  tmr_pause% = on%
2044 END IF
2046 END DEFine TimerPause
2048 :
2050 DEFine PROCedure TimerStop
2052 IF tmr_use% = off%: RETurn : rem Untimed
2054 timer_stop tmr_id
2056 tmr_stat% = off%: tmr_pause% = off%
2058 END DEFine TimerStop
2060 :
2062 DEFine PROCedure TimerOff
2064 IF tmr_use% = off%: RETurn : rem Already off
2066 timer_kill tmr_id: tmr_id = 0
2068 tmr_stat% = off%: tmr_pause% = off%
2070 END DEFine TimerOff
2072 :
2074 DEFine PROCedure TimerResume
2076 IF tmr_use% = off%: RETurn : rem Untimed
2078 timer_pause tmr_id
2080 tmr_stat% = on%: tmr_pause% = off%
2082 END DEFine TimerResume
2084 :
2086 rem     Misc
2088 :
2090 DEFine PROCedure ShowCount
2092 rem Display count
2094 MWINDOW#ch; wmcnt%! c0%: SetCol#ch; col_pmc, col_imc
2096 timer_led#ch; c3%, Z$(mleft%)
2098 WM_PAPER#ch; sp_appbg%: rem To avoid flash of col_pmc
2100 END DEFine ShowCount
2102 :
2104 DEFine FuNction Z$(n%)
2106 LOCal s$
2108 IF n% < c0%: s$ = '-': ELSE s$ = nul$
2110 RETurn s$ & FILL$("0", c3% - LEN(ABS(n%) & s$)) & ABS(n%)
2112 END DEFine
2114 :
2116 DEFine FuNction Centre$(w%, txt$)
2118 rem Centre text
2120 IF LEN(txt$) > w% THEN
2122  RETurn txt$(c1% TO w%)
2124 ELSE
2126  RETurn FILL$(spc$, (w% - LEN(txt$)) DIV c2%) & txt$
2128 END IF
2130 END DEFine Centre$
2132 :
2134 DEFine FuNction ItNo(i%, j%)
2136 rem Create item number from coordinates
2138 RETurn (j% * xdim% + i% + c1%) * mencon + 1
2140 END DEFine ItNo
2142 :
2144 DEFine FuNction AwRead%(awno%)
2146 LOCal k%
2148 RDPT#ch; mvec%
2150 PVAL#ch; tprec%: k% = tprec%(c6%)
2152 IF (tprec%(c2%) + c1%) <> awno%: RETurn esc%
2154 IF k% = esc%: Bye
2156 RETurn k%
2158 END DEFine AwRead%
2160 :
2162 DEFine PROCedure SetCol(ch, cp, ci)
2164 PAPER#ch; cp: INK#ch; ci
2166 END DEFine
2168 :
2170 DEFine PROCedure Bye
2172 IF tmr_id <> 0: timer_kill tmr_id
2174 IF saveonx AND changed: CfgSave: Ping 'saved'
2176 MCLEAR#ch: CLAMP: CLOSE: QUIT
2178 END DEFine Bye
2180 :
2182 rem     Button
2184 :
2186 DEFine PROCedure DoButton
2188 rem Save timer and window statuses,
2190 rem and close windows
2192 IF tmr_use% = on%  THEN
2194  but_t% = timer_time%(tmr_id): but_s% = timer_state%(tmr_id)
2196  IF but_t% = 0 AND game <> lost: but_t% = tmr_start%
2198  timer_kill tmr_id: tmr_id = 0
2200 rem if tmr_stat% = on% and game = playing% then
2202  IF game = playing% THEN
2204   Ping 'pause'
2206   IF tmr_cup% = on% THEN
2208    but_t% = but_t% - c1%
2210   ELSE
2212    but_t% = but_t% + c1%
2214   END IF
2216  END IF
2218 END IF
2220 PVAL#ch; prec%
2222 CLOSE#ct: MCLEAR#ch: CLAMP: CLOSE#ch
2224 rem Use button frame if wanted and available
2226 IF butbf THEN
2228  butx% = butsx%: buty% = butsy%
2230  er% = butuse%(butx%, buty%): rem Returns position in butx/y
2232  IF er% <> c0%: butbf = 0
2234 END IF
2236 ButWin
2238 END DEFine DoButton
2240 :
2242 DEFine PROCedure ButWake
2244 LOCal p, i, t%, a%, u%, w%
2246 rem Re-open windows and restore game
2248 CLOSE#butch: butch = 0: IF bfpresent: butfree
2250 ch = FOPEN(con$): ERT ch: ch% = ch: OUTL#ch
2252 ct = FOPEN(con$): ERT ct: rem Timer window
2254 RestoreGame prec%(c10%) - c6%, prec%(11) - c4%
2256 :
2258 rem Restore timer state (a bit fiddley this)
2260 IF tmr_use% = on% THEN
2262  tmr_id = timer_init(#ct! c3%)
2264  IF tmr_stat% = on% THEN
2266   rem Set Paper/Ink colour according to state
2268   IF (but_s% && 16) > c0% THEN
2270    SetCol#ct; col_ptw, col_itw
2272   ELSE
2274    SetCol#ct; col_ptm, col_itm
2276   END IF
2278   IF tmr_cup% = on% THEN
2280    timer_set tmr_id, but_t% TO 999, tmr_wru%
2282   ELSE
2284    timer_set tmr_id, but_t% TO c0%, tmr_wrd%
2286   END IF
2288   TimerShow but_t%
2290   PAUSE#ct; c1%: rem Re-schedule!
2292   IF but_t% > c0% THEN
2294    timer_start tmr_id
2296    IF tmr_pause% = on%: timer_pause tmr_id
2298   END IF
2300  ELSE
2302   rem Stopped, timedout or not initialised
2304   TimerSet
2306   MWLINK#ch; wtime%, #ct
2308   IF game = playing% THEN
2310    SetCol#ct; col_ptm, col_itm
2312    TimerShow cm1%
2314   ELSE
2316    IF but_t% <= c0% AND game = lost THEN
2318     SetCol#ct; col_pto, col_ito
2320    ELSE
2322     SetCol#ct; col_ptm, col_itm
2324    END IF
2326    TimerShow but_t%
2328   END IF
2330  END IF
2332 ELSE
2334  rem Timer off
2336  MWLINK#ch; wtime%, #ct
2338  SetCol#ct; col_ptm, col_itm
2340  TimerShow but_t%
2342 END IF
2344 END DEFine ButWake
2346 :
2348 DEFine PROCedure ButWin
2350 rem Button window routine
2352 LOCal bl, owl
2354 butch = FOPEN(con$)
2356 IF butch > 0 THEN
2358  rem Define button window and display
2360  IF butx% < c0% OR buty% < c0% THEN
2362   OUTL#butch; butsx%, butsy%, prec%(14), prec%(15)
2364  ELSE
2366   OUTL#butch; butsx%, butsy%, butx%, buty%
2368  END IF
2370  WM_BORDER#butch; c1%, sp_butbd%
2372  WM_PAPER#butch; sp_butbg%: WM_INK#butch; sp_butfg%
2374  CLS#butch: CURSOR#butch; c2%, c1%: PRINT#butch; 'D-Miner';
2376  SPRW#butch; butsprx%, c1%, sp_sleep
2378  :
2380  rem Pointer out of button window
2382  REPeat bl
2384   RDPT#butch; but_vi%
2386   IF but_vi% DIV 256 >= c1%: EXIT bl
2388   Ping 'wake'
2390   WM_BORDER#butch; c1%, sp_buthigh%
2392   SPRW#butch; butsprx%, c1%, sp_wink
2394   :
2396  rem Pointer in button window
2398   REPeat owl
2400    RDPT#butch; but_vo%:
2402    IF but_vo% DIV 256 >= c1% THEN
2404     IF but_vo% DIV 256 = c2% OR butbf: EXIT bl
2406     WM_BORDER#butch; c0%, sp_butbd%: rem Why?
2408     WMOV#butch
2410    END IF
2412    WM_BORDER#butch; c1%, sp_butbd%
2414    SPRW#butch; butsprx%, c1%, sp_sleep
2416    EXIT owl
2418   END REPeat owl
2420  END REPeat bl
2422  ButWake
2424 ELSE
2426  rem Cannot do button
2428  Burp 'illegal'
2430 END IF
2432 END DEFine ButWin
2434 :
2436 DEFine PROCedure RestoreGame(xp%, yp%)
2438 Winit xp%, yp%
2440 ShowCount
2442 IF game = lost THEN
2444  MITEM#ch%; li_new%, spr%, sp_sour
2446 ELSE
2448  IF game = won: MITEM#ch%; li_new%, spr%, sp_cool
2450 END IF
2452 rem Restore game board
2454 MAWDRAW#ch%; mapp%, mines$, c0%, c0%, spr%, sqsz%, sqsz%, c0%, c0%
2456 END DEFine RestoreGame
2458 :
2460 DEFine PROCedure MenuConf
2462 LOCal ml, mc, mk, s%, xp%, t$(c4%), snd, sox
2464 LOCal retrac : rem Local to menus
2466 TechnicalPause
2468 retrac = 0: colsq = 0
2470 mc = FOPEN(con$): IF mc < 0: ERT mc
2472 xp% = prec%(c10%) + c10%
2474 MSETUP#mc; mn_config, xp%, prec%(11) + 40
2476 sox = saveonx: snd = sound
2478 SetConf
2480 MDRAW#mc
2482 s% = c0%
2484 REPeat ml
2486  mk = MCALL(#mc; mk, s%)
2488  SELect ON mk
2490  = -2: Help#mc; 'hlp_config'
2492  = -3: IF changed: Ping ok$
2494    EXIT ml
2496  = -4: rem Sound
2498    s% = MSTAT%(#mc; mk)
2500    snd = s%: Ping ok$
2502    IF snd = (sound <> 0) THEN
2504     changed = changed - 1: IF changed < 0: changed = 0
2506    ELSE
2508     changed = changed + 1
2510    END IF
2512  = -5, -6: rem HIT/DO
2514    SwapHD
2516    IF t$ = 'HIT': hit% = c2%: do% = c1%: ELSE : hit% = c1%: do% = c2%
2518    s% = c0%: changed = changed + 1
2520  = -7: rem Look
2522     PVAL#mc; tprec%
2524     MenuLook tprec%(10) + 100, tprec%(11) + 76
2526     IF pal <> palno: changed = changed + 1
2528     s% = c0%
2530  = -8: rem Timer
2532    tmr_chg = 0
2534    PVAL#mc; tprec%
2536    MenuTime tprec%(10) + 100, tprec%(11) + 92
2538    s% = c0%
2540    IF tmr_chg: Ping ok$: changed = changed + tmr_chg
2542  = -9: rem Score
2544    PVAL#mc; tprec%
2546    changed = changed + MenuScore(tprec%(10) + 100, tprec%(11) + 108)
2548    s% = c0%
2550  = -10: rem Save on exit
2552    s% = MSTAT%(#mc; mk)
2554    IF sox = s% THEN
2556     changed = changed - 1: IF changed < 0: changed = 0
2558    ELSE
2560     changed = changed + 1
2562     saveonx = s%
2564    END IF
2566  = -11: rem Defaults
2568    SetDefaults: SetConf
2570    s% = MSTAT%(#mc; mk TO c0%)
2572    changed = 1
2574    Ping ok$
2576  = -12: rem Save Now
2578    SetSound snd
2580    CfgSave: Ping 'saved'
2582    s% = cm1%: NEXT ml
2584  END SELect
2586  IF changed THEN
2588   st% = MSTAT%(#mc; -12 TO c1%\ c0%)
2590  ELSE
2592   IF retrac: EXIT ml
2594   st% = MSTAT%(#mc; -12 TO cm1%\ c0%)
2596  END IF
2598 END REPeat ml
2600 MCLEAR#mc: CLOSE#mc
2602 SetSound snd
2604 IF colsq: RECHP colsq: colsq = 0
2606 TechnicalResume
2608 END DEFine MenuConf
2610 :
2612 DEFine PROCedure SetConf
2614 rem MenuConf subroutine
2616 MITEM#mc; -4, spr%, sp_spotn(spot%)
2618 MITEM#mc; -10, spr%, sp_spotn(spot%)
2620 IF (hit% = c1% AND MTEXT$(#mc; -5) <> 'HIT') OR (hit% = c2% AND MTEXT$(#mc; -5) <> 'DO'):  >>
     SwapHD
2622 IF sound: s% = MSTAT%(#mc; -4, c1%\ c0%): ELSE : s% = MSTAT%(#mc; -4, c0%\ c0%)
2624 s% = MSTAT%(#mc; -10, saveonx\ c0%)
2626 IF changed: s% = MSTAT%(#mc; -12, c1%\ c0%): ELSE : s% = MSTAT%(#mc; -12, cm1%\ c0%)
2628 END DEFine SetConf
2630 :
2632 DEFine PROCedure SwapHD
2634 rem MenuConf subroutine
2636 t$ = MTEXT$(#mc; -5)
2638 MITEM#mc; -5, c0%, MTEXT$(#mc; -6)
2640 MITEM#mc; -6, c0%, t$
2642 END DEFine SwapHD
2644 :
2646 DEFine PROCedure CfgSave
2648 LOCal i%, sc
2650 sc = FOP_OVER(homed$ & 'dminer_cfg'): IF sc < 0: Burp 'illegal': RETurn
2652 :
2654 rem Magic
2656 PRINT#sc; mgDmnr$
2658 :
2660 PRINT#sc\\ '* - File locations'\\
2662 Cfg 'Help', hlpprg$
2664 Cfg 'Message', msgprg$
2666 Cfg 'ColourSquare', colsq$
2668 Cfg 'SoundDir', snd$
2670 :
2672 PRINT#sc\\ '* - Game board'\\
2674 Cfg 'x-pos', xpos%
2676 Cfg 'y-pos', ypos%
2678 :
2680 FOR i% = c0% TO DIMN(game%)
2682  PRINT#sc\\ '* - Game #' & i%\\
2684  Cfg 'current', YN$(game%(i%, c0%))
2686  Cfg 'x-grid', game%(i%, c1%)
2688  Cfg 'linked', YN$(game%(i%, c2%))
2690  Cfg 'y-grid', game%(i%, c3%)
2692  Cfg 'mines', GetOpt$(game%(i%, c4%), gameM$)
2694  Cfg 'timer', GetOpt$(game%(i%, c5%), gameT$)
2696 END FOR i%
2698 :
2700 PRINT#sc\\ '* - General'\\
2702 Cfg 'sound', YN$(sound)
2704 Cfg 'palette', palno
2706 Cfg 'spots', colour$(spot% - c1%)
2708 Cfg 'HIT', hit%
2710 Cfg 'Save on Exit', YN$(saveonx)
2712 :
2714 PRINT#sc\\ '* - Timer'\\
2716 Cfg 'factor', tmr_fact
2718 Cfg 'warn up', tmr_wru%
2720 Cfg 'warn down', tmr_wrd%
2722 :
2724 PRINT#sc\\ '* - Score on'\\
2726 Cfg 'Count up', YN$(gme_cup%)
2728 Cfg 'Jump start', YN$(gme_jst%)
2730 Cfg 'Discard JS', YN$(gme_jsd%)
2732 PRINT#sc
2734 Cfg 'Auto save', YN$(autosave)
2736 :
2738 PRINT#sc\\ '* - Colours'\\
2740 Cfg 'Counter ink', Col$(col_imc)
2742 Cfg 'Counter paper', Col$(col_pmc)
2744 Cfg 'Timer ink', Col$(col_itm)
2746 Cfg 'Timer paper', Col$(col_ptm)
2748 Cfg 'Warn ink', Col$(col_itw)
2750 Cfg 'Warn paper', Col$(col_ptw)
2752 Cfg 'Timeout paper', Col$(col_pto)
2754 Cfg 'Timeout ink', Col$(col_ito)
2756 :
2758 PRINT#sc\\ '* - Button'\\
2760 Cfg 'Use button frame', YN$(butbf)
2762 Cfg 'Position x', butx%
2764 Cfg 'Position y', buty%
2766 :
2768 CLOSE#sc
2770 changed = 0
2772 END DEFine CfgSave
2774 :
2776 DEFine PROCedure Cfg(n$, e$)
2778 PRINT#sc; n$; TO 18; ':'! e$
2780 END DEFine Cfg
2782 :
2784 DEFine FuNction YN$(c)
2786 IF c: RETurn 'Yes': ELSE : RETurn 'No'
2788 END DEFine YN$
2790 :
2792 DEFine FuNction Col$(n)
2794 RETurn '$' & HEX$(n, 24)
2796 END DEFine Col$
2798 :
2800 DEFine FuNction CfgRead(fnm$)
2802 LOCal i%, il, sc, er, op, o$, l$, t$
2804 sc = GetMagic(fnm$, mgDmnr$)
2806 IF sc < 0: RETurn sc
2808 :
2810 er = 0
2812 :
2814 rem * - File locations
2816 rem If not a valid filename, dont change default
2818 t$ = Gcfg$('Help'): IF LEN(t$) > c5%: hlpprg$ = t$
2820 t$ = Gcfg$('Message'): IF LEN(t$) > c5%: msgprg$ = t$
2822 t$ = Gcfg$('ColourSquare'): IF LEN(t$) > c5%: colsq$ = t$
2824 t$ = Gcfg$('SoundDir'): IF LEN(t$) >= c4%: snd$ = t$
2826 :
2828 rem * - Game board
2830 xpos% = Gcfg$('x-pos')
2832 ypos% = Gcfg$('y-pos')
2834 :
2836 FOR i% = c0% TO DIMN(game%)
2838  rem * - Game #
2840  game%(i%, c0%) = GcfgY('current')
2842  game%(i%, c1%) = Gcfg$('x-grid')
2844  game%(i%, c2%) = GcfgY('linked')
2846  game%(i%, c3%) = Gcfg$('y-grid')
2848  game%(i%, c4%) = GcfgO('mines', gameM$)
2850  game%(i%, c5%) = GcfgO('timer', gameT$)
2852 END FOR i%
2854 :
2856 rem * - General
2858 sound = GcfgY('sound')
2860 SetSound sound
2862 :
2864 palno = Gcfg$('palette')
2866 spot% = ABS(GcfgO('spots', colour$))
2868 hit% = Gcfg$('HIT')
2870 saveonx = GcfgY('Save on Exit')
2872 :
2874 rem * - Timer
2876 tmr_fact = Gcfg$('factor')
2878 tmr_wru% = Gcfg$('warn up')
2880 tmr_wrd% = Gcfg$('warn down')
2882 :
2884 rem * - Score on
2886 gme_cup% = GcfgY('Count up')
2888 gme_jst% = GcfgY('Jump start')
2890 gme_jsd% = GcfgY('Discard JS')
2892 autosave = GcfgY('Auto save')
2894 :
2896 rem * - Colours
2898 col_imc = GcfgC('Counter ink')
2900 col_pmc = GcfgC('Counter paper')
2902 col_itm = GcfgC('Timer ink')
2904 col_ptm = GcfgC('Timer paper')
2906 col_itw = GcfgC('Warn ink')
2908 col_ptw = GcfgC('Warn paper')
2910 col_pto = GcfgC('Timeout paper')
2912 col_ito = GcfgC('Timeout ink')
2914 :
2916 rem * - Button
2918 butbf = GcfgY('Use button frame')
2920 butx% = Gcfg$('Position x')
2922 buty% = Gcfg$('Position y')
2924 :
2926 CLOSE#sc
2928 RETurn er
2930 END DEFine CfgRead
2932 :
2934 DEFine FuNction Gcfg$(tx$)
2936 REPeat il
2938  IF EOF(#sc): er = er + 1: EXIT il
2940  INPUT#sc; l$
2942  IF LEN(l$) = c0%: NEXT il
2944  p% = ': ' INSTR l$: IF p% = c0%: NEXT il
2946  IF (tx$ INSTR l$) <> c1%: NEXT il
2948  EXIT il
2950 END REPeat il
2952 IF er: RETurn nul$
2954 RETurn l$(p% + c2% TO LEN(l$))
2956 END DEFine Gcfg$
2958 :
2960 DEFine FuNction GcfgY(tx$)
2962 o$ = Gcfg$(tx$)
2964 IF 'yes' INSTR o$: RETurn 1: ELSE : RETurn 0
2966 END DEFine GcfgY
2968 :
2970 DEFine FuNction GcfgO(tx$, ar$)
2972 LOCal i%
2974 o$ = Gcfg$(tx$)
2976 op = 1000
2978 IF DIMN(ar$) > c0% THEN
2980  FOR i% = c0% TO DIMN(ar$)
2982   IF o$ == ar$(i%): op = cm1% - i%: EXIT i%
2984  END FOR i%
2986 ELSE
2988  IF o$ == ar$: op = cm1%
2990 END IF
2992 IF op = 1000: op = '0' & o$
2994 RETurn op
2996 END DEFine GcfgO
2998 :
3000 DEFine FuNction GcfgC(tx$)
3002 o$ = Gcfg$(tx$)
3004 IF LEN(o$) <> c7%: er = er + 1: RETurn 0
3006 RETurn HEX(o$(c2% TO LEN(o$)))
3008 END DEFine GcfgC
3010 :
3012 DEFine PROCedure MenuLook(xp%, yp%)
3014 LOCal ml, mc, mk, x%, y%
3016 mc = FOPEN(con$): IF mc < 0: ERT mc
3018 MSETUP#mc; mn_look, xp%, yp%
3020 MITEM#mc; -4, c0%, nul$ & pal
3022 MDRAW#mc
3024 REPeat ml
3026  mk = MCALL(#mc; mk, c0%)
3028  PVAL#mc; tprec%
3030  x% = tprec%(10) + 92
3032  SELect ON mk
3034  = -2: Help#mc; 'hlp_look'
3036  = -3: rem Exit
3038    retrac = (tprec%(c5%) = c2%)
3040    IF changed: Ping ok$
3042    EXIT ml
3044  = -4: rem Palette
3046    IF tprec%(c5%) = c2% THEN
3048     pal = (MTEXT$(#mc; mk) + c1%) MOD c5%
3050    ELSE
3052     pal = (MTEXT$(#mc; mk) - c1%)
3054     IF pal < 0: pal = c4%
3056    END IF
3058    Palette pal
3060    MCLEAR#mc: MDRAW#mc; mn_look, xp%, yp%
3062    MITEM#mc; mk, 0, nul$ & pal
3064  = -5: rem Spots
3066    MenuSpotsel x%, tprec%(11) + 40
3068  = -6: rem Run
3070    y% = tprec%(11) + 76
3072    MenuColsel 'Run', x%, y%, col_ptm, col_itm, tmr_start%
3074  = -7: rem Warn
3076    y% = tprec%(11) + 92
3078    MenuColsel 'Warn', x%, y%, col_ptw, col_itw, tmr_wrn%
3080  = -8: rem Timeout
3082    y% = tprec%(11) + 108
3084    MenuColsel 'Time', x%, y%, col_pto, col_ito, tmr_end%
3086  = -9: rem Minecount
3088    y% = tprec%(11) + 124
3090    MenuColsel 'Count', x%, y%, col_pmc, col_imc, mcount%
3092  END SELect
3094  IF retrac: EXIT ml
3096 END REPeat ml
3098 IF pal <> palno THEN
3100  redraw = 1
3102  Palette palno: rem Dont change before exit config
3104 END IF
3106 MCLEAR#mc: CLOSE#mc
3108 END DEFine MenuLook
3110 :
3112 DEFine PROCedure Palette(p%)
3114 LOCal cp, adr, c$(c6%)
3116 IF p% = c4% THEN
3118  IF palset < 0 THEN
3120   rem No palette available
3122   p% = c0%: Burp 'illegal'
3124  ELSE
3126   IF palset = 0 THEN
3128    palset = ALCHP(SP_GETCOUNT * c2%)
3130    IF palset = 0 OR palset = -3 THEN
3132     palset = 0: p% = c0%
3134     SP_JOBPAL -1, p%
3136     ErrMess 'Not enough memory!'
3138    ELSE
3140     LoadPal
3142    END IF
3144   ELSE
3146    SP_JOBOWNPAL -1, palset
3148   END IF
3150  END IF
3152 ELSE
3154  SP_JOBPAL -1, p%
3156 END IF
3158 END DEFine Palette
3160 :
3162 DEFine PROCedure LoadPal
3164 rem Palette subroutine
3166 cp = FOP_IN(homed$ & paln$)
3168 IF cp < 0 THEN
3170  RECHP palset
3172  palset = 0: p% = c0%
3174  SP_JOBPAL -1, p%
3176  ErrMess 'Palette\' & paln$ & '\\not found!'
3178 ELSE
3180  FOR adr = palset TO palset + (SP_GETCOUNT - c1%) * c2% STEP c2%
3182   INPUT#cp; c$
3184   POKE_W adr, HEX(c$(c2% TO LEN(c$)))
3186  END FOR adr
3188  CLOSE#cp
3190  SP_JOBOWNPAL -1, palset
3192 END IF
3194 END DEFine LoadPal
3196 :
3198 DEFine PROCedure MenuSpotsel(xp%, yp%)
3200 LOCal mc, mk, s%
3202 mc = FOPEN(con$): IF mc < 0: ERT mc
3204 MSETUP#mc; mn_spotsel, xp%, yp%
3206 s% = MSTAT%(#mc; -spot%, c1%\ c0%)
3208 s% = spot%
3210 MDRAW#mc
3212 mk = MCALL(#mc; mk, s%)
3214 PVAL#mc; tprec%
3216 IF tprec%(c5%) = c2% THEN
3218  spot% = ABS(mk)
3220  IF s% <> spot%: changed = changed + 1
3222  Ping ok$
3224 END IF
3226 MCLEAR#mc: CLOSE#mc
3228 END DEFine MenuSpotsel
3230 :
3232 DEFine PROCedure MenuColsel(n$, xp%, yp%, colp, coli, t%)
3234 LOCal ml, cl, mc, mk, s%, x%, y%, c, c$(c4%)
3236 LOCal ci, cp, chg
3238 rem GLObal colsq, menv%, llen, base, bpp%
3240 rem Alters parameters!
3242 rem V0.01 April 18th 2004
3244 :
3246 IF colsq = 0 THEN
3248  colsq = FLEN(\colsq$)
3250  IF colsq > 0 THEN
3252   colsq = ALCHP(colsq)
3254   LBYTES colsq$, colsq
3256  ELSE
3258   Burp 'illegal': RETurn
3260  END IF
3262 END IF
3264 :
3266 mc = FOPEN(con$): IF mc < 0: ERT mc
3268 MSETUP#mc; mn_colour, xp%, yp%
3270 MINOB#mc; c2%, c1%, Centre$(c6%, n$)
3272 MDRAW#mc
3274 p% = MSTAT%(#mc; -3 TO c1%)
3276 MWINDOW#mc; c5%! c0%
3278 PAPER#mc; colp: INK#mc; coli
3280 timer_led#mc; c3%, Z$(t%)
3282 MWINDOW#mc; c1%
3284 SPRW#mc; c0%, c0%, colsq
3286 ok% = c1%: s% = c0%
3288 ci = coli: cp = colp: chg = 0
3290 COLOUR_NATIVE
3292 REPeat ml
3294  mk = MCALL(#mc; mk, s%)
3296  SELect ON mk
3298   = -2: rem Exit
3300     PVAL#mc; tprec%
3302     retrac = (tprec%(c5%) = c2%)
3304     chg = 0
3306     EXIT ml
3308   = -3: rem Paper
3310     TogglePink mk
3312     ok% = c1%
3314   = -4: rem Ink
3316     TogglePink mk
3318     ok% = c2%
3320   = 1: rem Colour square
3322      PVAL#mc; tprec%
3324      x% = tprec%(14): y% = tprec%(15)
3326      REPeat cl
3328       RDPT#mc; menv%, x%, y%
3330       PVAL#mc; tprec%
3332       IF tprec%(c2%) <> c0%: EXIT cl: rem Out of this apwin
3334       IF tprec%(c5%) = c2% THEN
3336        IF ok% = c1%
3338         cp = c: TogglePink -4
3340         ok% = c2%
3342        ELSE
3344         IF ok% = c0%
3346          IF MSTAT%(#mc; -3): ok% = c1%: ELSE : ok% = c2%
3348          NEXT cl
3350         ELSE
3352          ci = c: TogglePink -3
3354          ok% = c1%
3356         END IF
3358        END IF
3360        chg = 1
3362       ELSE
3364        IF tprec%(c5%) = c1% THEN
3366         IF ok% = c1%: cp = c: ELSE : ci = c
3368         chg = 1
3370         ok% = c0%
3372         EXIT cl: rem End colour select
3374        ELSE
3376         IF ok% = c0%: EXIT cl
3378        END IF
3380       END IF
3382       IF bpp% = c1% THEN
3384        c = PEEK(base + llen * y% + x%)
3386       ELSE
3388        c = PEEK_W(base + llen * y% + x% + x%)
3390        IF DISP_TYPE = 32: c = PCBO(c)
3392       END IF
3394       MWINDOW#mc; c5%! c0%
3396       IF ok% = c1% THEN
3398        PAPER#mc; c
3400       ELSE
3402        INK#mc; c
3404       END IF
3406       timer_led#mc; c3%, Z$(t%)
3408      END REPeat cl
3410      s% = c0%
3412   = -1025: rem DO Counter
3414     Ping ok$: EXIT ml
3416   = REMAINDER : Burp 'illegal'
3418  END SELect
3420 END REPeat ml
3422 MCLEAR#mc: CLOSE#mc
3424 IF chg THEN
3426  changed = changed + chg
3428  redraw = 1
3430  IF DISP_TYPE = 32: ci = PCBO(ci): cp = PCBO(cp)
3432  coli = nat2rgb(ci): colp = nat2rgb(cp)
3434 END IF
3436 COLOUR_24
3438 END DEFine MenuColsel
3440 :
3442 DEFine PROCedure TogglePink(k)
3444 LOCal k1, k2
3446 IF k = -3: k1 = -3: k2 = -4: ELSE : k2 = -3: k1 = -4
3448 s% = MSTAT%(#mc; k2, c0%\ c0%)
3450 s% = MSTAT%(#mc; k1, c1% TO c0%)
3452 END DEFine TogglePink
3454 :
3456 DEFine FuNction PCBO(n)
3458 LOCal c$(c4%)
3460 rem Little-endian for QPC
3462 c$ = HEX$(n, _w%)
3464 RETurn HEX(c$(c3% TO c4%) & c$(c1% TO c2%))
3466 rem c = c div 256 + (c mod 256) * 256: Doesnt work
3468 END DEFine PCBO
3470 :
3472 rem     NumSel
3474 :
3476 DEFine FuNction NumSel%(xp%, yp%, st%, en%, cr%, opt$)
3478 LOCal nl, cn, nk, o%, n%, t%, o$(c8%)
3480 rem V0.01 Positive only
3482 :
3484 o% = cr%
3486 o$ = GetOpt$(o%, opt$)
3488 IF o% < c0%: n% = st%: ELSE : n% = o%
3490 t% = c0%
3492 cn = FOPEN(con$)
3494 MSETUP#cn; mn_numsel, xp%, yp%
3496 MITEM#cn; -2, c0%, o$
3498 MDRAW#cn
3500 REPeat nl
3502  nk = MCALL(#cn; nk, c0%)
3504  PVAL#cn; tprec%
3506  SELect ON nk
3508  = -1: rem Up
3510    IF tprec%(c5%) = c2% THEN
3512     ScrollUp #cn, c10%
3514    ELSE
3516     ScrollUp #cn; c1%
3518    END IF
3520    o% = n%
3522  = -2: rem Dial
3524    IF tprec%(c5%) = c1% OR tprec%(c6%) = esc% THEN
3526     o% = cr%: rem Discard changes
3528    END IF
3530    EXIT nl
3532  = -3: rem Down
3534    IF tprec%(c5%) = c2% THEN
3536     ScrollDn #cn; c10%
3538    ELSE
3540     ScrollDn #cn; c1%
3542    END IF
3544    o% = n%
3546  = -4, -5: rem Left/Right
3548    IF mk = -4 THEN
3550     t% = (t% - c1%) MOD (DIMN(opt$) + c2%)
3552    ELSE
3554     t% = (t% + c1%) MOD (DIMN(opt$) + c2%)
3556    END IF
3558    IF t% > DIMN(opt$) THEN
3560     o% = n%
3562    ELSE
3564     o% = cm1% - t%
3566    END IF
3568    o$ = GetOpt$(o%, opt$)
3570    MITEM #cn; -2, c0%, o$
3572  END SELect
3574 END REPeat nl
3576 MCLEAR#cn: CLOSE#cn
3578 RETurn o%: rem ret o$
3580 END DEFine NumSel%
3582 :
3584 DEFine FuNction GetOpt$(p%, opt$)
3586 IF p% < c0% THEN
3588  IF DIMN(opt$) = c0% THEN
3590   RETurn opt$: rem Plain variable
3592  ELSE
3594   RETurn opt$(ABS(p%) - c1%): rem Array
3596  END IF
3598 END IF
3600 RETurn nul$ & p%: rem Anything else is a number
3602 END DEFine GetOpt$
3604 :
3606 DEFine PROCedure ScrollUp(ch, a%)
3608 LOCal sul, x%, y%
3610 x% = tprec%(14): y% = tprec%(15)
3612 RDPT#ch; nsvi%, x%, y%, nstio%
3614 REPeat sul
3616  RDPT#ch; nsvo%
3618  PVAL#ch; tprec%
3620  NSInc a%
3622  s% = MSTAT%(#ch; -2 TO c0%)
3624  IF tprec%(c5%) = c0%: EXIT sul
3626 END REPeat sul
3628 t% = c1%
3630 END DEFine ScrollUp
3632 :
3634 DEFine PROCedure ScrollDn(ch, a%)
3636 LOCal sul, x%, y%
3638 x% = tprec%(14): y% = tprec%(15)
3640 RDPT#ch; nsvi%, x%, y%, nstio%
3642 REPeat sul
3644  RDPT#ch; nsvo%
3646  PVAL#ch; tprec%
3648  NSDec a%
3650  s% = MSTAT%(#ch; -2 TO c0%)
3652  IF tprec%(c5%) = c0%: EXIT sul
3654 END REPeat sul
3656 t% = n%
3658 END DEFine ScrollDn
3660 :
3662 DEFine PROCedure NSInc(a%)
3664 rem Subroutine of NumSel%
3666 n% = (n% + a%) MOD (en% + c1%)
3668 IF n% < st%: n% = st%
3670 MITEM#cn; -2, c0%, nul$ & n%
3672 END DEFine NSInc
3674 :
3676 DEFine PROCedure NSDec(a%)
3678 rem Subroutine of NumSel%
3680 n% = (n% - a%) MOD (en% + c1%)
3682 IF n% < st%: n% = en%
3684 MITEM#cn; -2, c0%, nul$ & n%
3686 END DEFine NSDec
3688 :
3690 rem     End Numsel
3692 :
3694 DEFine FuNction MenuScore(xp%, yp%)
3696 LOCal ml, cl, cm, mk, s%, chg
3698 rem V0.01 May 10th 2004
3700 rem V0.02 March 20th 2005 added Help
3702 :
3704 chg = 0
3706 cm = FOPEN(con$): IF cm < 0: ERT cm
3708 MSETUP#cm; mn_score, xp%, yp%
3710 MITEM#cm; -4, spr%, sp_spotn(spot%)
3712 MITEM#cm; -5, spr%, sp_spotn(spot%)
3714 MITEM#cm; -6, spr%, sp_spotn(spot%)
3716 MITEM#cm; -7, spr%, sp_spotn(spot%)
3718 s% = MSTAT%(#cm; -4, gme_cup%\ c0%)
3720 s% = MSTAT%(#cm; -5, gme_jst%\ c0%)
3722 s% = MSTAT%(#cm; -6, gme_jsd%\ c0%)
3724 s% = MSTAT%(#cm; -7, autosave\ c0%)
3726 MDRAW#cm
3728 s% = c0%
3730 REPeat ml
3732  mk = MCALL(#cm; mk, s%)
3734  SELect ON mk
3736   = -2: Help#cm; 'hlp_score'
3738     NEXT ml
3740   = -3: rem Exit
3742     IF chg = 0 THEN
3744      PVAL#cm; tprec%
3746      retrac = (tprec%(c5%) = c2%)
3748     ELSE
3750      Ping ok$
3752     END IF
3754     EXIT ml
3756   = -4: rem Count up
3758     s% = MSTAT%(#cm; mk)
3760     gme_cup% = s%
3762   = -5: rem Jump start
3764     s% = MSTAT%(#cm; mk)
3766     gme_jst% = s%
3768   = -6: rem Discard
3770     s% = MSTAT%(#cm; mk)
3772     gme_jsd% = s%
3774   = -7: rem Autosave
3776     s% = MSTAT%(#cm; mk)
3778     autosave = s%
3780  END SELect
3782  chg = 1
3784 END REPeat ml
3786 MCLEAR#cm: CLOSE#cm
3788 RETurn chg
3790 END DEFine MenuScore
3792 :
3794 DEFine PROCedure UpdtGame
3796 LOCal i%, j%, s%, it%
3798 FOR i% = c0% TO DIMN(game%)
3800  FOR j% = c0% TO DIMN(game%(c0%))
3802   it% = -4 - (i% * (DIMN(game%(c0%)) + c1%) + j%)
3804   SELect ON it%
3806    = -4, -10, -16: rem Spots
3808      rem Current game
3810      IF gme_chg: game%(i%, j%) = c0%: rem No game selected => game changed
3812      MITEM#cm; it%, spr%, sp_spotn(spot%)
3814      s% = MSTAT%(#cm; it%, game%(i%, j%)\ c0%)
3816    = -5, -7, -11, -13, -17, -19: rem Grid x, y
3818      MITEM#cm; it%, c0%, nul$ & game%(i%, j%)
3820    = -6, -12, -18: rem x
3822      rem If x selected then gridy is unavailable
3824      IF game%(i%, c1%) <> game%(i%, c3%) THEN
3826       rem But if x/y size different then unlock
3828       game%(i%, j%) = c0%
3830      END IF
3832      IF game%(i%, j%) = c1%: st% = MSTAT%(#cm; it% - c1%, cm1%\ c0%)
3834    = -8, -14, -20: rem Mines
3836      o$ = GetOpt$(game%(i%, j%), gameM$)
3838      MITEM#cm; it%, c0%, o$
3840    = -9, -15, -21: rem Timer
3842      o$ = GetOpt$(game%(i%, j%), gameT$)
3844      MITEM#cm; it%, c0%, o$
3846   END SELect
3848  END FOR j%
3850 END FOR i%
3852 END DEFine UpdtGame
3854 :
3856 DEFine FuNction MenuGame(xp%, yp%)
3858 LOCal i%, j%, ml, cl, cm, mk, s%, st%, chg, o$(c6%)
3860 rem V0.01 May 10th 2004
3862 rem V0.02 March 14th 2005 Removed default game
3864 rem V0.03 March 19th 2005 Added Help
3866 rem V0.04 March 26th 2005 Fixed positioning. External changes reflected
3868 :
3870 chg = 0
3872 cm = FOPEN(con$): IF cm < 0: ERT cm
3874 MSETUP#cm; mn_game, xp%, yp%
3876 UpdtGame
3878 rem Save now
3880 s% = MSTAT%(#cm; -22, cm1%\ c0%)
3882 MDRAW#cm
3884 s% = c0%
3886 REPeat ml
3888  mk = MCALL(#cm; mk, s%)
3890  i% = ABS(mk + c4%) DIV (DIMN(game%(c0%)) + c1%)
3892  j% = ABS(mk + c4%) MOD (DIMN(game%(c0%)) + c1%)
3894  SELect ON mk
3896   = -2: Help#cm; 'hlp_game'
3898   = -3: rem Exit
3900     IF chg = 0 THEN
3902      PVAL#cm; tprec%
3904      retrac = (tprec%(c5%) = c2%)
3906     ELSE
3908      Ping ok$
3910     END IF
3912     EXIT ml
3914   = -4, -10, -16: rem Select game
3916     PVAL#cm; tprec%
3918     s% = MSTAT%(#cm; mk)
3920     IF gme_chg AND tprec%(c5%) = c1% THEN
3922      game%(i%, c0%) = c1%
3924      game%(i%, c1%) = xdim%
3926      game%(i%, c2%) = xdim% = ydim%
3928      game%(i%, c3%) = ydim%
3930      IF gme_mcauto% = on%: game%(i%, c4%) = cm1%: ELSE : game%(i%, c4%) = mcount%
3932      IF tmr_use% = off% THEN
3934       game%(i%, c5%) = -3
3936      ELSE : IF tmr_auto% = on% THEN
3938       game%(i%, c5%) = cm1%
3940      ELSE : IF tmr_cup% = on% THEN
3942       game%(i%, c5%) = -2
3944      ELSE : game%(i%, c5%) = tmr_start%
3946      END IF : END IF : END IF
3948 rem if tmr_lrc% = on%: game%(i%, c5%) = -4 Not yet implemented
3950      gme_chg = 0: UpdtGame
3952     ELSE
3954      FOR j% = -16, -10, -4: st% = MSTAT%(#cm; j%, c0%\ c0%)
3956      FOR j% = c0% TO DIMN(game%): game%(j%, c0%) = c0%
3958      st% = MSTAT%(#cm; mk, s%\ c0%)
3960      game%(i%, c0%) = c1%: s% = c1%
3962      IF game%(i%, c1%) > maxx%: game%(i%, c1%) = maxx%: rem No bigger that max
3964      IF game%(i%, c3%) > maxy%: game%(i%, c3%) = maxy%
3966      gme_chg = 0
3968     END IF
3970     redraw = 1
3972     IF tprec%(c5%) = c2%: EXIT ml
3974   = -5, -11, -17: rem Grid x
3976     game%(i%, j%) = NumSel%(-1, -1, c10%, maxx%, game%(i%, j%), game%(i%, j%))
3978     MITEM#cm; mk, c0%, nul$ & game%(i%, j%)
3980     IF game%(i%, c2%) = c1% THEN
3982      MITEM#cm; mk - c2%, c0%, nul$ & game%(i%, j%)
3984      game%(i%, c3%) = game%(i%, j%)
3986     END IF
3988     IF game%(i%, c4%) >= c0% THEN
3990      Maxminm i%: rem Calculate max/min no. mines
3992      IF game%(i%, c4%) > maxm%: game%(i%, c4%) = maxm%
3994      IF game%(i%, c4%) < minm%: game%(i%, c4%) = minm%
3996      MITEM#cm; mk - c3%, c0%, nul$ & game%(i%, c4%)
3998     END IF
4000     IF game%(i%, c0%) = c1%: redraw = 1: ELSE : chg = 1
4002   = -7, -13, -19: rem Grid y
4004     game%(i%, j%) = NumSel%(-1, -1, c10%, maxy%, game%(i%, j%), game%(i%, j%))
4006     MITEM#cm; mk, c0%, nul$ & game%(i%, j%)
4008     IF game%(i%, c2%) = c1% THEN
4010      MITEM#cm; mk + c2%, c0%, nul$ & game%(i%, j%)
4012      game%(i%, c1%) = game%(i%, j%)
4014     END IF
4016     IF game%(i%, c4%) >= c0% THEN
4018      Maxminm i%: rem Calculate max/min no. mines
4020      IF game%(i%, c4%) > maxm%: game%(i%, c4%) = maxm%
4022      IF game%(i%, c4%) < minm%: game%(i%, c4%) = minm%
4024      MITEM#cm; mk - c1%, c0%, nul$ & game%(i%, c4%)
4026     END IF
4028     IF game%(i%, c0%) = c1%: redraw = 1: ELSE : chg = 1
4030   = -6, -12, -18: rem x
4032     s% = MSTAT%(#cm; mk)
4034     game%(i%, j%) = s%
4036     IF s% = c1% THEN
4038      st% = MSTAT%(#cm; mk - c1%, cm1%\ c0%)
4040     ELSE
4042      st% = MSTAT%(#cm; mk - c1%, c0%\ c0%)
4044     END IF
4046     chg = 1
4048   = -8, -14, -20: rem Mines
4050     Maxminm i%: rem Calculate max/min no. mines
4052     game%(i%, j%) = NumSel%(-1, -1, minm%, maxm%, game%(i%, j%), gameM$)
4054     o$ = GetOpt$(game%(i%, j%), gameM$)
4056     MITEM#cm; mk, c0%, o$
4058     s% = c0%
4060     IF game%(i%, c0%) = c1%: redraw = 1: ELSE : chg = 1
4062   = -9, -15, -21: rem Timer
4064     game%(i%, j%) = NumSel%(-1, -1, c5%, 999, game%(i%, j%), gameT$)
4066     o$ = GetOpt$(game%(i%, j%), gameT$)
4068     MITEM#cm; mk, c0%, o$
4070     s% = c0%
4072     IF game%(i%, c0%) = c1%: redraw = 1: ELSE : chg = 1
4074   = -22: rem Save now
4076     CfgSave: Ping 'saved'
4078     s% = cm1%: chg = 0
4080  END SELect
4082  IF chg OR redraw: st% = MSTAT%(#cm; -22, c0%\ c0%)
4084 END REPeat ml
4086 MCLEAR#cm: CLOSE#cm
4088 IF redraw: chg = 1
4090 TechnicalResume
4092 RETurn chg
4094 END DEFine MenuGame
4096 :
4098 DEFine PROCedure Maxminm(g%)
4100 rem Calculate max and min number of mines for this grid size
4102 rem This to avoid crash (max too large) or stack overflow (min too small)
4104 minm% = game%(g%, c1%) * game%(g%, c3%) DIV 12: rem Min mines
4106 maxm% = minm% * c4%: rem Max mines
4108 END DEFine Maxminm
4110 :
4112 DEFine PROCedure SetGame
4114 LOCal i%, g%
4116 g% = cm1%
4118 rem Find current game
4120 FOR i% = c0% TO DIMN(game%)
4122  IF game%(i%, c0%) = c1%: g% = i%: EXIT i%
4124 END FOR i%
4126 IF g% = cm1%: g% = c0%: rem Nine found: Default is game #0
4128 grdx% = game%(g%, c1%) - c1%: grdy% = game%(g%, c3%) - c1%
4130 IF game%(g%, c4%) = cm1% THEN
4132  gme_mcauto% = on%
4134 ELSE
4136  gme_mcauto% = off%
4138  mcount% = game%(g%, c4%)
4140 END IF
4142 i% = game%(g%, c5%)
4144 SELect ON i%
4146  = cm1%: rem Auto
4148    tmr_use% = on%
4150    tmr_auto% = on%
4152    tmr_cup% = off%
4154  = -2: rem Count time
4156    tmr_use% = on%
4158    tmr_cup% = on%
4160    tmr_auto% = off%
4162  = -3: rem No timer
4164    tmr_use% = off%
4166    tmr_auto% = off%
4168    tmr_cup% = off%
4170  = REMAINDER : rem Seconds
4172    tmr_use% = on%
4174    tmr_auto% = off%
4176    tmr_cup% = off%
4178    tmr_start% = game%(g%, c5%)
4180 END SELect
4182 END DEFine SetGame
4184 :
4186 DEFine PROCedure MenuStats
4188 LOCal wl, cm, mk
4190 LOCal xs%, ys%, dx%, i%, j%
4192 TechnicalPause
4194 xs% = xsize% - 20: ys% = ysize% - 60
4196 cm = FOPEN(con$): ERT cm
4198 MSETUP#cm; mn_info, prec%(c10%) + c10%, prec%(11) + 40, xs%, ys%
4200 MINOB#cm; c2%, c1%, 'Stats'
4202 MDRAW#cm; mn_info
4204 MWINDOW#cm; c6%! c0%
4206 OVER#cm; c0%
4208 xs% = xs% - c4%: ys% = ys% - 26
4210 dx% = xs% DIV 50: c% = c0%
4212 FOR i% = c0% TO xs% - dx% STEP dx%
4214  j% = RND(c% TO ys%): c% = c% + c2%
4216  WM_BLOCK#cm; dx%, j%, i%, ys% - j%, sp_infwinfg%
4218 END FOR i%
4220 WM_STRIP#cm; sp_infwinbg%
4222 CURSOR#cm; (xs% - 126) DIV c2%, ys% DIV c2%
4224 PRINT#cm; ' Stats not available '
4226 REPeat wl
4228  mk = MCALL(#cm; mk, c0%)
4230  SELect ON mk
4232   = -2: Help#cm; 'hlp_stats'
4234   = -3: Ping ok$: EXIT wl
4236  END SELect
4238 END REPeat wl
4240 MCLEAR#cm: CLOSE#cm
4242 TechnicalResume
4244 END DEFine MenuStats
4246 :
4248 DEFine PROCedure GameLoose
4250 TimerStop
4252 game = lost
4254 MITEM#ch%; li_new%, spr%, sp_sour
4256 END DEFine GameLoose
4258 :
4260 DEFine PROCedure GameWin
4262 TimerStop
4264 game = won
4266 Ping 'win'
4268 MITEM#ch%; li_new%, spr%, sp_cool
4270 END DEFine GameWin
4272 :
4274 DEFine PROCedure GameStart
4276 LOCal grd%
4278 grd% = grdx% * grdy%
4280 moves% = off%: rem No moves have been made
4282 IF 0 THEN
4284  rem ####
4286 IF autosave THEN
4288  sco = GetMagic(fnmscore$, mgDmsc$)
4290  IF sco < 0: ErrMess 'Opening score file\' & sco: RETurn
4292  PUT#sco\ 2E9; DATE, grd%, c0%, mcount%, mleft%
4294  CLOSE#sco
4296 END IF
4298 END IF
4300 TimerStart
4302 game = playing%
4304 END DEFine GameStart
4306 :
4308 DEFine PROCedure GameStop
4310 rem Stop game = loose game except in certain circumstances
4312 IF moves% = on% THEN
4314  game = lost
4316 ELSE
4318  IF gme_jsd% = off% AND game = playing% THEN
4320   game = stopped
4322  ELSE
4324   game = lost
4326  END IF
4328 END IF
4330 END DEFine GameStop
4332 :
4334 DEFine FuNction GetScore
4336 sco = GetMagic(fnmscore$, mgDmsc$)
4338 IF sco < 0: RETurn sco
4340 rem ###
4342 CLOSE#sco
4344 END DEFine GetScore
4346 :
4348 DEFine FuNction GetMagic(fnm$, mg$)
4350 LOCal i%, ch
4352 ch = FOPEN(fnm$): IF ch < 0: RETurn ch
4354 FOR i% = c1% TO LEN(mg$)
4356  IF INKEY$(#ch; cm1%) <> mg$(i%): CLOSE#ch: RETurn -12
4358 END FOR i%
4360 dummy% = CODE(INKEY$(#ch; cm1%)): rem Final lf
4362 RETurn ch
4364 END DEFine GetMagic
4366 :
4368 DEFine PROCedure GameMenu
4370 redraw = 0
4372 xp% = prec%(c10%) + 90: yp% = prec%(11) + 38
4374 IF MenuGame(xp%, yp%): Ping ok$
4376 IF redraw THEN
4378  SetGame
4380  NewWin prec%(c10%) - c2%, prec%(11) - c2%
4382 END IF
4384 END DEFine GameMenu
4386 :
4388 rem     Messages start
4390 :
4392 DEFine FuNction PreWarn(msg$, ch1$, ch2$, ch3$)
4394 LOCal adr, r, xo%, yo%, par$
4396 Burp 'warn'
4398 xo% = (SCR_XLIM(#ch%) - 240) DIV c2%
4400 yo% = (SCR_YLIM(#ch%) - 100) DIV c2%
4402 adr = ALCHP(4)
4404 par$ = HEX$(adr, 32) & hsh$ & cfname$ & spc$ & cfver$ & hsh$ & msg$ & hsh$ & ch1$ & hsh$ & ch2$ >>
      & hsh$ & ch3$
4406 EW msgprg$; HEX$(240, _w%) & HEX$(100, _w%) & HEX$(xo%, _w%) & HEX$(yo%, _w%) & HEX$(c0%, 32) & >>
      par$
4408 r = PEEK_L(adr): RECHP adr
4410 RETurn r
4412 END DEFine PreWarn
4414 :
4416 DEFine PROCedure ErrMess(tx$)
4418 LOCal i%, ce, c%, x%, y%
4420 Burp 'warn'
4422 ce = FOPEN(con$)
4424 rem Count lines in message (max == 6, not checked)
4426 c% = c0%
4428 FOR i% = c1% TO LEN(tx$)
4430  IF tx$(i%) = bks$: c% = c% + c1%
4432 END FOR i%
4434 IF c% < c3%: c% = c3%
4436 y% = prec%(11) + (prec%(c9%) - (c% * c10% + 48)) DIV c2%
4438 x% = prec%(c10%) + (prec%(c8%) - 136) DIV c2%
4440 MDRAW#ce; mn_err, x%, y%, 136, 56 + c% * c10%
4442 MWINDOW#ce; c3%! c0%: WM_INK#ce; sp_errfg%
4444 Split#ce, 21, tx$
4446 er = MCALL(#ce): MCLEAR#ce: CLOSE#ce
4448 END DEFine ErrMess
4450 :
4452 DEFine PROCedure Split(ch%, w%, t$)
4454 LOCal wl, p%, s%
4456 rem Slice lines at \ and print centred
4458 rem v0.01 March 25th 2005
4460 p% = c1%
4462 REPeat wl
4464  IF p% > LEN(t$): EXIT wl
4466  s% = '\' INSTR t$(p% TO LEN(t$))
4468  IF s% > 0 THEN
4470   PRINT#ch%; Centre$(w%, t$(p% TO p% + s% - c2%))
4472   p% = p% + s%
4474  ELSE
4476   PRINT#ch%;! Centre$(w%, t$(p% TO LEN(t$)))
4478   EXIT wl
4480  END IF
4482 END REPeat wl
4484 END DEFine Split
4486 :
4488 DEFine PROCedure Help(hc%, hlp$)
4490 LOCal t%
4492 t% = tpause%
4494 IF t% = c0%: TechnicalPause
4496 MessWin#hc%; hlpxs%, hlpys%, hlpprg$, homed$ & hlp$ & hx$, prec%
4498 IF t% = c0%: TechnicalResume
4500 END DEFine Help
4502 :
4504 DEFine PROCedure About
4506 Ping 'startup'
4508 IF Choose%(#ch%; 'About', Centre$(abtcx%, cfname$ & spc$ & cfver$) & '\' & Centre$(abtcx%, ' >>
     ©pjwitte 2oo4'), ok$, 'Readme', nul$) = c2% THEN
4510  Help#ch%; 'Readme'
4512 END IF
4514 Ping ok$
4516 END DEFine About
4518 :
4520 DEFine FuNction Choose%(cc%, tit$, msg$, ch1$, ch2$, ch3$)
4522 LOCal adr, r
4524 TechnicalPause
4526 IF prec%(c8%) <= wrnxs% THEN
4528  prec%(c9%) = wrnys% + wrnys%
4530  adr = ALCHP(4)
4532  MessWin#cc%; wrnxs%, wrnys%, msgprg$, HEX$(adr, 32) & hsh$ & tit$ & hsh$ & msg$ & hsh$ & ch1$  >>
     & hsh$ & ch2$ & hsh$ & ch3$, prec%
4534  r = PEEK_L(adr): RECHP adr
4536 ELSE
4538  r = ITEM_SELECT(tit$, msg$, ch1$, ch2$, ch3$)
4540 END IF
4542 TechnicalResume
4544 RETurn r
4546 END DEFine Choose%
4548 :
4550 DEFine FuNction Warn(msg$, ch1$, ch2$, ch3$)
4552 Burp 'warn'
4554 RETurn Choose%(#ch%; 'Warning', msg$, ch1$, ch2$, ch3$)
4556 END DEFine Warn
4558 :
4560 DEFine FuNction WarnGame
4562 IF game = playing% AND moves% = on% THEN
4564  IF Warn(Centre$(39, 'Game in progress!') & '\If you continue the game is lost!','Resume', ' >>
     Quit game',  nul$) = 2 THEN
4566   Burp 'loose': GameLoose
4568   RETurn 1
4570  ELSE
4572   RETurn 0
4574  END IF
4576 ELSE
4578  IF moves% = off%: TechnicalPause
4580 END IF
4582 RETurn 1
4584 END DEFine WarnGame
4586 :
4588 rem <-                          MessWin                       ->
4590 :
4592 DEFine PROCedure MessWin(ch%, sx%, sy%, prg$, par$, pr%)
4594 LOCal hl, id, xo%, yo%, p$(c8%)
4596 rem Display a message window larger than the job window
4598 rem V0.01 February 6th 2005
4600 rem V0.02 March 25th 2005   Supports jobownpal
4602 :
4604 rem Parameters:
4606 rem window x and y size, display program name, additional
4608 rem parameter, current pointer record
4610 :
4612 rem The job at the other end must parse the following
4614 rem standard parameters (in consecutive hex):
4616 rem sizex.w, sizey.w, xorig.w, yorig.w, syspal.b
4618 rem The calling routine can append additional parameters
4620 rem in par$
4622 :
4624 xo% = pr%(c10%) + pr%(c8%) DIV c2%
4626 yo% = pr%(11) + pr%(c9%) DIV c2%
4628 xo% = xo% - (sx% DIV c2%): IF xo% < c0%: xo% = c0%
4630 yo% = yo% - (sy% DIV c2%): IF yo% < c0%: yo% = c0%
4632 IF palno = 4: p$ = HEX$(palset, 32): ELSE : p$ = HEX$(palno, 32)
4634 IF (xo% + sx% + c4%) > SCR_XLIM(#ch%): xo% = SCR_XLIM(#ch%) - sx% - c4%
4636 IF (yo% + sy% + c4%) > SCR_YLIM(#ch%): yo% = SCR_YLIM(#ch%) - sy% - c4%
4638 id = EXF(prg$; HEX$(sx%, _w%) & HEX$(sy%, _w%) & HEX$(xo%, _w%) & HEX$(yo%, _w%) & p$ & par$)
4640 :
4642 REPeat hl
4644  RDPT#ch%; mwtv%
4646  IF JobLives(id) THEN
4648   PTOP#ch%; id
4650  ELSE
4652   EXIT hl
4654  END IF
4656 END REPeat hl
4658 END DEFine MessWin
4660 :
4662 DEFine FuNction JobLives(jid)
4664 LOCal nj, n
4666 IF jid = 0: RETurn 1
4668 REPeat nj
4670  n = NXJOB(n, 0)
4672  IF n = 0 OR n = jid: EXIT nj
4674 END REPeat nj
4676 RETurn n
4678 END DEFine JobLives
4680 :
4682 rem             Messages end
4684 :
4686 DEFine FuNction Spra$(spr)
4688 RETurn '@?' & LIN2STR$(spr)
4690 END DEFine Spra$
4692 :
4694 DEFine PROCedure Ping(nm$)
4696 rem Nice sound
4698 IF sound = 2 THEN
4700  IF FTEST(snd$ & nm$ & sx$) = 0 THEN
4702   KILLSOUND: SOUNDFILE snd$ & nm$ & sx$
4704  ELSE
4706   BEEP c2%, c2%
4708  END IF
4710 ELSE
4712  IF sound: BEEP c2%, c2%
4714 END IF
4716 END DEFine Ping
4718 :
4720 DEFine PROCedure Burp(nm$)
4722 rem Bad sound
4724 IF sound = 2 THEN
4726  IF FTEST(snd$ & nm$ & sx$) = 0 THEN
4728   KILLSOUND: SOUNDFILE snd$ & nm$ & sx$
4730  ELSE
4732   BEEP 999, 999
4734  END IF
4736 ELSE
4738  IF sound: BEEP 999, 999
4740 END IF
4742 END DEFine Burp
4744 :
4746 DEFine PROCedure SetSound(s)
4748 IF s THEN
4750  IF ssspresent: sound = 2: ELSE : sound = 1
4752 ELSE
4754  sound = 0
4756 END IF
4758 END DEFine SetSound
4760 :
4762 DEFine PROCedure SetDefaults
4764 hit% = c1%: do% = c2%:    rem Mouse buttons
4766 SetSound 1
4768 palno = 0:                rem palette number
4770 rem tmr_start% = 30:          rem Timer start time
4772 tmr_fact = 25:            rem Timer time factor
4774 tmr_end% = c0%:           rem Timer end time (count down)
4776 tmr_use% = on%:           rem Use timer
4778 tmr_cup% = off%:          rem Timer count up: 0 = down (default)
4780 tmr_auto% = on%:          rem Autocalculate time
4782 tmr_pause% = off%
4784 tmr_wru% = 989
4786 tmr_wrd% = 6
4788 spot% = c4%:              rem spot colour default
4790 butbf = bfpresent:        rem Use button frame if available..
4792 butx% = cm1%: buty% = cm1%: rem ..if not available use this position
4794 saveonx = 0:              rem Save on exit
4796 gme_cup% = c0%:           rem Game scoring variables
4798 gme_jst% = c0%
4800 gme_jsd% = c0%
4802 gme_mcauto% = on%:        rem Auto mine count
4804 gme_chg = 0:              rem Game changed outside game menu flag
4806 autosave = 1:             rem Autosave score after each game
4808 :
4810 palno = 4:                rem Defaults to own palette
4812 xpos% = cm1%: ypos% = cm1%: rem Window at pointer position
4814 :
4816 col_imc = '15772200':     rem Counter ink = $F0AA28 - orange
4818 col_pmc = 0:              rem Counter paper
4820 col_itm = '15772200':     rem Timer ink = $F0AA28 - orange
4822 col_ptm = 0:              rem Timer paper black
4824 col_itw = '16711680':     rem Timer ink = $FF0000 - red
4826 col_ptw = -1:             rem Warning paper white
4828 col_ito = '8421504':      rem Timeout ink $808080 - dark grey
4830 col_pto = '15790320':     rem Timeout paper $F0F0F0 - light grey
4832 END DEFine SetDefaults
4834 :
4836 DEFine PROCedure PrePreWarn(tx$)
4838 ch% = FOPEN("con_264x70"): Burp 'loose'
4840 BORDER#ch%; 1, 255: PAPER#ch%; 2: CLS#ch%
4842 PRINT#ch%; Centre$(44, cfname$ & spc$ & cfver$)
4844 PRINT#ch%; Centre$(44, FILL$('-', LEN(cfname$ & spc$ & cfver$)))\\
4846 PRINT#ch%; Centre$(44, tx$)\\
4848 PRINT#ch%; Centre$(44, 'Press any key to quit')
4850 PAUSE#ch%: QUIT
4852 END DEFine PrePreWarn
4854 :
4856 DEFine PROCedure TstSSS
4858 LOCal adr
4860 rem GLOBal ssspresent
4862 rem Test for presence of Sampled Sound System
4864 rem V0.01 pjwitte 2oo5
4866 :
4868 adr = ALCHP(26)
4870 POKE_L adr + 0, HEX("43fa0016"): rem lea.l result,a1
4872 POKE_L adr + 4, HEX("26780070"): rem move.l exv_i4,a3
4874 POKE_L adr + 8, HEX("0cab5353"): rem cmp.l #sss.flag,-8(a3)
4876 POKE_L adr + 12, HEX("5353fff8")
4878 POKE_L adr + 16, HEX("57e90001"): rem seq 1(a1)
4880 POKE_W adr + 20, HEX("7000")    : rem moveq#0,d0
4882 POKE_W adr + 22, HEX("4e75")    : rem rts
4884 POKE_W adr + 24, 0              : rem ds.w 1
4886 CALL adr
4888 ssspresent = PEEK_W(adr + 24)
4890 RECHP adr
4892 END DEFine TstSSS
4894 :