how to draw such a thing

Just starting out? Need help? Post your questions and find answers here.
mestnyi
Addict
Addict
Posts: 1102
Joined: Mon Nov 25, 2013 6:41 am

how to draw such a thing

Post by mestnyi »

Hi, how do I draw such an arrow?

Code: Select all

; 0,0,0,0,0,0,0,0,0,0,0
; 1,0,0,0,0,0,0,0,0,0,1
; 1,1,0,0,0,0,0,0,0,1,1
; 1,1,1,0,0,0,0,0,1,1,1
; 1,1,1,1,0,0,0,1,1,1,1
; 0,1,1,1,1,0,1,1,1,1,0
; 0,0,1,1,1,1,1,1,1,0,0
; 0,0,0,1,1,1,1,1,0,0,0
; 0,0,0,0,1,1,1,0,0,0,0
; 0,0,0,0,0,1,0,0,0,0,0
; 0,0,0,0,0,0,0,0,0,0,0
User avatar
Bisonte
Addict
Addict
Posts: 1320
Joined: Tue Oct 09, 2007 2:15 am

Re: how to draw such a thing

Post by Bisonte »

The very OldSchool way :

Code: Select all

Procedure Draw()
  
  Protected Dim a(10, 10)
  
  Restore Arrow
  
  If StartDrawing(ImageOutput(1))
    
    Box(0, 0, OutputWidth(), OutputHeight(), #White)
    
    For y = 0 To 10
      For x = 0 To 10
        
        Read.i a(x, y)
        
        If a(x, y)

          Plot(x, y, #Black)
        EndIf
        
      Next x
    Next y
    
    StopDrawing()
    
  EndIf

EndProcedure
DataSection
  Arrow:
  Data.i 0,0,0,0,0,0,0,0,0,0,0
  Data.i 1,0,0,0,0,0,0,0,0,0,1
  Data.i 1,1,0,0,0,0,0,0,0,1,1
  Data.i 1,1,1,0,0,0,0,0,1,1,1
  Data.i 1,1,1,1,0,0,0,1,1,1,1
  Data.i 0,1,1,1,1,0,1,1,1,1,0
  Data.i 0,0,1,1,1,1,1,1,1,0,0
  Data.i 0,0,0,1,1,1,1,1,0,0,0
  Data.i 0,0,0,0,1,1,1,0,0,0,0
  Data.i 0,0,0,0,0,1,0,0,0,0,0
  Data.i 0,0,0,0,0,0,0,0,0,0,0
EndDataSection

CreateImage(1, 11, 11)
Draw()

OpenWindow(0, 0, 0, 640, 480, "Test", #PB_Window_ScreenCentered|#PB_Window_SystemMenu)

ImageGadget(1, 50, 50, 11, 11, ImageID(1))

AddKeyboardShortcut(0, #PB_Shortcut_Escape, 59999)

Repeat
  Event = WaitWindowEvent()
  
  Select Event
    Case #PB_Event_CloseWindow
      Break
      
    Case #PB_Event_Gadget
      Select EventGadget()
        Case 1
          ;       
      EndSelect
      
    Case #PB_Event_Menu
      Select EventMenu()
        Case 59999
          Break
      EndSelect
      
  EndSelect
  
ForEver
aaah, the Commodore C64 and his Spite Sheets ;)
PureBasic 6.21 (Windows x64) | Windows 11 Pro | AsRock B850 Steel Legend Wifi | R7 9800x3D | 64GB RAM | RTX 5080 | ThermaltakeView 270 TG ARGB | build by vannicom​​
English is not my native language... (I often use DeepL.)
User avatar
jacdelad
Addict
Addict
Posts: 2031
Joined: Wed Feb 03, 2021 12:46 pm
Location: Riesa

Re: how to draw such a thing

Post by jacdelad »

Data.i seems a bit overpowered, .a or .b should be enough. :wink:
Good morning, that's a nice tnetennba!

PureBasic 6.21/Windows 11 x64/Ryzen 7900X/32GB RAM/3TB SSD
Synology DS1821+/DX517, 130.9TB+50.8TB+2TB SSD
User avatar
Mijikai
Addict
Addict
Posts: 1520
Joined: Sun Sep 11, 2016 2:17 pm

Re: how to draw such a thing

Post by Mijikai »

Another example:

Code: Select all

EnableExplicit

Procedure.i PlotSprite(*Memory.Ascii,Width.i,Height.i,X.i,Y.i,ColorBack.i,ColorFront.i)
  Protected.i px,py
  For py = 0 To Height - 1
    For px = 0 To Width - 1
      Plot(X + px,Y + py,ColorBack * Bool(*Memory\a = 0) + ColorFront * *Memory\a)
      *Memory + 1
    Next
  Next
  ProcedureReturn #Null
EndProcedure

Procedure.i Main()
  If OpenWindow(0,0,0,320,320,#Null$,#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
    If StartDrawing(WindowOutput(0))
      PlotSprite(?arrow,11,11,155,155,$FFFFFF,$000000)
      StopDrawing()
    EndIf
    Repeat:Until WaitWindowEvent() = #PB_Event_CloseWindow
    CloseWindow(0)  
  EndIf  
  ProcedureReturn #Null  
EndProcedure

End Main()

DataSection
  arrow:
  Data.a 0,0,0,0,0,0,0,0,0,0,0
  Data.a 1,0,0,0,0,0,0,0,0,0,1
  Data.a 1,1,0,0,0,0,0,0,0,1,1
  Data.a 1,1,1,0,0,0,0,0,1,1,1
  Data.a 1,1,1,1,0,0,0,1,1,1,1
  Data.a 0,1,1,1,1,0,1,1,1,1,0
  Data.a 0,0,1,1,1,1,1,1,1,0,0
  Data.a 0,0,0,1,1,1,1,1,0,0,0
  Data.a 0,0,0,0,1,1,1,0,0,0,0
  Data.a 0,0,0,0,0,1,0,0,0,0,0
  Data.a 0,0,0,0,0,0,0,0,0,0,0
EndDataSection
mestnyi
Addict
Addict
Posts: 1102
Joined: Mon Nov 25, 2013 6:41 am

Re: how to draw such a thing

Post by mestnyi »

Thanks guys, this was an image of what it should look like.
is it possible to do the same thing, just without the date section?
That is, I don't need a fixed size.

Code: Select all

; 0,0,0,0,0,0,0,0,0,0,0,0,0
; 0,1,0,0,0,0,0,0,0,0,0,1,0
; 0,1,1,0,0,0,0,0,0,0,1,1,0
; 0,1,1,1,0,0,0,0,0,1,1,1,0
; 0,1,1,1,1,0,0,0,1,1,1,1,0
; 0,1,1,1,1,1,0,1,1,1,1,1,0
; 0,1,1,1,1,1,1,1,1,1,1,1,0
; 0,1,1,1,1,1,1,1,1,1,1,1,0
; 0,1,1,1,1,1,1,1,1,1,1,1,0
; 0,0,1,1,1,1,1,1,1,1,1,0,0
; 0,0,0,1,1,1,1,1,1,1,0,0,0
; 0,0,0,0,1,1,1,1,1,0,0,0,0
; 0,0,0,0,0,1,1,1,0,0,0,0,0
; 0,0,0,0,0,0,1,0,0,0,0,0,0
; 0,0,0,0,0,0,0,0,0,0,0,0,0

size = 60
d=5


Procedure.b Draw_Arrow( x.l, y.l, size.a, direction.a, style.b = 1, FrameColor = $ff000000, Color = $ffffffff )
  Protected x1.l, y1.l
  
  If Style
    If Style =- 1
      ; ProcedureReturn Arrow( x, y, Size, Direction, Color )
    Else
      For x1 = 0 To size
        For y1 = x1 To size-x1 
          If direction = 0 ; left
            Box(x+size/2-x1*Style,y+y1,Style,1, FrameColor)
          EndIf
          If direction = 1 ; up
            Box(x+y1,y+size/2-x1*Style,1,Style, FrameColor)
          EndIf
          If direction = 2 ; right
            Box(x+size/2+x1*Style,y+y1,Style,1, FrameColor)
            ;Box(x-size/2+x1,y+y1,1,1, FrameColor)
          EndIf
          If direction = 3 ; down
            Box(x+y1,y+size/2+x1*Style,1,Style, FrameColor)
            ;Box(x+y1,y-size/2+x1,1,1, FrameColor)
          EndIf
        Next  
      Next
      
      For x1 = 1 To size-1
        For y1 = x1+1 To size-1-x1 
          If direction = 0 ; left
            Box(x+size/2-x1*Style,y+y1,Style,1, Color)
          EndIf
          If direction = 1 ; up
            Box(x+y1,y+size/2-x1*Style,1,Style, Color)
          EndIf
          If direction = 2 ; right
            Box(x+size/2+x1*Style,y+y1,Style,1, Color)
            ;Box(x-size/2+x1,y+y1,1,1, Color)
          EndIf
          If direction = 3 ; down
            Box(x+y1,y+size/2+x1*Style,1,Style, Color)
            ;Box(x+y1,y-size/2+x1,1,1, Color)
          EndIf
        Next  
      Next
    EndIf
  EndIf
EndProcedure


If OpenWindow(0, 0, 0, 400, 400, "2DDrawing Example DPI", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  If CreateImage(0, 400, 400, 24, $BFBFEC) And StartDrawing(ImageOutput(0))
    SetOrigin(size/2,size/2)
    
    x=0
    y=size*2+d
    Draw_Arrow(x,y, size, 0,2)
    x=size*2+d*2+size*2
    Draw_Arrow(x,y, size, 2,2)
    
    y=0
    x=size*2+d
    Draw_Arrow(x,y, size, 1)
    y=size*2+d*2+size*2
    Draw_Arrow(x,y, size, 3)
    
    StopDrawing() 
    ImageGadget(0, 0, 0, 200, 200, ImageID(0))      
  EndIf
  
  Repeat
    Event = WaitWindowEvent()
  Until Event = #PB_Event_CloseWindow
EndIf
Last edited by mestnyi on Mon Oct 28, 2024 6:35 pm, edited 1 time in total.
User avatar
Mijikai
Addict
Addict
Posts: 1520
Joined: Sun Sep 11, 2016 2:17 pm

Re: how to draw such a thing

Post by Mijikai »

Something like this?
I used VectorDrawing (there is a function called IsInsidePath() which might be useful later on if this will be a control).

Code: Select all

EnableExplicit

Procedure.i DrawArrows(X.d,Y.d,SizeUD.d,SizeLR.d,Gap.d,ColorA.i,ColorB.i)
  Protected.d a,b,g
  a = SizeUD / 2.0
  b = SizeLR / 2.0
  g = Gap / 2.0
  TranslateCoordinates(X,Y)
  VectorSourceColor(ColorA)
  MovePathCursor(- a,-g,#PB_Path_Default)
  AddPathLine(0,-(g + SizeUD))
  AddPathLine(a,-g)
  ClosePath()
  MovePathCursor(- a,g,#PB_Path_Default)
  AddPathLine(0,g + SizeUD)
  AddPathLine(a,g)
  ClosePath()
  MovePathCursor(-g,-b,#PB_Path_Default)
  AddPathLine(-(g + SizeLR),0)
  AddPathLine(-g,b)
  ClosePath()
  MovePathCursor(g,-b,#PB_Path_Default)
  AddPathLine(g + SizeLR,0)
  AddPathLine(g,b)
  ClosePath()
  FillPath(#PB_Path_Preserve)
  VectorSourceColor(ColorB)
  StrokePath(2.0,#PB_Path_RoundEnd|#PB_Path_RoundCorner)
  ProcedureReturn #Null
EndProcedure

Procedure.i Main()
  If OpenWindow(0,0,0,320,320,#Null$,#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
    If StartVectorDrawing(WindowVectorOutput(0))
      DrawArrows(160,160,24,20,40,$FF200010,$FFAA00FF)
      StopVectorDrawing()
    EndIf
    Repeat:Until WaitWindowEvent() = #PB_Event_CloseWindow
    CloseWindow(0)  
  EndIf  
  ProcedureReturn #Null  
EndProcedure

End Main()
mestnyi
Addict
Addict
Posts: 1102
Joined: Mon Nov 25, 2013 6:41 am

Re: how to draw such a thing

Post by mestnyi »

Thanks, this will come in handy too. but I don't need such arrows, namely the ones that I threw off at the beginning of the post to draw through 2D
User avatar
Mijikai
Addict
Addict
Posts: 1520
Joined: Sun Sep 11, 2016 2:17 pm

Re: how to draw such a thing

Post by Mijikai »

The Vector Library is probably the best option for this kind of thing.

Example like the first but sizeable and without datasection (slow):

Code: Select all

EnableExplicit

Procedure.i PlotArrow(X.i,Y.i,Size.i,ColorBack.i,ColorFront.i)
  Protected Dim span.a(0)
  Protected.i px,py,ps,pq,pi,pp
  ps = Size - 1
  pq = Size >> 1
  pp = pq >> 3
  ReDim span(ps)
  If ArraySize(span(),1) = ps
    For py = 0 To ps
      For px = 0 To ps
        Plot(X + px,Y + py,ColorBack * Bool(span(px) = 0) + ColorFront * span(px))
      Next
      If pi < ps
        If pi >= pp 
          If pi < ps - (pp << 2) 
            pi - pp
            If pi >= pq
              span(pi - pq) = 0
              span(ps - (pi - pq)) = 0 
            EndIf
            If pi <= pq 
              span(pi) = 1
              span(ps - pi) = 1
            EndIf
            pi + pp
          EndIf
        EndIf
        pq - pp
        If pi >= pq
          span(pi - pq) = 0
          span(ps - (pi - pq)) = 0 
        EndIf
        pq + pp
      EndIf
      pi + 1
    Next
    ProcedureReturn #True
  EndIf
  ProcedureReturn #False
EndProcedure

Procedure.i Main()
  If OpenWindow(0,0,0,320,320,#Null$,#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
    If StartDrawing(WindowOutput(0))
      PlotArrow(0,0,320,$202020,$808080)
      PlotArrow(144,144,32,$AAAAAA,$404040)
      StopDrawing()
    EndIf
    Repeat:Until WaitWindowEvent() = #PB_Event_CloseWindow
    CloseWindow(0)  
  EndIf  
  ProcedureReturn #Null  
EndProcedure

End Main()
mestnyi
Addict
Addict
Posts: 1102
Joined: Mon Nov 25, 2013 6:41 am

Re: how to draw such a thing

Post by mestnyi »

Mijikai wrote: Tue Oct 29, 2024 10:05 am The Vector Library is probably the best option for this kind of thing.

Example like the first but sizeable and without datasection (slow):
No, it won't do. :)
That's what I got.

Code: Select all

Procedure Arrow( x, y, size, direction, color = 0 )
  size/2
  Protected thickness = size/2+2
  
  For x1 = -size To size
    If direction = 0 ; left
      If x1 > 0
        Box(x+x1,y+x1*1,-thickness,1, Color)
      Else
        Box(x-x1,y+x1*1,-thickness,1, Color)
      EndIf
    EndIf
    If direction = 2 ; right
      If x1 < 0
        Box(x+x1,y+x1*1,thickness,1, Color)
      Else
        Box(x-x1,y+x1*1,thickness,1, Color)
      EndIf
    EndIf
    
    If direction = 1 ; up
      If x1 > 0
        Box(x+x1*1,y+x1,1,-thickness, Color)
      Else
        Box(x+x1*1,y-x1,1,-thickness, Color)
      EndIf
    EndIf
    
    If direction = 3 ; down
      If x1 < 0
        Box(x+x1*1,y+x1,1,thickness, Color)
      Else
        Box(x+x1*1,y-x1,1,thickness, Color)
      EndIf
    EndIf
  Next
EndProcedure

size = 30
d=5



If OpenWindow(0, 0, 0, 400, 400, "2DDrawing Example DPI", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  If CreateImage(0, 200, 200, 24, $FFFFFF) And StartDrawing(ImageOutput(0))
    SetOrigin(size/2,size/2)
    FrontColor($ff0000)
    pos = 10
    x=pos
    y=size*2+d+pos
    Arrow(x,y, size, 0)
    x=size*2+d*2+size*2+pos
    Arrow(x,y, size, 2)
    
    y=pos
    x=size*2+d+pos
    Arrow(x,y, size, 1)
    y=size*2+d*2+size*2+pos
    Arrow(x,y, size, 3)
    
    
    
    StopDrawing() 
    ImageGadget(0, 0, 0, 200, 200, ImageID(0))      
  EndIf
  
  Repeat
    Event = WaitWindowEvent()
  Until Event = #PB_Event_CloseWindow
EndIf
Post Reply