Welcome, Guest
You have to register before you can post on our site.

Username/Email:
  

Password
  





Search Forums

(Advanced Search)

Forum Statistics
» Members: 492
» Latest member: Feederumn
» Forum threads: 2,829
» Forum posts: 26,529

Full Statistics

Latest Threads
which day of the week
Forum: Programs
Last Post: Stuart
14 minutes ago
» Replies: 26
» Views: 593
Playing sound files in QB...
Forum: Programs
Last Post: ahenry3068
3 hours ago
» Replies: 9
» Views: 1,152
Aloha from Maui guys.
Forum: General Discussion
Last Post: mrbcx
6 hours ago
» Replies: 6
» Views: 100
another variation of "10 ...
Forum: Programs
Last Post: Jack002
9 hours ago
» Replies: 1
» Views: 83
Rock Jockey 2.0 is ready ...
Forum: Games
Last Post: NakedApe
11 hours ago
» Replies: 20
» Views: 577
Button rack or hotkey fun...
Forum: Utilities
Last Post: Jack002
Yesterday, 08:20 PM
» Replies: 6
» Views: 389
ANSIPrint
Forum: a740g
Last Post: bplus
Yesterday, 05:36 PM
» Replies: 11
» Views: 206
Audio Spectrum Analyser
Forum: Programs
Last Post: Jack002
Yesterday, 01:56 AM
» Replies: 7
» Views: 160
_mem
Forum: Help Me!
Last Post: hsiangch_ong
Yesterday, 01:50 AM
» Replies: 13
» Views: 302
pan around a large image ...
Forum: Programs
Last Post: hsiangch_ong
Yesterday, 01:32 AM
» Replies: 0
» Views: 27

 
  Where is my mistake using _mousemovement keywords?
Posted by: TempodiBasic - 09-17-2023, 06:46 PM - Forum: Help Me! - Replies (8)

Hi Qb64pe community

I'm in trouble with a fine couple of QB64 keywords:  _MousemovementX & _MousemovementY

I think that the issue is raising from my bad code or bad knowledge about these two useful keywords...

here the first example taken from the wiki
mousemovementX wiki
mousemovementY wiki

Code: (Select All)
Rem _MOUSEMOVEMENTX / _MOUSEMOVEMENTY  STUDY

Rem example 1 from wiki
Screen 12
PX = 320: PY = 240 'center position
_MouseMove PX, PY ' set center of screen, pointer of mouse and center of circle at the same position
Do: _Limit 200
    Do While _MouseInput
        PX = PX + _MouseMovementX
        PY = PY + _MouseMovementY
    Loop
    Cls
    Circle (PX, PY), 10, 10
    Locate 1, 1: Print PX, PY
Loop Until InKey$ = Chr$(27) 'escape key exit
as you can see my adds are:
- the 2 REM lines 
- and the _MouseMove PX,PY line of code.
The issue, that I am not able to correct, comes out if you play moving the pointer of mouse some times along the horizonthal and vertical axis of the screen.

Can someone give me a feedback or an enlightment about this?

Print this item

  Aqualin Board Game
Posted by: Donald Foster - 09-17-2023, 06:45 PM - Forum: Donald Foster - Replies (1)

Code: (Select All)
_TITLE "Aqualin - Programmed by Donald L. Foster Jr. 2023"

RANDOMIZE TIMER

SCREEN _NEWIMAGE(1317, 752, 256)

_PALETTECOLOR 1, _RGB32(200, 6, 17) '     Red
_PALETTECOLOR 2, _RGB32(6, 105, 0) '      Green
_PALETTECOLOR 3, _RGB32(245, 220, 6) '    Yellow
_PALETTECOLOR 4, _RGB32(127, 72, 127) '   Violet
_PALETTECOLOR 5, _RGB32(255, 133, 0) '    Orange
_PALETTECOLOR 6, _RGB32(0, 89, 255) '     Blue
_PALETTECOLOR 7, _RGB32(0, 150, 255) '    Cyan Board
_PALETTECOLOR 10, _RGB32(110, 80, 40) '   Shape
_PALETTECOLOR 11, _RGB32(210, 180, 140) ' Background

DIM AS _UNSIGNED _BIT FirstMove, Selected, Slide, TilePlaced(36), TileRemoved(36)
DIM AS _UNSIGNED _BYTE Player, Opponent, Row, Column, Tile, TileShape, TileColor, TilesPlaced, Supply, Position, ShapeGroups, ColorGroups, DisplayTile(6)
DIM AS _UNSIGNED INTEGER V, X, Y, Z
DIM SHARED AS _UNSIGNED _BIT Playable(6, 6), ShapeGroupOk(6, 6), ColorGroupOk(6, 6)
DIM SHARED AS _BYTE Shape, Colour, Group, BoardShapeGroup(6, 6), BoardColorGroup(6, 6), ShapeGroupCount(6, 6), ColorGroupCount(6, 6), Points(6), PlayerScore(2)
DIM SHARED AS _BYTE BoardTile(6, 6), TileShape(36), TileColor(36), BoardShape(6, 6), BoardColor(6, 6), ShapeGroupScore(6, 6), ColorGroupScore(6, 6), ShapeScore(6), ColorScore(6)
DIM SHARED AS INTEGER BoardX(6, 6), BoardY(6, 6), DisplayX(6), DisplayY(6)

