forums.silverfrost.com Forum Index forums.silverfrost.com
Welcome to the Silverfrost forums
 
 FAQFAQ   SearchSearch   MemberlistMemberlist   UsergroupsUsergroups   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 

hatch fill polygon

 
Post new topic   Reply to topic    forums.silverfrost.com Forum Index -> ClearWin+
View previous topic :: View next topic  
Author Message
Smib



Joined: 26 Apr 2009
Posts: 22
Location: Melbourne

PostPosted: Mon Apr 27, 2009 1:07 pm    Post subject: hatch fill polygon Reply with quote

Does anybody have sample code to fill a polygon with a hatch pattern? I don't seem to be making any progress with createhatchbrush

Cheers

Brian
Back to top
View user's profile Send private message
PaulLaidler
Site Admin


Joined: 21 Feb 2005
Posts: 7916
Location: Salford, UK

PostPosted: Mon Apr 27, 2009 4:33 pm    Post subject: Reply with quote

draw_filled_polygon@ only allows you to specify the fill as a solid colour.

I guess that you may be able to create your own brush hBrush using CreateHatchBrush but you will have to select it into the relevant device context before calling draw_filled_polygon@ etc.

You can get the hDC from clearwin_info@("GRAPHICS_HDC") and then select the created hBrush with a call to the Windows API SelectObject.

oldBrush = SelectObject(hDC, hBrush)
Back to top
View user's profile Send private message AIM Address
LitusSaxonicum



Joined: 23 Aug 2005
Posts: 2388
Location: Yateley, Hants, UK

PostPosted: Mon Apr 27, 2009 11:02 pm    Post subject: Reply with quote

In I.O. Angell & G. Griffith "High-resolution computer graphics using Fortran 77" published by Macmillan, ISBN 0-333-40398-3 (0-333-430399-1 for the paperback) (1987) there is a routine for doing just that on pages 93 & 94. (You are a bit too far away from SW London for me to offer you the loan of my copy. I could scan the pages and e mail them if you send me an e mail address via "private message").

However, when I typed up the code and ran it my recollection is that it missed out one of the hatch lines through a vertex. I never got to the bottom of it, and gave up ... (it might have simply been a precision problem).

Eddie
Back to top
View user's profile Send private message
IanLambley



Joined: 17 Dec 2006
Posts: 490
Location: Sunderland

PostPosted: Tue Apr 28, 2009 1:29 pm    Post subject: Reply with quote

Eddie,

You are right, lines which pass through a vertex go wrong. I seem to remember having a fight with that routine. I have attached where I got to in 1994, but it does seem to be a precision problem where one of the hatching lines is very close to the end of a boundary line.

This code just checks a series of lines against a boundary.

Code:

      dimension xvert(100),yvert(100),x1(10),y1(10),x2(10),y2(10),
     &          rmt(100)
      open(unit=10,file='border',status='unknown')
c
c determine the border into which lines are to be clipped
      read(10,*)nvertex
      do i=1,nvertex
        read(10,*)xvert(i),yvert(i)
c        print *,xvert(i),yvert(i)
      enddo
c
c read the lines to be drawn
      read(10,*)nlines
      do i=1,nlines
        read(10,*)x1(i),y1(i),x2(i),y2(i)
c        print *,x1(i),y1(i),x2(i),y2(i)
      enddo
c
c take a line and see whether the intersection is within the range of each
c of the border lines
      do j = 1,nlines
      dx = x2(j)-x1(j)
      dy = y2(j)-y1(j)
c
c set number of intersections to zero plus 2 to denote the start and end
c of the line itself and insert 0 & 1 into the rmt array
      ni = 2
      rmt(1) = 0.0
      rmt(2) = 1.0
c      print *,'         rmu           isec'
      do i=0,nvertex-1
        i1 = mod(i+1,nvertex)+1
        call ill2(xvert(i+1),yvert(i+1),xvert(i1),yvert(i1),
     &            x1(j),y1(j),dx,dy,rmu,rmt(ni+1),isec)
c        print *,rmu,rmt(ni+1),isec
        if(isec .eq. 1)then
c
c yes it intersects but is it within limits of border line in question
          if(rmu .ge. 0.0 .and. rmu .le. 1.0)then
c
c take this one into account
c            print *,'line intersects edge ',i-1,' at rmu =',rmu
c
c determine position on line to be drawn of the intersection
            ni = ni + 1
          endif
        endif
      enddo
c      print *,'RMT values'
c      print *,(rmt(i),i=1,ni)
      call SORT(rmt,Ni,1,ni,1,1,ISTAT)
