Page 1 of 1

CanvasGadget example

Posted: Mon Jun 27, 2011 7:33 pm
by Demivec
Code updated for 5.20+

This is an example CanvasGadget that I wrote up for a task on RosettaCode. Even though the need for a gadget like this is contrived for the RosettaCode task I thought it would also make a useful example here.

It is designed to meet the task as it was specified on RosettaCode but it contains elements which can easily modified and adapted to one's own needs.

First, the task involved creating a honeycomb of smaller hex gadgets (each with a random unique letter) that reacted to both mouseclicks and key presses. The hex region changed color and a message was displayed reporting the selection. A hex region could only be selected, and not unselected. After five selections the program ends. I modified the task to allow nine selections, which is enough to select the letters in PureBasic (if all are present). :wink:

Useful things that the program code demonstrates include: defining polygon regions within a gadget and detecting mouse interactions within a region, detecting keyclicks for a canvas gadget and acting on them and drawing to a CanvasGadget. It also demonstrates prototypes.

Some comments on the polygon regions is in order. The polygon regions are defined according to their vertexes. An alternative method for defining regions by pixel color is provided by netmaestro's excellent CustomRegions.pbi. One significant difference between the two is the amount of memory required to define the regions. To define the honeycomb regions with the CustomRegions.pbi would require about 54275 bytes (2171 bytes for each hex region) whereas defining the regions using the polygon method requires 1200 bytes (24 bytes for each hex region). There is also a difference in speed, CustomRegions.pbi is faster, though the difference may be insignificant based on the number and the complexity of the regions. Both methods are useful and should be evaluated based on the regions needed. They can even be intermixed.

I hope this is useful to someone...

Code: Select all

Macro PS(a)
  #PB_Shortcut_#a
EndMacro

DataSection
  keyAlphaArray:
  Data.i ps(a), ps(b), ps(c), ps(d), ps(e), ps(f), ps(g), ps(h), ps(i), ps(j), ps(k), ps(l), ps(m)
  Data.i ps(n), ps(o), ps(p), ps(q), ps(r), ps(s), ps(t), ps(u), ps(v), ps(w), ps(x), ps(y), ps(z)
EndDataSection

Structure integerArray
  i.i[0]
EndStructure

Structure hexGadget
  text.s
  Status.i     ;nonselected = 0, selected = 1
  center.POINT ;location of hex's center
  List shape.POINT()
EndStructure

Structure honeycomb
  gadgetID.i
  margins.POINT
  unusedLetters.s
  chosen.s
  maxLength.i
  Array hexGadgets.hexGadget(0)
  textY.i
  fontID.i
EndStructure

Prototype hexEvent_prt(*h.honeycomb, hexID)
Global *keyAlphaArray.integerArray = ?keyalphaarray

Procedure inpoly(*p.POINT, List poly.POINT())
  ;returns 1 if point is inside the polygon defined by poly(), otherwise returns 0
  Protected new.POINT, old.POINT, lp.POINT, rp.POINT, i, inside, *poly
  If ListSize(poly()) < 3: ProcedureReturn 0: EndIf 
  LastElement(poly()): old = poly()
  ForEach poly()
    ;find leftmost endpoint 'lp' and the rightmost endpoint 'rp' based on x value
    If poly()\x > old\x 
      lp = old
      rp = poly()
    Else
      lp = poly()
      rp = old
    EndIf 
    If lp\x < *p\x And *p\x <= rp\x And (*p\y - lp\y) * (rp\x - lp\x) < (rp\y - lp\y) * (*p\x - lp\x)
      inside = ~inside
    EndIf 
    old = poly()
  Next 
  ProcedureReturn inside & 1
EndProcedure

