Show Posts

This section allows you to view all posts made by this member. Note that you can only see posts made in areas you currently have access to.

Topics - George McGinn

Pages: [1] 2

QB64 Discussion / Changes To Auto Install/Run QB64 on Raspberry PI ARM Processors

« on: February 03, 2022, 06:56:17 pm »

I've have updates ready to QB64 that will automatically install it on a Raspberry PI and works properly, including DATA statements.

With Apple's new computers running the M1 ARM processor, and Intel (announced in June of 2021), along with AMD and Microsoft working together (announced in October of 2021) to develop ARM processors, QB64 needs to be able to run on these chips as well.

I have tested my changes, but I would like some others to check it out as well before I push the change on Gitub.

In my tests, I have even run compiled QB64 programs that use MariaDB and Zenity on the PI without issues. Pipecom runs without issues as well as $DEBUG. However, my testing has only been done on the 32bit Raspian OS. I do plan to test it with other Linux systems that run on the PI.

There were a number of changes needed, which most are automated in the setup_lnx.sh script. The other change was made directly to common.h.

The two files that changed are below, but here is what I needed to change.

common.h
Two of the issues I ran into had to do with mis-aligned addresses (int32 and int16 for example). To correct this, I either needed to add "-fsanitize=address" to the gcc statement, or add code to the common.h file for ARM processors. I was given the code by a C++ programmer who explained that, while not an issue with x86_64 or i386 processors, it is an issue with ARM processors. The code (see below) corrects this issue. She also gave me the corresponding code for the x86_64/i386, just in case. I've regression tested this on my x86_64 system, but others should also run it as well.

setup_lnx.sh
The setup script has a number of issues on ARM processors. The first is it doesn't download the libraries needed, and the other it created invalid link modules. To correct the first issue, the setup script now checks whether or not the processor is an ARM. If so, it sets DISTRO to "raspbian". The issue about the link/binary executables has to do with how the ARM processes bits. ARM processors are little endian (See note below). So the script replaces both the makedat_lnx32.txt and makedat_lnx64.txt files with the correct parameters for the OBJCOPY. ("-Oelf32-littlearm -Barm" replaced the original "-Oelf32-i386 -Bi386" in the 32bit file and the "-Oelf64-littlearm -Barm" replaced the "-Oelf64-x86-64 -Bi386:x86-64" in the 64bit file)

NOTE: Yes, Intel, AMD and the PI ARM chips are all little endian. However, from what I've read, the Intel and AMD chips convert the little endian to big endian. It has something to do with floating point. However, this does not seem to be the case with ARM processors, at least for the PI. From what I read, the Apple M1 is designed the same as that the PI's ARM. This change to the OBJCOPY allows DATA statements, among other things, to work. the -Barm tells OBJCOPY how to format the binary executable file. This is my understanding, which is of course, subject to interpretation, but the changes makes QB64 run and compile, and compiled programs also run on the PI.

To implement these changes, after extracting the QB64 compiler, you need to replace the common.h file in the qb64/internal/c directory, and the setup_lnx.sh file in the main qb64 directory. Then all you have to do is run the setup_lnx.sh file to install library dependencies and compile qb64.bas.

These changes should also work on the Apple M1 ARM processor, but I do not have one to test this on. If someone has a M1 ARM processor, I can provide the changes to the setup_osx.command script. You'll have to do the testing as I will not have a M1 processor until July.

Also, besides the M1 processor, I haven't been able to test is a 64bit OS on the Raspberry PI. Raspberry no longer offers the 64bit version of their Raspbian OS. So while I am looking for non-raspbian OS's to test on, if someone here is running, say Kali on a PI or an earlier version of the 64bit Raspbian OS, please test this. I will do so as well, but the more who tests this, the better. (This was suggested by Fellippe).

Some Issues:
When testing this on my PI, I was unable to get InForm to run. It compiles, but I get a series of errors from "Bus signal errors" to misaligned addresses. I am still looking into this, but I may need to defer to Fellippe or Luke on this, as I am not a C++ programmer, and in my C coding, I've never encountered these errors. I have run tests in gdb and ddd utilites to try and isolate the issue, but I am at a loss. If someone wants to tackle this on their PI, I'd appreciate it.

Here is the common.h file:

Code: C: [Select]

//Setup for ARM Processor (Similar to -fsanitize=address GCC compiler flag)
#ifdef __arm__
        #define POST_PACKED_STRUCTURE
#else
        #define POST_PACKED_STRUCTURE __attribute__((__packed__))
#endif /* ARM */
 
//Fill out dependency macros
#ifndef DEPENDENCY_NO_SOCKETS
    #define DEPENDENCY_SOCKETS
#endif
 
#ifndef DEPENDENCY_NO_PRINTER
    #define DEPENDENCY_PRINTER
#endif
 
#ifndef DEPENDENCY_NO_ICON
    #define DEPENDENCY_ICON
#endif
 
#ifndef DEPENDENCY_NO_SCREENIMAGE
    #define DEPENDENCY_SCREENIMAGE
#endif
 
#ifndef INC_COMMON_CPP
    #define INC_COMMON_CPP
    #include "os.h"
    
    #define QB64_GL1
    #define QB64_GLUT
    
    #ifdef DEPENDENCY_CONSOLE_ONLY
        #undef QB64_GLUT
        #else
        #define QB64_GUI
    #endif
    
    //core
    #ifdef QB64_GUI
        #ifdef QB64_GLUT
            //This file only contains header stuff
            #include "parts/core/src.c"
        #endif
    #endif
    
    #ifdef QB64_WINDOWS
        
        #ifndef QB64_GUI
            #undef int64 //definition of int64 from os.h conflicts with a definition within windows.h, temporarily undefine then redefine
            #include <windows.h>
            #define int64 __int64
        #endif
        
        #include <shfolder.h>
        
        #include <float.h>
        #include <winbase.h>
        
    #endif
    
    //common includes
    #include <stdio.h>
    #ifdef QB64_MACOSX
        #include <cmath>
        #else
        //#include <math.h> //<-causes overloading abs conflicts in Windows
        #include <cmath>
    #endif
    #include <time.h>
    #include <iostream>
    #include <fstream>
    #include <time.h>
    #include <string.h>
    #include <errno.h>
    #include <fcntl.h>
    
    //OS/compiler specific includes
    #ifdef QB64_WINDOWS
        #include <direct.h>
        #ifdef DEPENDENCY_PRINTER
            #include <winspool.h>
        #endif
        #include <csignal>
        #include <process.h> //required for multi-threading
        #if defined DEPENDENCY_AUDIO_OUT || defined QB64_GUI
            #include <mmsystem.h>
        #endif
        
        #else
        
        #include <stdlib.h>
        #include <sys/types.h>
        #include <sys/stat.h>
        #include <sys/wait.h>
        #include <unistd.h>
        #include <stdint.h>
        #include <pthread.h>
        #ifndef QB64_MACOSX
            #include <dlfcn.h>
        #endif
        
    #endif
    
    #ifdef QB64_GUI
        #ifdef QB64_GLUT
            #include "parts/core/gl_headers/opengl_org_registery/glext.h"
        #endif
    #endif
    
    
    //QB64 string descriptor structure
    struct qbs_field{
        int32 fileno;
        int64 fileid;
        int64 size;
        int64 offset;
    };
    
    struct qbs{
        uint8 *chr;//a 32 bit pointer to the string's data
        int32 len;//must be signed for comparisons against signed int32s
        uint8 in_cmem;//set to 1 if in the conventional memory DBLOCK
        uint16 *cmem_descriptor;
        uint16 cmem_descriptor_offset;
        uint32 listi;//the index in the list of strings that references it
        uint8 tmp;//set to 1 if the string can be deleted immediately after being processed
        uint32 tmplisti;//the index in the list of strings that references it
        uint8 fixed;//fixed length string
        uint8 readonly;//set to 1 if string is read only
        qbs_field *field;
    };
    
    struct img_struct{
        void *lock_offset;
        int64 lock_id;
        uint8 valid;//0,1 0=invalid
        uint8 text;//if set, surface is a text surface
        uint8 console;//dummy surface to absorb unimplemented console functionality
        uint16 width,height;
        uint8 bytes_per_pixel;//1,2,4
        uint8 bits_per_pixel;//1,2,4,8,16(text),32
        uint32 mask;//1,3,0xF,0xFF,0xFFFF,0xFFFFFFFF
        uint16 compatible_mode;//0,1,2,7,8,9,10,11,12,13,32,256
        uint32 color,background_color,draw_color;
        uint32 font;//8,14,16,?
        int16 top_row,bottom_row;//VIEW PRINT settings, unique (as in QB) to each "page"
        int16 cursor_x,cursor_y;//unique (as in QB) to each "page"
        uint8 cursor_show, cursor_firstvalue, cursor_lastvalue;
        union{
            uint8 *offset;
            uint32 *offset32;
        };
        uint32 flags;
        uint32 *pal;
        int32 transparent_color;//-1 means no color is transparent
        uint8 alpha_disabled;
        uint8 holding_cursor;
        uint8 print_mode;
        //BEGIN apm ('active page migration')
        //everything between apm points is migrated during active page changes
        //note: apm data is only relevent to graphics modes
        uint8 apm_p1;
        int32 view_x1,view_y1,view_x2,view_y2;
        int32 view_offset_x,view_offset_y;
        float x,y;
        uint8 clipping_or_scaling;
        float scaling_x,scaling_y,scaling_offset_x,scaling_offset_y;
        float window_x1,window_y1,window_x2,window_y2;
        double draw_ta;
        double draw_scale;
        uint8 apm_p2;
        //END apm
    };
    //img_struct flags
    #define IMG_FREEPAL 1 //free palette data before freeing image
    #define IMG_SCREEN 2 //img is linked to other screen pages
    #define IMG_FREEMEM 4 //if set, it means memory must be freed
    
    
    //QB64 internal variable type flags (internally referenced by some C functions)
    #define ISSTRING 1073741824
    #define ISFLOAT 536870912
    #define ISUNSIGNED 268435456
    #define ISPOINTER 134217728
    #define ISFIXEDLENGTH 67108864 //only set for strings with pointer flag
    #define ISINCONVENTIONALMEMORY 33554432
    #define ISOFFSETINBITS 16777216
    
    struct ontimer_struct{
        uint8 allocated;
        uint32 id;//the event ID to trigger (0=no event)
        int64 pass;//the value to pass to the triggered event (only applicable to ON ... CALL ...(x)
        uint8 active;//0=OFF, 1=ON, 2=STOP
        uint8 state;//0=untriggered,1=triggered
        double seconds;//how many seconds between events
        double last_time;//the last time this event was triggered
    };
    
    struct onkey_struct{
        uint32 id;//the event ID to trigger (0=no event)
        int64 pass;//the value to pass to the triggered event (only applicable to ON ... CALL ...(x)
        uint8 active;//0=OFF, 1=ON, 2=STOP
        uint8 state;//0=untriggered,1=triggered,2=in progress(TIMER only),2+=multiple events queued(KEY only)
        uint32 keycode;//32-bit code, same as what _KEYHIT returns
        uint32 keycode_alternate;//an alternate keycode which may also trigger event
        uint8 key_scancode;
        uint8 key_flags;
        //flags:
        //0 No keyboard flag, 1-3 Either Shift key, 4 Ctrl key, 8 Alt key,32 NumLock key,64 Caps Lock key, 128 Extended keys on a 101-key keyboard
        //To specify multiple shift states, add the values together. For example, a value of 12 specifies that the user-defined key is used in combination with the Ctrl and Alt keys.
        qbs *text;
    };
    
    struct onstrig_struct{
        uint32 id;//the event ID to trigger (0=no event)
        int64 pass;//the value to pass to the triggered event (only applicable to ON ... CALL ...(x)
        uint8 active;//0=OFF, 1=ON, 2=STOP
        uint8 state;//0=untriggered,1=triggered,2=in progress(TIMER only),2+=multiple events queued(KEY only)
    };
    
    struct byte_element_struct
    {
        uint64 offset;
        int32 length;
    };
    
    struct device_struct{
        int32 used;
        int32 type;
        //0=Unallocated
        //1=Joystick/Gamepad
        //2=Keybaord
        //3=Mouse  
        char *name;
        int32 connected;
        int32 lastbutton;
        int32 lastaxis;
        int32 lastwheel;
        //--------------
        int32 max_events;
        int32 queued_events;
        uint8 *events;//the structure and size of the events depends greatly on the device and its capabilities
        int32 event_size;
        //--------------
        uint8 STRIG_button_pressed[256];//checked and cleared by the STRIG function
        //--------------
        void *handle_pointer;//handle as pointer
        int64 handle_int;//handle as integer
        char *description;//description provided by manufacturer
        int64 product_id;
        int64 vendor_id;
        int32 buttons;
        int32 axes;
        int32 balls;
        int32 hats;
    };
    
    //device_struct constants
    #define QUEUED_EVENTS_LIMIT 1024
    #define DEVICETYPE_CONTROLLER 1
    #define DEVICETYPE_KEYBOARD 2
    #define DEVICETYPE_MOUSE 3
    
    struct mem_block{
        ptrszint offset;
        ptrszint size;
        int64 lock_id;//64-bit key, must be present at lock's offset or memory region is invalid
        ptrszint lock_offset;//pointer to lock
        ptrszint type;
        /*
            memorytype (4 bytes, but only the first used, for flags):
            1 integer values
            2 unsigned (set in conjunction with integer)
            4 floating point values
            8 char string(s) 'element-size is the memory size of 1 string
        */
        ptrszint elementsize;
        int32 image;
        int32 sound;
    };
    struct mem_lock{
        uint64 id;
        int32 type;//required to know what action to take (if any) when a request is made to free the block
        //0=no security (eg. user defined block from _OFFSET)
        //1=C-malloc'ed block
        //2=image
        //3=sub/function scope block
        //4=array
        //5=sound
        //---- type specific variables follow ----
        void *offset;//used by malloc'ed blocks to free them
    };
    
#endif //INC_COMMON_CPP
 

Here is the setup_lnx.sh file:

Code: Bash: [Select]

#!/bin/bash
#QB64 Installer -- Shell Script -- Matt Kilgore 2013
#Version 5 -- January 2020
 
#This version includes the updates to sucessfully install QB64 on the PI
#or any ARM processor (Current version only tested on the Raspberry PI and
#sets the DISTRO to "raspbian".) -- George McGinn (2/1/2022)
 
#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
pkg_install() {
  #Search
  packages_to_install=
  for pkg in $pkg_list; do
    if [ -z "$(echo "$installed_packages" | grep $pkg)" ]; then
      packages_to_install="$packages_to_install $pkg"
    fi
  done
  if [ -n "$packages_to_install" ]; then
    echo "Installing required packages. If prompted to, please enter your password."
    $installer_command $packages_to_install
  fi
 
}
 
#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
#Raspbian    = raspbian
#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
elif $(arch | grep arm > /dev/null); then
  DISTRO=raspbian
fi
 
echo "DISTRO detected = $DISTRO"
 
#Find and install packages
if [ "$DISTRO" == "arch" ]; then
  echo "ArchLinux detected."
  pkg_list="gcc zlib xorg-xmessage $GET_WGET"
  installed_packages=`pacman -Q`
  installer_command="sudo pacman -S "
  pkg_install
elif [ "$DISTRO" == "linuxmint" ] || [ "$DISTRO" == "ubuntu" ] || [ "$DISTRO" == "debian" ] || [ "$DISTRO" == "zorin" ] || [ "$DISTRO" == "raspbian" ]; then
  echo "Debian/Raspian based distro detected."
  pkg_list="g++ x11-utils mesa-common-dev libglu1-mesa-dev libasound2-dev zlib1g-dev $GET_WGET"
  installed_packages=`dpkg -l`
  installer_command="sudo apt-get -y install "
  pkg_install
elif [ "$DISTRO" == "fedora" ] || [ "$DISTRO" == "redhat" ] || [ "$DISTRO" == "centos" ]; then
  echo "Fedora/Redhat based distro detected."
  pkg_list="gcc-c++ xmessage mesa-libGLU-devel alsa-lib-devel zlib-devel $GET_WGET"
  installed_packages=`yum list installed`
  installer_command="sudo yum install "
  pkg_install
elif [ "$DISTRO" == "voidlinux" ]; then
   echo "VoidLinux detected."
   pkg_list="gcc xmessage glu-devel zlib-devel alsa-lib-devel $GET_WGET"
   installed_packages=`xbps-query -l |grep -v libgcc`
   installer_command="sudo xbps-install -Sy "
   pkg_install
elif [ -z "$DISTRO" ]; then
  echo "Unable to detect distro, skipping package installation"
  echo "Please be aware that for QB64 to compile, you will need the following installed:"
  echo "  OpenGL developement libraries"
  echo "  ALSA development libraries"
  echo "  GNU C++ Compiler (g++)"
  echo "  xmessage (x11-utils)"
  echo "  zlib"
fi
 
echo "Compiling and installing QB64..."
 
