I know this is a 'nit -- a very minor thing, but it probably should be fixed in the future.
It is that _Round(5/10) should be 1, but it is 0. And there is a pattern: 25, 45, 65, etc.
But maybe that is an alternative rule that I don't know about. It is a 'nit.
Shell _Hide com$
_Delay 1 'give the os time to download and create the file
Open "temp.txt" For Binary As #1
Do Until EOF(1)
Line Input #1, temp$
If InStr(temp$, "download_count") Then Print Mid$(temp$, 27);
If InStr(temp$, "browser_download_url") Then Print Mid$(temp$, 33)
Loop
For anyone who wants to take a look at the number of downloads the Phoenix Edition has for each release, you can use the little app above to do so.
If you're really curious about a lot more junk than just the download count, you can open the "temp.txt" and get a whole status report on the repo and the releases and such. I'm not certain if anyone else would be interested in this type of thing, but I thought I'd share just in case.
I'm trying to figure out what if anything I need to do to have the sound continue to work in QB64. The SBMIDI files aren't Windows compatible and I don't have the source code.
Another adaptation of an old QB4.5 program of mine. This is a simulation of a Spirograph. To be precise it simulates the result of a wheel that runs around inside a larger wheel and the patterns that can be created with different diameters of the small wheel and offsets from its centre. It is easy to use and is something of a rabbit hole that you may well disappear down into. While instructions are included in the comments, here is the relevant text -
Quote:To experiment with the patterns that this program can produce it is only necessary to alter the values held in two constants. These constants are SmallDiameter# and Offset#. Changing the value in SmallDiameter# will alter the overall shape of the pattern while altering Offset# will change the "pointyness" of the peaks. To see what I am talking about, simply play around with these constants. Note that it is not necessary to change both values every time that you wish to change the pattern.
If you find values for one or the other of those constants feel free to post them in here. To start you off try a value of 100 for SmallDiameter#. One little warning - it is possible to get the drawing to run off the screen although this doesn't crash the program.
SPIRO.BAS
Code: (Select All)
'===========================================================================
' Subject: SIMULATION OF A SPIROGRAPH Date: 02-23-99 (21:53)
' Author: TarotRedhand Code: QB, QBasic, PDS
'===========================================================================
'SPIRO.BAS - A simulation of the most used part of the toy called a
' spirograph. Public domain. Use entirely at own risk. The
' author accepts no liability whatsoever. In the case that I have
' used a registered trademark, I apologise. I do not at this time
' own any trademarks.
'
' There is a toy called a spirograph that is used to make curved patterns.
' This toy consists of a number of pieces that are made from transparent
' plastic and a number of ball-point pens with different coloured inks in them.
' Each piece has gear-teeth along their outside edges. The gear-teeth are
' all of the same size, independent of the piece that they are on. In
' addition each piece has a number of holes in them, which are designed to
' accept a pen point.
'
' This program works in VGA mode 12 graphics and is a simulation of the most
' often used part of that toy. It simulates the use of 2 of the plastic pieces
' to produce a circular pattern. As this program uses double-precision
' numbers and maths, it is comparatively slow. One thing that I have done to
' speed this up is to have 2 identical SUBs with STATIC variables in them.
' This works by ensuring that the built-in functions SIN and COS are only
' called once for each of the 2 angles that are used.
'
' RULES
'
' In order to use this program there are a few rules that you should be aware
' of. DO NOT alter the value of the constant LargeDiameter#. DO NOT place a
' value in the constant SmallDiameter# that is less than or equal to zero or
' greater than or equal to the value in LargeDiameter#. DO NOT place a value
' greater than one or less than or equal to zero in the constant Offset.
' Violation of any of these rules will result in at best, the program
' attempting to draw off of the screen.
'
' Using this program.
'
' To experiment with the patterns that this program can produce it is only
' necessary to alter the values held in two constants. These constants are
' SmallDiameter# and Offset#. Changing the value in SmallDiameter# will alter
' the overall shape of the pattern while altering Offset# will change the
' "pointyness" of the peaks. To see what I am talking about, simply play
' around with these constants. Note that it is not necessary to change both
' values every time that you wish to change the pattern.
'
' Anyway, have fun.
'
' TarotRedhand - 11/1998
'
Const PI# = 3.141592653589793#
Const LargeDiameter# = 478
Const SmallDiameter# = 333
Const CenterX# = 320, CenterY# = 240
Const Offset# = .725
Const Angle1# = 1
Const StartColour = 1
Const EndColour = 13
Const FALSE% = 0
Const TRUE% = Not FALSE%
LC# = (PI# * LargeDiameter#) / 360
A2# = 360 / ((PI# * SmallDiameter#) / LC#)
SmallRadius# = SmallDiameter# / 2
SmallCenterY# = 1 + SmallRadius#
SmallCenterX# = CenterX#
StartX# = CenterX#
StartY# = 1 + SmallRadius# - (SmallRadius# * Offset#)
MyX# = StartX#
MyY# = StartY#
Orbit1 SmallCenterX#, SmallCenterY#, CenterX#, CenterY#, Angle1#, TRUE%
Orbit1 MyX#, MyY#, CenterX#, CenterY#, Angle1#, FALSE%
Orbit2 MyX#, MyY#, SmallCenterX#, SmallCenterY#, -A2#, TRUE%
Screen 12
_FullScreen _SquarePixels
Line (1, 1)-(640, 480), 15, BF
Colour = StartColour
Line (StartX#, StartY#)-(MyX#, MyY#), Colour
Do
For Index% = 1 To 360
Orbit1 SmallCenterX#, SmallCenterY#, CenterX#, CenterY#, Angle1#, FALSE%
Orbit1 MyX#, MyY#, CenterX#, CenterY#, Angle1#, FALSE%
Orbit2 MyX#, MyY#, SmallCenterX#, SmallCenterY#, -A2#, FALSE%
Line -(MyX#, MyY#), Colour
_Delay 0.002
If InKey$ <> "" Then
Exit Do
End If
Next Index%
Colour = Colour + 1
If Colour > EndColour Then Colour = StartColour
Loop
End
Sub Orbit1 (PointX#, PointY#, OrbitX#, OrbitY#, Angle#, FirstTime%)
Static C#, S#
If FirstTime% Then
C# = Cos(Angle# * (PI# / 180#))
S# = Sin(Angle# * (PI# / 180#))
End If
OldX# = PointX# - OrbitX#
OldY# = PointY# - OrbitY#
PointX# = (OldX# * C# - OldY# * S#) + OrbitX#
PointY# = (OldX# * S# + OldY# * C#) + OrbitY#
End Sub
Sub Orbit2 (PointX#, PointY#, OrbitX#, OrbitY#, Angle#, FirstTime%)
Static C#, S#
If FirstTime% Then
C# = Cos(Angle# * (PI# / 180#))
S# = Sin(Angle# * (PI# / 180#))
End If
OldX# = PointX# - OrbitX#
OldY# = PointY# - OrbitY#
PointX# = (OldX# * C# - OldY# * S#) + OrbitX#
PointY# = (OldX# * S# + OldY# * C#) + OrbitY#
End Sub
I'm not a professional programmer, just a hobbyist, but I'm proud of what I was able to accomplish with QB64.
This is a program that will be of interest to a limited audience. It's for those who want to be able to manage, update, manipulate, and deploy Windows 10 and 11 images and media.
I've spent years learning how to perform all these tasks, and more importantly, how to do them the RIGHT way. I've poured all that knowledge into this program.
If this sounds like something that you might be at all interested in check it out on my GitHub page. It was simply too large to post here.
to simplify the updates, I created this dedicated post.
after reading some information about gcc, i decided to use the -O3 compiler option. it's a good compromise between security and speed.
if this is your first installation of qb64, it is advised to run the script setup_lnx.sh to install the package dependencies necessary for qb64...
this script allows to insert the -O3 compiler option of gcc g++ to optimize qb64. the original files are saved. i removed some useless sections of the original script setup_lnx.sh. download the source code of qb64, unzip, put the script in the directory where is setup_lnx.sh, make it executable and run it. the processing is automatic. if the compilation was successful, the qb64 executable will be created:
compile_qb64.sh
Code: (Select All)
#!/bin/bash
# QB64 Installer
# Argument 1: If not blank, qb64 will not be started after compilation
dont_run="$1"
#This checks the currently installed packages for the one's QB64 needs
#And runs the package manager to install them if that is the case
# *** SECTION ENLEVE ***
#Make sure we're not running as root
if [ $EUID == "0" ]; then
echo "You are trying to run this script as root. This is highly unrecommended."
echo "This script will prompt you for your sudo password if needed to install packages."
exit 1
fi
GET_WGET=
#Path to Icon
#Relative Path to icon -- Don't include beginning or trailing '/'
QB64_ICON_PATH="internal/source"
#Name of the Icon picture
QB64_ICON_NAME="qb64icon32.png"
DISTRO=
lsb_command=`which lsb_release 2> /dev/null`
if [ -z "$lsb_command" ]; then
lsb_command=`which lsb_release 2> /dev/null`
fi
#Outputs from lsb_command:
#Arch Linux = arch
#Debian = debian
#Fedora = Fedora
#KUbuntu = ubuntu
#LUbuntu = ubuntu
#Linux Mint = linuxmint
#Ubuntu = ubuntu
#Slackware = slackware
#VoidLinux = voidlinux
#XUbuntu = ubuntu
#Zorin = Zorin
if [ -n "$lsb_command" ]; then
DISTRO=`$lsb_command -si | tr '[:upper:]' '[:lower:]'`
elif [ -e /etc/arch-release ]; then
DISTRO=arch
elif [ -e /etc/debian_version ] || [ -e /etc/debian_release ]; then
DISTRO=debian
elif [ -e /etc/fedora-release ]; then
DISTRO=fedora
elif [ -e /etc/redhat-release ]; then
DISTRO=redhat
elif [ -e /etc/centos-release ]; then
DISTRO=centos
fi
#Find and install packages
# *** SECTION ENLEVE ***
if [ -e "./qb64" ]; then
echo "DISTRO: $DISTRO"
echo "Done compiling!!"
echo
echo "QB64 is located in this folder:"
echo "`pwd`"
else
### QB64 didn't compile
echo "It appears that the qb64 executable file was not created, this is usually an indication of a compile failure (You probably saw lots of error messages pop up on the screen)"
echo "Usually these are due to missing packages needed for compilation. If you're not running a distro supported by this compiler, please note you will need to install the packages listed above."
echo "If you need help, please feel free to post on the QB64 Forums detailing what happened and what distro you are using."
echo "Also, please tell them the exact contents of this next line:"
echo "DISTRO: $DISTRO"
fi
echo
echo "Thank you for using the QB64 installer."
I put this together last night for a younger relative to play. It's the classic cups and ball, or shell game. The ball hides under a cup, cups are shuffled around, you click on the cup you think the ball is under. There's no score keeping, it just keeps looping over with a new game. Mildly entertaining to play for a while I suppose. The fun for me was making it. This uses the power of RotoZoom3 to animate/shuffle the cups.
- Dav
Code: (Select All)
'============
'FINDBALL.BAS
'============
'Classic Cups & Ball game (shell game)
'Coded by Dav, MAY/2022
'Cups will shuffle. Click the cup with the ball.
'If selected correctly, screen flashes green. If not,
'screen will flash red. This could be turned into a
'game easy, with score keeping and speed changes.
'For now it just loops over and over.
RANDOMIZE TIMER
SCREEN _NEWIMAGE(1000, 600, 32)
cup& = BASIMAGE1& 'decode cup image to use
ball& = BASIMAGE2& 'decode ball image to use
speed = 75 'speed for _LIMIT
moves = 15 'how many shuffle moves to do
DO
cupball = INT(RND * 3) + 1 'make random cupball number (1,2,or 3)
GOSUB ShowBall 'show where ball is first
'shuffle the cups
FOR m = 1 TO moves
SELECT CASE INT(RND * 6) + 1 'random move
CASE 1: GOSUB move1to2
CASE 2: GOSUB move1to3
CASE 3: GOSUB move2to1
CASE 4: GOSUB move2to3
CASE 5: GOSUB move3to1
CASE 6: GOSUB move3to2
END SELECT
NEXT
GOSUB PlaceCups 'make sure they are placed right
selected = 0 'not selected yet
DO
WHILE _MOUSEINPUT: WEND
IF _MOUSEBUTTON(1) THEN
mx = _MOUSEX: my = _MOUSEY
'clicked cup 1
IF mx > 114 AND mx < 316 AND my > 146 AND my < 439 THEN
IF cupball = 1 THEN selected = 1
EXIT DO
END IF
'clicked cup 2
IF mx > 378 AND mx < 600 AND my > 146 AND my < 439 THEN
IF cupball = 2 THEN selected = 1
EXIT DO
END IF
'clicked cup 3
IF mx > 694 AND mx < 911 AND my > 146 AND my < 439 THEN
IF cupball = 3 THEN selected = 1
EXIT DO
END IF
END IF
LOOP
'make sure mouse button up to continue
DO UNTIL _MOUSEBUTTON(1) = 0: m = _MOUSEINPUT: LOOP
'flash screen based on selection
IF selected = 0 THEN
'flash red - wrong one
LINE (0, 0)-(_WIDTH, _HEIGHT), _RGBA(255, 0, 0, 100), BF
_DISPLAY
_DELAY .25
ELSE
'flash green - selected right
LINE (0, 0)-(_WIDTH, _HEIGHT), _RGBA(0, 255, 0, 100), BF
_DISPLAY
_DELAY .25
END IF
GOSUB ShowBall 'show where ball is
LOOP
END
'===================================================================
PlaceCups: 'shows all cups in place
'=========
'Place all cups first
_PUTIMAGE (0, 0), back&
RotoZoom3 200, 300, cup&, 1, 1, 0
RotoZoom3 500, 300, cup&, 1, 1, 0
RotoZoom3 800, 300, cup&, 1, 1, 0
_DISPLAY
RETURN
'=====
'===================================================================
ShowBall: 'Raises cup to show ball
'=======
'make sure showing all cups first
GOSUB PlaceCups
_DISPLAY: _DELAY 1
'raise a cup based on cupball number
SELECT CASE cupball
CASE IS = 1 'raise cup 1
_PUTIMAGE (0, 0), back&
FOR y = 300 TO 175 STEP -7
_PUTIMAGE (0, 0), back&
RotoZoom3 500, 300, cup&, 1, 1, 0
RotoZoom3 800, 300, cup&, 1, 1, 0
RotoZoom3 210, 400, ball&, 1, 1, 0 'ball first
RotoZoom3 200, y, cup&, 1, 1, 0 'cup over
_DISPLAY
_LIMIT 50
NEXT
CASE IS = 2 'raise cup 2
_PUTIMAGE (0, 0), back&
FOR y = 300 TO 175 STEP -7
_PUTIMAGE (0, 0), back&
RotoZoom3 200, 300, cup&, 1, 1, 0
RotoZoom3 800, 300, cup&, 1, 1, 0
RotoZoom3 510, 400, ball&, 1, 1, 0 'ball first
RotoZoom3 500, y, cup&, 1, 1, 0 'cup over
_DISPLAY
_LIMIT 50
NEXT
CASE IS = 3 'raise cup 3
_PUTIMAGE (0, 0), back&
FOR y = 300 TO 175 STEP -7
_PUTIMAGE (0, 0), back&
RotoZoom3 200, 300, cup&, 1, 1, 0
RotoZoom3 500, 300, cup&, 1, 1, 0
RotoZoom3 810, 400, ball&, 1, 1, 0 'ball first
RotoZoom3 800, y, cup&, 1, 1, 0 'cup over
_DISPLAY
_LIMIT 50
NEXT
END SELECT
_DELAY 1 'pause to see ball
'now lower the same a cup
SELECT CASE cupball
CASE IS = 1 'lower cup 1
_PUTIMAGE (0, 0), back&
FOR y = 175 TO 300 STEP 7
_PUTIMAGE (0, 0), back&
RotoZoom3 500, 300, cup&, 1, 1, 0
RotoZoom3 800, 300, cup&, 1, 1, 0
RotoZoom3 210, 400, ball&, 1, 1, 0 'ball first
RotoZoom3 200, y, cup&, 1, 1, 0 'cup over
_DISPLAY
_LIMIT 50
NEXT
CASE IS = 2 'lower cup 2
_PUTIMAGE (0, 0), back&
FOR y = 175 TO 300 STEP 7
_PUTIMAGE (0, 0), back&
RotoZoom3 200, 300, cup&, 1, 1, 0
RotoZoom3 800, 300, cup&, 1, 1, 0
RotoZoom3 510, 400, ball&, 1, 1, 0 'ball first
RotoZoom3 500, y, cup&, 1, 1, 0 'cup over
_DISPLAY
_LIMIT 50
NEXT
CASE IS = 3 'lower cup 3
_PUTIMAGE (0, 0), back&
FOR y = 175 TO 300 STEP 7
_PUTIMAGE (0, 0), back&
RotoZoom3 200, 300, cup&, 1, 1, 0
RotoZoom3 500, 300, cup&, 1, 1, 0
RotoZoom3 810, 400, ball&, 1, 1, 0 'ball first
RotoZoom3 800, y, cup&, 1, 1, 0 'cup over
_DISPLAY
_LIMIT 50
NEXT
END SELECT
RETURN
'=====
'===================================================================
move1to2: 'moves cup 1 over to cup 2
'=======
cup1z = 1: cup2z = 1: cup3z = 1
FOR move = 1 TO 300 STEP 15
_PUTIMAGE (0, 0), back& 'redraw background
'cup 3 stays in place
RotoZoom3 800, 300, cup&, cup3z, cup3z, 0
'cup 2 shrinks, going under cup 1, moving left
RotoZoom3 500 - move, 300 - cup2z, cup&, cup2z, cup2z, 0
IF move > 150 THEN cup2z = cup2z + .03 ELSE cup2z = cup2z - .03
'cup 1 enlarges, going over cup 2, moving right
RotoZoom3 200 + move, 300 * cup1z, cup&, cup1z, cup1z, 0
IF move > 150 THEN cup1z = cup1z - .03 ELSE cup1z = cup1z + .03
_DISPLAY
_LIMIT speed
NEXT
'swap ball placement
SELECT CASE cupball
CASE 1: cupball = 2
CASE 2: cupball = 1
END SELECT
RETURN
'=====
'===================================================================
move1to3: 'move cup 1 over to cup 3
'=======
cup1z = 1: cup2z = 1: cup3z = 1
FOR move = 1 TO 300 STEP 8
_PUTIMAGE (0, 0), back&
'cup 3 shrinks, moves left two places
RotoZoom3 800 - (move * 2), 300 - cup3z, cup&, cup3z, cup3z, 0
IF move > 150 THEN cup3z = cup3z + .02 ELSE cup3z = cup3z - .02
'cup 2 stays in place
RotoZoom3 500, 300, cup&, cup2z, cup2z, 0
'cup 1 enlarges, moving right two places
RotoZoom3 200 + (move * 2), 300 * cup1z, cup&, cup1z, cup1z, 0
IF move > 150 THEN cup1z = cup1z - .02 ELSE cup1z = cup1z + .02
_DISPLAY
_LIMIT speed * 1.7
NEXT
SELECT CASE cupball
CASE 1: cupball = 3
CASE 3: cupball = 1
END SELECT
RETURN
'=====
'===================================================================
move2to1: 'move cup 2 over to cup 1
'=======
cup1z = 1: cup2z = 1: cup3z = 1
FOR move = 1 TO 300 STEP 15
_PUTIMAGE (0, 0), back&
'3rd cup stays in place
RotoZoom3 800, 300, cup&, cup3z, cup3z, 0
'cup 1 shrinks, moving right
RotoZoom3 200 + move, 300 - cup1z, cup&, cup1z, cup1z, 0
IF move > 150 THEN cup1z = cup1z + .03 ELSE cup1z = cup1z - .03
'cup 2 enlarges, moving left
RotoZoom3 500 - move, 300 * cup2z, cup&, cup2z, cup2z, 0
IF move > 150 THEN cup2z = cup2z - .03 ELSE cup2z = cup2z + .03
_DISPLAY
_LIMIT speed
NEXT
SELECT CASE cupball
CASE 1: cupball = 2
CASE 2: cupball = 1
END SELECT
RETURN
'=====
'===================================================================
move2to3: 'move cup 2 over to cup 3
'=======
cup1z = 1: cup2z = 1: cup3z = 1
FOR move = 1 TO 300 STEP 15
_PUTIMAGE (0, 0), back&
'cup 1 stays in place
RotoZoom3 200, 300, cup&, cup1z, cup1z, 0
'cup 3 shrinks under, moves left 1 cup,
RotoZoom3 800 - move, 300 - cup3z, cup&, cup3z, cup3z, 0
IF move > 150 THEN cup3z = cup3z + .03 ELSE cup3z = cup3z - .03
'cup 2 enlarges over, moves right 1 cup
RotoZoom3 500 + move, 300 * cup2z, cup&, cup2z, cup2z, 0
IF move > 150 THEN cup2z = cup2z - .03 ELSE cup2z = cup2z + .03
_DISPLAY
_LIMIT speed
NEXT
SELECT CASE cupball
CASE 2: cupball = 3
CASE 3: cupball = 2
END SELECT
RETURN
'===================================================================
move3to1: 'move cup 3 over to cup 1
'=======
cup1z = 1: cup2z = 1: cup3z = 1
FOR move = 1 TO 300 STEP 8
_PUTIMAGE (0, 0), back&
'cup 1 shrinks under, moving right two cup places,
RotoZoom3 200 + (move * 2), 300 - cup1z, cup&, cup1z, cup1z, 0
IF move > 150 THEN cup1z = cup1z + .02 ELSE cup1z = cup1z - .02
'cup2 stays in place
RotoZoom3 500, 300, cup&, cup2z, cup2z, 0
'cup 3 enlarges over, moving left two cup places,
RotoZoom3 800 - (move * 2), 300 * cup3z, cup&, cup3z, cup3z, 0
IF move > 150 THEN cup3z = cup3z - .02 ELSE cup3z = cup3z + .02
_DISPLAY
_LIMIT speed * 1.7
NEXT
SELECT CASE cupball
CASE 3: cupball = 1
CASE 1: cupball = 3
END SELECT
RETURN
'=====
'===================================================================
move3to2: 'move cup 3 over to cup2
'=======
cup1z = 1: cup2z = 1: cup3z = 1
FOR move = 1 TO 300 STEP 15
_PUTIMAGE (0, 0), back&
'cup1 stays in place
RotoZoom3 200, 300, cup&, cup1z, cup1z, 0
'cup 2 shrinks under, moves right 1 cup
RotoZoom3 500 + move, 300 - cup2z, cup&, cup2z, cup2z, 0
IF move > 150 THEN cup2z = cup2z + .03 ELSE cup2z = cup2z - .03
'cup 3 enlarges over, moves left 1 cup,
RotoZoom3 800 - move, 300 * cup3z, cup&, cup3z, cup3z, 0
IF move > 150 THEN cup3z = cup3z - .03 ELSE cup3z = cup3z + .03
_DISPLAY
_LIMIT speed
NEXT
SELECT CASE cupball
CASE 3: cupball = 2
CASE 2: cupball = 3
END SELECT
RETURN
SUB RotoZoom3 (X AS LONG, Y AS LONG, Image AS LONG, xScale AS SINGLE, yScale AS SINGLE, radianRotation AS SINGLE)
' This assumes you have set your drawing location with _DEST or default to screen.
' X, Y - is where you want to put the middle of the image
' Image - is the handle assigned with _LOADIMAGE
' xScale, yScale - are shrinkage < 1 or magnification > 1 on the given axis, 1 just uses image size.
' These are multipliers so .5 will create image .5 size on given axis and 2 for twice image size.
' radianRotation is the Angle in Radian units to rotate the image
' note: Radian units for rotation because it matches angle units of other Basic Trig functions
' and saves a little time converting from degree.
' Use the _D2R() function if you prefer to work in degree units for angles.
DIM px(3) AS SINGLE: DIM py(3) AS SINGLE ' simple arrays for x, y to hold the 4 corners of image
DIM W&, H&, sinr!, cosr!, i&, x2&, y2& ' variables for image manipulation
W& = _WIDTH(Image&): H& = _HEIGHT(Image&)
px(0) = -W& / 2: py(0) = -H& / 2 'left top corner
px(1) = -W& / 2: py(1) = H& / 2 ' left bottom corner
px(2) = W& / 2: py(2) = H& / 2 ' right bottom
px(3) = W& / 2: py(3) = -H& / 2 ' right top
sinr! = SIN(-radianRotation): cosr! = COS(-radianRotation) ' rotation helpers
FOR i& = 0 TO 3 ' calc new point locations with rotation and zoom
x2& = xScale * (px(i&) * cosr! + sinr! * py(i&)) + X: y2& = yScale * (py(i&) * cosr! - px(i&) * sinr!) + Y
px(i&) = x2&: py(i&) = y2&
NEXT
_MAPTRIANGLE _SEAMLESS(0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image TO(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
_MAPTRIANGLE _SEAMLESS(0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image TO(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
END SUB
Help!!!
I've found this morning that I can't produce ANY new QB64 programs. When I write one, as simple as SCREEN 12 : PRINT "OK": STOP, I get an error "C++ compilation failed".
I can re-compile and run all my previous progs, even after making changes to them, but no new ones . What the...?
(I know this is headed as HELP, and should possibly be in the Help Me post, but it seems more related to QB64 questions, to me).
Constructed from a series of letters that I posted in the QB ECHO of FIDONET quite a long time ago. Note that this tutorial was all about speeding things up which may not be quite the problem it was back then. Anyway, here is the original tutorial. In addition to the line drawing routine that is used to illustrate this tutorial on optimisation, I have included a couple of other graphics primitives routines. Fill is a seed fill routine and doros is an integer circle drawing routine. Doros is based on an algorithm discovered by a professor Doros and is a variation of the standard bresenham routine. The only drawback to it is that in order for it to produce circular circles it needs square pixels (i.e. SCREEN 12).
As there doesn't seem to be a lot of code floating around at present and we have quite a few newbies here I thought I would give an example of the way I have developed stuff in the past. Now as most people who are new to programming are interested in graphics I thought I'd use an example based in this area. Below is a small program that illustrates a different method of drawing a line on the screen than the one that is built into QB. The actual algorithm used is called a digital difference engine and while it is small it does have some drawbacks <g>.
Try it now and see if you can spot what they are. When you have done that go to the end of this message for an explanation of what they are and how the algorithm works.
Code: (Select All)
CONST FromX = 10
CONST FromY = 10
CONST ToX = 310
CONST ToY = 190
SCREEN 13
_FullScreen _SquarePixels
FOR index = 1 TO 5
LINE (FromX, FromY)-(ToX, ToY), 15
Sleep
DigitalDifferenceEngine FromX, FromY, ToX, ToY, 12
Sleep
NEXT index
SLEEP
END
SUB DigitalDifferenceEngine (X1, Y1, X2, Y2, C)
XS = 1
YS = 1
XI = 1
YI = 1
DX = X2 - X1
DY = Y2 - Y1
IF DX < 0 THEN XS = -1
IF DY < 0 THEN YS = -1
NX = ABS(DX)
NY = ABS(DY)
IF NX >= NY THEN
NP = NX
YI = NY / NX
ELSE
NP = NY
XI = NX / NY
END IF
FOR Q = 0 TO NP
X = X1 + XS * INT(Q * XI + .5)
Y = Y1 + YS * INT(Q * YI + .5)
PSET (X, Y), C
NEXT Q
END SUB
O.K. So first lets mention what is good about this routine. First the layout is almost perfect and second flow of control is good i.e. no spaghetti. Thirdly it does what it is supposed to do. So what's bad about it. Well the majority of the variable names are either one or two letters long which makes it a lot harder to understand than necessary. Apart from this it is *slow*. Its slow because it uses floating point routines instead of integer and it is not optimised at all. However, before we can optimise it we have to understand how it works. The first step to understanding how it works is too change the variable names to something more meaningful.
Code: (Select All)
CONST FromX = 10
CONST FromY = 10
CONST ToX = 310
CONST ToY = 190
SCREEN 13
_FullScreen _SquarePixels
FOR index = 1 TO 5
LINE (FromX, FromY)-(ToX, ToY), 15
Sleep
DigitalDifferenceEngine FromX, FromY, ToX, ToY, 12
Sleep
NEXT index
SLEEP
END
SUB DigitalDifferenceEngine (X1, Y1, X2, Y2, Colour)
DirectionX = 1
DirectionY = 1
XIncrement = 1
YIncrement = 1
DistanceX = X2 - X1
DistanceY = Y2 - Y1
IF DistanceX < 0 THEN DirectionX = -1
IF DistanceY < 0 THEN DirectionY = -1
NewDistanceX = ABS(DistanceX)
NewDistanceY = ABS(DistanceY)
IF NewDistanceX >= NewDistanceY THEN
NumberOfPoints = NewDistanceX
YIncrement = NewDistanceY / NewDistanceX
ELSE
NumberOfPoints = NewDistanceY
XIncrement = NewDistanceX / NewDistanceY
END IF
FOR PointNumber = 0 TO NumberOfPoints
X = X1 + DirectionX * INT(PointNumber * XIncrement + .5)
Y = Y1 + DirectionY * INT(PointNumber * YIncrement + .5)
PSET (X, Y), Colour
NEXT PointNumber
END SUB
So how does this work? First we set the variables that determine the direction that the line will be drawn in (i.e. up and to the right etc.) to one each. We also set the variables that determine the rate of change in both the X and Y directions, to one each. After this we determine the distance between the start and end points for both the X and Y directions. Having got a value for the distances we then test for these values being negative and if they are we correct the relevant direction variables to reflect this. We then make sure that we have positive values for both distance variables. We are now ready to determine how many points need to be set for our line. We do this by testing to see which of the two distance variables is the larger. Once we have determined this we set the number of points to be equal to the larger value. We also reduce the value held in the variable that determines the rate of change for the other direction. So if the distance between the 2 X coordinates is larger than that between the 2 Y coordinates we change the YIncrement variable. The new value that is assigned to this variable is less than one and is determined by dividing the smaller distance by the longer. We are now, finally, ready to draw our line. See if you can work out how the X and Y coordinates are finally determined in the body of the for-next loop.
OK so how do we go about optimising this? Well first we need to analyse it in a little more depth. Looking at it a bit more closely it becomes apparent that *both* the longest and shortest distances are important. We have already established that the longest distance is the number of pixels (-1) that we need to turn on for our line. The shortest distance is the number of times we need to alter our other coordinate. For example if the longest distance is in the X direction then we will need to change our Y coordinate DistanceY times. We can use this fact a little later to enable us to optimise our routine.
Now as our major concern is to speed this routine up, the most obvious change would be to convert it from floating point to integer because floating point operations are *slow* by comparison. This is easy enough until we get to the point where fractions are used. However there is a way around this. In order to illustrate this I will assume that the distance between the two X coordinates is the longest. Looking at our routine we can see that in this case our DistanceX corresponds to an IncrementX of precisely 1. What this does is to ensure that for every pass through our for-next loop, a new pixel is set in the X direction. We also see that our IncrementY is a fraction of 1. This means that it takes a more than 1 pass (except in one special case mentioned later) through our for-next loop before we change the Y coordinate of the pixels that we are setting. We can simulate this by use of a variable that holds an intermediate value. What we do is to assign a value of zero to this variable before we enter the for-next loop. Then on every pass through the loop we add the DistanceY to this variable and compare the result with our DistanceX. When the value in our variable equals or exceeds that of DistanceX we alter the Y coordinate and subtract the value of DistanceX from it.
We are now almost there. We can now (if we so desire) convert our line drawing routine from being floating point to integer. However there is still some optimisation we can do to our routine. Again the 2 distance variables are central to this. This is because there are some cases where we do not need to do any comparisons within the for-next loop. Remember, every time that we need to make a comparison we are using processor time. Fortunately these cases are easy enough to detect by examining the values of the 2 distance variables.
The first special case is detected when both distance variables hold the value zero. When this is the case it means that we are dealing with a single pixel that needs to set and not a line to be drawn so we can use PSET and return from our SUB.
The second case is where the DistanceX variable holds zero and DistanceY does not. This means that we need to draw a vertical line.
In the third case it is DistanceY that holds zero and DistanceX does not. In this case we need to draw a horizontal line.
The final special case is where neither distance variable holds zero but both contain the same value. This is where we need to draw a diagonal line at 45 degrees (at least in modes with square pixels). This means that for each new pixel there is a new X and Y coordinate pair.
This leaves the 2 cases that will be used most often. Where the DistanceX is greater than the DistanceY and where the DistanceY is greater than the DistanceX. As we have separated out the other 4 cases in the interests of speed optimisation it makes sense to do the same for this last pair of cases.
The final design decision that I have taken is to implement the whole thing as a number of SUBs. This makes it easier to test and also, I hope, easier to understand.
Code: (Select All)
CONST FromX = 10
CONST FromY = 10
CONST ToX = 310
CONST ToY = 190
SCREEN 13
_FullScreen _SquarePixels
FOR Index = 1 TO 5
LINE (FromX, FromY)-(ToX, ToY), 15
Sleep
DDE2 FromX, FromY, ToX, ToY, 12
Sleep
NEXT Index
SLEEP
END
SUB DDE2 (X1%, Y1%, X2%, Y2%, Colour%)
XLength% = X2% - X1%
XIncrement% = SGN(XLength%)
XLength% = XLength% * XIncrement%
YLength% = Y2% - Y1%
YIncrement% = SGN(YLength%)
YLength% = YLength% * YIncrement%
IF XLength% = 0 AND YLength% = 0 THEN
PSET (X1%, Y1%), Colour%
ELSEIF XLength% = YLength% THEN
Do45Degrees X1%, Y1%, XIncrement%, YIncrement%, XLength%, Colour%
ELSEIF XLength% = 0 THEN
DoVertical X1%, Y1%, Y2%, YIncrement%, Colour%
ELSEIF YLength% = 0 THEN
DoHorizontal X1%, X2%, Y1%, XIncrement%, Colour%
ELSEIF XLength% > YLength% THEN
XGreater X1%, Y1%, XLength%, YLength%, XIncrement%, YIncrement%, Colour%
ELSE
YGreater X1%, Y1%, XLength%, YLength%, XIncrement%, YIncrement%, Colour%
END IF
END SUB
SUB Do45Degrees (XStart%, YStart%, XIncrement%, YIncrement%, Length%, Colour%)
X% = XStart%
Y% = YStart%
PSET (X%, Y%), Colour%
FOR Index% = 1 TO Length%
X% = X% + XIncrement%
Y% = Y% + YIncrement%
PSET (X%, Y%), Colour%
NEXT Index%
END SUB
SUB DoHorizontal (X1%, X2%, Y%, XIncrement%, Colour%)
FOR X% = X1% TO X2% STEP XIncrement%
PSET (X%, Y%), Colour%
NEXT X%
END SUB
SUB DoVertical (X%, Y1%, Y2%, YIncrement%, Colour%)
FOR Y% = Y1% TO Y2% STEP YIncrement%
PSET (X%, Y%), Colour%
NEXT Y%
END SUB
SUB XGreater (XStart%, YStart%, XLength%, YLength%, XIncrement%, YIncrement%, Colour%)
X% = XStart%
Y% = YStart%
ChangeY% = 0
PSET (X%, Y%), Colour%
FOR Index% = 1 TO XLength%
X% = X% + XIncrement%
ChangeY% = ChangeY% + YLength%
IF ChangeY% >= XLength% THEN
Y% = Y% + YIncrement%
ChangeY% = ChangeY% - XLength%
END IF
PSET (X%, Y%), Colour%
NEXT Index%
END SUB
SUB YGreater (XStart%, YStart%, XLength%, YLength%, XIncrement%, YIncrement%, Colour%)
X% = XStart%
Y% = YStart%
ChangeX% = 0
PSET (X%, Y%), Colour%
FOR Index% = 1 TO YLength%
Y% = Y% + YIncrement%
ChangeX% = ChangeX% + XLength%
IF ChangeX% >= YLength% THEN
X% = X% + XIncrement%
ChangeX% = ChangeX% - YLength%
END IF
PSET (X%, Y%), Colour%
NEXT Index%
END SUB
Finally a few notes.
IMPORTANT - There is absolutely *no* error detection in either routine! So be careful and add them in yourself. This was done for clarity.
At this point you may be saying 'But QB already has a LINE command, why do we need another one? Not only that, but this new line does less than the built in one!' True, but the built-in commands won't work with any of the varieties of modex. And what happens if for some reason you need to write a line drawing routine in some other language say assembly? Well now you've got an algorithm that you can use.
Once you've run these routines you may be saying 'Well it appears to work but it doesn't draw exactly the same line as the built-in routine.' True again <g>. This just shows that there are a number of different algorithms that can be used to achieve the same end. I strongly suspect that the built-in routine is a variety of the more commonly used Bresenham algorithm. Because the Bresenham algorithm has error-correction built-in it draws a more accurate line, but this can slow the drawing down. Even though the Bresenham algorithm is more accurate both algorithms start and end at exactly the same point, so the choice is yours <g>.
Posted by: Pete - 05-08-2022, 06:11 PM - Forum: Programs
- No Replies
I built a game called Pecos Pete Poker around a couple of decades ago. I recently updated it to play on QB64, and I also got together with TheBOB who offered his graphics playing cards if I wanted to make a graphics version. I've been working on that, and since I love reinventing the wheel, I came up with a completely new poker hand evaluator to go with it. This hand evaluation model is written in SCREEN 0 but can be converted to evaluate graphics hands, which I'll work on next week.
You need jacks or better to display a "Pair" with a payout. Other lesser pairs are marked in grey. Press Enter or any non-number key to draw the next hand. Since it takes awhile to get hands like 4 of a kind, and especially a royal flush, I put number buttons in a menu. Press 1 to wait on a royal flush, 2 for a straight flush, 3 for 4 of a kind, 4 for a full house, etc. Press esc if you get tired of waiting, it will go back to one at a time display.
Code: (Select All)
' Jacks or better poker evaluator demo.
' Use keys 1 - 9 to search for particular hands, Royal Flush, Full HOuse, etc.
sw% = 55
sh% = 17
WIDTH sw%, sh%
PALETTE 7, 63
COLOR 0, 7: CLS
fontpath$ = ENVIRON$("SYSTEMROOT") + "\fonts\lucon.ttf"
font& = _LOADFONT(fontpath$, 40, "monospace")
_FONT font&
_DELAY .25
_SCREENMOVE 0, 0
msg$ = "Poker Hand Evaluator"
LOCATE 1, (sw% / 2) - (LEN(msg$) / 2): PRINT msg$;
msg$ = "Any Key or 1=RF 2=SF 3=4K 4=FH 5=F 6=S 7=3K 8=2P 9=P"
LOCATE sh%, (sw% / 2) - (LEN(msg$) / 2): PRINT msg$;
VIEW PRINT 3 TO sh% - 2: LOCATE 4, 1
h = 1 ' Number of hands.
noc = 5 ' Number of card.
DO
REDIM cardID$(1, 5)
REDIM taken(5)
taken(3) = 13: taken(4) = 26: taken(5) = 39
FOR i = 1 TO noc
DO
card = INT(RND * 52) + 1
FOR j = 1 TO i
IF taken(j) = card THEN flag = -1: EXIT FOR
NEXT
IF flag = 0 THEN taken(i) = card: EXIT DO ELSE flag = 0
LOOP
cardID$(h, i) = LTRIM$(STR$(y)) + "|" + LTRIM$(STR$(scol + (i - 1) * 120 + x)) + "#" + LTRIM$(STR$(card))
NEXT
IF POS(0) > 3 OR CSRLIN > 4 THEN PRINT: PRINT: PRINT: LOCATE CSRLIN - 1
LOCATE , 3
FOR j = 1 TO 5
a = VAL(MID$(cardID$(h, j), INSTR(cardID$(h, j), "#") + 1))
a1 = (a - 1) MOD 13 + 1
x$ = LTRIM$(STR$(a1))
b = (a + 12) \ 13
suite$ = CHR$(2 + b)
REM PRINT x$; suite$; " ";
IF suite$ = CHR$(3) OR suite$ = CHR$(4) THEN COLOR 4 ELSE COLOR 0
SELECT CASE VAL(x$)
CASE 1: PRINT "A"; suite$; " ";
CASE 13: PRINT "K"; suite$; " ";
CASE 12: PRINT "Q"; suite$; " ";
CASE 11: PRINT "J"; suite$; " ";
CASE 10: PRINT "10"; suite$; " ";
CASE ELSE: PRINT LTRIM$(STR$(VAL(x$))); suite$; " ";
END SELECT
NEXT
GOSUB eval
COLOR 1
LOCATE , 28
IF hand$ = "Pair" THEN
IF highkind >= 11 THEN COLOR 1: PRINT hand$; " (Pay Out)"; ELSE COLOR 8: PRINT hand$;
ELSE
PRINT hand$;
END IF
COLOR 1
IF search$ = "" THEN GOSUB getkey ELSE IF INKEY$ = CHR$(27) THEN search$ = ""
IF LEN(search$) THEN
IF hand$ = search$ THEN SLEEP: search$ = ""
END IF
LOOP
END
eval:
hand$ = ""
DO
' Look for flush, same suit.
samesuit = 0
FOR j = 1 TO noc
a = VAL(MID$(cardID$(h, j), INSTR(cardID$(h, j), "#") + 1))
b = (a + 12) \ 13
IF j > 1 AND b <> samesuit THEN flag = -1: EXIT FOR
samesuit = b
NEXT
IF flag = 0 THEN
' Flush or better.
hand$ = "Flush"
ELSE
flag = 0
END IF
' Look for staright, sequential order.
high = 0: low = 0: match$ = ""
FOR j = 1 TO noc
a = VAL(MID$(cardID$(h, j), INSTR(cardID$(h, j), "#") + 1))
a1 = (a - 1) MOD 13 + 1
match$ = match$ + CHR$(a1 + 64)
NEXT
IF INSTR(match$, CHR$(1 + 64)) THEN
IF INSTR(match$, CHR$(13 + 64)) THEN high = 14 ' Ace high straight possible.
END IF
FOR j = 1 TO noc
a = VAL(MID$(cardID$(h, j), INSTR(cardID$(h, j), "#") + 1))
a1 = (a - 1) MOD 13 + 1
IF j > 1 AND INSTR(match$, CHR$(a1 + 64)) <> j THEN match$ = "": EXIT FOR
IF low = 0 OR low > a1 THEN
IF a1 = 1 AND high = 14 THEN ELSE low = a1
END IF
IF high = 0 OR high < a1 THEN high = a1
NEXT
IF LEN(match$) AND high - low = noc - 1 THEN
IF hand$ = "Flush" THEN
IF high = 14 THEN
hand$ = "Royal Flush"
ELSE
hand$ = "Straight Flush": EXIT DO
END IF
ELSE
hand$ = "Straight": EXIT DO
END IF
END IF
' Look for number of kinds.
kinds = 1: highkind = -1
FOR j = 1 TO noc
kindcnt = 0
a = VAL(MID$(cardID$(h, j), INSTR(cardID$(h, j), "#") + 1))
a1 = (a - 1) MOD 13 + 1
IF a1 = 1 THEN ' Convert ace high.
a1 = 14
'' cardID$(h, j) = MID$(cardID$(h, j), 1, INSTR(cardID$(h, j), "#")) + "14"
END IF
FOR k = 1 TO noc
IF j <> k THEN
IF a1 = (VAL(MID$(cardID$(h, k), INSTR(cardID$(h, k), "#") + 1)) - 1) MOD 13 + 1 OR a1 = 14 AND (VAL(MID$(cardID$(h, k), INSTR(cardID$(h, k), "#") + 1)) - 1) MOD 13 + 1 = 1 THEN
kindcnt = kindcnt + 1: IF highkind < a1 OR highkind = 0 THEN highkind = a1
END IF
END IF
IF kinds <= kindcnt THEN kinds = kindcnt + 1
NEXT k
NEXT j
IF kinds = 4 THEN hand$ = "Four of a Kind": EXIT DO
IF kinds = 3 THEN ' Look for full house.
kinds = 0
FOR j = 1 TO noc
kindcnt = 0
a = VAL(MID$(cardID$(h, j), INSTR(cardID$(h, j), "#") + 1))
a1 = (a - 1) MOD 13 + 1
FOR k = 1 TO noc
IF j <> k AND a1 <> highkind THEN
IF a1 = (VAL(MID$(cardID$(h, k), INSTR(cardID$(h, k), "#") + 1)) - 1) MOD 13 + 1 THEN
kindcnt = kindcnt + 1
END IF
END IF
NEXT k
IF kinds < kindcnt THEN kinds = kindcnt + 1
NEXT j
IF kinds = 2 THEN
hand$ = "Full House": EXIT DO
ELSE
hand$ = "Three of a Kind": EXIT DO
END IF
END IF
IF kinds = 2 THEN
' Look for two pair.
kinds = 0
FOR j = 1 TO noc
kindcnt = 0
a = VAL(MID$(cardID$(h, j), INSTR(cardID$(h, j), "#") + 1))
a1 = (a - 1) MOD 13 + 1
FOR k = 1 TO noc
IF j <> k AND a1 <> highkind THEN
IF a1 = 1 AND highkind = 14 THEN
' Checks for ace as 1 here after previous highkind converion to 14.
ELSE
IF a1 = (VAL(MID$(cardID$(h, k), INSTR(cardID$(h, k), "#") + 1)) - 1) MOD 13 + 1 THEN
kindcnt = kindcnt + 1
END IF
END IF
END IF
NEXT k
IF kinds < kindcnt THEN kinds = kindcnt + 1
NEXT j
IF kinds = 2 THEN
hand$ = "Two Pair": EXIT DO
ELSE
hand$ = "Pair": EXIT DO
END IF
END IF
EXIT DO
LOOP
RETURN
getkey:
DO
_LIMIT 30
b$ = INKEY$
IF LEN(b$) THEN
IF b$ = CHR$(27) THEN SYSTEM
IF b$ >= "1" AND b$ <= "9" THEN
SELECT CASE VAL(b$)
CASE 1: search$ = "Royal Flush"
CASE 2: search$ = "Straight Flush"
CASE 3: search$ = "Four of a Kind"
CASE 4: search$ = "Full House"
CASE 5: search$ = "Flush"
CASE 6: search$ = "Straight"
CASE 7: search$ = "Three of a Kind"
CASE 8: search$ = "Two Pair"
CASE 9: search$ = "Pair"
END SELECT
EXIT DO
END IF
EXIT DO
END IF
LOOP
RETURN
