The V4 "Look Ma" showcase

[Dare2]

PureBasic four has heaps of new stuff, and I am sure we will all overlook some things.

So if you have any small snippets of code that use one of the new features (or improved approaches), post it here.

[Dare2]

To kick off, a silly with:
.. Macro
.. Default/optional parameter values (poor example)
.. Swap
.. Not
.. Colouring in

Code: Select all

; PureBasic 4 - Hey Ma, look what I can do!
; Showing:

Enumeration    ; WINDOWS
  #_winMain
EndEnumeration
Enumeration    ; GADGETS
  #_gTxtLookAtMe
  #_gBtnToggleWindow
  #_gBtnToggleText
EndEnumeration

; Macro to set all PureBasic colour properties for gadget
Macro colorGadget(gadgetNum, backColor=$FFFFFF, foreColor=0, lineColor=0)
  If IsGadget(gadgetNum)
    SetGadgetColor(gadgetNum,#PB_Gadget_BackColor,backColor)
    SetGadgetColor(gadgetNum,#PB_Gadget_FrontColor,foreColor)
    SetGadgetColor(gadgetNum,#PB_Gadget_LineColor,lineColor)
  EndIf
EndMacro
; Procedure to do same as Macro.
Procedure gadgetColoring(gadgetNum, backColor=$FFFFFF, foreColor=0, lineColor=0)
  If IsGadget(gadgetNum)
    SetGadgetColor(gadgetNum,#PB_Gadget_BackColor,backColor)
    SetGadgetColor(gadgetNum,#PB_Gadget_FrontColor,foreColor)
    SetGadgetColor(gadgetNum,#PB_Gadget_LineColor,lineColor)
  EndIf
EndProcedure

windowBG_now.l   = RGB($FF,$FF,$E0)
windowBG_later.l = RGB($E0,$F0,$FF)

textBG_now.l = RGB($FF,$00,$00)
textFG_now.l = RGB($FF,$FF,$00)
textBG_later.l = RGB($FF,$FF,$00)
textFG_later.l = RGB($FF,$00,$00)

; Let's Not and say we did!
If Not OpenWindow(#_winMain, 0,0, 200,200, #PB_Window_Invisible|#PB_Window_SystemMenu|#PB_Window_ScreenCentered,"Hey Ma!")
  MessageRequester("ERROR", "Could not open the main window. :(", #MB_ICONERROR)
  End
EndIf
If Not CreateGadgetList(WindowID(#_winmain)) 
  MessageRequester("ERROR", "Could not create gadget list. :(", #MB_ICONERROR)
  CloseWindow(#_winMain)
  End
EndIf

; Colouring in.
SetWindowColor(#_winMain,windowBG_now)

TextGadget(#_gTxtLookAtMe, 5,20, 190,18, "L O O K   A T   M E",#PB_Text_Center)
colorGadget(#_gTxtLookAtMe, textBG_now, textFG_now)    ; Macro used, 2 of 3 parameters
ButtonGadget(#_gBtnToggleText, 50,60, 100,20, "TOGGLE TEXT")
ButtonGadget(#_gBtnToggleWindow, 50,100, 100,20, "TOGGLE WINDOW")

HideWindow(#_winMain,#False) 

Repeat 
  EventID.l=WaitWindowEvent() 
  If EventID=#PB_Event_CloseWindow 
    Quit = 1 
  ElseIf EventID=#PB_Event_Gadget 
    Select EventGadget()                                      ; Whup! No longer has ID suffix
    Case #_gBtnToggleText
      Swap textBG_now, textBG_later                           ; Swap!
      Swap textFG_now, textFG_later
      GadgetColoring(#_gTxtLookAtMe, textBG_now, textFG_now)  ; Proc, no third param
    Case #_gBtnToggleWindow
      Swap windowBG_now, windowBG_later                       ; Swap!
      SetWindowColor(#_winMain,windowBG_now)
    EndSelect
  EndIf
Until Quit = 1 

CloseWindow(#_winMain)
End

[ts-soft]

a DLL-Wrapper, not finished ("AutoItX3.dll")
http://www.autoitscript.com/autoit3/

Prototypes, Macros ...

Code: Select all

EnableExplicit

#AU3_INTDEFAULT = -2147483647
#AU3_MEMBuffer = 65536

Macro AU3_LL(a, b, c, d); LoadLibrary
  If d
    c = a#M(d)
  Else
    If b
      c = a#_(b)
    Else
      c = a#_("AutoItX3.dll")
    EndIf
  EndIf
EndMacro

Macro AU3_FL(a,b,c); FreeLibrary
  If c
    a#M(b)
  Else
    a#_(b)
  EndIf
EndMacro

Macro AU3_GPA(a, b, c, d, e); GetProcAddress
  If e
    d = a#M(b, c)
  Else
    d = a#_(b, c)
  EndIf 
EndMacro

;{ Prototypes
Prototype.l AU3_error()
Prototype.l AU3_AutoItSetOption(szOption.s, nValue.l)
Prototype   AU3_BlockInput(nFlag.l)
Prototype   AU3_CDTray(szDrive.s, szAction.s)
Prototype   AU3_ClipGet_(szClip.l, nBufSize.l)
;}

;{ Globale Variablen
Global AU3_error.AU3_error
Global AU3_AutoItSetOption.AU3_AutoItSetOption
Global AU3_BlockInput.AU3_BlockInput
Global AU3_CDTray.AU3_CDTray
;}

Procedure.s AU3_ClipGet()
  Protected AU3_ClipGet_.AU3_ClipGet_
  Shared AU3_DLLhWnd.l, AU3_LoadFromMemory.l, AU3_Membuffer.l
  AU3_GPA(GetProcAddress, AU3_DLLhWnd, "AU3_ClipGet", AU3_ClipGet_, AU3_LoadFromMemory)
  AU3_ClipGet_(AU3_MEMBuffer, #AU3_MEMBuffer)
  ProcedureReturn PeekS(AU3_MEMBuffer)
EndProcedure

Procedure AU3_Init(DLLname.s = "", DLLMempointer.l = 0)
  Shared AU3_DLLhWnd.l, AU3_LoadFromMemory.l, AU3_Membuffer.l
  If DLLMempointer
    AU3_LoadFromMemory = #True
  EndIf
  AU3_LL(LoadLibrary, DLLname, AU3_DLLhWnd, DLLMempointer)
  If AU3_DLLhWnd
    AU3_GPA(GetProcAddress, AU3_DLLhWnd, "AU3_error", AU3_error, AU3_LoadFromMemory)
    AU3_GPA(GetProcAddress, AU3_DLLhWnd, "AU3_AutoItSetOption", AU3_AutoItSetOption, AU3_LoadFromMemory)
    AU3_GPA(GetProcAddress, AU3_DLLhWnd, "AU3_BlockInput", AU3_BlockInput, AU3_LoadFromMemory)
    AU3_GPA(GetProcAddress, AU3_DLLhWnd, "AU3_CDTray", AU3_CDTray, AU3_LoadFromMemory)
    AU3_Membuffer = AllocateMemory(#AU3_MEMBuffer)
    If Not AU3_Membuffer
      ProcedureReturn #False
    EndIf
  EndIf
  ProcedureReturn AU3_DLLhWnd
EndProcedure

Procedure AU3_End()
  Shared AU3_DLLhWnd.l, AU3_LoadFromMemory.l, AU3_Membuffer.l
  If AU3_DLLhWnd
    AU3_FL(FreeLibrary,AU3_DLLhWnd, AU3_LoadFromMemory)
    FreeMemory(AU3_Membuffer)
  EndIf  
EndProcedure

If AU3_Init()
  Debug AU3_ClipGet()
  AU3_CDTray("s:","open")
  AU3_End()
EndIf
; DataSection
;   DLL: IncludeBinary "AutoItX3.dll"
; EndDataSection

for including DLL, you can use "PBOSL_LoadDllMemory" in PB4

[Dare2]

Macro magic.

Macros can be used to add readability and perhaps save typing without the slight speed hit of a procedure.

They are resolved before compilation, and replace the macro "call" in situ:

Code: Select all

; Two Macros defined

Macro uWord(valu)            ; This will be used to change any "uWord" found in code
  (valu & $FFFF)             ;   The text "value" is replaced by the parameter provided
EndMacro

Macro uByte(valu = $80)      ; This will be used to change any "uByte" found in code
  (valu & $FF)               ;   The text "value" is replaced by the parameter provided
EndMacro                     ;   If no parameter is provided, default $80 (128 or -1) is used

;Test data

myByte.b = -1
myWord.w = $8000

Debug "------- BYTE"
Debug myByte
Debug uByte(myByte)          ; Before compiling, resolved to: Debug (myByte & $FF)
Debug uByte(PeekB(@myByte))  ; Before compiling, resolved to: Debug (PeekB(@myByte) & $FF)

Debug "------- WORD"
Debug myWord
Debug uWord(myWord)
Debug uWord(PeekW(@myWord))

Debug "------- BYTE, option parameter used"
Debug uByte()                ; Before compiling, resolved to: Debug ($80 & $FF)
Debug ($80 & $FF)

[Dare2]

Modded the rtf editor. (It is still a pretty ugly and raw example, but now it is PureBasic v4.00 compatible ugly and raw)

http://www.tabturn.com/pbOddments/dare2RTF.zip

SmartWindowRefresh(#window, #True) makes a heap of difference (flicker free) on my setup

[Fred]

SmartWindowRefresh(#window, #True) makes a heap of difference (flicker free) on my setup

Here too, there is no more flickering .

[Dare2]

So it works on your system! You going to throw away notepad now? hehe. (I wouldn't).

This is also neat!

One of the bigger headaches for me with larger projects and common "across-project" include files is organisational, to avoid duplicate definitions, and etc.

The CompilerIf Defined(name,type) sorts out heaps of these problems!

Just to see it in action - this is an include file. Save as "inc_CompilerIfTest.pb" (or rename the include in the main prog to whatever you called this).

Code: Select all

; In case the parent program has defined these before including this file

CompilerIf Defined(myStructure, #PB_Structure) = #False

  Structure myStructure 
    myWord.w
    myLong.l
  EndStructure

CompilerEndIf

; Note. The #_filler_group constant is used here just so that I don't
; have to do a CompilerIf Defined for every single one of a related
; group of constants. Could have as easily used the first, I guess.

CompilerIf Defined(_filler_group, #PB_Constant) = #False

  #_filler_group = 0
  
  #_filler_byte = $FF
  #_filler_word = $FFFF
  #_filler_long = $FFFFFFFF

CompilerEndIf


Procedure FillItUp(*ItIs.myStructure)
  *ItIs\myWord = #_filler_word
  *ItIs\myLong = #_filler_long
EndProcedure

This is the main program.

Code: Select all

; In case any included file has defined these
;  And yes, there are no prior includes, but let us pretend there are. :)

CompilerIf Defined(myStructure, #PB_Structure) = #False

  Structure myStructure 
    myWord.w
    myLong.l
  EndStructure

CompilerEndIf

XIncludeFile "inc_compilerIfTest.pb"

; Just to prove it, do it this side of the include

CompilerIf Defined(_filler_group, #PB_Constant) = #False

  #_filler_group = 0
  
  #_filler_byte = $FF
  #_filler_word = $FFFF
  #_filler_long = $FFFFFFFF

CompilerEndIf

ThisIs.myStructure

FillItUp(@ThisIs)

Debug ThisIs\myWord
Debug ThisIs\myLong

This is so cool!

This alone is going to speed up things for me no end. Hope this is useful for someone else as well!

[remi_meier]

Threads and mutex (I hope it's correct!). Just compile with /THREADSAFE
and it should work without problems (perhaps also without)!

Code: Select all

enableexplicit

Global Dim names.s(3)
Global NewList queue.s()
Global counter.l, mutex.l
names(0) = "peter"
names(1) = "hans"
names(2) = "franz"
names(3) = "juuli"
mutex = CreateMutex()


Procedure thread(index.l)
  Protected name.s, z.l
  name = names(index)
  
  z = 0
  Repeat
    
    LockMutex(mutex)
      counter + 1
      AddElement(queue())
      queue() = name
    UnlockMutex(mutex)
    Delay(Random(500) + 200)
    
    z + 1
  Until z = 20
EndProcedure


Define.l t
t = CreateThread(@thread(), 0)
t = CreateThread(@thread(), 1)
t = CreateThread(@thread(), 2)
t = CreateThread(@thread(), 3)


Repeat
  LockMutex(mutex)
    ForEach queue()
      Debug queue()
      DeleteElement(queue())
    Next
  UnlockMutex(mutex)
  
  Delay(50)
Until counter = 80

FreeMutex(mutex)

[NoahPhense]

Nice threading..

I guess you don't need to use WaitThread(.. in there eh?

- np

[Dare2]

Importing - using 3rd party libs and object files, is too easy!

( I can say that now, after traumatic took a second out from ironing to explain a small fact Thanks, traumatic!)

This zip contains a "SillyStringThing.obj" and "SillyStringThing.asm", the latter being the source in Masm.

http://www.tabturn.com/pbOddments/sillystringthing.zip

Use it as shown in this code:

Code: Select all

Import "Full\Path\To\SillyStringThing.obj"

  StringToLower.l(ptrStr.l) As "_sillyString2Lower@4"   ; your alias As real name

  StringToUpper.l(ptrStr.l) As "_sillyString2Upper@4"   ; Note the @4 advising 4 bytes of params
                                                        ; In this case 1xLong (the string address) = 4 bytes
EndImport 

w.s="aBC123DEf"
Debug w
r = StringToLower(@w)   ; Note the @w, to pass the address!
Debug w
r = StringToUpper(@w)   ; Return value is junk, just the string address back.
Debug w

Fred advised me this:

BTW, 'Import' uses the STDCALL convention, so an PB_Test(a.l) def will be converted to _PB_Test@4 if 'As' isn't specified.

'ImportC' uses the C convention and will be converted to _PB_Test (and the compiler will automatically adjust the stack on return.

Finally - use at your own risk!

[traumatic]

[...] after traumatic took a second out from ironing[...]

*grrrr*

You're welcome

[Fangbeast]

[...] after traumatic took a second out from ironing[...]

*grrrr*

You're welcome

Damnit Traumatic, you missed my socks again!!!