get "libhdr" static $( randstate = 0 $) manifest $( nummask = #XF flagmask = #X10 bombmask = #X20 revealed = #X40 MAXINT = (~0)>>1 MININT = ~MAXINT $) let min(x,y) = x x, y and max(x,y) = x>y -> x, y let rand() = valof $( randstate := random(randstate) resultis randstate >> 7 $) let randto(x) = valof $( let r, mask = ?, 1 while mask false, valof $( for xa = max(x-1, 0) to min(x+1, xsize-1) for ya = max(y-1, 0) to min(y+1, ysize-1) $( let loc = ya*xsize+xa let n = field!loc & nummask field!loc := (field!loc & ~nummask) | (n + 1) $) field!(y*xsize+x) := field!(y*xsize+x) | bombmask resultis true $) // Populate the field with N bombs let populate(field, xsize, ysize, nbombs) be $( for i=0 to xsize*ysize-1 do field!i := 0 while nbombs > 0 $( let x, y = randto(xsize), randto(ysize) if placebomb(field, xsize, ysize, x, y) then nbombs := nbombs - 1 $) $) // Reveal field (X,Y) - returns true if stepped on a bomb let reveal(field, xsize, ysize, x, y) = (field!(y*xsize+x) & bombmask) ~= 0 -> true, valof $( let loc = y*xsize+x field!loc := field!loc | revealed if (field!loc & nummask) = 0 then for xa = max(x-1, 0) to min(x+1, xsize-1) for ya = max(y-1, 0) to min(y+1, ysize-1) if (field!(ya*xsize+xa) & (bombmask | flagmask | revealed)) = 0 do reveal(field, xsize, ysize, xa, ya) resultis false $) // Toggle flag let toggleflag(field, xsize, ysize, x, y) be $( let loc = y*xsize+x field!loc := field!loc neqv flagmask $) // Show the field. Returns true if won. let showfield(field, xsize, ysize, kaboom) = valof $( let bombs, flags, hidden, found = 0, 0, 0, 0 for i=0 to xsize*ysize-1 $( if (field!i & revealed) = 0 do hidden := hidden + 1 unless (field!i & bombmask) = 0 do bombs := bombs + 1 unless (field!i & flagmask) = 0 do flags := flags + 1 if (field!i & bombmask) ~= 0 & (field!i & flagmask) ~= 0 do found := found + 1 $) writef("Bombs: %N - Flagged: %N - Hidden: %N*N", bombs, flags, hidden) wrch('+') for x=0 to xsize-1 do wrch('-') writes("+*N") for y=0 to ysize-1 $( wrch('|') for x=0 to xsize-1 $( let loc = y*xsize+x test kaboom & (field!loc & bombmask) ~= 0 do wrch('**') or test (field!loc & (flagmask | revealed)) = flagmask do wrch('?') or test (field!loc & revealed) = 0 do wrch('.') or test (field!loc & nummask) = 0 do wrch(' ') or wrch('0' + (field!loc & nummask)) $) writes("|*N") $) wrch('+') for x=0 to xsize-1 do wrch('-') writes("+*N") resultis found = bombs $) // Ask a question, get number let ask(q, min, max) = valof $( let n = ? $( writes(q) n := readn() $) repeatuntil min <= n <= max resultis n $) // Read string let reads(v) = valof $( let ch = ? v%0 := 0 $( ch := rdch() if ch = endstreamch then resultis false v%0 := v%0 + 1 v%(v%0) := ch $) repeatuntil ch = '*N' resultis true $) // Play game given field let play(field, xsize, ysize) be $( let x = ? let y = ? let ans = vec 80 if showfield(field, xsize, ysize, false) $( writes("*NYou win!*N") finish $) $( writes("*NR)eveal, F)lag, Q)uit? ") unless reads(ans) finish unless ans%0 = 2 & ans%2='*N' loop ans%1 := ans%1 | 32 if ans%1 = 'q' then finish $) repeatuntil ans%1='r' | ans%1='f' y := ask("Row? ", 1, ysize)-1 x := ask("Column? ", 1, xsize)-1 switchon ans%1 into $( case 'r': unless (field!(y*xsize+x) & flagmask) = 0 $( writes("*NError: that field is flagged, unflag it first.*N") endcase $) unless (field!(y*xsize+x) & revealed) = 0 $( writes("*NError: that field is already revealed.*N") endcase $) if reveal(field, xsize, ysize, x, y) $( writes("*N K A B O O M *N*N") showfield(field, xsize, ysize, true) finish $) endcase case 'f': test (field!(y*xsize+x) & revealed) = 0 do toggleflag(field, xsize, ysize, x, y) or writes("*NError: that field is already revealed.*N") endcase $) wrch('*N') $) repeat let start() be $( let field, xsize, ysize, bombs = ?, ?, ?, ? writes("Minesweeper*N-----------*N*N") randstate := ask("Random seed? ", MININT, MAXINT) xsize := ask("Width (4-64)? ", 4, 64) ysize := ask("Height (4-22)? ", 4, 22) // 10 to 20% bombs bombs := muldiv(xsize,ysize,10) + randto(muldiv(xsize,ysize,10)+1) field := getvec(xsize*ysize) populate(field, xsize, ysize, bombs) play(field, xsize, ysize) $)