Player = 1: Opponent = 2: FirstMove = 1: Supply = 30: TilesPlaced = 0

Points(0) = 0: Points(1) = 0: Points(2) = 1: Points(3) = 3: Points(4) = 6: Points(5) = 10: Points(6) = 15

Tile = 1: FOR Z = 1 TO 6: FOR Y = 1 TO 6: TileShape(Tile) = Z: TileColor(Tile) = Y: Tile = Tile + 1: ShapeGroupOk(Z, Y) = 1: ColorGroupOk(Z, Y) = 1: NEXT: NEXT

PlayerGoal$(1) = "Group Same Shape  ": PlayerGoal$(2) = "Group Same Color  "

FOR Z = 1 TO 36: TilePlaced(Z) = 0: TileRemoved(Z) = 0: NEXT

' Mix Up Supply Tiles
FOR Z = 1 TO 6
   FOR Y = 1 TO 6
      GetTile: Tile = INT(RND * 36) + 1: IF TilePlaced(Tile) GOTO GetTile
      TileShape(Tile) = Z: TileColor(Tile) = Y: TilePlaced(Tile) = 1
   NEXT
NEXT

FOR Z = 1 TO 36: TilePlaced(Z) = 0: NEXT

' Get 6 Random Display Tiles
FOR Z = 1 TO 6
   RandomTile: Tile = INT(RND * 36) + 1: IF TilePlaced(Tile) GOTO RandomTile
   DisplayTile(Z) = Tile: TilePlaced(Tile) = 1: TileRemoved(Tile) = 1
NEXT

fontpath$ = ENVIRON$("SYSTEMROOT") + "\fonts\Arialbd.ttf"

CLS , 11

' Draw Board
LINE (0, 0)-(751, 751), 7, BF: LINE (10, 10)-(741, 741), 15, BF

X = 75
FOR Z = 1 TO 6
   V = 75
   FOR Y = 1 TO 6
      LINE (V - 53, X - 53)-(V + 53, X + 53), 7, BF
      BoardX(Z, Y) = V: BoardY(Z, Y) = X
      V = V + 120
   NEXT
   X = X + 120
NEXT

' Draw Game Title
font& = _LOADFONT(fontpath$, 40): _FONT font&
COLOR 0, 11: _PRINTSTRING (912, 10), "A Q U A L I N"

' Draw Supply Tile
DrawTile 1029, 230, 0, 0, 1
font& = _LOADFONT(fontpath$, 16): _FONT font&
COLOR 15, 0: _PRINTSTRING (992, 222), "AQUALIN"

' Draw Display Tiles
Position = 1: X = 420
FOR Z = 1 TO 2
   V = 887
   FOR Y = 1 TO 3
      IF DisplayTile(Position) > 0 THEN
         DrawTile V, X, TileShape(DisplayTile(Position)), TileColor(DisplayTile(Position)), 1
         DisplayX(Position) = V: DisplayY(Position) = X: Position = Position + 1: V = V + 140
      END IF
   NEXT
   X = X + 140
NEXT

StartGame:

' Displau Player Info
font& = _LOADFONT(fontpath$, 30): _FONT font&
COLOR 0, 11: _PRINTSTRING (813, 100), "Player " + STR$(Player) + "  -  " + PlayerGoal$(Player)

' Display Supply Tile Quanity
font& = _LOADFONT(fontpath$, 20): _FONT font&
COLOR 0, 11: _PRINTSTRING (978, 285), "Supply: " + STR$(Supply)

font& = _LOADFONT(fontpath$, 25): _FONT font&

ChooseTile:

IF FirstMove = 0 AND Slide = 0 THEN
   _PRINTSTRING (823, 680), "          Choose a Tile to Slide or       "
ELSE
   _PRINTSTRING (823, 680), STRING$(100, 32)
END IF

_PRINTSTRING (823, 718), "Choose a Tile to Place on the Board"

GetTileInput:

DO WHILE _MOUSEINPUT

   ' Choose a Board Tile to Move
   IF FirstMove = 0 AND Slide = 0 THEN
      FOR Z = 1 TO 6
         FOR Y = 1 TO 6
            IF _MOUSEX > BoardX(Z, Y) - 57 AND _MOUSEX < BoardX(Z, Y) + 57 AND _MOUSEY > BoardY(Z, Y) - 57 AND _MOUSEY < BoardY(Z, Y) + 57 THEN Selected = 1 ELSE Selected = 0
            IF _MOUSEBUTTON(1) = -1 AND Selected = 1 AND BoardTile(Z, Y) > 0 THEN
               GOSUB ReleaseButton: Row = Z: Column = Y: Tile = BoardTile(Z, Y)
               IF GetPlayables(Z, Y) = 1 THEN DrawCursor BoardX(Z, Y), BoardY(Z, Y), 0: GOTO SlideTile ELSE GOTO GetTileInput
            END IF
         NEXT
      NEXT
   END IF

   ' Choose a Tile to Place
   FOR Z = 1 TO 6
      IF _MOUSEX > DisplayX(Z) - 57 AND _MOUSEX < DisplayX(Z) + 57 AND _MOUSEY > DisplayY(Z) - 57 AND _MOUSEY < DisplayY(Z) + 57 THEN Selected = 1 ELSE Selected = 0
      IF _MOUSEBUTTON(1) = -1 AND Selected = 1 AND DisplayTile(Z) > 0 THEN
         GOSUB ReleaseButton: Tile = DisplayTile(Z): Position = Z: DrawCursor DisplayX(Z), DisplayY(Z), 0: GOTO TileChosen
      END IF
   NEXT

LOOP
A$ = INKEY$: IF A$ <> "" THEN IF ASC(A$) = 27 AND FullScreen = 0 THEN FullScreen = -1: _FULLSCREEN _SQUAREPIXELS , _SMOOTH ELSE IF ASC(A$) = 27 THEN FullScreen = 0: _FULLSCREEN _OFF
GOTO GetTileInput

SlideTile:

_PRINTSTRING (823, 680), " Choose a Space to Slide Tile to or      "
_PRINTSTRING (823, 718), "    Choose a Different Tile to Slide      "

GetSlideInput:

DO WHILE _MOUSEINPUT
   FOR Z = 1 TO 6
      FOR Y = 1 TO 6
         IF _MOUSEX > BoardX(Z, Y) - 57 AND _MOUSEX < BoardX(Z, Y) + 57 AND _MOUSEY > BoardY(Z, Y) - 57 AND _MOUSEY < BoardY(Z, Y) + 57 THEN Selected = 1 ELSE Selected = 0
         IF _MOUSEBUTTON(1) = -1 AND Selected = 1 THEN
            GOSUB ReleaseButton
            IF Playable(Z, Y) = 1 THEN
               IF Row = Z AND Column = Y THEN ClearCursors: GOTO ChooseTile ELSE ClearCursors: GOTO MoveTile
            ELSE
               IF BoardTile(Z, Y) > 0 THEN ClearCursors: IF GetPlayables(Z, Y) = 1 THEN DrawCursor BoardX(Z, Y), BoardY(Z, Y), 0: GOTO SlideTile ELSE GOTO GetSlideInput
            END IF
         END IF
      NEXT
   NEXT
LOOP
A$ = INKEY$: IF A$ <> "" THEN IF ASC(A$) = 27 AND FullScreen = 0 THEN FullScreen = -1: _FULLSCREEN _SQUAREPIXELS , _SMOOTH ELSE IF ASC(A$) = 27 THEN FullScreen = 0: _FULLSCREEN _OFF
GOTO GetSlideInput

MoveTile:

BoardTile(Z, Y) = Tile: BoardTile(Row, Column) = 0: PAINT (BoardX(Row, Column), BoardY(Row, Column)), 7: DrawTile BoardX(Z, Y), BoardY(Z, Y), TileShape(Tile), TileColor(Tile), 1: Slide = 1

IF Slide = 1 THEN GOTO ChooseTile ELSE GOTO EndRound

TileChosen:

_PRINTSTRING (823, 680), "        Choose a Board Space or           "
_PRINTSTRING (823, 718), "    Choose a Different Tile to Play       "

GetBoardInput:

DO WHILE _MOUSEINPUT

   ' Choose a Different Tile
   FOR Z = 1 TO 6
      IF _MOUSEX > DisplayX(Z) - 57 AND _MOUSEX < DisplayX(Z) + 57 AND _MOUSEY > DisplayY(Z) - 57 AND _MOUSEY < DisplayY(Z) + 57 THEN Selected = 1 ELSE Selected = 0
      IF _MOUSEBUTTON(1) = -1 AND Selected = 1 AND DisplayTile(Z) > 0 THEN
         GOSUB ReleaseButton: DrawCursor DisplayX(Position), DisplayY(Position), 11
         IF Z = Position GOTO ChooseTile ELSE Tile = DisplayTile(Z): Position = Z:: DrawCursor DisplayX(Z), DisplayY(Z), 0: GOTO GetBoardInput
      END IF
   NEXT

   ' Choose Board Space to Place Tile
   FOR Z = 1 TO 6
      FOR Y = 1 TO 6
         IF _MOUSEX > BoardX(Z, Y) - 57 AND _MOUSEX < BoardX(Z, Y) + 57 AND _MOUSEY > BoardY(Z, Y) - 57 AND _MOUSEY < BoardY(Z, Y) + 57 THEN Selected = 1 ELSE Selected = 0
         IF _MOUSEBUTTON(1) = -1 AND Selected AND BoardTile(Z, Y) = 0 THEN GOSUB ReleaseButton: Row = Z: Column = Y: GOTO PlaceTile
      NEXT
   NEXT

LOOP
A$ = INKEY$: IF A$ <> "" THEN IF ASC(A$) = 27 AND FullScreen = 0 THEN FullScreen = -1: _FULLSCREEN _SQUAREPIXELS , _SMOOTH ELSE IF ASC(A$) = 27 THEN FullScreen = 0: _FULLSCREEN _OFF
GOTO GetBoardInput

PlaceTile:

' Move Display Tile to Board
DisplayTile(Position) = 0: BoardTile(Row, Column) = Tile: TilesPlaced = TilesPlaced + 1
LINE (DisplayX(Position) - 58, DisplayY(Position) - 58)-(DisplayX(Position) + 58, DisplayY(Position) + 58), 11, BF
DrawTile BoardX(Row, Column), BoardY(Row, Column), TileShape(Tile), TileColor(Tile), 1

' Replenish Display Tiles
IF Supply > 0 THEN
   RemoveTile: Tile = INT(RND * 36) + 1: IF TilePlaced(Tile) GOTO RemoveTile
   DisplayTile(Position) = Tile: TilePlaced(Tile) = 1: IF Supply > 0 THEN Supply = Supply - 1
   DrawTile DisplayX(Position), DisplayY(Position), TileShape(Tile), TileColor(Tile), 1
END IF

' Display Supply Tile Quanity
font& = _LOADFONT(fontpath$, 20): _FONT font&
COLOR 0, 11: _PRINTSTRING (978, 285), "Supply:      ": _PRINTSTRING (978, 285), "Supply: " + STR$(Supply)

EndRound:

' Check for End of Game
IF TilesPlaced = 36 THEN

   Winner = (EndOfGame)

   font& = _LOADFONT(fontpath$, 22): _FONT font&: DisplayScores

   font& = _LOADFONT(fontpath$, 25): _FONT font&

   IF Winner = 3 THEN
      _PRINTSTRING (823, 685), "         The Game Ended in a Tie           "
   ELSE
      _PRINTSTRING (823, 685), "           Player " + STR$(Winner) + " is the Winner!      "
   END IF

   _PRINTSTRING (823, 718), "      Play Another Game? ( Y or N)          "

   YorN: A$ = UCASE$(INKEY$): IF A$ = "" GOTO YorN
   IF ASC(A$) = 27 AND FullScreen = 0 THEN FullScreen = -1: _FULLSCREEN _SQUAREPIXELS , _SMOOTH ELSE IF ASC(A$) = 27 THEN FullScreen = 0: _FULLSCREEN _OFF
   IF A$ = "Y" THEN RUN
   IF A$ = "N" THEN SYSTEM
   GOTO YorN

END IF

FirstMove = 0: Slide = 0: SWAP Player, Opponent: GOTO StartGame

ReleaseButton:

DO WHILE _MOUSEINPUT
   IF _MOUSEBUTTON(1) = 0 THEN RETURN
LOOP
GOTO ReleaseButton

SUB DrawTile (X1, X2, TileShape, TileColor, Tile)

   IF Tile THEN
      LINE (X1 - 48, X2 - 40)-(X1 - 48, X2 + 40), 0: LINE (X1 + 48, X2 - 40)-(X1 + 48, X2 + 40), 0: LINE (X1 - 40, X2 - 48)-(X1 + 40, X2 - 48), 0: LINE (X1 - 40, X2 + 48)-(X1 + 40, X2 + 48), 0
      CIRCLE (X1 - 40, X2 - 40), 8, 0, 1.5, 3.1: CIRCLE (X1 + 40, X2 - 40), 8, 0, 0, 1.6: CIRCLE (X1 - 40, X2 + 40), 8, 0, 3.0, 4.8: CIRCLE (X1 + 40, X2 + 40), 8, 0, 4.5, 0: PAINT (X1, X2), 0
   END IF

   SELECT CASE TileShape
      CASE 1 ' Circle
         CIRCLE (X1, X2), 35, 15
      CASE 2 ' Diamond
         PSET (X1, X2), 0: DRAW "C15TA0BU38G39F39E39H39"
      CASE 3 ' Cross
         CIRCLE (X1 - 20, X2), 15, 15, 1.0, 5.2: CIRCLE (X1 + 20, X2), 15, 15, 4.1, 2.1
         CIRCLE (X1, X2 - 20), 15, 15, 5.5, 3.9: CIRCLE (X1, X2 + 20), 15, 15, 2.4, 0.6
      CASE 4 ' X
         PSET (X1, X2), 0: DRAW "C15TA0BR15TA65R35TA115U35TA65U35TA115L35TA65L35TA115D35TA65D35TA115R35"
      CASE 5 ' Square
         LINE (X1 - 32, X2 - 32)-(X1 + 32, X2 + 32), 15, B
      CASE 6 ' Star
         PSET (X1, X2), 0: DRAW "C15TA0BU15BR5TA15U22TA165U22TA45BL12TA15L22TA165L22TA45BD12TA15D22TA165D22TA45BR12TA15R22TA165R22"
         DRAW "C15TA60R22TA30L22TA0BL12TA60U22TA30D22TA0BD12TA60L22TA30R22TA0BR12TA60D22TA30U22"
   END SELECT

   IF TileColor THEN PAINT (X1, X2), TileColor, 15

END SUB

SUB DrawCursor (X1, X2, CursorColor)

   PSET (X1 - 56, X2 - 56), CursorColor: DRAW "TA0R112D112L112U112H1R114D114L114U114H1R116D116L116U116"

END SUB

SUB ClearCursors

   FOR Z = 1 TO 6
      FOR Y = 1 TO 6
         Playable(Z, Y) = 0: DrawCursor BoardX(Z, Y), BoardY(Z, Y), 15
      NEXT
   NEXT

END SUB

FUNCTION GetPlayables (X1, X2)

   ' Clear All Playables
   FOR Z = 1 TO 6: FOR Y = 1 TO 6: Playable(Z, Y) = 0: NEXT: NEXT: Playable(X1, X2) = 1: V = 0

   X = 0
   CheckUp:
   IF X1 - X - 1 >= 1 THEN
      IF BoardTile(X1 - X - 1, X2) = 0 THEN Playable(X1 - X - 1, X2) = 1: DrawCursor BoardX(X1 - X - 1, X2), BoardY(X1 - X - 1, X2), 0: X = X + 1: V = 1: GOTO CheckUp
   END IF

   X = 0
   CheckDown:
   IF X1 + X + 1 <= 6 THEN
      IF BoardTile(X1 + X + 1, X2) = 0 THEN Playable(X1 + X + 1, X2) = 1: DrawCursor BoardX(X1 + X + 1, X2), BoardY(X1 + X + 1, X2), 0: X = X + 1: V = 1: GOTO CheckDown
   END IF

   X = 0
   CheckLeft:
   IF X2 - X - 1 >= 1 THEN
      IF BoardTile(X1, X2 - X - 1) = 0 THEN Playable(X1, X2 - X - 1) = 1: DrawCursor BoardX(X1, X2 - X - 1), BoardY(X1, X2 - X - 1), 0: X = X + 1: V = 1: GOTO CheckLeft
   END IF

   X = 0
   CheckRight:
   IF X2 + X + 1 <= 6 THEN
      IF BoardTile(X1, X2 + X + 1) = 0 THEN Playable(X1, X2 + X + 1) = 1: DrawCursor BoardX(X1, X2 + X + 1), BoardY(X1, X2 + X + 1), 0: X = X + 1: V = 1: GOTO CheckRight
   END IF

   GetPlayables = V

END FUNCTION

FUNCTION EndOfGame ()

   ' Get Tile Shapes and Colors
   FOR Z = 1 TO 6
      FOR Y = 1 TO 6
         BoardShape(Z, Y) = TileShape(BoardTile(Z, Y)): BoardColor(Z, Y) = TileColor(BoardTile(Z, Y)): BoardShapeGroup(Z, Y) = 0: BoardColorGroup(Z, Y) = 0
      NEXT
   NEXT

   ' Set ShapeGroupCount, ShapeGroupScore, ColorGroupCount and ColorGroupScore to 0
   FOR Z = 1 TO 6: FOR Y = 1 TO 6: ShapeGroupCount(Z, Y) = 0: ShapeGroupScore(Z, Y) = 0: ColorGroupCount(Z, Y) = 0: ColorGroupScore(Z, Y) = 0: NEXT: NEXT

   PatternShapes = 0: PatternColors = 0

   ' Get Tile Shape Group
   FOR Z = 1 TO 6
      FOR Y = 1 TO 6
         Shape = BoardShape(Z, Y)
         IF Y - 1 >= 1 AND Z - 1 >= 1 THEN
            Group1 = BoardShapeGroup(Z, Y - 1): Group2 = BoardShapeGroup(Z - 1, Y)
            IF BoardShape(Z, Y - 1) = Shape AND BoardShape(Z - 1, Y) = Shape THEN
               IF Group1 <> Group2 THEN
                  IF Group1 < Group2 THEN
                     ChangeShapeGroup Shape, Group1, Group2: BoardShapeGroup(Z, Y) = Group1
                  ELSE
                     ChangeShapeGroup Shape, Group2, Group1: BoardShapeGroup(Z, Y) = Group2
                  END IF
               ELSE
                  BoardShapeGroup(Z, Y) = Group1
               END IF
            ELSE
               X = 0
               IF BoardShape(Z, Y - 1) = Shape THEN BoardShapeGroup(Z, Y) = Group1: X = 1
               IF BoardShape(Z - 1, Y) = Shape THEN BoardShapeGroup(Z, Y) = Group2: X = 1
               IF X = 0 THEN BoardShapeGroup(Z, Y) = NextShapeGroup(Shape)
            END IF
         ELSEIF Y - 1 >= 1 THEN
            IF BoardShape(Z, Y - 1) = BoardShape(Z, Y) THEN
               BoardShapeGroup(Z, Y) = BoardShapeGroup(Z, Y - 1)
            ELSE
               BoardShapeGroup(Z, Y) = NextShapeGroup(Shape)
            END IF
         ELSEIF Z - 1 >= 1 THEN
            IF BoardShape(Z - 1, Y) = BoardShape(Z, Y) THEN
               BoardShapeGroup(Z, Y) = BoardShapeGroup(Z - 1, Y)
            ELSE
               BoardShapeGroup(Z, Y) = NextShapeGroup(Shape)
            END IF
         ELSE
            BoardShapeGroup(Z, Y) = NextShapeGroup(Shape)
         END IF
      NEXT
   NEXT

   ' Get Tile Color Group
   FOR Z = 1 TO 6
      FOR Y = 1 TO 6
         Colour = BoardColor(Z, Y)
         IF Y - 1 >= 1 AND Z - 1 >= 1 THEN
            Group1 = BoardColorGroup(Z, Y - 1): Group2 = BoardColorGroup(Z - 1, Y)
            IF BoardColor(Z, Y - 1) = Colour AND BoardColor(Z - 1, Y) = Colour THEN
               IF Color1 <> Color2 THEN
                  IF Color1 < Color2 THEN
                     ChangeColorGroup Colour, Group1, Group2: BoardColorGroup(Z, Y) = Group1
                  ELSE
                     ChangeColorGroup Colour, Group2, Group1: BoardColorGroup(Z, Y) = Group2
                  END IF
               ELSE
                  BoardColorGroup(Z, Y) = Group1
               END IF
            ELSE
               X = 0
               IF BoardColor(Z, Y - 1) = Colour THEN BoardColorGroup(Z, Y) = Group1: X = 1
               IF BoardColor(Z - 1, Y) = Colour THEN BoardColorGroup(Z, Y) = Group2: X = 1
               IF X = 0 THEN BoardColorGroup(Z, Y) = NextColorGroup(Colour)
            END IF
         ELSEIF Y - 1 >= 1 THEN
            IF BoardColor(Z, Y - 1) = BoardColor(Z, Y) THEN
               BoardColorGroup(Z, Y) = BoardColorGroup(Z, Y - 1)
            ELSE
               BoardColorGroup(Z, Y) = NextColorGroup(Colour)
            END IF
         ELSEIF Z - 1 >= 1 THEN
            IF BoardColor(Z - 1, Y) = BoardColor(Z, Y) THEN
               BoardColorGroup(Z, Y) = BoardColorGroup(Z - 1, Y)
            ELSE
               BoardColorGroup(Z, Y) = NextColorGroup(Colour)
            END IF
         ELSE
            BoardColorGroup(Z, Y) = NextColorGroup(Colour)
         END IF
      NEXT
      PRINT
   NEXT

   ' Set Group Counts to 0
   FOR Z = 1 TO 6: FOR Y = 1 TO 6: ShapeGroupCount(Z, Y) = 0: ColorGroupCount(Z, Y) = 0: NEXT: NEXT

   ' Count Each Group
   FOR Z = 1 TO 6
      FOR Y = 1 TO 6
         ShapeGroupCount(BoardShape(Z, Y), BoardShapeGroup(Z, Y)) = ShapeGroupCount(BoardShape(Z, Y), BoardShapeGroup(Z, Y)) + 1
         ColorGroupCount(BoardColor(Z, Y), BoardColorGroup(Z, Y)) = ColorGroupCount(BoardColor(Z, Y), BoardColorGroup(Z, Y)) + 1
      NEXT
   NEXT

   ' Get Points for Each Group
   FOR Z = 1 TO 6
      FOR Y = 1 TO 6
         ShapeGroupScore(Z, Y) = Points(ShapeGroupCount(Z, Y)): ColorGroupScore(Z, Y) = Points(ColorGroupCount(Z, Y))
      NEXT
   NEXT

   ' Get Scores for Each Shape and Color
   FOR Z = 1 TO 6
      ShapeScore(Z) = ShapeGroupScore(Z, 1) + ShapeGroupScore(Z, 2) + ShapeGroupScore(Z, 3) + ShapeGroupScore(Z, 4) + ShapeGroupScore(Z, 5) + ShapeGroupScore(Z, 6)
      ColorScore(Z) = ColorGroupScore(Z, 1) + ColorGroupScore(Z, 2) + ColorGroupScore(Z, 3) + ColorGroupScore(Z, 4) + ColorGroupScore(Z, 5) + ColorGroupScore(Z, 6)
   NEXT

   ' Get Player Scores
   PlayerScore(1) = ShapeScore(1) + ShapeScore(2) + ShapeScore(3) + ShapeScore(4) + ShapeScore(5) + ShapeScore(6)
   PlayerScore(2) = ColorScore(1) + ColorScore(2) + ColorScore(3) + ColorScore(4) + ColorScore(5) + ColorScore(6)

   ' Determine the Winner
   IF PlayerScore(1) > PlayerScore(2) THEN Winner = 1 ELSE IF PlayerScore(2) > PlayerScore(1) THEN Winner = 2 ELSE Winner = 3

   EndOfGame = Winner

END FUNCTION


SUB ChangeShapeGroup (Shape, A, B)

   ShapeGroupOk(Shape, B) = 1

   FOR Z = 1 TO 6
      FOR Y = 1 TO 6
         IF BoardShape(Z, Y) = Shape AND BoardShapeGroup(Z, Y) = B THEN BoardShapeGroup(Z, Y) = A
      NEXT
   NEXT

END SUB

SUB ChangeColorGroup (Colour, A, B)

   ColorGroupOk(Colour, B) = 1

   FOR Z = 1 TO 6
      FOR Y = 1 TO 6
         IF BoardColor(Z, Y) = Colour AND BoardColorGroup(Z, Y) = B THEN BoardColorGroup(Z, Y) = A
      NEXT
   NEXT

END SUB

FUNCTION NextShapeGroup (Shape)

   X = 1
   GetX: IF ShapeGroupOk(Shape, X) = 1 THEN ShapeGroupOk(Shape, X) = 0: NextShapeGroup = X ELSE X = X + 1: GOTO GetX

END FUNCTION

FUNCTION NextColorGroup (Colour)

   X = 1
   GetX: IF ColorGroupOk(Colour, X) = 1 THEN ColorGroupOk(Colour, X) = 0: NextColorGroup = X ELSE X = X + 1: GOTO GetX

END FUNCTION

SUB DisplayScores

   LINE (772, 80)-(1296, 751), 11, BF

   ' Displau Player Info
   COLOR 0, 11: _PRINTSTRING (800, 65), "          Player 1                                Player 2    "
   COLOR 0, 11: _PRINTSTRING (800, 90), "Group Same Shape             Group Same Color"

   X = 165
   FOR Z = 1 TO 6
      DrawTile 870, X, Z, 10, 0: _PRINTSTRING (940, X - 10), STR$(ShapeScore(Z))
      DrawTile 1145, X, 5, Z, 0: _PRINTSTRING (1215, X - 10), STR$(ColorScore(Z))
      X = X + 85
   NEXT

   COLOR 0, 11: _PRINTSTRING (800, 640), "Player 1 Score:    " + STR$(PlayerScore(1))
   COLOR 0, 11: _PRINTSTRING (1070, 640), "Player 2 Score:    " + STR$(PlayerScore(2))

END SUB
Here's another board game. I borrowed 6 shapes and colors from my Niya game. I've included the scouse code, description of the game, screenshot of the game and a picture of the actual game I changed the shapes.

[Image: Aqualin-Screenshot.png]


[Image: Aqualin-play4.webp]


.pdf   Aqualin Description.pdf (Size: 40.94 KB / Downloads: 63)

Thanks

Donald



Attached Files
.pdf   English rules translation.pdf (Size: 173.07 KB / Downloads: 63)
Print this item

  _PUTIMAGE Question
Posted by: TerryRitchie - 09-17-2023, 02:56 AM - Forum: Help Me! - Replies (3)

This question pertains to my work on the hardware acceleration lesson in the tutorial.

According to the Wiki _PUTIMAGE should be allowed to use hardware images as either the source or destination. However this is not working for me. Please take a look at the sample code I included below. Am I missing something obvious or does the Wiki need updating?

Code: (Select All)
OPTION _EXPLICIT '    declare those variables son!

DIM SWimage AS LONG ' software image
DIM HWimage AS LONG ' hardware image

SCREEN _NEWIMAGE(640, 480, 32) '     create a software surface
SWimage = _NEWIMAGE(100, 100, 32) '  create a software image
_DEST SWimage '                      draw on the software image
CIRCLE (49, 49), 49 '                create a full size circle on the software image
HWimage = _COPYIMAGE(SWimage, 33) '  create a hardware version of the software image
CLS '                                clear the software image
CIRCLE (49, 49), 24 '                create a half size circle on the software image
_DEST 0 '                            return to the software surface
_PUTIMAGE (0, 0), SWimage '          place the software image onto the software surface

'+------------------------------------------------------------------------------------------------------------------+
'| According to the Wiki _PUTIMAGE should be allowed to use hardware images, however it's not working.              |
'|                                                                                                                  |
'| "Hardware images (created using mode 33 via _LOADIMAGE or _COPYIMAGE) can be used as the source or destination." |
'|                                                                                                                  |
'| The quote above was taken directly from the Wiki.                                                                |
'+------------------------------------------------------------------------------------------------------------------+

'_PUTIMAGE (0, 0), HWimage, SWimage ' nope, invalid handle           <<--- neither one of these work?
'_PUTIMAGE (0, 0), SWimage, HWimage ' nope, invalid handle           <<---

DO
    _LIMIT 15 '                      slow down hoss
    _PUTIMAGE (0, 0), HWimage '      draw the hardware image over the software image
    _DISPLAY '                       update the surfaces
LOOP UNTIL _KEYDOWN(27) '            leave when ESC pressed
_FREEIMAGE SWimage
_FREEIMAGE HWimage

Print this item

  Our Calendar
Posted by: Dimster - 09-16-2023, 04:19 PM - Forum: Help Me! - Replies (7)

I have never taken advantage of the Calendar. I see where there would be 2 different types - a public calendar and a private calendar. Was there a particular use intended for the public calendar? Also, on the private calendar, what features are available like color, events v's tasks, personal notifications, can I add photos or documents etc I didn't see any info on the calendar in the wiki, so I apologize if there is a tutorial on it that I missed. thanks

Print this item

Rainbow Kenney Game Assets All-in-1 Free Day - on itch.io - not spam
Posted by: grymmjack - 09-16-2023, 04:49 AM - Forum: General Discussion - Replies (17)

For a limited time you can get every single Kenney game asset in all 1 bundle on itch.io here:

https://itch.io/s/102989/kenney-game-ass...1-free-day

This is a pretty incredible amount of stuff!

Includes all of this: https://kenney.nl/data/itch/preview/

