lynx-snapshots - Unnamed repository; edit this file 'description' to name the repository.

diff options

Diffstat (limited to 'WWW/Library/Implementation/HTPlain.c')

0 files changed, 0 insertions, 0 deletions

; Minesweeper game ; Mouse clicks call HIT procedure ; Main data structure: array of arrays, e.g., ; (ITEM (ITEM STATUS 3) 5) for row 3 column 5. ; Values are: HIDDEN (tan square), ; FLAGGED (flagged as a mine), ; SHOWN (open, non-mine, shows number of mined neighbors), ; BORDER (just outside of actual playing field). ; Notice that a FLAGGED square might not really be a mine. ; (Player can make mistakes!) ; Actual mines are listed in MINES (list of [row col] lists). cslsload "buttons to mines if :LogoPlatform = "Windows [maximize.window "true] localmake "inference "false localmake "newnmines 100 localmake "newsize 15 localmake "halfsize 10 localmake "squaresize 2*:halfsize localmake "maxxmax :halfsize*15*2 localmake "maxymax :halfsize*15 localmake "sizechoice 3 localmake "hardchoice 2 localmake "sizes [5 10 15] localmake "hardness [38.1 44.45 59.26] localmake "windows ifelse :LogoPlatform="Windows [16] [0] if :LogoPlatform="wxWidgets [make "windows 16] norefresh catch "quit [forever [catch "newgame [setup :newnmines :newsize :newsize*2]]] refresh cs ct setpc 7 st end ; ------------------------ Initial setup --------------------------------- to setup :nmines :rows :columns cs ct wait 0 ht fs localmake "mines [] ; list of [row col] lists localmake "statuses (array :rows+2 -1) ; status of each square localmake "xmax :halfsize*:columns localmake "ymax :halfsize*:rows localmake "opening "true localmake "playing "true ; false only at end of game for [i -1 :rows] [setitem :i :statuses (array :columns+2 -1)] putmines :nmines ; Choose mined squares randomly. setbg 0 setup.buttons make "nhidden :rows * :columns borderrow -1 :columns borderrow :rows :columns ; mark nonexistent squares just outside field as BORDER ; to simplify how-many-of-my-neighbors computations bordersides :rows-1 hint ; open some safe squares so we don't have to guess blindly localmake "prevmines -1 pu setxy :maxxmax-100-2*:windows :maxymax+14 setpc 7 label [Mines left:] showminesleft action.loop end to putmines :num ; Choose random square, and make it a mine unless it already was one. if :num = 0 [stop] localmake "row random :rows localmake "col random :columns if member? (list :row :col) :mines [putmines :num stop] make "mines fput (list :row :col) :mines putmines :num-1 end to setup.buttons init.buttons setbutton (list -:maxxmax :maxymax+10) [60 20] [throw "newgame] ~ "false 0 "|NEW GAME| "G setbutton (list 80-:maxxmax :maxymax+10) [40 20] [action.off throw "quit] ~ "false 0 "QUIT "Q caption (list 160-:maxxmax-:windows :maxymax+10) [60 20] "infer: drawinferbuttons caption (list -:maxxmax -(:maxymax+30)) [60 20] "size: caption (list 160-:maxxmax-:windows -(:maxymax+30)) [80 20] "difficulty: drawsizebuttons setbutton (list -:xmax -:ymax) (list 2*:xmax 2*:ymax) ~ [hit :mousepos showminesleft] "false 9 "|| [] ; Entire board is one big button. showboard "false ; input is TRUE to uncover entire board at end of game pu end to drawinferbuttons rebutton (list 200-:maxxmax :maxymax+10) [20 20] ~ [make "inference "true drawinferbuttons] ~ :inference 0 "Y "Y rebutton (list 230-:maxxmax :maxymax+10) [20 20] ~ [make "inference "false drawinferbuttons] ~ not :inference 0 "N "N end to drawsizebuttons make "newsize item :sizechoice :sizes make "newnmines int (item :hardchoice :hardness)*:newsize*:newsize/100 rebutton (list 40-:maxxmax -(:maxymax+30)) [20 20] ~ [make "sizechoice 1 drawsizebuttons] ~ :sizechoice=1 0 "S "S rebutton (list 70-:maxxmax -(:maxymax+30)) [20 20] ~ [make "sizechoice 2 drawsizebuttons] ~ :sizechoice=2 0 "M "M rebutton (list 100-:maxxmax -(:maxymax+30)) [20 20] ~ [make "sizechoice 3 drawsizebuttons] ~ :sizechoice=3 0 "L "L rebutton (list 230-:maxxmax -(:maxymax+30)) [20 20] ~ [make "hardchoice 1 drawsizebuttons] ~ :hardchoice=1 0 "1 "1 rebutton (list 260-:maxxmax -(:maxymax+30)) [20 20] ~ [make "hardchoice 2 drawsizebuttons] ~ :hardchoice=2 0 "2 "2 rebutton (list 290-:maxxmax -(:maxymax+30)) [20 20] ~ [make "hardchoice 3 drawsizebuttons] ~ :hardchoice=3 0 "3 "3 end to showminesleft if :prevmines=:nmines [stop] setpensize [2 2] penerase if :prevmines > 99 [pu seth 0 setxy :maxxmax-30 :maxymax+14 invoke word "draw int :prevmines/100 7] if :prevmines > 9 [pu seth 0 setxy :maxxmax-19 :maxymax+14 invoke word "draw int (remainder :prevmines 100)/10 7] if :prevmines > -1 [pu seth 0 setxy :maxxmax-8 :maxymax+14 invoke word "draw remainder :prevmines 10 7] penpaint if :nmines > 99 [pu seth 0 setxy :maxxmax-30 :maxymax+14 invoke word "draw int :nmines/100 7] if :nmines > 9 [pu seth 0 setxy :maxxmax-19 :maxymax+14 invoke word "draw int (remainder :nmines 100)/10 7] if :nmines > -1 [pu seth 0 setxy :maxxmax-8 :maxymax+14 invoke word "draw remainder :nmines 10 7] make "prevmines :nmines pu seth 0 setpensize [1 1] end ; --------------------------- Mark border squares ------------------------- to borderrow :row :col ; Mark all squares on this row (including -1 and :columns) as border setstatus :row :col "border if :col < 0 [stop] borderrow :row :col-1 end to bordersides :row ; Mark squares -1 and :columns on all rows as border if :row < 0 [stop] setstatus :row -1 "border setstatus :row :columns "border bordersides :row-1 end ; ---------------------- Initial and final display of entire board -------- to showboard :over ; Input is FALSE during setup, TRUE when a mine is uncovered and game ends. setpc 7 for [y -:ymax :ymax :squaresize] [pu setxy -:xmax :y pd setxy :xmax :y] for [x -:xmax :xmax :squaresize] [pu setxy :x -:ymax pd setxy :x :ymax] pu turtlerows :rows-1 end to turtlerows :row if :row < 0 [stop] turtlerow :columns-1 turtlerows :row-1 end to turtlerow :col if :col < 0 [stop] ifelse :over [ ; game over, only hidden squares need be displayed if "hidden = status :row :col [onesquare] if and ("flagged = status :row :col) (not member? (list :row :col) :mines) [ ; but indicate mistakenly flagged ones setx (:col*:squaresize)-:xmax sety (:row*:squaresize)-:ymax setpensize [3 3] setpc 4 ; draw red X over mine symbol pd setxy xcor+:squaresize ycor+:squaresize pu setx xcor-:squaresize pd setxy xcor+:squaresize ycor-:squaresize pu setpensize [1 1] setpc 7 ] ] [ ; game starting, mark each square as hidden setstatus :row :col "hidden ] turtlerow :col - 1 end to onesquare action.once setx (:col*:squaresize)-:xmax sety (:row*:squaresize)-:ymax ifelse member? (list :row :col) :mines [ setpc 2 ; thick green border pu setxy xcor+1 ycor+1 pd repeat 4 [fd :squaresize-2 rt 90] pu setxy xcor+1 ycor+1 pd filled 13 [repeat 4 [fd :squaresize-4 rt 90]] ] [ setpc 11 ; grey in aqua border for empty pu setxy xcor+1 ycor+1 pd filled 15 [repeat 4 [fd :squaresize-2 rt 90]] ] end ; ---------------- Start game by uncovering a few safe squares -------------- to hint [:tries 30] [:inference "true] if :tries=0 [stop] ; limit number of attempts localmake "ohidden :nhidden localmake "ry random :rows localmake "rx random :columns if and equalp status :ry :rx "hidden not member? (list :ry :rx) :mines [ catch "error [hitsquare :ry :rx] if (:ohidden - :nhidden) > 5 [stop] ; stop when at least 5 neighbors were opened ] (hint :tries-1) end ; -------- Main player activity, mouse clicks on minefield squares ----- to hit :pos ; Convert mouse (pixel) coordinate to column and row numbers ; (square is :squaresize x :squaresize pixels) if not :playing [stop] localmake "opening equalp :button 1 ; true to open, false to flag catch "error [hitsquare (int (((last :pos) + :ymax) / :squaresize)) (int (((first :pos) + :xmax) / :squaresize))] end to hitsquare :row :col ; Called on player mouse click and automatic opening of neighbors ; when infering. if :nhidden = 0 [stop] ; No hidden squares, game is over. if (or (:row<0) (:row>=:rows) (:col<0) (:col>=:columns)) [stop] penup setx (:col*:squaresize)-:xmax ; Move turtle over chosen square sety (:row*:squaresize)-:ymax localmake "status status :row :col localmake "near neighbors :row :col "minecheck if not equal? :status "shown [ ; Clicking on hidden or flagged square. if not :opening [showflag stop] ; FLAG mode. (Below is OPEN mode.) if :status = "flagged [showflag stop] ; Can't open flagged square. setstatus :row :col "shown ; This square is now shown. if member? (list :row :col) :mines [lose stop] ; Oops! setpc 11 ; aqua border pu setxy xcor+1 ycor+1 pd filled 15 [repeat 4 [fd :squaresize-2 rt 90]] setpensize [2 2] seth 0 pu setxy xcor+6 ycor+3 if :near>0 word "draw :near ; Run procedure to draw digit pu setpensize [1 1] seth 0 make "nhidden :nhidden - 1 ; Keep track of number of squares still hidden. if :nhidden = 0 [win stop] ; If all squares shown or flagged, we win! if and (not equal? :near 0) (not :inference) [stop] ; Finished if no automatic inference ] ; Automatic inference section: localmake "hnear neighbors :row :col "hiddencheck localmake "fnear neighbors :row :col "flaggedcheck ifelse :fnear = :near [ ; If number of neighboring mines equals localmake "opening "true ; number of flagged neighbors, hitfriends :row :col ; all hidden neighbors must be safe ; (unless player has flagged wrongly!) ] [ if (:hnear + :fnear) = :near [ ; If number of neighboring mines equals localmake "opening "false ; number of non-shown (hidden or flagged) hitfriends :row :col ; neighbors, all hidden neighbors must be ; mines. ] ] end ; --------------- Automatic inference to speed up game ------------------ ; Either OPEN or FLAG all eight immediate neighbors unless already open or ; flagged. Note mutual recursion: HITSQUARE calls HITFRIENDS to do inference; ; HITFRIENDS calls HITSQUARE for each inferred opening/flagging. to hitfriends :row :col hitfriendsrow :row-1 :col hitfriendsrow :row :col hitfriendsrow :row+1 :col end to hitfriendsrow :row :col hitfriend :row :col-1 hitfriend :row :col hitfriend :row :col+1 end to hitfriend :row :col if "hidden = status :row :col [hitsquare :row :col] end ; Here's where we count the neighbors that have some property ; (being truly mined, being flagged as mined, or being hidden). ; Third input is a procedure that takes ROW and COL inputs, ; returning 1 if property is satisfied, 0 if not. to neighbors :row :col :check output (nrow :row-1 :col) + (nrow :row :col) + (nrow :row+1 :col) end to nrow :row :col output (invoke :check :row :col-1) + (invoke :check :row :col) + ~ (invoke :check :row :col+1) end ; Here are the three property-checking procedures. to minecheck :row :col output ifelse member? (list :row :col) :mines [1] [0] end to hiddencheck :row :col output ifelse "hidden = status :row :col [1] [0] end to flaggedcheck :row :col output ifelse "flagged = status :row :col [1] [0] end ; --------------------- Flag mode (user says where mines are) -------------- to showflag if :nhidden = 0 [stop] ; Game is over, no action allowed. localmake "flagged status :row :col ifelse :flagged = "hidden [ ; Square was hidden, so flag it. if :nmines = 0 [stop] ; But don't allow more flags than actual mines. setstatus :row :col "flagged setpc 7 filled 2 [repeat 4 [fd :squaresize rt 90]] pu setxy xcor+6 ycor+3 drawflag ; with purple flag make "nmines :nmines-1 make "nhidden :nhidden-1 ] [ if not equal? :flagged "flagged [stop] ; Square was shown, can't flag it. setstatus :row :col "hidden setpc 7 filled 9 [repeat 4 [fd :squaresize rt 90]] make "nmines :nmines + 1 make "nhidden :nhidden + 1 ] if :nhidden = 0 [win] ; Flagged last mine, so win. end to drawflag setpc 13 ; purple for flag setpensize [2 2] pd fd 5 filled 13 [repeat 4 [fd 5 rt 90]] end ; ------------ Notify user when game is won or lost ------------------- to win make "playing "false make "nhidden 0 ; print [You win!!!!] pu setxy :xmax+3 0 ; flash screen green repeat 5 [setpc 2 fill wait 0 action.once setpc 0 fill wait 0] end to lose make "playing "false setpc 6 ; Yellow square on purple setpensize [3 3] pu setxy xcor+3 ycor+3 pd filled 13 [repeat 4 [fd :squaresize-6 rt 90]] ; Show which mine was hit setpensize [1 1] make "nhidden 0 ; print [You lose!!!!] pu setxy :xmax+3 0 ; flash screen red repeat 5 [setpc 4 fill wait 0 action.once setpc 0 fill wait 0] showboard "true end ; --------------- data abstraction for statuses array ------------- to status :row :col output item :col (item :row :statuses) end to setstatus :row :col :value setitem :col (item :row :statuses) :value end ; -------------------- draw digits ---------------------- to draw1 [:color 4] setpc :color ; red pd rt 90 fd 6 bk 3 lt 90 fd 12 lt 90+45 fd 4 end to draw2 [:color 13] setpc :color ; purple pu setxy xcor-1 ycor+2 pd rt 90 fd 6 bk 6 lt 45 fd 8 rt 45 pu bk 3 pd arc -180 3 end to draw3 [:color 0] setpc :color ; black pu fd 12 rt 90 pd fd 6 rt 90+45 fd 7 pu lt 45 fd 3 pd arc -130 3 end to draw4 [:color 8] setpc :color ; brown pu fd 6 pd fd 6 bk 6 rt 90 fd 6 bk 3 lt 90 fd 6 bk 12 end to draw5 [:color 10] setpc :color ; forest pu fd 12 pd rt 90 fd 6 bk 6 rt 90 fd 5 pu fd 3 pd arc -180 3 end to draw6 [:color 12] setpc :color ; salmon pu fd 7 rt 90 fd 1 pd repeat 270 [fd 0.07 rt 1] repeat 45 [fd 0.3 rt 2] end to draw7 [:color 1] setpc :color ; blue pu fd 11 rt 90 pd fd 6 rt 90+30 fd 9 end to draw8 [:color 5] setpc :color ; magenta pu fd 3 rt 90 fd 2 pd arc 359 3 pu lt 90 fd 6 pd arc 359 3 end to draw9 [:color 7] setpc :color pu fd 12 rt 90 fd 6 rt 90 ; like 6 but upside down pu fd 7 rt 90 fd 1 pd repeat 270 [fd 0.07 rt 1] repeat 45 [fd 0.3 rt 2] end to draw0 [:color 7] setpc :color pu fd 6 pd repeat 90 [fd (2-repcount/90)*6/150 rt 1] repeat 90 [fd (1+repcount/90)*6/150 rt 1] repeat 90 [fd (2-repcount/90)*6/150 rt 1] repeat 90 [fd (1+repcount/90)*6/150 rt 1] end


context:
space:
mode: