PureBasic Forums - English

Code: Select all

EnableExplicit

;Project: SpriteLines
;Author: Mijikai

;There is no 2D Line function outside of Start/StopDrawing()!
;DrawLine() uses the TransformSprite() function to create 2D Lines with a Sprite.

;It is not perfect but a start :)

Procedure.i DrawLine(X1.i,Y1.i,X2.i,Y2.i,Width.i);<- draw the line
  Protected.f w,h,r,s,c,ws,wc,hs,hc
  w = Sqr(Pow(X1 - X2,2) + Pow(Y1 - Y2,2))
  h = Width / 2.0
  r = ATan2(X2 - X1,Y2 - Y1)
  s = Sin(r)
  c = Cos(r)
  ws = w * s
  wc = w * c
  hs = h * s
  hc = h * c
  TransformSprite(0,hs,-hc,0,wc + hs,ws - hc,0,wc - hs,ws + hc,0,-hs,hc,0)
  DisplayTransparentSprite(0,X1,Y1)
  ProcedureReturn #Null
EndProcedure

Procedure.i Render();<- examples
  DrawLine(200,200,400,200,1)
  DrawLine(200,200,200,400,2)
  DrawLine(200,200,400,400,3)
  DrawLine(200,200,400,300,8)
  DrawLine(200,200,40,100,80)
  ProcedureReturn #Null
EndProcedure

Procedure.i Sprite();<- dummy sprite
  If CreateSprite(0,16,16,#PB_Sprite_AlphaBlending)
    If StartDrawing(SpriteOutput(0))
      DrawingMode(#PB_2DDrawing_AllChannels)
      Box(0,0,OutputWidth(),OutputHeight(),RGBA(255,0,0,255))
      StopDrawing()
      ProcedureReturn #True  
    EndIf
    FreeSprite(0)  
  EndIf
  ProcedureReturn #False
EndProcedure

Procedure.i Main();<- main loop
  Protected.i exit
  If InitSprite()
    If OpenWindow(0,0,0,800,600,#Null$,#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
      If OpenWindowedScreen(WindowID(0),0,0,WindowWidth(0),WindowHeight(0))
        SetFrameRate(60)
        If Sprite()
          Repeat
            Repeat
              Select WindowEvent()
                Case #PB_Event_None
                  Break
                Case #PB_Event_CloseWindow
                  exit = #True
              EndSelect
            ForEver
            ClearScreen($0)
            Render()
            ZoomSprite(0,#PB_Default,#PB_Default)
            DisplayTransparentSprite(0,200 - 8,200 - 8,255,RGBA(0,255,0,255))
            FlipBuffers()
          Until exit
        EndIf
        CloseScreen()  
      EndIf
      CloseWindow(0)
    EndIf
  EndIf
  ProcedureReturn #Null
EndProcedure

End Main()

Code: Select all

x1=10
x2=20
y1=10
x2=20

a=ElapsedMilliseconds()
For i = 1 To 1000000
  Sqr(Pow(X1 - X2,2) + Pow(Y1 - Y2,2))
Next i

b=ElapsedMilliseconds()
For i = 1 To 1000000
  Sqr((X1 - X2)*(X1 - X2) + (Y1 - Y2)*(Y1 - Y2))
Next i
c=ElapsedMilliseconds()

Debug b-a
Debug c-b

Code: Select all

For i = 1 To 1000000
  x=x1-x2:y=y1-y2
  Sqr((x)*(x) + (x)*(x))
Next i
d=ElapsedMilliseconds()

MessageRequester("", Str(b-a)+ " "+Str(c-b)+" "+Str(d-c))

Code: Select all

;-

; Bresenham's Line, Circle and Ellipse Algorithms -> Purebasic 
; For convenience all variables in these functions starts with "b".
; Author: hagibaba.
; Date: 09/7/05.

;Fps Globals
Global Fps, Timer, NewTime, Frames
Declare DisplayFps()

;Declares
Declare DrawCircle(bcenter_x, bcenter_y, bradi, bfill, bclr)
Declare DrawEllipse(bcenter_x, bcenter_y, bradi_x, bradi_y, bfill, bclr)
Declare DrawLine(bplot_x1, bplot_y1, bplot_x2, bplot_y2, bclr)
Declare PlotLineX(bplot_x1, bplot_x2, bplot_y, bclr)
Declare PlotLineY(bplot_x, bplot_y1, bplot_y2, bclr)
Declare PlotPixel(bplot_x, bplot_y, bclr)

;Constants
#Win = 0
#WSM = #PB_Window_SystemMenu
#WSC = #PB_Window_ScreenCentered
;Screen dimensions, used in PlotPixel
#Xmin = 0
#Ymin = 0
#Xmax = 640
#Ymax = 480

;- Open Window
If InitSprite() ;init directdraw 7
	If OpenWindow(#Win,#Xmin-3,#Ymin-3,#Xmax,#Ymax,"BresAlgorithms",#WSM|#WSC)
		If OpenWindowedScreen(WindowID(#Win),#Xmin,#Ymin,#Xmax,#Ymax,0,0,0)
			
			Repeat
				
				EventID = WindowEvent()
				MouseX = WindowMouseX(#Win)
				MouseY = WindowMouseY(#Win)
				
				Select EventID
						
					Case #WM_LBUTTONDOWN ;leftmouse close
						Quit=1
						
					Case #PB_Event_CloseWindow ;close button
						Quit=1
						
				EndSelect
				
				StartDrawing(ScreenOutput())
				
				DrawEllipse(MouseX, MouseY, MouseX/2, MouseY/2, 1, RGB(64,64,192))
				DrawEllipse(MouseX, MouseY, MouseX/2, MouseY/2, 0, RGB(64,192,64))
				DrawCircle(MouseX, MouseY, MouseX/3, 1, RGB(192,192,64))
				DrawCircle(MouseX, MouseY, MouseX/3, 0, RGB(192,64,64))
				DrawLine(MouseX/2,MouseY/2,MouseX,MouseY,RGB(0,0,220))
				
				StopDrawing()
				
				DisplayFps()
				
				FlipBuffers()
				ClearScreen(RGB(0,0,0)) ;black
				
			Until Quit=1
			
		EndIf
	EndIf
EndIf

;- Start Functions

Procedure DisplayFps()
	
	; DrawingBuffer.pb -> http://www.purearea.net/
	; Author: ??
	; Display Frames-per-second count as returned from GetTickCount,
	; number of milliseconds that have elapsed since Windows was started.
	
	Frames + 1
	NewTime = GetTickCount_()
	If NewTime - Timer > 1000
		Fps = Frames
		Frames = 0
		Timer = NewTime
	EndIf
	
	StartDrawing(ScreenOutput())
	DrawingMode(1) : FrontColor(RGB(250, 250, 250)) ;white
	DrawText(5, 5, "Fps " + Str(Fps)) ;top-left
	StopDrawing()
	
EndProcedure


Procedure DrawCircle(bcenter_x, bcenter_y, bradi, bfill, bclr)
	
	; Circle algorithm in Pascal -> http://www.gamedev.net/
	; An implementation of Bresenham's circle algorithm.
	; By Mark Feldman.
	;
	; Calculates the locations of the pixels in the first 45 degrees
	; and draws a pixel for each of the 8 octants of the circle.
	; It assumes that the circle is centered on the origin.
	;
	; Includes a fill parameter, 0 for outline and 1 for fill.
	
	;initialize decision variable and circle points
	bdi = 3 - (bradi << 1)
	bxi = bradi
	byi = 0
	
	;draw the first octant, until y = x
	While byi <= bxi
		If bfill > 0 ;draw lines across inner octants, w-nw>e-ne and w-sw>e-se
			PlotLineX(bcenter_x - bxi, bcenter_x + bxi, bcenter_y - byi, bclr)
			PlotLineX(bcenter_x - bxi, bcenter_x + bxi, bcenter_y + byi, bclr)
			If bdi >= 0 ;if x changed fill outer octants, n-nw>n-ne and s-sw>s-se
				PlotLineX(bcenter_x - byi, bcenter_x + byi, bcenter_y - bxi, bclr)
				PlotLineX(bcenter_x - byi, bcenter_x + byi, bcenter_y + bxi, bclr)
			EndIf
		Else ;draw the 8 circle pixels, for each octant
			PlotPixel(bcenter_x - byi, bcenter_y - bxi, bclr) ;n-nw
			PlotPixel(bcenter_x + byi, bcenter_y - bxi, bclr) ;n-ne
			PlotPixel(bcenter_x - bxi, bcenter_y - byi, bclr) ;w-nw
			PlotPixel(bcenter_x + bxi, bcenter_y - byi, bclr) ;e-ne
			PlotPixel(bcenter_x - bxi, bcenter_y + byi, bclr) ;e-sw
			PlotPixel(bcenter_x + bxi, bcenter_y + byi, bclr) ;e-se
			PlotPixel(bcenter_x - byi, bcenter_y + bxi, bclr) ;s-sw
			PlotPixel(bcenter_x + byi, bcenter_y + bxi, bclr) ;s-se
		EndIf
		If bdi < 0
			bdi = bdi + (byi << 2) + 6
		Else
			bdi = bdi + (byi - bxi) << 2 + 10
			bxi = bxi - 1 ;move left
		EndIf
		byi = byi + 1 ;always move up
	Wend
	
EndProcedure


Procedure DrawEllipse(bcenter_x, bcenter_y, bradi_x, bradi_y, bfill, bclr)
	
	; Ellipse algorithm in C -> http://www.programmersheaven.com/
	; Bresenham's algorithm from IEEE CG&A Sept 1984 p.24
	; Jack C. Morrison - Jet Propulsion Laboratory
	;
	; A few requests for ellipses have prompted me to include this code. It
	; draws ellipses (including circles, of course) of varying line width
	; on a SUN bitmap display. (It's part of a paint-type program). I don't
	; know how this compares to the earlier posting of an ellipse algorithm,
	; but it's fairly fast.
	;
	; Includes a fill parameter, 0 for outline and 1 for fill.
	
	;initialize intermediate terms to speed up loop
	bxi = bradi_x * bradi_x
	bx1 = bxi << 1
	bx2 = bx1 << 1
	byi = bradi_y * bradi_y
	by1 = byi << 1
	by2 = by1 << 1
	bf1 = bradi_x * by1
	bf2 = bf1 << 1
	bdi = 0
	
	;error terms and ellipse points, can reuse bxi and byi
	bd1 = bx1 - bf1 + (byi >> 1)
	bd2 = (bxi >> 1) - bf2 + by1
	bxi = bradi_x
	byi = 0
	
	;draw top right quadrant, until slope = -1
	While bd2 < 0
		If bfill > 0 ;draw lines across inner octants, w-nw>e-ne and w-sw>e-se
			PlotLineX(bcenter_x - bxi, bcenter_x + bxi, bcenter_y - byi, bclr)
			PlotLineX(bcenter_x - bxi, bcenter_x + bxi, bcenter_y + byi, bclr)
		Else ;draw 4 points using symmetry
			PlotPixel(bcenter_x + bxi, bcenter_y + byi, bclr) ;e-se
			PlotPixel(bcenter_x + bxi, bcenter_y - byi, bclr) ;e-ne
			PlotPixel(bcenter_x - bxi, bcenter_y + byi, bclr) ;w-sw
			PlotPixel(bcenter_x - bxi, bcenter_y - byi, bclr) ;w-nw
		EndIf
		If bd1 < 0 ;move straight up
			bd1 = bd1 + bdi + bx1
			bd2 = bd2 + bdi
		Else ;move up and left
			bxi = bxi - 1
			bf2 = bf2 - by2
			bd1 = bd1 + bdi + bx1 - bf2
			bd2 = bd2 + bdi + by1 - bf2
		EndIf
		byi = byi + 1 ;always move up
		bdi = bdi + bx2
	Wend
	
	;draw rest of top right quadrant, until x = 0
	While bxi >= 0
		If bfill > 0 ;draw lines across outer octants, n-nw>n-ne and s-sw>s-se
			If bd2 < 0 ;if y changed fill outer octants, no overlap
				PlotLineX(bcenter_x - bxi, bcenter_x + bxi, bcenter_y - byi, bclr)
				PlotLineX(bcenter_x - bxi, bcenter_x + bxi, bcenter_y + byi, bclr)
			EndIf
		Else ;draw 4 points using symmetry
			PlotPixel(bcenter_x + bxi, bcenter_y + byi, bclr) ;s-se
			PlotPixel(bcenter_x + bxi, bcenter_y - byi, bclr) ;n-ne
			PlotPixel(bcenter_x - bxi, bcenter_y + byi, bclr) ;s-sw
			PlotPixel(bcenter_x - bxi, bcenter_y - byi, bclr) ;n-nw
		EndIf
		If bd2 < 0 ;move up and left
			byi = byi + 1
			bdi = bdi + bx2
			bd2 = bd2 + bdi + by1 - bf2
		Else ;move straight left
			bd2 = bd2 + by1 - bf2
		EndIf
		bxi = bxi - 1 ;always move left
		bf2 = bf2 - by2
	Wend
	
EndProcedure


Procedure DrawLine(bplot_x1, bplot_y1, bplot_x2, bplot_y2, bclr)
	
	; Line drawing algorithm in Pascal -> http://www.gamedev.net/
	; A general-purpose implementation of Bresenham's line algorithm.
	; By Mark Feldman.
	
	;deltax and deltay
	bdx = Abs(bplot_x2 - bplot_x1)
	bdy = Abs(bplot_y2 - bplot_y1)
	
	;always 1
	bx2 = 1
	by2 = 1
	
	;initialize vars based on which is the independent variable
	If bdx >= bdy ;x is independent variable
		bnp = bdx + 1
		bd1 = bdy << 1
		bdi = bd1 - bdx
		bd2 = (bdy - bdx) << 1
		bx1 = 1
		by1 = 0
	Else ;y is independent variable
		bnp = bdy + 1
		bd1 = bdx << 1
		bdi = bd1 - bdy
		bd2 = (bdx - bdy) << 1
		bx1 = 0
		by1 = 1
	EndIf
	
	;make sure x and y move in the right directions
	If bplot_x1 > bplot_x2
		bx1 = -bx1
		bx2 = -bx2
	EndIf
	If bplot_y1 > bplot_y2
		by1 = -by1
		by2 = -by2
	EndIf
	
	;start drawing at
	bxi = bplot_x1
	byi = bplot_y1
	
	;draw the pixels
	For bli = 1 To bnp
		PlotPixel(bxi, byi, bclr)
		If bdi < 0
			bdi = bdi + bd1
			bxi = bxi + bx1
			byi = byi + by1
		Else
			bdi = bdi + bd2
			bxi = bxi + bx2
			byi = byi + by2
		EndIf
	Next bli
	
EndProcedure


Procedure PlotLineX(bplot_x1, bplot_x2, bplot_y, bclr)
	
	; Plot a line of pixels across the screen from x1 To x2 at the y value.
	; Since only increments are involved it is optimised.
	
	If bplot_x2 < bplot_x1 ;if x2 less, switch plot directions
		bli = bplot_x2      ;store = x2
		bplot_x2 = bplot_x1 ;x2 = x1
		bplot_x1 = bli      ;x1 = store
	EndIf
	
	For bli = bplot_x1 To bplot_x2 ;Step 2
		PlotPixel(bli, bplot_y, bclr)
	Next bli
	
EndProcedure


Procedure PlotLineY(bplot_x, bplot_y1, bplot_y2, bclr)
	
	; Plot a line of pixels down the screen from y1 To y2 at the x value.
	; Since only increments are involved it is optimised.
	
	If bplot_y2 < bplot_y1 ;if y2 less, switch plot directions
		bli = bplot_y2      ;store = y2
		bplot_y2 = bplot_y1 ;y2 = y1
		bplot_y1 = bli      ;y1 = store
	EndIf
	
	For bli = bplot_y1 To bplot_y2
		PlotPixel(bplot_x, bli, bclr)
	Next bli
	
EndProcedure


Procedure PlotPixel(bplot_x, bplot_y, bclr)
	
	; Plot a pixel if values are inside this area, screen dimensions here.
	; Shorten code and prevent screen garbage.
	
	If bplot_x >= #Xmin And bplot_x < #Xmax
		If bplot_y >= #Ymin And bplot_y < #Ymax
			Plot(bplot_x, bplot_y, bclr)
		EndIf
	EndIf
	
EndProcedure

Code: Select all

Procedure.i DrawLine(X1.i,Y1.i,X2.i,Y2.i,Width.i);<- draw the line
  Protected.f w,h,r,s,c,ws,wc,hs,hc
  w = Sqr((X1 - X2) * (X1 - X2) + (Y1 - Y2) * (Y1 - Y2))
  h = Width / 2.0
  r = ATan2(X2 - X1,Y2 - Y1)
  s = Sin(r)
  c = Cos(r)
  ws = w * s
  wc = w * c
  hs = h * s
  hc = h * c
  ZoomSprite(0,w,Width)
  TransformSprite(0,hs,-hc,0,wc + hs,ws - hc,0,wc - hs,ws + hc,0,-hs,hc,0)
  DisplayTransparentSprite(0,X1,Y1)
  ZoomSprite(0,#PB_Default,#PB_Default)
  ProcedureReturn #Null
EndProcedure

Code: Select all

Procedure.i DrawLine(X1.i,Y1.i,X2.i,Y2.i,Width.i);<- draw the line
  Protected.f length, dx, dy
  length = Sqr((X1-X2)*(X1-X2) + (Y1-Y2)*(Y1-Y2))
  dy = (X2-X1)*Width/(2*length)
  dx = (Y1-Y2)*Width/(2*length)
  TransformSprite(0, X1-dx, Y1-dy, X2-dx, Y2-dy, X2+dx, Y2+dy, X1+dx, Y1+dy)
  DisplayTransparentSprite(0,0,0)
  ProcedureReturn #Null
EndProcedure

Code: Select all

;--MODULE DECLARATION
DeclareModule line
  Global initialized.b =#False , sprite_ID.i = -1
  Declare init()
  Declare destroy()
  Declare draw(x1.i,y1.i,x2.i,y2.i,color.i=-16776961,width.i=2,intensity.i = 255)
EndDeclareModule

;--MODULE
Module line
  ;******************************************************************
  ;This procedure initializes the line functions, creates it's sprite
  ;******************************************************************
  Procedure init()
    line::sprite_ID = CreateSprite(#PB_Any,1,1,#PB_Sprite_AlphaBlending)
    If Not IsSprite(line::sprite_ID) : ProcedureReturn #False : EndIf
    StartDrawing(SpriteOutput(line::sprite_ID))
    DrawingMode(#PB_2DDrawing_AllChannels)
    Box(0,0,OutputWidth(),OutputHeight(),RGBA(255,255,255,255))
    StopDrawing()
    line::initialized = #True : ProcedureReturn #True  
  EndProcedure
  
  ;******************************************************************
  ;This procedure frees the resources (1 sprite) if linedrawing is 
  ;not needed anymore
  ;******************************************************************
  Procedure destroy()
    If IsSprite(line::sprite_ID) : FreeSprite(line::sprite_ID) : EndIf 
    line::initialized = #False
  EndProcedure
  
  ;******************************************************************
  ;This procedure draws a line to screen either 2d or 3d Ogre screen
  ;******************************************************************
  Procedure draw(x1.i,y1.i,x2.i,y2.i,color.i=-16776961,width.i=2,intensity.i = 255)
    ;MIJIKAI and STARGATE code
    Protected.f length, dx, dy
    length = Sqr((X1-X2)*(X1-X2) + (Y1-Y2)*(Y1-Y2))
    dy = (X2-X1)*Width/(2*length)
    dx = (Y1-Y2)*Width/(2*length)
    ZoomSprite(line::sprite_ID,length,length)
    TransformSprite(line::sprite_ID, X1-dx, Y1-dy, X2-dx, Y2-dy, X2+dx, Y2+dy, X1+dx, Y1+dy)
    DisplayTransparentSprite(line::sprite_ID,0,0,intensity,color)
  EndProcedure
EndModule

;-*************
;-EXAMPLE USAGE
;-*************
#STEPS = 30
ExamineDesktops()
InitSprite()
InitKeyboard()
InitMouse()
OpenWindow(0,0,0,DesktopUnscaledX(DesktopWidth(0)),DesktopUnscaledY(DesktopHeight(0)),"2d Line Draw module", #PB_Window_BorderLess)
OpenWindowedScreen(WindowID(0),0,0,WindowWidth(0),WindowHeight(0),1,0,0,#PB_Screen_SmartSynchronization)
SetFrameRate(60)
line::init()
Repeat
  Repeat: Until Not WindowEvent()
  ExamineKeyboard() : ExamineMouse() : ClearScreen(RGB(50,20,20))
  
  For x = 0 To #STEPS
    line::draw(0,0,ScreenWidth(),ScreenHeight()/#STEPS*(#STEPS-x))
    line::draw(0,ScreenHeight(),ScreenWidth(),ScreenHeight()/#STEPS*(#STEPS-x))
    line::draw(ScreenWidth(),ScreenHeight(),0,ScreenHeight()/#STEPS*(#STEPS-x))
    line::draw(ScreenWidth(),0,0,ScreenHeight()/#STEPS*(#STEPS-x))
  Next x
  FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)