QB64PE v4.0 is now live!!

[RhoSigma]

I am guessing from the image that you want to get the max of 3 numbers.

Code: (Select All)

maxOfThree = _IIF(a > b, _IIF(a > c, a, c), _IIF(b > c, b, c))

Less writing:

Code: (Select All)

maxOfThree = _MAX(_MAX(a, b), c)

Thanks to a740g and RhoSigma for the effort. @RhoSigma, it works!

I love this kind of thing: simple and clear!    Thanks!

Code: (Select All)

'Tenaeren Operator in QB64 ab Vers. 4.0 - 16. Dez. 2024

'Dank an a740g und RhoSigma - 17. Dez 2024



Option _Explicit



Dim As Long zahl1, zahl2, zahl3, max



Locate 3, 3

Print "Dreifach tenaerer Operator in QB64"

Locate 4, 3

Print "=================================="



Locate 6, 3

Input "Zahl 1: ", zahl1



Locate 7, 3

Input "Zahl 2: ", zahl2



Locate 8, 3

Input "Zahl 3: ", zahl3



max = _Max(_Max(zahl1, zahl2), zahl3)



Locate 10, 3

Print Using "Die groesste Zahl ist: ####"; max



End

Yes, but to be exact, that's a double _MAX function, not a triple tenary operator anymore. Although, the _MAX function uses the tenary _IIF internally, so from that point of view it makes not much differnce.

[SMcNeill]

Steve!! Your speed test for graphics quit working with qn64pe v4.0.0!

First, the error message in compilelog.txt:
------------------------------------
internal\c\c_compiler\bin\c++.exe -O2 -std=gnu++17 -fno-strict-aliasing -Wno-conversion-null -DGLEW_STATIC -DFREEGLUT_STATIC -Iinternal\c\libqb/include -Iinternal\c/parts/core/freeglut/include -Iinternal\c/parts/core/glew/include -DDEPENDENCY_NO_SOCKETS -DDEPENDENCY_NO_PRINTER -DDEPENDENCY_NO_ICON -DDEPENDENCY_NO_SCREENIMAGE internal\c/qbx.cpp -c -o internal\c/qbx.o
In file included from internal\c/qbx.cpp:1743:
internal\c/../temp/main.txt:255:90: error: arithmetic on a pointer to void
  255 | memmove(_SUB_SAVE32_STRING3_TEMP->chr,(void*)*(ptrszint*)(((char*)_SUB_SAVE32_UDT_M)+(0))+(((*_SUB_SAVE32_LONG_W**_SUB_SAVE32_LONG_Y)+*_SUB_SAVE32_LONG_X)* 4 ),3);
      |                                      ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~^
1 error generated.
mingw32-make: *** [Makefile:407: internal\c/qbx.o] Error 1
-----------------------------------------------------

Seems to me that this mingw32-make has to be modofied for the new compiler, yes?

Then your code:

Code: (Select All)

Screen _NewImage(1280, 720, 32)
Cls , _RGB32(255, 255, 0)

For i = 1 To 20
    Line (Rnd * 1280, Rnd * 720)-(Rnd * 1280, Rnd * 720), _RGB32(Rnd * 256, Rnd * 256, Rnd * 256), BF
Next


t# = Timer
Save32 0, 0, 1279, 719, 0, "temp.bmp"
t1# = Timer
ThirtyTwoBit 0, 0, 1279, 719, 0, "temp2.bmp"
t2# = Timer
Print Using "###.### seconds with Save32"; t1# - t#
Print Using "###.### seconds with ThirtyTwoBit"; t2# - t1#
'KILL "temp.bmp"
'KILL "temp2.bmp"


Sub Save32 (x1%, y1%, x2%, y2%, image&, Filename$)
    'Super special STEVE-Approved BMP Export routine for use with 32-bit color images.


    Type BMPFormat ' Description                          Bytes    QB64 Function
        ID As String * 2 ' File ID("BM" text or 19778 AS Integer) 2      CVI("BM")
        Size As Long ' Total Size of the file                4      LOF
        Blank As Long ' Reserved                              4
        Offset As Long ' Start offset of image pixel data      4      (add one for GET)
        Hsize As Long ' Info header size (always 40)          4
        PWidth As Long ' Image width                            4      _WIDTH(handle&)
        PDepth As Long ' Image height (doubled in icons)        4      _HEIGHT(handle&)
        Planes As Integer ' Number of planes (normally 1)          2
        BPP As Integer ' Bits per pixel(palette 1, 4, 8, 24)    2      _PIXELSIZE(handle&)
        Compression As Long ' Compression type(normally 0)          4
        ImageBytes As Long ' (Width + padder) * Height              4
        Xres As Long ' Width in PELS per metre(normally 0)    4
        Yres As Long ' Depth in PELS per metre(normally 0)    4
        NumColors As Long ' Number of Colors(normally 0)          4      2 ^ BPP
        SigColors As Long ' Significant Colors(normally 0)        4
    End Type '                Total Header bytes =  54

    Dim BMP As BMPFormat
    Dim x As Long, y As Long
    Dim temp As String * 3
    Dim m As _MEM, n As _MEM
    Dim o As _Offset
    m = _MemImage(image&)
    Dim Colors8%(255)

    If x1% > x2% Then Swap x1%, x2%
    If y1% > y2% Then Swap y1%, y2%
    _Source image&
    pixelbytes& = 4
    OffsetBITS& = 54 'no palette in 24/32 bit
    BPP% = 24
    NumColors& = 0 '24/32 bit say zero
    BMP.PWidth = (x2% - x1%) + 1
    BMP.PDepth = (y2% - y1%) + 1

    ImageSize& = BMP.PWidth * BMP.PDepth

    BMP.ID = "BM"
    BMP.Size = ImageSize& * 3 + 54
    BMP.Blank = 0
    BMP.Offset = 54
    BMP.Hsize = 40
    BMP.Planes = 1
    BMP.BPP = 24
    BMP.Compression = 0
    BMP.ImageBytes = ImageSize&
    BMP.Xres = 3780
    BMP.Yres = 3780
    BMP.NumColors = 0
    BMP.SigColors = 0

    Compression& = 0
    WidthPELS& = 3780
    DepthPELS& = 3780
    SigColors& = 0
    f = FreeFile
    n = _MemNew(BMP.Size)
    _MemPut n, n.OFFSET, BMP
    o = n.OFFSET + 54

    $Checking:Off
    y = y2% + 1
    w& = _Width(image&)
    Do
        y = y - 1: x = x1% - 1
        Do
            x = x + 1
            _MemGet m, m.OFFSET + (w& * y + x) * 4, temp
            _MemPut n, o, temp
            o = o + 3
        Loop Until x = x2%
    Loop Until y = y1%
    $Checking:On
    _MemFree m
    Open Filename$ For Binary As #f
    t$ = Space$(BMP.Size)
    _MemGet n, n.OFFSET, t$
    Put #f, , t$
    _MemFree n
    Close #f
End Sub


Sub ThirtyTwoBit (x1%, y1%, x2%, y2%, image&, Filename$)
    Dim Colors8%(255)
    If x1% > x2% Then Swap x1%, x2%
    If y1% > y2% Then Swap y1%, y2%
    _Source image&
    pixelbytes& = _PixelSize(image&)
    If pixelbytes& = 0 Then Beep: Exit Sub 'no text screens

    FileType$ = "BM"
    QB64$ = "QB64" 'free advertiising in reserved bytes
    If pixelbytes& = 1 Then OffsetBITS& = 1078 Else OffsetBITS& = 54 'no palette in 24/32 bit
    InfoHEADER& = 40
    PictureWidth& = (x2% - x1%) + 1
    PictureDepth& = (y2% - y1%) + 1
    NumPLANES% = 1
    If pixelbytes& = 1 Then BPP% = 8 Else BPP% = 24
    Compression& = 0
    WidthPELS& = 3780
    DepthPELS& = 3780

    If pixelbytes& = 1 Then 'byte padder prevents image skewing
        NumColors& = 256 'set 256 colors even if they are not used by the screen mode
        If (PictureWidth& Mod 4) Then ZeroPad$ = Space$(4 - (PictureWidth& Mod 4))
    Else '24/32 bit images use 3 bytes for RGB pixel values
        NumColors& = 0 '24/32 bit say zero
        If ((PictureWidth& * 3) Mod 4) Then ZeroPad$ = Space$((4 - ((PictureWidth& * 3) Mod 4)))
    End If

    ImageSize& = (PictureWidth& + Len(ZeroPad$)) * PictureDepth&
    FileSize& = ImageSize& + OffsetBITS&
    f = FreeFile
    Open Filename$ For Binary As #f

    Put #f, , FileType$
    Put #f, , FileSize&
    Put #f, , QB64$
    Put #f, , OffsetBITS&
    Put #f, , InfoHEADER&
    Put #f, , PictureWidth&
    Put #f, , PictureDepth&
    Put #f, , NumPLANES%
    Put #f, , BPP%
    Put #f, , Compression&
    Put #f, , ImageSize&
    Put #f, , WidthPELS&
    Put #f, , DepthPELS&
    Put #f, , NumColors&
    Put #f, , SigColors& '51 offset

    If pixelbytes& = 1 Then '4 or 8 BPP use 256 color Palette
        u$ = Chr$(0)
        For c& = 0 To 255 'PUT as BGR order colors
            cv& = _PaletteColor(c&, image&)
            Colr$ = Chr$(_Blue32(cv&))
            Put #f, , Colr$
            Colr$ = Chr$(_Green32(cv&))
            Put #f, , Colr$
            Colr$ = Chr$(_Red32(cv&))
            Put #f, , Colr$
            Put #f, , u$ 'Unused byte
        Next
    End If

    For y% = y2% To y1% Step -1 'place bottom up
        For x% = x1% To x2%
            c& = Point(x%, y%)
            If pixelbytes& = 1 Then
                a$ = Chr$(c&)
                Colors8%(c&) = 1
            Else: a$ = Left$(MKL$(c&), 3)
            End If
            Put #f, , a$
        Next
        Put #f, , ZeroPad$
    Next

    For n = 0 To 255
        If Colors8%(n) = 1 Then SigColors& = SigColors& + 1
    Next n
    Put #f, 51, SigColors&
    Close #f
End Sub

Yep.  You found a glitch that we overlooked when swapping out to the new compiler.  (The issue is that _memput has two different behaviors for when $Checking is on or off...  we just apparently overlooked the $Checking:Off output here and didn't update to the proper changes that we need to.)

Two quick fixes for this:

1) Turn $CHECKING:OFF... well, off.   Just remark out that line and recompile and it should work without any issues.

2) That that middle argument and encase it in parenthesis, like so on line 92:

Code: (Select All)

            _MemGet m, (m.OFFSET + (w& * y + x) * 4), temp

Both *fixes* will allow you to temporarily bypass the glitch, and we'll fix the problem and push it into the next release so it won't be an issue in the future.

Thanks for finding and pointing this out to us! We're only human, and when things get separated and broke into different segments and such like this has, it's easy to just overlook a simple change and then miss it when testing for it. Good news is the dev team is now on it and should have it patched up ASAP and fixed before long.

[bert22306]

Thanks, dev guys! And, technically it was your program that found the glitch, Steve.