c      print *,'RMT values sorted'
c      print *,(rmt(i),i=1,ni)
c
c if the first value in the list is 0.0 then line starts outside
c if the last  value in the list is 1.0 then line ends   outside
c we must also only draw items in the range of 0.0 to 1.0 so scan list
c and start a line on an even rmt array subscript plot to next subscript
c only draw a line if start point is in range 0 to 1
      print *,'rmt values to plot'
      do i = 2,ni-1,2
        if(rmt(i) .ge. 0.0 .and. rmt(i) .le. 1.0)then
          print *,i,rmt(i),' to ',rmt(i+1)
        endif
      enddo
      enddo
      end

See continuation post

Ian
Back to top
View user's profile Send private message Send e-mail
IanLambley



Joined: 17 Dec 2006
Posts: 490
Location: Sunderland

PostPosted: Tue Apr 28, 2009 1:29 pm    Post subject: Reply with quote

Part 2
Code:

c==================================================================
      subroutine ill2(x1,y1,x2a,y2a,x3,y3,x4,y4,rmu,rmt,isec)
c
c finds point of intersection of two lines x1,y1 to x2,y2 with
c                                          x3,y3 to x4,y4
c rmu is the non dimensional value of the intersection on the first line
c rmu = 0 for start of line ,1 for end of line therefore outside range
c 0 to 1 means they do not intersect
c x,y are the coordinates of the intersection
c isec = 1 if success else 0
      x2 = x2a-x1
      y2 = y2a-y1
      delta = x2*y4 - y2*x4
      delta2 = x4*y2 - y4*x2
c
c if delta = 0 then lines parallel
      if(abs(delta) .lt. 0.00001)then
        isec = 0
        return
      endif
c
c find rmu value for (x,y) on first line
      isec = 1
      rmu = ((x3-x1)*y4 - (y3-y1)*x4)/delta
      rmt = ((x1-x3)*y2 - (y1-y3)*x2)/delta2
      return
      end
Back to top
View user's profile Send private message Send e-mail
IanLambley



Joined: 17 Dec 2006
Posts: 490
Location: Sunderland

PostPosted: Tue Apr 28, 2009 1:32 pm    Post subject: Reply with quote

Part 3
Code:

      SUBROUTINE SORT(X,N,M,L,ISORT,ITY,ISTAT)
C sorts X into order
C name      type size   dimensions  i/o description
C  x         RE 4        (*,*)        b an array dimensioned (nxm) containing the data to be sorted.
C n          in 4                     i the maximum number of entries in each column. and the first dimension of ix
C m          in 4                     i the number of columns in ix to be sorted and hence the second dimension of ix.
C l          in 4                     i the fill of the array columns 0 < l <= n
C isort      in 4                     i the column to sort on 1 <= isort <= m
C ity        in 4                     i the type of sort.
C +1 = ascending order,  +2 = ascending on absolute value
C -1 = descending order, -2 = descending order on absolute
C istat      in 4                     o error status.
C 0 = ok, 1 = zero colums in array, 2 = sort column too low,  4 = sort column too high, 8 = invalid sort type so isort set to 1,
C  16 = fill greater than available so l set to n
C  status 1, 2 & 4 are fatal, 8 & 16 are non-fatal
      DIMENSION X(N,M)
C note : istat codes may be the summation of any
C        of the above
C                         ! initialize status
      ISTAT   = 0
C                         ! zero columns found
      IF( M.LT.1 )ISTAT = 1
C sort column too low
      IF( ISORT.LT.1 )ISTAT = ISTAT + 2
C sort column too high
      IF( ISORT.GT.M )ISTAT = ISTAT + 4
C ===============================================
C if istat not zero then don't sort, just return
      IF( ISTAT.NE.0 )RETURN
      IF( ITY.NE.1 .AND. ITY.NE.-1 )THEN
        IF( ITY.NE.2 .AND. ITY.NE.-2 )THEN
          ITY     = 1
          ISTAT   = 8
        ENDIF
      ENDIF
      IF( L.GT.N )THEN
        L       = N
        ISTAT   = ISTAT + 16
      ENDIF
C                     ! float integer
      TY      = SIGN(1.0,FLOAT(ITY))
      MODE    = ABS(ITY)
C ===============================================
C set up search loops
      DO 30 I = 1, L - 1
        DO 20 J = I + 1, L
C ===============================================
C check magnitudes
C ===============================================
          IF( MODE.EQ.1 )THEN
C
C normal sort
            IF( X(I,ISORT)*IFIX(TY).LE.X(J,ISORT)*IFIX(TY) )GOTO 20
