It is currently Mon Apr 06, 2020 10:56 pm

All times are UTC + 1 hour




Post new topic Reply to topic  [ 3 posts ] 
Author Message
 Post subject: Plotting X,Y Data Program Template
PostPosted: Wed Mar 25, 2020 6:21 pm 
Offline
New User
New User

Joined: Fri Jan 31, 2020 6:48 pm
Posts: 4
I have written several programs that plot X,Y data sets. Here is a demo program that uses the scaling routines I developed and also displays the scroll bar information while it is being moved. I hope this useful to some of you.

Code:
;Demo program to plot x,y data using scaling and scroll bar

Global xsize.f,ysize.f,xlow.f,xhigh.f,ylow.f,yhigh.f,xratio.f,yratio.f,BottomMargin
Global scrx,scry,scrw,scrh
Dim SineWave.f(2000)

Enumeration 100
  #HBar
  #HScrollPoint
EndEnumeration


Procedure ScrnScale(xl.f,xh.f,yl.f,yh.f)  ;Calculate Scaling Parameters, call before ScrnX or ScrnY and after opening a screen
                                          ;Parameters are x1,x2,y1,y2 of Screen to plot on
  xsize=ScreenWidth()-1                   ;Note screen width is pixels, so plot values run from 0 to 499
  ysize=ScreenHeight()-BottomMargin-1     ;in this example with a 500 by 500 screen (see below)
  xlow=xl : xhigh=xh
  ylow=yl : yhigh=yh
  xratio=xsize/(xhigh-xlow)
  yratio=ysize/(yhigh-ylow)
EndProcedure

Procedure ScrnX(x.f)   ;Return scaled x value of Screen
  ProcedureReturn (x-xlow)*xratio
EndProcedure

Procedure ScrnY(y.f)    ;Return scaled y value of Screen
  ProcedureReturn ysize-(y-ylow)*yratio
EndProcedure