Print this item

  Loading font from memory help needed...
Posted by: Dav - 09-16-2023, 12:10 AM - Forum: Help Me! - Replies (6)

I've been trying to load a font from string memory, like @a740g did HERE, but none of my font string data will work like a740g code does.  i must not be doing it right.  Here's what I'm doing.

I'm first loading the entire .otf font file data into a string named fontdata$.  Then I try to load the font from fontdata$ memory like this.

myfont& = _LoadFont(fontdata$, 32, "memory")
_Font myfont&

Thanks for any help....

- Dav

Print this item

  QBJS - Deep Field
Posted by: dbox - 09-15-2023, 07:25 PM - Forum: QBJS, BAM, and Other BASICs - Replies (6)

Saw this on Discord.  It is ported from a SpecBas program by ZXDunny and is another example of how math can be beautiful:



Screensaver Mode

Print this item

  Is the POS command in need of a fix?
Posted by: PhilOfPerth - 09-15-2023, 04:26 AM - Forum: Help Me! - Replies (4)

When I try to print several lines of text, all indented to the same tab point (tab14), the lines are separated by a blank line.
Wiki says "Column tab prints may not always move 9 spaces past the center of the screen. Some may move text to next row.", which seems a bit "iffy". 
Is there a firm rule that applies here, or must I resort to a new Locate command?  Huh

Print this item

  _DISPLAYORDER Question
Posted by: TerryRitchie - 09-14-2023, 09:26 PM - Forum: Help Me! - Replies (7)

I'm working on the hardware acceleration tutorial lesson.

According to the Wiki _DISPLAYORDER has the following default surface order:

_DISPLAYORDER _SOFTWARE, _HARDWARE, _GLRENDER, _HARDWARE1

_SOFTWARE - I understand
_HARDWARE - I understand
_GLRENDER - I sort of understand
_HARDWARE1 - What is this?

Where does _HARDWARE1 come into play and how would I utilize it?

Also, the Wiki points out that _DISPLAYORDER can be used as:

_DISPLAYORDER [{_SOFTWARE|_HARDWARE|_HARDWARE1|_GLRENDER}][, ...][, ...][, ...][, ...] 

Does this somehow mean that the four surfaces above can be listed and used more than once? If so, how the heck does that work?

Print this item

  elcircle
Posted by: James D Jarvis - 09-14-2023, 04:02 PM - Forum: Programs - Replies (4)

elcircle is a pretty quick subroutine to draw filled ellipses (and circles) that doesn't have the problems using Paint does. It's not a fast as fcircle but it's speedy and it can do ellipses.

Code: (Select All)
'elcircle demo
' by James D. Jarvis
' a fast subroutine to fill an ellipsoid or a circlc without using PAINT
'expanded from a circle routine by Chuck Venoit here https://basicanywheremachine-news.blogsp...nVdETyxJk4
Screen _NewImage(800, 500, 256)
Randomize Timer
e = 64000
t1 = Timer
For c = 1 To e
    elcircle Rnd * _Width, Rnd * _Height, Int(10 + c / 1000), 1.5, Int(Rnd * 256)
Next c
t2 = Timer
For c = 1 To e
    elcircle2 Rnd * _Width, Rnd * _Height, Int(10 + c / 1000), 0.5, Int(Rnd * 256)
Next c
t3 = Timer
Print "elcircle"; t2 - t1; "  elcircle 2 "; t3 - t2; " press any key to continue"
Sleep
Cls
Print "use standard circle comands if you wish to add a 1 pixel outline to the circles"
elcircle 200, 200, 100, 0.5, 12
Circle (200, 200), 100, 15, , , 0.5
elcircle 400, 200, 100, 3.5, 12
Circle (400, 200), 100, 15, , , 3.5

Sub elcircle (cx, cy, crad, aspectr, klr As _Unsigned Long)
    'elcircle  does not render correctly if ascpect ratio is <1
    If aspectr < 1 Then
        elcircle2 cx, cy, crad, aspectr, klr
    Else
        For xy = 0 To crad * 0.75
            a = Sqr(crad * crad - xy * xy)
            a_ar = a / aspectr
            xy_ar = xy / aspectr
            Line (cx - a_ar, cy - xy)-(cx + a_ar, cy - xy), klr, BF
            Line (cx - a_ar, cy + xy)-(cx + a_ar, cy + xy), klr, BF
            Line (cx - xy_ar, cy - a)-(cx + xy_ar, cy - a), klr, BF
            Line (cx - xy_ar, cy + a)-(cx + xy_ar, cy + a), klr, BF
        Next xy
    End If
End Sub
Sub elcircle2 (cx, cy, crad, aspectr, klr As _Unsigned Long)
    'elcircle2 renders aspect ratios <1 correctly but it is  slower than elcircle itself
    For xy = 0 To (crad * 0.75)
        a = Sqr(crad * crad - xy * xy)
        a_ar = a * aspectr
        xy_ar = xy * aspectr
        Line (cx - xy, cy + a_ar)-(cx + xy, cy - a_ar), klr, BF
        Line (cx - a, cy + xy_ar)-(cx + a, cy - xy_ar), klr, BF
    Next xy
End Sub

Print this item