C
C absolute sort
          ELSEIF( ABS(X(I,ISORT)*IFIX(TY)).LE.ABS(X(J,ISORT)*IFIX(TY))
     &             )THEN
            GOTO 20
          ENDIF
C ===============================================
C do the swap
C ===============================================
          DO 10 K = 1, M
            DUMMY  = X(J,K)
            X(J,K) = X(I,K)
            X(I,K) = DUMMY
   10     CONTINUE
   20   CONTINUE
   30 CONTINUE
      RETURN
      END
Back to top
View user's profile Send private message Send e-mail
LitusSaxonicum



Joined: 23 Aug 2005
Posts: 2388
Location: Yateley, Hants, UK

PostPosted: Tue Apr 28, 2009 4:17 pm    Post subject: Reply with quote

Thanks Ian,

That saved me a job.

Eddie
Back to top
View user's profile Send private message
Smib



Joined: 26 Apr 2009
Posts: 22
Location: Melbourne

PostPosted: Wed Apr 29, 2009 12:37 pm    Post subject: Reply with quote

Gents Thanks for the very prompt replies

Paul I have not had a chace to try this yet;

Eddie Thanks for the offer; and

Ian thanks for the code

Cheers

Brian
Back to top
View user's profile Send private message
JohnCampbell



Joined: 16 Feb 2006
Posts: 2554
Location: Sydney

PostPosted: Thu Apr 30, 2009 3:05 am    Post subject: Reply with quote

Ian,

I could not resist converting your SORT to fortran 90, using a SELECT CASE (ITY) structure. I do think that fortran 90 is an improvement in style and probably with little overhead.

I also noted your code sets ITY to 1, however ITY is not supplied as a variable. This could be one of those nasty bugs that is difficult to find.

Code:

        IF( ITY.NE.2 .AND. ITY.NE.-2 )THEN
          ITY     = 1
          ISTAT   = 8
        ENDIF


John
Back to top
View user's profile Send private message
Smib



Joined: 26 Apr 2009
Posts: 22
Location: Melbourne

PostPosted: Thu Apr 30, 2009 11:01 am    Post subject: Reply with quote

Paul

Worked perfect;ly when i used the polygon API and after I twiged that I had to define my coordinates in a vector of alternating x and y values

Thanks again to all
Back to top
View user's profile Send private message
JohnHorspool



Joined: 26 Sep 2005
Posts: 270
Location: Gloucestershire UK

PostPosted: Thu Apr 30, 2009 11:10 am    Post subject: Reply with quote

Brian,

Could you post the code please, for all to see?

John
Back to top
View user's profile Send private message Visit poster's website
LitusSaxonicum



Joined: 23 Aug 2005
Posts: 2388
Location: Yateley, Hants, UK

PostPosted: Thu Apr 30, 2009 1:10 pm    Post subject: Reply with quote

May I add my voice to John H's, asking to see a code fragment please?

Apart from the line through a vertex problem, I think that the ultimate reason I abandoned the quest to program hatching was the incredible price drop in colour printers, and my abandoning plotters of the type that used to pick up a pen and rush round the page with it.

To John C: As Angell and Griffiths were writing in Fortran 77, they probably eschewed Select Case deliberately. Think yourself lucky the code isn't all in arithmetic IFs, ASSIGNed GOTOs and Holleriths, with no comments and worse ....

Eddie
Back to top
View user's profile Send private message
Smib



Joined: 26 Apr 2009
Posts: 22
Location: Melbourne

PostPosted: Fri May 01, 2009 9:52 am    Post subject: Reply with quote

Apologies

Here is code:

integer hatchbrush,oldbrush,npts
integer*4 ijk(50)

c put xy coordinates into a vector array ijk
c alternating x and y

ijk(1)=x(1)
ijk(2)=y(1)
.
.
.
.
.
ijk(2n-1)=x(n)
ijk(2n)=x(n)

npts=n

ij=clearwin_info@('GRAPHICS_HDC')
hatchBrush = CreateHatchBrush(HS_DIAGCROSS,RGB@(255,128,0))
oldBrush = SelectObject (ij, hatchBrush)
call polygon(ij,ijk,npts)


Cheers

Brian
Back to top
View user's profile Send private message
Display posts from previous:   
Post new topic   Reply to topic    forums.silverfrost.com Forum Index -> ClearWin+ All times are GMT + 1 Hour
Page 1 of 1

 
Jump to:  
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
You cannot vote in polls in this forum


Powered by phpBB © 2001, 2005 phpBB Group