Procedure BindHScroll()              ;Needed to display value while scrolling x axis
  If IsGadget(#HBar)=0 :ListViewGadget(#HBar,300,620,125,20) : EndIf
  ClearGadgetItems(#HBar)
  AddGadgetItem(#HBar,0,"New End Point = "+Str(GetGadgetState(#HScrollPoint)))
EndProcedure


For i=1 To 2000          ;Generate a sine wave
  SineWave(i)=Sin(i/100.0)
Next
For i=2000 To 1 Step -1  ;find last point close to zero
  If SineWave(i)< 0.01
    lastpoint=i
    Break
  EndIf
Next
Font1 = LoadFont(#PB_Any, "Arial"  ,  10)
Font2 = LoadFont(#PB_Any, "Arial"  ,  14)
ymin=-1: ymax=1 :Oldlastpoint=lastpoint
BottomMargin=25           ;this space can be used for botttom tick marks and x axis notation
If InitSprite() = 0 Or InitKeyboard()=0
  MessageRequester("Error", "Can't open screen & sprite environment!", 0)
  End
EndIf

OpenWindow(0, 0, 0, 1000, 800, "Show plotting using scaling", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
SetWindowColor(0,$E9F2C7)
TextGadget(50,300,50,400,15,"Hit D,Y,R and see what happens")
SetGadgetColor(50,#PB_Gadget_BackColor,$E9F2C7):SetGadgetFont(50,font2)
OpenWindowedScreen(WindowID(0), 100, 100, 500, 500)
ScrollBarGadget(#HScrollPoint,100, 600, 500, 20, 0, lastpoint, 1)
SetGadgetState(#HScrollPoint,lastpoint)
BindGadgetEvent(#HScrollPoint, @BindHScroll())                          ;so can read scroll bar while scrolling
Gosub plot


Repeat
  WaitWindowEvent()
  Event = WindowEvent()
  If event= #PB_Event_CloseWindow
    End
  EndIf
  If event = #PB_Event_Gadget
    If EventGadget() = #HScrollPoint         ;xaxis scroll moved change center mass
      If IsGadget(#HBar)                     ;only display mass box while scrolling
        FreeGadget(#HBar)
      EndIf                           
      lastpoint=GetGadgetState(#HScrollPoint)
      Gosub plot                            ;move center x axis to scroll point
    EndIf
  EndIf
  ExamineKeyboard()
  If KeyboardReleased(#PB_Key_D)            ;half x range
    lastpoint=lastpoint/2
    SetGadgetAttribute(#HScrollPoint,#PB_ScrollBar_Maximum,lastpoint)
    SetGadgetState(#HScrollPoint,lastpoint)
    Gosub plot
  ElseIf KeyboardReleased(#PB_Key_Y)        ;double y range
    ymin=ymin*2 :ymax=ymax*2
    Gosub plot
  ElseIf KeyboardReleased(#PB_Key_R)        ;reset x,y ranges
    ymin=-1:ymax=1 :lastpoint=Oldlastpoint
    SetGadgetAttribute(#HScrollPoint,#PB_ScrollBar_Maximum,lastpoint)
    SetGadgetState(#HScrollPoint,lastpoint)
    Gosub plot
  EndIf
ForEver

Plot:
ClearScreen($FFFFFF)
StartDrawing(ScreenOutput())
DrawingMode(#PB_2DDrawing_Transparent | #PB_2DDrawing_Outlined)
ScrnScale(1,100,1,100)
LineXY(ScrnX(1),Scrny(1),Scrnx(100),Scrny(100),$41FC32)  ;Draw a diagonal line
Box(0,0,500,500-BottomMargin,0)                          ;note box dimensions are in pixels
Ticksize=7                                               ;draw tick marks
For i=1 To 9
  xpoint.f=i*xsize/10.0: ypoint.f=i*ysize/10.0 
  LineXY(xpoint,ysize+TickSize,xpoint,ysize,0)    ;bottom ticks
  LineXY(0,ypoint,TickSize,ypoint,0)              ;left ticks
  LineXY(xpoint,0,xpoint,TickSize,0)              ;top ticks
  LineXY(xsize,ypoint,xsize-TickSize,ypoint,0)    ;right ticks
Next
ScrnScale(1,lastpoint,ymin,ymax)                    ;set to plot sine wave values
lastx=scrnx(1):lasty=scrny(SineWave(1))
FrontColor($FF0000)
For i=1 To lastpoint
  xpoint=scrnx(i):ypoint=scrny(SineWave(i))
  LineXY(lastx,lasty,xpoint,ypoint)
  lastx=xpoint:lasty=ypoint
Next
DrawingFont(FontID(font1))                      ;label axes
tsize=TextWidth("1234")
DrawText(3,480,"0",0)
DrawText(250-tsize/2,480,RSet(Str(lastpoint/2),4),0)
DrawText(495-tsize,480,RSet(Str(lastpoint),4),0)
DrawText(3,3,StrF(ymax,2),0)
DrawText(3,460,StrF(ymin,2),0)
StopDrawing()
FlipBuffers()
Return
End


Top
 Profile  
Reply with quote  
 Post subject: Re: Plotting X,Y Data Program Template
PostPosted: Wed Mar 25, 2020 7:01 pm 
Offline
Addict
Addict
User avatar

Joined: Wed Dec 23, 2009 10:14 pm
Posts: 3235
Location: Boston, MA
Nice job. Try applying your code to the canvas gadget and the vector drawing lib.
The graphics are slower, but you get anti-aliased lines and a modern look.

_________________
The nice thing about standards is there are so many to choose from. ~ Andrew Tanenbaum


Top
 Profile  
Reply with quote  
 Post subject: Re: Plotting X,Y Data Program Template
PostPosted: Wed Mar 25, 2020 8:42 pm 
Online
Addict
Addict
User avatar

Joined: Thu Jan 10, 2008 1:30 pm
Posts: 1261
Location: Germany, Glienicke
Here is an example with the VectorDrawing-Lib:
Code:
Enumeration
   #Window
   #Gadget
   #Font
   #Image
EndEnumeration

EnableExplicit

LoadFont(#Font, "Arial", 24)

Structure Vector
   X.f
   Y.f
EndStructure


Procedure.f MyFunction(X.f)
   ; Write here your function:
   ProcedureReturn Sin(10/(X+0.1))
EndProcedure

Prototype.f PathFunction(X.f)


Procedure CreateFunctionPath(List Node.Vector(), Function.PathFunction, Min.f, Max.f, Samples.i=32)
   Protected Sample.i
   Protected.Vector *P1, P2, *P3
   Protected Resolution.f = 0.05/VectorOutputWidth()
   For Sample = 0 To Samples
      AddElement(Node())
      Node()\X = Min + (Max-Min) * Sample/Samples
      Node()\Y = Function(Node()\X)
   Next
   FirstElement(Node())
   *P1 = Node()
   While NextElement(Node())
      *P3 = Node()
      P2\X = (*P1\X+*P3\X)/2
      P2\Y = Function(P2\X)
      If Abs((*P1\Y+*P3\Y-2*P2\Y)) > Resolution/Abs(*P1\X-*P3\X)
         InsertElement(Node())
         Node() = P2
         *P3 = Node()
         PreviousElement(Node())
      Else
         *P1 = *P3
      EndIf
   Wend
EndProcedure


Procedure Update()
   
   Protected X.f, Y.f, I.i
   Protected NewList Node.Vector()
   
   ResizeGadget(#Gadget, 0, 0, WindowWidth(#Window), WindowHeight(#Window))
   
   If StartVectorDrawing(CanvasVectorOutput(#Gadget,#PB_Unit_Pixel))
      
      VectorSourceColor($FFFFFFFF)
      FillVectorOutput()
      
      VectorFont(FontID(#Font), 16.0)
      TranslateCoordinates(0.5, 0.5) ; Pixel-Offset
      
      VectorSourceColor($FF000000)
      
      MovePathCursor(50, 40)
      AddPathLine(50, VectorOutputHeight()-40)
      
      MovePathCursor(40, VectorOutputHeight()/2)
      AddPathLine(VectorOutputWidth()-40, VectorOutputHeight()/2)
      
      For I = -10 To 10
         MovePathCursor(50, VectorOutputHeight()/2+I*(VectorOutputHeight()-100)/20)
         If I % 5
            AddPathLine(3, 0, #PB_Path_Relative)
         ElseIf I<>0
            MovePathCursor(45-VectorTextWidth(StrF(-I/10,1)), VectorOutputHeight()/2+I*(VectorOutputHeight()-100)/20-6)
            DrawVectorText(StrF(-I/10,1))
            MovePathCursor(50, VectorOutputHeight()/2+I*(VectorOutputHeight()-100)/20)
            AddPathLine(5, 0, #PB_Path_Relative)
         EndIf
      Next
      For I = 1 To 20
         MovePathCursor(50+I*(VectorOutputWidth()-100)/20, VectorOutputHeight()/2)
         If I % 5
            AddPathLine(0, -3, #PB_Path_Relative)
         Else
            MovePathCursor(50+I*(VectorOutputWidth()-100)/20-8, VectorOutputHeight()/2+4)
            DrawVectorText(StrF(I/10,1))
            MovePathCursor(50+I*(VectorOutputWidth()-100)/20, VectorOutputHeight()/2)
            AddPathLine(0, -5, #PB_Path_Relative)
         EndIf
      Next
      StrokePath(1, #PB_Path_SquareEnd)
      
      CreateFunctionPath(Node(), @MyFunction(), 0.0, 2.0)
      
      VectorSourceColor($FFC06000)
      TranslateCoordinates(50, VectorOutputHeight()/2)
      ForEach Node()
         X = Node()\X * (VectorOutputWidth()-100)/2
         Y = -Node()\Y * (VectorOutputHeight()-100)/2
         If ListIndex(Node()) = 0
            MovePathCursor(X, Y)
         Else
            AddPathLine(X, Y)
         EndIf
      Next
      StrokePath(1.6, #PB_Path_RoundCorner)
      
      StopVectorDrawing()
   EndIf
   
EndProcedure

If OpenWindow(#Window, 0, 0, 800, 600, "VectorDrawing", #PB_Window_SizeGadget|#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget|#PB_Window_ScreenCentered)
   CanvasGadget(#Gadget, 0, 0, WindowWidth(#Window), WindowHeight(#Window))
   Update()
   
   BindEvent(#PB_Event_SizeWindow, @Update(), #Window)
   
   If StartDrawing(CanvasOutput(#Gadget))
      GrabDrawingImage(#Image, 0, 0, OutputWidth(), OutputHeight())
      StopDrawing()
   EndIf
   SetClipboardImage(#Image)
   
   Repeat
      Select WaitWindowEvent()
         Case #PB_Event_CloseWindow
            Break
      EndSelect
   ForEver
EndIf

_________________
ImageImage


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 3 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: MSN [Bot] and 7 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye