Author Topic: Hexagon Minesweeper by bplus  (Read 478 times)

Offline Qwerkey

  • Moderator
  • Forum Resident
  • Posts: 736
Hexagon Minesweeper by bplus
« on: May 17, 2020, 09:59:01 AM »
Hexagon Minesweeper

Author: @bplus
Source: qb64.org Forum
URL: https://www.qb64.org/forum/index.php?topic=1558.msg114148#msg114148
Version: v3.1 Crater
Tags: [Graphics], [2D], [Audio]

Description:
I have a new and improved Hexagonal Minesweeper. I was challenged to add particle explosion at SmallBASIC board at Syntax Bomb forum. Couldn't help myself, I tweaked Crater Maker some more to scale to board size and closer fit to Bomb sound.  PS the exe is for Windows 64

Controls:
Right & Left Mouse Buttons

Source Code:
Code: QB64: [Select]
  1. OPTION _EXPLICIT 'Bplus started 2019-08-08 from quick version of Hex Minesweeper and Minesweeper Custom Field
  2.  
  3. '============================================================================================================
  4. '
  5. '         Hex Minesweeper v3.1: Field Customization, Sound Effects and mod Crator Maker!
  6. '
  7. '                                      bplus mod 2020-02-10
  8. '=============================================================================================================
  9.  
  10. ' Attention: this program creates a file: "Hexagon Minefield Custom Specs.txt"
  11. ' that you edit with your text editor, if you select that option in the opening screen menu.
  12.  
  13. ' 2019-08-13 Hex Minesweeper Custom and Sound.bas add ogg file sound effects
  14. '   Public domain .ogg files source
  15. '   https://bigsoundbank.com/detail-0029-computer-mouse.html
  16. '   and bomb #6: https://www.mediacollege.com/downloads/sound-effects/explosion/
  17.  
  18. '2020-02-09 adding Crator Maker effect I devloped for SmallBASIC 2020-02-08 should work even better with QB64.
  19. '                                      It does indeed!!!!
  20. '
  21. '2020-02-10 refined Crater Maker to scale to board size and Bombsound time of blast
  22. '
  23.  
  24. DEFINT A-Z
  25. CONST P2 = 6.28318531
  26. 'to make things easy set cellR as const at 25
  27. CONST cellR = 25 ' which makes the following constant
  28. DIM SHARED xspacing!, yspacing!
  29. xspacing! = 2 * cellR * COS(_D2R(30)): yspacing! = cellR * (1 + SIN(_D2R(30)))
  30. DIM SHARED xmax, ymax, Xarrd, Yarrd, mines 'set all this in customField sub
  31.  
  32. 'sound events
  33. DIM SHARED ToggleSnd AS LONG, BombSnd AS LONG, ApplauseSnd AS LONG, openSnd AS LONG
  34. DIM SHARED SwooshSnd AS LONG
  35.  
  36. _TITLE "Hexagon Minesweeper v3: Customize, Sound Effects and now Crator Maker"
  37. ToggleSnd = _SNDOPEN("Toggle.ogg")
  38. openSnd = _SNDOPEN("Ticking.ogg")
  39. BombSnd = _SNDOPEN("bomb.ogg")
  40. ApplauseSnd = _SNDOPEN("Applause sm.ogg")
  41. SwooshSnd = _SNDOPEN("Flyby.ogg")
  42. '_SNDPLAY SwooshSnd: IF SwooshSnd = 0 THEN PRINT " not loaded." ELSE PRINT "OK loaded.": END
  43.  
  44. 'rnd reveal sounds
  45. DIM SHARED rndSnd(28) AS LONG
  46. rndSnd(0) = _SNDOPEN("357 shot.ogg")
  47. rndSnd(1) = _SNDOPEN("alarm.ogg")
  48. rndSnd(2) = _SNDOPEN("Apple bite.ogg")
  49. rndSnd(3) = _SNDOPEN("Barkings.ogg")
  50. rndSnd(4) = _SNDOPEN("Bike.ogg")
  51. rndSnd(5) = _SNDOPEN("brake.ogg")
  52. rndSnd(6) = _SNDOPEN("bumble bee.ogg")
  53. rndSnd(7) = _SNDOPEN("creaking.ogg")
  54. rndSnd(8) = _SNDOPEN("crows.ogg")
  55. rndSnd(9) = _SNDOPEN("Ding.ogg")
  56. rndSnd(10) = _SNDOPEN("dinggg.ogg")
  57. rndSnd(11) = _SNDOPEN("Donkey.ogg")
  58. rndSnd(12) = _SNDOPEN("elec phone.ogg")
  59. rndSnd(13) = _SNDOPEN("Fill mug.ogg")
  60. rndSnd(14) = _SNDOPEN("goat.ogg")
  61. rndSnd(15) = _SNDOPEN("hen.ogg")
  62. rndSnd(16) = _SNDOPEN("Horse.ogg")
  63. rndSnd(17) = _SNDOPEN("Kids.ogg")
  64. rndSnd(18) = _SNDOPEN("M scream.ogg")
  65. rndSnd(19) = _SNDOPEN("Male Hilarious.ogg")
  66. rndSnd(20) = _SNDOPEN("Marimba.ogg")
  67. rndSnd(21) = _SNDOPEN("neighing.ogg")
  68. rndSnd(22) = _SNDOPEN("polaris ring.ogg")
  69. rndSnd(23) = _SNDOPEN("pull top can.ogg")
  70. rndSnd(24) = _SNDOPEN("Punch line drum.ogg")
  71. rndSnd(25) = _SNDOPEN("Ring 2.ogg")
  72. rndSnd(26) = _SNDOPEN("Rooster.ogg")
  73. rndSnd(27) = _SNDOPEN("Unlock door.ogg")
  74. rndSnd(28) = _SNDOPEN("whook.ogg")
  75. 'DIM i 'test load and sounds
  76. 'FOR i = 10 TO 10
  77. '    _SNDPLAY (rndSnd(i))
  78. '    PRINT i;
  79. '    IF rndSnd(i) = 0 THEN PRINT i; " not loaded." ELSE PRINT
  80. '    _DELAY 8
  81. 'NEXT
  82. 'END
  83.  
  84. customField
  85. SCREEN _NEWIMAGE(xmax, ymax, 32)
  86. _SCREENMOVE (1280 - xmax) / 2 + 60, (760 - ymax) / 2
  87. TYPE boardType
  88.     x AS SINGLE 'pixel location
  89.     y AS SINGLE 'pixel location
  90.     dx AS SINGLE 'for crator making
  91.     dy AS SINGLE ' ditto
  92.     id AS INTEGER '0 to 6 neighbor mines
  93.     reveal AS INTEGER ' 1 for marked, 0 hidden, -1 for revealed
  94.     mine AS INTEGER '0 or -1
  95. REDIM SHARED b(0 TO Xarrd + 1, 0 TO Yarrd + 1) AS boardType 'oversize the board to make it easy to count mines
  96. DIM SHARED restart
  97. DIM gameOver, cc, cr, mbN, s$, sz!
  98. _TITLE _TRIM$(STR$(Yarrd * Xarrd - mines)) + " Cells to Free   Instructions: Left click Reveals, Right Marks Red"
  99. restart = 1
  100.     gameOver = 0
  101.     WHILE gameOver = 0
  102.         IF restart THEN initialize
  103.         mbN = 0
  104.         getCell cc, cr, mbN
  105.         IF mbN = 1 AND b(cc, cr).reveal = 0 THEN
  106.             IF b(cc, cr).mine THEN 'ka boom
  107.                 makeCrator cc, cr
  108.                 's$ = "KA - BOOOMMMM!"           'comment out since post code
  109.                 'sz! = 1.2 * xmax / LEN(s$)
  110.                 'cText xmax / 2, ymax / 2, sz!, &HFF000000, s$
  111.                 'cText xmax / 2 - 4, ymax / 2 - 4, sz!, &HFFFF0000, s$
  112.                 'cText xmax / 2 - 8, ymax / 2 - 8, sz!, &HFFFFFF00, s$
  113.                 gameOver = -1
  114.                 _DELAY 4
  115.             ELSE
  116.                 b(cc, cr).reveal = -1: showCell cc, cr
  117.                 IF b(cc, cr).id = 0 THEN
  118.                     sweepZeros cc, cr
  119.                 ELSE
  120.                     _SNDPLAY rndSnd(INT(RND * 29))
  121.                 END IF
  122.             END IF
  123.         ELSEIF mbN = 2 THEN
  124.             _SNDPLAY ToggleSnd
  125.             IF b(cc, cr).reveal = 1 THEN
  126.                 b(cc, cr).reveal = 0: showCell cc, cr
  127.             ELSE
  128.                 IF b(cc, cr).reveal = 0 THEN b(cc, cr).reveal = 1: showCell cc, cr
  129.             END IF
  130.         END IF
  131.         IF TFwin THEN
  132.             s$ = "Good Job!"
  133.             sz! = 1.2 * xmax / LEN(s$)
  134.             cText xmax / 2, ymax / 2, sz!, &HFF000000, s$
  135.             cText xmax / 2 - 1, ymax / 2 - 2, sz!, &HFF000055, s$
  136.             _DELAY 4
  137.             _SNDPLAY ApplauseSnd
  138.             _DELAY 7
  139.             gameOver = -1
  140.         END IF
  141.         _LIMIT 60
  142.     WEND
  143.     restart = 1
  144.  
  145. NoOff:
  146. DATA 1,0,0,-1,0,1,-1,-1,-1,0,-1,1
  147.  
  148. xOff:
  149. DATA -1,0,0,-1,0,1,1,-1,1,0,1,1
  150.  
  151. SUB makeCrator (col, row)
  152.     TYPE Particle
  153.         x AS SINGLE
  154.         y AS SINGLE
  155.         dx AS SINGLE
  156.         dy AS SINGLE
  157.         sz AS SINGLE
  158.         c AS _UNSIGNED LONG
  159.         TYPE AS INTEGER
  160.     END TYPE
  161.  
  162.     DIM nP, r, c, a!, i, ra!, red!, j, stopper
  163.     nP = 25 * Xarrd * Yarrd
  164.     DIM p(nP) AS Particle
  165.     _SNDPLAY BombSnd
  166.     _DELAY .500 'need a fairly long delay before actually hear sound
  167.     LINE (0, 0)-(xmax, ymax), &HFFFFFFFF, BF
  168.     _DELAY .01
  169.     CLS
  170.     FOR r = 1 TO Yarrd 'show all mines
  171.         FOR c = 1 TO Xarrd
  172.             IF b(c, r).mine THEN b(c, r).reveal = -1
  173.             showCell c, r
  174.             a! = _ATAN2(b(c, r).y - b(col, row).y, b(c, r).x - b(col, row).x)
  175.             b(c, r).dx = .005 * Xarrd * Yarrd * COS(a!)
  176.             b(c, r).dy = .005 * Xarrd * Yarrd * SIN(a!)
  177.         NEXT
  178.     NEXT
  179.     FOR i = 0 TO nP
  180.         p(i).x = b(col, row).x + RND * 2 * cellR - cellR
  181.         p(i).y = b(col, row).y + RND * 2 * cellR - cellR
  182.         p(i).sz = RND * 6.5 + .1
  183.         ra! = RND * P2
  184.         p(i).dx = .09 * Xarrd * Yarrd / p(i).sz * COS(ra!)
  185.         p(i).dy = .09 * Xarrd * Yarrd / p(i).sz * SIN(ra!)
  186.         red! = RND * 100
  187.         p(i).c = _RGB32(red!, .5 * red! + .1 * red! * RND - .05 * red!, .25 * red! + .05 * red! * RND - .025 * red!)
  188.         p(i).TYPE = INT(RND * 2)
  189.     NEXT
  190.     stopper = .5 * nP 'orig .3
  191.     FOR i = 1 TO 170 'make a Crator!!! maybe runs to long try 70 from original post 270
  192.         CLS
  193.         FOR r = 1 TO Yarrd 'redraw board with cells moved
  194.             FOR c = 1 TO Xarrd
  195.                 IF r = row AND c = col THEN
  196.                 ELSE
  197.                     IF i > 70 THEN
  198.                         b(c, r).dx = .9 * b(c, r).dx
  199.                         b(c, r).dy = .9 * b(c, r).dy
  200.                     END IF
  201.                     b(c, r).x = b(c, r).x + b(c, r).dx
  202.                     b(c, r).y = b(c, r).y + b(c, r).dy
  203.                     showCell c, r
  204.                 END IF
  205.             NEXT
  206.         NEXT
  207.         FOR j = 1 TO stopper
  208.             IF p(j).TYPE THEN
  209.                 fcirc p(j).x, p(j).y, p(j).sz, p(j).c
  210.             ELSE
  211.                 LINE (p(j).x - .5 * p(i).sz, p(j).y - .5 * p(j).sz)-STEP(p(j).sz, p(j).sz), p(j).c, BF
  212.             END IF
  213.             p(j).x = p(j).x + p(j).dx
  214.             p(j).y = p(j).y + p(j).dy
  215.             p(j).dx = .97 * p(j).dx ' original post .992
  216.             p(j).dy = .97 * p(j).dy
  217.         NEXT
  218.         _DISPLAY
  219.         _LIMIT 35
  220.         IF i < 70 THEN stopper = stopper + 80 ' ELSE stopper = stopper + 1
  221.         IF stopper > nP THEN stopper = nP
  222.     NEXT
  223.  
  224. 'set all these 'DIM SHARED xmax, ymax, XarrD, YarrD, mines
  225. SUB customField
  226.     DIM fName$, fe, fLine$, p, inCnt, beenHere, allow$, choice$
  227.  
  228.     fName$ = "Hexagon Minefield Custom Specs.txt"
  229.     IF _FILEEXISTS(fName$) THEN fe = -1 ELSE fe = 0
  230.     allow$ = "12" + CHR$(27)
  231.     PRINT
  232.     PRINT "     Hexagom Minesweeper options:"
  233.     PRINT
  234.     PRINT "  1. Use mine field settings: 10 X 10 cells and 10 mines."
  235.     PRINT "  2. Customize your own field settings."
  236.     IF fe THEN PRINT "  3. Use the last customized mine field settings.": allow$ = allow$ + "3"
  237.     PRINT
  238.     PRINT "     or press esc to quit."
  239.     choice$ = getChar$(allow$)
  240.     SELECT CASE choice$
  241.         CASE "1": xmax = 800: ymax = 600: Xarrd = 10: Yarrd = 10: mines = 10
  242.         CASE "2": GOSUB editCustom
  243.         CASE "3": GOSUB loadCustom
  244.         CASE ELSE: SYSTEM
  245.     END SELECT
  246.     xmax = (Xarrd + 2.5) * xspacing!: ymax = (Yarrd + 2) * yspacing!
  247.     EXIT SUB
  248.  
  249.     editCustom:
  250.     IF fe = 0 THEN
  251.         OPEN fName$ FOR OUTPUT AS #1
  252.         PRINT #1, " "
  253.         PRINT #1, "          Custom Field Specs For Your Hexagon Minesweeper Game"
  254.         PRINT #1, " "
  255.         PRINT #1, " We will be sizing the screen according to a constant cell radius of 25"
  256.         PRINT #1, " and then numbers filled in here."
  257.         PRINT #1, " "
  258.         PRINT #1, " Please fill out the right side of all Equal signs."
  259.         PRINT #1, " "
  260.         PRINT #1, "   X dimensions across the screen:"
  261.         PRINT #1, "         Your Max Screen Width (pixels) = "
  262.         PRINT #1, "      Number of Horizontal Cells Across = "
  263.         PRINT #1, " "
  264.         PRINT #1, "   Y dimensions going down:"
  265.         PRINT #1, "        Your Max Screen Height (pixels) = "
  266.         PRINT #1, "                   Number of Cells Down = "
  267.         PRINT #1, " "
  268.         PRINT #1, "The percent of mines (8 easy - 15 hard) = "
  269.         PRINT #1, " "
  270.         PRINT #1, "    To finish, Save the file and then close the editor."
  271.         CLOSE #1
  272.     END IF
  273.     ' I picked up this shortcut from Ken, normally I would call a text editor that I don't know if you have!
  274.     SHELL fName$
  275.     GOSUB loadCustom
  276.     RETURN
  277.  
  278.     loadCustom:
  279.     beenHere = beenHere + 1 'we'll give it 5 tries
  280.     IF beenHere > 5 THEN
  281.         PRINT "OK we tried 5 times, going with default settings..."
  282.         xmax = 800: ymax = 600: Xarrd = 10: Yarrd = 10: mines = 10
  283.         RETURN
  284.     END IF
  285.     inCnt = 0
  286.     OPEN fName$ FOR INPUT AS #1
  287.     WHILE EOF(1) = 0 ' look to get 5 values from 5 = signs
  288.         LINE INPUT #1, fLine$
  289.         p = INSTR(fLine$, "=")
  290.         IF p > 0 THEN
  291.             inCnt = inCnt + 1
  292.             SELECT CASE inCnt
  293.                 CASE 1: xmax = VAL(rightOf$(fLine$, "="))
  294.                 CASE 2: Xarrd = VAL(rightOf$(fLine$, "="))
  295.                 CASE 3: ymax = VAL(rightOf$(fLine$, "="))
  296.                 CASE 4: Yarrd = VAL(rightOf$(fLine$, "="))
  297.                 CASE 5: mines = VAL(rightOf$(fLine$, "=")) * Xarrd * Yarrd / 100
  298.             END SELECT
  299.             IF inCnt = 5 THEN EXIT WHILE
  300.         END IF
  301.     WEND
  302.     CLOSE #1
  303.     IF inCnt = 5 THEN 'alternate exit from gosub
  304.         IF xmax >= (Xarrd + 2.5) * xspacing! THEN
  305.             IF ymax < (Yarrd + 2) * yspacing! THEN 'all good
  306.                 PRINT "Opps, Screen height is not big enough for Y cells down."
  307.             ELSE
  308.                 RETURN
  309.             END IF
  310.         ELSE
  311.             PRINT "Opps, Screen width is not big enough for X cells across."
  312.         END IF
  313.     ELSE
  314.         PRINT "We did not get everything filled out by = signs."
  315.     END IF
  316.     PRINT: PRINT "Press any to continue.. "
  317.     SLEEP
  318.     SHELL fName$
  319.     GOTO loadCustom
  320.  
  321. SUB initialize ()
  322.     DIM minesPlaced, rx, ry, x, y, nMines, xoffset!
  323.     CLS
  324.     _SNDPLAY openSnd
  325.     restart = 0
  326.     REDIM b(0 TO Xarrd + 1, 0 TO Yarrd + 1) AS boardType
  327.     minesPlaced = 0
  328.     WHILE minesPlaced < mines
  329.         rx = INT(RND * Xarrd) + 1: ry = INT(RND * Yarrd) + 1
  330.         IF b(rx, ry).mine = 0 THEN
  331.             b(rx, ry).mine = -1: minesPlaced = minesPlaced + 1
  332.         END IF
  333.     WEND
  334.     'count mines amoung the neighbors
  335.     FOR y = 1 TO Yarrd
  336.         IF y MOD 2 = 0 THEN xoffset! = .5 * xspacing! ELSE xoffset! = 0
  337.         FOR x = 1 TO Xarrd
  338.             IF b(x, y).mine <> -1 THEN 'not already a mine
  339.                 '2 sets of neighbors depending if x offset or not
  340.                 IF xoffset! > .1 THEN
  341.                     nMines = b(x - 1, y).mine + b(x, y - 1).mine + b(x, y + 1).mine
  342.                     nMines = nMines + b(x + 1, y - 1).mine + b(x + 1, y).mine + b(x + 1, y + 1).mine
  343.                 ELSE
  344.                     nMines = b(x + 1, y).mine + b(x, y - 1).mine + b(x, y + 1).mine
  345.                     nMines = nMines + b(x - 1, y - 1).mine + b(x - 1, y).mine + b(x - 1, y + 1).mine
  346.                 END IF
  347.                 b(x, y).id = -nMines
  348.             ELSE
  349.                 b(x, y).id = 0
  350.             END IF
  351.             b(x, y).x = x * xspacing! + xoffset! + .5 * xspacing!
  352.             b(x, y).y = y * yspacing! + .5 * yspacing!
  353.             b(x, y).reveal = 0
  354.             showCell x, y
  355.         NEXT
  356.     NEXT
  357.  
  358. SUB showCell (c, r)
  359.     DIM da, x!, y!, lastx!, lasty!, clr AS _UNSIGNED LONG
  360.     SELECT CASE b(c, r).reveal
  361.         CASE -1: IF b(c, r).mine THEN clr = &HFF883300 ELSE clr = &HFFFFFFFF 'revealed  white with number of mine neighbors
  362.         CASE 0: clr = &HFF008800 'hidden green
  363.         CASE 1: clr = &HFFFF0000 'marked red
  364.     END SELECT
  365.     lastx! = b(c, r).x + cellR * COS(_D2R(-30))
  366.     lasty! = b(c, r).y + cellR * SIN(_D2R(-30))
  367.     FOR da = 30 TO 330 STEP 60
  368.         x! = b(c, r).x + cellR * COS(_D2R(da))
  369.         y! = b(c, r).y + cellR * SIN(_D2R(da))
  370.         LINE (lastx!, lasty!)-(x!, y!), &HFFFF00FF
  371.         lastx! = x!: lasty! = y!
  372.     NEXT
  373.     PAINT (b(c, r).x, b(c, r).y), clr, &HFFFF00FF
  374.     IF b(c, r).reveal = -1 THEN
  375.         'cText b(c, r).x, b(c, r).y, 15, &HFF000000, _TRIM$(STR$(c)) + "," + _TRIM$(STR$(r))
  376.         IF b(c, r).id > 0 THEN cText b(c, r).x, b(c, r).y, 35, &HFF000000, _TRIM$(STR$(b(c, r).id))
  377.         IF b(c, r).mine = -1 THEN cText b(c, r).x, b(c, r).y, 35, &HFFFFFFFF, "*"
  378.     END IF
  379.  
  380. FUNCTION TFwin
  381.     DIM c, x, y
  382.     FOR y = 1 TO Yarrd
  383.         FOR x = 1 TO Xarrd
  384.             IF b(x, y).reveal = -1 AND b(x, y).mine = 0 THEN c = c + 1
  385.         NEXT
  386.     NEXT
  387.     IF c = Xarrd * Yarrd - mines THEN TFwin = -1
  388.  
  389. SUB getCell (returnCol AS INTEGER, returnRow AS INTEGER, mbNum AS INTEGER)
  390.     DIM m, mx, my, mb1, mb2, r, c
  391.     mb1 = _MOUSEBUTTON(1): mb2 = _MOUSEBUTTON(2)
  392.     IF mb1 THEN mbNum = 1
  393.     IF mb2 THEN mbNum = 2
  394.     IF mb1 OR mb2 THEN '                      get last place mouse button was down
  395.         WHILE mb1 OR mb2 '                    wait for mouse button release as a "click"
  396.             m = _MOUSEINPUT: mb1 = _MOUSEBUTTON(1): mb2 = _MOUSEBUTTON(2)
  397.             mx = _MOUSEX: my = _MOUSEY
  398.         WEND
  399.         FOR r = 1 TO Yarrd
  400.             FOR c = 1 TO Xarrd
  401.                 IF ((mx - b(c, r).x) ^ 2 + (my - b(c, r).y) ^ 2) ^ .5 < .5 * xspacing! THEN
  402.                     returnCol = c: returnRow = r: EXIT SUB
  403.                 END IF
  404.             NEXT
  405.         NEXT
  406.         mbNum = 0 'still here then clicked wrong
  407.     END IF
  408.  
  409. SUB sweepZeros (col, row) ' recursive sweep
  410.     DIM c, r, cMin, cMax, rMin, rMax, x, y, id
  411.     _SNDPLAY SwooshSnd
  412.     c = col: r = row 'get copies for recursive sub
  413.     IF c > 2 THEN cMin = c - 1 ELSE cMin = 1
  414.     IF c < Xarrd - 1 THEN cMax = c + 1 ELSE cMax = Xarrd
  415.     IF r > 2 THEN rMin = r - 1 ELSE rMin = 1
  416.     IF r < Yarrd - 1 THEN rMax = r + 1 ELSE rMax = Yarrd
  417.     FOR y = rMin TO rMax
  418.         FOR x = cMin TO cMax
  419.             IF b(x, y).reveal = 0 THEN
  420.                 id = b(x, y).id
  421.                 IF b(x, y).mine = 0 AND id = 0 THEN
  422.                     b(x, y).reveal = -1 'mark played
  423.                     showCell x, y
  424.                     sweepZeros x, y
  425.                 ELSE
  426.                     IF b(x, y).mine = 0 AND id >= 1 AND id <= 8 THEN
  427.                         b(x, y).reveal = -1
  428.                         showCell x, y
  429.                     END IF
  430.                 END IF
  431.             END IF
  432.         NEXT
  433.     NEXT
  434.  
  435. 'center the text around (x, y) point, needs a graphics screen!
  436. SUB cText (x, y, textHeight AS SINGLE, K AS _UNSIGNED LONG, txt$)
  437.     DIM fg AS _UNSIGNED LONG, cur&, I&, mult!, xlen
  438.     fg = _DEFAULTCOLOR
  439.     'screen snapshot
  440.     cur& = _DEST
  441.     I& = _NEWIMAGE(8 * LEN(txt$), 16, 32)
  442.     _DEST I&
  443.     COLOR K, _RGBA32(0, 0, 0, 0)
  444.     _PRINTSTRING (0, 0), txt$
  445.     mult! = textHeight / 16
  446.     xlen = LEN(txt$) * 8 * mult!
  447.     _PUTIMAGE (x - .5 * xlen, y - .5 * textHeight)-STEP(xlen, textHeight), I&, cur&
  448.     COLOR fg
  449.     _FREEIMAGE I&
  450.  
  451. FUNCTION rightOf$ (source$, of$)
  452.     IF INSTR(source$, of$) > 0 THEN rightOf$ = MID$(source$, INSTR(source$, of$) + LEN(of$))
  453.  
  454. FUNCTION getChar$ (fromStr$)
  455.     DIM OK AS INTEGER, k$
  456.     WHILE OK = 0
  457.         k$ = INKEY$
  458.         IF LEN(k$) THEN
  459.             IF INSTR(fromStr$, k$) <> 0 THEN OK = -1
  460.         END IF
  461.         _LIMIT 200
  462.     WEND
  463.     _KEYCLEAR
  464.     getChar$ = k$
  465.  
  466. 'from Steve Gold standard
  467. SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
  468.     DIM Radius AS INTEGER, RadiusError AS INTEGER
  469.     DIM X AS INTEGER, Y AS INTEGER
  470.     Radius = ABS(R): RadiusError = -Radius: X = Radius: Y = 0
  471.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
  472.     LINE (CX - X, CY)-(CX + X, CY), C, BF
  473.     WHILE X > Y
  474.         RadiusError = RadiusError + Y * 2 + 1
  475.         IF RadiusError >= 0 THEN
  476.             IF X <> Y + 1 THEN
  477.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
  478.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
  479.             END IF
  480.             X = X - 1
  481.             RadiusError = RadiusError - X * 2
  482.         END IF
  483.         Y = Y + 1
  484.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
  485.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
  486.     WEND
  487.