;draw a hex Gadget by number
Procedure drawhex(*h.honeycomb, hexID)
  With *h\hexGadgets(hexID)
    Protected p.POINT
    If LastElement(\shape())
      p = \shape()
    EndIf 
    ForEach \shape()
      LineXY(p\x, p\y, \shape()\x, \shape()\y, RGB(0, 0, 0)) ;black
      p = \shape()
    Next 
    DrawingMode(#PB_2DDrawing_Transparent)
    DrawingFont(FontID(*h\fontID))
    If \Status
      FillArea(\center\x + 1, \center\y + 1, RGB(0, 0, 0), RGB($FF, 0, $FF))    ;magenta
      DrawText(\center\x - TextWidth(\text) / 2, \center\y - TextHeight(\text) / 2, \text, RGB(0, 0, 1)) ;black, almost
    Else
      FillArea(\center\x + 1, \center\y + 1, RGB(0, 0, 0), RGB($FF, $FF, 0)) ;yellow
      DrawText(\center\x - TextWidth(\text) / 2, \center\y - TextHeight(\text) / 2, \text, RGB($FF, 0, 0)) ;red
    EndIf 
  EndWith
EndProcedure

Procedure selectHex(*h.honeycomb, hexID)
  If Not *h\hexGadgets(hexID)\Status
    *h\chosen + *h\hexGadgets(hexID)\text
    *h\hexGadgets(hexID)\Status = 1
    StartDrawing(CanvasOutput(*h\gadgetID))
      drawhex(*h, hexID)
      DrawingMode(#PB_2DDrawing_Default)
      DrawingFont(#PB_Default)
      DrawText(0, *h\textY, "Chosen: " + *h\chosen)
      DrawText(0, *h\textY + 20, "The user chose letter " + *h\hexGadgets(hexID)\text + ".  ")
    StopDrawing()
    ProcedureReturn 1
  EndIf 
EndProcedure

Procedure hexKey(*h.honeycomb, hexID)
  Protected key = GetGadgetAttribute(*h\gadgetID, #PB_Canvas_Key)
  If key = *keyAlphaArray\i[Asc(*h\hexGadgets(hexID)\text) - 65]
    ProcedureReturn selectHex(*h, hexID)
  EndIf
EndProcedure

Procedure hexMouse(*h.honeycomb, hexID)
  Protected mPos.POINT
  mPos\x = GetGadgetAttribute(*h\gadgetID, #PB_Canvas_MouseX)
  mPos\y = GetGadgetAttribute(*h\gadgetID, #PB_Canvas_MouseY)
  If inpoly(mPos,*h\hexGadgets(hexID)\shape())
    ProcedureReturn selectHex(*h, hexID)
  EndIf 
EndProcedure

Procedure honeycombEvents(*h.honeycomb)
  If Len(*h\chosen) >= *h\maxLength: ProcedureReturn: EndIf
  
  Protected event = EventType(), *eventFunction.hexEvent_prt
  Select event
    Case #PB_EventType_KeyDown
      *eventFunction = @hexKey()
    Case #PB_EventType_LeftButtonUp
      *eventFunction = @hexMouse()
    Case #PB_EventType_LostFocus
      SetActiveGadget(*h\gadgetID)
  EndSelect
  
  If *eventFunction
    For hexID = 0 To ArraySize(*h\hexGadgets())
      If *eventFunction(*h, hexID)
        Break ;event successfully handled
      EndIf 
    Next 
  EndIf 
EndProcedure

Procedure createHexGadget(*h.honeycomb, hexID, x, y, dx, dy)
  With *h\hexGadgets(hexID)
    If *h\unusedLetters
      Protected letterNum = Random(Len(*h\unusedLetters) - 1) + 1
      \text = Mid(*h\unusedLetters, letterNum, 1)
      *h\unusedLetters = ReplaceString(*h\unusedLetters, \text, "")
    EndIf 
    \center\x = x: \center\y = y
    AddElement(\shape()): \shape()\x = x - dx:     \shape()\y = y
    AddElement(\shape()): \shape()\x = x - dx / 2: \shape()\y = y + dy
    AddElement(\shape()): \shape()\x = x + dx / 2: \shape()\y = y + dy
    AddElement(\shape()): \shape()\x = x + dx:     \shape()\y = y
    AddElement(\shape()): \shape()\x = x + dx / 2: \shape()\y = y - dy
    AddElement(\shape()): \shape()\x = x - dx / 2: \shape()\y = y - dy 
  EndWith
EndProcedure

Procedure initHoneycomb(*h.honeycomb, posX, posY, dx = 30, dy = 25, marginX = 10, marginY = 5)
  Protected i, sx, sy, hCols = 5, hRows = 5, hexGadgetCount = hCols * hRows - 1
  If Not *h: ProcedureReturn 0: EndIf
  
  *h\unusedLetters.s = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"    
  *h\chosen = ""
  *h\maxLength = 9
  
  Dim *h\hexGadgets(hexGadgetCount)
  ;calculate size width, height and create honeycomb with margins
  sx = Round(dx * (0.5 + hCols * 1.5), #PB_Round_Nearest) + 1 + 2 * marginX
  sy = dy * (2 * hRows + 1) + 1 + 2 * marginY + 2 * 20 ;includes room for hex, margins, and text
  *h\textY = sy - 2 * 20
  
  ;create hexes
  Protected hexID, column, row, x, y, baseX, baseY, majorOffsetY = dy
  baseX = dx + marginX
  For column = 0 To hCols - 1
    baseY = dy + marginY
    majorOffsetY ! dy
    For row = 0 To hRows - 1
      x = baseX
      y = baseY + majorOffsetY
      createHexGadget(*h, hexID, x, y, dx, dy)
      baseY + dy * 2
      hexID + 1
    Next 
    baseX + dx * 1.5
  Next 
  
  ;draw honeycomb
  *h\gadgetID = CanvasGadget(#PB_Any, posX, posY, sx, sy, #PB_Canvas_Keyboard | #PB_Canvas_ClipMouse)
  If *h\gadgetID = 0: ProcedureReturn 0: EndIf ;failed to created honeycomb

  *h\fontID = LoadFont(#PB_Any, "Arial", 24, #PB_Font_Bold)
  StartDrawing(CanvasOutput(*h\gadgetID))
    For i = 0 To ArraySize(*h\hexGadgets())
      drawhex(*h, i)
    Next 
    Box(0, *h\textY, sx, 40, RGB(0, 0, 0)) ;draw black text box
  StopDrawing()
  ProcedureReturn 1
EndProcedure

If OpenWindow(0, 0, 0, 400, 400, "PureBasic - Honeycombs", #PB_Window_SystemMenu)
  Define honeycomb.honeycomb, quit
  If Not initHoneycomb(honeycomb, 0, 0): End: EndIf
  ResizeWindow(0, #PB_Ignore, #PB_Ignore, GadgetWidth(honeycomb\gadgetID), GadgetHeight(honeycomb\gadgetID))
  SetActiveGadget(honeycomb\gadgetID)

  Repeat
    event = WaitWindowEvent()

    Select event
      Case #PB_Event_Gadget
        If EventGadget() = honeycomb\gadgetID
          honeycombEvents(honeycomb)
          If Len(honeycomb\chosen) = honeycomb\maxLength
            MessageRequester("Exit", "You chose: " + honeycomb\chosen + ".")
            quit = 1
          EndIf 
        EndIf
      Case #PB_Event_CloseWindow
        quit = 1
    EndSelect
    
  Until quit = 1
EndIf
@Edit: Make a correction in the comment regarding memory needed for the CustomRegions.pbi, revising the memory estimate significantly downward.

Re: CanvasGadget example

Posted: Tue Jun 28, 2011 2:21 am
by Tomi
Very nice Demivec, Thanks :D

Re: CanvasGadget example

Posted: Tue Jun 28, 2011 3:57 am
by rsts
Good one. Cool 8)

Thanks for posting.

cheers

Re: CanvasGadget example

Posted: Tue Jun 28, 2011 9:38 am
by Kwai chang caine
Nice !!
Thanks 8)

Re: CanvasGadget example

Posted: Tue Jun 28, 2011 2:57 pm
by TomS
Nice.
Thanks for sharing!

Re: CanvasGadget example

Posted: Thu Sep 01, 2011 6:46 pm
by Demivec
Code updated for 5.20+

Here is an updated version of the original code in the first post that implements the new canvas gadget attribute #Canvas_Input to get the key pressed (available as of v4.60b4).

It's also little shorter. :wink:

Code: Select all

Structure hexGadget
  text.s
  Status.i     ;nonselected = 0, selected = 1
  center.POINT ;location of hex's center
  List shape.POINT()
EndStructure

Structure honeycomb
  gadgetID.i
  margins.POINT
  unusedLetters.s
  chosen.s
  maxLength.i
  Array hexGadgets.hexGadget(0)
  textY.i
  fontID.i
EndStructure

Prototype hexEvent_prt(*h.honeycomb, hexID)

Procedure ThickLineXY(x1.i, y1.i, x2.i, y2.i, Thickness.i, Color.i) 
  Protected length.i = Sqr((x2-x1)*(x2-x1)+(y2-y1)*(y2-y1)) 
  Protected i, DeltaX.i, DeltaY.i 
  If length = 0 
    Circle(x1, y1, Thickness/2, Color) 
  Else 
    For i = 0 To length 
      DeltaX = (x2-x1)*i/length 
      DeltaY = (y2-y1)*i/length 
      Circle(x1+DeltaX, y1+DeltaY, Thickness/2, Color) 
    Next 
  EndIf
EndProcedure

Procedure inpoly(*p.POINT, List poly.POINT())
  ;returns 1 if point is inside the polygon defined by poly(), otherwise returns 0
  Protected new.POINT, old.POINT, lp.POINT, rp.POINT, i, inside, *poly
  If ListSize(poly()) < 3: ProcedureReturn 0: EndIf 
  LastElement(poly()): old = poly()
  ForEach poly()
    ;find leftmost endpoint 'lp' and the rightmost endpoint 'rp' based on x value
    If poly()\x > old\x 
      lp = old
      rp = poly()
    Else
      lp = poly()
      rp = old
    EndIf 
    If lp\x < *p\x And *p\x <= rp\x And (*p\y - lp\y) * (rp\x - lp\x) < (rp\y - lp\y) * (*p\x - lp\x)
      inside = ~inside
    EndIf 
    old = poly()
  Next 
  ProcedureReturn inside & 1
EndProcedure

;draw a hex Gadget by number
Procedure drawhex(*h.honeycomb, hexID)
  With *h\hexGadgets(hexID)
    Protected p.POINT
    If LastElement(\shape())
      p = \shape()
    EndIf 
    ForEach \shape()
      ;LineXY(p\x, p\y, \shape()\x, \shape()\y, RGB(0, 0, 0)) ;black
      ThickLineXY(p\x, p\y, \shape()\x, \shape()\y, 3, RGB(0, 0, 0)) 
      p = \shape()
    Next 
    DrawingMode(#PB_2DDrawing_Transparent)
    DrawingFont(FontID(*h\fontID))
    If \Status
      FillArea(\center\x + 1, \center\y + 1, RGB(0, 0, 0), RGB($FF, 0, $FF))    ;magenta
      DrawText(\center\x - TextWidth(\text) / 2, \center\y - TextHeight(\text) / 2, \text, RGB(0, 0, 1)) ;black, almost
    Else
      FillArea(\center\x + 1, \center\y + 1, RGB(0, 0, 0), RGB($FF, $FF, 0)) ;yellow
      DrawText(\center\x - TextWidth(\text) / 2, \center\y - TextHeight(\text) / 2, \text, RGB($FF, 0, 0)) ;red
    EndIf 
  EndWith
EndProcedure

Procedure selectHex(*h.honeycomb, hexID)
  If Not *h\hexGadgets(hexID)\Status
    *h\chosen + *h\hexGadgets(hexID)\text
    *h\hexGadgets(hexID)\Status = 1
    StartDrawing(CanvasOutput(*h\gadgetID))
      drawhex(*h, hexID)
      DrawingMode(#PB_2DDrawing_Default)
      DrawingFont(#PB_Default)
      DrawText(0, *h\textY, "Chosen: " + *h\chosen)
      DrawText(0, *h\textY + 20, "The user chose letter " + *h\hexGadgets(hexID)\text + ".  ")
    StopDrawing()
    ProcedureReturn 1
  EndIf 
EndProcedure

Procedure hexKey(*h.honeycomb, hexID)
  Protected key = GetGadgetAttribute(*h\gadgetID, #PB_Canvas_Input)
  If UCase(Chr(key)) = *h\hexGadgets(hexID)\text
    ProcedureReturn selectHex(*h, hexID)
  EndIf
EndProcedure

Procedure hexMouse(*h.honeycomb, hexID)
  Protected mPos.POINT
  mPos\x = GetGadgetAttribute(*h\gadgetID, #PB_Canvas_MouseX)
  mPos\y = GetGadgetAttribute(*h\gadgetID, #PB_Canvas_MouseY)
  If inpoly(mPos,*h\hexGadgets(hexID)\shape())
    ProcedureReturn selectHex(*h, hexID)
  EndIf 
EndProcedure

Procedure honeycombEvents(*h.honeycomb)
  If Len(*h\chosen) >= *h\maxLength: ProcedureReturn: EndIf
  
  Protected event = EventType(), *eventFunction.hexEvent_prt
  Select event
    Case #PB_EventType_Input
      *eventFunction = @hexKey()
    Case #PB_EventType_LeftButtonUp
      *eventFunction = @hexMouse()
    Case #PB_EventType_LostFocus
      SetActiveGadget(*h\gadgetID)
  EndSelect
  
  If *eventFunction
    For hexID = 0 To ArraySize(*h\hexGadgets())
      If *eventFunction(*h, hexID)
        Break ;event successfully handled
      EndIf 
    Next 
  EndIf 
EndProcedure

Procedure createHexGadget(*h.honeycomb, hexID, x, y, dx, dy)
  With *h\hexGadgets(hexID)
    If *h\unusedLetters
      Protected letterNum = Random(Len(*h\unusedLetters) - 1) + 1
      \text = Mid(*h\unusedLetters, letterNum, 1)
      *h\unusedLetters = ReplaceString(*h\unusedLetters, \text, "")
    EndIf 
    \center\x = x: \center\y = y
    AddElement(\shape()): \shape()\x = x - dx:     \shape()\y = y
    AddElement(\shape()): \shape()\x = x - dx / 2: \shape()\y = y + dy
    AddElement(\shape()): \shape()\x = x + dx / 2: \shape()\y = y + dy
    AddElement(\shape()): \shape()\x = x + dx:     \shape()\y = y
    AddElement(\shape()): \shape()\x = x + dx / 2: \shape()\y = y - dy
    AddElement(\shape()): \shape()\x = x - dx / 2: \shape()\y = y - dy 
  EndWith
EndProcedure

Procedure initHoneycomb(*h.honeycomb, posX, posY, dx = 30, dy = 25, marginX = 10, marginY = 5)
  Protected i, sx, sy, hCols = 5, hRows = 5, hexGadgetCount = hCols * hRows - 1
  If Not *h: ProcedureReturn 0: EndIf
  
  *h\unusedLetters.s = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"    
  *h\chosen = ""
  *h\maxLength = 9
  
  Dim *h\hexGadgets(hexGadgetCount)
  ;calculate size width, height and create honeycomb with margins
  sx = Round(dx * (0.5 + hCols * 1.5), #PB_Round_Nearest) + 1 + 2 * marginX
  sy = dy * (2 * hRows + 1) + 1 + 2 * marginY + 2 * 20 ;includes room for hex, margins, and text
  *h\textY = sy - 2 * 20
  
  ;create hexes
  Protected hexID, column, row, x, y, baseX, baseY, majorOffsetY = dy
  baseX = dx + marginX
  For column = 0 To hCols - 1
    baseY = dy + marginY
    majorOffsetY ! dy
    For row = 0 To hRows - 1
      x = baseX
      y = baseY + majorOffsetY
      createHexGadget(*h, hexID, x, y, dx, dy)
      baseY + dy * 2
      hexID + 1
    Next 
    baseX + dx * 1.5
  Next 
  
  ;draw honeycomb
  *h\gadgetID = CanvasGadget(#PB_Any, posX, posY, sx, sy, #PB_Canvas_Keyboard | #PB_Canvas_ClipMouse)
  If *h\gadgetID = 0: ProcedureReturn 0: EndIf ;failed to created honeycomb

  *h\fontID = LoadFont(#PB_Any, "Arial", 24, #PB_Font_Bold)
  StartDrawing(CanvasOutput(*h\gadgetID))
    For i = 0 To ArraySize(*h\hexGadgets())
      drawhex(*h, i)
    Next 
    Box(0, *h\textY, sx, 40, RGB(0, 0, 0)) ;draw black text box
  StopDrawing()
  ProcedureReturn 1
EndProcedure

If OpenWindow(0, 0, 0, 400, 400, "PureBasic - Honeycombs", #PB_Window_SystemMenu)
  Define honeycomb.honeycomb, quit
  If Not initHoneycomb(honeycomb, 0, 0): End: EndIf
  ResizeWindow(0, #PB_Ignore, #PB_Ignore, GadgetWidth(honeycomb\gadgetID), GadgetHeight(honeycomb\gadgetID))
  SetActiveGadget(honeycomb\gadgetID)
  Debug Str(GadgetWidth(honeycomb\gadgetID)) + "," + Str(GadgetHeight(honeycomb\gadgetID))
  Repeat
    event = WaitWindowEvent()

    Select event
      Case #PB_Event_Gadget
        If EventGadget() = honeycomb\gadgetID
          honeycombEvents(honeycomb)
          If Len(honeycomb\chosen) = honeycomb\maxLength
            MessageRequester("Exit", "You chose: " + honeycomb\chosen + ".")
            quit = 1
          EndIf 
        EndIf
      Case #PB_Event_CloseWindow
        quit = 1
    EndSelect
    
  Until quit = 1
EndIf 
I could of just updated the code in the original post I decide to post the updated code so that the two methods of reading keys from the CanvasGadget can be compared.

The first method (in the former post) required using the 'key_down' event for the gadget and comparing the value of the '#Canvas_Key' attribute to a table containing the constants for the 'shortcut' keys for each letter. The updated code uses the 'input' event and compares the value of '#Canvas_Input' to the character code.

Re: CanvasGadget example

Posted: Sat Sep 03, 2011 5:19 am
by electrochrisso
8)

Re: CanvasGadget example

Posted: Mon Sep 05, 2011 1:02 am
by DoubleDutch
Thanks. :)