' *************************************************
' * Programm: inkrementaler Kreisgenerator        *
' * Autor:    Andreas Hollmann                    *
' * Sprache:  GFA-Basic                           *
' * Copyright MAXON Computer GmbH                 *
' *************************************************
'
' Linienmuster definieren:
CLS
CARD{V:type&}=&X1111111111111111   ! durchgezogen
' CARD{V:type&}=&X1010101010101010   ! gepunktet
' CARD{V:type&}=&X1110111011101110   ! gestrichelt
'
FOR r&=2 TO 80 STEP 5       ! konzentrische Kreise
  DEFLINE 1     ! weil DEFLINE auch auf PLOT wirkt
  circle(160,199,r&,type&)      ! echter Kreis
  DEFLINE -CARD{V:type&}        !
  CIRCLE 480,199,r&             ! VDI-'Kreis'
NEXT r&
'
END
'
> PROCEDURE circle(x0&,y0&,r&,type&)
  ' Parameter:
  ' x0&,y0&   = Kreismittelpunkt-Koordinaten
  ' r&        = Kreisradius
  ' type&     = Linienmuster (16 Bits)
  '
  LOCAL octant&,x&,y&
  '
  x&=r&
  '
  FOR octant&=1 TO 8
    IF ODD(octant&)           ! Oktant 1,3,5,7
      SUB r&,SHL&(x&,1)
      DO UNTIL y&>x&
        IF BTST(type&,0)      ! Muster-Bit gesetzt
          SELECT octant&      ! Punkt setzen
          CASE 1
            PLOT ADD(x0&,x&),ADD(y0&,y&)
          CASE 3
            PLOT SUB(x0&,y&),ADD(y0&,x&)
          CASE 5
            PLOT SUB(x0&,x&),SUB(y0&,y&)
          CASE 7
            PLOT ADD(x0&,y&),SUB(y0&,x&)
          ENDSELECT
        ENDIF
        type&=ROR&(type&,1)  ! Muster weitersetzen
        ADD r&,SUCC(SHL&(y&,1))
        INC y&
        IF r&>=0
          SUB r&,SUB(SHL&(x&,1),2)
          DEC x&
        ENDIF
      LOOP
    ELSE                    ! Oktant 2,4,6,8
      ADD r&,SHL&(x&,1)
      DO UNTIL y&<0
        SUB r&,PRED(SHL&(y&,1))
        DEC y&
        IF r&<0
          ADD r&,ADD(SHL&(x&,1),2)
          INC x&
        ENDIF
        IF x&<>y&  ! Diagonalen-Linien vermeiden
          IF BTST(type&,0)     ! Muster-Bit gesetzt
            SELECT octant&     ! Punkt setzen
            CASE 2
              PLOT ADD(x0&,y&),ADD(y0&,x&)
            CASE 4
              PLOT SUB(x0&,x&),ADD(y0&,y&)
            CASE 6
              PLOT SUB(x0&,y&),SUB(y0&,x&)
            CASE 8
              PLOT ADD(x0&,x&),SUB(y0&,y&)
            ENDSELECT
          ENDIF
          type&=ROR&(type&,1) ! Muster weitersetzen
        ENDIF
      LOOP
      type&=ROR&(type&,1) ! Muster weitersetzen
    ENDIF
    '
  NEXT octant&
  '
RETURN