### Build process
find . -name "*.sh" -exec chmod +x {} \;
find internal/c/parts -type f -iname "*.a" -exec rm -f {} \;
find internal/c/parts -type f -iname "*.o" -exec rm -f {} \;
find internal/c/libqb -type f -iname "*.o" -exec rm -f {} \;
rm ./internal/temp/*
 
#if [ "$DISTRO" == "raspbian" ]; then 
if $(arch | grep arm > /dev/null); then
  echo "Updating files for the ARM processor..."
  echo "updating makedat_lnx32.txt file..."
  pushd internal/c >/dev/null
  cat > makedat_lnx32.txt <<EOF
objcopy -Ibinary -Oelf32-littlearm -Barm
EOF
  echo "updating makedat_lnx64.txt file..."
  cat > makedat_lnx64.txt <<EOF
objcopy -Ibinary -Oelf64-littlearm -Barm
EOF
  popd >/dev/null
fi
 
echo "Building library 'LibQB'"
pushd internal/c/libqb/os/lnx >/dev/null
rm -f libqb_setup.o
./setup_build.sh
popd >/dev/null
 
echo "Building library 'FreeType'"
pushd internal/c/parts/video/font/ttf/os/lnx >/dev/null
rm -f src.o
./setup_build.sh
popd >/dev/null
 
echo "Building library 'Core:FreeGLUT'"
pushd internal/c/parts/core/os/lnx >/dev/null
rm -f src.a
./setup_build.sh
popd >/dev/null
 
echo "Building 'QB64'"
cp -r ./internal/source/* ./internal/temp/
pushd internal/c >/dev/null
g++ -no-pie -w qbx.cpp libqb/os/lnx/libqb_setup.o parts/video/font/ttf/os/lnx/src.o parts/core/os/lnx/src.a -lGL -lGLU -lX11 -lpthread -ldl -lrt -D FREEGLUT_STATIC -o ../../qb64
popd
 
if [ -e "./qb64" ]; then
  echo "Done compiling!!"
 
  echo "Creating ./run_qb64.sh script..."
  _pwd=`pwd`
  echo "#!/bin/sh" > ./run_qb64.sh
  echo "cd $_pwd" >> ./run_qb64.sh
  echo "./qb64 &" >> ./run_qb64.sh
  
  chmod +x ./run_qb64.sh
  #chmod -R 777 ./
  echo "Adding QB64 menu entry..."
  cat > ~/.local/share/applications/qb64.desktop <<EOF
[Desktop Entry]
Name=QB64 Programming IDE
GenericName=QB64 Programming IDE
Exec=$_pwd/run_qb64.sh
Icon=$_pwd/$QB64_ICON_PATH/$QB64_ICON_NAME
Terminal=false
Type=Application
Categories=Development;IDE;
Path=$_pwd
StartupNotify=false
EOF
 
  echo "Running QB64..."
  ./qb64 &
  echo "QB64 is located in this folder:"
  echo "`pwd`"
  echo "There is a ./run_qb64.sh script in this folder that should let you run qb64 if using the executable directly isn't working."
  echo 
  echo "You should also find a QB64 option in the Programming/Development section of your menu you can use."
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."
 

Thanks,

Programs / Converting MIDI to WAV and MP3 (BASH Script)

« on: December 19, 2021, 07:20:03 pm »

Awhile back I ran into issues where my MIDI file collection needed to be converted into an acceptable file format to be able to play it in QB64, as the only valid files are: WAV, OGG or MP3 file types.

So below is a BASH Shell script that converts a MIDI file into BOTH a .wav and a .mp3 file.

You will need to have installed:

Zenity - Used for the BASH GUI
timidity - To convert MIDI to WAV (Software synthesizer)
ffmpeg - To convert timidity WAV to MP3 files.

Except for Zenity, timidity and ffmpeg I believe exists on all OS's, Since I only run Linux and macOS, I can't guarantee that this will run on Windows, but the principle behind what the script does should apply. I haven't completely tested it yet on my macOS, but I have installed the three requirements above. If I have any issues with it, I will post an update (not an edit). I know not all features of Zenity work on a macOS system. So I may create a command-line version.

Now I can convert all my Christmas MIDI files into WAV and MP3 files.

Merry Christmas.

Code: Bash: [Select]

#!/bin/bash
#
# MIDI to WAV and MP3 Converter -- Shell Script -- George McGinn 2021
#Version 1.0 -- December 19, 2021
#
# convertMIDI - Script to convert a MIDI file into both a .WAV and .MP3
#               audio formats. Uses Zenity to retrieve the MIDI file,
#               create the output files, show progress, and other messages.
#
# NOTES: This script needs the following installed:
#        Zenity - Script's GUI 
#        timidity - Converts the MIDI to a WAV format
#        ffmpeg - Converts a MIDI/WAV to MP3 format
#
# USEAGE:
#   This script can be invoked from a File Manager or from a terminal
#   session. When started, it defaults to your $HOME/Music directory.
#   Select the location of your MIDI file. You will be able to change
#   the directory. Select your MID or MIDI file then click [OK]. Next
#   The output for the WAV and MP3 files will default to your $HOME/Music
#   directory. You can change this location. Enter the file name WITHOUT
#   any extensions. The .wav and .mp3 will be added to the file name
#   you provide. The script will create both files.
#
#   If you select directory(ies) that require ROOT access, the script will
#   ask you for your password and then do the conversions as stated above.
#   There is no need to start this script with sudo.
#
 
# Change directory to Home/Music
 
cd $HOME/Music
 
# Get the MIDI path/file name
mid=$(zenity --file-selection)
if [ $? = 1 ];
        then exit
fi
 
 
# Get save path/file name
wav=$(zenity --file-selection --save --confirm-overwrite)
if [ $? = 1 ];
        then exit
fi
 
# see if current user has write permissions by creating an empty file
> "$wav:".wav
> "$wav".mp3
 
# if so, delete the empty files and do the conversion and show progress bar
if [ $?  -eq 0 ]; then
        rm "$wav:".wav
        rm "$wav".mp3
 
        timidity "$mid" -Ow -o "$wav".wav  | zenity --progress --pulsate --auto-close --text "Converting to WAV..."
        timidity "$mid" -Ow -o - | ffmpeg -i - -acodec libmp3lame -ab 64k "$wav".mp3 | zenity --progress --pulsate --auto-close --text "Converting to MP3..." 
 
# Tell us the conversion is done
        zenity --info --text "Conversion complete!"
 
# if not, get root password, run command as root
else
# Get the users password
        passwd=$(zenity --password)
 
# Do the conversion and show a progress bar
        echo $passwd|sudo -S timidity "$mid" -Ow -o "$wav".wav | zenity --progress --pulsate --auto-close --text "Converting to WAV..."
        echo $passwd|sudo -S timidity "$mid" -Ow -o - | ffmpeg -i - -acodec libmp3lame -ab 64k "$wav".mp3 | zenity --progress --pulsate --auto-close --text "Converting to MP3..." 
 
        if [ $? = 1 ];
                then exit
        fi
 
# Tell us the conversion is done
        zenity --info --text "Conversion complete!"
fi
 

Programs / Baseball/Softball Statistical Record-keeping System Pre-Release

« on: December 15, 2021, 02:25:29 pm »

I am posting the pre-release of my Baseball/Softball Statistical System for your input on this. I’ve been working on this for more than 4 months, and I need new eyes to spot things I can’t see. I also hope that some of you find it useful. The final release will have more features that can be used for advanced game record-keeping and will include a suite of Sabermetric tools. Any comments from what works, what doesn’t, clarity needed in my HELP and other documentation, and how to make this work with other relational databases like MariaDB and SQLite will be very helpful.

This Linux-only (for now) application records and produces baseball or softball offensive, defensive and pitching statistics and reports for players and for multiple teams. This can be used if you manage/coach one or more youth baseball teams, run a single baseball/softball league, or play a game like Strat-O-Matic Baseball.

This is a pre-release, as I still have some more features to code. But it appears stable enough to unleash on all of you.

Originally I was going to write just a small program for myself, but some others I know wanted to use it as well, and what started off as a tutorial on using MySQL (or just SQL) with QB64 turned into a large application that includes QB64 code, C++ functions, MySQL, HTML, CSS, JavaScript, and Zenity among others.

I have been also working on getting the code in the WIKI (MySQL Client) by Galleon working, but I will be taking that program in another direction, and those who are waiting for that tutorial will have it, probably by the end of January (I hope!).

This is now an example of using various tools in Linux to create a slick-looking application based on QB64. About a month ago, the QB64 code alone topped 7,000 lines of code, with all the code going above 10,000 lines, so this is a substantial application.

The Readme file on my GitHub is quite extensive (and still a work in progress), but there should be enough information there that you can run this application. Also, when you start up this application, on the ABOUT/Splash Screen, there is a link to a menu where you can read all the HELP files for each function/feature to familiarize yourself with the system.

I have tested this on Ubuntu, Linux Mint, and Q4OS (before I added the ability for the application to adapt to Dark/Light/Standard desktop themes), so you may have to tweak the colors of your Dark Theme in the /help/baseballStyle.css file. The rest works automatically.

I know some of you use a different relational DB then MySQL, and I am interested in hearing from you so I can add the ability to use different DB’s transparent to the user.

I have attached the ZIP file with all the source code and files needed to run this application, but I do suggest that you visit my GitHub listed below to read what is documented.

Here is the link to the pre-release: https://github.com/GeorgeMcGinn/baseballStats/releases/tag/v0.27.0

Here is the link to the files on GitHub: https://github.com/GeorgeMcGinn/baseballStats

baseballStats-0.27.0.zip

Programs / Modified (More Challenging) Version of the Original Hamurabi Game!

« on: December 05, 2021, 01:07:38 pm »

If you think the original Hamurabi game was hard, I've made it more challenging!

In this revised version from the one created by David Ahl, feeding your kingdom just got harder.

The original game's mechanics have remained the same - that is you have to plant, feed a growing population of people. The can be hit with a plague and rats have been known to eat parts of your bushels.

You still need to provide each person 20 bushels to feed them, and 1 person can plant 10 acres. And you still need 2 bushels to plant an acre.

Here are the new updates to this classic game:

You now have to deal with newborns. Each year, you can have up to 10 newborns. These add to the overall population, but they are not available to plant your fields.
Able bodies (Planters) are the people who can plant your harvest. If no plagues (or disasters) hit, there could be a larger population, with less people to plant your harvest.
Disasters - The current game still has plagues that wipe out 1/2 of your population. I've now added disasters that wipe out 1/3 of your population. And yes, you can get hit by both a plague and a disaster at the same time. The plague wipes out first, then the disaster takes 1/3 of those remaining. Both not only reduces the total population, but also able-bodied people to plant. This is to ensure some of the newborns survive plagues and disasters.
Insects (pestilence) have been added as a force affecting your harvest. This part has changed. You can have rat and insect damage, but they now work differently. Rats only eat bushels in storage, while insects only affect the harvest. And yes, I've seen in my testing insects wipe out entire harvests. Rats can do some damage, but I left the original in this game, and rats in my testing have never eaten an entire storage of grain!

All other parameters of the game, right now, are the same.

Remember, when you allocate bushels to feed, it is your entire population (newborns + planters). I have caught myself using the wrong number and starving a few people.

Also, you can choose whether to play with the QB64 Screen, or change the code to play in a terminal. This game should work on all OS's (Windows, Mac and Linux), or wherever you compile your QB64 programs!

Good Luck!

PS: I am developing an InForm version of this game, where you can see, in real time, what your changes do to your values before you commit them. The original game written back in the 1960's and 70's does not provide that. In the spirit of those of us who played the original game when it first came out, I haven't done those updates to this version. But the InForm game will be even more challenging.

Code: QB64: [Select]

_TITLE "Hamurabi - King of Babylon and Ruler of the Ancient Kingdom of Sumeria"
 
' *** Choose your console/screen type below (comment/uncomment)
'$CONSOLE:ONLY
'SCREEN 0
SCREEN _NEWIMAGE(800, 600, 32)
 
RANDOMIZE TIMER
 
' ***
' *** DISPLAY INTRODUCTION TO THE GAME
' ***
PRINT TAB(32); "HAMURABI"
PRINT
PRINT "You are the ruler of the ancient kingdom of Sumeria."
PRINT "Your people call you 'Hamurabi the Wise'."
PRINT
PRINT "Your task is for the next 10 years is to develop"
PRINT "a stable economy by the wise management of your"
PRINT "resources. You will be beset from time to time"
PRINT "by natural events."
PRINT
PRINT "The only help I can give you is the fact that it"
PRINT "takes 1 bushel of grain as seed to plant two acres."
PRINT
PRINT "May you judge well, alknowing Hamurabi!"
PRINT
PRINT "***********HAMURABI IS HERE***********"
PRINT
_DELAY 5
 
HamurabiInit:
    DIM AS DOUBLE STARVED, PEOPLE_DIED, PCT_STARVED, YEAR, POPULATION, BUSHELS, HARVESTED
    DIM AS DOUBLE RATS_ATE, PESTILENCE, PRICE, ACRES, IMMIGRATED, C
    DIM AS DOUBLE PI
    DIM AS INTEGER PLAGUE_PCT, PLAGUE, ACRES_BUY, ACRES_SELL, ACRES_PLANTED, BUSHELS_FEED
 
    STARVED = 0 '*** D=0
    PEOPLE_DIED = 0 '*** D1=0
    PCT_STARVED = 0 '*** P1=0
    YEAR = 0 '*** Z=0
    POPULATION = 95 '*** P=95
    BUSHELS = 2800 '*** S=2800
    HARVESTED = 3000 '*** H=3000
    RATS_ATE = HARVESTED - BUSHELS '*** E=H-S
    PESTILENCE = 0 '*** NEW FIELD
    PRICE = 3 '*** Y=3
    ACRES = HARVESTED / PRICE '*** A=H/Y
    IMMIGRATED = 5 '*** I=5
    C = 1 '*** C=1  VARIABLE USED FOR ALL RANDOM NUMBER GENERATORS
    PI = 0
    NEWBORN = 0
    PLANTERS = 0 '*** The number of people able to plant fields (Excludes New Borns)
 
 
PlayGame:
    CLS
    PRINT: PRINT
    PRINT "HAMURABI, I beg to report to you!"
    PRINT
    YEAR = YEAR + 1
    PRINT "In year "; FORMAT$(STR$(YEAR), "##"); ", "; FORMAT$(STR$(STARVED), "#,###"); " People starved, "; FORMAT$(STR$(NEWBORN), "##"); " New Borns, and "; FORMAT$(STR$(IMMIGRATED), "##"); " migrated into the city."
    POPULATION = POPULATION + IMMIGRATED + NEWBORN
    IF YEAR = 1 THEN PLANTERS = POPULATION ELSE PLANTERS = PLANTERS + IMMIGRATED
 
CheckForPlague:
' *** check for plague and if found, reduce population by 1/2. (15% chance of plague)
    PLAGUE_PCT = (10 * RND(1))
    DISASTER_PCT = (10 * RND(1))
    PRINT
    IF PLAGUE_PCT >= 8.5 AND YEAR > 1 THEN
        PLAGUE = INT(POPULATION / 2)
        POPULATION = PLAGUE
        PLANTERS = INT(PLANTERS / 2)
        PRINT "A horrible plague struck! Half the people died."
        PRINT "Half, or "; FORMAT$(STR$(PLAGUE), "#,###"); " people died of the plague."
        PRINT
    END IF
 
    PRINT
    IF DISASTER_PCT >= 8.5 AND YEAR > 1 THEN
        DISASTER = INT(POPULATION / 3)
        POPULATION = DISASTER
        PLANTERS = INT(PLANTERS / 3)
        PRINT "A horrible disaster struck! One-Third the people died."
        PRINT "One-third, or "; FORMAT$(STR$(DISASTER), "#,###"); " people died from the disaster."
        PRINT
    END IF
 
Display_Population:
    PRINT "Our Population is now "; FORMAT$(STR$(POPULATION), "#,###")
    PRINT "Able-bodied people to plant the fields is now "; FORMAT$(STR$(PLANTERS), "#,###")
    PRINT "The city owns "; FORMAT$(STR$(ACRES), "#,###"); " acres, "
    PRINT "You havested "; FORMAT$(STR$(PRICE), "#,###"); " bushels per acre"
    PRINT "Rats destroyed "; FORMAT$(STR$(RATS_ATE), "#,###"); " bushels. "
    PRINT "Insects destroyed "; FORMAT$(STR$(PESTILENCE), "#,###"); " bushels."
    PRINT "You have "; FORMAT$(STR$(BUSHELS), "#,###"); " bushels in storage."
    PRINT
    IF YEAR = 11 THEN GOTO PlayEvaluation
    C = INT(10 * RND(1))
    PRICE = C + 17
    PRINT "Land is trading at "; FORMAT$(STR$(PRICE), "#,###"); " bushels per acre."
 
BuyLand:
    INPUT "How much land (in acres) do you wish to buy "; ACRES_BUY
    IF ACRES_BUY < 0 THEN GOTO FedUp
    IF PRICE * ACRES_BUY <= BUSHELS THEN
        IF ACRES_BUY = 0 THEN GOTO SellLand
        ACRES = ACRES + ACRES_BUY
        BUSHELS = BUSHELS - PRICE * ACRES_BUY
        C = 0
        GOTO FeedPopulation
    END IF
    GOSUB NotEnoughGrain
    GOTO BuyLand
 
SellLand:
    INPUT "How many acres of land do you wish to sell "; ACRES_SELL
    IF ACRES_SELL < 0 THEN GOTO FedUp
    IF ACRES_SELL < ACRES THEN
        ACRES = ACRES - ACRES_SELL
        BUSHELS = BUSHELS + PRICE * ACRES_SELL
        C = 0
        GOTO FeedPopulation
    END IF
    GOSUB NotEnoughAcres
    GOTO SellLand
 
FeedPopulation:
    INPUT "How many bushels do you wish to set aside for food "; BUSHELS_FEED
    IF BUSHELS_FEED < 0 THEN GOTO FedUp
    IF BUSHELS_FEED = 0 THEN
        GOSUB NotEnoughGrain
        GOTO FeedPopulation
    END IF
' *** TRYING TO USE MORE GRAIN THAN IS IN SILOS?
    IF BUSHELS_FEED <= BUSHELS THEN
        BUSHELS = BUSHELS - BUSHELS_FEED
        C = 1
        GOTO AcresToPlant
    END IF
    GOSUB NotEnoughGrain
    GOTO FeedPopulation
 
AcresToPlant:
    INPUT "How many acres do you wish to plant "; ACRES_PLANTED
' *** TRYING TO PLANT MORE ACRES THAN YOU OWN?
    IF ACRES_PLANTED = 0 THEN GOTO HarvestCrops
    IF ACRES_PLANTED < 0 THEN GOTO FedUp
' *** ENOUGH GRAIN FOR SEED (TWO BUSHELS PER ACRE)?
    IF ACRES_PLANTED <= ACRES THEN
        IF INT(ACRES_PLANTED / 2) <= BUSHELS THEN
' *** ENOUGH PEOPLE TO TEND THE CROPS?
            IF ACRES_PLANTED < 10 * PLANTERS + 1 THEN
                BUSHELS = BUSHELS - INT(ACRES_PLANTED / 2)
                GOTO HarvestCrops
            ELSE
                PRINT "But you only have "; FORMAT$(STR$(PLANTERS), "#,###"); " people to tend the fields!, Now then, "
                GOTO AcresToPlant
            END IF
        ELSE
            GOSUB NotEnoughGrain
            GOTO AcresToPlant
        END IF
    END IF
    GOSUB NotEnoughAcres
    GOTO AcresToPlant
 
HarvestCrops:
' *** A BOUNTIFUL HARVEST!
    GOSUB Randomizer
    PRICE = C
    HARVESTED = ACRES_PLANTED * PRICE
 
' *** Provides a 50-50 chance of no damage due to Rats and Insects
    GOSUB Randomizer
    IF C MOD 2 = 0 THEN
        BUSHELS = BUSHELS + HARVESTED
        GOTO PopulationControl
    END IF
 
' *** Rats eat the existing store of Bushels, before the harvest is added
    RATS_ATE = 0
    RATS_ATE = INT(BUSHELS / C)
 
' *** Insects eat at the crops in the field, and reduce the harvest, and
' *** can sometimes wipe out an entire year's harvest!
    GOSUB Randomizer
    PESTILENCE = 0
    INSECTS_PCT = (10 * RND(1))
    IF INSECTS_PCT >= 6 THEN PESTILENCE = INT(HARVESTED / C)
 
    BUSHELS = BUSHELS + HARVESTED - (RATS_ATE + PESTILENCE)
    IF BUSHELS < 0 THEN BUSHELS = 0
 
PopulationControl:
' *** Determine births and those who moved to the city
 
' *** LET'S HAVE SOME BABIES (Change to a random-generated number from 0-20)
'   NEWBORN = INT(C * (20 * ACRES + BUSHELS) / POPULATION / 100 + 1)
'    GOSUB Randomizer
    NEWBORN = INT(10 * RND(1)) ' *** No more than 10 newborns in a year
 
' *** LET'S HAVE SOME IMMIGRATION
    GOSUB Randomizer
    IMMIGRATED = INT(C * (20 * ACRES + BUSHELS) / POPULATION / 100 + 1)
 
' *** HOW MANY PEOPLE HAD FULL TUMMIES?
    C = INT(BUSHELS_FEED / 20)
    IF POPULATION < C THEN
        STARVED = 0
        GOTO PlayGame
    END IF
 
' *** STARVED ENOUGH FOR IMPEACHMENT (Greater than 45% of population)?
    STARVED = POPULATION - C
    IF STARVED > .45 * POPULATION THEN GOTO StarvedMSG
    PCT_STARVED = ((YEAR - 1) * PCT_STARVED + STARVED * 100 / POPULATION) / YEAR
    POPULATION = C
    PEOPLE_DIED = PEOPLE_DIED + STARVED '*** D1=D1+D
    GOTO PlayGame
 
' ***
' *** Game processing routines
' ***
 
StarvedMSG:
    PRINT
    PRINT "You starved "; FORMAT$(STR$(STARVED), "###"); " people in this year!!!"
 
ExtremeMismangement:
    PRINT "Due to extreme mismanagement you have been impeached and thrown out of office."
    PRINT "You have failed to honor your promise or lacked courage or commitment."
    PRINT "The people have declared you a National Fink!!!!"
    GOTO endProg
 
FedUp:
    PRINT
    PRINT "HAMURABI: I cannot do what you wish."
    PRINT "Get yourself another steward!!!!!"
    GOTO endProg
 
PlayEvaluation:
    PRINT "In your 10-year term of office, "; FORMAT$(STR$(PCT_STARVED), "##.##");
    PRINT " percent of the population"
    PRINT "starved per year on average,";
    PRINT " or a total of "; FORMAT$(STR$(PEOPLE_DIED), "###");
    PRINT " people died!!"
    PRINT
 
DeterminePlay:
    LAND_PER_PERSON = ACRES / POPULATION
    PRINT "You started with 10 acres per person and ended with "; FORMAT$(STR$(LAND_PER_PERSON), "##.##");
    PRINT " arces per person."
    PRINT
    IF PCT_STARVED > 33 THEN GOTO ExtremeMismangement
    IF LAND_PER_PERSON < 7 THEN GOTO ExtremeMismangement
    IF PCT_STARVED > 10 THEN GOTO HeavyHanded
    IF LAND_PER_PERSON < 9 THEN GOTO HeavyHanded
    IF PCT_STARVED > 3 THEN GOTO MediocurePlay
    IF LAND_PER_PERSON < 10 THEN GOTO MediocurePlay
    PRINT "A fantastic performance! Charlemange, Disraeli, and"
    PRINT "Jefferson combined could not have done better!"
    GOTO endProg
 
HeavyHanded:
    PRINT "Your heavy-handed performance smacks of Nero and Ivan IV."
    PRINT "The remaining people find you an unpleasant ruler, and,"
    PRINT "frankly, hate your guts!!"
    GOTO endProg
 
MediocurePlay:
    PRINT "Your performance could have been somewhat better, but"
    PRINT "really wasn't too bad at all. "; INT(POPULATION * .8 * RND(1)); " people"
    PRINT "would dearly like to see you assassinated but we all have our"
    PRINT "trivial problems."
    GOTO endProg
 
NotEnoughGrain:
    PRINT " HAMURABI: Think again. You have only"
    PRINT BUSHELS; " bushels of grain. Now then,"
    RETURN
 
NotEnoughAcres:
    PRINT "HAMURABI: Think again. You own only "; ACRES; " acres. Now Then,"
    RETURN
 
Randomizer:
    C = INT(RND(1) * 5) + 1
    RETURN
 
endProg:
    PRINT
    FOR N = 1 TO 10
        PRINT CHR$(7);
    NEXT N
    PRINT "So long, for now."
    PRINT
    END
    
FUNCTION FORMAT$ (text AS STRING, template AS STRING)
'-----------------------------------------------------------------------------
' *** Return a formatted string to a variable
'
    d = _DEST: s = _SOURCE
    n = _NEWIMAGE(80, 80, 0)
    _DEST n: _SOURCE n
    PRINT USING template; VAL(text)
    FOR i = 1 TO 79
        t$ = t$ + CHR$(SCREEN(1, i))
    NEXT
    IF LEFT$(t$, 1) = "%" THEN t$ = MID$(t$, 2)
    FORMAT$ = _TRIM$(t$)
    _DEST d: _SOURCE s
    _FREEIMAGE n
END FUNCTION
 

InForm-based programs / EBAC Calculator

« on: October 14, 2021, 04:36:45 pm »

This is a rework of a post I made a few months ago.

I converted my EBAC Calculator from Zenity to now use InForm, and uses many of it's features.

I've included all the files needed to compile it, and have tested it on Linux and MAC OSX. It should also run on Windows (I don't have a Windows OS installed).

Below is the main program for those who want to look at it, but you will need the files/directories in the .ZIP file if you want to compile it. You do not need InForm to compile and use the program. Just the files provided.

Here's the main source:

Code: QB64: [Select]

REM $TITLE: ebacCalculator.bas Version 1.0  04/01/2021 - Last Update: 10/14/2021
_TITLE "ebacCalculator.bas"
' ebacCalculator.bas    Version 2.0  10/14/2021
'-----------------------------------------------------------------------------------
'       PROGRAM: ebacCalculator.bas
'        AUTHOR: George McGinn
'
'  DATE WRITTEN: 04/01/2021
'       VERSION: 2.0
'       PROJECT: Estimated Blood-Alcohol Content Calculator
'
'   DESCRIPTION: Program shows many of the functions of using InForm while using
'                most of the original code from the Zenity project. This can now
'                run on all systems (Linux, MAC and Windows).
'
' Written by George McGinn
' Copyright (C)2021 by George McGinn - All Rights Reserved
' Version 1.0 - Created 04/01/2021
' Version 2.0 - Created 10/14/2021
'
' CHANGE LOG
'-----------------------------------------------------------------------------------
' 04/01/2021 v1.0  GJM - New Program (TechBASIC and C++ Versions).
' 06/19/2021 v1.5  GJM - Updated to use Zenity and SHELL commands to run on Linux with
'                        a simple GUI.
' 10/14/2021 v2.0  GJM - Updated to use InForm GUI in place of Zenity an SHELL commands.
'                        Can now run on any OS
'-----------------------------------------------------------------------------------
'  Copyright (C)2021 by George McGinn.  All Rights Reserved.
'
' untitled.bas by George McGinn is licensed under a Creative Commons
' Attribution-NonCommercial 4.0 International. (CC BY-NC 4.0)
'
' Full License Link: https://creativecommons.org/licenses/by-nc/4.0/legalcode
'
'-----------------------------------------------------------------------------------
' PROGRAM NOTES
'
': This program uses
': InForm - GUI library for QB64 - v1.3
': Fellippe Heitor, 2016-2021 - fellippe@qb64.org - [member=2]FellippeHeitor[/member]
': https://github.com/FellippeHeitor/InForm
'-----------------------------------------------------------------------------------
 
': Controls' IDs: ------------------------------------------------------------------
DIM SHARED maleRB AS LONG
DIM SHARED femaleRB AS LONG
DIM SHARED AgreeCB AS LONG
DIM SHARED AGREEBT AS LONG
DIM SHARED ebacFRM AS LONG
DIM SHARED SexLB AS LONG
DIM SHARED weightLB AS LONG
DIM SHARED nbrdrinksLB AS LONG
DIM SHARED timeLB AS LONG
DIM SHARED EnterInformationLB AS LONG
DIM SHARED WeightTB AS LONG
DIM SHARED nbrDrinksTB AS LONG
DIM SHARED TimeTB AS LONG
DIM SHARED CancelBT AS LONG
DIM SHARED OKBT AS LONG
DIM SHARED HELPBT AS LONG
DIM SHARED QUITBT AS LONG
DIM SHARED displayResults AS LONG
DIM SHARED informationLB AS LONG
 
': User-defined Variables: ---------------------------------------------------------
DIM SHARED AS STRING HELPFile
DIM SHARED AS INTEGER l, SOBER, legalToDrive
DIM SHARED AS STRING Sex
DIM SHARED AS DOUBLE A, T
DIM SHARED AS SINGLE B, OZ, Wt, EBAC
DIM SHARED numeric(255)
 
DIM SHARED AS STRING helpcontents, prt_text
 
 
 
': External modules: ---------------------------------------------------------------
'$INCLUDE:'InForm/InForm.bi'
'$INCLUDE:'InForm/xp.uitheme'
'$INCLUDE:'ebacCalculator.frm'
 
 
 
': Event procedures: ---------------------------------------------------------------
SUB __UI_BeforeInit
 
END SUB
 
SUB __UI_OnLoad
 
' *** Initialize Variables
    A = 0
    Wt = 0
    B = .0
    T = 0: St = 0
    I = 0
    Bdl = 1.055
    OZ = .5
    SOBER = False: legalToDrive = False
    HELPFile = "EBACHelp.txt"
    displayDisclaimer
 
END SUB
 
SUB __UI_BeforeUpdateDisplay
    'This event occurs at approximately 60 frames per second.
    'You can change the update frequency by calling SetFrameRate DesiredRate%
 
END SUB
 
SUB __UI_BeforeUnload
    'If you set __UI_UnloadSignal = False here you can
    'cancel the user's request to close.
 
END SUB
 
SUB __UI_Click (id AS LONG)
    SELECT CASE id
        CASE maleRB
            Sex = "M"
 
        CASE femaleRB
            Sex = "F"
 
        CASE AGREEBT
            Answer = MessageBox("Do you want to perform another calculation?             ", "", MsgBox_YesNo + MsgBox_Question)
            IF Answer = MsgBox_Yes THEN
                Control(AgreeCB).Value = False
                Control(AGREEBT).Disabled = True
            ELSE
                Answer = MessageBox("Thank You for using EBAC Calculator. Please Don't Drink and Drive.", "", MsgBox_Ok + MsgBox_Information)
               SYSTEM
            END IF
 
        CASE CancelBT
            ResetForm
 
        CASE OKBT
            IF Control(maleRB).Value = False AND Control(femaleRB).Value = False THEN
                Answer = MessageBox("Invalid: You must select either M (male) or F (female). Please Correct.", "", MsgBox_Ok + MsgBox_Information)
                EXIT SUB
            END IF
            A = Control(nbrDrinksTB).Value
            Wt = Control(WeightTB).Value
            T = Control(TimeTB).Value
            calcEBAC
            Control(QUITBT).Disabled = True
            ResetList displayResults
            Text(displayResults) = prt_text
 
        CASE HELPBT
            ResetList displayResults
            IF _FILEEXISTS(HELPFile) THEN
                DIM fh AS LONG
                fh = FREEFILE
                OPEN HELPFile FOR INPUT AS #fh
                DO UNTIL EOF(fh)
                    LINE INPUT #fh, helpcontents
                    AddItem displayResults, helpcontents
                LOOP
                CLOSE #fh
                Control(displayResults).LastVisibleItem = 0
            ELSE
                Answer = MessageBox("HELP File " + HELPFile$ + " Not Found                             ", "", MsgBox_Ok + MsgBox_Question)
                SYSTEM 1
            END IF
 
        CASE QUITBT
            Answer = MessageBox("Are you sure you want to QUIT?                     ", "", MsgBox_YesNo + MsgBox_Question)
            IF Answer = MsgBox_Yes THEN
                Answer = MessageBox("Thank You for using EBAC Calculator. Please Don't Drink and Drive.", "", MsgBox_Ok + MsgBox_Information)
                SYSTEM
            END IF
 
    END SELECT
END SUB
 
SUB __UI_MouseEnter (id AS LONG)
END SUB
 
SUB __UI_MouseLeave (id AS LONG)
END SUB
 
SUB __UI_FocusIn (id AS LONG)
END SUB
 
SUB __UI_FocusOut (id AS LONG)
    'This event occurs right before a control loses focus.
    'To prevent a control from losing focus, set __UI_KeepFocus = True below.
END SUB
 
SUB __UI_MouseDown (id AS LONG)
END SUB
 
SUB __UI_MouseUp (id AS LONG)
END SUB
 
SUB __UI_KeyPress (id AS LONG)
    'When this event is fired, __UI_KeyHit will contain the code of the key hit.
    'You can change it and even cancel it by making it = 0
END SUB
 
SUB __UI_TextChanged (id AS LONG)
    SELECT CASE id
 
        CASE WeightTB
            Control(AgreeCB).Value = False
            Control(AGREEBT).Disabled = True
 
        CASE nbrDrinksTB
            Control(AgreeCB).Value = False
            Control(AGREEBT).Disabled = True
 
        CASE TimeTB
            Control(AgreeCB).Value = False
            Control(AGREEBT).Disabled = True
 
    END SELECT
END SUB
 
SUB __UI_ValueChanged (id AS LONG)
    SELECT CASE id
 
        CASE maleRB
            Control(AgreeCB).Value = False
            Control(AGREEBT).Disabled = True
 
        CASE femaleRB
            Control(AgreeCB).Value = False
            Control(AGREEBT).Disabled = True
 
        CASE AgreeCB
            IF Control(AgreeCB).Value = True THEN
                Control(AGREEBT).Disabled = False
                Control(QUITBT).Disabled = False
            ELSE
                Control(AGREEBT).Disabled = True
                Control(QUITBT).Disabled = True
            END IF
 
    END SELECT
END SUB
 
SUB __UI_FormResized
END SUB
 
'$INCLUDE:'InForm/InForm.ui'
 
 
': User FUNCTIONS/SUBROUTINES: ---------------------------------------------------------------
 
SUB displayDisclaimer
 
'    prt_text = "*** DISCLAIMER ***" + CHR$(10)
    prt_text = "Unless otherwise separately undertaken by the Licensor, to the extent" + CHR$(10)
    prt_text = prt_text + "possible, the Licensor offers the Licensed Material as-is and" + CHR$(10)
    prt_text = prt_text + "as-available, and makes no representations or warranties of any kind" + CHR$(10)
    prt_text = prt_text + "concerning the Licensed Material, whether express, implied, statutory," + CHR$(10)
    prt_text = prt_text + "or other. This includes, without limitation, warranties of title," + CHR$(10)
    prt_text = prt_text + "merchantability, fitness for a particular purpose, non-infringement," + CHR$(10)
    prt_text = prt_text + "absence of latent or other defects, accuracy, or the presence or absence" + CHR$(10)
    prt_text = prt_text + "of errors, whether or not known or discoverable. Where disclaimers of" + CHR$(10)
    prt_text = prt_text + "warranties are not allowed in full or in part, this disclaimer may not" + CHR$(10)
    prt_text = prt_text + "apply to You." + CHR$(10) + CHR$(10)
 
    prt_text = prt_text + "To the extent possible, in no event will the Licensor be liable to You" + CHR$(10)
    prt_text = prt_text + "on any legal theory (including, without limitation, negligence) or" + CHR$(10)
    prt_text = prt_text + "otherwise for any direct, special, indirect, incidental, consequential," + CHR$(10)
    prt_text = prt_text + "punitive, exemplary, or other losses, costs, expenses, or damages" + CHR$(10)
    prt_text = prt_text + "arising out of this Public License or use of the Licensed Material, even" + CHR$(10)
    prt_text = prt_text + "if the Licensor has been advised of the possibility of such losses," + CHR$(10)
    prt_text = prt_text + "costs, expenses, or damages. Where a limitation of liability is not" + CHR$(10)
    prt_text = prt_text + "allowed in full or in part, this limitation may not apply to You." + CHR$(10) + CHR$(10)
 
    prt_text = prt_text + "The disclaimer of warranties and limitation of liability provided above" + CHR$(10)
    prt_text = prt_text + "shall be interpreted in a manner that, to the extent possible, most" + CHR$(10)
    prt_text = prt_text + "closely approximates an absolute disclaimer and waiver of all liability." + CHR$(10)
 
    Answer = MessageBox(prt_text, "*** DISCLAIMER ***", MsgBox_YesNo + MsgBox_Question)
    IF Answer = MsgBox_No THEN
        Answer = MessageBox("Sorry you don't agree. Please Don't Drink and Drive.", "", MsgBox_Ok + MsgBox_Information)
        SYSTEM
    END IF
 
END SUB
 
 
SUB ResetForm
    Control(nbrDrinksTB).Value = 0
    Control(WeightTB).Value = 0
    Control(TimeTB).Value = 0
    Control(AgreeCB).Value = False
    Control(AGREEBT).Disabled = True
    Control(maleRB).Value = False
    Control(femaleRB).Value = False
    ResetList displayResults
    Sex = ""
END SUB
 
 
SUB calcEBAC
'-------------------------------------------------------------
' *** Convert Drinks into Fluid Ounces of EtOH (Pure Alcohol).
' *** A is number of drinks. 1 drink is about .6 FLoz of alcohol
    FLoz = A * OZ
    legalToDrive = False
 
'-----------------------------------------------------
' *** Set/calculate EBAC values based on Sex
    SELECT CASE Sex
        CASE "M"
            B = .017
            EBAC = 7.97 * FLoz / Wt - B * T
        CASE "F"
            B = .019
            EBAC = 9.86 * FLoz / Wt - B * T
    END SELECT
 
    IF EBAC < 0 THEN EBAC = 0
 
'----------------------------------------------------------------------------------------------
' *** Populate the EBAC string with the EBAC value formatted to 3 decimal places for FORM output
    prt_text = "ESTIMATED BLOOD ALCOHOL CONTENT (EBAC) in g/dL = " + strFormat$(STR$(EBAC), "###.###") + CHR$(10) + CHR$(10)
 
 
'-----------------------------------------------------------------------------------------
' *** Based on EBAC range values, populate the FORM output string with the approriate text
    SELECT CASE EBAC
        CASE .500 TO 100.9999
            prt_text = prt_text + "*** ALERT: CALL AN AMBULANCE, DEATH LIKELY" + CHR$(10)
            prt_text = prt_text + "Unconsious/coma, unresponsive, high likelihood of death. It is illegal" + CHR$(10) + _
                                  "to operate a motor vehicle at this level of intoxication in all states." + CHR$(10)
        CASE .400 TO .4999
            prt_text = prt_text + "*** ALERT: CALL AN AMBULANCE, DEATH POSSIBLE" + CHR$(10)
            prt_text = prt_text + "Onset of coma, and possible death due to respiratory arrest. It is illegal" + CHR$(10) + _
                                  "to operate a motor vehicle at this level of intoxication in all states." + CHR$(10)
        CASE .350 TO .3999
            prt_text = prt_text + "*** ALERT: CALL AN AMBULANCE, SEVERE ALCOHOL POISONING" + CHR$(10)
            prt_text = prt_text + " Coma is possible. This is the level of surgical anesthesia. It is illegal" + CHR$(10) + _
                                  "to operate a motor vehicle at this level of intoxication in all states." + CHR$(10)
        CASE .300 TO .3499
            prt_text = prt_text + "*** ALERT: YOU ARE IN A DRUNKEN STUP0R, AT RISK TO PASSING OUT" + CHR$(10)
            prt_text = prt_text + "STUPOR. You have little comprehension of where you are. You may pass out" + CHR$(10) + _
                                  "suddenly and be difficult to awaken. It is illegal to operate a motor" + CHR$(10) + _
                                  "vehicle at this level of intoxication in all states." + CHR$(10)
        CASE .250 TO .2999
            prt_text = prt_text + "*** ALERT: SEVERLY IMPAIRED - DRUNK ENOUGH TO CAUSE SEVERE INJURY/DEATH TO SELF" + CHR$(10)
            prt_text = prt_text + "All mental, physical and sensory functions are severely impaired." + CHR$(10) + _
                                  "Increased risk of asphyxiation from choking on vomit and of seriously injuring" + CHR$(10) + _
                                  "yourself by falls or other accidents. It is illegal to operate a motor" + CHR$(10) + _
                                  "vehicle at this level of intoxication in all states." + CHR$(10)
        CASE .200 TO .2499
            prt_text = prt_text + "YOU ARE EXTREMELY DRUNK" + CHR$(10)
            prt_text = prt_text + "Feeling dazed/confused or otherwise disoriented. May need help to" + CHR$(10) + _
                                  "stand/walk. If you injure yourself you may not feel the pain. Some" + CHR$(10) + _
                                  "people have nausea and vomiting at this level. The gag reflex" + CHR$(10) + _
                                  "is impaired and you can choke if you do vomit. Blackouts are likely" + CHR$(10) + _
                                  "at this level so you may not remember what has happened. It is illegal" + CHR$(10) + _
                                  "to operate a motor vehicle at this level of intoxication in all states." + CHR$(10)
        CASE .160 TO .1999
            prt_text = prt_text + "YOUR ARE SEVERLY DRUNK - ENOUGH TO BECOME VERY SICK" + CHR$(10)
            prt_text = prt_text + "Dysphoria* predominates, nausea may appear. The drinker has the appearance" + CHR$(10) + _
                                  "of a 'sloppy drunk.' It is illegal to operate a motor vehicle at this level" + CHR$(10) + _
                                  "of intoxication in all states." + CHR$(10) + CHR$(10) + _
                                  "* Dysphoria: An emotional state of anxiety, depression, or unease." + CHR$(10)
        CASE .130 TO .1599
            prt_text = prt_text + "YOU ARE VERY DRUNK - ENOUGH TO LOSE PHYSICAL & MENTAL CONTROL" + CHR$(10)
            prt_text = prt_text + "Gross motor impairment and lack of physical control. Blurred vision and major" + CHR$(10) + _
                                  "loss of balance. Euphoria is reduced and dysphoria* is beginning to appear." + CHR$(10) + _
                                  "Judgment and perception are severely impaired. It is illegal to operate a " + CHR$(10) + _
                                  "motor vehicle at this level of intoxication in all states." + CHR$(10) + CHR$(10)
            prt_text = prt_text + "* Dysphoria: An emotional state of anxiety, depression, or unease." + CHR$(10)
        CASE .100 TO .1299
            prt_text = prt_text + "YOU ARE LEGALLY DRUNK" + CHR$(10)
            prt_text = prt_text + "Significant impairment of motor coordination and loss of good judgment." + CHR$(10) + _
                                  "Speech may be slurred; balance, vision, reaction time and hearing will be" + CHR$(10) + _
                                  "impaired. Euphoria. It is illegal to operate a motor vehicle at this level" + CHR$(10) + _
                                  "of intoxication in all states." + CHR$(10)
        CASE .070 TO .0999
            prt_text = prt_text + "YOU MAY BE LEGALLY DRUNK" + CHR$(10)
            prt_text = prt_text + "Slight impairment of balance, speech, vision, reaction time, and hearing." + CHR$(10) + _
                                  "Euphoria. Judgment and self-control are reduced, and caution, reason and" + CHR$(10) + _
                                  "memory are impaired (in some* states .08 is legally impaired and it is illegal" + CHR$(10) + _
                                  "to drive at this level). You will probably believe that you are functioning" + CHR$(10) + _
                                  "better than you really are." + CHR$(10) + CHR$(10)
            prt_text = prt_text + "(*** As of July, 2004 ALL states had passed .08 BAC Per Se Laws. The final" + CHR$(10) + _
                                  "one took effect in August of 2005.)" + CHR$(10)
        CASE .040 TO .0699
            prt_text = prt_text + "YOU MAY BE LEGALLY BUZZED" + CHR$(10)
            prt_text = prt_text + "Feeling of well-being, relaxation, lower inhibitions, sensation of warmth." + CHR$(10) + _
                                  "Euphoria. Some minor impairment of reasoning and memory, lowering of caution." + CHR$(10) + _
                                  "Your behavior may become exaggerated and emotions intensified (Good emotions" + CHR$(10) + _
                                  "are better, bad emotions are worse)" + CHR$(10)
        CASE .020 TO .0399
            prt_text = prt_text + "YOU MAY BE OK TO DRIVE, BUT IMPAIRMENT BEGINS" + CHR$(10)
            prt_text = prt_text + "No loss of coordination, slight euphoria and loss of shyness. Depressant effects" + CHR$(10) + _
                                  "are not apparent. Mildly relaxed and maybe a little lightheaded." + CHR$(10)
        CASE .000 TO .0199
            prt_text = prt_text + "YOU ARE OK TO DRIVE" + CHR$(10)
    END SELECT
 
'-----------------------------------------------------------
'*** Determine if Drunk (>.08 EBAC) and calculate:
'***    - When user will be less than .08
'***    - How long it will take to become completely sober
    IF EBAC > .08 THEN
        SOBER = False
        CEBAC = EBAC
        st = T
        DO UNTIL SOBER = True
            T = T + 1
            IF CEBAC > .0799 THEN I = I + 1
 
            SELECT CASE Sex
                CASE "M"
                    B = .017
                    CEBAC = 7.97 * FLoz / Wt - B * T
                CASE "F"
                    B = .019
                    CEBAC = 9.86 * FLoz / Wt - B * T
            END SELECT
 
            IF legalToDrive = False THEN
                IF CEBAC < .08 THEN
                    prt_text = prt_text + CHR$(10) + CHR$(10) + "It will take about " + strFormat$(STR$(I), "##") + " hours from your last drink to be able to drive." + CHR$(10)
                    legalToDrive = True
                END IF
            END IF
 
            IF CEBAC <= 0 THEN
                prt_text = prt_text + "It will take about " + strFormat$(STR$(T - st), "##") + " hours from your last drink to be completely sober."
                SOBER = True
            END IF
        LOOP
    END IF
 
END SUB
 
 
FUNCTION strFormat$ (text AS STRING, template AS STRING)
'-----------------------------------------------------------------------------
' *** Return a formatted string to a variable
'
    d = _DEST: s = _SOURCE
    n = _NEWIMAGE(80, 80, 0)
    _DEST n: _SOURCE n
    PRINT USING template; VAL(text)
    FOR i = 1 TO 79
        t$ = t$ + CHR$(SCREEN(1, i))
    NEXT
    IF LEFT$(t$, 1) = "%" THEN t$ = MID$(t$, 2)
    strFormat$ = _TRIM$(t$)
    _DEST d: _SOURCE s
    _FREEIMAGE n
END FUNCTION
 
 

And the Form file:

Code: QB64: [Select]

': This form was generated by
': InForm - GUI library for QB64 - v1.3
': Fellippe Heitor, 2016-2021 - fellippe@qb64.org - [member=2]FellippeHeitor[/member]
': https://github.com/FellippeHeitor/InForm
'-----------------------------------------------------------
SUB __UI_LoadForm
 
    DIM __UI_NewID AS LONG, __UI_RegisterResult AS LONG
 
    __UI_NewID = __UI_NewControl(__UI_Type_Form, "ebacFRM", 618, 630, 0, 0, 0)
    __UI_RegisterResult = 0
    SetCaption __UI_NewID, "EBAC - ESTIMATED BLOOD ALCOHOL CONTENT CALCULATOR"
    Control(__UI_NewID).Font = SetFont("Fonts/arial.ttf", 16)
    Control(__UI_NewID).HasBorder = False
 
    __UI_NewID = __UI_NewControl(__UI_Type_Label, "SexLB", 40, 26, 232, 64, 0)
    __UI_RegisterResult = 0
    SetCaption __UI_NewID, "Sex:"
    Control(__UI_NewID).Font = SetFont("Fonts/Arial Black.ttf", 14)
    Control(__UI_NewID).HasBorder = False
    Control(__UI_NewID).VAlign = __UI_Middle
 
    __UI_NewID = __UI_NewControl(__UI_Type_Label, "weightLB", 99, 25, 173, 91, 0)
    __UI_RegisterResult = 0
    SetCaption __UI_NewID, "Weight (lbs):"
    Control(__UI_NewID).Font = SetFont("Fonts/Arial Black.ttf", 14)
    Control(__UI_NewID).HasBorder = False
    Control(__UI_NewID).VAlign = __UI_Middle
 
    __UI_NewID = __UI_NewControl(__UI_Type_Label, "nbrdrinksLB", 138, 25, 134, 121, 0)
    __UI_RegisterResult = 0
    SetCaption __UI_NewID, "Number of drinks:"
    Control(__UI_NewID).Font = SetFont("Fonts/Arial Black.ttf", 14)
    Control(__UI_NewID).HasBorder = False
    Control(__UI_NewID).VAlign = __UI_Middle
 
    __UI_NewID = __UI_NewControl(__UI_Type_Label, "timeLB", 202, 25, 70, 151, 0)
    __UI_RegisterResult = 0
    SetCaption __UI_NewID, "Time (hrs) from first drink:"
    Control(__UI_NewID).Font = SetFont("Fonts/Arial Black.ttf", 14)
    Control(__UI_NewID).HasBorder = False
    Control(__UI_NewID).VAlign = __UI_Middle
 
    __UI_NewID = __UI_NewControl(__UI_Type_Label, "EnterInformationLB", 440, 31, 16, 17, 0)
    __UI_RegisterResult = 0
    SetCaption __UI_NewID, "Enter information about your or your friend:"
    Control(__UI_NewID).Font = SetFont("Fonts/Arial Black.ttf", 18)
    Control(__UI_NewID).HasBorder = False
    Control(__UI_NewID).VAlign = __UI_Middle
 
    __UI_NewID = __UI_NewControl(__UI_Type_TextBox, "WeightTB", 50, 23, 278, 92, 0)
    __UI_RegisterResult = 0
    Control(__UI_NewID).Font = SetFont("", 16)
    Control(__UI_NewID).HasBorder = True
    Control(__UI_NewID).Min = -32768
    Control(__UI_NewID).Max = 32767
    Control(__UI_NewID).CanHaveFocus = True
    Control(__UI_NewID).BorderSize = 1
    Control(__UI_NewID).NumericOnly = __UI_NumericWithBounds
 
    __UI_NewID = __UI_NewControl(__UI_Type_TextBox, "nbrDrinksTB", 50, 23, 278, 121, 0)
    __UI_RegisterResult = 0
    Control(__UI_NewID).Font = SetFont("", 16)
    Control(__UI_NewID).HasBorder = True
    Control(__UI_NewID).Min = -32768
    Control(__UI_NewID).Max = 32767
    Control(__UI_NewID).CanHaveFocus = True
    Control(__UI_NewID).BorderSize = 1
    Control(__UI_NewID).NumericOnly = __UI_NumericWithBounds
 
    __UI_NewID = __UI_NewControl(__UI_Type_TextBox, "TimeTB", 50, 25, 277, 151, 0)
    __UI_RegisterResult = 0
    Control(__UI_NewID).Font = SetFont("", 16)
    Control(__UI_NewID).HasBorder = True
    Control(__UI_NewID).Min = -32768
    Control(__UI_NewID).Max = 32767
    Control(__UI_NewID).CanHaveFocus = True
    Control(__UI_NewID).BorderSize = 1
    Control(__UI_NewID).NumericOnly = __UI_NumericWithBounds
 
    __UI_NewID = __UI_NewControl(__UI_Type_Button, "CancelBT", 99, 30, 435, 99, 0)
    __UI_RegisterResult = 0
    SetCaption __UI_NewID, "&Cancel"
    Control(__UI_NewID).Font = SetFont("Fonts/Arial Black.ttf", 14)
    Control(__UI_NewID).HasBorder = False
    Control(__UI_NewID).CanHaveFocus = True
 
    __UI_NewID = __UI_NewControl(__UI_Type_Button, "OKBT", 99, 30, 435, 63, 0)
    __UI_RegisterResult = 0
    SetCaption __UI_NewID, "&OK"
    Control(__UI_NewID).Font = SetFont("Fonts/Arial Black.ttf", 14)
    Control(__UI_NewID).HasBorder = False
    Control(__UI_NewID).CanHaveFocus = True
 
    __UI_NewID = __UI_NewControl(__UI_Type_Button, "HELPBT", 99, 30, 435, 134, 0)
    __UI_RegisterResult = 0
    SetCaption __UI_NewID, "&HELP"
    Control(__UI_NewID).Font = SetFont("Fonts/Arial Black.ttf", 14)
    Control(__UI_NewID).HasBorder = False
    Control(__UI_NewID).CanHaveFocus = True
 
    __UI_NewID = __UI_NewControl(__UI_Type_Button, "QUITBT", 99, 30, 435, 170, 0)
    __UI_RegisterResult = 0
    SetCaption __UI_NewID, "&QUIT"
    Control(__UI_NewID).Font = SetFont("Fonts/Arial Black.ttf", 14)
    Control(__UI_NewID).HasBorder = False
    Control(__UI_NewID).CanHaveFocus = True
 
    __UI_NewID = __UI_NewControl(__UI_Type_Label, "informationLB", 210, 17, 22, 194, 0)
    __UI_RegisterResult = 0
    SetCaption __UI_NewID, "Information Display"
    Control(__UI_NewID).Font = SetFont("Fonts/Arial Black.ttf", 14)
    Control(__UI_NewID).HasBorder = False
    Control(__UI_NewID).VAlign = __UI_Middle
    Control(__UI_NewID).BorderSize = 1
 
    __UI_NewID = __UI_NewControl(__UI_Type_ListBox, "displayResults", 576, 320, 20, 213, 0)
    __UI_RegisterResult = 0
    Control(__UI_NewID).Font = SetFont("Fonts/Courier New.ttf", 12)
    Control(__UI_NewID).HasBorder = True
    Control(__UI_NewID).CanHaveFocus = True
    Control(__UI_NewID).BorderSize = 2
 
    __UI_NewID = __UI_NewControl(__UI_Type_Button, "AGREEBT", 99, 31, 495, 574, 0)
    __UI_RegisterResult = 0
    SetCaption __UI_NewID, "&AGREE"
    Control(__UI_NewID).Font = SetFont("Fonts/Arial Black.ttf", 14)
    Control(__UI_NewID).HasBorder = False
    Control(__UI_NewID).CanHaveFocus = True
    Control(__UI_NewID).Disabled = True
 
    __UI_NewID = __UI_NewControl(__UI_Type_CheckBox, "AgreeCB", 564, 23, 26, 544, 0)
    __UI_RegisterResult = 0
    SetCaption __UI_NewID, "I agree that this programand its results are not legally binding."
    Control(__UI_NewID).HasBorder = False
    Control(__UI_NewID).CanHaveFocus = True
 
    __UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "maleRB", 40, 23, 277, 64, 0)
    __UI_RegisterResult = 0
    SetCaption __UI_NewID, "M"
    Control(__UI_NewID).Font = SetFont("Fonts/Arial Black.ttf", 14)
    Control(__UI_NewID).HasBorder = False
    Control(__UI_NewID).CanHaveFocus = True
 
    __UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "femaleRB", 40, 23, 322, 64, 0)
    __UI_RegisterResult = 0
    SetCaption __UI_NewID, "F"
    Control(__UI_NewID).Font = SetFont("Fonts/Arial Black.ttf", 14)
    Control(__UI_NewID).HasBorder = False
    Control(__UI_NewID).CanHaveFocus = True
 
END SUB
 
SUB __UI_AssignIDs
    ebacFRM = __UI_GetID("ebacFRM")
    SexLB = __UI_GetID("SexLB")
    weightLB = __UI_GetID("weightLB")
    nbrdrinksLB = __UI_GetID("nbrdrinksLB")
    timeLB = __UI_GetID("timeLB")
    EnterInformationLB = __UI_GetID("EnterInformationLB")
    WeightTB = __UI_GetID("WeightTB")
    nbrDrinksTB = __UI_GetID("nbrDrinksTB")
    TimeTB = __UI_GetID("TimeTB")
    CancelBT = __UI_GetID("CancelBT")
    OKBT = __UI_GetID("OKBT")
    HELPBT = __UI_GetID("HELPBT")
    QUITBT = __UI_GetID("QUITBT")
    informationLB = __UI_GetID("informationLB")
    displayResults = __UI_GetID("displayResults")
    AGREEBT = __UI_GetID("AGREEBT")
    AgreeCB = __UI_GetID("AgreeCB")
    maleRB = __UI_GetID("maleRB")
    femaleRB = __UI_GetID("femaleRB")
END SUB
 

Here is the complete ZIP file, that contains all the source, fonts, and text files needed to run the program:

ebacCalculator.zip

InForm-based programs / Word Search

« on: October 13, 2021, 11:37:20 am »

A couple of days ago I went through Fellippe's video and recreated his program, so I have zipped it up and is available.

However, I have made some improvements to it, namely:

Added a QUIT button, as I found out on MAC OSX, there is no X button to close the form, and the red dot is greyed out.
Formatted the search results using @SMcNeill' format string function he wrote and updated for me (https://www.qb64.org/forum/index.php?topic=4031.msg133716#msg133716)
Removed all the code not needed (You need to leave all the generated SUBs in, but can remove statements not used)

The zip file contains:

bible.txt - The text version of the King James Bible from the Gutenberg Project
countWords.bas - The original console version from the video
wordSearch.bas - The source code originally generated by InForm, with the updates from countWords and my additional changes
bibleSearch.bas - Shows what the code would/should look like after removing all the SELECT/CASE statements not needed
wordSearch.frm - The form file generated by InForm
wordSearch - A Linux Binary file, which after compiling, is the only file needed for distribution (unless you need to supply Font files)
InForm - A folder with all the files necessary to compile the programs in QB64 or edit the form in InForm

You will also notice that there is no form named bibleSearch.frm. That's because I use the wordSearch.frm in that program. Bear in mind that if you edit wordSearch.frm in InForm, it will create a new wordSearch form and BASIC program, or if the BASIC program already exists, will update your version without wiping out the code you placed in it.

Below is a screen print of my modified form while processing a search. When the search completes, the message changes to say "Search completed ...".

Here is the Zip file:

wordSearch.zip

QB64 Discussion / Possible Bug - Zombie & Orphan Process Plagues both Development & Stable Release

« on: August 11, 2021, 08:07:30 pm »

As I promised, I conducted testing of both the development release (Build ef4dffb) and the stable release (Build 3043116) to see if I could replicate both the zombie and orphan issues I have been having while testing the DEBUG feature.

My conclusion is that zombie (and sometimes orphan processes) occur in both releases, and have nothing to do with the DEBUG updates.

I ran separate tests, one set with the stable release, the same programs in the development release (both without DEBUG and the third with DEBUG) and I get the same results. Every time I compile and run programs from the IDE, it creates a zombie process.

My computer setup is as follows: Dell Optiplex 990, with Intel® Core™ i5-2400 CPU @ 3.10GHz × 4, 32GB of RAM (Crucial RAM 4x8GB DDR3 1600 MHz CL11 Desktop Memory), running the latest updates of Linux Ubuntu 20.04.2 LTS. My primary hard drive is 500GB with a USB ProBox 4-bay HD storage device with 4 more SATA hard drives totaling 16TB.

After my last report where orphan processes were running just over 50 hours, I have not repeated this test (I plan on it, but wanted to reproduce the zombie process first).

The code I used for my testing is in this post (It was modified from a program by bplus) and all it does is display the character, binary number, ASCII code and hexadecimal code for ASCII 32 to 126. All display was to QB64's console. No compiles were done outside the IDE. No execution was launched from outside the IDE. Everything during the 3 tests outlined above were all done with the IDE.

I have looked at a test runs that I conducted outside of the IDE, where I wrote the code in the Geany Editor and used both the compile function from Geany and compiled on the command line using both QB64 directly and my BASH script I wrote, and doing more than 30 compiles and test runs of a program that integrates mySQL and BASH scripts providing args to them, I have not been able to reproduce the issues outlined here.

Common to all three types of testing and watching the progress, only after the third run (compile and execute from the IDE), 2 Zombie processes showed up! And from that point on, each successive run created a new zombie process.

I have provided in this post both screen prints of HTOP showing the zombie processes, and a log from my terminal showing the commands and results, such as MEMSTAT, PTREE and PS. I only provided one set of results, as they were the same across the three sets of testing I conducted.

In the three test sessions I performed, closing out QB64 did close out all the zombie processes. However, in the past as I have reported, this is not always the case. QB64 left orphans of itself and my system thought they were still running. With no active QB64 IDE or compiled code running, my screen prints from last week on Discord showed orphan processes that were still running (they were orphans because QB64 was closed down more than 24 hours before those screen prints were taken), even though QB64 was terminated normally. I even had PIDs of the program I was testing still running, even though everything was closed out properly more than 24 hours prior.

My system is running as a server that manages my devices in my house, so my system runs for weeks on end with no performance degradation, or any other issues. Only when QB64 is running, and I am doing many test runs and code changes using the IDE do I get severe system issues after many days.

I think it is time that someone looks into why this is happening. Before I did this test, I had both zombie and orphan processes, which crashed my machine before I could screen print and run my terminal commands to document them. As I discussed on Discord, I had closed out normally QB64, and all the programs I was running and testing over those three days ended normally.

And I do not accept as a solution to not run my system or development the way I do. It is not my behavior when coding or running my system as a server that is causing the issue, otherwise I would have similar issues with mySQL or Apache 2 Server.

Below are the screen prints from HTOP, and a log of commands I ran in terminal to show how these processes are tied in with each other. I also ran a MEMSTAT just to show what other programs are being used by QB64.

Here are the results from my Terminal commands:

Quote

(base) gjmcginn@optiplex990:~$ pidof qb64
18952
(base) gjmcginn@optiplex990:~$ memstat -p 18952
586892k: PID 18952 (/home/gjmcginn/qb64-development/qb64)
4k( 4k): /memfd:xshmfence 18952
4k( 4k): /memfd:xshmfence 18952
15004k( 15004k): anon_inode:i915.gem 18952
1284k( 1284k): /home/gjmcginn/.cache/mesa_shader_cache/index 18952
7024k( 6352k): /home/gjmcginn/qb64-development/qb64 18952
148k( 88k): /usr/lib/x86_64-linux-gnu/libdrm_intel.so.1.0.0 18952
480k( 272k): /usr/lib/x86_64-linux-gnu/libGLX_mesa.so.0.0.0 18952
676k( 584k): /usr/lib/x86_64-linux-gnu/libzstd.so.1.4.4 18952
1916k( 964k): /usr/lib/x86_64-linux-gnu/libstdc++.so.6.0.28 18952
108k( 72k): /usr/lib/x86_64-linux-gnu/libgcc_s.so.1 18952
184k( 140k): /usr/lib/x86_64-linux-gnu/ld-2.31.so 18952
540k( 128k): /usr/lib/x86_64-linux-gnu/libGL.so.1.7.0 18952
456k( 332k): /usr/lib/x86_64-linux-gnu/libGLU.so.1.3.1 18952
144k( 108k): /usr/lib/x86_64-linux-gnu/libGLX.so.0.0.0 18952
228k( 56k): /usr/lib/x86_64-linux-gnu/libglapi.so.0.0.0 18952
704k( 252k): /usr/lib/x86_64-linux-gnu/libGLdispatch.so.0.0.0 18952
20k( 4k): /usr/lib/x86_64-linux-gnu/libX11-xcb.so.1.0.0 18952
24k( 8k): /usr/lib/x86_64-linux-gnu/libXau.so.6.0.0 18952
32k( 8k): /usr/lib/x86_64-linux-gnu/libXdmcp.so.6.0.0 18952
84k( 44k): /usr/lib/x86_64-linux-gnu/libXext.so.6.4.0 18952
32k( 12k): /usr/lib/x86_64-linux-gnu/libXfixes.so.3.1.0 18952
28k( 12k): /usr/lib/x86_64-linux-gnu/libXxf86vm.so.1.0.0 18952
100k( 60k): /usr/lib/x86_64-linux-gnu/libbsd.so.0.10.0 18952
1976k( 1504k): /usr/lib/x86_64-linux-gnu/libc-2.31.so 18952
24k( 8k): /usr/lib/x86_64-linux-gnu/libdl-2.31.so 18952
80k( 40k): /usr/lib/x86_64-linux-gnu/libdrm.so.2.4.0 18952
60k( 28k): /usr/lib/x86_64-linux-gnu/libdrm_radeon.so.1.0.1 18952
44k( 20k): /usr/lib/x86_64-linux-gnu/libdrm_nouveau.so.2.0.0 18952
184k( 112k): /usr/lib/x86_64-linux-gnu/libexpat.so.1.6.11 18952
1340k( 668k): /usr/lib/x86_64-linux-gnu/libm-2.31.so 18952
56k( 28k): /usr/lib/x86_64-linux-gnu/libnss_files-2.31.so 18952
44k( 20k): /usr/lib/x86_64-linux-gnu/libpciaccess.so.0.11.1 18952
124k( 68k): /usr/lib/x86_64-linux-gnu/libpthread-2.31.so 18952
28k( 8k): /usr/lib/x86_64-linux-gnu/libxcb-dri2.so.0.0.0 18952
24k( 4k): /usr/lib/x86_64-linux-gnu/libxcb-dri3.so.0.0.0 18952
116k( 36k): /usr/lib/x86_64-linux-gnu/libxcb-glx.so.0.0.0 18952
20k( 4k): /usr/lib/x86_64-linux-gnu/libxcb-present.so.0.0.0 18952
20k( 4k): /usr/lib/x86_64-linux-gnu/libxcb-shm.so.0.0.0 18952
40k( 12k): /usr/lib/x86_64-linux-gnu/libxcb-sync.so.1.0.0 18952
40k( 12k): /usr/lib/x86_64-linux-gnu/libxcb-xfixes.so.0.0.0 18952
168k( 80k): /usr/lib/x86_64-linux-gnu/libxcb.so.1.1.0 18952
2056k( 4k): /usr/lib/x86_64-linux-gnu/libxshmfence.so.1.0.0 18952
112k( 68k): /usr/lib/x86_64-linux-gnu/libz.so.1.2.11 18952
1268k( 556k): /usr/lib/x86_64-linux-gnu/libX11.so.6.3.0 18952
14588k( 9596k): /usr/lib/x86_64-linux-gnu/dri/i965_dri.so 18952
--------
638528k ( 38672k)
(base) gjmcginn@optiplex990:~$ pstree -A -p -s 18952
systemd(1)---systemd(1519)---qb64(18952)-+-qb64(18983)
|-qb64(19010)
|-qb64(19035)
|-qb64(19061)
|-qb64(19322)
|-qb64(19345)
|-qb64(19374)
|-qb64(19399)
|-qb64(19427)
|-{qb64}(18953)
|-{qb64}(18954)
|-{qb64}(18955)
|-{qb64}(18958)
|-{qb64}(18959)
|-{qb64}(18960)
`-{qb64}(18961)
(base) gjmcginn@optiplex990:~$ ps ax | grep qb64
18952 ? Sl 2:05 ./qb64
18983 ? Z 0:00 [qb64] <defunct>
19010 ? Z 0:00 [qb64] <defunct>
19035 ? Z 0:00 [qb64] <defunct>
19061 ? Z 0:00 [qb64] <defunct>
19322 ? Z 0:00 [qb64] <defunct>
19345 ? Z 0:00 [qb64] <defunct>
19374 ? Z 0:00 [qb64] <defunct>
19399 ? Z 0:00 [qb64] <defunct>
19427 ? Z 0:00 [qb64] <defunct>
20077 pts/3 S+ 0:00 grep --color=auto qb64
(base) gjmcginn@optiplex990:~$ pstree -A -p -g -s -t 18952
systemd(1,1)---systemd(1519,1519)---qb64(18952,1924)-+-qb64(18983,1924)
|-qb64(19010,1924)
|-qb64(19035,1924)
|-qb64(19061,1924)
|-qb64(19322,1924)
|-qb64(19345,1924)
|-qb64(19374,1924)
|-qb64(19399,1924)
|-qb64(19427,1924)
|-{qb64:disk$0}(18958,1924)
|-{qb64:disk$1}(18959,1924)
|-{qb64:disk$2}(18960,1924)
|-{qb64:disk$3}(18961,1924)
|-{qb64}(18953,1924)
|-{qb64}(18954,1924)
`-{qb64}(18955,1924)
(base) gjmcginn@optiplex990:~$

Below are the two HTOP screen prints showing basically the same info above:
[ You are not allowed to view this attachment ]
[ You are not allowed to view this attachment ]

Here is a screen shot of my system details:
[ You are not allowed to view this attachment ]

Listing of System Details from my Terminal:

Quote

(base) gjmcginn@optiplex990:~$ cat /etc/os-release
NAME="Ubuntu"
VERSION="20.04.2 LTS (Focal Fossa)"
ID=ubuntu
ID_LIKE=debian
PRETTY_NAME="Ubuntu 20.04.2 LTS"
VERSION_ID="20.04"
HOME_URL="https://www.ubuntu.com/"
SUPPORT_URL="https://help.ubuntu.com/"
BUG_REPORT_URL="https://bugs.launchpad.net/ubuntu/"
PRIVACY_POLICY_URL="https://www.ubuntu.com/legal/terms-and-policies/privacy-policy"
VERSION_CODENAME=focal
UBUNTU_CODENAME=focal
(base) gjmcginn@optiplex990:~$ hostnamectl
Static hostname: optiplex990
Pretty hostname: optiPlex990
Icon name: computer-desktop
Chassis: desktop
Machine ID: 88fa40fc6c1047309a1ad45fbe33b289
Boot ID: 5d3ddf0e33af417281ac967e0fb6154a
Operating System: Ubuntu 20.04.2 LTS
Kernel: Linux 5.11.0-25-lowlatency
Architecture: x86-64
(base) gjmcginn@optiplex990:~$

Here is the code I was running and compiling in the IDE:

Code: QB64: [Select]

_TITLE "ASCII-BIN-HEX Table" ' b+ 2021-08-04
SCREEN _NEWIMAGE(900, 450, 32)
count = 0
PRINT "CHARACTER, BINARY, ASCII, and HEX TABLE": PRINT
FOR i = 32 TO 126 ' looks OK
   count = count + 1
   IF count = 4 THEN
       PRINT " " + CHR$(i); " "; AscBin$(i); VAL("&b" + AscBin$(i)); " "; "0x" + HEX$(i)
       count = 0
   ELSE
       PRINT " " + CHR$(i); " "; AscBin$(i); VAL("&b" + AscBin$(i)); " "; "0x" + HEX$(i),
   END IF
NEXT i
 
END
 
FUNCTION AscBin$ (integerBase10 AS INTEGER) 'any integer < 256  ie all ascii
    DIM j AS INTEGER
    AscBin$ = STRING$(8, "0")
    WHILE j <= 8
        IF (integerBase10 AND 2 ^ j) > 0 THEN MID$(AscBin$, 8 - j, 1) = "1" + AscBin$
        j = j + 1
    WEND
END FUNCTION

QB64 Discussion / INPUT from a file failing on a comma in the record

« on: July 22, 2021, 04:40:03 pm »

Hello,

I am running into an issue were I am reading a record from a file, and part of the record there is a coma. I am not getting the entire record.

The file was created after a mySQL select returned a number of rows. I piped them to a file to test various ways to process them.

After the INPUT #1, qString$, the results are truncated from the comma on. It is not until I do another INPUT #1, qString$ that I get the rest of the record.

Here is one of the records, and the result from my program.

Record (TAB Delimited, but not the issue here as it still occurs when I change the TAB to a pipe):

Quote

7 Blondel père et fils Frédérique Citeaux 24, place Kléber Strasbourg 67000 France

This is what I am getting:

Quote

Length of qString$: 47
7 Blondel père et fils Frédérique Citeaux 24

After the next INPUT, I get (With the results):

Quote

Length of qString$: 37
place Kléber Strasbourg 67000 France

If I put the entire record in quotes, it works.

Is this a bug? Shouldn't I get the entire record, commas and all, as they are strings?

(And the answer is not to put the record in Quotes, as the results from mySQL does not do that as far as I know!)

QB64 Discussion / Zombie Procecsses Getting Out of Hand

« on: July 18, 2021, 03:11:29 pm »

@FellippeHeitor @SpriggsySpriggs

EDIT: I have been informed that there are commits that address zombie processes. I have been running these from the 8109b81 build, and the issues below are from that.

While testing the new development build, including the $DEBUG enhancements, I have been also watching my PIDs closer than I normally do.

What I have noticed is that Zombie processes are getting out of control.

I just checked my PIDs, and I have more than 100 zombie processes from both QB64 and mysqlPGM, a program I was testing until today. I've attached some screen shots of what I am seeing.

I also know that @Richard had an issue where his IDE froze up while running a test over multiple days. I am willing to bet his issue has to do with zombie processes. I was also having IDE issues, and noticed these in my htop display.

I have to take an issue with @luke in that zombie process are harmless (he implied this). A zombie process is the result of a program spawning off one or more child processes, and does not wait for its status (waitpid(pid, &status, 0)). the parent does not wait and when the child process ends, it stays in the system process table. I realize that many people contribute to this project, so some issues may get overlooked.

While some say that these processes are benign, I disagree. They at least take up PID's, which there are a limited number of them. Also, some of the child processes are still running, as the parent process hasn't check their status to kill them when they are done. This takes up clock cycles (the CPU does check all zombie's to see if they need resources).

I have also noticed system slowdowns due to tasks not getting a PID immediately.

This needs to be fixed. Telling us to just quit the IDE does not clear all the issues (I've had to manually kill PID's after terminating the QB64 IDE).

Below shows both the Zombie processes (S=Z) as well as a program that hasn't run since yesterday (mysqlPGM). Some of these processes have run for more than 36 hours!

[ You are not allowed to view this attachment ]
[ You are not allowed to view this attachment ]

Edited: Added a pstree and a ps piped grep showing more about the processes. I have 159 processes running/zombies currently.
[ You are not allowed to view this attachment ]
[ You are not allowed to view this attachment ]

Update: I noticed something else. When checking into some of the processes more, I noticed that for one (and probably many of them) the PGID for the processes below do not have a process, yet instead of showing up a an OPRHAN, they are in a SL status.

Quote

(base) gjmcginn@optiplex990:~$ ps jp 223051
PPID PID PGID SID TTY TPGID STAT UID TIME COMMAND
1334 223051 207117 6511 pts/0 248264 Sl 1000 23:20 ./mysqlPGM
(base) gjmcginn@optiplex990:~$ ps jp 207315
PPID PID PGID SID TTY TPGID STAT UID TIME COMMAND
1334 207315 207117 6511 pts/0 248270 Sl 1000 91:45 ./qb64
(base) gjmcginn@optiplex990:~$ ps jp 207117
PPID PID PGID SID TTY TPGID STAT UID TIME COMMAND
(base) gjmcginn@optiplex990:~$ ps a | grep 207117
248284 pts/0 S+ 0:00 grep --color=auto 207117

QB64 Discussion / QB64 Command Line Compiler Script

« on: June 27, 2021, 12:15:23 pm »

EDITED 6/27/21: I updated the script (now version 1.1) to allow -c "--help" to execute the help option of the compiler. This will help adding in the replacement compiler option function.

This script will compile a QB64 program via the terminal (command line). It allows you to pass additional compiler switches as well as the directory and program source.

This script runs on Linux, and @SpriggsySpriggs has offered to create a Window's version of this. I will be testing this script on macOS, and will post that script here when it's done.

Some usage conventions are required to use this script:
   1) You need to update your PATH variable to where the qb64 binary resides (in Linux, it is in the /etc/environment file)
   2) Currently this may not work as ROOT for Linux users (There are issues if qb64 is executed from a ROOT directory)

This is what my file "environment" looks like with the qb64 directory added:
   PATH="/home/gjmcginn/qb64:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/usr/games:/usr/local/games:/snap/bin"

Once you update your PATH, you will need to reboot your system for the changes to take effect.

This script will take up to 3 arguments, each proceeded by a switch, which tells the script where to place them. The switches are:
   -c (Provide additional compiler options besides the -c and -o)
   -d (The directory where both the binary will be created and where the source file is located)
   -p (The source file without the .bas extension - the script adds this)

   Note: The script has a -r switch. This is to replace the compiler options and will be implemented in Version 2.

The default compiler switches applied to all compiles are: -c -x and -o.
   -x Compile instead of edit and output the result to the console
   -o <output file> Write output executable to <output file>

To see all the switches for qb64, you can use just "-c --help" with this script and it will display them in the terminal program.

The syntax for executing this script is:
   compileqb64.sh -c "compiler options" -d "source directory" -p "source code"

For example:
   compileqb64.sh -c "-w -e" -d "/home/gjmcginn/SourceCode/basic" -p "EBAC Calculator"

This example adds -w and -e to the compiler options, sets up the directory, and provides the <file> to be compiled. Things to remember:
   1) If there are more than one compiler options, they must be enclosed in quotes
   2) If either your directory or file name has spaces, they too must be enclosed in quotes. (You can always use quotes,regardless)
   3) Do not add the / at the end of the directory name from -d. The script will do this for you.

The script will do some rudimentary error checking, and will display in the terminal program its progress. The script is well commented.

Save as compileqb64.sh (Or any name you wish to run it as):

Code: Bash: [Select]

#!/bin/bash
 
#QB64 Compiler -- Shell Script -- George McGinn 2021
#Version 1.5 -- June 28, 2021
#
# compileqb64 - script to compile QB64 source code from any directory
#
# This script takes in up to 3 arguments for use in compiling QB64 from
# the command line. At least two arguments must be present to compile, 
# or the script will not work right. The arguments passed are:
#       -c Compiler Options (Add to default) (In quotes)
#   -r Compiler Options (Replace default) (In quotes)
#       -d Source Code/Object Directory Name
#       -p Program File Name (without the .bas extension)
#
# Syntax for compileqb64 is:
#       compileqb64 -c "compiler options" -d "source directory" -p "source code"
# or:
#   compileqb64 -c "--help"
#
# By using switches (-a, -d, -p) this script will parse out the argument
# values, and load the variables based on the values passed. Note that the
# script will append the .bas to the source code <filename>.
#
# Both switches -c and -r populate compiler options, but in a different way.
# The -c switch tells the script to "append" the arguments passed to the ones
# used as default (the -c and -o). 
#
# The -r tells the script to replace the default with the ones provided. This may be 
# used if you want to compile only to get the C++ code, or start the IDE with or 
# without a program loaded.
#
# If you use -c "--help" then the compiler will display the HELP text.
#
# The script, based on what was passed, will build and execute the compile statment.
# The script does a check to see if the source file exists. If it does, it completes
# the compile. If the directory or file does not exist, it errors out.
#
# The process in Version 1.x cannot run as ROOT and will need to be tested.
#
 
# FUNCTION: Test to see if the source code exists (True if the FILE exists and is a regular file (not a directory or device))
is_file() {
        if [ ! -f $FILE ];    
        then
                echo && echo "*** ERROR: $FILE does not exist. Please fix and retry. Script Terminated."
                exit 2
        fi
}
 
### Start of script
 
# Make sure we're not running as root (To be tested for future versions)
if [ $EUID == "0" ]; then
  echo "*** ERROR: You are trying to run this script as root. This is highly unrecommended. Script Terminated."
  exit 1
fi
 
echo "Starting QB64 Command Line Compiler..."
echo 
 
# Display the number of arguments passed and their values
echo "Number of arguments passed: $#"
echo "Arguments: $@"
 
# If no compiler options are found, display error message, qb64 help and terminate
if [ $# == 0 ]; then                                                                                            
        echo "*** ERROR: No Compiler Options passed. Make sure you use one of the ones below. Script terminated."
        echo "qb64 --help"
        echo
        qb64 --help
        exit 1
fi
 
# Parse out the arguments based on associated switches
while getopts c:d:p:r: option
        do
        case "${option}"
                in
                c) compiler_options_append=${OPTARG} 
                   option_c=1;;
                r) 
                   compiler_options_replace=${OPTARG}
                   option_r=1;;
                d) source_directory=${OPTARG};;
                p) qb64_program=${OPTARG};;
        esac
done
 
# Build the QB64 Source and Object variables for qb64 command line
if [ "$compiler_options_append" == "--help" ] || [ "$compiler_options_replace" == "--help" ]; then      # Display and execute the qb64 compiler help text
        echo
        echo "qb64 --help"
        echo
        qb64 --help
else                                                                                                    
        if [ "$source_directory" == "" ]; then                          # If source directory isn't provided, then set current working directory as source directory    
                source_directory="$PWD"
        fi
        qb64_object=$source_directory"/""$qb64_program"
        qb64_source=$source_directory"/""$qb64_program".bas
        FILE=$qb64_source
        is_file "$FILE"                                     # Check to make sure directory/file exists and is readable (not a device or directory only)
        echo
        if [ "$option_c" = 1 ]; then                                                    # Display and the qb64 command line compiler options passed to script
                echo "Compiler Options (Append): "$compiler_options_append
        elif [ "$option_r" = 1 ]; then
                echo "Compiler Options (Replace): "$compiler_options_replace
        fi
        echo "Source Code Directory: "$source_directory
        echo "Object Filename: "$qb64_object
        echo "Source Code Filename: "$qb64_source
        echo 
 
# Logic to determine the type of process (compile or load QB64 IDE) and execute qb64 binary
        if [ "$compiler_options_append" == "" ] && [ "$option_c" != 1 ]; then   # Check for compiler_options_append equal to NULL, execute replace if so  
                if [ "$compiler_options_replace" == "" ]; then                                      # If compiler_options_replace is also NULL, then load source into QB64 IDE and edit
                        echo "Editing (QB64 IDE) "$qb64_source" ..."
                        qb64 "$qb64_source"
                        exit 0                                                                          # Exit script after QB64 IDE shuts down
                else                                                                                    # Execute replace compiler options
                        echo "qb64 $compiler_options_replace -o $qb64_object $qb64_source"
                        echo
                        echo "Compiling "$qb64_source" ..."
                        qb64 "$compiler_options_replace" -o "$qb64_object" "$qb64_source"
                fi
        else                                                                                            # Eexecute append compiler options
                if [ "$compiler_options_append" != "" ]; then
                        echo "qb64 -x -w $compiler_options_append -o $qb64_object $qb64_source"
                        echo
                        echo "Compiling "$qb64_source" ..."
                        qb64 -x -w "$compiler_options_append" -o "$qb64_object" "$qb64_source"
                else
                        echo "qb64 -x -w -o $qb64_object $qb64_source"
                        echo
                        echo "Compiling "$qb64_source" ..."
                        qb64 -x -w -o "$qb64_object" "$qb64_source"
                fi
        fi
 
# Check for successful compiled completion and display appropriate message
        if [ $? != 0 ]; then                                                               
                echo ""
                echo "*** ERROR: Program did not compile successfully. Please fix and retry. Script Terminated."
                exit 1
        else
                echo
                echo "Program \"$qb64_program.bas\" compiled successfully."
        fi
fi
 

Programs / Estimated Blood Alcohol Calculator (Text-Based, All Platforms)

« on: June 20, 2021, 11:20:37 pm »

Here is the text-based version o the Estimated Blood Alcohol program.

For more on this (most of it will apply, see post: https://www.qb64.org/forum/index.php?topic=4003.msg133420#msg133420)

Code: QB64: [Select]

_TITLE "EBAC Calculator"
'------------------------------------------------------------------------------------------------
' EBAC Calculator v1.0 by George McGinn, MAY, 2021
' Copyright (C)2021 by George McGinn/Linux Software Systems
'                      All Rights Reserved.
'
' Program is designed to run as an App in iTunes to run specifically
' on an iPhone so those who would like to know their esitmate BAC and
' how long it will take to get to a level to drive safely and legally.
'
' Blood alcohol content (BAC) can be estimated by a method developed by
' Swedish professor Erik Widmark in the 1920s.
'
' Gives the estimated BAC (EBAC), algorhithm reduced as:
'    EBAC=A/(r*Wt)*1.055-B*T (verified by Wiki source listed below)
' Where:
'    EBAC: Estimated Blood Alcohol Content (%)
'        A: Alcohol consumed (in ounces to grams) or FLoz
'        r: Ratio of body water to total weight (men: .68, women: .55)
'      Wt: Body weight (in pounds to kilograms)
'        B: Rate alcohol metabolized (men: .019/hr, women: .017/hr)
'        T: Time alcohol in blood or time since consumption began
'    1.055: Constant value of density of blood
'
' The formula can also be reduced as follows (called the 8/10 formula):
'    For Men:   EBAC = 7.97*A/Wt-B*T
'    For Women: EBAC = 9.86*A/Wt-B*T
'
' Factors 7.97 and 9.86 are derived from "r" and 1.055.
' Also, this formula is geared to fluid ounces and pounds, not
' grams and kilograms. While the suggested values were 8 and 10,
' testing showed the results were not accurate. So I reworked it
' and found that 7.97 and 9.86 gives better results.
'
' It will be this reduced formula the program will use.
'
' Each shot, wine glass and bottle/can of beer contains .6oz of
' alcohol. User records the number of drinks, which will then be
' converted to ounces (drinks * .6)
'
' *** Formulas created/translated by George McGinn using the following sources:
'    * Blood alcohol content can be estimated by a method developed
'      by Swedish professor Erik Widmark [sv] in the 1920s.
'      (https://web.archive.org/web/20031202155933/http://www.dui-law.com/810art.htm)
'    * https://www.ou.edu/police/faid/blood-alcohol-calculator
'    * https://www.gambonelaw.com/faqs/the-widmark-formula-and-calculating-your-bac-level/
'    * https://en.wikipedia.org/wiki/Blood_alcohol_content
'    * https://en.wikipedia.org/wiki/Binge_drinking
'    * https://en.wikipedia.org/wiki/Alcohol_intoxication
'    * https://en.wikipedia.org/wiki/Breathalyzer
'    * https://ndaa.org/wp-content/uploads/toxicology_final.pdf
'    * http://njlaw.rutgers.edu/collections/courts/supreme/a-96-06.doc.html
'    * https://www.researchgate.net/profile/Alan-Jones-14/publication/318055507_Profiles_in_Forensic_Toxicology_Professor_Erik_Widmark_1889-1945/links/595794330f7e9ba95e0fd91d/Profiles-in-Forensic-Toxicology-Professor-Erik-Widmark-1889-1945.pdf?origin=publication_detail
'    * https://www.cdc.gov/alcohol
'------------------------------------------------------------------------------------------------
'
' PROGRAM NOTES:
' --------------
' This blood alcohol content or BAC, for short, calculator can estimate
' your blood alcohol levels. Metabolism, body fat percentage and
' medication are other factors that can affect the rate of absorption
' by the body, and these are not considered in this calculation.
'
' Blood alcohol content (BAC) or blood alcohol level is the
' concentration of alcohol in the bloodstream. It is usually measured
' as mass per volume. For example, a Blood alcohol content BAC of
' 0.04% means 0.4% (permille) or 0.04 grams of alcohol per 100 grams
' of individual’s blood. Use this BAC Calculator for informational
' purposes only, and not to drink and drive or drink and work.
'
' Important Note: There is no BAC calculator that is 100% accurate.
' This is due to the number of factors that come into play regarding
' the consumption and alcohol processing rates of different people.
' Factors include the gender of the drinker (biologic, not identity),
' their differing metabolism rates, various health issues, and the
' combination of medications and supplements that might be taken by
' the drinker, drinking frequency, amount of food in the stomach and
' small intestine and when it was eaten, elapsed time, and other
' factors. The best that can be done is a rough estimation of the
' bloodstreams alcohol content or the BAC level based on known inputs.
'
' Every state in the U.S. has a legal Blood Alcohol (BAC) limit of
' 0.05% or 0.08%, (depending on the state you are driving in). Most
' states also have lower legal BAC limits for young and inexperienced
' drivers, professional drivers and commercial drivers. Sentences for
' drunk driving include imprisonment, large fines, lengthy drivers
' license suspension and/or revocation, house arrest, community
' service, DUI schools, alcohol treatment programs, vehicle forfeiture
' and ignition interlock restrictions.
'
'------------------------------------------------------------------------------------------------
' Program Copyright (C)2021 by George McGinn/Pyramid Software Systems
' All Rights Reserved.
'
' EBAC Calculator by George McGinn is licensed under a Creative Commons
' Attribution-NonCommercial 4.0 International License.
'
' Full License Link: https://creativecommons.org/licenses/by-nc/4.0/
'
'
' You are free to (For non-commerical purposes only):
'     Share          - copy and redistribute the material in any medium or format.
'     Adapt          - remix, transform, and build upon the material.
'     Attribution    - You must give appropriate credit, provide a link to
'     the license, and indicate if changes were made. You may do so in any
'     reasonable manner, but not in any way that suggests the licensor
'     endorses you or your use.
'     Non Commercial - You may not use the material for commercial purposes.
'
' *** None of this code is considered in the Public Domain. Rights granted under CC 4.0
'     are outlined as above and the disclaimer below:
'
' *** DISCLAIMER ***
' Unless otherwise separately undertaken by the Licensor, to the extent possible,
' the Licensor offers the Licensed Material as-is and as-available, and makes no
' representations or warranties of any kind concerning the Licensed Material, whether
' express, implied, statutory, or other. This includes, without limitation, warranties
' of title, merchantability, fitness for a particular purpose, non-infringement, absence
' of latent or other defects, accuracy, or the presence or absence of errors, whether or
' not known or discoverable. Where disclaimers of warranties are not allowed in full or
' in part, this disclaimer may not apply to You.
'
' To the extent possible, in no event will the Licensor be liable to You on any legal theory
' (including, without limitation, negligence) or otherwise for any direct, special, indirect,
' incidental, consequential, punitive, exemplary, or other losses, costs, expenses, or damages
' arising out of this Public License or use of the Licensed Material, even if the Licensor has
' been advised of the possibility of such losses, costs, expenses, or damages. Where a limitation
' of liability is not allowed in full or in part, this limitation may not apply to You.
'
' The disclaimer of warranties and limitation of liability provided above shall be interpreted
' in a manner that, to the extent possible, most closely approximates an absolute disclaimer and
'  waiver of all liability.
'------------------------------------------------------------------------------------------------
 
 
'--------------------------------
'*** Initialize SCREEN
'SCREEN 12
SCREEN _NEWIMAGE(800, 600, 32)
 
'*** Setup Font Type and Size
fontpath$ = "Verdana.ttf"
font& = _LOADFONT(fontpath$, 8, "")
 
 
QBMain:
DIM A AS DOUBLE
DIM B, OZ AS SINGLE
DIM EBAC AS DOUBLE
 
'*** Setup constant variables
A = 0
Wt = 0
B = .0
T = 0: St = 0
I = 0
Bdl = 1.055
OZ = .5
TRUE = 1: FALSE = 0
SOBER = FALSE
 
'*** Get INPUT for values for calculations
PRINT
PRINT "BLOOD ALCOHOL CALCULATOR"
PRINT "------------------------"
PRINT: PRINT
INPUT "YOUR SEX (M/F): "; SEX$
SEX$ = UCASE$(SEX$)
IF SEX$ <> "M" AND SEX$ <> "F" THEN GOTO QBMain
INPUT "YOUR WEIGHT (lbs): "; Wt
INPUT "NUMBER OF DRINKS: "; A
INPUT "TIME (HRS) SINCE CONSUMPTION BEGAN: "; T
 
'*** Convert Drinks into Fluid Ounces of EtOH (Pure Alcohol).
'*** A is number of drinks. 1 drink is about .6 FLoz of alcohol
FLoz = A * OZ
 
'*** Set/calculate EBAC values based on SEX$
SELECT CASE SEX$
    CASE "M"
        B = .017
        EBAC = 7.97 * FLoz / Wt - B * T
    CASE "F"
        B = .019
        EBAC = 9.86 * FLoz / Wt - B * T
END SELECT
 
IF EBAC < 0 THEN EBAC = 0
 
'*** DISPLAY RESULTS
PRINT: PRINT
PRINT USING "ESTIMATED BLOOD ALCOHOL CONTENT (EBAC) in g/dL = #.###"; EBAC
 
 
'*** IF DRUNK DISPLAY WARNING (.10 WAS DRUNK IN 1984, .08 IN 2003/2004)
SELECT CASE EBAC
    CASE .500 TO 1.9999
        PRINT: PRINT "*** ALERT: CALL AN AMBULANCE, DEATH LIKELY"
        PRINT "Unconsious/coma, unresponsive, high likelihood of death. It is illegal to operate a motor vehicle at this level of intoxication in all states."
    CASE .400 TO .4999
        PRINT: PRINT "*** ALERT: CALL AN AMBULANCE, DEATH POSSIBLE"
        PRINT "Onset of coma, and possible death due to respiratory arrest. It is illegal to operate a motor vehicle at this level of intoxication in all states."
    CASE .350 TO .3999
        PRINT: PRINT "*** ALERT: CALL AN AMBULANCE, SEVERE ALCOHOL POISONING"
        PRINT " Coma is possible. This is the level of surgical anesthesia. It is illegal to operate a motor vehicle at this level of intoxication in all states."
    CASE .300 TO .3499
        PRINT: PRINT "*** ALERT: YOU ARE IN A DRUNKEN STUP0R, AT RISK TO PASSING OUT"
        PRINT "STUPOR. You have little comprehension of where you are. You may pass out suddenly and be difficult to awaken. It is illegal to operate a motor vehicle at this level of intoxication in all states."
    CASE .250 TO .2999
        PRINT: PRINT "*** ALERT: SEVERLY IMPAIRED - DRUNK ENOUGH TO CAUSE SEVERE INJURY/DEATH TO SELF"
        PRINT "All mental, physical and sensory functions are severely impaired. Increased risk of asphyxiation from choking on vomit and of seriously injuring yourself by falls or other accidents. It is illegal to operate a motor vehicle at this level of intoxication in all states."
    CASE .200 TO .2499
        PRINT: PRINT "YOU ARE EXTREMELY DRUNK"
        PRINT "Feeling dazed/confused or otherwise disoriented. May need help to stand/walk. If you injure yourself you may not feel the pain. Some people have nausea and vomiting at this level. The gag reflex is impaired and you can choke if you do vomit. Blackouts are likely at this level so you may not remember what has happened. It is illegal to operate a motor vehicle at this level of intoxication in all states."
    CASE .160 TO .1999
        PRINT: PRINT "YOUR ARE SEVERLY DRUNK - ENOUGH TO BECOME VERY SICK"
        PRINT "Dysphoria predominates, nausea may appear. The drinker has the appearance of a 'sloppy drunk.' It is illegal to operate a motor vehicle at this level of intoxication in all states."
        PRINT: PRINT "* Dysphoria: An emotional state of anxiety, depression, or unease."
    CASE .130 TO .1599
        PRINT: PRINT "YOU ARE VERY DRUNK - ENOUGH TO LOSE PHYSICAL & MENTAL CONTROL"
        PRINT "Gross motor impairment and lack of physical control. Blurred vision and major loss of balance. Euphoria is reduced and dysphoria* is beginning to appear. Judgment and perception are severely impaired. It is illegal to operate a motor vehicle at this level of intoxication in all states."
        PRINT: PRINT "* Dysphoria: An emotional state of anxiety, depression, or unease."
    CASE .100 TO .1299
        PRINT: PRINT "YOU ARE LEGALLY DRUNK"
        PRINT "Significant impairment of motor coordination and loss of good judgment. Speech may be slurred; balance, vision, reaction time and hearing will be impaired. Euphoria. It is illegal to operate a motor vehicle at this level of intoxication in all states."
    CASE .070 TO .0999
        PRINT: PRINT "YOU MAY BE LEGALLY DRUNK"
        PRINT "Slight impairment of balance, speech, vision, reaction time, and hearing. Euphoria. Judgment and self-control are reduced, and caution, reason and memory are impaired (in some* states .08 is legally impaired and it is illegal to drive at this level). You will probably believe that you are functioning better than you really are."
        PRINT: PRINT "(*** As of July, 2004 ALL states had passed .08 BAC Per Se Laws. The final one took effect in August of 2005.)"
    CASE .040 TO .0699
        PRINT: PRINT "YOU MAY BE LEGALLY BUZZED"
        PRINT "Feeling of well-being, relaxation, lower inhibitions, sensation of warmth. Euphoria. Some minor impairment of reasoning and memory, lowering of caution. Your behavior may become exaggerated and emotions intensified (Good emotions are better, bad emotions are worse)"
    CASE .020 TO .0399
        PRINT: PRINT "YOU MAY BE OK TO DRIVE, BUT IMPAIRMENT BEGINS"
        PRINT "No loss of coordination, slight euphoria and loss of shyness. Depressant effects are not apparent. Mildly relaxed and maybe a little lightheaded."
    CASE .000 TO .0199
        PRINT: PRINT "YOU ARE OK TO DRIVE"
END SELECT
 
 
'*** Determine if Drunk (>.08 EBAC) and calculate:
'***    - When user will be less than .08
'***    - How long it will take to become completely sober
PRINT
IF EBAC > .08 THEN
    SOBER = FALSE
    CEBAC = EBAC
    St = T
    DO UNTIL SOBER = TRUE
        T = T + 1
        IF CEBAC > .0799 THEN I = I + 1
 
        SELECT CASE SEX$
            CASE "M"
                B = .015
                CEBAC = 7.97 * FLoz / Wt - B * T
            CASE "F"
                B = .015
                CEBAC = 9.86 * FLoz / Wt - B * T
        END SELECT
 
        IF legalToDrive = FALSE THEN
            IF CEBAC < .08 THEN
                IF I > 9 THEN
                    PRINT USING "It will take ## hours from your last drink to be able to drive."; I
                ELSE
                    PRINT USING "It will take # hours from your last drink to be able to drive."; I
                END IF
                legalToDrive = TRUE
            END IF
        END IF
 
        IF CEBAC <= 0 THEN
            IF T - St > 9 THEN
                PRINT USING "It will take you ## hours from your last drink to be completely sober."; T - St
            ELSE
                PRINT USING "It will take you # hours from your last drink to be completely sober."; T - St
            END IF
            SOBER = TRUE
        END IF
    LOOP
END IF
 
END
 

Programs / Estimated Blood Alcohol Calculator (LINUX/Zenity Only)

« on: June 20, 2021, 11:16:12 pm »

This program was originally written by me in Objective-C for mobile devices. That is until Apple decided to ban all these programs from the iTunes store. (From their 6/7 update: 4.3: Added drinking game apps as a saturated category.).

After learning Zenity, I decided to convert this program to QB64 and give this GUI a test, and I am pleased with the results.

Back when I was a police officer, this formula, in a more advanced form, was used by defense attorneys in the 70's through parts of the 90's when defending their clients on DUI charges. I can tell you that a breathlizer does not accurately measure blood alcohol content, a requirement to convict someone in court. What it does measure is the amount of alcohol that is leaving the body. Which is why the must draw blood to get an accurate BAC figure, which is done today, but wasn't standard back when I was in law enforcement.

I offer this program as a novelty, and if you host parties, you could use it to guide your decision on guests who may drink too much. I do. However, remember that when I created this, I used only the averages for males and females. Many factors are specific to an individual such as metabolism rate, which your doctor can tell you what it is after conducting tests. The comments in the program and the help file lists some of the many factors that are not considered by this program.

The program itself is well documented and lots of comments to help anyone looking to understand how Zenity works with QB64. I use both pipecom and SHELL to serve the GUI, and I am using most of the funtionality of Zenity with some exceptions.

This program will only run on Linux. I have a version for all platforms that uses the QB64 screen for input and output. I will post this program seperately.

To run this program, there is a HELP file that must be loaded in the same directory as the binary executable. The program, due to the constraints of Zenity's Text Information Dialog, the output into the GUI can only come from this file. Also, the program will write out the results of the calculation to a temporary file called "tempfile" that resides in the same directory as the executable. The program removes this file when it ends. If the file somehow exists when the program starts, it will be replaced. So make sure you do not have a file by that name in the directory you plan to run this.

Attached to this post is a compressed file that has both the source code and the help file. I also have the latest pipecom utility by Spriggs in this archive as well. This is for those who do not want to cut/paste a 400+ line program (150 lines consists of the comments at the beginning of the program).

Since this may still be a commercially viable program for me (in that I plan to market it for free), it is provided under the Creative Commons Attribution License. You are free to do what you want with it as long as: 1) I am credited with it, and 2) For your protection, keep the disclaimer intact.

Enjoy. Those who wish to learn about Zenity will find this program very educational.

*** You can find the latest version of Pipecom here: https://www.qb64.org/forum/index.php?topic=3641.msg129938#msg129938

Code: QB64: [Select]

_TITLE "ebacCalculator.bas"
'------------------------------------------------------------------------------------------------
' EBAC Calculator v1.0 by George McGinn, APRIL, 2021
' Copyright (C)2021 by George McGinn
'                      All Rights Reserved.
'
' 6/19/2021 - Updated To use Zenity and SHELL commands to run on Linux with a simple GUI. (GJM)
'
' Original code designed to run as an App in iTunes to run specifically
' on an iPhone so those who would like to know their esitmate BAC and
' how long it will take to get to a level to drive safely and legally.
'
' Modified to run on the Desktop for use at home. You can judge the amount of drinks your guests
' have had and use this program to help in deciding who can drive and approximately how long
' someone needs to wait before they could possibly drive.
'
' *** There is no warranty (See Disclaimer) as to the fitness or accuracy of the results.
' *** While every effort has been made to provide accurate results, other factors not considered
' *** also play a role in determining one's Blood Alcohol Content.
'
' Blood alcohol content (BAC) can be estimated by a method developed by Swedish professor
' Erik Widmark in the 1920s.
'
' Gives the estimated BAC (EBAC), algorhithm reduced as:
'    EBAC=A/(r*Wt)*1.055-B*T (verified by Wiki source listed below)
' Where:
'    EBAC: Estimated Blood Alcohol Content (%)
'        A: Alcohol consumed (in ounces to grams) or FLoz
'        r: Ratio of body water to total weight (men: .68, women: .55)
'      Wt: Body weight (in pounds to kilograms)
'        B: Rate alcohol metabolized (men: .019/hr, women: .017/hr)
'        T: Time alcohol in blood or time since consumption began
'    1.055: Constant value of density of blood
'
' The formula can also be reduced as follows (called the 8/10 formula):
'    For Men:   EBAC = 7.97*A/Wt-B*T
'    For Women: EBAC = 9.86*A/Wt-B*T
'
' Factors 7.97 and 9.86 are derived from "r" and 1.055 among other factors.
' Also, this formula is geared to fluid ounces and pounds, not
' grams and kilograms. While the suggested values were 8 and 10,
' testing showed the results were not accurate. So I reworked it
' and found that 7.97 and 9.86 gives better results.
'
' It will be this reduced formula the program will use.
'
' Each shot, wine glass and bottle/can of beer contains .6oz of
' alcohol. User records the number of drinks, which will then be
' converted to ounces (drinks * .6)
'
' *** Formulas created/translated by George McGinn using the following sources:
'    * Blood alcohol content can be estimated by a method developed
'      by Swedish professor Erik Widmark [sv] in the 1920s.
'      (https://web.archive.org/web/20031202155933/http://www.dui-law.com/810art.htm)
'    * https://www.ou.edu/police/faid/blood-alcohol-calculator
'    * https://www.gambonelaw.com/faqs/the-widmark-formula-and-calculating-your-bac-level/
'    * https://en.wikipedia.org/wiki/Blood_alcohol_content
'    * https://en.wikipedia.org/wiki/Binge_drinking
'    * https://en.wikipedia.org/wiki/Alcohol_intoxication
'    * https://en.wikipedia.org/wiki/Breathalyzer
'    * https://ndaa.org/wp-content/uploads/toxicology_final.pdf
'    * http://njlaw.rutgers.edu/collections/courts/supreme/a-96-06.doc.html
'    * https://www.researchgate.net/profile/Alan-Jones-14/publication/318055507_Profiles_in_Forensic_Toxicology_Professor_Erik_Widmark_1889-1945/links/595794330f7e9ba95e0fd91d/Profiles-in-Forensic-Toxicology-Professor-Erik-Widmark-1889-1945.pdf?origin=publication_detail
'    * https://www.cdc.gov/alcohol
'------------------------------------------------------------------------------------------------
'
' PROGRAM NOTES:
' --------------
' This blood alcohol content or BAC, for short, calculator can estimate
' your blood alcohol levels. Metabolism, body fat percentage and
' medication are some of the other factors that can affect the rate of absorption
' by the body, and these are not considered in this calculation.
'
' Blood alcohol content (BAC) or blood alcohol level is the
' concentration of alcohol in the bloodstream. It is usually measured
' as mass per volume. For example, a Blood alcohol content BAC of
' 0.04% means 0.4% (permille) or 0.04 grams of alcohol per 100 grams
' of individuals blood. Use this BAC Calculator for informational
' purposes only, and not to drink and drive or drink and work.
'
' Important Note: There is no BAC calculator that is 100% accurate.
' This is due to the number of factors that come into play regarding
' the consumption and alcohol processing rates of different people.
' Other factors not considered here include:
'    * Overall health and wellness
'    * Body type
'    * Metabolism (Program uses an Average for Males & Females)
'    * Alcohol tolerance
'    * What kind of alcohol is consumed (Program uses average drink of 40% ETOH)
'    * Medications
'    * Amount of food eaten
'    * Emotional, mental state
'
' The best that can be done is a rough estimation of the
' bloodstreams alcohol content or the BAC level based on known inputs.
'
' Every state in the U.S. has a legal Blood Alcohol (BAC) limit of 0.05% or 0.08%,
' (depending on the state you are driving in). Most states also have lower legal
' BAC limits for young and inexperienced drivers, professional drivers and commercial
' drivers. Sentences for drunk driving include imprisonment, large fines, lengthy drivers
' license suspension and/or revocation, house arrest, community service, DUI schools,
' alcohol treatment programs, vehicle forfeiture and ignition interlock restrictions.
'
'------------------------------------------------------------------------------------------------
' Program Copyright (C)2021 by George McGinn
' All Rights Reserved.
'
' EBAC Calculator by George McGinn is licensed under a Creative Commons
' Attribution-NonCommercial 4.0 International License.
'
' Full License Link: https://creativecommons.org/licenses/by-nc/4.0/
'
'
' You are free to (For non-commerical purposes only):
'     Share          - copy and redistribute the material in any medium or format.
'     Adapt          - remix, transform, and build upon the material.
'     Attribution    - You must give appropriate credit, provide a link to
'                      the license, and indicate if changes were made. You may do so in any
'                      reasonable manner, but not in any way that suggests the licensor
'                      endorses you or your use.
'     Non Commercial - You may not use the material for commercial purposes.
'
' *** None of this code is considered in the Public Domain. Rights granted under CC 4.0
'     are outlined as above and the disclaimer below:
'
' *** DISCLAIMER ***
' Unless otherwise separately undertaken by the Licensor, to the extent possible,
' the Licensor offers the Licensed Material as-is and as-available, and makes no
' representations or warranties of any kind concerning the Licensed Material, whether
' express, implied, statutory, or other. This includes, without limitation, warranties
' of title, merchantability, fitness for a particular purpose, non-infringement, absence
' of latent or other defects, accuracy, or the presence or absence of errors, whether or
' not known or discoverable. Where disclaimers of warranties are not allowed in full or
' in part, this disclaimer may not apply to You.
'
' To the extent possible, in no event will the Licensor be liable to You on any legal theory
' (including, without limitation, negligence) or otherwise for any direct, special, indirect,
' incidental, consequential, punitive, exemplary, or other losses, costs, expenses, or damages
' arising out of this Public License or use of the Licensed Material, even if the Licensor has
' been advised of the possibility of such losses, costs, expenses, or damages. Where a limitation
' of liability is not allowed in full or in part, this limitation may not apply to You.
'
' The disclaimer of warranties and limitation of liability provided above shall be interpreted
' in a manner that, to the extent possible, most closely approximates an absolute disclaimer and
' waiver of all liability.
'------------------------------------------------------------------------------------------------
 
 
'--------------------------------
'*** Initialize
 
'*** If You comment the line below out, you will see the [DEBUG] PRINT statements in the QB64 Window. You can add your own PRINT statements if needed
$SCREENHIDE
SCREEN _NEWIMAGE(500, 700, 32)
 
DIM SHARED AS INTEGER l
DIM SHARED AS DOUBLE A, T
DIM SHARED AS SINGLE B, OZ, Wt
DIM SHARED AS SINGLE EBAC
DIM SHARED numeric(255)
DIM SHARED AS INTEGER TRUE, FALSE, SOBER
DIM SHARED Sex AS STRING
DIM SHARED AS STRING Weight, Drinks, TimeElapsed
DIM SHARED AS STRING cmd, stdout, stderr, stdbutton
DIM SHARED AS LONG result
DIM SHARED AS STRING prt_text
 
'--------------------------------
'*** Setup NUMERIC Check Table
FOR I = 48 TO 57
    numeric(I) = -1
NEXT
 
EBACMain:
'--------------------------------
'*** Setup constant variables
    A = 0
    Wt = 0
    B = .0
    T = 0: St = 0
    I = 0
    Bdl = 1.055
    OZ = .5
    TRUE = -1: FALSE = 0
    SOBER = FALSE
 
 
EBACForm:
'--------------------------------
'*** Produce the Input Form
    stdout = ""
    cmd = "zenity --forms --title=" + CHR$(34) + "EBAC Blood Alcohol Calculator" + CHR$(34) + _
          " --text=" + CHR$(34) + "Enter information about your friend." + CHR$(34) + _
          " --add-entry=" + CHR$(34) + "Sex (M or F)" + CHR$(34) + _
          " --add-entry=" + CHR$(34) + "Weight (lbs)" + CHR$(34) + _
          " --add-entry=" + CHR$(34) + "Number of drinks" + CHR$(34) + _
          " --add-entry=" + CHR$(34) + "Time (hrs) from first drink" + CHR$(34) + _
          " --extra-button=HELP --extra-button=QUIT"
 
    result = pipecom(cmd, stdout, stderr)
 
    stdbutton = LEFT$(stdout, 4)
 
    IF result = 1 AND stdbutton = "QUIT" THEN GOTO endPROG
 
    IF result = 1 AND stdbutton = "HELP" THEN
        cmd = "zenity --text-info " + _
              " --title=" + CHR$(34) + "HELP/ABOUT: EBAC Calculator" + CHR$(34) + _
              " --filename=" + "EBACHelp.txt" + _
              " --width=525 --height=600"
        SHELL (cmd)
        GOTO EBACForm
    END IF
 
    IF result <> 0 THEN
        SHELL ("zenity --error --text=" + CHR$(34) + "Main Form did not load. Program Terminated." + CHR$(34) + " --width=175 --height=100")
        GOTO endPROG
    END IF
 
'----------------------------------------------------------
'*** Populate QB64 variables from the form's stdout results
 
'--------------------------------------------------
'*** Get and Validate Sex Input
    Sex = MID$(stdout, 1, INSTR(stdout, "|") - 1)
    Sex = UCASE$(Sex)
    IF Sex <> "M" AND Sex <> "F" THEN
        SHELL ("zenity --warning --text=" + CHR$(34) + "SEX must be either M or F." + CHR$(34) + " --width=175 --height=100")
        GOTO EBACForm
    END IF
 
'---------------------------------------------------
'*** Get and Validate Weight Input
    stdout = MID$(stdout, INSTR(stdout, "|") + 1)
    Weight = MID$(stdout, 1, INSTR(stdout, "|") - 1)
    IF ISNUMERIC(Weight) THEN
        Wt = VAL(Weight)
    ELSE
        SHELL ("zenity --warning --text=" + CHR$(34) + "Weight must be numeric." + CHR$(34) + " --width=175 --height=100")
        GOTO EBACForm
    END IF
 
 
'-----------------------------------------------------
'*** Get and Validate Number of Drinks Input
    stdout = MID$(stdout, INSTR(stdout, "|") + 1)
    Drinks = MID$(stdout, 1, INSTR(stdout, "|") - 1)
    IF ISNUMERIC(Drinks) THEN
        A = VAL(Drinks)
    ELSE
        SHELL ("zenity --warning --text=" + CHR$(34) + "Number of drinks must be numeric." + CHR$(34) + " --width=175 --height=100")
        GOTO EBACForm
    END IF
 
'-------------------------------------------------------------------
'*** Get and Validate Time Since First Drink (Time Elapsed) Input
    TimeElapsed = MID$(stdout, INSTR(stdout, "|") + 1)
    l = LEN(TimeElapsed)
    TimeElapsed$ = LEFT$(TimeElapsed, l - 1)
    IF ISNUMERIC(TimeElapsed) THEN
        T = VAL(TimeElapsed)
    ELSE
        SHELL ("zenity --warning --text=" + CHR$(34) + "Time since first drink must be numeric." + CHR$(34) + " --width=175 --height=100")
        GOTO EBACForm
    END IF
 
'--------------------------------------------------------------------------------------------------------
'*** Calculate the value of the Estimated Blood Alcohol Content (EBAC) and check for sucessful completion
    result = calcEBAC
    IF result <> 0 THEN
        SHELL ("zenity --error --text=" + CHR$(34) + "Calulating the EBAC results failed. Program Terminated" + CHR$(34) + " --width=175 --height=100")
        GOTO endPROG
    END IF
 
'---------------------------------------------------------------------------------------------------------------------------------------------
'*** Create a temp file for the Zenity Information Box and write out prt_text (This box cannot have text passed to it unless it is in a file)
    OPEN "tempfile" FOR OUTPUT AS #1
    PRINT #1, USING "ESTIMATED BLOOD ALCOHOL CONTENT (EBAC) in g/dL = #.###"; EBAC
    PRINT #1, prt_text
    CLOSE #1
 
displayEBAC:
'------------------------------------------------------------------
'*** Prepare the Zenity command and execute, check for good return
 
    cmd = "zenity --text-info " + _
          " --title=" + CHR$(34) + "EBAC Blood Alcohol Calculator" + CHR$(34) + _
          " --width=525 --height=400" + _
          " --filename=tempfile" + _
          " --checkbox=" + CHR$(34) + "I agree that this program and its results are not legally binding." + CHR$(34)
 
    result = SHELL(cmd)
 
    IF result = 1 THEN
        result = SHELL("zenity --warning --text=" + CHR$(34) + "You must agree to the terms of use. Please check the confirmation box." + CHR$(34) + " --width=175 --height=100")
        GOTO displayEBAC
    END IF
 
    result = SHELL("zenity --question --text=" + CHR$(34) + "Do you want to run another calculation?" + CHR$(34) + " --width=175 --height=100")
    IF result = 0 THEN
        SHELL ("rm tempfile")
        GOTO EBACForm
    END IF
 
endPROG:
    SHELL ("rm tempfile")
    result = SHELL("zenity --info --text=" + CHR$(34) + "Thank You for using EBAC Calculator. Please Don't Drink and Drive." + CHR$(34) + " --width=175 --height=100")
    END
 
 
FUNCTION calcEBAC
'-------------------------------------------------------------
'*** Convert Drinks into Fluid Ounces of EtOH (Pure Alcohol).
'*** A is number of drinks. 1 drink is about .6 FLoz of alcohol
    FLoz = A * OZ
 
'-----------------------------------------------------
'*** Set/calculate EBAC values based on Sex
    SELECT CASE Sex
        CASE "M"
            B = .017
            EBAC = 7.97 * FLoz / Wt - B * T
        CASE "F"
            B = .019
            EBAC = 9.86 * FLoz / Wt - B * T
    END SELECT
 
    IF EBAC < 0 THEN EBAC = 0
 
'----------------------------------------------------------------------------------------------
'*** Populate the EBAC string with the EBAC value formatted to 3 decimal places for FORM output
'    prt_text = "ESTIMATED BLOOD ALCOHOL CONTENT (EBAC) in g/dL = " + EBAC_ST$ + CHR$(10) + CHR$(10)
    prt_text = "" + CHR$(10)
 
'-----------------------------------------------------------------------------------------
'*** Based on EBAC range values, populate the FORM output string with the approriate text
    SELECT CASE EBAC
        CASE .500 TO 1.9999
            prt_text = prt_text + "*** ALERT: CALL AN AMBULANCE, DEATH LIKELY" + CHR$(10)
            prt_text = prt_text + "Unconsious/coma, unresponsive, high likelihood of death. It is illegal to operate a motor vehicle at this level of intoxication in all states."
        CASE .400 TO .4999
            prt_text = prt_text + "*** ALERT: CALL AN AMBULANCE, DEATH POSSIBLE" + CHR$(10)
            prt_text = prt_text + "Onset of coma, and possible death due to respiratory arrest. It is illegal to operate a motor vehicle at this level of intoxication in all states."
        CASE .350 TO .3999
            prt_text = prt_text + "*** ALERT: CALL AN AMBULANCE, SEVERE ALCOHOL POISONING" + CHR$(10)
            prt_text = prt_text + " Coma is possible. This is the level of surgical anesthesia. It is illegal to operate a motor vehicle at this level of intoxication in all states."
        CASE .300 TO .3499
            prt_text = prt_text + "*** ALERT: YOU ARE IN A DRUNKEN STUP0R, AT RISK TO PASSING OUT" + CHR$(10)
            prt_text = prt_text + "STUPOR. You have little comprehension of where you are. You may pass out suddenly and be difficult to awaken. It is illegal to operate a motor vehicle at this level of intoxication in all states."
        CASE .250 TO .2999
            prt_text = prt_text + "*** ALERT: SEVERLY IMPAIRED - DRUNK ENOUGH TO CAUSE SEVERE INJURY/DEATH TO SELF" + CHR$(10)
            prt_text = prt_text + "All mental, physical and sensory functions are severely impaired. Increased risk of asphyxiation from choking on vomit and of seriously injuring yourself by falls or other accidents. It is illegal to operate a motor vehicle at this level of intoxication in all states."
        CASE .200 TO .2499
            prt_text = prt_text + "YOU ARE EXTREMELY DRUNK" + CHR$(10)
            prt_text = prt_text + "Feeling dazed/confused or otherwise disoriented. May need help to stand/walk. If you injure yourself you may not feel the pain. Some people have nausea and vomiting at this level. The gag reflex is impaired and you can choke if you do vomit. Blackouts are likely at this level so you may not remember what has happened. It is illegal to operate a motor vehicle at this level of intoxication in all states."
        CASE .160 TO .1999
            prt_text = prt_text + "YOUR ARE SEVERLY DRUNK - ENOUGH TO BECOME VERY SICK" + CHR$(10)
            prt_text = prt_text + "Dysphoria predominates, nausea may appear. The drinker has the appearance of a 'sloppy drunk.' It is illegal to operate a motor vehicle at this level of intoxication in all states." + CHR$(10) + CHR$(10)
            prt_text = prt_text + "* Dysphoria: An emotional state of anxiety, depression, or unease."
        CASE .130 TO .1599
            prt_text = prt_text + "YOU ARE VERY DRUNK - ENOUGH TO LOSE PHYSICAL & MENTAL CONTROL" + CHR$(10)
            prt_text = prt_text + "Gross motor impairment and lack of physical control. Blurred vision and major loss of balance. Euphoria is reduced and dysphoria* is beginning to appear. Judgment and perception are severely impaired. It is illegal to operate a motor vehicle at this level of intoxication in all states." + CHR$(10) + CHR$(10)
            prt_text = prt_text + "* Dysphoria: An emotional state of anxiety, depression, or unease."
        CASE .100 TO .1299
            prt_text = prt_text + "YOU ARE LEGALLY DRUNK" + CHR$(10)
            prt_text = prt_text + "Significant impairment of motor coordination and loss of good judgment. Speech may be slurred; balance, vision, reaction time and hearing will be impaired. Euphoria. It is illegal to operate a motor vehicle at this level of intoxication in all states."
        CASE .070 TO .0999
            prt_text = prt_text + "YOU MAY BE LEGALLY DRUNK" + CHR$(10)
            prt_text = prt_text + "Slight impairment of balance, speech, vision, reaction time, and hearing. Euphoria. Judgment and self-control are reduced, and caution, reason and memory are impaired (in some* states .08 is legally impaired and it is illegal to drive at this level). You will probably believe that you are functioning better than you really are." + CHR$(10) + CHR$(10)
            prt_text = prt_text + "(*** As of July, 2004 ALL states had passed .08 BAC Per Se Laws. The final one took effect in August of 2005.)"
        CASE .040 TO .0699
            prt_text = prt_text + "YOU MAY BE LEGALLY BUZZED" + CHR$(10)
            prt_text = prt_text + "Feeling of well-being, relaxation, lower inhibitions, sensation of warmth. Euphoria. Some minor impairment of reasoning and memory, lowering of caution. Your behavior may become exaggerated and emotions intensified (Good emotions are better, bad emotions are worse)"
        CASE .020 TO .0399
            prt_text = prt_text + "YOU MAY BE OK TO DRIVE, BUT IMPAIRMENT BEGINS" + CHR$(10)
            prt_text = prt_text + "No loss of coordination, slight euphoria and loss of shyness. Depressant effects are not apparent. Mildly relaxed and maybe a little lightheaded."
        CASE .000 TO .0199
            prt_text = prt_text + "YOU ARE OK TO DRIVE" + CHR$(10)
    END SELECT
 
'-----------------------------------------------------------
'*** Determine if Drunk (>.08 EBAC) and calculate:
'***    - When user will be less than .08
'***    - How long it will take to become completely sober
    IF EBAC > .08 THEN
        SOBER = FALSE
        CEBAC = EBAC
        st = T
        DO UNTIL SOBER = TRUE
            T = T + 1
            IF CEBAC > .0799 THEN I = I + 1
 
            SELECT CASE Sex
                CASE "M"
                    B = .017
                    CEBAC = 7.97 * FLoz / Wt - B * T
                CASE "F"
                    B = .019
                    CEBAC = 9.86 * FLoz / Wt - B * T
            END SELECT
 
            IF legalToDrive = FALSE THEN
                IF CEBAC < .08 THEN
                    prt_text = prt_text + CHR$(10) + CHR$(10) + "It will take about " + STR$(I) + " hours from your last drink to be able to drive." + CHR$(10)
                    legalToDrive = TRUE
                END IF
            END IF
 
            IF CEBAC <= 0 THEN
                prt_text = prt_text + "It will take about " + STR$(T - st) + " hours from your last drink to be completely sober."
                SOBER = TRUE
            END IF
        LOOP
    END IF
 
END FUNCTION
 
 
FUNCTION ISNUMERIC (A$)
'-----------------------------------------------------
'*** Numeric Check of a STRING
    l = LEN(A$)
    FOR I = 1 TO l
        ACODE = ASC(A$, I)
        IF numeric(ACODE) THEN
            ISNUMERIC = TRUE
        ELSE
            ISNUMERIC = FALSE
            EXIT FUNCTION
        END IF
    NEXT I
END FUNCTION
 
 
'$INCLUDE:'pipecomqb64.bas'
 

ebacCalculator-qb64.zip

QB64 Discussion / Zenity and QB64

« on: June 18, 2021, 04:08:23 pm »

I'm not sure if this is me, QB64, Zenity, pipecom, or a mixture of all.

I took an example from the Zenity documentation, and it is presenting me with garbage. Here is the code from the documentation, my QB64 code, and a screen print of what I am getting.

I originally had all the parameters in, but I removed the "--title" and the ">> addr.csv" and reordered it the same way as the code given to me by Spriggs, with no changes in my results.

The commented out part works fine (It is Spriggs code that was provided).

From Zenity Documentation (just the portion of the BASH script that is the call to Zenity):

Code: [Select]

zenity --forms --title="Add Friend" \
	--text="Enter information about your friend." \
	--separator="," \
	--add-entry="First Name" \
	--add-entry="Family Name" \
	--add-entry="Email" \
	--add-calendar="Birthday" >> addr.csv

QB64:

Code: QB64: [Select]

OPTION _EXPLICIT
'$CONSOLE:ONLY
'_DEST _CONSOLE
DIM AS STRING email, dates, other, form, birthday, firstname, lastname
 
'form = pipecom_lite("zenity --forms --add-entry=" + CHR$(34) + "Email" + CHR$(34) + _
'                    " --add-calendar=" + CHR$(34) + "Pick date" + CHR$(34) + _
'                    " --text=" + CHR$(34) + "This is a form made in zenity" + CHR$(34) + _
'                    " --add-entry=" + CHR$(34) + "Ultimate Haxxor" + CHR$(34) _
'                    )
 
 
form = pipecom_lite( _
                    "zenity --forms --add-entry=" + CHR$(34) + "First Name" + CHR$(34) + _
                    "--add-calendar=" + CHR$(34) + "Birthday" + CHR$(34) + _
                    "--text=" + CHR$(34) + "Enter information about your friend." + CHR$(34) + _
                    "--add-entry=" + CHR$(34) + "Last Name" + CHR$(34) + _
                    "--add-entry=" + CHR$(34) + "Email" + CHR$(34) _
                    )
 
 
 
'email = MID$(form, 1, INSTR(form, "|") - 1)
'PRINT email
'form = MID$(form, INSTR(form, "|") + 1)
'dates = MID$(form, 1, INSTR(form, "|") - 1)
'PRINT dates
'other = MID$(form, INSTR(form, "|") + 1)
'PRINT other
 
'$INCLUDE:'pipecomqb64.bas'

Here is the run results:
[ You are not allowed to view this attachment ]

QB64 Discussion / PRINT USING Bug?

« on: June 01, 2021, 08:09:01 pm »

In researching for the post on 128bit numbers, I've isolated the following code and believe that this is a bug.

I am running on Linux Ubuntu 20.04.2 LTS, and screen print is attached.

I am print the following number: 10.349449797507

And regardless of whether I use FLOAT, DOUBLE or SINGLE type, if my program prints this out with a USING mask, I get garbage after the end of the number.

There are occasions where your mask must be larger than a number because a program may not know how big or small the number you are to PRINT.

This should not happen. The rest of the mask after the last digit should be all ZEROES.

The screen print shows the various values printed after the valid end of the number.

Code: QB64: [Select]

DIM result AS _FLOAT
DIM answer AS DOUBLE
DIM result2 AS SINGLE
 
 
result = 10.349449797507
answer = 10.349449797507
result2 = 10.349449797507
 
PRINT USING "The value is:  ###.#########################"; result
PRINT USING "The value is:  ###.#########################"; answer
PRINT USING "The value is:  ###.#########################"; result2

[ You are not allowed to view this attachment ]

Programs / Poem Generator

« on: May 27, 2021, 09:39:43 pm »

This is a simple poem generator, with some grammar/vocabulary rules.

There is no limit to how this program can grow.

I also attached the source, just in case you do not want the 3 or so spaces that are inserted when selecting/copying the source from the code box.

It is well commented. Have fun.

Code: QB64: [Select]

_TITLE "Poem Generator"
'*******************************************************************************
'*** Poem Generator
'*** By George McGinn - May 27, 2021
'***
'***
'*** About the AI system
'***    Since writing poems has specific rules, which can easily break grammar
'***    rules, the AI will impose just the basic grammar syntax, like adding a
'***    "an" when required, and not ending sentences with words such as
'***    "like" which happens now. They will have a special modifier tag as with
'***    the tables in use, one of them can be used to finish the sentence.
'***
'***    However, poems do not follow strict sentence structure either, and like
'***    at the end of a line, since there is no period, it may be a pause where
'***    the first words on the next continues the thought. This will be
'***    built into the modifier tag. It will also check the words ahead of it to
'***    see if they are on the modifier list for the word "like" and others like
'***    it.
'***
'***    So due to the special circumstances on meter and rhyme and even the
'***    structure of the poem, the AI system will rely heavily on rule and word
'***    tables that will provide it the words, apply modifiers, check for any
'***    grammar changes, and will have a way to keep the poem on one theme.
'***
'***    And for this system to work properly, the vocabulary must grow to
'***    proportions where each word has associated tags for use with other words
'***    to help the AI engine to keep the poem on target.
'***
'*******************************************************************************
 
 
'SCREEN 12
SCREEN _NEWIMAGE(800, 600, 32)
RANDOMIZE TIMER
OPTION BASE 1
DEFINT A-Z
 
 
'***************************************************************
'*** Initialize variables/arrays (comments to prevent confusion)
'***
x = 0 '* Index to poem length (# lines)
i = 0 '* Index to loading Arrays
 
cr$ = CHR$(10) '* Add a Carriage-Return character
 
Author$ = "By QB64 Program" '* Name of Programmer running code
 
DIM article$(35), noun$(60), verb$(46), adjective$(46)
DIM colormodifier$(28), colortable$(8), nounmodifiers$(14)
DIM connectives$(151), conective_extended$(34)
 
 
'**************************************************
'*** Load Arrays from Data Statements
'***
 
GOSUB LoadWordArrays
 
 
'**************************************************
'*** Pick a 2- to 3-word title
'***
ta$ = article$(INT(RND * 35) + 1)
b$ = LCASE$(noun$(INT(RND * 60) + 1)) '** Pick a primary noun
b1$ = LCASE$(noun$(INT(RND * 60) + 1)) '** Pick a noun-color modifier
c$ = LCASE$(verb$(INT(RND * 46) + 1)) '** Pick a primary verb
c1$ = LCASE$(verb$(INT(RND * 46) + 1)) '** Pick a verb modifier
d$ = LCASE$(adjective$(INT(RND * 46) + 1)) '** Pick an adjective
bc$ = LCASE$(colormodifier$(INT(RND * 28) + 1)) '** Pick a modifier for a color
color$ = LCASE$(colortable$(INT(RND * 8) + 1)) '** Pick a color as a modifier
nounmod$ = LCASE$(nounmodifiers$(INT(RND * 14) + 1)) '** Pick a non-color noun modifier
 
IF LEFT$(b$, 1) = "@" OR LEFT$(b1$, 1) = "@" THEN GOSUB CheckForCapitalization
IF RIGHT$(b$, 1) = "*" OR RIGHT$(b$, 1) = "+" THEN GOSUB CheckForModifierAfter
IF LEFT$(b$, 1) = "*" OR LEFT$(b$, 1) = "+" THEN GOSUB CheckForModifierBefore
tb$ = b$
 
Title$ = ta$ + " " + tb$
 
 
'**************************************************
'*** Create the poem, 16 lines in 4 4-line stanzas
'***
 
PRINT SPACE$(3) + Title$
PRINT SPACE$(3) + Author$
PRINT: PRINT
 
 
'*** NOTE: b1 & c1 placeholders for future use as modifiers, or
'***       to initially use b1 & c1 as modifiers themselves.
FOR x = 1 TO 16
    a$ = LCASE$(article$(INT(RND * 35) + 1)) '** Pick an Article
    b$ = LCASE$(noun$(INT(RND * 60) + 1)) '** Pick a primary noun
    b1$ = LCASE$(noun$(INT(RND * 60) + 1)) '** Pick a noun-color modifier
    c$ = LCASE$(verb$(INT(RND * 46) + 1)) '** Pick a primary verb
    c1$ = LCASE$(verb$(INT(RND * 46) + 1)) '** Pick a verb modifier
    d$ = LCASE$(adjective$(INT(RND * 46) + 1)) '** Pick an adjective
    bc$ = LCASE$(colormodifier$(INT(RND * 28) + 1)) '** Pick a modifier for a color
    color$ = LCASE$(colortable$(INT(RND * 8) + 1)) '** Pick a color as a modifier
    nounmod$ = LCASE$(nounmodifiers$(INT(RND * 14) + 1)) '** Pick a non-color noun modifier
 
    '*** Check for modifiers to nouns
    IF LEFT$(b$, 1) = "@" OR LEFT$(b1$, 1) = "@" OR LEFT$(bc$, 1) = "@" THEN GOSUB CheckForCapitalization
    IF LEFT$(b$, 1) = "*" OR LEFT$(b$, 1) = "+" THEN GOSUB CheckForModifierBefore
    IF RIGHT$(b$, 1) = "*" OR RIGHT$(b$, 1) = "+" THEN GOSUB CheckForModifierAfter
 
    '*** Capitalize the first word of each sentence or stanza (whether noun or verb)
    r = RND(2) + 1
    IF r = 1 THEN
        z = LEN(a$)
        a$ = UCASE$(LEFT$(a$, 1)) + RIGHT$(a$, z - 1)
        Line$ = a$ + " " + b$ + " " + c$ + " " + d$
    ELSE
        z = LEN(c$)
        c$ = UCASE$(LEFT$(c$, 1)) + RIGHT$(c$, z - 1)
        Line$ = c$ + " " + b$ + " " + d$
    END IF
    IF x MOD 4 = 0 THEN Line$ = Line$ + "." + cr$
    PRINT SPACE$(3) + Line$
NEXT x
 
 
endPROG:
'**************************************************
'*** Print Copyright and Date/Time Stamp and END
'***
 
mnth$ = LEFT$(DATE$, 2): M = VAL(mnth$)
day$ = MID$(DATE$, 4, 2): D = VAL(day$)
day$ = STR$(D) ' eliminate any leading zeros
year$ = RIGHT$(DATE$, 4): Y = VAL(year$)
 
SELECT CASE M
    CASE 1: Month$ = "January"
    CASE 2: Month$ = "February"
    CASE 3: Month$ = "March"
    CASE 4: Month$ = "April"
    CASE 5: Month$ = "May"
    CASE 6: Month$ = "June"
    CASE 7: Month$ = "July"
    CASE 8: Month$ = "August"
    CASE 9: Month$ = "September"
    CASE 10: Month$ = "October"
    CASE 11: Month$ = "November"
    CASE 12: Month$ = "December"
END SELECT
 
 
'*** Copyright Sign (Character, Unicode, UTF-8 Values
'***
 
PRINT: PRINT: PRINT SPACE$(3) + "(C)2021 " + Author$ + " (if it is good), All Rights Reserved"
PRINT SPACE$(3) + "Created " + WeekDay$(M, D, Y) + ", " + Month$ + day$ + ", " + year$ + " at " + Clock$
 
END
 
 
'***
'*** END OF MAIN PROGRAM
'*******************************************************************
 
 
'*******************************************************************
'*** FUNCTIONS/SUB ROUTINES
'***
 
 
LoadWordArrays:
'**************************************************
'*** Load Arrays from Data Statements
'***
 
'*** Load Articles
    FOR i = 1 TO 35: READ article$(i): NEXT i
 
'*** Load Nouns
    FOR i = 1 TO 60: READ noun$(i): NEXT i
 
'*** Load Verbs
    FOR i = 1 TO 46: READ verb$(i): NEXT i
 
'*** Load Adjectives
    FOR i = 1 TO 46: READ adjective$(i): NEXT i
 
'*** Load Color Modifiers
    FOR i = 1 TO 28: READ colormodifier$(i): NEXT i
 
'*** Load Color Table
    FOR i = 1 TO 7: READ colortable$(i): NEXT i
 
'*** Load Noun Modifiers
    FOR i = 1 TO 14: READ nounmodifiers$(i): NEXT i
 
'*** Load Connectives
    FOR i = 1 TO 151: READ connectives$(i): NEXT i
 
'*** Load Contective Extended
    FOR i = 1 TO 34: READ conective_extended$(i): NEXT i
 
 
RETURN
 
 
CheckForCapitalization:
'*** Check for modifiers (@=Capitalize Word)
IF LEFT$(b$, 1) = "@" THEN
    z = LEN(b$)
    b$ = RIGHT$(b$, z - 1)
    b$ = UCASE$(LEFT$(b$, 1)) + RIGHT$(b$, z - 2)
END IF
IF LEFT$(b1$, 1) = "@" THEN
    z = LEN(b1$)
    b1$ = RIGHT$(b1$, z - 1)
    b1$ = UCASE$(LEFT$(b1$, 1)) + RIGHT$(b1$, z - 2)
END IF
IF LEFT$(bc$, 1) = "@" THEN
    z = LEN(bc$)
    bc$ = RIGHT$(bc$, z - 1)
    bc$ = UCASE$(LEFT$(bc$, 1)) + RIGHT$(bc$, z - 2)
END IF
 
RETURN
 
 
CheckForModifierBefore:
'*** Check for modifiers Before
 
'*** "*" the noun needs a color before it
IF LEFT$(b$, 1) = "*" THEN
    z = LEN(b$)
    b$ = RIGHT$(b$, z - 1)
    b$ = color$ + " " + b$
END IF
 
'*** "+" the noun needs another noun to follow it (selection from noun modifier)
IF RIGHT$(b$, 1) = "+" THEN
    z = LEN(b$)
    b$ = LEFT$(b$, z - 1)
    b$ = nounmod$ + " " + b$
END IF
 
RETURN
 
 
CheckForModifierAfter:
'*** Check for modifiers after
 
'*** "*" the noun is a color and only color-friendly nouns considered
IF RIGHT$(b$, 1) = "*" THEN
    z = LEN(b$)
    b$ = LEFT$(b$, z - 1)
    b$ = b$ + " " + bc$
END IF
 
'*** "+" the noun needs another noun to follow it (selection from noun modifier)
IF RIGHT$(b$, 1) = "+" THEN
    z = LEN(b$)
    b$ = LEFT$(b$, z - 1)
    b$ = b$ + " " + nounmod$
END IF
 
RETURN
 
 
 
'**************************************************
'*** DATA Statements for Poem Generator
'***
 
'*** 35 Articles
articles:
DATA "The","All of the","Most of the","Some of the"
DATA "My","Your","His","Her","Their","Our","Everybody's","Almost all of the"
DATA "That","I knew that the","We knew that the","She knew that the","He knew that the","They knew that the","And the coming","Oh, the","A spring of","Beyond the","Within the","And the","Alone, alone,","I fear","I looked upon","A","But where the","Like","A still and","Alone","All alone, a","The moving","It is"
 
 
'*** 60 Nouns
nouns:
DATA "darkness","morning","morning+","light","feeling","feeling+","beauty","love","hatred","happiness","sadness","anger","frustration","expression","message","ship","lips","mouth","voice","garment","saint","snake","snakes","water","fire","lead","dreams","air","ghost","sails","sleep","river","cloud","@moon","@sun","waters","life","stars","the stars","lightning","beams","beams+","*beard","fool","white*","black*","green*","blue*","yellow*","red*","light beams","*river","*garment","*ship","*snake","*snakes","*sails","voice+","ship+","ocean blue"
 
 
'*** 46 Verbs (lv)
verbs:
DATA "was","had been","will be","could be","might be","should have been","would have been","could have been","drunk","drank","was heavenly","a heavy","blessed","glossy","velvet","flash","kind","coiled","swarm","swarmed","fire","pity","filled","fill","moved","wind","danced","steep","wide","steep and wide","thick","light","roar","loud","more loud","lightning","struck","fell","more horrible","horrible","awful","hit","huge","holds","long","surrounds"
 
 
'*** 46 Adjectives/adverbs
adjectives:
DATA "abstract","mysterious","permanent","unfortunate","was unfortunate"
DATA "intricate","confusing","serene","confusing"
DATA "true","false","fake","a lie","burden"
DATA "a stranger","a friend","an enemy"
DATA "terrible","enchanting","is mine","was yours","is his","is hers","was theirs","was ours"
DATA "fortunate","was understood","mine","is mutual","with an artistic flair","was musical"
DATA "golden pond","blessed","moment","unaware","no","yes","sure"
DATA "like","dreams","between","inbetween","alone","than that","interesting","glossy lake"
 
 
'*** 28 Color modifiers
colormodifiers:
DATA "morning","light","beauty","love","ship","lips","garment","knight","saint","snake","snakes","water","fire","ghost","sails"
DATA "river","cloud","@moon","@sun","waters","stars","lightning","beams","beard","velvet","flash","grass","book"
 
 
'*** 8 Color table entries
colortable:
DATA "red","yellow","blue","green","white","black","orange","purple"
 
 
'*** 14 Noun Modifier Table (Nouns, Verbs/Adverbs, Adjectives)
nounmodifier:
DATA "sunshine","light","glow","fog","of peace","of love","blue","great","unloved","sad","happy","loved","of light","of love"
 
'*** 151 Connectives
connectives:
DATA "I","the","of","and","to","a","in","that","is","was","he","for","it"
DATA "with","as","his","on","be","at","by","i","this","had","not"
DATA "are","but","from","or","have","an","they","which","one","you","were"
DATA "her","all","she","there","would","their","we","him","been","has"
DATA "when","who","will","more","no","if","out","so","said","what","u","its","about"
DATA "into","than","them","can","only","other","new","some","could","time","these"
DATA "two","may","then","do","first","any","my","now","such","like","our"
DATA "over","man","me","even","most","made","after","also","did","many","before","must"
DATA "through","back","years","where","much","your","way","well","down","should"
DATA "because","each","just","those","people","mr","how","too","little"
DATA "state","good","very","make","world","still","own","see","men","work","long"
DATA "get","here","between","both","life","being","under","never","day","same"
DATA "another","know","while","last","might","us","great","old","year","off"
DATA "come","since","against","go","came","right","used","take","three"
 
'*** 34 Extened Connectives:
connectives_extend:
DATA "whoever","nonetheless","therefore","although","consequently","furthermore"
DATA "whereas","nevertheless","whatever","however","besides","henceforward","yet"
DATA "until","alternatively","meanwhile","notwithstanding","whenever"
DATA "moreover","despite","similarly","firstly","secondly","lastly","eventually"
DATA "gradually","finally","thus","hence","accordingly","otherwise","indeed"
DATA "though","unless"
 
 
 
 
'*******************************************************************
'*** FUNCTIONS (FORMAT DATE AND TIME FIELDS)
'***
 
 
FUNCTION WeekDay$ (M, D, Y)
    IF M < 3 THEN M = M + 12: Y = Y - 1 'add 12 to Jan - Feb month, -1 year
    C = Y \ 100: Y = Y MOD 100 'split century and year number
    S1 = (C \ 4) - (2 * C) - 1 'century leap
    S2 = (5 * Y) \ 4 '4 year leap
    S3 = 26 * (M + 1) \ 10 'days in months
    WkDay = (S1 + S2 + S3 + D) MOD 7 'weekday total remainder
    IF WkDay < 0 THEN WkDay = WkDay + 7 'Adjust negative results to 0 to 6
    SELECT CASE WkDay
        CASE 0: day$ = "Sunday"
        CASE 1: day$ = "Monday"
        CASE 2: day$ = "Tuesday"
        CASE 3: day$ = "Wednesday"
        CASE 4: day$ = "Thursday"
        CASE 5: day$ = "Friday"
        CASE 6: day$ = "Saturday"
    END SELECT
    WeekDay$ = day$
END FUNCTION
 
 
FUNCTION Clock$
    hour$ = LEFT$(TIME$, 2): H% = VAL(hour$)
    min$ = MID$(TIME$, 3, 3)
    IF H% >= 12 THEN ampm$ = " pm" ELSE ampm$ = " am"
    IF H% > 12 THEN
        IF H% - 12 < 10 THEN hour$ = STR$(H% - 12) ELSE hour$ = LTRIM$(STR$(H% - 12))
    ELSEIF H% = 0 THEN hour$ = "12" ' midnight hour
    ELSE: IF H% < 10 THEN hour$ = STR$(H%) ' eliminate leading zeros
    END IF
    Clock$ = hour$ + min$ + ampm$
END FUNCTION

Pages: [1] 2

News:

Show Posts

Topics - George McGinn

QB64 Discussion / Changes To Auto Install/Run QB64 on Raspberry PI ARM Processors

Programs / Converting MIDI to WAV and MP3 (BASH Script)

Programs / Baseball/Softball Statistical Record-keeping System Pre-Release

Programs / Modified (More Challenging) Version of the Original Hamurabi Game!

InForm-based programs / EBAC Calculator

InForm-based programs / Word Search

QB64 Discussion / Possible Bug - Zombie & Orphan Process Plagues both Development & Stable Release

QB64 Discussion / INPUT from a file failing on a comma in the record

QB64 Discussion / Zombie Procecsses Getting Out of Hand

QB64 Discussion / QB64 Command Line Compiler Script

Programs / Estimated Blood Alcohol Calculator (Text-Based, All Platforms)

Programs / Estimated Blood Alcohol Calculator (LINUX/Zenity Only)

QB64 Discussion / Zenity and QB64

QB64 Discussion / PRINT USING Bug?

Programs / Poem Generator